Merge pull request #178 from StoXProject/catchLotteryStox4

Catch lottery stox4

NEWS.md

@@ -1,6 +1,8 @@
 # 1.5.0-9004
+* Added / exposed function for collapsing strata on IndividualSamplingParameters (CollapseStrata)
 * Added documentation for dealing with incomplete biological records (#170)
 * Made stratification options for ComputePsuSamplingParameters more flexible (#171)
+* Fixed a bug with handling of NA values in AddLengthGroupStoxBiotic
 * 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

R/StoxAnalyticalBaselineFunctions.R

@@ -776,9 +776,6 @@ AssignPSUSamplingParameters <- function(PSUSamplingParametersData, StoxBioticDat
 #'  If any strata are specified in the SampleTable of 'IndividualSamplingParametersData' but are not sampled per the SelectionTable
 #'  all estimates will be provided as NAs for this stratum.
 #'  
-#'  Domains that are not present in a sample are not reported, although their estimated abundance and total is zero. Use the function
-#'  \code{\link[RstoxFDA]{LiftStrata}} to infer zero values for unreported domains, and mark unsampled strata as NA.
-#'  
 #'  In general unbiased estimates rely on known inclusion probabilites, and domain definitions that coincides
 #'  with stratification. When the domain definitions are not aligned
 #'  with the stratification, ratio estimates are provided for which unbiasedness is not guaranteed.
@@ -1333,7 +1330,7 @@ AnalyticalPopulationEstimate <- function(PSUSamplingParametersData, AnalyticalPS
 
   NestimatesByStrata <- AnalyticalPSUEstimateData$Abundance[,list(estimates=get(".N")),by="Stratum"]
   if (!length(unique(NestimatesByStrata$estimates))==1){
-    stop("Cannot Estimate with heterogeneous lower level stratification. Consider the functions LiftStrata or CollapseStrata.")
+    stop("Cannot Estimate with heterogeneous lower level stratification. Consider the function CollapseStrata.")
   }
 
   LowerLevelStrata <- AnalyticalPSUEstimateData$StratificationVariables[!duplicated(get("Stratum")),.SD, .SDcol=names(AnalyticalPSUEstimateData$StratificationVariables)[names(AnalyticalPSUEstimateData$StratificationVariables)!="SampleId"]]
@@ -1353,8 +1350,8 @@ AnalyticalPopulationEstimate <- function(PSUSamplingParametersData, AnalyticalPS
   missingMean <- AnalyticalPSUEstimateData$Variables$SampleId[is.na(AnalyticalPSUEstimateData$Variables$Mean) & !is.nan(AnalyticalPSUEstimateData$Variables$Mean)]
 
   if (!MeanOfMeans & (length(missingAbund)>0 | length(missingTotal)>0)){
-    msg <- "Cannot estimate. Estimates are not provided for all samples in 'AnalyticalPSUEstimateData'."
-    if (length(missingFreq)==0 & length(missingMean)==0){
+    msg <- "Cannot estimate. Abundance- or total-estimates are not provided for all samples in 'AnalyticalPSUEstimateData'."
+    if (length(missingFreq)==0 | length(missingMean)==0){
       msg <- paste(msg, "Consider the option MeanOfMeans.")
     }
 
@@ -1364,7 +1361,7 @@ AnalyticalPopulationEstimate <- function(PSUSamplingParametersData, AnalyticalPS
   }
 
   if (MeanOfMeans & (length(missingFreq)>0 | length(missingMean)>0)){
-    msg <- "Cannot estimate. Estimates are not provided for all samples in 'AnalyticalPSUEstimateData'."
+    msg <- "Cannot estimate. Frequency- or means-estimates are not provided for all samples in 'AnalyticalPSUEstimateData'."
     missing <- unique(c(missingFreq, missingMean))
 
     msg <- paste(msg, "Missing for SamplingUnitIds:", truncateStringVector(missing))
@@ -1578,6 +1575,7 @@ AnalyticalRatioEstimate <- function(AnalyticalPopulationEstimateData, StoxLandin
 
   checkMandatory(AnalyticalPopulationEstimateData, "AnalyticalPopulationEstimateData")
   checkMandatory(StoxLandingData, "StoxLandingData")
+  checkLandingsNotEmpty(StoxLandingData)
   checkMandatory(WeightVariable, "WeightVariable")
   checkOptions(Method, "Method", c("TotalDomainWeight", "MeanDomainWeight"))
   checkMandatory(StratificationVariables, "StratificationVariables")
@@ -1958,6 +1956,7 @@ ExtendAnalyticalSamplingFrameCoverage <- function(AnalyticalPopulationEstimateDa
 
   checkMandatory(AnalyticalPopulationEstimateData, "AnalyticalPopulationEstimateData")
   checkMandatory(StoxLandingData, "StoxLandingData")
+  checkLandingsNotEmpty(StoxLandingData)
   checkMandatory(StratificationVariables, "StratificationVariables")
   checkOptions(Method, "Method", c("Strict", "SetToStratum"))
   checkMandatory(UnsampledStratum, "UnsampledStratum")
@@ -2342,6 +2341,7 @@ InterpolateAnalyticalDomainEstimates <- function(AnalyticalPopulationEstimateDat
 
   checkMandatory(AnalyticalPopulationEstimateData, "AnalyticalPopulationEstimateData")
   checkMandatory(StoxLandingData, "StoxLandingData")
+  checkLandingsNotEmpty(StoxLandingData)
   checkOptions(Method, "Method", c("Strict", "StratumMean"))
   if (Method=="StratumMean"){
     checkMandatory(DomainMarginVariables, "DomainMarginVariables")
@@ -2513,8 +2513,8 @@ AddLengthGroupStoxBiotic <- function(StoxBioticData, LengthInterval=numeric(), L
   }
   StoxBioticData$Individual[[LengthGroupVariable]] <- as.character(
     cut(StoxBioticData$Individual$IndividualTotalLength, 
-        seq(0, max(StoxBioticData$Individual$IndividualTotalLength)+LengthInterval, LengthInterval), 
+        seq(0, max(StoxBioticData$Individual$IndividualTotalLength,na.rm=T)+LengthInterval, LengthInterval), 
         right=LeftOpen))
-
+  StoxBioticData$Individual[[LengthGroupVariable]][is.na(StoxBioticData$Individual$IndividualTotalLength)] <- as.character(NA)
   return(StoxBioticData)
 }

R/StoxBaselineFunctions.R

@@ -1,5 +1,13 @@
-
-
+#' Halts with error if StoxLandingData is empty
+#' @noRd
+checkLandingsNotEmpty <- function(StoxLandingData){
+  if (!RstoxData::is.StoxLandingData(StoxLandingData)){
+    stop("Malformed StoxLandingData")
+  }
+  if (nrow(StoxLandingData$Landing)==0){
+    stop("StoxLandingData is empty.")
+  }
+}
 
 #' Checks symmetry of Car table
 #' @noRd
@@ -929,6 +937,7 @@ AddGearGroupStoxLanding <- function(StoxLandingData, Translation){
 
   checkMandatory(StoxLandingData, "StoxLandingData")
   checkMandatory(Translation, "Translation")
+  checkLandingsNotEmpty(StoxLandingData)
 
   if (!is.Translation(Translation)){
     stop("Translation is not a valid Translation table.")

R/StoxDataTypes.R

@@ -2456,6 +2456,14 @@ stoxFunctionAttributes <- list(
       )
     )
   ),
+  CollapseStrata = list(
+    functionType = "modelData", 
+    functionCategory = "baseline", 
+    functionOutputDataType = "IndividualSamplingParametersData",
+    functionParameterFormat = list(
+      RetainStrata = "collapsestrataretain"
+    )
+  ),
   ComputePSUSamplingParameters = list(
     functionType = "modelData", 
     functionCategory = "baseline", 
@@ -3384,6 +3392,15 @@ processPropertyFormats <- list(
       return(pv)
     },
     variableTypes = "character"
+  ),
+  collapsestrataretain = list(
+    class = "vector",
+    title = "Strata to retain from collapse", 
+    possibleValues = function(IndividualSamplingParametersData){
+      pv <- unique(IndividualSamplingParametersData$StratificationVariables$Stratum)
+      return(pv)
+    },
+    variableTypes = "character"
   )
 )
 

inst/tinytest/test-StoxAnalyticalBaselineFunctions.R

@@ -273,7 +273,7 @@ stationDesign <- RstoxFDA:::ComputePSUSamplingParameters(StoxBioticData = ss, Sa
 sexStrat <-  RstoxFDA:::ComputeIndividualSamplingParameters(ss, "Stratified", c("IndividualAge"), StratificationColumns = "IndividualSex")
 expect_warning(psuEst <- RstoxFDA:::AnalyticalPSUEstimate(ss, sexStrat, "IndividualRoundWeight", c("IndividualSex")), "Not all strata are sampled. Estimates will not be provided for some strata for SampleIds:")
 psuEst <- RstoxFDA:::LiftStrata(psuEst)
-expect_error(popEst <- RstoxFDA:::AnalyticalPopulationEstimate(stationDesign, psuEst), "Cannot estimate. Estimates are not provided for all samples in 'AnalyticalPSUEstimateData'. Missing for SamplingUnitIds:")
+expect_error(popEst <- RstoxFDA:::AnalyticalPopulationEstimate(stationDesign, psuEst), "Cannot estimate. Abundance- or total-estimates are not provided for all samples in 'AnalyticalPSUEstimateData'. Missing for SamplingUnitIds")
 
 #Test that Abundance and Frequency are NA for unsampled strata (Domain Sex is Unsampled for strata unkown sex)
 unsampled <- merge(psuEst$Abundance, sexStrat$SampleTable[n==0], by=c("SampleId", "Stratum"))