Merge pull request #684 from adokter/altitude_layer_check

improve altitude bin validation read_vpts() and as.vpts()

NEWS.md

@@ -2,6 +2,8 @@
 
 * correct units specified in plot label for quantity VIR (#674)
 
+* discard profiles with misspecified altitude bins in `as.vpts()` and `read_vpts()` (#684)
+
 # bioRad 0.8.1
 
 ## bugfixes

R/as.vpts.R

@@ -22,11 +22,28 @@ as.vpts <- function(data) {
   height <- datetime <- source_file <- radar <- NULL
 
   # Throw error if nrows per height are not identical
-
-  assertthat::assert_that(
-    remainder_is_zero(dim(data)[1], length(unique(data$height))) > 0,
-    msg = "Number of rows per height variable must be identical"
-  )
+  # FIXME: first if statement is a weak check that could fail, could be improved.
+  # retaining for now because of speed
+  if(!remainder_is_zero(dim(data)[1], length(unique(data$height)))){
+    data %>%
+      dplyr::group_by(radar, datetime) %>%
+      dplyr::mutate(bioRad_internal_interval = height-lag(height)) %>%
+      dplyr::add_count(name="bioRad_internal_levels") -> data
+    interval_median <- median(data$bioRad_internal_interval, na.rm=TRUE)
+    interval_unique <- unique(data$bioRad_internal_interval)
+    interval_unique <- interval_unique[!is.na(interval_unique)]
+    if(length(interval_unique)>1){
+      warning(paste("profiles found with different altitude interval:",paste(sort(interval_unique),collapse=" ")), ", retaining ",interval_median, " only.")
+      data <- dplyr::filter(data, bioRad_internal_interval == interval_median)
+    }
+    levels_median <- median(data$bioRad_internal_levels)
+    levels_unique <- unique(data$bioRad_internal_levels)
+    if(length(levels_unique)>1){
+      warning(paste("profiles found with different number of height layers:",paste(sort(levels_unique),collapse=" ")), ", retaining ",levels_median, " only.")
+      data <- dplyr::filter(data, bioRad_internal_levels == levels_median)
+    }
+    data <- dplyr::select(data, -c(bioRad_internal_interval, bioRad_internal_levels))
+  }
 
   radar <- unique(data[["radar"]])
 

tests/testthat/test-as.vpts.R

@@ -1,11 +1,15 @@
-test_that("as.vpts() returns error message for incorrect data", {
+test_that("as.vpts() returns warning message for incorrect data", {
   df <- read.csv(system.file("extdata", "example_vpts.csv", package = "bioRad"))
 
+  #remove top bin of the third profile, creating a profile with lower max height
+  df <- df[-which(df$height==max(df$height))[3], ]
+  expect_warning(as.vpts(df),"profiles found with different")
+
   #randomly remove row
   randomIndex <- sample(nrow(df), 1)
   df <- df[-randomIndex, ]
 
-  expect_error(as.vpts(df),"identical")
+  expect_warning(as.vpts(df),"profiles found with different")
 })
 
 test_that("as.vpts() handles multiple unique attribute values correctly", {