Develop

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: RstoxBase
-Version: 2.2.1-9005
-Date: 2026-06-13
+Version: 2.2.1-9006
+Date: 2026-06-23
 Title: Base StoX Functions
 Authors@R: c(
   person(given = "Arne Johannes", 
@@ -47,7 +47,7 @@ Imports:
     jsonlite (>= 1.6),
     lwgeom (>= 0.2-0),
     maps (>= 0.2-0),
-    RstoxData (>= 2.2.1-9007),
+    RstoxData (>= 2.2.1-9008),
     sf (>= 0.9.0),
     stringi (>= 1.4.0),
     units (>= 0.7),

NEWS.md

@@ -1,5 +1,9 @@
+# RstoxBase v2.2.1-9006  (2026-06-22)
+* Reduced processing time for the functions MeanNASC, AcousticDensity, MeanDensity and Abundance to approximately 30% for a StoX project with large acoustic data (regular survey with 10 m channels and 0.1 nautical mile log distance). This can lead to approximately 50 % reduction in Bootstrap time.
+
+
 # RstoxBase v2.2.1-9005  (2026-06-13)
-* Added support in DefineStratumPolygon() for specifying a folder holding shape files, and not only the file with extension "shp". 
+* Added support in DefineStratumPolygon() for specifying a folder holding shape files, and not only the shape file itself (file with extension "shp")
 
 
 # RstoxBase v2.2.1-9004  (2026-06-06)

R/Abundance.R

@@ -33,6 +33,7 @@ Quantity <- function(
     # Added all.x for StoX 3.2.0, as the default all = FALSE drops strata not present in StratumAreaData (particularly NA stratum):
     QuantityData$Data <- merge(QuantityData$Data, StratumAreaData, by ="Stratum", all.x = TRUE)
 
+
     # Multiply the area and the density:
     if(MeanDensityData$Data$DensityType[1] == "AreaNumberDensity") {
         QuantityData$Data[, Abundance := Area * Density]
@@ -43,10 +44,13 @@ Quantity <- function(
         QuantityData$Data[, Biomass := Area * Density]
     }
 
+
+
     # Format the output:
     # Changed added on 2020-10-16, where the datatypes DensityData and QuantityData are now considered non-rigid:
     #formatOutput(QuantityData, dataType = "QuantityData", keep.all = FALSE)
-    formatOutput(QuantityData, dataType = "QuantityData", keep.all = FALSE, allow.missing = TRUE)
+    formatOutput(QuantityData, dataType = "QuantityData", keep.all = FALSE, allow.missing = TRUE, orderRows = c(Data = TRUE, Resolution = FALSE))
+
 
     return(QuantityData)
 }

R/Acoustic.R

@@ -48,6 +48,7 @@ NASC <- function(
     # Format the output:
     formatOutput(NASCData, dataType = "NASCData", keep.all = FALSE)
 
+
     return(NASCData)
 }
 
@@ -173,6 +174,7 @@ MeanNASC <- function(
         )
     }
 
+
     SurveyDefinition <- RstoxData::match_arg_informative(SurveyDefinition)
     PSUDefinition <- RstoxData::match_arg_informative(PSUDefinition)
     # Convert the PSUDefinitionMethod to "Identity" if "EDSUToPSU":

R/Definitions.R

@@ -987,15 +987,16 @@ getRstoxBaseDefinitions <- function(name = NULL, ...) {
 #' @param secondaryColumnOrder,secondaryRowOrder A vector of column names specifying order of column not defined by \code{\link{getDataTypeDefinition}} used to prioritize when ordering columns and rows, respectively.
 #' @param removeStoXKeys Logical: If TRUE remove the key columns, which are those ending with "Key".
 #' @param orderColumns Logical: If TRUE (the default) order the columns by the first the \code{primaryColumnOrder}, then the variables defined for the StoX datatype (as returned by \code{\link{getDataTypeDefinition}}), then by the \code{secondaryColumnOrder}
-#' @param orderRows Logical: If TRUE (the default) order the rows first by the values in the variables defined for the StoX datatype (as returned by \code{\link{getDataTypeDefinition}}), then by the values of the variables specified by \code{secondaryRowOrder}.
+#' @param orderRows Logical: If TRUE (the default) order the rows first by the values in the variables defined for the StoX datatype (as returned by \code{\link{getDataTypeDefinition}}), then by the values of the variables specified by \code{secondaryRowOrder}. The \code{orderRows} can be given as a vector or list of logicals, named by the different tables of the \code{Data}, if one wishes to order one but not the other, e.g is the Resolution table is passed unchanged from the input to the output (used e.g. in \code{\link{MeanDensity}}).
+#' @param colsToSplit Character: Either a vector of names of the columns to apply splitting on using \code{\link[RstoxData]{setorderv_numeric}}, or NA (the default) to spply splitting on the columns defined by the elements "surveyDefinition", "horizontalResolution", "verticalResolution" and "obserationVariable" as returned from \code{\link{getDataTypeDefinition}} of the \code{dataType}.
 #' 
 #' @export
 #' 
-formatOutput <- function(data, dataType, keep.all = TRUE, allow.missing = FALSE, primaryColumnOrder = NULL, secondaryColumnOrder = NULL, secondaryRowOrder = NULL, removeStoXKeys = FALSE, orderColumns = TRUE, orderRows = TRUE) {
+formatOutput <- function(data, dataType, keep.all = TRUE, allow.missing = FALSE, primaryColumnOrder = NULL, secondaryColumnOrder = NULL, secondaryRowOrder = NULL, removeStoXKeys = FALSE, orderColumns = TRUE, orderRows = TRUE, colsToSplit = NA) {
 
     # If data is only one table:
     if(data.table::is.data.table(data)) {
-        dataTypeDefinition <- getDataTypeDefinition(dataType, subTable = "Data", unlist = TRUE)
+        dataTypeDefinition <- getDataTypeDefinition(dataType, subTable = "Data", unlist = FALSE)
         formatOutputOneTable(
             table = data, 
             tableDefinition = dataTypeDefinition, 
@@ -1006,16 +1007,30 @@ formatOutput <- function(data, dataType, keep.all = TRUE, allow.missing = FALSE,
             secondaryRowOrder = secondaryRowOrder, 
             removeStoXKeys = removeStoXKeys, 
             orderColumns = orderColumns, 
-            orderRows = orderRows
+            orderRows = orderRows, 
+            colsToSplit = colsToSplit
         ) 
     }
     # ... or a list of tables:
     else if(is.list(data) && data.table::is.data.table(data[[1]])) {
-        dataTypeDefinition <- lapply(names(data), function(tableName) getDataTypeDefinition(dataType, subTable = tableName, unlist = TRUE))
+
+        # Order the colsToSplit if it has names:
+        if( length(orderRows) == length(data)  &&  all(names(orderRows) %in% names(data)) ) {
+            orderRows <- orderRows[names(data)]
+        }
+        # Order the colsToSplit if it has names:
+        if( length(colsToSplit) == length(data)  &&  all(names(colsToSplit) %in% names(data)) ) {
+            colsToSplit <- colsToSplit[names(data)]
+        }
+
+
+        dataTypeDefinition <- lapply(names(data), function(tableName) getDataTypeDefinition(dataType, subTable = tableName, unlist = FALSE))
         mapply(
             formatOutputOneTable, 
             table = data, 
             tableDefinition = dataTypeDefinition, 
+            orderRows = orderRows, 
+            colsToSplit = colsToSplit, 
             MoreArgs = list(
                 keep.all = keep.all, 
                 allow.missing = allow.missing, 
@@ -1029,18 +1044,18 @@ formatOutput <- function(data, dataType, keep.all = TRUE, allow.missing = FALSE,
 }
 
 
-formatOutputOneTable <- function(table, tableDefinition, keep.all = TRUE, allow.missing = FALSE, primaryColumnOrder = NULL, secondaryColumnOrder = NULL, secondaryRowOrder = NULL, removeStoXKeys = FALSE, orderColumns = TRUE, orderRows = TRUE) {
+formatOutputOneTable <- function(table, tableDefinition, keep.all = TRUE, allow.missing = FALSE, primaryColumnOrder = NULL, secondaryColumnOrder = NULL, secondaryRowOrder = NULL, removeStoXKeys = FALSE, orderColumns = TRUE, orderRows = TRUE, colsToSplit = NA) {
 
     # Get the column order:
     columnOrder <- unique(
         c(
-            tableDefinition, 
+            unlist(tableDefinition), 
             secondaryColumnOrder
         )
     )
     rowOrder <- unique(
         c(
-            tableDefinition, 
+            unlist(tableDefinition), 
             secondaryRowOrder
         )
     )
@@ -1092,11 +1107,26 @@ formatOutputOneTable <- function(table, tableDefinition, keep.all = TRUE, allow.
     # Order the rows:
     #data.table::setorder(table, na.last = TRUE)
     if(orderRows) {
-        RstoxData::setorderv_numeric(table, by = rowOrder, split = c("-", "/"))
+        # If colsToSplit is NA, use the default, which is "surveyDefinition", "horizontalResolution", "verticalResolution" and "obserationVariable", except "EDSU", since this only has strings and formatted time:
+        if(identical(colsToSplit, NA)) {
+            colsToSplitVars <- c(
+                "surveyDefinition",
+                "horizontalResolution",
+                "verticalResolution",
+                "obserationVariable"
+            )
+            colsToSplit <- unlist(tableDefinition[colsToSplitVars])
+            # Add ReplaceIndividual:
+            colsToSplit <- c(colsToSplit, "ReplaceIndividual")
+            # Remove EDSU, ince this only has strings and formatted time:
+            colsToSplit <- setdiff(colsToSplit, "EDSU")
+        }
+        RstoxData::setorderv_numeric(table, by = rowOrder, split = c("-", "/"), colsToSplit = colsToSplit)
     }
 
     # Delete any keys, as we use the argument 'by' for all merging and aggregation:
     data.table::setkey(table, NULL)
+
 }
 
 

R/Density.R

@@ -120,7 +120,7 @@ AcousticDensity <- function(
     # Add the Resolution table:
     DensityData <- list(
         Data = DensityData, 
-        Resolution = MeanNASCData$Resolution
+        Resolution = data.table::copy(MeanNASCData$Resolution)
     )
 
 
@@ -702,7 +702,8 @@ MeanDensity <- function(
 
     # Format the output:
     # Use keep.all = FALSE, as the difference between acoustic and swept area density is sorted out in the DensityData:
-    formatOutput(MeanDensityData, dataType = "MeanDensityData", keep.all = FALSE, allow.missing = TRUE)
+    # We order the Data table but not the Resolution table:
+    formatOutput(MeanDensityData, dataType = "MeanDensityData", keep.all = FALSE, allow.missing = TRUE, orderRows = c(Data = TRUE, Resolution = FALSE))
 
     return(MeanDensityData)
 }

R/SpeciesCategoryCatch.R

@@ -61,6 +61,7 @@ SpeciesCategoryCatch <- function(
     # 2024-08-20: We keep all possible variables from StoxBiotic here excluding the keys:
     formatOutput(SpeciesCategoryCatchData, dataType = "SpeciesCategoryCatchData", keep.all = TRUE, removeStoXKeys = TRUE)
 
+
     return (SpeciesCategoryCatchData)
 }