fix read vpts error with multiple values in select fields

R/as.vpts.R

@@ -71,23 +71,36 @@ as.vpts <- function(data) {
     regular <- FALSE
   }
 
-  # Get attributes
-  radar_height <- data[["radar_height"]][1]
-  interval <- unique(heights[-1] - heights[-length(heights)])
-  wavelength <- data[["radar_wavelength"]][1]
-  if(length(unique(data[["radar_longitude"]]))>1) warning(paste0("multiple `radar_longitude` values found, storing only first (",lon,") as the functional attribute"))
-  lon <- data[["radar_longitude"]][1]
-  if(length(unique(data[["radar_latitude"]]))>1) warning(paste0("multiple `radar_latitude` values found, storing only first (",lat,") as the functional attribute"))
-  lat <- data[["radar_latitude"]][1]
-  if(length(unique(data[["rcs"]]))>1) warning(paste0("multiple `rcs` values found, storing only first (",rcs,") as the functional attribute"))
-  rcs <- data[["rcs"]][1]
-  if(length(unique(data[["sd_vvp_threshold"]]))>1) warning(paste0("multiple `sd_vvp_threshold` values found, storing only first (",sd_vvp_threshold,") as the functional attribute"))
-  sd_vvp_threshold <- data[["sd_vvp_threshold"]][1]
+# Get attributes
+radar_height <- data[["radar_height"]][1]
+interval <- unique(heights[-1] - heights[-length(heights)])
+wavelength <- data[["radar_wavelength"]][1]
+
+# Check and warn for multiple values of specific attributes and return only the first values of those attributes
+check_multivalue_attributes <- function(data) {
+  attributes <- c("radar_longitude", "radar_latitude", "rcs", "sd_vvp_threshold")
+  first_values <- list()
+  for (attr in attributes) {
+    if (length(unique(data[[attr]])) > 1) {
+      warning(paste0("multiple `", attr, "` values found, storing only first (",
+                     as.character(data[[attr]][1]), ") as the functional attribute."))
+    }
+    first_values[[attr]] <- data[[attr]][1]
+  }
+    return(first_values)
+}
 
+  first_values <- check_multivalue_attributes(data)
+
+  # Directly extract and assign values from the list
+  lon <- first_values$radar_longitude
+  lat <- first_values$radar_latitude
+  rcs <- first_values$rcs
+  sd_vvp_threshold <- first_values$sd_vvp_threshold
+
   # Convert dataframe
   maskvars <- c("radar", "rcs", "sd_vvp_threshold", "radar_latitude", "radar_longitude", "radar_height", "radar_wavelength", "source_file", "datetime", "height", "sunrise", "sunset", "day")
 
-
   data <- df_to_mat_list(data, maskvars, cached_schema)
 
   # Create vpts object

tests/testthat/test-as.vpts.R

@@ -24,3 +24,27 @@ test_that("as.vpts() converts reflectivity `dbz_all` into 'DBZH'", {
   expect_true(!"dbz_all" %in% names(vpts_obj$data))
 
 })
+
+# Test that the function issues a correct warning for multiple radar_longitude values
+test_that("Warning is issued for multiple radar_longitude values", {
+  file <- system.file("extdata", "example_vpts.csv", package = "bioRad")
+  vpts_df <-  read_vpts(file, data_frame=TRUE)
+  vpts_df$radar_longitude[1] <- vpts_df$radar_longitude[1] + 0.1
+  expect_warning(
+    modified_df <- as.vpts(vpts_df),
+    "multiple `radar_longitude` values found"
+  )
+})
+
+# Test that the function sets all radar_longitude values to the first one if it's a multi-value attribute
+test_that("values are set to the first for multi-value attributes", {
+  file <- system.file("extdata", "example_vpts.csv", package = "bioRad")
+  vpts_df <-  read_vpts(file, data_frame=TRUE)
+  vpts_df$radar_longitude[1] <- vpts_df$radar_longitude[1] + 0.1
+  expect_warning(
+    vpts_obj <- as.vpts(vpts_df),
+    "multiple `radar_longitude` values found"
+  )
+  expect_equal(vpts_obj$attributes$where$lon, vpts_df$radar_longitude[1])
+
+})