R/vp.R

In bioRad: Biological Analysis and Visualization of Weather Radar Data

#' Inspect a vertical profile (`vp`)
#'
#' R base functions for inspecting a vertical profile of biological targets
#' (`vp`) object.
#'
#' @param object A `vp` object.
#' @param ... Additional arguments affecting the summary produced.
#'
#' @method summary vp
#'
#' @export
#'
#' @details
#' A vertical profile of biological targets contains a collection of quantities,
#' organized in different (typically equally spaced) altitude layers (height
#' bins) above the earth's surface. A vertical profile (`vp`) object is a list
#' containing:
#' * `radar`: Radar identifier.
#' * `datetime`: Nominal time of the volume to which the scan belongs in UTC.
#' * `data`: A data.frame with the profile's quantities organized per height
#' bin. Use [get_quantity()] to access these:
#'   * `height`: Height bin (lower bound) in m above sea level.
#'   * `u`: Ground speed component west to east in m/s.
#'   * `v`: Ground speed component south to north in m/s.
#'   * `w`: Vertical speed (unreliable!) in m/s.
#'   * `ff`: Horizontal ground speed in m/s.
#'   * `dd`: Ground speed direction in degrees clockwise from north.
#'   * `sd_vvp`: VVP radial velocity standard deviation in m/s.
#'   * `gap`: Angular data gap detected in T/F.
#'   * `dbz`: Animal reflectivity factor in dBZ.
#'   * `eta`: Animal reflectivity in cm^2/km^3.
#'   * `dens`: Animal density in animals/km^3.
#'   * `DBZH`: Total reflectivity factor (bio + meteo scattering) in dBZ.
#'   * `n`: Number of data points used for the ground speed estimates
#'   (quantities `u`, `v`, `w`, `ff`, `dd`).
#'   * `n_all`: Number of data points used for the radial velocity standard
#'   deviation estimate (quantity `sd_vvp`).
#'   * `n_dbz`: Number of data points used for reflectivity-based estimates
#'   (quantities `dbz`, `eta`, `dens`).
#'   * `n_dbz_all`: Number of data points used for the total reflectivity
#'   estimate (quantity `DBZH`).
#' * `attributes`: List of the vertical profile's `what`, `where` and `how`
#' attributes.
#'
#' @section Conventions:
#' * `NA`: Maps to `nodata` in the ODIM convention: value to denote areas void
#' of data (never radiated).
#' * `NaN`: Maps to `undetect` in the ODIM convention: denote areas below the
#' measurement detection threshold (radiated but nothing detected). The value is
#' also used when there are too few datapoints to calculate a quantity.
#' * `0`: Maps to `0` in the ODIM convention: denote areas where the quantity
#' has a measured value of zero (radiated and value zero detected or inferred).
#'
#' It depends on a radar's detection threshold or signal to noise ratio whether
#' it safe to assume an `undetect` is equivalent to zero. When dealing with
#' close range data only (within 35 km), it is typically safe to assume aerial
#' densities (`dens`) and reflectivities (`eta`) are in fact zero in case of
#' undetects.
#'
#' @seealso
#' * [calculate_vp()]
#' * [read_vpfiles()]
#' * [`example_vp`]
#' * [get_quantity()]
#' * [plot.vp()]
#' * [as.data.frame.vp()]
#' * [bind_into_vpts()]
#'
#' @return For [summary.vp()]: prints summary of the `vp` object.
#'
#' @examples
#' # Check if an object is of class vp
#' is.vp(example_vp)
#'
#' # Get summary info
#' example_vp # Same as summary(example_vp) or print(example_vp)
#'
#' # Get dimensions
#' dim(example_vp)
summary.vp <- function(object, ...) {
  print.vp(object)
}

#' Print summary for an object of class `vp`
#'
#' @noRd
#'
#' @export
print.vp <- function(x, digits = max(3L, getOption("digits") - 3L), ...) {
  stopifnot(inherits(x, "vp"))
  if (is.null(x$data[["height"]])) {
    warning(glue::glue("`x` is a legacy `vp` object without a column `height`. ",
            "Use convert_legacy() to avoid errors."))
    x <- convert_legacy(x)
  }
  cat("               Vertical profile (class vp)\n\n")
  cat("       radar: ", x$radar, "\n")
  cat("      source: ", x$attributes$what$source, "\n")
  cat("nominal time: ", as.character(x$datetime), "\n")
  cat("generated by: ", paste(
    x$attributes$how$task,
    x$attributes$how$task_version
  ), "\n")
}

#' Check if an object is of class `vp`
#'
#' @param x A `vp` object.
#'
#' @return For [is.vp()]: `TRUE` for an object of class `vp`, otherwise
#'   `FALSE`.
#'
#' @rdname summary.vp
#'
#' @export
is.vp <- function(x) {
  inherits(x, "vp")
}

#' Get dimensions for an object of class `vp`
#'
#' @return For [dim.vp()]: number of heights and quantities in a vertical
#'   profile (`vp`).
#'
#' @rdname summary.vp
#'
#' @export
dim.vp <- function(x) {
  stopifnot(inherits(x, "vp"))
  dim(x$data)
}

#' Concatenate vertical profiles (`vp`) into a list of vertical profiles
#'
#' Concatenates vertical profiles (`vp`) into a list of vertical profiles
#' (`c(vp, vp, vp)`) and warns if they are not from a single radar.
#'
#' @param ... `vp` objects.
#'
#' @return A list of `vp` objects.
#'
#' @export
#'
#' @examples
#' # concatenate vp objects into a list:
#' c(example_vp, example_vp)
#'
#' @seealso [bind_into_vpts()]
c.vp <- function(...) {
  vp_list <- list(...)
  is_vp <- sapply(vp_list, function(x) methods::is(x, "vp"))
  assertthat::assert_that(all(is_vp), msg = "Each element must be a `vp` object.")
  # extract radar identifiers
  radars <- unique(sapply(vp_list, "[[", "radar"))
  if (length(radars) > 1) {
    warning("Vertical profiles are not from a single radar.")
  }
  class(vp_list) <- c("list")
  vp_list
}