fixed issue with reports over several strata

NEWS.md

@@ -1,4 +1,5 @@
 # 1.5.0-9004
+* Fixed a bug with missing error detection when trying to report estimates over several strata (#173)
 * Fixed a bug which would cause duplicate samplingUnitIds in the SelectionTable when running ComputePsuSamplingParameters with the option "adHocStoxBiotic" (#172)
 * Fixed a bug which cause the menu for ExtendAnalyticalSamplingFrameCoverage to not show options for StratificationVariables
 * Fixed a bug which caused AssignPSUSamplingParameters to report the wrong records as missing, when data is not provided for all sampled records

R/StoxAnalyticalReportFunction.R

@@ -1,3 +1,11 @@
+#' Raise an error if reporting is attempted for estimates with several strata.
+#' @noRd
+checkAggregation <- function(AnalyticalPopulationEstimateData){
+  if (length(unique(AnalyticalPopulationEstimateData$StratificationVariables$Stratum))>1){
+    stop("Report function does not support several strata. Consider aggregating with 'AggregateAnalyticalEstimate'. Specify any desired grouping variables as PSU-domains.")
+  }
+}
+
 #' Redefines age variable as lowest age in age group
 #' Adds plusgroup and puts NA group to 0.
 #' Assumes zero covariance for unkown covariances.
@@ -126,7 +134,10 @@ ReportAnalyticalCatchAtAge <- function(AnalyticalPopulationEstimateData, PlusGro
   AgeDomainVar = "IndividualAge"
 
   checkMandatory(AnalyticalPopulationEstimateData, "AnalyticalPopulationEstimateData")
-  stopifnot(is.AnalyticalPopulationEstimateData(AnalyticalPopulationEstimateData))
+  if (!is.AnalyticalPopulationEstimateData(AnalyticalPopulationEstimateData)){
+    stop("Malformed 'AnalyticalPopulationEstimateData'")
+  }
+  checkAggregation(AnalyticalPopulationEstimateData)
 
   if (!(AgeDomainVar %in% names(AnalyticalPopulationEstimateData$DomainVariables))){
     stop(paste("Catch-at-age reporting, requires the StoxBiotic variable 'IndividualAge' to be among the domain variables of 'AnalyticalPopulationEstimateData'."))
@@ -200,7 +211,11 @@ ReportAnalyticalCatchAtAge <- function(AnalyticalPopulationEstimateData, PlusGro
 ReportAnalyticalCatchAtLength <- function(AnalyticalPopulationEstimateData, LengthGroupVariable=character(), IntervalWidth=numeric(), Decimals=integer(), Unit=RstoxData::getUnitOptions("cardinality", conversionRange=c(1,1e12))){
 
   checkMandatory(AnalyticalPopulationEstimateData, "AnalyticalPopulationEstimateData")
-  stopifnot(is.AnalyticalPopulationEstimateData(AnalyticalPopulationEstimateData))
+  if (!is.AnalyticalPopulationEstimateData(AnalyticalPopulationEstimateData)){
+    stop("Malformed 'AnalyticalPopulationEstimateData'")
+  }
+  checkAggregation(AnalyticalPopulationEstimateData)
+
   checkMandatory(LengthGroupVariable, "LengthGroupVariable")
   if (!(LengthGroupVariable %in% names(AnalyticalPopulationEstimateData$DomainVariables))){
     stop(paste("Catch-at-length reporting, requires the StoxBiotic variable identified by 'LengthGroupVariable'", LengthGroupVariable," to be among the domain variables of 'AnalyticalPopulationEstimateData'."))
@@ -322,7 +337,12 @@ ReportAnalyticalWeightAtAge <- function(AnalyticalPopulationEstimateData, PlusGr
   AgeDomainVar = "IndividualAge"
   WeightVar = "IndividualRoundWeight"
   checkMandatory(AnalyticalPopulationEstimateData, "AnalyticalPopulationEstimateData")
-  stopifnot(is.AnalyticalPopulationEstimateData(AnalyticalPopulationEstimateData))
+
+  if (!is.AnalyticalPopulationEstimateData(AnalyticalPopulationEstimateData)){
+    stop("Malformed 'AnalyticalPopulationEstimateData'")
+  }
+  checkAggregation(AnalyticalPopulationEstimateData)
+
   if (!(AgeDomainVar %in% names(AnalyticalPopulationEstimateData$DomainVariables))){
     stop(paste("Weight-at-age reporting, requires the StoxBiotic variable '",AgeDomainVar,"' to be among the domain variables of 'AnalyticalPopulationEstimateData'."))
   }
@@ -379,7 +399,12 @@ ReportAnalyticalLengthAtAge <- function(AnalyticalPopulationEstimateData, PlusGr
   AgeDomainVar = "IndividualAge"
   LengthVar = "IndividualTotalLength"
   checkMandatory(AnalyticalPopulationEstimateData, "AnalyticalPopulationEstimateData")
-  stopifnot(is.AnalyticalPopulationEstimateData(AnalyticalPopulationEstimateData))
+
+  if (!is.AnalyticalPopulationEstimateData(AnalyticalPopulationEstimateData)){
+    stop("Malformed 'AnalyticalPopulationEstimateData'")
+  }
+  checkAggregation(AnalyticalPopulationEstimateData)
+
   if (!(AgeDomainVar %in% names(AnalyticalPopulationEstimateData$DomainVariables))){
     stop(paste("Length-at-age reporting, requires the StoxBiotic variable '",AgeDomainVar,"' to be among the domain variables of 'AnalyticalPopulationEstimateData'."))
   }

inst/tinytest/test-StoxAnalyticalReportFunction.R

@@ -165,3 +165,27 @@ cal <- RstoxFDA:::ReportAnalyticalCatchAtLength(popEst, LengthGroupVariable = "L
 expect_true(abs(sum(cal$NbyLength$CatchAtLength) - sum(caaReport$NbyAge$CatchAtAge)) / sum(cal$NbyLength$CatchAtLength) < 1e-2)
 expect_true("Gear" %in% names(cal$NbyLength))
 expect_true("Gear" %in% cal$GroupingVariables$GroupingVariables)
+
+
+
+#
+# check reports for estimates with several strata
+#
+stationDesign <- RstoxFDA::CatchLotterySamplingExample
+stationDesign$StratificationVariables <- rbind(stationDesign$StratificationVariables, data.table::data.table(Stratum="S2", CountryVessel="OUT"))
+stationDesign$SampleTable <- rbind(stationDesign$SampleTable, data.table::data.table(Stratum="S2", N=100, n=2, SelectionMethod="Poisson", FrameDescription="OUT"))
+stationDesign$SampleTable$n[1] <- stationDesign$SampleTable$n[1]-2
+stationDesign$SelectionTable$Stratum[stationDesign$SelectionTable$SamplingUnitId %in% c("38401","38433")] <- "S2"
+
+ex <- RstoxFDA::CatchLotteryExample
+ex$SpeciesCategory$SpeciesCategory <- "061104"
+stationDesign <- RstoxFDA::AssignPSUSamplingParameters(stationDesign, ex, "serialnumber", "Haul", "MissingAtRandom")
+srs <-  RstoxFDA:::ComputeIndividualSamplingParameters(ex, "SRS", c("IndividualAge"))
+#add stratificaion variable to domain definition
+psuEst <- RstoxFDA:::AnalyticalPSUEstimate(ex, srs, c("IndividualRoundWeight"), c("IndividualAge", "SpeciesCategory"))
+popEst <- RstoxFDA:::AnalyticalPopulationEstimate(stationDesign, psuEst)
+
+expect_error(RstoxFDA:::ReportAnalyticalCatchAtAge(popEst, Decimals = 1, IntervalWidth = .9, Unit = "individuals"), "Report function does not support several strata. Consider aggregating with 'AggregateAnalyticalEstimate'. Specify any desired grouping variables as PSU-domains.")
+agg <- RstoxFDA::AggregateAnalyticalEstimate(popEst, AggregateStratumName = "agg")
+aggRep <- RstoxFDA:::ReportAnalyticalCatchAtAge(agg, Decimals = 1, IntervalWidth = .9, Unit = "individuals")
+expect_true("SpeciesCategory" %in% names(aggRep$NbyAge))