From a55acbd7742c40aaa479e7cb68af6004383592d5 Mon Sep 17 00:00:00 2001 From: Ty Garber Date: Wed, 24 Apr 2024 10:42:36 -0700 Subject: [PATCH] function to compare sfrs rolling sfrs change detection into compare_runs() Increment version number to 0.2.2 --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/compare_inputs.R | 81 ++++++++++++++++++++++- R/zzz.R | 2 +- man/compare_stock_fishery_rate_scalers.Rd | 19 ++++++ 5 files changed, 102 insertions(+), 3 deletions(-) create mode 100644 man/compare_stock_fishery_rate_scalers.Rd diff --git a/DESCRIPTION b/DESCRIPTION index d2f51f0..70780ba 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: framrsquared Type: Package Title: FRAM Database Interface -Version: 0.2.1 +Version: 0.2.2 Author: Ty Garber Maintainer: Ty Garber Description: More about what it does (maybe more than one line) diff --git a/NAMESPACE b/NAMESPACE index bed4336..53273d3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ export(compare_non_retention_input_flags) export(compare_non_retention_inputs) export(compare_recruits) export(compare_runs) +export(compare_stock_fishery_rate_scalers) export(connect_fram_db) export(copy_fishery_scalers) export(disconnect_fram_db) diff --git a/R/compare_inputs.R b/R/compare_inputs.R index eafe0ef..d3b9b0b 100644 --- a/R/compare_inputs.R +++ b/R/compare_inputs.R @@ -447,6 +447,76 @@ compare_non_retention_input_flags <- function(fram_db, run_ids){ } +#' Compares the stock fishery rate scalers of two runs +#' @param fram_db FRAM database object +#' @param run_ids Two run ids +#' @export +#' @examples +#' \dontrun{fram_db |> compare_stock_fishery_rate_scalers(c(55, 56))} +compare_stock_fishery_rate_scalers <- function(fram_db, run_ids){ + + runs <- fram_db |> + fetch_table('RunID') |> + dplyr::select(.data$run_id, .data$run_name) + + stocks <- fram_db |> + fetch_table('Stock') |> + dplyr::filter(.data$species == fram_db$fram_db_species) |> + dplyr::select(.data$stock_id, .data$stock_name) + + fisheries <- fram_db |> + fetch_table('Fishery') |> + dplyr::filter(.data$species == fram_db$fram_db_species) |> + dplyr::select(.data$fishery_id, .data$fishery_name) + + + # stock fishery rate scalers + sfrs <- fram_db |> + fetch_table('StockFisheryRateScaler') |> + dplyr::select(.data$run_id, + .data$stock_id, + .data$fishery_id, + .data$time_step, + .data$stock_fishery_rate_scaler) + + base_run_name <- runs |> + dplyr::filter(.data$run_id == run_ids[[1]]) |> + dplyr::pull(.data$run_name) |> + rlang::sym() #... don't ask, R voodoo magic + + new_run_name <- runs |> + dplyr::filter(.data$run_id == run_ids[[2]]) |> + dplyr::pull(.data$run_name) |> + rlang::sym() #... don't ask, R voodoo magic + + sfrs |> + dplyr::filter(.data$run_id %in% run_ids) |> + dplyr::inner_join(runs, by = 'run_id') |> + dplyr::inner_join(stocks, by = 'stock_id') |> + dplyr::inner_join(fisheries, by = 'fishery_id') |> + dplyr::select( + .data$stock_id, + .data$stock_name, + .data$fishery_id, + .data$fishery_name, + .data$time_step, + .data$stock_fishery_rate_scaler, + .data$run_name + ) |> #View() + tidyr::pivot_wider( + names_from = .data$run_name, + values_from = .data$stock_fishery_rate_scaler + ) |> #print(n=Inf) + dplyr::filter((!!base_run_name != !!new_run_name) | + xor(is.na(!!base_run_name), is.na(!!new_run_name))) |> + dplyr::select(.data$stock_id, + .data$stock_name, + .data$time_step,!!base_run_name,!!new_run_name) |> + `attr<-`('species', fram_db$fram_db_species) # making accessible to package filters + +} + + #' Generates a report to the console of changes to inputs between to runs #' @param fram_db FRAM database object #' @param run_ids Two run ids @@ -529,11 +599,20 @@ compare_runs <- function(fram_db, run_ids, tolerance = .01){ } cli::cli_h3('Checking for changes to fishery flags') - cli::cli_alert_info('Detention tolerance set to: {scales::percent(tolerance)}') + cli::cli_alert_info('detection tolerance set to: {scales::percent(tolerance)}') fishery_inputs <- fram_db |> compare_fishery_inputs(run_ids, tolerance = tolerance) if(nrow(fishery_inputs) > 0){ cli::cli_alert_info('Changes detected in fishery flag inputs, below is a table outlining them') print(fishery_inputs, n=Inf) + } else { + cli::cli_alert_success('No changes detected in fishery flag inputs') + } + + cli::cli_h3('Checking for changes to stock fishery rate scalers') + sfrs <- fram_db |> compare_stock_fishery_rate_scalers(run_ids) + if(nrow(sfrs) > 0){ + cli::cli_alert_info('Changes detected in stock fishery rate scalers, below is a table outlining them') + print(sfrs, n=Inf) } else { cli::cli_alert_success('No changes detected in fishery inputs') } diff --git a/R/zzz.R b/R/zzz.R index 8552fd7..2f93a7c 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -13,7 +13,7 @@ startup_message <- function(){ ,' `. \\ / | O \\___/ | ~^~^~^~^~^~^~^~^~^~^~^~^~ - framrsquared 0.2.1 + framrsquared 0.2.2 " )) )) diff --git a/man/compare_stock_fishery_rate_scalers.Rd b/man/compare_stock_fishery_rate_scalers.Rd new file mode 100644 index 0000000..a61be85 --- /dev/null +++ b/man/compare_stock_fishery_rate_scalers.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compare_inputs.R +\name{compare_stock_fishery_rate_scalers} +\alias{compare_stock_fishery_rate_scalers} +\title{Compares the stock fishery rate scalers of two runs} +\usage{ +compare_stock_fishery_rate_scalers(fram_db, run_ids) +} +\arguments{ +\item{fram_db}{FRAM database object} + +\item{run_ids}{Two run ids} +} +\description{ +Compares the stock fishery rate scalers of two runs +} +\examples{ +\dontrun{fram_db |> compare_stock_fishery_rate_scalers(c(55, 56))} +}