From dba0b8c5bbb872cd9cb82ac03d681e0474e13412 Mon Sep 17 00:00:00 2001 From: Bart Hoekstra Date: Wed, 20 May 2020 23:09:23 +0200 Subject: [PATCH 1/9] Rough implementation of multi-param compositing Bugfixes --- R/composite_ppi.R | 108 ++++++++++++++++++++++++++++++---------------- 1 file changed, 70 insertions(+), 38 deletions(-) diff --git a/R/composite_ppi.R b/R/composite_ppi.R index a0822c0cc..cfa3adcf9 100644 --- a/R/composite_ppi.R +++ b/R/composite_ppi.R @@ -63,7 +63,7 @@ #' # plot the calculated max product on the basemap #' map(my_composite, bm) #' } -composite_ppi <- function(x, param = "DBZH", nx = 100, ny = 100, xlim, ylim, res, crs, raster = NA, method = "max", idp = 2, idw_max_distance=NA) { +composite_ppi <- function(x, param = "DBZH", nx = 100, ny = 100, xlim, ylim, res, crs, raster = NA, method = "max", idp = 2, idw_max_distance = NA) { if (FALSE %in% sapply(x, is.ppi)) { stop("'composite' expects objects of class ppi only") } @@ -80,19 +80,23 @@ composite_ppi <- function(x, param = "DBZH", nx = 100, ny = 100, xlim, ylim, res if (!missing(res)) { assert_that(is.numeric(res)) assert_that(length(res) <= 2) + t_res <- res } else { - res <- NA + t_res <- NULL } - # check crs argument as in raster::raster() if (!missing(crs)) { - crs <- CRS(as.character(raster::projection(crs))) - } - else { - crs <- CRS("+proj=longlat +datum=WGS84") + t_crs <- CRS(as.character(raster::projection(crs))) + } else { + t_crs <- NULL } + if (!method %in% c("max", "min", "mean", "idw")) stop("'method' should be one of 'max', 'mean', 'min' or 'idw'") + if (length(param) == 1 && param == "all") { + param <- names(x[[1]]$data) + } ppis <- lapply(x, `[.ppi`, i = param) + lons <- sapply(ppis, function(x) x$geo$bbox["lon", ]) lats <- sapply(ppis, function(x) x$geo$bbox["lat", ]) if(!missing(xlim)) lons <- xlim @@ -106,53 +110,81 @@ composite_ppi <- function(x, param = "DBZH", nx = 100, ny = 100, xlim, ylim, res ) if (!are_equal(raster, NA)) { - r <- raster(raster) + r <- raster::raster(raster) } else { - if (missing(res) | is.na(res)) { - r <- raster(ncols = nx, nrows = ny, ext = raster::extent(c(min(lons),max(lons),min(lats),max(lats))), crs = crs) - } - else { - r <- raster(ncols = nx, nrows = ny, ext = raster::extent(c(min(lons),max(lons),min(lats),max(lats))), crs = crs, res = res) + d_crs <- CRS("+proj=longlat +datum=WGS84") + if (!is.null(t_res) && !is.null(t_crs)) { + r <- raster(ext = raster::extent(c(min(lons), max(lons), min(lats), max(lats))), crs = t_crs, resolution = t_res) + } else if (!is.null(t_crs) && is.null(t_res)) { + r <- raster(ncols = nx, nrows = ny, ext = raster::extent(c(min(lons), max(lons), min(lats), max(lats))), crs = t_crs) + } else if (is.null(t_crs) && !is.null(t_res)) { + r <- raster(ext = raster::extent(c(min(lons), max(lons), min(lats), max(lats))), crs = d_crs) + t_crs <- CRS(paste0("+proj=aeqd +units=m +ellps=WGS84 +lat_0=", mean(lats), " +lon_0=", mean(lons))) + r <- raster::projectExtent(r, t_crs) + raster::res(r) <- t_res + } else { + r <- raster(ncols = nx, nrows = ny, ext = raster::extent(c(min(lons), max(lons), min(lats), max(lats))), crs = d_crs) } } # initialize all values of the grid to NA - raster::values(r) <- NA - spGrid = as(r,'SpatialGridDataFrame') + suppressWarnings(r <- raster::setValues(r, NA)) + spGrid = as(r, 'SpatialGridDataFrame') names(spGrid@data) <- names(ppis[[1]]$data)[1] # merge - projs <- suppressWarnings(sapply( - ppis, + projs <- sapply(ppis, function(x) { over( - spTransform( - spGrid, - CRS(proj4string(x$data)) + suppressWarnings( + spTransform( + spGrid, + CRS(proj4string(x$data)) + ) ), - x$data + x$data[param] ) } - )) + ) - if(method == "max") spGrid@data[, 1] <- do.call(function(...) pmax(..., na.rm = TRUE), projs) - if(method == "min") spGrid@data[, 1] <- do.call(function(...) pmin(..., na.rm = TRUE), projs) - if(method == "mean") as.data.frame(projs) %>% rowMeans(na.rm=T) -> spGrid@data[, 1] - if(method == "idw"){ - brick_data = raster::brick(raster::brick(spGrid),nl=length(projs)) - brick_weights = brick_data - #weights<-raster::pointDistance(as.matrix(data.frame(x=lons.radar,y=lats.radar)), coordinates(raster(spGrid)),lonlat=T) - for(i in 1:length(projs)){ - brick_data <- raster::setValues(brick_data, projs[[i]], layer=i) - latlon.radar <- unique(data.frame(lat=c(lats.radar), lon=c(lons.radar))) - weights<-raster::pointDistance(as.matrix(data.frame(x=latlon.radar$lon,y=latlon.radar$lat))[i,], coordinates(raster(spGrid)),lonlat=T) - if(!is.na(idw_max_distance)) weights[weights>idw_max_distance]=NA - weights = 1/(weights^idp) + for (p in param) { + if (length(param) > 1) { + merged <- projs[p, ] + } else { + merged <- projs + } + + if (length(method) > 1) { + param_method <- method[match(p, param)] + } else { + param_method <- method + } - brick_weights <- raster::setValues(brick_weights, weights, layer=i) + if(param_method == "max") spGrid@data[, p] <- do.call(function(...) pmax(..., na.rm = TRUE), merged) + if(param_method == "min") spGrid@data[, p] <- do.call(function(...) pmin(..., na.rm = TRUE), merged) + if(param_method == "mean") as.data.frame(merged) %>% rowMeans(na.rm=TRUE) -> spGrid@data[, p] + if(param_method == "idw"){ + brick_data <- suppressWarnings(raster::brick(raster::brick(spGrid), nl = length(merged))) + brick_weights <- brick_data + #weights<-raster::pointDistance(as.matrix(data.frame(x=lons.radar,y=lats.radar)), coordinates(raster(spGrid)),lonlat=T) + for(i in 1:length(merged)){ + brick_data <- raster::setValues(brick_data, merged[[i]], layer=i) + latlon.radar <- unique(data.frame(lat = c(lats.radar), lon = c(lons.radar))) + if (is.null(t_res)) { + weights <- suppressWarnings(raster::pointDistance(as.matrix(data.frame(x = latlon.radar$lon, y = latlon.radar$lat))[i, ], coordinates(raster(spGrid)), lonlat = TRUE)) + } else { + d <- data.frame(lon = latlon.radar$lon, lat = latlon.radar$lat) + coordinates(d) <- c("lon", "lat") + proj4string(d) <- d_crs + proj.radar <- as.data.frame(spTransform(d, t_crs)) + weights <- suppressWarnings(raster::pointDistance(as.matrix(data.frame(x = proj.radar$lon, y = proj.radar$lat))[i, ], coordinates(raster(spGrid)), lonlat = FALSE)) + } + if(!is.na(idw_max_distance)) weights[weights > idw_max_distance] <- NA + weights <- 1 / (weights ^ idp) + brick_weights <- raster::setValues(brick_weights, weights, layer=i) + } + spGrid@data[, p] <- as.vector(raster::weighted.mean(brick_data, brick_weights, na.rm = TRUE)) } - spGrid <- as(raster::weighted.mean(brick_data, brick_weights, na.rm=T),"SpatialGridDataFrame") - names(spGrid@data) <- names(ppis[[1]]$data)[1] } ppi.out <- list(data = spGrid, geo = list( From e644e9385bb622e067ee4e4d8ddb631a7d6c0cca Mon Sep 17 00:00:00 2001 From: Bart Hoekstra Date: Sun, 24 May 2020 12:20:09 +0200 Subject: [PATCH 2/9] Add documentation for multi-param, -method and res --- R/composite_ppi.R | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/R/composite_ppi.R b/R/composite_ppi.R index cfa3adcf9..6d16d2684 100644 --- a/R/composite_ppi.R +++ b/R/composite_ppi.R @@ -6,8 +6,10 @@ #' #' @inheritParams integrate_to_ppi #' @param x A list of \code{ppi} objects. -#' @param param Scan parameter to composite. -#' @param method string. Compositing method, one of "mean", "min", "max" or "idw" +#' @param param An atomic vector of character strings, containing the names of \code{ppi} parameters to composite. +#' To composite all \code{ppi} parameters use 'all'. +#' @param method string. Compositing method, one of "mean", "min", "max" or "idw". Provide a list of methods +#' names of length(param) to apply different methods to each of the parameters. #' @param idw_max_distance numeric. Maximum distance from the radar to consider in #' inverse distance weighting. Measurements beyond this distance will have a #' weighting factor of zero. @@ -38,7 +40,10 @@ #' } #' #' The coordinates system of the returned \code{ppi} is a WGS84 -#' (lat,lon) datum. +#' (lat, lon) datum, unless a different \code{crs} is provided. If only +#' \code{res} is provided, but no \code{crs} is set, \code{res} is in +#' meter units and the origin of the composite \code{ppi} is set to the +#' mean (lat, lon) location. #' #' This function is a prototype and under active development #' From 2863c623c146065c4536476b5c00796bb6e4d742 Mon Sep 17 00:00:00 2001 From: Bart Hoekstra Date: Sun, 24 May 2020 12:34:30 +0200 Subject: [PATCH 3/9] Add additional input checks for multi-param -method composites --- R/composite_ppi.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/composite_ppi.R b/R/composite_ppi.R index 6d16d2684..645f10eb1 100644 --- a/R/composite_ppi.R +++ b/R/composite_ppi.R @@ -95,7 +95,11 @@ composite_ppi <- function(x, param = "DBZH", nx = 100, ny = 100, xlim, ylim, res } else { t_crs <- NULL } - if (!method %in% c("max", "min", "mean", "idw")) stop("'method' should be one of 'max', 'mean', 'min' or 'idw'") + if (!all(method %in% c("max", "min", "mean", "idw"))) stop("'method' should be one or multiple of 'max', 'mean', 'min' or 'idw'") + if (length(method) != length(param) & length(method) != 1) stop("'method' should be of length 1 or length(param)") + if (!missing(coverage)) { + if (!coverage %in% c("count", "radars")) stop("'coverage' should be 'count' or 'radars'") + } if (length(param) == 1 && param == "all") { param <- names(x[[1]]$data) From 086fb98008db68926f32bf623c8a53256fded667 Mon Sep 17 00:00:00 2001 From: Bart Hoekstra Date: Sun, 24 May 2020 12:53:28 +0200 Subject: [PATCH 4/9] Add optional coverage parameter --- R/composite_ppi.R | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/R/composite_ppi.R b/R/composite_ppi.R index 645f10eb1..e8488a976 100644 --- a/R/composite_ppi.R +++ b/R/composite_ppi.R @@ -13,7 +13,10 @@ #' @param idw_max_distance numeric. Maximum distance from the radar to consider in #' inverse distance weighting. Measurements beyond this distance will have a #' weighting factor of zero. -#' @param idp numeric. inverse distance weighting power +#' @param idp numeric. inverse distance weighting power. +#' @param coverage string. Additional radar coverage parameter to be added to the \code{ppi}, one of "count" or +#' "radars" for the number of radars 'covering' a single \code{ppi} pixel and a list of the the corresponding +#' ODIM radar IDs respectively. #' #' @return A \code{\link[=summary.ppi]{ppi}}. #' @@ -68,7 +71,7 @@ #' # plot the calculated max product on the basemap #' map(my_composite, bm) #' } -composite_ppi <- function(x, param = "DBZH", nx = 100, ny = 100, xlim, ylim, res, crs, raster = NA, method = "max", idp = 2, idw_max_distance = NA) { +composite_ppi <- function(x, param = "DBZH", nx = 100, ny = 100, xlim, ylim, res, crs, raster = NA, method = "max", idp = 2, idw_max_distance = NA, coverage) { if (FALSE %in% sapply(x, is.ppi)) { stop("'composite' expects objects of class ppi only") } @@ -141,6 +144,11 @@ composite_ppi <- function(x, param = "DBZH", nx = 100, ny = 100, xlim, ylim, res spGrid = as(r, 'SpatialGridDataFrame') names(spGrid@data) <- names(ppis[[1]]$data)[1] + if (!missing(coverage)) { + ppis <- lapply(ppis, function(x) {x$data$coverage <- 1; return(x)}) + param <- c(param, "coverage") + } + # merge projs <- sapply(ppis, function(x) { @@ -157,6 +165,7 @@ composite_ppi <- function(x, param = "DBZH", nx = 100, ny = 100, xlim, ylim, res ) for (p in param) { + if (p == "coverage") next() if (length(param) > 1) { merged <- projs[p, ] } else { @@ -196,6 +205,17 @@ composite_ppi <- function(x, param = "DBZH", nx = 100, ny = 100, xlim, ylim, res } } + if (!missing(coverage)) { + colnames(projs) <- lapply(x, function(x) x$radar) + cov <- !is.na(do.call("cbind", projs["coverage", ])) + if (coverage == "count") { + spGrid@data$coverage <- rowSums(cov) + } else if (coverage == "radars") { + cov <- apply(cov, 1, function(x) colnames(projs)[x]) + spGrid@data$coverage <- cov + } + } + ppi.out <- list(data = spGrid, geo = list( lat = lats.radar, lon = lons.radar, elangle = elangles, bbox = bbox, From 21d2fe000e18a4003bfb879a624676d1e9e2ed03 Mon Sep 17 00:00:00 2001 From: GitHub Actions Date: Wed, 9 Jun 2021 12:09:18 +0000 Subject: [PATCH 5/9] Document --- man/composite_ppi.Rd | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/man/composite_ppi.Rd b/man/composite_ppi.Rd index 48cc21f33..6f3308635 100644 --- a/man/composite_ppi.Rd +++ b/man/composite_ppi.Rd @@ -16,13 +16,15 @@ composite_ppi( raster = NA, method = "max", idp = 2, - idw_max_distance = NA + idw_max_distance = NA, + coverage ) } \arguments{ \item{x}{A list of \code{ppi} objects.} -\item{param}{Scan parameter to composite.} +\item{param}{An atomic vector of character strings, containing the names of \code{ppi} parameters to composite. +To composite all \code{ppi} parameters use 'all'.} \item{nx}{number of raster pixels in the x (longitude) dimension} @@ -42,13 +44,18 @@ To use a WSG84 (lat,lon) projection, use crs="+proj=longlat +datum=WGS84"} \item{raster}{(optional) RasterLayer with a CRS. When specified this raster topology is used for the output, and nx, ny, res arguments are ignored.} -\item{method}{string. Compositing method, one of "mean", "min", "max" or "idw"} +\item{method}{string. Compositing method, one of "mean", "min", "max" or "idw". Provide a list of methods +names of length(param) to apply different methods to each of the parameters.} -\item{idp}{numeric. inverse distance weighting power} +\item{idp}{numeric. inverse distance weighting power.} \item{idw_max_distance}{numeric. Maximum distance from the radar to consider in inverse distance weighting. Measurements beyond this distance will have a weighting factor of zero.} + +\item{coverage}{string. Additional radar coverage parameter to be added to the \code{ppi}, one of "count" or +"radars" for the number of radars 'covering' a single \code{ppi} pixel and a list of the the corresponding +ODIM radar IDs respectively.} } \value{ A \code{\link[=summary.ppi]{ppi}}. @@ -79,7 +86,10 @@ weighted according to 1/(distance from the radar)^\code{idp}} } The coordinates system of the returned \code{ppi} is a WGS84 -(lat,lon) datum. +(lat, lon) datum, unless a different \code{crs} is provided. If only +\code{res} is provided, but no \code{crs} is set, \code{res} is in +meter units and the origin of the composite \code{ppi} is set to the +mean (lat, lon) location. This function is a prototype and under active development } From 6a5d014fb95896d8856d2418bffc415a8a16761e Mon Sep 17 00:00:00 2001 From: Peter Desmet Date: Wed, 9 Jun 2021 14:11:46 +0200 Subject: [PATCH 6/9] Make minor change to trigger tests --- R/composite_ppi.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/composite_ppi.R b/R/composite_ppi.R index e8488a976..39708d2fb 100644 --- a/R/composite_ppi.R +++ b/R/composite_ppi.R @@ -5,7 +5,7 @@ #' radars. #' #' @inheritParams integrate_to_ppi -#' @param x A list of \code{ppi} objects. +#' @param x A list of `ppi` objects. #' @param param An atomic vector of character strings, containing the names of \code{ppi} parameters to composite. #' To composite all \code{ppi} parameters use 'all'. #' @param method string. Compositing method, one of "mean", "min", "max" or "idw". Provide a list of methods From aca894af6a387948e3f8332f0fa6564536ddf3d6 Mon Sep 17 00:00:00 2001 From: Adriaan Dokter Date: Thu, 10 Jun 2021 12:48:18 -0400 Subject: [PATCH 7/9] documentation updates --- R/composite_ppi.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/composite_ppi.R b/R/composite_ppi.R index 39708d2fb..0b69886cd 100644 --- a/R/composite_ppi.R +++ b/R/composite_ppi.R @@ -6,8 +6,9 @@ #' #' @inheritParams integrate_to_ppi #' @param x A list of `ppi` objects. -#' @param param An atomic vector of character strings, containing the names of \code{ppi} parameters to composite. -#' To composite all \code{ppi} parameters use 'all'. +#' @param param The scan parameter name(s) to composite. An atomic vector of character strings +#' can be provided to composite multiple scan parameters at once. To composite all available +#' scan parameters use 'all' (default). #' @param method string. Compositing method, one of "mean", "min", "max" or "idw". Provide a list of methods #' names of length(param) to apply different methods to each of the parameters. #' @param idw_max_distance numeric. Maximum distance from the radar to consider in @@ -71,7 +72,7 @@ #' # plot the calculated max product on the basemap #' map(my_composite, bm) #' } -composite_ppi <- function(x, param = "DBZH", nx = 100, ny = 100, xlim, ylim, res, crs, raster = NA, method = "max", idp = 2, idw_max_distance = NA, coverage) { +composite_ppi <- function(x, param = "all", nx = 100, ny = 100, xlim, ylim, res, crs, raster = NA, method = "max", idp = 2, idw_max_distance = NA, coverage) { if (FALSE %in% sapply(x, is.ppi)) { stop("'composite' expects objects of class ppi only") } From 1ce26da19a9fd6ef94d9d58339684445d8cee96d Mon Sep 17 00:00:00 2001 From: Adriaan Dokter Date: Thu, 10 Jun 2021 13:33:11 -0400 Subject: [PATCH 8/9] update documentation --- man/composite_ppi.Rd | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/man/composite_ppi.Rd b/man/composite_ppi.Rd index 6f3308635..0fba395de 100644 --- a/man/composite_ppi.Rd +++ b/man/composite_ppi.Rd @@ -6,7 +6,7 @@ \usage{ composite_ppi( x, - param = "DBZH", + param = "all", nx = 100, ny = 100, xlim, @@ -23,8 +23,9 @@ composite_ppi( \arguments{ \item{x}{A list of \code{ppi} objects.} -\item{param}{An atomic vector of character strings, containing the names of \code{ppi} parameters to composite. -To composite all \code{ppi} parameters use 'all'.} +\item{param}{The scan parameter name(s) to composite. An atomic vector of character strings +can be provided to composite multiple scan parameters at once. To composite all available +scan parameters use 'all' (default).} \item{nx}{number of raster pixels in the x (longitude) dimension} From b0214fd1ed21137196c2bf5c85ab3028b584fa99 Mon Sep 17 00:00:00 2001 From: Bart Hoekstra Date: Fri, 11 Jun 2021 12:53:19 +0200 Subject: [PATCH 9/9] Remove coverage options --- R/composite_ppi.R | 23 +++++++---------------- man/composite_ppi.Rd | 7 +++---- 2 files changed, 10 insertions(+), 20 deletions(-) diff --git a/R/composite_ppi.R b/R/composite_ppi.R index 0b69886cd..dfe463eff 100644 --- a/R/composite_ppi.R +++ b/R/composite_ppi.R @@ -15,9 +15,8 @@ #' inverse distance weighting. Measurements beyond this distance will have a #' weighting factor of zero. #' @param idp numeric. inverse distance weighting power. -#' @param coverage string. Additional radar coverage parameter to be added to the \code{ppi}, one of "count" or -#' "radars" for the number of radars 'covering' a single \code{ppi} pixel and a list of the the corresponding -#' ODIM radar IDs respectively. +#' @param coverage logical. When TRUE adds an additional "coverage" parameter to the \code{ppi} with the +#' number of PPIs covering a single composite \code{ppi} pixel. #' #' @return A \code{\link[=summary.ppi]{ppi}}. #' @@ -72,7 +71,7 @@ #' # plot the calculated max product on the basemap #' map(my_composite, bm) #' } -composite_ppi <- function(x, param = "all", nx = 100, ny = 100, xlim, ylim, res, crs, raster = NA, method = "max", idp = 2, idw_max_distance = NA, coverage) { +composite_ppi <- function(x, param = "all", nx = 100, ny = 100, xlim, ylim, res, crs, raster = NA, method = "max", idp = 2, idw_max_distance = NA, coverage = FALSE) { if (FALSE %in% sapply(x, is.ppi)) { stop("'composite' expects objects of class ppi only") } @@ -101,9 +100,7 @@ composite_ppi <- function(x, param = "all", nx = 100, ny = 100, xlim, ylim, res, } if (!all(method %in% c("max", "min", "mean", "idw"))) stop("'method' should be one or multiple of 'max', 'mean', 'min' or 'idw'") if (length(method) != length(param) & length(method) != 1) stop("'method' should be of length 1 or length(param)") - if (!missing(coverage)) { - if (!coverage %in% c("count", "radars")) stop("'coverage' should be 'count' or 'radars'") - } + if (!is.logical(coverage)) stop("'coverage' should be a logical") if (length(param) == 1 && param == "all") { param <- names(x[[1]]$data) @@ -145,7 +142,7 @@ composite_ppi <- function(x, param = "all", nx = 100, ny = 100, xlim, ylim, res, spGrid = as(r, 'SpatialGridDataFrame') names(spGrid@data) <- names(ppis[[1]]$data)[1] - if (!missing(coverage)) { + if (coverage) { ppis <- lapply(ppis, function(x) {x$data$coverage <- 1; return(x)}) param <- c(param, "coverage") } @@ -206,15 +203,9 @@ composite_ppi <- function(x, param = "all", nx = 100, ny = 100, xlim, ylim, res, } } - if (!missing(coverage)) { - colnames(projs) <- lapply(x, function(x) x$radar) + if (coverage) { cov <- !is.na(do.call("cbind", projs["coverage", ])) - if (coverage == "count") { - spGrid@data$coverage <- rowSums(cov) - } else if (coverage == "radars") { - cov <- apply(cov, 1, function(x) colnames(projs)[x]) - spGrid@data$coverage <- cov - } + spGrid@data$coverage <- rowSums(cov) } ppi.out <- list(data = spGrid, geo = list( diff --git a/man/composite_ppi.Rd b/man/composite_ppi.Rd index 0fba395de..80353429a 100644 --- a/man/composite_ppi.Rd +++ b/man/composite_ppi.Rd @@ -17,7 +17,7 @@ composite_ppi( method = "max", idp = 2, idw_max_distance = NA, - coverage + coverage = FALSE ) } \arguments{ @@ -54,9 +54,8 @@ names of length(param) to apply different methods to each of the parameters.} inverse distance weighting. Measurements beyond this distance will have a weighting factor of zero.} -\item{coverage}{string. Additional radar coverage parameter to be added to the \code{ppi}, one of "count" or -"radars" for the number of radars 'covering' a single \code{ppi} pixel and a list of the the corresponding -ODIM radar IDs respectively.} +\item{coverage}{logical. When TRUE adds an additional "coverage" parameter to the \code{ppi} with the +number of PPIs covering a single composite \code{ppi} pixel.} } \value{ A \code{\link[=summary.ppi]{ppi}}.