From 21c56bb28d955b4ac3545094bc3f61e29ccbcef5 Mon Sep 17 00:00:00 2001 From: RLumSK Date: Wed, 18 Sep 2024 12:04:20 +0200 Subject: [PATCH] write_BIN2R(): + fx non-ASCII character bug + fx open connection bug after crash + rf code polish + ad tests + ad NEWS + up manual --- NEWS.Rmd | 7 ++++- NEWS.md | 11 +++++++- R/write_R2BIN.R | 47 +++++++++++++++---------------- man/write_R2BIN.Rd | 11 ++------ tests/testthat/test_write_R2BIN.R | 8 ++++++ 5 files changed, 49 insertions(+), 35 deletions(-) diff --git a/NEWS.Rmd b/NEWS.Rmd index 748a3ec6f..b1fda7553 100644 --- a/NEWS.Rmd +++ b/NEWS.Rmd @@ -25,11 +25,16 @@ it shows a warning with instructions and set `plot = FALSE`. This should prevent * When the function was used on a list of `RLum.Analysis-class` objects with the argument `null.rm = TRUE` it would remove all `NULL` objects, but not elements that became `list()` (empty list) during the selection; fixed. - ### `plot_RLum.Data.Spectrum()` * Add support for `lphi` and `ltheta` light direction arguments for `plot.type = "persp"`. * Fix the reason for the unclear warning `In col.unique == col : longer object length is not a multiple of shorter object length` +### `write_R2BIN()` +* Recently, non-ASCII characters in comments or file names became more common and that led to crashes during the +file export. To avoid this now all non-ASCII characters are replaced by `_` before writing them to the BIN/BINX files. +* The function now returns the file path of the export. +* Fix a bug that left connections open if the function crashed. + ## Internals * Two new internal functions `.throw_warning()` and `.throw_error()` sometimes flushed the diff --git a/NEWS.md b/NEWS.md index 8e4cb19ca..eddde2237 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,7 +5,7 @@ -# Changes in version 0.9.25.9000-3 (2024-09-16) +# Changes in version 0.9.25.9000-8 (2024-09-18) ## New functions @@ -38,6 +38,15 @@ - Fix the reason for the unclear warning `In col.unique == col : longer object length is not a multiple of shorter object length` +### `write_R2BIN()` + +- Recently, non-ASCII characters in comments or file names became more + common and that led to crashes during the file export. To avoid this + now all non-ASCII characters are replaced by `_` before writing them + to the BIN/BINX files. +- The function now returns the file path of the export. +- Fix a bug that left connections open if the function crashed. + ## Internals - Two new internal functions `.throw_warning()` and `.throw_error()` diff --git a/R/write_R2BIN.R b/R/write_R2BIN.R index 24a1152af..1a039465a 100644 --- a/R/write_R2BIN.R +++ b/R/write_R2BIN.R @@ -37,7 +37,7 @@ #' @param txtProgressBar [logical] (*with default*): #' enables or disables [txtProgressBar]. #' -#' @return Write a binary file. +#' @return Write a binary file and returns the name and path of the file as [character]. #' #' @note #' The function just roughly checks the data structures. The validity of @@ -55,7 +55,7 @@ #' BIN/BINX-file may not fully compatible, at least not similar to the ones #' directly produced by the Risø readers! #' -#' @section Function version: 0.5.2 +#' @section Function version: 0.5.3 #' #' @author #' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) @@ -95,19 +95,15 @@ write_R2BIN <- function( ){ # Config ------------------------------------------------------------------ - ##set supported BIN format version VERSION.supported <- as.raw(c(3, 4, 5, 6, 7, 8)) # Check integrity --------------------------------------------------------- - ##check if input object is of type 'Risoe.BINfileData' - if(is(object, "Risoe.BINfileData") == FALSE){ - stop("[write_R2BIN()] Input object is not of type Risoe.BINfileData!", call. = FALSE) - - } + if(!inherits(object, "Risoe.BINfileData")) + .throw_error("Input object is not of type Risoe.BINfileData!") - ## check if it fulfills the latest definition ... + ## check if it fulfils the latest definition ... if(ncol(object@METADATA) != ncol(set_Risoe.BINfileData()@METADATA)){ .throw_error("Your Risoe.BINfileData object is not compatible with the ", "latest specification of this S4-class object. You are ", @@ -117,13 +113,11 @@ write_R2BIN <- function( } ##check if input file is of type 'character' - if(is(file, "character") == FALSE){ - stop("[write_R2BIN()] argument 'file' has to be of type character!", call. = FALSE) - - } + if(is(file, "character") == FALSE) + .throw_error("argument 'file' has to be of type character!") # Check Risoe.BINfileData Struture ---------------------------------------- - ##check wether the BIN-file DATA slot contains more than 9999 records; needs to be run all the time + ##check whether the BIN-file DATA slot contains more than 9999 records; needs to be run all the time temp_check <- vapply(object@DATA, function(x){ if(length(x) > 9999){ TRUE @@ -135,9 +129,9 @@ write_R2BIN <- function( ##force compatibility if(compatibility.mode && any(temp_check)){ - ##drop warning - warning("[write_R2BIN()] Compatibility mode selected: Some data sets are longer than 9,999 points and will be binned!", call. = FALSE) + warning("[write_R2BIN()] Compatibility mode selected: Some data sets are longer than 9,999 points and will be binned!", + call. = FALSE) ##BIN data to reduce amount of data if the BIN-file is too long object@DATA <- lapply(object@DATA, function(x){ @@ -165,7 +159,7 @@ write_R2BIN <- function( temp_check <- FALSE ##get new number of points - temp_NPOINTS <- sapply(object@DATA, length) + temp_NPOINTS <- vapply(object@DATA, length, numeric(1)) ##correct LENGTH object@METADATA[["LENGTH"]] <- object@METADATA[["LENGTH"]] - (4 * object@METADATA[["NPOINTS"]]) + (temp_NPOINTS * 4) @@ -187,18 +181,20 @@ write_R2BIN <- function( ##remove rm(temp_check) + ## UTF-8 conversion + object@METADATA[["SAMPLE"]] <- base::iconv(object@METADATA[["SAMPLE"]], "latin1", "ASCII", sub="_") + object@METADATA[["COMMENT"]] <- base::iconv(object@METADATA[["COMMENT"]], "latin1", "ASCII", sub="_") + object@METADATA[["FNAME"]] <- base::iconv(object@METADATA[["FNAME"]], "latin1", "ASCII", sub="_") + object@METADATA[["USER"]] <- base::iconv(object@METADATA[["USER"]], "latin1", "ASCII", sub="_") + object@METADATA[["SEQUENCE"]] <- base::iconv(object@METADATA[["SEQUENCE"]], "latin1", "ASCII", sub="_") ##VERSION - ##If missing version argument set to the highest value if(missing(version)){ - version <- as.raw(max(as.numeric(object@METADATA[,"VERSION"]))) version.original <- version - }else{ - version.original <- as.raw(max(as.numeric(object@METADATA[,"VERSION"]))) version <- as.raw(version) object@METADATA[["VERSION"]] <- version @@ -383,7 +379,8 @@ write_R2BIN <- function( object@METADATA[,"TAG"] <- ifelse(object@METADATA[,"SEL"] == TRUE, 1, 0) # SET FILE AND VALUES ----------------------------------------------------- - con<-file(file, "wb") + con <- file(file, "wb") + on.exit(close(con)) ##get records n.records <- length(object@METADATA[,"ID"]) @@ -1227,7 +1224,6 @@ write_R2BIN <- function( } }else{ - ##DETECTOR_ID writeBin(as.integer(object@METADATA[ID,"DETECTOR_ID"]), con, @@ -1317,12 +1313,13 @@ write_R2BIN <- function( } } - # ##close con - close(con) # # ##close if(txtProgressBar) close(pb) ##output message("\t >> ", ID - 1, " records have been written successfully!\n\n") + + ## return path + invisible(file) } diff --git a/man/write_R2BIN.Rd b/man/write_R2BIN.Rd index f32e05289..96b888727 100644 --- a/man/write_R2BIN.Rd +++ b/man/write_R2BIN.Rd @@ -41,7 +41,7 @@ data the curve data get binned using the smallest possible bin width.} enables or disables \link{txtProgressBar}.} } \value{ -Write a binary file. +Write a binary file and returns the name and path of the file as \link{character}. } \description{ Exports a \code{Risoe.BINfileData} object in a \verb{*.bin} or \verb{*.binx} file that can be @@ -75,7 +75,7 @@ ROI definitions (introduced in BIN-file version 8) are not supported! There are furthermore ignored by the function \link{read_BIN2R}. } \section{Function version}{ - 0.5.2 + 0.5.3 } \examples{ @@ -90,12 +90,7 @@ temp_file <- tempfile(pattern = "output", fileext = ".binx") ##export to temporary file path write_R2BIN(temp, file = temp_file) -} - -\section{How to cite}{ -Kreutzer, S., 2024. write_R2BIN(): Export Risoe.BINfileData into Risø BIN/BINX-file. Function version 0.5.2. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ } - \references{ DTU Nutech, 2016. The Sequence Editor, Users Manual, February, 2016. \url{https://www.fysik.dtu.dk} @@ -105,5 +100,5 @@ DTU Nutech, 2016. The Sequence Editor, Users Manual, February, 2016. } \author{ Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} +} \keyword{IO} diff --git a/tests/testthat/test_write_R2BIN.R b/tests/testthat/test_write_R2BIN.R index 29118bf59..66f33e9a5 100644 --- a/tests/testthat/test_write_R2BIN.R +++ b/tests/testthat/test_write_R2BIN.R @@ -117,4 +117,12 @@ data(ExampleData.BINfileData, envir = environment()) write_R2BIN(object = new, file = paste0(path, "BINfile_V8.bin"), version = "08") }) + + ## check UTF-8 characters + new_utf8 <- new + new_utf8@METADATA$FNAME <- c("I do not belong in here \xb5m") + t <- expect_silent(suppressMessages(write_R2BIN(object = new_utf8, file = paste0(path, "BINfile_V8.bin"), + version = "08", txtProgressBar = FALSE))) + expect_type(object = t, type = "character") }) +