Nothing
# vim:textwidth=80:expandtab:shiftwidth=4:softtabstop=4
#' Class to Store Lowered-adp Data
#'
#' This class stores data measured with a lowered ADP (also
#' known as ADCP) device.
#'
#' @templateVar class ladp
#'
#' @templateVar dataExample {}
#'
#' @templateVar metadataExample {}
#'
#' @template slot_summary
#'
#' @template slot_put
#'
#' @template slot_get
#'
#' @author Dan Kelley
#'
#' @family things related to ladp data
setClass("ladp", contains = "oce")
setMethod(
f = "initialize",
signature = "ladp",
definition = function(.Object, longitude, latitude, station, waterDepth, time, pressure, u, v, uz, vz, salinity, temperature, ...) {
.Object <- callNextMethod(.Object, ...)
# Assign to some columns so they exist if needed later (even if they are NULL)
.Object@metadata$longitude <- if (missing(longitude)) "?" else longitude
.Object@metadata$latitude <- if (missing(latitude)) "?" else latitude
.Object@metadata$station <- if (missing(station)) "?" else station
.Object@metadata$waterDepth <- if (missing(waterDepth)) NA else waterDepth
.Object@metadata$time <- if (missing(time)) NULL else time
.Object@data$pressure <- if (missing(pressure)) NULL else pressure
.Object@data$u <- if (missing(u)) NULL else u
.Object@data$v <- if (missing(v)) NULL else v
.Object@data$uz <- if (missing(uz)) NULL else uz
.Object@data$vz <- if (missing(vz)) NULL else vz
.Object@data$salinity <- if (missing(salinity)) NULL else salinity
.Object@data$temperature <- if (missing(temperature)) NULL else temperature
dots <- list(...)
dotsNames <- names(dots)
for (i in seq_along(dots)) {
# message("extra column named: ", dotsNames[i])
.Object@data[dotsNames[i]] <- dots[i]
}
.Object@processingLog$time <- presentTime()
.Object@processingLog$value <- "create 'ladp' object"
return(.Object)
}
)
#' Summarize an ladp Object
#'
#' Pertinent summary information is presented, including the station name,
#' sampling location, data ranges, etc.
#'
#' @param object an [ladp-class] object.
#'
#' @param ... Further arguments passed to or from other methods.
#'
#' @return A matrix containing statistics of the elements of the `data` slot.
#'
#' @author Dan Kelley
#'
#' @family things related to ladp data
setMethod(
f = "summary",
signature = "ladp",
definition = function(object, ...) {
cat("LADP Summary\n------------\n\n")
showMetadataItem(object, "station", "Station: ")
invisible(callNextMethod()) # summary
}
)
#' Extract Something From an ladp Object
#'
#' @param x an [ladp-class] object.
#'
#' @section Details of the Specialized Method:
#'
#' If `i` is `"?"`, then the return value is a list containing four items, each
#' of which is a character vector holding the names of things that can be
#' accessed with `[[`. The `data` and `metadata` items hold the names of entries
#' in the object's data and metadata slots, respectively. The `metadataDerived`
#' item is NULL, and the `dataDerived` item holds the following synonyms: `"p"`
#' for `"pressure"`, `"t"` for `"temperature"` and `"S"` for `"salinity"`.
#'
#' @template sub_subTemplate
#'
#' @family things related to ladp data
#'
#' @author Dan Kelley
setMethod(
f = "[[",
signature(x = "ladp", i = "ANY", j = "ANY"),
definition = function(x, i, j, ...) {
dataDerived <- c("p", "t", "S")
if (i == "?") {
return(list(
metadata = sort(names(x@metadata)),
metadataDerived = NULL,
data = sort(names(x@data)),
dataDerived = sort(dataDerived)
))
}
if (i == "p") {
return(x@data$pressure)
}
if (i == "t") {
return(x@data$temperature)
}
if (i == "S") {
return(x@data$salinity)
}
callNextMethod() # [[
}
)
#' Replace Parts of an ladp Object
#'
#' @param x an [ladp-class] object.
#'
#' @template sub_subsetTemplate
#'
#' @family things related to ladp data
setMethod(
f = "[[<-",
signature(x = "ladp", i = "ANY", j = "ANY"),
definition = function(x, i, j, ..., value) {
callNextMethod(x = x, i = i, j = j, ..., value = value) # [[<-
}
)
#' Plot an ladp Object
#'
#' Uses [plotProfile()] to create panels of depth variation of easterly
#' and northerly velocity components.
#'
#' @param x an [ladp-class] object.
#' @param which a character vector storing names of items to be plotted.
#' @param ... Other arguments, passed to plotting functions.
#'
#' @family things related to ladp data
#' @family functions that plot oce data
#'
#' @aliases plot.ladp
#'
#' @author Dan Kelley
setMethod(
f = "plot",
signature = signature("ladp"),
definition = function(x, which = c("u", "v"), ...) {
par(mfrow = c(1, length(which)))
for (w in which) {
plotProfile(x, xtype = w, ...)
}
}
)
fixColumn <- function(x) {
x[!is.finite(x)] <- NA
as.vector(x)
}
#' Coerce Data Into an ladp object
#'
#' This function assembles vectors of pressure and velocity, possibly also with
#' shears, salinity, temperature, etc.
#'
#' @param longitude longitude in degrees east, or an `oce` object that
#' contains the data otherwise given by `longitude` and the
#' other arguments.
#'
#' @param latitude latitude in degrees east (use negative in southern hemisphere).
#'
#' @param station number or string indicating station ID.
#'
#' @param time time at the start of the profile, constructed by e.g. [as.POSIXct()].
#'
#' @param pressure pressure in decibars, through the water column.
#'
#' @param u eastward velocity (m/s).
#'
#' @param v northward velocity (m/s).
#'
#' @param uz vertical derivative of eastward velocity (1/s).
#'
#' @param vz vertical derivative of northward velocity (1/s).
#'
#' @param salinity salinity through the water column, in practical salinity units.
#'
#' @param temperature temperature through the water column.
#'
#' @param \dots optional additional data columns.
#'
#' @return An [ladp-class] object.
#'
#' @family things related to ladp data
#'
#' @author Dan Kelley
as.ladp <- function(longitude, latitude, station, time, pressure, u, v, uz, vz, salinity, temperature, ...) {
if (inherits(longitude, "oce")) {
x <- longitude
longitude <- x[["longitude"]]
latitude <- x[["latitude"]]
station <- x[["station"]]
time <- x[["time"]]
# try hard to get pressure
pressure <- x[["pressure"]]
if (is.null(pressure)) {
z <- x[["z"]]
if (is.null(z)) {
depth <- x[["depth"]]
if (is.null(depth)) {
stop("parent object lacks pressure, depth, and z")
}
pressure <- abs(depth)
} else {
pressure <- abs(z)
}
}
u <- x[["u"]]
if (is.null(u)) {
stop("parent object lacks u")
}
v <- x[["v"]]
if (is.null(v)) {
stop("parent object lacks v")
}
uz <- x[["uz"]]
vz <- x[["vz"]]
salinity <- x[["salinity"]]
temperature <- x[["temperature"]]
} else if (is.data.frame(longitude) || is.list(longitude)) {
x <- longitude
names <- names(x)
longitude <- x$longitude[1]
latitude <- x$latitude[1]
station <- x$station[1]
time <- x$time
pressure <- x$pressure
if (is.null(pressure)) {
stop("parent object lacks pressure")
}
u <- x$u
if (is.null(u)) {
stop("parent object lacks u")
}
v <- x$v
if (is.null(v)) {
stop("parent object lacks v")
}
uz <- if ("uz" %in% names) x$uz else NULL
vz <- if ("vz" %in% names) x$vz else NULL
salinity <- if ("salinity" %in% names) x$salinity else NULL
temperature <- if ("temperature" %in% names) x$temperature else NULL
} else {
if (missing(longitude)) {
stop("must supply longitude")
}
if (missing(latitude)) {
stop("must supply latitude")
}
if (missing(station)) station <- "?"
if (missing(time)) time <- NULL
if (missing(pressure)) {
stop("must supply pressure")
}
if (missing(u)) {
stop("must supply u")
} else {
u <- fixColumn(u)
}
if (missing(v)) {
stop("must supply v")
} else {
v <- fixColumn(v)
}
uz <- if (missing(uz)) NULL else fixColumn(uz)
vz <- if (missing(vz)) NULL else fixColumn(vz)
salinity <- if (missing(salinity)) NULL else fixColumn(salinity)
temperature <- if (missing(temperature)) NULL else fixColumn(temperature)
}
res <- new("ladp",
longitude = longitude, latitude = latitude, station = station, time = time,
pressure = pressure, u = u, v = v, uz = uz, vz = vz, salinity = salinity, temperature = temperature, ...
)
res@metadata$waterDepth <- max(pressure, na.rm = TRUE)
res
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.