Merge branch 'master' into vol_coverage

NAMESPACE

@@ -15,6 +15,7 @@ S3method(bind_into_vpts,list)
 S3method(bind_into_vpts,vp)
 S3method(bind_into_vpts,vpts)
 S3method(c,vp)
+S3method(calculate_param,ppi)
 S3method(calculate_param,pvol)
 S3method(calculate_param,scan)
 S3method(check_night,default)

NEWS.md

@@ -1,8 +1,9 @@
 # bioRad 0.5.2.9XXX
 
-
 * adding `attribute_table()` to quickly tabulate scan attributes
 
+* `calculate_param()` now also works on ppi's (#316)
+
 * Speed up `integrate_to_ppi` and other functions by avoiding duplicate input argument checking (#358)
 
 * Warn when multiple scans with the same elevation are equally close to the requested elevation in `get_scan()`, and add option to return all (#414)

R/calculate_param.R

@@ -14,6 +14,7 @@
 #'
 #' # load the file:
 #' example_pvol <- read_pvolfile(pvolfile)
+#' data(example_scan)
 #'
 #' # calculate linear reflectivity ETA from reflectivity factor DBZH:
 #' radar_wavelength <- example_pvol$attributes$how$wavelength
@@ -26,6 +27,11 @@
 #' # calculate_param operates on both pvol and scan objects:
 #' calculate_param(example_scan, DR = 10 * log10((ZDR + 1 - 2 * ZDR^0.5 * RHOHV) /
 #'   (ZDR + 1 + 2 * ZDR^0.5 * RHOHV)))
+#'
+#' # it also works for ppis
+#' ppi <- project_as_ppi(example_scan)
+#' calculate_param(ppi, exp(DBZH))
+#'
 #' @references
 #' \itemize{
 #'   \item Kilambi, A., Fabry, F., and Meunier, V., 2018. A simple and effective method
@@ -40,15 +46,34 @@ calculate_param <- function(x, ...) {
 #' @describeIn calculate_param Calculate a new scan parameter for all scans in a polar volume.
 #' @export
 calculate_param.pvol <- function(x, ...) {
-  assert_that(class(x) == "pvol")
+  assert_that(is.pvol(x))
   x$scans <- do.call(lapply, list(x$scans, calculate_param.scan, substitute(list(...))))
   return(x)
 }
 
+#' @describeIn calculate_param Calculate a new parameter for a PPI.
+#' @export
+calculate_param.ppi <- function(x, ...) {
+  assert_that(is.ppi(x))
+  calc <- as.list(substitute(list(...)))[-1L]
+  name <- names(calc)
+  if (is.null(name)) {
+    name <- rep("", length(calc))
+  }
+  for (i in seq_along(calc)) {
+    newParam <- eval(nn <- (calc[[i]]), x$data@data)
+    if ("" == (name[[i]])) {
+      name[[i]] <- deparse(nn, width.cutoff = 250L)[1]
+    }
+    x$data@data[,name[[i]]]<-newParam
+  }
+  return(x)
+}
+
 #' @describeIn calculate_param Calculate a new scan parameter for a scan
 #' @export
 calculate_param.scan <- function(x, ...) {
-  assert_that(class(x) == "scan")
+  assert_that(is.scan(x))
   # check if all parameters are equal
   attr_to_check<-c('class','radar','datetime','geo','dim')
   for(i in attr_to_check){