R/Module_prepDataForRapidStatus.R

In Pacific-salmon-assess/WSP-Metrics-Pkg: WSPMetrics Package: R package to calculate and use metrics for status assessments under Canada's Wild Salmon Policy (WSP)

#' prepDataForRapidStatus
#'
#' this reorganizes the output from calculateMetricsByCU() into the format required by generateRapidStatus().
#' @param cu.info a data frame with specifications for each CU. For details, see help file for calculateMetricsByCU().
#' @param  metrics.raw data frame with calculated metrics generated by calculateMetricsByCU().
#' @param gen.avg.src data frame with calculated generational averages generated by calculateMetricsByCU().
#' @param out.label label to use in the filenames for the output
#' @param out.filepath folder for storing the output files 
#' @keywords trend
#' @export


prepDataForRapidStatus <- function(cu.info,metrics.raw,gen.avg.src, 
								 out.label = "MetricsOut",
								 out.filepath = ""){

require(dplyr)
require(tidyr)

# fix the CU_ID ("_" vs. "-") (just in case, this is a recurring issue)
cu.info$CU_ID <- gsub("_","-",cu.info$CU_ID)
metrics.raw$CU_ID <- gsub("_","-",metrics.raw$CU_ID)
gen.avg.src$CU_ID <- gsub("_","-",gen.avg.src$CU_ID)

  
# change to the units the algorithms are using
metrics.raw[metrics.raw$Metric == "LongTrend","Value"] <- metrics.raw[metrics.raw$Metric == "LongTrend","Value"] * 100 
metrics.raw[metrics.raw$Metric == "LongTrend","LBM"] <- metrics.raw[metrics.raw$Metric == "LongTrend","LBM"] * 100 
metrics.raw[metrics.raw$Metric == "LongTrend","UBM"] <- metrics.raw[metrics.raw$Metric == "LongTrend","UBM"] * 100 
  
# Get the ratios
metrics.tmp1 <- metrics.raw %>% rename(Compare=Value) %>%
                                                          #relocate(Data_Type, .after=Label) %>%
                                                          left_join(cu.info %>% select(CU_ID, DataType=DataQualkIdx, AbdMetric, AbsAbdMetric, ShortTrendMetric, LongTrendMetric, PercentileMetric), by="CU_ID" ) %>%
                                                          # Replace Value with NA when expert defined column says this metric is not appropriate for the data
                                                          mutate(Compare = replace(Compare, (Metric == "RelAbd" & AbdMetric==FALSE) , NA)) %>%
                                                          mutate(Compare = replace(Compare, (Metric == "AbsAbd" & AbsAbdMetric==FALSE) , NA)) %>%
                                                          mutate(Compare = replace(Compare, ((Metric == "PercChange" | Metric == "ProbDeclBelowLBM") & ShortTrendMetric==FALSE) , NA)) %>%
                                                          mutate(Compare = replace(Compare, ((Metric == "LongTrend") & LongTrendMetric==FALSE) , NA)) %>%
                                                          mutate(Compare = replace(Compare, (( Metric == "Percentile" ) & PercentileMetric==FALSE) , NA)) %>%
                                                          mutate(Value= case_when( (Metric == "RelAbd" | Metric == "AbsAbd") ~ (Compare/LBM), 
                                                                                   (Metric != "RelAbd" & Metric != "AbsAbd") ~ (Compare)
                                                          )
                                                          ) %>%
                                                          mutate(Metric = recode(Metric, RelAbd = "RelLBM", AbsAbd = "AbsLBM")) 


metrics.tmp2 <- metrics.tmp1 %>% rbind(metrics.tmp1 %>% filter(Metric == "RelLBM"| Metric =="AbsLBM") %>% 
                                                        mutate(Value=Compare/UBM) %>%
                                                        mutate(Metric=recode(Metric, RelLBM = "RelUBM", AbsLBM = "AbsUBM"))
                                                        ) %>%
                                                        mutate(Status = replace(Status, is.na(Value), NA)) %>%
                                                        select(-c(Data_Type, AbdMetric, AbsAbdMetric, ShortTrendMetric, LongTrendMetric, PercentileMetric)) 


# Write long format metrics to sub file
write.csv(metrics.tmp2, paste0(out.filepath,"/Metrics_Longform_SUB_",out.label,".csv"))

std.metrics <- c("AbsLBM","AbsUBM","LongTrend","PercChange","RelLBM","RelUBM")

metrics.synoptic.values <- metrics.tmp2 %>% 
                                            select(-c(Label, Compare, LBM, UBM, Status)) %>%
                                            pivot_wider(names_from = Metric, values_from=Value)    

metrics.synoptic.status <- metrics.tmp2 %>% 
                                            select(-c(Label, Compare, LBM, UBM, Value)) %>%
                                            pivot_wider(names_from = Metric, values_from=Status) %>%
                                            mutate(RelAbd = RelUBM, AbsAbd = AbsLBM)



metrics.synoptic.values[["NumStdMetrics"]] <-  rowSums(!is.na(metrics.synoptic.values[,std.metrics]))
metrics.synoptic.status[["NumStdMetrics"]] <-  rowSums(!is.na(metrics.synoptic.status[,std.metrics]))


metrics.synoptic.values <- metrics.synoptic.values %>% left_join(gen.avg.src, by=c("CU_ID", "Year"))
metrics.synoptic.status <- metrics.synoptic.status %>% left_join(gen.avg.src, by=c("CU_ID", "Year"))
																								   
# Write files for running the algorithms in retro
write.csv( metrics.synoptic.values, paste0(out.filepath,"/Retrospective_Metrics_Values_",out.label,".csv"), row.names = FALSE)
write.csv( metrics.synoptic.status, paste0(out.filepath,"/Retrospective_Metrics_Status_",out.label,".csv"), row.names = FALSE)     

                
return(list(Values = metrics.synoptic.values,
	   Status = metrics.synoptic.status,
	   LongForm = metrics.tmp2))

}