Merge branch 'develop' of https://github.com/adokter/bioRad into develop

NAMESPACE

@@ -26,6 +26,7 @@ S3method(check_night,vpts)
 S3method(convert_legacy,vp)
 S3method(convert_legacy,vpts)
 S3method(dim,ppi)
+S3method(dim,pvol)
 S3method(dim,scan)
 S3method(dim,vp)
 S3method(dim,vpts)

R/as.data.frame.R

@@ -0,0 +1,240 @@
+#' Convert a vertical profile (\code{vp}) to a Data Frame
+#'
+#' Converts a vertical profile to a Data Frame, and optionally adds information
+#' on sunrise/sunset, day/night and derived quantities like migration
+#' traffic rates.
+#'
+#' @param x An object of class \code{vp}.
+#' @param row.names \code{NULL} or a character vector giving the row names for
+#' the data frame. Missing values are not allowed. See [base::as.data.frame()].
+#' @param optional If \code{FALSE} then the names of the variables in the data
+#' frame are checked to ensure that they are syntactically valid variable names
+#' and are not duplicated.
+#' @param quantities An optional character vector with the names of the
+#' quantities to include as columns in the data frame.
+#' @param elev Sun elevation in degrees, see \link{sunrise}/\link{sunset}.
+#' @param lat Radar latitude in decimal degrees. When set, overrides the
+#' latitude stored in \code{x} in \link{sunrise}/\link{sunset} calculations
+#' @param lon Radar longitude in decimal degrees. When set, overrides the
+#' longitude stored in \code{x} in \link{sunrise}/\link{sunset} calculations.
+#' @param suntime Logical, when \code{TRUE}, adds sunrise/sunset and day/night
+#' information to each row.
+#' @param geo Logical, when \code{TRUE}, adds latitude, longitude and antenna
+#' height of the radar to each row.
+#' @param ... Additional arguments to be passed to or from methods.
+#'
+#' @return An object of class \code{data.frame}.
+#'
+#' @export
+#'
+#' @details
+#' Note that only the "dens" quantity is thresholded for radial velocity
+#' standard deviation by \link{sd_vvp_threshold}. Note that this is different from the
+#' default \link{plot.vp}, \link{plot.vpts} and \link{get_quantity.vp}
+#' functions, where quantities "eta", "dbz", "ff", "u", "v", "w", "dd" are
+#' all thresholded by \link{sd_vvp_threshold}
+#'
+#' @examples
+#' # Load the example vertical profile
+#' vp <- example_vp
+#'
+#' # Convert to a data.frame
+#' vp_df <- as.data.frame(vp)
+#'
+#' # Print data.frame
+#' vp_df
+#'
+#' # Do not compute sunrise/sunset information
+#' vp_df <- as.data.frame(vp, suntime = FALSE)
+#'
+#' # Override the latitude/longitude information stored in the object when
+#' # calculating sunrise/sunset information
+#' vp_df <- as.data.frame(vp, suntime = TRUE, lat = 50, lon = 4)
+as.data.frame.vp <- function(x, row.names = NULL, optional = FALSE,
+                             quantities = names(x$data), suntime = TRUE,
+                             geo = TRUE, elev = -0.268, lat = NULL,
+                             lon = NULL, ...) {
+  stopifnot(inherits(x, "vp"))
+  if (!is.null(row.names)) {
+    if (is.character(row.names) & length(row.names) ==
+        length(x$datetime) * length(x$height)) {
+      rownames(output) <- row.names
+    } else {
+      stop(paste(
+        "`row.names` is not a character vector of length",
+        length(x$datetime) * length(x$height)
+      ))
+    }
+  }
+  if (is.null(lat)) {
+    lat <- x$attributes$where$lat
+  }
+  if (is.null(lon)) {
+    lon <- x$attributes$where$lon
+  }
+  missing <- which(!(quantities %in% names(x$data)))
+  if (length(missing) > 0) {
+    stop(paste(
+      paste(quantities[missing], collapse = " "),
+      "not an available quantity, select one or more of",
+      paste(names(x$data), collapse = ",")
+    ))
+  }
+  # coerce data to a data frame
+  output <- as.data.frame(x$data, optional = optional, ...)
+  # add height and datetime as a column
+  output <- cbind(datetime = x$datetime, height = output$height, output)
+  output$height <- NULL
+  # add radar name
+  output <- cbind(radar = x$radar, output, stringsAsFactors = FALSE)
+  # add location information
+  if (geo) {
+    output$lat <- lat
+    output$lon <- lon
+    output$height_antenna <- x$attributes$where$height
+  }
+  # override the lat,lon attributes in case of user-provided values
+  x$attributes$where$lat <- lat
+  x$attributes$where$lon <- lon
+  # add day
+  if (suntime) {
+    dayQ <- !check_night(x, elev = elev)
+    dayQ <- c(t(replicate(nrow(x), dayQ)))
+    output <- cbind(output, day = dayQ)
+    sunrise <- sunrise(x$datetime, lat = lat, lon = lon)
+    sunset <- sunset(x$datetime, lat = lat, lon = lon)
+    output$sunrise <- as.POSIXct(
+      c(t(replicate(nrow(x), sunrise))),
+      origin = "1970-1-1", tz = "UTC"
+    )
+    output$sunset <- as.POSIXct(
+      c(t(replicate(nrow(x), sunset))),
+      origin = "1970-1-1", tz = "UTC"
+    )
+  }
+  output
+}
+
+#' Convert a time series of vertical profiles (\code{vpts}) to a data frame
+#'
+#' Converts vertical profile time series (objects of class \code{vpts}) to a
+#' data Frame, and optionally adds information on sunrise/sunset, day/night
+#' and derived quantities like migration traffic rates.
+#'
+#' @param x An object of class \code{vpts}.
+#' @param row.names \code{NULL} or a character vector giving the row names for
+#' the data frame. Missing values are not allowed.
+#' @param optional If \code{FALSE} then the names of the variables in the data
+#' frame are checked to ensure that they are syntactically valid variable names
+#' and are not duplicated.
+#' @param quantities An optional character vector with the names of the
+#' quantities to include as columns in the data frame.
+#' @param elev Sun elevation in degrees, see \link{sunrise}/\link{sunset}.
+#' @param lat Radar latitude in decimal degrees. When set, overrides the
+#' latitude stored in \code{x} in \link{sunrise}/\link{sunset} calculations.
+#' @param lon Radar longitude in decimal degrees. When set, overrides the
+#' longitude stored in \code{x} in \link{sunrise}/\link{sunset} calculations.
+#' @param suntime Logical, when TRUE, adds sunrise/sunset and day/night
+#' information to each row.
+#' @param geo Logical, when TRUE, adds latitude, longitude and antenna height
+#' of the radar to each row.
+#' @param ... Additional arguments to be passed to or from methods.
+#'
+#' @return An object of class data.frame.
+#'
+#' @export
+#'
+#' @details
+#' Note that only the 'dens' quantity is thresholded for radial velocity
+#' standard deviation by \link{sd_vvp_threshold}. Note that this is different from the
+#' default \link{plot.vp}, \link{plot.vpts} and \link{get_quantity.vp}
+#' functions, where quantities "eta", "dbz", "ff", "u", "v", "w", "dd" are all
+#' thresholded by \link{sd_vvp_threshold}.
+#'
+#' @examples
+#' # Load the example time series of vertical profiles
+#' vpts <- example_vpts
+#'
+#' # Convert to a data.frame
+#' vpts_df <- as.data.frame(vpts)
+#'
+#' # Print the first 10 rows of the data.frame
+#' vpts_df[1:10, ]
+#'
+#' # Do not compute sunrise/sunset information
+#' vpts_df <- as.data.frame(vpts, suntime = FALSE)
+#'
+#' # Override the latitude/longitude information stored in the object when
+#' # calculating sunrise/sunset information
+#' vpts_df <- as.data.frame(vpts, suntime = TRUE, lat = 50, lon = 4)
+as.data.frame.vpts <- function(x, row.names = NULL, optional = FALSE,
+                               quantities = names(x$data), suntime = TRUE,
+                               geo = TRUE, elev = -0.268, lat = NULL,
+                               lon = NULL, ...) {
+  stopifnot(inherits(x, "vpts"))
+  if (!is.null(row.names)) {
+    if (is.character(row.names) & length(row.names) ==
+        length(x$datetime) * length(x$height)) {
+      rownames(output) <- row.names
+    } else {
+      stop(paste(
+        "'row.names' is not a character vector of length",
+        length(x$datetime) * length(x$height)
+      ))
+    }
+  }
+  if (is.null(lat)) {
+    lat <- x$attributes$where$lat
+  }
+  if (is.null(lon)) {
+    lon <- x$attributes$where$lon
+  }
+  missing <- which(!(quantities %in% names(x$data)))
+  if (length(missing) > 0) {
+    stop(paste(
+      paste(quantities[missing], collapse = " "),
+      "not an available quantity, select one or more of",
+      paste(names(x$data), collapse = ",")
+    ))
+  }
+  # coerce data to a data frame
+  output <- as.data.frame(lapply(x$data[quantities], c),
+                          optional = optional, ...
+  )
+  # add height and datetime as a column
+  output <- cbind(
+    datetime = as.POSIXct(
+      c(t(replicate(length(x$height), x$datetime))),
+      origin = "1970-1-1", tz = "UTC"
+    ),
+    height = rep(x$height, length(x$datetime)), output
+  )
+  # add radar name
+  output <- cbind(radar = x$radar, output, stringsAsFactors = FALSE)
+  # add location information
+  if (geo) {
+    output$lat <- lat
+    output$lon <- lon
+    output$height_antenna <- x$attributes$where$height
+  }
+  # override the lat,lon attributes in case of user-provided values
+  x$attributes$where$lat <- lat
+  x$attributes$where$lon <- lon
+  # add day
+  if (suntime) {
+    dayQ <- !check_night(x, elev = elev)
+    dayQ <- c(t(replicate(length(x$height), dayQ)))
+    output <- cbind(output, day = dayQ)
+    sunrise <- sunrise(x$datetime, lat = lat, lon = lon)
+    sunset <- sunset(x$datetime, lat = lat, lon = lon)
+    output$sunrise <- as.POSIXct(
+      c(t(replicate(length(x$height), sunrise))),
+      origin = "1970-1-1", tz = "UTC"
+    )
+    output$sunset <- as.POSIXct(
+      c(t(replicate(length(x$height), sunset))),
+      origin = "1970-1-1", tz = "UTC"
+    )
+  }
+  output
+}

R/convert_legacy.R

@@ -1,19 +1,19 @@
 #' Convert legacy bioRad objects to current version
 #'
-#' Convert legacy bioRad objects (vp, vpts) that have become
-#' obsolete and make them compatible with the current bioRad version.
+#' Convert legacy bioRad objects (`vp`, `vpts`) that have become obsolete
+#' compatible with the current bioRad version.
 #'
-#' @param x A `vp`, or `vpts` object.
+#' @param x A `vp` or `vpts` object.
 #'
 #' @return An updated object of the same class as the input.
 #'
 #' @export
 #'
 #' @examples
-#' # convert a vp object:
+#' # Convert a vp object
 #' convert_legacy(example_vp)
 #'
-#' # convert a vpts object:
+#' # Convert a vpts object
 #' convert_legacy(example_vpts)
 convert_legacy <- function(x) {
   UseMethod("convert_legacy", x)
@@ -24,7 +24,7 @@ convert_legacy <- function(x) {
 #' @export
 convert_legacy.vp <- function(x) {
   assert_that(inherits(x, "vp"))
-  names(x$data)=sub("HGHT","height",names(x$data))
+  names(x$data) <- sub("HGHT", "height", names(x$data))
   x
 }
 
@@ -33,7 +33,7 @@ convert_legacy.vp <- function(x) {
 #' @export
 convert_legacy.vpts <- function(x) {
   assert_that(inherits(x, "vpts"))
-  names(x)=sub("heights","height",names(x))
-  names(x)=sub("dates","datetime",names(x))
+  names(x) <- sub("heights", "height", names(x))
+  names(x) <- sub("dates", "datetime", names(x))
   x
 }

R/data.R

@@ -1,64 +1,69 @@
-#' Example object of class \code{vp}
+#' Scan (`scan`) example
 #'
-#' Example of a \code{\link[=summary.vp]{vp}} object with name
-#' \code{example_vp}. Can be created with \code{\link{calculate_vp}} or read
-#' from file with \code{\link{read_vpfiles}}.
+#' Example object of class [`scan`][summary.scan()] with name `example_scan`.
 #'
-#' @rdname example_vp
+#' @rdname example_scan
 #'
 #' @examples
-#' # get summary of example vp:
-#' summary(example_vp)
+#' # Reload example_scan from package (e.g. in case it was altered)
+#' data(example_scan)
 #'
-#' # example_vp was created with:
-#' vpfile <- system.file("extdata", "profile.h5", package = "bioRad")
-#' example_vp <- read_vpfiles(vpfile)
+#' # Get summary info
+#' example_scan
+#'
+#' # example_scan was created with
 #' \dontrun{
-#' # save(example_vp, file = "data/example_vp.rda")
+#' pvolfile <- system.file("extdata", "volume.h5", package = "bioRad")
+#' pvol <- read_pvolfile(pvolfile)
+#' example_scan <- pvol$scans[[1]]
+#' save(example_scan, file = "data/example_scan.rda")
 #' }
-"example_vp"
+"example_scan"
 
-#' Example object of class \code{scan}
+#' Vertical profile (`vp`) example
 #'
-#' Example of a \code{\link[=summary.scan]{scan}} object with name
-#' \code{example_scan}.
+#' Example object of class [`vp`][summary.vp()] with name `example_vp`.
 #'
-#' @rdname example_scan
+#' @rdname example_vp
 #'
 #' @examples
-#' # get summary of example scan:
-#' summary(example_scan)
+#' # Reload example_vp from package (e.g. in case it was altered)
+#' data(example_vp)
 #'
-#' # example_scan was created with:
-#' pvolfile <- system.file("extdata", "volume.h5", package = "bioRad")
-#' pvol <- read_pvolfile(pvolfile)
-#' example_scan <- pvol$scans[[1]]
+#' # Get summary info
+#' example_vp
+#'
+#' # example_vp was created with
 #' \dontrun{
-#' # save(example_scan, file = "data/example_scan.rda")
+#' vpfile <- system.file("extdata", "profile.h5", package = "bioRad")
+#' example_vp <- read_vpfiles(vpfile)
+#' save(example_vp, file = "data/example_vp.rda")
 #' }
-"example_scan"
+"example_vp"
 
-#' Example object of class \code{vpts}
+#' Time series of vertical profiles (`vpts`) example
 #'
-#' Example of a \code{\link[=summary.vpts]{vpts}} object (a time series of
-#' vertical profiles) with name \code{example_vpts}.
+#' Example object of class [`vpts`][summary.vpts()] with name `example_vpts`.
 #'
 #' @rdname example_vpts
 #'
 #' @examples
-#' # get summary of example vpts:
-#' summary(example_vpts)
+#' # Reload example_vpts from package (e.g. in case it was altered)
+#' data(example_vpts)
+#'
+#' # Get summary info
+#' example_vpts
 #'
-#' # example_vpts was created with:
+#' # example_vpts was created with
 #' \dontrun{
 #' vptsfile <- system.file("extdata", "vpts.txt.zip", package = "bioRad")
-#' unzip(vptsfile, exdir = (dirname(vptsfile)), junkpaths = T)
+#' unzip(vptsfile, exdir = (dirname(vptsfile)), junkpaths = TRUE)
 #' vptsfile <- substr(vptsfile, 1, nchar(vptsfile) - 4)
 #' example_vpts <- read_vpts(vptsfile, radar = "KBGM", wavelength = "S")
 #' rcs(example_vpts) <- 11
 #' sd_vvp_threshold(example_vpts) <- 2
 #' example_vpts$attributes$where$lat <- 42.2
 #' example_vpts$attributes$where$lon <- -75.98
-#' # save(example_vpts, file = "data/example_vpts.rda", compress = "xz")
+#' save(example_vpts, file = "data/example_vpts.rda", compress = "xz")
 #' }
 "example_vpts"