support quality test report

R/calc_parameter_chunk_size.R

@@ -30,7 +30,6 @@ calc_parameter_chunk_size.data <- function(ds) {
 #' calculate the full chunk size
 #' @param ds dataset
 calc_chunk_size <- function(ds) {
-
   chunk_size <- ds$next_offset - ds$offset
   return(chunk_size)
 }

R/create_dataset.R

@@ -50,6 +50,8 @@ create_dataset <- function(header_data) {
     "b15-c16-t104-a1" = c(read_class = "parameter", block_type_name = "me_test_report_ab"),
     "b15-c16-t0-a64" = c(read_class = "data", block_type_name = "ab_no_atm_comp"),
     "b15-c16-t0-a0" = c(read_class = "data", block_type_name = "ab"),
+    # https://github.com/spectral-cockpit/opusreader2/issues/81
+    "b15-c16-t96-a0" = c(read_class = "parameter", block_type_name = "quality_test_report"),
     # channel code 48: save reflectance (settings
     "b15-c48-t112-a0" = c(read_class = "parameter", block_type_name = "quant_report_refl"),
     "b15-c48-t104-a1" = c(read_class = "parameter", block_type_name = "me_test_report_refl"), # check "a1"

R/get_nice_parameter_name.R

@@ -211,6 +211,7 @@ sort_list_by <- function(dataset_list) {
     "lab_and_process_param_raw",
     "lab_and_process_param_processed",
     "info_block",
+    "quality_test_report",
     "history",
     "report_unknown",
     "unknown"

R/parse_chunk.R

@@ -6,7 +6,7 @@
 #'
 #' @keywords internal
 #' @family parsing
-parse_chunk <- function(ds,raw) UseMethod("parse_chunk")
+parse_chunk <- function(ds, raw) UseMethod("parse_chunk")
 
 
 
@@ -15,8 +15,7 @@ parse_chunk <- function(ds,raw) UseMethod("parse_chunk")
 #' @inheritParams parse_chunk
 #'
 #' @keywords internal
-parse_chunk.default <- function(ds,raw) {
-
+parse_chunk.default <- function(ds, raw) {
   return(ds)
 }
 
@@ -26,10 +25,10 @@ parse_chunk.default <- function(ds,raw) {
 #' @inheritParams parse_chunk
 #'
 #' @keywords internal
-parse_chunk.text <- function(ds,raw) {
-
+parse_chunk.text <- function(ds, raw) {
   text <- read_character(
-    raw, ds$offset+1, n = ds$chunk_size, n_char = ds$chunk_size
+    raw, ds$offset + 1,
+    n = ds$chunk_size, n_char = ds$chunk_size
   )
 
   ds$text <- text
@@ -41,9 +40,8 @@ parse_chunk.text <- function(ds,raw) {
 #' @inheritParams parse_chunk
 #'
 #' @keywords internal
-parse_chunk.parameter <- function(ds,raw) {
-
-  if (ds$text_type %in% c(104, 112, 144)) {
+parse_chunk.parameter <- function(ds, raw) {
+  if (ds$text_type %in% c(104, 112, 96, 144)) { # added text typ
     cursor <- ds$offset + 13
   } else {
     cursor <- ds$offset + 1
@@ -56,7 +54,6 @@ parse_chunk.parameter <- function(ds,raw) {
   result_list <- list()
 
   repeat {
-
     parameter_name <- read_character(raw, cursor, n = 1, n_char = 3)
 
     if (parameter_name == "END") {
@@ -82,7 +79,8 @@ parse_chunk.parameter <- function(ds,raw) {
       parameter_value <- read_double(raw, cursor_value, n = 1L)
     } else if (type_index %in% c(3, 4, 5)) {
       parameter_value <- read_character(
-        raw, cursor_value, n = 1L, n_char = 2*parameter_size
+        raw, cursor_value,
+        n = 1L, n_char = 2 * parameter_size
       )
     }
 
@@ -108,6 +106,7 @@ parse_chunk.parameter <- function(ds,raw) {
   names(result_list) <- parameter_names
 
   ds$parameters <- result_list
+
   return(ds)
 }
 
@@ -117,8 +116,7 @@ parse_chunk.parameter <- function(ds,raw) {
 #'
 #' @keywords internal
 parse_chunk.data <- function(ds, raw) {
-
-  data <- read_float(raw, ds$offset+1, n = ds$chunk_size)
+  data <- read_float(raw, ds$offset + 1, n = ds$chunk_size)
 
   ds$data <- data
   return(ds)

R/parse_header.R

@@ -13,7 +13,7 @@ parse_header <- function(raw) {
 
   all_cursors <- seq(start_cursor, header_length, 12L)
 
-  out <- lapply(all_cursors, function(x) test_header_parse(raw, x))
+  out <- lapply(all_cursors, function(x) parse_header_impl(raw, x))
 
   out[sapply(out, is.null)] <- NULL
 
@@ -32,7 +32,7 @@ dec_to_ascii <- function(n) {
 
 
 
-test_header_parse <- function(raw, cursor) {
+parse_header_impl <- function(raw, cursor) {
   offset <- read_signed_int(raw, cursor + 8L)
 
   if (offset <= 0L) {
@@ -41,12 +41,6 @@ test_header_parse <- function(raw, cursor) {
   chunk_size <- read_signed_int(raw, cursor + 4L)
   next_offset <- offset + 4L * chunk_size
 
-  # if(next_offset > length(raw)){
-  #   browser()
-  #   chunk_size <- length(raw) - offset
-  # }
-
-
   repeat_list <- list(
     block_type = read_unsigned_int(raw, cursor),
     channel_type = read_unsigned_int(raw, cursor + 1L),

inst/WORDLIST

@@ -37,6 +37,7 @@ knitr
 landcareresearch
 MERCHANTABILITY
 MLOps
+MPA
 NeedsCompilation
 NONINFRINGEMENT
 nz
@@ -49,6 +50,7 @@ OPUSLab
 opusreader
 ORCID
 PARAM
+parsable
 Philipp
 PhSm
 postfixed
@@ -72,9 +74,11 @@ ScRf
 ScSm
 Sila
 simplerspec
+sofware
 str
 STR
 sublicense
+testhat
 testthat
 texttype
 thhe

tests/testthat/test-create_dataset.R

@@ -1,9 +1,8 @@
 test_that("that a dataset is correctly cearted", {
-
   header_data <- list(
     block_type = 0,
     text_type = 104,
-    channel_type  = 0,
+    channel_type = 0,
     additional_type = 64
   )
 
@@ -17,7 +16,7 @@ test_that("that a dataset is correctly cearted", {
   header_data <- list(
     block_type = 100,
     text_type = 104,
-    channel_type  = 0,
+    channel_type = 0,
     additional_type = 64
   )
 
@@ -37,13 +36,11 @@ test_that("that a dataset is correctly cearted", {
   header_data <- list(
     block_type = 15,
     text_type = 0,
-    channel_type  = 48,
+    channel_type = 48,
     additional_type = 64
   )
 
   ds <- create_dataset(header_data)
 
   expect_equal(ds$block_type_name, "refl_no_atm_comp")
-
-
 })