From 80c2177030a181a7f4eb51e63c0a11e036dad526 Mon Sep 17 00:00:00 2001 From: Adriaan Dokter Date: Mon, 4 Nov 2024 14:57:01 -0500 Subject: [PATCH 1/5] check for altitude bin spacing and number of bins, retain most common type only --- R/as.vpts.R | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/R/as.vpts.R b/R/as.vpts.R index e21b6c94..ed0a8906 100644 --- a/R/as.vpts.R +++ b/R/as.vpts.R @@ -22,11 +22,27 @@ 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. + 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(bin_unique)>1){ + warning(paste("profiles found with different altitude interval:",paste(sort(bin_unique),collapse=" ")), ", retaining ",bin_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"]]) From 72ac0cf147be263b759e216682b48e2f0abc5311 Mon Sep 17 00:00:00 2001 From: Adriaan Dokter Date: Mon, 4 Nov 2024 15:19:17 -0500 Subject: [PATCH 2/5] fix variable name --- R/as.vpts.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/as.vpts.R b/R/as.vpts.R index ed0a8906..059d51bc 100644 --- a/R/as.vpts.R +++ b/R/as.vpts.R @@ -23,6 +23,7 @@ as.vpts <- function(data) { # Throw error if nrows per height are not 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) %>% @@ -31,8 +32,8 @@ as.vpts <- function(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(bin_unique)>1){ - warning(paste("profiles found with different altitude interval:",paste(sort(bin_unique),collapse=" ")), ", retaining ",bin_median, " only.") + 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) From 5fdf406e824fc429b6e92d136591a88a33da7482 Mon Sep 17 00:00:00 2001 From: Adriaan Dokter Date: Mon, 4 Nov 2024 15:24:58 -0500 Subject: [PATCH 3/5] fix test for as.vpts() --- tests/testthat/test-as.vpts.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-as.vpts.R b/tests/testthat/test-as.vpts.R index 1c41d083..432db3ef 100644 --- a/tests/testthat/test-as.vpts.R +++ b/tests/testthat/test-as.vpts.R @@ -1,11 +1,11 @@ -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")) #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", { From 0864c4c9fb636c55f1caa1e066f573dbccd9b153 Mon Sep 17 00:00:00 2001 From: Adriaan Dokter Date: Tue, 5 Nov 2024 11:16:28 -0500 Subject: [PATCH 4/5] add test to improve coverage --- tests/testthat/test-as.vpts.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/testthat/test-as.vpts.R b/tests/testthat/test-as.vpts.R index 432db3ef..9dafe9f8 100644 --- a/tests/testthat/test-as.vpts.R +++ b/tests/testthat/test-as.vpts.R @@ -1,6 +1,10 @@ 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, ] From 13aaad3117477a1ad08eebadbab0b1c12e115e4c Mon Sep 17 00:00:00 2001 From: Adriaan Dokter Date: Tue, 5 Nov 2024 11:43:07 -0500 Subject: [PATCH 5/5] update news --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 65c4069c..f42cfd9a 100644 --- a/NEWS.md +++ b/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