From 630c8840f02958cfd3eed84d97dc5ff063053b12 Mon Sep 17 00:00:00 2001 From: arnejh Date: Mon, 6 Jul 2026 13:19:50 +0200 Subject: [PATCH] Improved error when CVVariable is not given in PlotReportBootstrap() --- DESCRIPTION | 2 +- NEWS.md | 5 ++ R/Framework.R | 61 ++++++++++++++++--- R/Plot.R | 6 ++ R/resample.R | 2 +- .../OfficialRstoxFrameworkVersions.txt | 2 +- 6 files changed, 67 insertions(+), 11 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 76760886..de71d28a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: RstoxFramework Version: 4.2.1 -Date: 2026-06-26 +Date: 2026-07-06 Title: The Engine of StoX Authors@R: c( person(given = "Arne Johannes", diff --git a/NEWS.md b/NEWS.md index 5481c255..20b393f0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# RstoxFramework v4.2.1 (2025-07-04) +* Improved error when CVVariable is not given in PlotReportBootstrap(). +* Added support for an actual function in replaceData in runProcess() and replaceDataList in runModel(), runProject() and runProjects(). + + # RstoxFramework v4.2.1-9005 (2025-06-13) * Fixed bug in zipProject(), where large files failed, presumably due to the q flag, which is now removed. diff --git a/R/Framework.R b/R/Framework.R index 6873f7c4..ff300be9 100644 --- a/R/Framework.R +++ b/R/Framework.R @@ -5814,10 +5814,28 @@ runProcess <- function( # Apply the replaceData, which can be a function with first parameter the processOutput and additional parameters given in ..., or an actual object to replace the output by: #thisReplaceData <- replaceData[[process$processName]] - if(length(replaceData) && is.character(replaceData)) { - replaceData <- list(FunctionName = replaceData) + if(length(replaceData) == 1) { + if(is.character(replaceData)) { + replaceData <- list(FunctionName = replaceData) + } + else if(is.function(replaceData)) { + replaceData <- list(FunctionName = replaceData) + } } - if(is.list(replaceData) && !data.table::is.data.table(replaceData) && is.character(replaceData$FunctionName)) { + + # Check whether the replaceData has a function in FunctionName: + replaceData_hasFunction <- + # A list: + is.list(replaceData) && !data.table::is.data.table(replaceData) && + # ... and + ( + # a string naming a function: + is.character(replaceData$FunctionName) || + # ... or a function: + is.function(replaceData$FunctionName) + ) + + if(replaceData_hasFunction) { # Add a message when replacing data using a function: message( @@ -5825,7 +5843,12 @@ runProcess <- function( getProcessIndexFromProcessID(projectPath = projectPath, modelName = modelName, processID = processID), ": ", getProcessName(projectPath = projectPath, modelName = modelName, processID = processID), - " using the function ", replaceData$FunctionName, ".", + if(is.function(replaceData$FunctionName)) + " using the function given by replaceData$FunctionName" + else + paste0(" using the function ", replaceData$FunctionName, + "."), + appendLF = TRUE ) @@ -5872,6 +5895,8 @@ runProcess <- function( processOutput <- replaceData } + + # Clear memory to avoid memory leak when running parallel bootstrapping. NEVER remove this unless the performance has been thoroughly tested by running bootstrap on multiple large StoX projects sequentially, to give R a chance to pile up memory: #gc() @@ -5890,7 +5915,7 @@ runProcess <- function( currentActiveProcessID = currentActiveProcessID, processDirty = FALSE ) - + # If a valid output class, wrap the function output to a list named with the data type: if(isValidOutputDataClass(processOutput)) { processOutput <- list(processOutput) @@ -5919,7 +5944,6 @@ runProcess <- function( writeActiveProcessID(projectPath, modelName, propertyDirty = FALSE) } - # Write to memory files. Here we pass processOutput as input and get the processOutput as output, since in the case that the processOutput is a file path to a temporary NewCDF4 file (only relevant for the Bootstrap function for now) the file is copied to the projectSession folder and an attribute added to the file name: processOutput <- writeProcessOutputMemoryFiles(processOutput = processOutput, projectPath = projectPath, modelName = modelName, processID = process$processID) @@ -7215,7 +7239,7 @@ writeStoxOutputOne <- function(processOutputOne, filePath, escape = TRUE) { writeGPX_track_points(processOutputOne, filePath) } else { - writeGPX_waypoints(processOutputOne, filePath) + writeGPX_waypoint(processOutputOne, filePath) } } @@ -7312,7 +7336,7 @@ writeGPX_track_points <- function( } -writeGPX_waypoints <- function( +writeGPX_waypoint <- function( x, filePath, layers = c("geometry", "Stratum", "name") @@ -7331,6 +7355,27 @@ writeGPX_waypoints <- function( } +writeGPX_route_layer <- function( + x, + filePath, + layers = c("geometry", "name") +) { + + # Keep only the specified layers: + x <- subset(x, select = layers) + + sf::st_write( + x, + dsn = filePath, + layer = "route_layer", + driver = "GPX", + dataset_options = "GPX_USE_EXTENSIONS=YES" + ) +} + + + + ggsaveApplyDefaults <- function(x, filePath, overrideAttributes = list()) { # Replace any attributes given in the overrideAttributes: diff --git a/R/Plot.R b/R/Plot.R index 295ce211..d8f0fe15 100644 --- a/R/Plot.R +++ b/R/Plot.R @@ -212,6 +212,12 @@ PlotReportBootstrapOne <- function(plotArguments, ind = NULL) { maxPlottingVariable <- plotArguments$ReportBootstrapData[, max(get(plotArguments$PlottingVariableUpper), na.rm = TRUE)] if(plotArguments$AddCVToPlot) { + + # Error if the plotArguments$CVVariable is not given: + if(!length(plotArguments$CVVariable) || (length(plotArguments$CVVariable) && !nchar(plotArguments$CVVariable))) { + stop("The CVVariable is not given.") + } + maxCV <- plotArguments$ReportBootstrapData[, max(get(plotArguments$CVVariable), na.rm = TRUE)] cvScalingFactor <- maxPlottingVariable / maxCV plotArguments$ReportBootstrapData[, eval(plotArguments$CVVariable) := get(plotArguments$CVVariable) * cvScalingFactor] diff --git a/R/resample.R b/R/resample.R index b9da3e03..e3adc3a6 100644 --- a/R/resample.R +++ b/R/resample.R @@ -688,7 +688,7 @@ readBootstrapDataOne <- function(selectionOneTable, nc, BootstrapID = NA) { varListFullName <- unname(unlist(lapply(varList, function(x) lapply(x, function(y) apply(y, 1, paste, collapse = "/"))))) notPresentInFile <- setdiff(requestedVariablesFullName, varListFullName) if(length(notPresentInFile)) { - stop("The following requested variables are not present in the file ", nc$filename, " (These variables can be added using the parameter OutputVariables of the function Bootstrap()): \n", paste(notPresentInFile, collapse = "\n")) + stop("The following requested variables are not present in the file ", nc$filename, " (These variables can be added using the parameter OutputVariables of the function Bootstrap(), or the function getOutputVariablesUsedInReport can be used to get a full list of required OutputVariables): \n", paste(notPresentInFile, collapse = "\n")) } # Get the nrow variable, which determines what to read, and which will be added as BootstrapID to the output table: diff --git a/inst/versions/OfficialRstoxFrameworkVersions.txt b/inst/versions/OfficialRstoxFrameworkVersions.txt index 14a2b4c1..37077bc0 100644 --- a/inst/versions/OfficialRstoxFrameworkVersions.txt +++ b/inst/versions/OfficialRstoxFrameworkVersions.txt @@ -102,4 +102,4 @@ StoX RstoxFramework Dependencies OptionalDependencies Official Date 4.2.1-9003 4.2.1-9004 RstoxBase_2.2.1-9003,RstoxData_2.2.1-9005 RstoxFDA_1.7.0-9999 FALSE 2026-05-22 4.2.1-9004 4.2.1-9005 RstoxBase_2.2.1-9005,RstoxData_2.2.1-9007 RstoxFDA_1.7.0-9999 FALSE 2026-06-13 4.2.1-9005 4.2.1-9006 RstoxBase_2.2.1-9006,RstoxData_2.2.1-9008 RstoxFDA_1.7.0-9999 FALSE 2026-06-23 -4.2.1 4.2.1 RstoxBase_2.2.1,RstoxData_2.2.1 RstoxFDA_1.7.0 TRUE 2026-06-26 +4.2.1 4.2.1 RstoxBase_2.2.1,RstoxData_2.2.1 RstoxFDA_1.7.0 TRUE 2026-07-06