Feat 51 name first level of list

R/extract_metadata.R

@@ -0,0 +1,10 @@
+get_meta_sample_name <- function(ds_list) {
+  ds_parameter <- ds_list[vapply(ds_list, class,
+    FUN.VALUE = character(1L)
+  ) == "parameter"]
+
+  sample <- ds_parameter$sample
+  sample_name_long <- sample$parameters$SNM$parameter_value
+  sample_name <- strsplit(sample_name_long, split = ";")[[1L]][1L]
+  return(sample_name)
+}

R/read_bin_types.R

@@ -34,7 +34,10 @@ read_signed_int <- function(con, cursor, n = 1L) {
 #' read character from binary
 #'
 #' @inheritParams read_unsigned_int
-read_character <- function(con, cursor, n = 1L) {
+#' @param encoding encoding to assign character strings that are read. Default
+#' is `"latin1"`., which will use Windows Latin 1 (ANSI) encoding. This is
+#' how Bruker software OPUS is assumed to commonly store strings.
+read_character <- function(con, cursor, n = 1L, encoding = "latin1") {
   seek_opus(con, cursor)
   out <- readBin(
     con,
@@ -43,6 +46,7 @@ read_character <- function(con, cursor, n = 1L) {
     size = 1,
     endian = "little"
   )
+  Encoding(out) <- encoding
   return(out)
 }
 

R/read_opus.R

@@ -185,6 +185,13 @@ read_opus <- function(dsn,
 
   class(dataset_list) <- c("list_opusreader2", class(dataset_list))
 
+  dsn_filenames <- vapply(
+    dataset_list, function(x) attr(x, "dsn_file_name"),
+    FUN.VALUE = character(1L)
+  )
+
+  names(dataset_list) <- dsn_filenames
+
   return(dataset_list)
 }
 
@@ -201,6 +208,10 @@ read_opus_single <- function(dsn, data_only = FALSE) {
 
   parsed_data <- parse_opus(raw, data_only)
 
+  dsn_file_name <- basename(dsn)
+
+  attr(parsed_data, "dsn_file_name") <- dsn_file_name
+
   return(parsed_data)
 }
 

inst/WORDLIST

@@ -21,6 +21,7 @@ forster
 FTIR
 github
 GmbH
+GmBH
 Hengl
 https
 IgRf
@@ -73,10 +74,12 @@ sublicense
 testthat
 texttype
 thhe
+thosee
 tidyverse
 Tighly
 Tomislav
 twagner
+unlist
 utf
 vapour
 VignetteBuilder