From 853605925d205fb1fb5a2e674695332f01aea365 Mon Sep 17 00:00:00 2001
From: hsonne <hauke.sonnenberg@kompetenz-wasser.de>
Date: Fri, 2 Aug 2024 20:02:51 +0200
Subject: [PATCH] Improve and test extractObservationData_1()

---
 R/extractObservationData_1.R                  | 28 +++++++------
 .../test-function-extractObservationData_1.R  | 39 +++++++++++++++----
 2 files changed, 45 insertions(+), 22 deletions(-)

diff --git a/R/extractObservationData_1.R b/R/extractObservationData_1.R
index 76f26ff..27a4bd2 100644
--- a/R/extractObservationData_1.R
+++ b/R/extractObservationData_1.R
@@ -7,35 +7,33 @@ extractObservationData_1 <- function(
   #header.info <- kwb.en13508.2::euCodedFileHeader()
   
   # Create accessor function to header info fields
-  header_field <- kwb.utils::createAccessor(header.info)
+  fromHeader <- kwb.utils::createAccessor(header.info)
   
   # Get information on the row numbers where the different blocks start
   indices <- getBlockIndices(eu_lines, dbg = dbg)
   
   # Column separator
-  sep <- header_field("separator")
+  sep <- fromHeader("separator")
   
   # Try to get the C-Block captions (if they are unique, otherwise rais error!)
   captions <- tryToGetUniqueCaptions(eu_lines[indices$C], sep)
   
+  tableHeader <- paste(captions, collapse = sep)
+  rowsToRemove <- c(indices$A, indices$B, indices$B + 1L, indices$C, indices$Z)
+  tableBody <- eu_lines[-rowsToRemove]
+  
   # Try to find the column types for the given captions
   colClasses <- getColClasses(codes = inspectionDataFieldCodes(), captions)
   
   observations <- readObservationsFromCsvText(
-    text = eu_lines[-c(indices$A, indices$B, indices$B + 1L, indices$C, indices$Z)], 
+    text = c(tableHeader, tableBody), 
     sep = sep, 
-    dec = header_field("decimal"), 
-    quote = header_field("quote"), 
-    colClasses = unname(colClasses)
+    dec = fromHeader("decimal"), 
+    quote = fromHeader("quote"), 
+    colClasses = colClasses,
+    header = TRUE
   )
-  
-  # Set the column names to the captions
-  names(observations) <- if (identical(colClasses, NA)) {
-    captions
-  } else {
-    captions[!sapply(colClasses, is.null)]
-  }
-  
+
   indices$B01 <- indices$B[grep("^#B01=", eu_lines[indices$B])]
   
   # Try to generate a vector of inspection numbers assigning to each observation
@@ -143,7 +141,7 @@ getColClasses2 <- function(codes, as.text)
 readObservationsFromCsvText <- function(text, sep, dec, quote, colClasses, ...)
 {
   # If colClasses is specified, reduce it to the columns that actually occur
-  if (! identical(colClasses, NA)) {
+  if (!identical(colClasses, NA)) {
     
     # Get the column names from the first line
     colNames <- strsplit(text[1L], sep)[[1L]]
diff --git a/tests/testthat/test-function-extractObservationData_1.R b/tests/testthat/test-function-extractObservationData_1.R
index 5cd1956..60de88d 100644
--- a/tests/testthat/test-function-extractObservationData_1.R
+++ b/tests/testthat/test-function-extractObservationData_1.R
@@ -1,16 +1,41 @@
-#kwb.utils::assignPackageObjects("kwb.en13508.2")
+#library(testthat)
 test_that("extractObservationData_1() works", {
 
-  f <- kwb.en13508.2:::extractObservationData_1
+  header.info <- kwb.en13508.2::euCodedFileHeader()
+  
+  f <- function(eu_lines) {
+    kwb.en13508.2:::extractObservationData_1(eu_lines, header.info, dbg = FALSE)
+  }
   
   expect_error(f())
   
-  eu_lines <- c(
-    "#C=A;B",
+  result <- f(eu_lines = c(
+    "#C=A;B", 
     "1;2"
-  )
+  ))
+  expect_identical(result, data.frame(inspno = 1L, A = "1", B = "2"))
+
+  expect_error(f(eu_lines = c(
+    "#C=A;B", 
+    "1;2", 
+    "#C=A;C", 
+    "2;4"
+  )))
+  
+  result <- f(eu_lines = c(
+    "#B01=", 
+    "#C=A;B", 
+    "1;3", 
+    "#Z", 
+    "#B01=", 
+    "#C=A;B", 
+    "2;4"
+  ))
   
-  header.info <- euCodedFileHeader()
+  expect_identical(result, data.frame(
+    inspno = 1:2, 
+    A = as.character(1:2),
+    B = as.character(3:4)
+  ))
   
-  expect_error(capture.output(f(eu_lines, header.info)))
 })