R/ArrayResourceBySize-class.R

In mizer: Dynamic Multi-Species Size Spectrum Modelling

# ArrayResourceBySize and ArrayTimeByResourceBySize S3 classes for resource
# size spectra
#
# Copyright 2026 Gustav Delius.
# Distributed under the GPL 3 or later.

#' S3 class for resource size spectra
#'
#' `r lifecycle::badge("experimental")`
#' Several functions in mizer return a vector over the full size grid holding
#' a resource-related quantity such as the resource number density, the
#' resource mortality, the intrinsic resource birth rate or carrying capacity.
#' The `ArrayResourceBySize` class wraps these vectors to provide convenient
#' `print()`, `summary()`, `plot()`, and `as.data.frame()` methods.
#'
#' An `ArrayResourceBySize` object behaves just like a regular numeric vector
#' for arithmetic operations and subsetting. It carries three lightweight
#' attributes:
#' \itemize{
#'   \item `value_name` – a human-readable name for the value
#'       (e.g. "Resource mortality").
#'   \item `units` – the units of the value (e.g. "1/year").
#'   \item `params` – the `MizerParams` object that the value was computed from.
#' }
#'
#' @param x A numeric vector over the full size grid. For
#'   `is.ArrayResourceBySize()`, any object to test.
#' @param value_name A string giving the human-readable name for the value.
#' @param units A string giving the units (e.g. "1/year").
#' @param type The kind of quantity the values are, see [ArraySpeciesBySize()]
#'   and [array_types].
#' @param params A `MizerParams` object. Used for the resource colour and the
#'   size grid in the `plot()` method.
#'
#' @return An `ArrayResourceBySize` object (inherits from `numeric`).
#' @seealso [print()], [summary()], [as.data.frame()], [plot()], [plot2()],
#'   [plotRelative()], [addPlot()]
#' @export
#' @examples
#' \donttest{
#' mort <- getResourceMort(NS_params)
#' is.ArrayResourceBySize(mort)
#' summary(mort)
#' plot(mort)
#' }
ArrayResourceBySize <- function(x, value_name = NULL, units = NULL,
                                type = NULL, params = NULL) {
    if (!is.numeric(x) || !is.null(dim(x))) {
        stop("`x` must be a numeric vector.")
    }
    type <- resolve_array_type(type, value_name, units)
    if (!is.null(params) && length(x) == length(params@initial_n_pp) &&
            is.null(names(x))) {
        names(x) <- names(params@initial_n_pp)
    }
    structure(x,
        class = c("ArrayResourceBySize", "numeric"),
        value_name = value_name,
        units = units,
        type = type,
        params = params
    )
}

#' @rdname ArrayResourceBySize
#' @return `is.ArrayResourceBySize()` returns `TRUE` if `x` is an
#'   `ArrayResourceBySize` object, `FALSE` otherwise.
#' @export
is.ArrayResourceBySize <- function(x) {
    inherits(x, "ArrayResourceBySize")
}

#' @export
print.ArrayResourceBySize <- function(x, ...) {
    value_name <- attr(x, "value_name") %||% "ArrayResourceBySize"
    units_str <- attr(x, "units")
    header <- paste0(value_name, " (", length(x), " sizes)")
    if (!is.null(units_str) && nzchar(units_str)) {
        header <- paste0(header, " [", units_str, "]")
    }
    cat(header, "\n")

    w <- get_ArrayResourceBySize_w(x)
    vec <- unclass_resource(x)
    n <- length(vec)

    size_k <- fit_log_spaced_k(
        n, mizer_print_defaults$size_max, mizer_print_defaults$size_min,
        width_fn = function(k) {
            idx <- pick_log_spaced_indices(n, k)
            vector_display_width(vec[idx])
        })
    sz_idx <- pick_log_spaced_indices(n, size_k)
    print(vec[sz_idx])

    if (length(sz_idx) < n) {
        cat(format_truncation_note(length(sz_idx), n, "sizes",
                                   format_size_range_detail(w)), "\n")
    }
    invisible(x)
}

#' @export
summary.ArrayResourceBySize <- function(object, ...) {
    value_name <- attr(object, "value_name") %||% "ArrayResourceBySize"
    units_str <- attr(object, "units")
    vals <- unclass(object)

    result <- list(
        value_name = value_name,
        units = units_str,
        length = length(object),
        stats = data.frame(
            Min = min(vals, na.rm = TRUE),
            Mean = mean(vals, na.rm = TRUE),
            Max = max(vals, na.rm = TRUE),
            row.names = NULL
        )
    )
    class(result) <- "summary.ArrayResourceBySize"
    result
}

#' @export
print.summary.ArrayResourceBySize <- function(x, ...) {
    header <- x$value_name
    if (!is.null(x$units) && nzchar(x$units)) {
        header <- paste0(header, " [", x$units, "]")
    }
    cat(header, "\n")
    cat(x$length, "sizes\n\n")
    print(x$stats, row.names = FALSE)
    invisible(x)
}

#' Plot method for `ArrayResourceBySize` objects
#'
#' See [plot()] for an overview of the mizer plotting system and the
#' arguments shared by all of its methods.
#'
#' @param x An `ArrayResourceBySize` object.
#' @param return_data If `TRUE`, return the data frame instead of the
#'   plot.
#' @param log_x If `TRUE`, use a log10 x-axis. Default is `TRUE`.
#' @param log_y If `TRUE`, use a log10 y-axis. Default is `TRUE`.
#' @param log Character string specifying which axes should use log10
#'   scales, in the same form as the base [plot()] argument. For example,
#'   `"x"`, `"y"`, `"xy"` or `""`. If supplied, this overrides `log_x` and
#'   `log_y`.
#' @param wlim A numeric vector of length two providing lower and upper
#'   limits for the weight (x) axis. Use `NA` to refer to the existing
#'   minimum or maximum.
#' @param llim A numeric vector of length two providing lower and upper limits
#'   for the length (x) axis when `size_axis = "l"`. Use `NA` to refer to the
#'   existing minimum or maximum.
#' @param ylim A numeric vector of length two providing lower and upper
#'   limits for the value (y) axis. Use `NA` to refer to the existing
#'   minimum or maximum.
#' @param size_axis Whether to plot size as weight (`"w"`, default) or length
#'   (`"l"`), using the weight-length relationship in [resource_params()].
#' @param per_log_size For an array that holds a density, whether to plot it
#'   per logarithmic size (`TRUE`) rather than per size (`FALSE`). The default,
#'   `NULL`, plots the density as it stands. An error for an array that does not
#'   hold a density.
#' @param y_ticks The approximate number of ticks desired on the y axis.
#' @param ... Unused.
#'
#' @return A ggplot2 object, unless `return_data = TRUE`, in which case a
#'   data frame is returned.
#' @keywords internal
#' @export
#' @examples
#' \donttest{
#' plot(getResourceMort(NS_params))
#' plot(initialNResource(NS_params))
#' }
plot.ArrayResourceBySize <- function(x, return_data = FALSE,
                                     log_x = TRUE, log_y = TRUE, log = NULL,
                                     wlim = c(NA, NA), llim = c(NA, NA),
                                     ylim = c(NA, NA),
                                     size_axis = c("w", "l"),
                                     per_log_size = NULL,
                                     y_ticks = 6, ...) {
    size_axis <- plot_size_axis(size_axis)
    check_per_log_size(x, per_log_size)
    log_y <- array_log_y(x, log_y, log, !missing(log_y))
    log_axes <- parsePlotLog(log, log_x = log_x, log_y = log_y)
    log_x <- log_axes$log_x
    log_y <- log_axes$log_y

    assert_that(length(wlim) == 2,
                length(llim) == 2,
                length(ylim) == 2)
    params <- attr(x, "params")

    plot_dat <- ArrayResourceBySize_plot_data(x, wlim = wlim, llim = llim,
                                              size_axis = size_axis,
                                              per_log_size = per_log_size)

    if (return_data) return(plot_dat)

    y_label <- array_y_label(x, default = "value", size_axis = size_axis,
                             per_log_size = per_log_size)

    ylim <- array_ylim(x, ylim, log_y, plot_dat[[2]])
    plotDataFrame(plot_dat, params, xlab = plot_size_xlab(size_axis),
                  ylab = y_label,
                  xtrans = if (log_x) "log10" else "identity",
                  ytrans = if (log_y) "log10" else "identity",
                  xlim = plot_size_xlim(wlim, size_axis, llim), ylim = ylim,
                  y_ticks = y_ticks, legend_var = "Legend")
}

#' The complete plotting data of a resource-by-size array
#'
#' The resource analogue of [ArraySpeciesBySize_plot_data()]: the weight limits,
#' the conversion of the values and of the size coordinate onto the requested
#' axis, and the length limits, all done with the array's own `params`. A
#' resource array holds a single spectrum, so there is no selection, no
#' background and no total to form.
#'
#' @param x An `ArrayResourceBySize` object.
#' @param wlim Numeric vector of length two giving the weight limits.
#' @param llim Numeric vector of length two giving the length limits, applied
#'   only on a length axis.
#' @param size_axis Either `"w"` (weight) or `"l"` (length).
#' @param per_log_size Whether to express a density per logarithmic size.
#' @return A data frame with the size coordinate in its first column, the values
#'   in its second, and `Species` and `Legend` columns.
#' @keywords internal
ArrayResourceBySize_plot_data <- function(x, wlim = c(NA, NA),
                                          llim = c(NA, NA),
                                          size_axis = "w",
                                          per_log_size = NULL) {
    params <- attr(x, "params")
    size_axis <- plot_size_axis(size_axis)
    plot_dat <- prepare_ArrayResourceBySize_plot_data(x, wlim = wlim)
    plot_dat <- convert_plot_density_axis(plot_dat, params, size_axis,
                                          density_wrt = array_density_wrt(x),
                                          per_log_size = per_log_size)
    if (identical(size_axis, "l")) {
        plot_dat <- filter_plot_length_limits(plot_dat, llim)
    }
    plot_dat
}

prepare_ArrayResourceBySize_plot_data <- function(x, wlim = c(NA, NA)) {
    w <- get_ArrayResourceBySize_w(x)
    value_name <- attr(x, "value_name") %||% "value"

    plot_dat <- data.frame(
        w = w,
        value = as.numeric(unclass(x)),
        Species = "Resource",
        Legend = "Resource",
        stringsAsFactors = FALSE
    )
    plot_dat <- apply_wlim(plot_dat, wlim)
    names(plot_dat)[2] <- value_name
    plot_dat
}

#' @rdname plot2
#' @usage NULL
#' @export
plot2.ArrayResourceBySize <- function(x, y, name1 = "First", name2 = "Second",
                                      species = NULL,
                                      log_x = TRUE, log_y = TRUE, log = NULL,
                                      ylim = c(NA, NA),
                                      total = FALSE, background = TRUE,
                                      highlight = NULL,
                                      y_ticks = 6,
                                      wlim = c(NA, NA), llim = c(NA, NA),
                                      size_axis = c("w", "l"),
                                      per_log_size = NULL, ...) {
    check_plot2_compatible(x, y, "ArrayResourceBySize")
    compare_array_metadata(x, y)
    warn_unused_resource_args(species, total, background)
    size_axis <- plot_size_axis(size_axis)
    check_per_log_size(x, per_log_size)
    log_y <- array_log_y(x, log_y, log, !missing(log_y))
    log_axes <- parsePlotLog(log, log_x = log_x, log_y = log_y)
    log_x <- log_axes$log_x
    log_y <- log_axes$log_y
    assert_that(length(wlim) == 2,
                length(llim) == 2,
                length(ylim) == 2)

    params <- attr(x, "params")
    y_label <- array_y_label(x, default = "Value", size_axis = size_axis,
                             per_log_size = per_log_size)
    # Each array is prepared with its own model: the resource has its own
    # weight-length relationship too, see `resource_length_params()`.
    plot_dat1 <- ArrayResourceBySize_plot_data(x, wlim = wlim, llim = llim,
                                               size_axis = size_axis,
                                               per_log_size = per_log_size)
    plot_dat2 <- ArrayResourceBySize_plot_data(y, wlim = wlim, llim = llim,
                                               size_axis = size_axis,
                                               per_log_size = per_log_size)

    ylim <- array_ylim(x, ylim, log_y, c(plot_dat1[[2]], plot_dat2[[2]]))

    plotComparisonDataFrame(plot_dat1, plot_dat2, params,
                            name1 = name1, name2 = name2,
                            xlab = plot_size_xlab(size_axis), ylab = y_label,
                            xtrans = if (log_x) "log10" else "identity",
                            ytrans = if (log_y) "log10" else "identity",
                            xlim = plot_size_xlim(wlim, size_axis, llim),
                            ylim = ylim, highlight = highlight,
                            y_ticks = y_ticks, legend_var = "Legend")
}

#' @rdname plotRelative
#' @usage NULL
#' @export
plotRelative.ArrayResourceBySize <- function(x, y, species = NULL,
                                             log_x = TRUE,
                                             ylim = c(NA, NA),
                                             total = FALSE,
                                             background = TRUE,
                                             highlight = NULL,
                                             wlim = c(NA, NA),
                                             llim = c(NA, NA),
                                             size_axis = c("w", "l"),
                                             per_log_size = NULL, ...) {
    check_plot2_compatible(x, y, "ArrayResourceBySize")
    compare_array_metadata(x, y)
    warn_unused_resource_args(species, total, background)
    size_axis <- plot_size_axis(size_axis)
    check_per_log_size(x, per_log_size)
    assert_that(length(wlim) == 2,
                length(llim) == 2,
                length(ylim) == 2)

    params <- attr(x, "params")
    plot_dat1 <- ArrayResourceBySize_plot_data(x, wlim = wlim, llim = llim,
                                               size_axis = size_axis,
                                               per_log_size = per_log_size)
    plot_dat2 <- ArrayResourceBySize_plot_data(y, wlim = wlim, llim = llim,
                                               size_axis = size_axis,
                                               per_log_size = per_log_size)

    plotRelativeDataFrame(plot_dat1, plot_dat2, params,
                          xlab = plot_size_xlab(size_axis),
                          xtrans = if (log_x) "log10" else "identity",
                          xlim = plot_size_xlim(wlim, size_axis, llim),
                          ylim = ylim, highlight = highlight,
                          legend_var = "Legend", interpolate = TRUE)
}

#' @rdname addPlot
#' @usage NULL
#' @export
addPlot.ArrayResourceBySize <- function(plot, x, species = NULL,
                                        total = FALSE,
                                        background = TRUE,
                                        colour = NULL,
                                        linetype = "dashed",
                                        linewidth = 0.8,
                                        alpha = 1,
                                        wlim = c(NA, NA),
                                        llim = c(NA, NA),
                                        size_axis = c("w", "l"),
                                        per_log_size = NULL, ...) {
    if (!inherits(plot, "ggplot")) {
        stop("The `plot` argument must be a ggplot object.")
    }
    assert_that(is.number(linewidth),
                is.number(alpha),
                alpha >= 0,
                alpha <= 1,
                length(wlim) == 2,
                length(llim) == 2)
    warn_unused_resource_args(species, total, background)
    size_axis <- plot_size_axis(size_axis)
    check_per_log_size(x, per_log_size)

    plot <- deep_copy(plot)
    plot_dat <- ArrayResourceBySize_plot_data(x, wlim = wlim, llim = llim,
                                              size_axis = size_axis,
                                              per_log_size = per_log_size)
    x_var <- plot_size_x_var(size_axis)
    y_var <- names(plot_dat)[2]
    check_addPlot_compatible(plot, x_var = x_var, y_var = y_var,
                             units = array_units(x, size_axis, per_log_size))

    # A resource array is a single line, so there is nothing to distinguish by
    # colour. Mapping colour to the "Resource" legend level would rely on the
    # existing plot's colour scale containing that level, which it does not when
    # adding the resource to a species plot. Use a fixed colour instead.
    if (is.null(colour)) {
        params <- attr(x, "params")
        colour <- if (!is.null(params) &&
                          "Resource" %in% names(params@linecolour)) {
            params@linecolour[["Resource"]]
        } else {
            "green"
        }
    }

    mapping <- aes(x = .data[[x_var]], y = .data[[y_var]],
                   group = .data[["Species"]])
    if (is.null(linetype)) {
        mapping$linetype <- rlang::quo(.data[["Legend"]])
    }

    layer_args <- list(
        data = plot_dat,
        mapping = mapping,
        colour = colour,
        linewidth = linewidth,
        alpha = alpha,
        inherit.aes = FALSE
    )
    if (!is.null(linetype)) {
        layer_args$linetype <- linetype
    }

    plot + do.call(geom_line, layer_args)
}

#' @rdname plotHover
#' @usage NULL
#' @examples
#' \donttest{
#' plotHover(getResourceMort(NS_params))
#' }
#' @export
plotHover.ArrayResourceBySize <- function(x, ...) {
    plotHover(plot(x, ...), ...)
}

#' @export
as.data.frame.ArrayResourceBySize <- function(x, row.names = NULL,
                                              optional = FALSE, ...) {
    w <- get_ArrayResourceBySize_w(x)
    data.frame(
        w = w,
        value = as.numeric(unclass(x)),
        row.names = row.names,
        check.names = !optional,
        stringsAsFactors = FALSE
    )
}

#' Get the size grid for an ArrayResourceBySize object
#'
#' Internal helper that returns the full prey/resource size grid
#' `params@w_full`, or the numeric vector parsed from the names of `x` if no
#' `params` is attached.
#'
#' @param x An `ArrayResourceBySize` object.
#'
#' @return A numeric vector giving the size represented by each element.
#' @keywords internal
get_ArrayResourceBySize_w <- function(x) {
    params <- attr(x, "params")
    if (!is.null(params) && length(x) == length(params@w_full)) {
        return(params@w_full)
    }
    w <- as.numeric(names(x))
    if (any(is.na(w))) {
        w <- seq_along(x)
    }
    w
}

#' @export
`[.ArrayResourceBySize` <- function(x, ...) {
    result <- NextMethod()
    attr(result, "value_name") <- attr(x, "value_name")
    attr(result, "units") <- attr(x, "units")
    attr(result, "type") <- attr(x, "type")
    attr(result, "params") <- attr(x, "params")
    class(result) <- c("ArrayResourceBySize", "numeric")
    result
}

#' @export
Ops.ArrayResourceBySize <- function(e1, e2) {
    # Strip ArrayResourceBySize class so that arithmetic returns a plain vector.
    if (is.ArrayResourceBySize(e1)) e1 <- unclass_resource(e1)
    if (!missing(e2) && is.ArrayResourceBySize(e2)) e2 <- unclass_resource(e2)
    op <- match.fun(.Generic)
    if (missing(e2)) op(e1) else op(e1, e2)
}

# The plotting generics carry `species`, `total` and `background` because the
# species classes need them. A resource array holds a single spectrum, so they
# do nothing here. The methods have to declare them anyway (R CMD check requires
# a method to have all the arguments of its generic), so say when they are being
# discarded rather than doing it silently.
warn_unused_resource_args <- function(species = NULL, total = FALSE,
                                      background = TRUE) {
    unused <- c(if (!is.null(species)) "species",
                if (!isFALSE(total)) "total",
                if (!isTRUE(background)) "background")
    if (length(unused) > 0) {
        warning("The argument", if (length(unused) > 1) "s" else "", " `",
                paste(unused, collapse = "`, `"), "` ",
                if (length(unused) > 1) "are" else "is",
                " not used for resource arrays, which hold a single spectrum.")
    }
}

# Helper to strip all ArrayResourceBySize attributes
unclass_resource <- function(x) {
    x <- unclass(x)
    attr(x, "value_name") <- NULL
    attr(x, "units") <- NULL
    attr(x, "type") <- NULL
    attr(x, "params") <- NULL
    x
}

# Strip the `params` back-reference so the default str() doesn't dump the whole
# MizerParams; summarise it in a single line instead. See str.ArraySpeciesBySize.
#' @export
str.ArrayResourceBySize <- function(object, ...) {
    params <- attr(object, "params")
    attr(object, "params") <- NULL
    class(object) <- "numeric"
    out <- utils::capture.output(utils::str(object, ...))
    out[1] <- paste0(" 'ArrayResourceBySize' ", sub("^ ", "", out[1]))
    cat(paste0(out, collapse = "\n"), "\n", sep = "")
    if (!is.null(params)) {
        cat(" - attr(*, \"params\")=Formal class 'MizerParams' [package \"mizer\"] with ",
            length(slotNames(params)), " slots\n", sep = "")
    }
    invisible(NULL)
}


# ArrayTimeByResourceBySize ----------------------------------------------------

#' S3 class for time x resource-size arrays
#'
#' `r lifecycle::badge("experimental")`
#' The [NResource()] function returns a two-dimensional array (time x size)
#' holding the resource number density through time. The
#' `ArrayTimeByResourceBySize` class wraps this array to provide convenient
#' `print()`, `summary()`, `plot()`, and `as.data.frame()` methods.
#'
#' An `ArrayTimeByResourceBySize` object behaves just like a regular matrix for
#' arithmetic operations and subsetting. It carries these lightweight
#' attributes:
#' \itemize{
#'   \item `value_name` – a human-readable name for the value
#'       (e.g. "Number density").
#'   \item `units` – the units of the value (e.g. "1/g").
#'   \item `params` – the `MizerParams` object that the value was computed from.
#' }
#'
#' @param x A matrix (time x size). For `is.ArrayTimeByResourceBySize()`, any
#'   object to test.
#' @param value_name A string giving the human-readable name for the value.
#' @param units A string giving the units (e.g. "1/g").
#' @param type The kind of quantity the values are, see [ArraySpeciesBySize()]
#'   and [array_types].
#' @param params A `MizerParams` object. Used for the resource colour and the
#'   size grid in the `plot()` method.
#'
#' @return An `ArrayTimeByResourceBySize` object (inherits from `matrix` and
#'   `array`).
#' @seealso [print()], [summary()], [as.data.frame()], [plot()], [plot2()],
#'   [plotRelative()], [addPlot()], [animate()]
#' @export
#' @examples
#' \donttest{
#' nr <- NResource(NS_sim)
#' is.ArrayTimeByResourceBySize(nr)
#' summary(nr)
#' plot(nr)
#' }
ArrayTimeByResourceBySize <- function(x, value_name = NULL, units = NULL,
                                      type = NULL, params = NULL) {
    if (!is.matrix(x)) {
        stop("`x` must be a matrix.")
    }
    type <- resolve_array_type(type, value_name, units)
    structure(x,
        class = c("ArrayTimeByResourceBySize", "matrix", "array"),
        value_name = value_name,
        units = units,
        type = type,
        params = params
    )
}

#' @rdname ArrayTimeByResourceBySize
#' @return `is.ArrayTimeByResourceBySize()` returns `TRUE` if `x` is an
#'   `ArrayTimeByResourceBySize` object, `FALSE` otherwise.
#' @export
is.ArrayTimeByResourceBySize <- function(x) {
    inherits(x, "ArrayTimeByResourceBySize")
}

#' @export
print.ArrayTimeByResourceBySize <- function(x, ...) {
    value_name <- attr(x, "value_name") %||% "ArrayTimeByResourceBySize"
    units_str <- attr(x, "units")
    dims <- dim(x)
    header <- paste0(value_name, " (", dims[1], " times x ", dims[2],
                     " sizes)")
    if (!is.null(units_str) && nzchar(units_str)) {
        header <- paste0(header, " [", units_str, "]")
    }
    cat(header, "\n")

    mat <- unclass_resource(x)
    n_time <- nrow(mat)
    n_sizes <- ncol(mat)
    times <- parse_numeric_labels(rownames(mat), n_time)
    w <- parse_numeric_labels(colnames(mat), n_sizes)

    time_idx <- pick_log_spaced_indices(n_time, mizer_print_defaults$time_max,
                                        mizer_print_defaults$time_threshold)
    size_k <- fit_log_spaced_k(
        n_sizes, mizer_print_defaults$size_max, mizer_print_defaults$size_min,
        width_fn = function(k) {
            sz_idx <- pick_log_spaced_indices(n_sizes, k)
            matrix_display_width(mat[time_idx, sz_idx, drop = FALSE])
        })
    sz_idx <- pick_log_spaced_indices(n_sizes, size_k)

    print(mat[time_idx, sz_idx, drop = FALSE])

    if (length(time_idx) < n_time) {
        cat(format_truncation_note(length(time_idx), n_time, "times",
                                   format_time_range_detail(times)), "\n")
    }
    if (length(sz_idx) < n_sizes) {
        cat(format_truncation_note(length(sz_idx), n_sizes, "sizes",
                                   format_size_range_detail(w)), "\n")
    }
    invisible(x)
}

#' @export
summary.ArrayTimeByResourceBySize <- function(object, ...) {
    value_name <- attr(object, "value_name") %||% "ArrayTimeByResourceBySize"
    units_str <- attr(object, "units")
    vals <- unclass(object)

    result <- list(
        value_name = value_name,
        units = units_str,
        dims = dim(object),
        stats = data.frame(
            Min = min(vals, na.rm = TRUE),
            Mean = mean(vals, na.rm = TRUE),
            Max = max(vals, na.rm = TRUE),
            row.names = NULL
        )
    )
    class(result) <- "summary.ArrayTimeByResourceBySize"
    result
}

#' @export
print.summary.ArrayTimeByResourceBySize <- function(x, ...) {
    header <- x$value_name
    if (!is.null(x$units) && nzchar(x$units)) {
        header <- paste0(header, " [", x$units, "]")
    }
    cat(header, "\n")
    cat(x$dims[1], "times x", x$dims[2], "sizes\n\n")
    print(x$stats, row.names = FALSE)
    invisible(x)
}

#' Plot method for `ArrayTimeByResourceBySize` objects
#'
#' See [plot()] for an overview of the mizer plotting system. This method
#' plots a single time slice, by first extracting it as an
#' `ArrayResourceBySize` object and delegating to
#' [plot.ArrayResourceBySize()], which the further arguments in `...` are
#' passed on to.
#'
#' @param x An `ArrayTimeByResourceBySize` object.
#' @param time The time to display. Default (`NULL`) is the final time
#'   step.
#' @param ... Passed on to [plot.ArrayResourceBySize()].
#'
#' @return A ggplot2 object, unless `return_data = TRUE`, in which case a
#'   data frame is returned.
#' @keywords internal
#' @export
#' @examples
#' \donttest{
#' plot(NResource(NS_sim))
#' }
plot.ArrayTimeByResourceBySize <- function(x, time = NULL, ...) {
    slice <- ArrayTimeByResourceBySize_slice(x, time = time)
    plot.ArrayResourceBySize(slice, ...)
}

ArrayTimeByResourceBySize_slice <- function(x, time = NULL) {
    params <- attr(x, "params")
    value_name <- attr(x, "value_name")
    units <- attr(x, "units")

    times <- as.numeric(dimnames(x)[[1]])
    if (is.null(time)) {
        tidx <- dim(x)[1]
    } else {
        tidx <- which.min(abs(times - time))
    }

    vec <- unclass(x)[tidx, ]
    ArrayResourceBySize(vec, value_name = value_name,
                        units = units, type = attr(x, "type"),
                        params = params)
}

#' @rdname plot2
#' @usage NULL
#' @export
plot2.ArrayTimeByResourceBySize <- function(x, y, name1 = "First",
                                            name2 = "Second",
                                            species = NULL,
                                            log_x = TRUE, log_y = TRUE,
                                            log = NULL,
                                            ylim = c(NA, NA),
                                            total = FALSE, background = TRUE,
                                            highlight = NULL,
                                            y_ticks = 6,
                                            time = NULL,
                                            wlim = c(NA, NA),
                                            llim = c(NA, NA),
                                            size_axis = c("w", "l"),
                                            per_log_size = NULL, ...) {
    check_plot2_compatible(x, y, "ArrayTimeByResourceBySize")
    slice1 <- ArrayTimeByResourceBySize_slice(x, time = time)
    slice2 <- ArrayTimeByResourceBySize_slice(y, time = time)

    plot2.ArrayResourceBySize(slice1, slice2, name1 = name1, name2 = name2,
                              species = species, log_x = log_x, log_y = log_y,
                              log = log, ylim = ylim, total = total,
                              background = background, highlight = highlight,
                              y_ticks = y_ticks,
                              wlim = wlim, llim = llim, size_axis = size_axis,
                              per_log_size = per_log_size, ...)
}

#' @rdname plotRelative
#' @usage NULL
#' @export
plotRelative.ArrayTimeByResourceBySize <- function(x, y, species = NULL,
                                                   log_x = TRUE,
                                                   ylim = c(NA, NA),
                                                   total = FALSE,
                                                   background = TRUE,
                                                   highlight = NULL,
                                                   time = NULL,
                                                   wlim = c(NA, NA),
                                                   llim = c(NA, NA),
                                                   size_axis = c("w", "l"), ...) {
    check_plot2_compatible(x, y, "ArrayTimeByResourceBySize")
    slice1 <- ArrayTimeByResourceBySize_slice(x, time = time)
    slice2 <- ArrayTimeByResourceBySize_slice(y, time = time)

    plotRelative.ArrayResourceBySize(slice1, slice2, species = species,
                                     log_x = log_x, ylim = ylim, total = total,
                                     background = background,
                                     highlight = highlight, wlim = wlim,
                                     llim = llim, size_axis = size_axis, ...)
}

#' @rdname addPlot
#' @usage NULL
#' @export
addPlot.ArrayTimeByResourceBySize <- function(plot, x, species = NULL,
                                              total = FALSE,
                                              background = TRUE,
                                              colour = NULL,
                                              linetype = "dashed",
                                              linewidth = 0.8,
                                              alpha = 1,
                                              time = NULL,
                                              wlim = c(NA, NA),
                                              llim = c(NA, NA),
                                              size_axis = c("w", "l"),
                                              per_log_size = NULL, ...) {
    slice <- ArrayTimeByResourceBySize_slice(x, time = time)
    addPlot.ArrayResourceBySize(plot, slice, species = species, total = total,
                                background = background, colour = colour,
                                linetype = linetype, linewidth = linewidth,
                                alpha = alpha, wlim = wlim, llim = llim,
                                size_axis = size_axis,
                                per_log_size = per_log_size, ...)
}

#' @rdname animate
#' @usage NULL
#' @export
animate.ArrayTimeByResourceBySize <- function(x, species = NULL,
                                              log_x = TRUE,
                                              log_y = TRUE,
                                              log = NULL,
                                              wlim = c(NA, NA),
                                              llim = c(NA, NA),
                                              ylim = c(NA, NA),
                                              tlim = c(NA, NA),
                                              size_axis = c("w", "l"),
                                              per_log_size = NULL,
                                              total = FALSE,
                                              background = TRUE,
                                              frame_duration = 500,
                                              transition_duration = frame_duration,
                                              easing = "linear",
                                              ...) {
    assert_that(is.number(frame_duration), frame_duration >= 0,
                is.number(transition_duration), transition_duration >= 0,
                is.string(easing),
                length(wlim) == 2, length(llim) == 2, length(ylim) == 2,
                length(tlim) == 2)
    warn_unused_resource_args(species, total, background)
    check_per_log_size(x, per_log_size)
    size_axis <- plot_size_axis(size_axis)
    log_y <- array_log_y(x, log_y, log, !missing(log_y))
    log_axes <- parsePlotLog(log, log_x = log_x, log_y = log_y)
    log_x <- log_axes$log_x
    log_y <- log_axes$log_y

    params <- attr(x, "params")

    times <- as.numeric(dimnames(x)[[1]])
    arr <- unclass(x)
    if (!is.na(tlim[1])) {
        arr <- arr[times >= tlim[1], , drop = FALSE]
        times <- times[times >= tlim[1]]
    }
    if (!is.na(tlim[2])) {
        arr <- arr[times <= tlim[2], , drop = FALSE]
        times <- times[times <= tlim[2]]
    }

    # Any time slice has the same size grid, so take one to reuse the
    # size-grid lookup of the resource class.
    w <- get_ArrayResourceBySize_w(ArrayTimeByResourceBySize_slice(x))

    # Time varies fastest, to match c(arr)
    df <- expand.grid(time = times, w = w, stringsAsFactors = FALSE)
    df$value <- c(arr)
    df$Species <- "Resource"
    df$legend_name <- "Resource"

    # The label has to know the size axis: on a length axis a density per gram
    # is restated per centimetre, and the units must say so.
    y_label <- array_y_label(x, default = "Value", size_axis = size_axis,
                             per_log_size = per_log_size)

    animate_plotly(df, params, log_x, log_y, y_label, wlim, llim, ylim,
                   size_axis = size_axis,
                   density_wrt = array_density_wrt(x),
                   per_log_size = per_log_size,
                   type = array_type(x),
                   frame_duration = frame_duration,
                   transition_duration = transition_duration,
                   easing = easing)
}

#' @rdname plotHover
#' @usage NULL
#' @examples
#' \donttest{
#' plotHover(NResource(NS_sim))
#' }
#' @export
plotHover.ArrayTimeByResourceBySize <- function(x, ...) {
    plotHover(plot(x, ...), ...)
}

#' @export
as.data.frame.ArrayTimeByResourceBySize <- function(x, row.names = NULL,
                                                    optional = FALSE, ...) {
    times <- as.numeric(dimnames(x)[[1]])
    if (any(is.na(times))) times <- seq_len(dim(x)[1])
    w <- as.numeric(dimnames(x)[[2]])
    if (any(is.na(w))) w <- seq_len(dim(x)[2])

    data.frame(
        expand.grid(time = times, w = w, stringsAsFactors = FALSE),
        value = c(unclass(x)),
        row.names = row.names,
        check.names = !optional
    )
}

#' @export
`[.ArrayTimeByResourceBySize` <- function(x, i, j, ..., drop = TRUE) {
    result <- NextMethod()
    if (is.matrix(result) && length(dim(result)) == 2) {
        attr(result, "value_name") <- attr(x, "value_name")
        attr(result, "units") <- attr(x, "units")
        attr(result, "type") <- attr(x, "type")
        attr(result, "params") <- attr(x, "params")
        class(result) <- c("ArrayTimeByResourceBySize", "matrix", "array")
    } else if (is.null(dim(result)) && !is.null(names(result)) &&
                   identical(names(result), colnames(x))) {
        # A single time step was selected, leaving a resource size spectrum.
        result <- ArrayResourceBySize(result,
                                      value_name = attr(x, "value_name"),
                                      units = attr(x, "units"),
                                      type = attr(x, "type"),
                                      params = attr(x, "params"))
    }
    result
}

#' @export
Ops.ArrayTimeByResourceBySize <- function(e1, e2) {
    if (is.ArrayTimeByResourceBySize(e1)) e1 <- unclass_resource(e1)
    if (!missing(e2) && is.ArrayTimeByResourceBySize(e2)) {
        e2 <- unclass_resource(e2)
    }
    op <- match.fun(.Generic)
    if (missing(e2)) op(e1) else op(e1, e2)
}

# Strip the `params` back-reference so the default str() doesn't dump the whole
# MizerParams; summarise it in a single line instead. See str.ArraySpeciesBySize.
#' @export
str.ArrayTimeByResourceBySize <- function(object, ...) {
    params <- attr(object, "params")
    attr(object, "params") <- NULL
    class(object) <- c("matrix", "array")
    out <- utils::capture.output(utils::str(object, ...))
    out[1] <- paste0(" 'ArrayTimeByResourceBySize' ", sub("^ ", "", out[1]))
    cat(paste0(out, collapse = "\n"), "\n", sep = "")
    if (!is.null(params)) {
        cat(" - attr(*, \"params\")=Formal class 'MizerParams' [package \"mizer\"] with ",
            length(slotNames(params)), " slots\n", sep = "")
    }
    invisible(NULL)
}