Merge pull request #368 from StoXProject/develop

Develop
StoXProject · Oct 29, 2024 · c3cfdb8 · c3cfdb8
2 parents 3469e53 + b92ccf0
commit c3cfdb8
Show file tree

Hide file tree

Showing 17 changed files with 201 additions and 207 deletions.
diff --git a/.github/workflows/check-full.yaml b/.github/workflows/check-full.yaml
@@ -24,25 +24,21 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: macOS-13,   r: 'release', pkgext: '.tgz'} # Changed se per https://github.blog/changelog/2024-01-30-github-actions-macos-14-sonoma-is-now-available/
-          - {os: macOS-13,   r: '4.3',     pkgext: '.tgz'}
-          - {os: macOS-13,   r: '4.2',     pkgext: '.tgz'}
-          - {os: macOS-13,   r: '4.1',     pkgext: '.tgz'} # Temporarily disabling this due to new sf release not ready for R 4.2
-          # - {os: macOS-latest,   r: '4.0',     pkgext: '.tgz'} # Returs error  callr not found
-          # - {os: macOS-latest,   r: '3.6',     pkgext: '.tgz'} # Not used in RstoxFramework
+          # Latest macOS will use the big-sur-arm64 folder when deploying to the drat repo:
+          - {os: macOS-latest,   r: 'release', pkgext: '.tgz'}
+          - {os: macOS-latest,   r: '4.3',  pkgext: '.tgz'}
+
+          # macOS-13 will use the big-sur-x86_64 folder when deploying to the drat repo:
+          - {os: macOS-13,   r: 'release', pkgext: '.tgz'}
+          - {os: macOS-13,   r: '4.3',  pkgext: '.tgz'}
+
           - {os: windows-latest, r: 'release', pkgext: '.zip'}
-          - {os: windows-latest, r: '4.3',     pkgext: '.zip'}
-          # - {os: windows-latest, r: '4.2',     pkgext: '.zip'} # Removed due to sf failing to build
-          # - {os: windows-latest, r: '4.1',     pkgext: '.zip'} # Disabled due to stringi failure
-          #- {os: windows-latest, r: '4.0',     pkgext: '.zip',    rspm: "https://cloud.r-project.org"} # Too slow
-          #- {os: windows-latest, r: '3.6',     pkgext: '.zip',    rspm: "https://cloud.r-project.org"} # Too slow
+          - {os: windows-latest, r: '4.3',  pkgext: '.zip'}
+
           - {os: ubuntu-latest,  r: 'release', pkgext: '.tar.gz', rspm: "https://cloud.r-project.org"}
-          - {os: ubuntu-22.04,   r: '4.3',     pkgext: '.tar.gz', rspm: "https://cloud.r-project.org"}
-          - {os: ubuntu-22.04,   r: '4.2',     pkgext: '.tar.gz', rspm: "https://cloud.r-project.org"}
-          # - {os: ubuntu-20.04,   r: '4.1',     pkgext: '.tar.gz', rspm: "https://cloud.r-project.org"} # Removed due to sf failing to build
-          # - {os: ubuntu-20.04,   r: '4.0',     pkgext: '.tar.gz', rspm: "https://cloud.r-project.org"} # Removed due to sf failing to build
-          #- {os: ubuntu-20.04,   r: '3.6',     pkgext: '.tar.gz', rspm: "https://cloud.r-project.org"}
-
+          - {os: ubuntu-22.04,   r: '4.3',  pkgext: '.tar.gz', rspm: "https://cloud.r-project.org"}
+          - {os: ubuntu-22.04,   r: '4.2',  pkgext: '.tar.gz', rspm: "https://cloud.r-project.org"}
+
     env:
       R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
       RSPM: ${{ matrix.config.rspm }}

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: RstoxBase
-Version: 2.0.1-9003
-Date: 2024-10-05
+Version: 2.0.1-9004
+Date: 2024-10-29
 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.0.1-9003),
+    RstoxData (>= 2.0.1-9005),
     sf (>= 0.9.0),
     stringi (>= 1.4.0),
     units (>= 0.7),

diff --git a/NAMESPACE b/NAMESPACE
@@ -2,7 +2,6 @@
 
 export(AcousticDensity)
 export(AddHaulDensityToSuperIndividuals)
-export(AddPSUToPreySpeciesCategoryCatch)
 export(AppendNASC)
 export(AssignmentLengthDistribution)
 export(BioticAssignmentWeighting)
@@ -32,12 +31,10 @@ export(MeanSpeciesCategoryCatch)
 export(NASC)
 export(NASCToStoxAcoustic)
 export(PlotAcousticTrawlSurvey)
-export(PreySpeciesCategoryCatch)
 export(Quantity)
 export(RegroupLengthDistribution)
 export(RelativeLengthDistribution)
 export(ReportDensity)
-export(ReportPreySpeciesCategoryCatch)
 export(ReportQuantity)
 export(ReportSpeciesCategoryCatch)
 export(ReportSuperIndividuals)

diff --git a/NEWS.md b/NEWS.md
@@ -1,16 +1,24 @@
-# RstoxData v2.0.1-9003  (2024-10-17)
-* Added warning if there are duplicated StratumLayerIndividual in Individuals(). There may however be duplicated StratumLayerIndividual in SuperIndividuals(), e.g. when multiple Beam are used. Added support in imputation to tackle this.
+# RstoxBase v2.0.1-9004  (2024-10-28)
+* Added a warning in NASC() for multiple Beam with the same frequency, which may lead to over-estimation.
+* Changed aggregateBaselineDataOneTableSingleFunction() used by aggregateBaselineDataOneTable() to pad with zeros for all "data" variables, as specified in the dataTypeDefinition.
+* Fixed bug in factorNAfirst() which failed when age plus group was not used.
+* Fixed bug in ReportBootstrap when an integer variables with missing values are reported (in which case replacing NA by 0 did not work).
+* Added splitting by both "-" and "/" in formatOutput to ensure correct sorting. This change should not affect any results through imputation as all known StoX project use only one SpeciesCategory in SuperIndividuals.
+* Temporarily hiding Prey functions.
+
+# RstoxBase v2.0.1-9003  (2024-10-17)
+* Added warning if there are duplicated StratumLayerIndividual in Individuals(). There may however be duplicated StratumLayerIndividual in SuperIndividuals(), e.g. when multiple Beam are used. Added support in imputation to tackle this and avoid errors such as "factor level [2316] is duplicated".
 * Fixed bug when using DefinitionMethod = "PreDefined" in DefineAcousticPSU().
 * Added support for numeric sorting of plus groups in plots, so that 9 comes before 10+.
 * Fixed problem with selecting PointColor in PlotAcousticTrawlSurvey() in the GUI.
 
 
-# RstoxData v2.0.1-9002  (2024-09-17)
+# RstoxBase v2.0.1-9002  (2024-09-17)
 * Renamed ReportVariable to TargetVariable and ReportVariableUnit to TargetVariableUnit in ReportSpeciesCategoryCatch() for consistency with other report functions.
 * Added TargetVariable and TargetVariableUnit in ReportPreySpeciesCategoryCatch().
 
 
-# RstoxData v2.0.1-9001  (2024-09-01)
+# RstoxBase v2.0.1-9001  (2024-09-01)
 * Added functions PreySpeciesCategoryCatch and ReportPreySpeciesCategoryCatch.
 * Added the ReportFunction "number", "fractionOfOccurrence" and "fractionOfSum".
 * Fixed bug where possible values where not available for DensityUnit in ReportDensity().

diff --git a/R/Acoustic.R b/R/Acoustic.R
@@ -32,6 +32,12 @@ NASC <- function(
     if(!allEqual(ChannelReferenceType, na.rm = TRUE) && NROW(NASCData)) {
         stop("The StoxAcousticData must have only one ", type, " in the NASC function. This can be obtained in FilterStoxAcoustic.")
     }
+    # Added a warning for multiple Beam with the same frequency, which may lead to over-estimation:
+    numberOfBeamsPerFrequency <- NASCData[, .(numberOfBeams  = length(unique(Beam))), by = "Frequency"]
+    numberOfBeamsPerFrequency <- subset(numberOfBeamsPerFrequency, numberOfBeams > 1)
+    if(NROW(numberOfBeamsPerFrequency)) {
+        warning("StoX: SEVERE WARNING: There are multiple Beams for the same frequency, which can lead to over-estimation, as AcousticDensity considers Frequency only and not Beam. If NMDEchosounder data were used to produce the NASCData, this can be an indication that different 'transceiver' ID is used for the same frequency, which can occur if two platforms have different frequency as its lowest frequency (e.g. that one of the platforms lack 18 kHz). Please translate the Beam to a common value to avoid this:\n", "Frequency: ", paste(numberOfBeamsPerFrequency$Frequency, collapse = ","), ". Number of Beams: ", paste(numberOfBeamsPerFrequency$numberOfBeams, collapse = ","))
+    }
 
     # Interpret the ChannelDepths:
     getChannelDepth(NASCData)

diff --git a/R/AddResolution.R b/R/AddResolution.R
@@ -14,8 +14,6 @@
 #' @inheritParams MeanLengthDistribution
 #' @inheritParams DefineBioticPSU
 #' 
-#' @export
-#' 
 AddPSUToPreySpeciesCategoryCatch <- function(
         PreySpeciesCategoryCatchData,
         # PSU: 
@@ -31,6 +29,8 @@ AddPSUToPreySpeciesCategoryCatch <- function(
         StratumPolygon = NULL
 ) {
 
+    # Export this function when prey is official
+
     # Convert the PSUDefinitionMethod to "Identity" if "EDSUToPSU":
     PSUDefinitionMethod <- RstoxData::match_arg_informative(PSUDefinitionMethod)
     if(grepl("StationToPSU", PSUDefinitionMethod, ignore.case = TRUE)) {

diff --git a/R/Define.R b/R/Define.R
@@ -1669,6 +1669,7 @@ getSquaredRelativeDiff <- function(LogData, HaulData, variableName, axisLength)
 #'
 #'\emph{MinNumberOfEDSUs} The minimum number of EDSUs to use, effectively expanding the radius to cover this number of EDSUs if an insufficient number of EDSUs is found using the specified radius
 #'  
+#' Note that the AcousticDensity WeightingMethod is time consuming, as distances are calculated to all EDSUs and the acoustic density is calculated for each assigned Haul.
 #' 
 #' @return
 #' An object of StoX data type \code{\link{BioticAssignment}}.

diff --git a/R/Definitions.R b/R/Definitions.R
@@ -198,24 +198,24 @@ initiateRstoxBase <- function(){
             )
         ), 
 
-        # PreySpeciesCategoryIndividualCatchData:
-        PreySpeciesCategoryCatchData = list(
-            horizontalResolution = "Station", 
-            verticalResolution = "Individual", 
-            obserationVariable = NULL,
-            categoryVariable = "PreySpeciesCategory", 
-            groupingVariables = "PreyCatchFractionWeightResolution", 
-            data = c(
-                Weight = c(
-                    "TotalPreyCatchWeight", 
-                    "TotalPreyCatchNumber"
-                )
-            ),
-            verticalRawDimension = c("MinHaulDepth", "MaxHaulDepth"), 
-            verticalLayerDimension = NULL, 
-            weighting = "PreySpeciesCategoryCatchWeightingFactor", 
-            other = NULL
-        ), 
+        ## PreySpeciesCategoryIndividualCatchData:
+        #PreySpeciesCategoryCatchData = list(
+        #    horizontalResolution = "Station", 
+        #    verticalResolution = "Individual", 
+        #    obserationVariable = NULL,
+        #    categoryVariable = "PreySpeciesCategory", 
+        #    groupingVariables = "PreyCatchFractionWeightResolution", 
+        #    data = c(
+        #        Weight = c(
+        #            "TotalPreyCatchWeight", 
+        #            "TotalPreyCatchNumber"
+        #        )
+        #    ),
+        #    verticalRawDimension = c("MinHaulDepth", "MaxHaulDepth"), 
+        #    verticalLayerDimension = NULL, 
+        #    weighting = "PreySpeciesCategoryCatchWeightingFactor", 
+        #    other = NULL
+        #), 
 
 
         AssignmentLengthDistributionData = list(
@@ -382,6 +382,14 @@ initiateRstoxBase <- function(){
     )
     ####
 
+    # Get the list of data variables, which are those that are stored as a vector of variable names in the "data" element of a table defined in dataTypeDefinition:
+    dataVariables <- unique(
+        c(
+            unlist(lapply(dataTypeDefinition, "[", "data")), 
+            unlist(lapply(dataTypeDefinition, function(x) x[["Data"]][["data"]]))
+        )
+    )
+
     #### Data type units: ####
     dataTypeUnits <- list(
         # DensityData
@@ -1027,7 +1035,7 @@ formatOutputOneTable <- function(table, tableDefinition, keep.all = TRUE, allow.
 
     # Order the rows:
     #data.table::setorder(table, na.last = TRUE)
-    RstoxData::setorderv_numeric(table, by = rowOrder, na.last = TRUE)
+    RstoxData::setorderv_numeric(table, by = rowOrder, split = c("-", "/"))
 
     # Delete any keys, as we use the argument 'by' for all merging and aggregation:
     data.table::setkey(table, NULL)

diff --git a/R/PreySpeciesCategoryCatch.R b/R/PreySpeciesCategoryCatch.R
@@ -6,10 +6,10 @@
 #' 
 #' @inheritParams ModelData
 #' 
-#' @export
-#' 
 PreySpeciesCategoryCatch <- function(StoxBioticData) {
 
+    # Export this function when prey is official
+
     # Store the sample names to remove them as columns in the end of the function:
     preySampleNames <- names(StoxBioticData$PreySample)
     preySampleNamesToRemove <- c(preySampleNames[!endsWith(preySampleNames, "Key") & preySampleNames != "PreyCatchFractionWeightResolution"], "PreySampleKey")

diff --git a/R/Report.R b/R/Report.R
@@ -411,15 +411,16 @@ aggregateBaselineDataOneTableSingleFunction <- function(
         #gc()
 
         # Convert the NAs to 0 for the abundance and biomass columns:
-        abudanceVariables <- setdiff(names(stoxData), paddingVariables)
+        possibleAbudanceVariables <- setdiff(names(stoxData), paddingVariables)
         # Convert NA to 0 only for Biomass or Abundance:
-        abudanceVariableKeys <- getDataTypeDefinition("SuperIndividualsData", subTable = "Data", elements = "data", unlist = TRUE)
-        isAbudanceVariable <- rowSums(outer(abudanceVariables, abudanceVariableKeys, startsWith)) > 0
-        abudanceVariables <- abudanceVariables[isAbudanceVariable]
+        abudanceVariableKeys <- getRstoxBaseDefinitions("dataVariables")
+
+        isAbudanceVariable <- rowSums(outer(possibleAbudanceVariables, abudanceVariableKeys, startsWith)) > 0
+        abudanceVariables <- possibleAbudanceVariables[isAbudanceVariable]
 
         if(length(abudanceVariables)) {
             # Set all NA to 0, both those from the original stoxData and those introduced by the grid:
-            replaceNAByReference(stoxData, cols = abudanceVariables, replacement = 0)
+            replaceNAByReference(stoxData, cols = abudanceVariables, replacement = list(numeric = 0, integer = 0L))
             # Restore the NAs from the original stoxData:
             stoxData[areNA, eval(TargetVariable) := NA]
         }
@@ -821,8 +822,6 @@ filterTable <- function(table, filter = character()) {
 #' @return
 #' A \code{\link{ReportPreySpeciesCategoryCatchData}} object.
 #' 
-#' @export
-#' 
 ReportPreySpeciesCategoryCatch <- function(
     PreySpeciesCategoryCatchData, 
     # No longer hard coding this to weight:
@@ -840,9 +839,7 @@ ReportPreySpeciesCategoryCatch <- function(
     FractionOverVariable = character()
 ) 
 {
-    # No longer hard coding this to weight:
-    ## Only Density is relevant here:
-    #TargetVariable <- "TotalPreyCatchWeight"
+    # Export this function when prey is official
 
     # Issue a warning if RemoveMissingValues = TRUE:
     if(isTRUE(RemoveMissingValues) && any(is.na(PreySpeciesCategoryCatchData[[TargetVariable]]))) {

diff --git a/R/RstoxBase-package.R b/R/RstoxBase-package.R
@@ -39,8 +39,9 @@ utils::globalVariables(c(
 	 "backscatteringCrossSection", "crossSection", "distance", "ggtitle", "haulWeightFactor",
 	 "imputeSeed", "includeintotal", "individualNumber", "individualWeightFactor", "inside",
 	 "insideRadius", "intervalIndex", "midIndividualTotalLength", "minDistance",
-	 "missingAssignment", "missingSpecies", "numberOfIndividuals", "numberOfSubSamples",
-	 "polygonAreaSP_simple", "raisingFactor", "representativeBackscatteringCrossSection",
+	 "missingAssignment", "missingSpecies", "numberOfBeams", "numberOfIndividuals",
+	 "numberOfSubSamples", "polygonAreaSP_simple", "raisingFactor",
+	 "representativeBackscatteringCrossSection",
 	 "representativeBackscatteringCrossSectionNormalized", "setUnit", "sumArea",
 	 "sumIndividualWeightFactor", "sumWeightedNumber", "temporary_denominator_column_name",
 	 "temporary_numerator_column_name", "x", "y"))

diff --git a/R/Utilities.R b/R/Utilities.R
@@ -964,14 +964,6 @@ StoxDataStartMiddleStopDateTime <- function(
 #' 
 #' @export
 #' 
-#replaceNAByReference <- function(DT, cols = NULL, replacement = 0) {
-#    if(!length(cols)) {
-#        cols <- names(DT)
-#    }
-#    for (j in cols) {
-#        data.table::set(DT, which(is.na(DT[[j]]) & is.numeric(DT[[j]])), j, replacement)
-#    }
-#}
 replaceNAByReference <- function(DT, cols = NULL, replacement = list(numeric = 0, integer = 0L)) {
     if(length(cols) == 1 && is.na(cols)) {
         cols <- names(DT)
@@ -1760,7 +1752,7 @@ factorNAfirst <- function(x){
     }
 
     # If there are levels ending with "+", this is an indication that a plus group (e.g. age) is given, so we remove the "+" and try as numeric:
-    if(any(endsWith(levels, "+"))) {
+    if(any(endsWith(levels, "+"), na.rm = TRUE)) {
         levels_sans_plus <- convertToNumericIfPossible(sub("+", "", levels, fixed = TRUE))
         levels = levels[order(levels_sans_plus)]
     }

diff --git a/R/backwardCompatibility.R b/R/backwardCompatibility.R
@@ -364,13 +364,6 @@ backwardCompatibility_RstoxBase <- list(
             functionName = "ReportQuantity", 
             modelName = "report", 
             parameterName = "FractionOverVariable"
-        ), 
-        list(
-            changeVersion = "2.0.1-9002", 
-            functionName = "ReportPreySpeciesCategoryCatch", 
-            modelName = "report", 
-            parameterName = "TargetVariable", 
-            parameterValue = "TotalPreyCatchWeight"
         )
     ),  
 
@@ -437,13 +430,6 @@ backwardCompatibility_RstoxBase <- list(
             modelName = "report", 
             parameterName = "ReportVariableUnit",
             newParameterName = "TargetVariableUnit"
-        ), 
-        list(
-            changeVersion = "2.0.1-9002", 
-            functionName = "ReportPreySpeciesCategoryCatch", 
-            modelName = "report", 
-            parameterName = "TotalPreyCatchWeightUnit",
-            newParameterName = "TargetVariableUnit"
         )
     ),