diff --git a/NEWS.md b/NEWS.md index c216f6e6..9baf72d1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,12 @@ # mizer 3.1.0.9000 (development version) +- Mis-spelled column names in the `gear_params` and `species_params` data frames + are now detected by fuzzy matching against the recognised parameter names. A + near miss such as `sel_fun` (instead of `sel_func`) triggers a warning that + suggests the intended name, rather than being silently ignored (#442). Columns + are only flagged, never renamed, so legitimate custom columns are left + untouched. + - `compareParams()` now checks that the number of size bins, species and gears agree before comparing the array-valued slots. When they differ it reports the mismatch instead of erroring while trying to compare arrays of incompatible diff --git a/R/helpers.R b/R/helpers.R index 983abd25..45769c25 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -302,3 +302,57 @@ get_steady_state_n <- function(params, g, mu, D, N0, return(zero_above_support(n, w_top)) } + +#' Warn about column names that look like mis-spelled parameter names +#' +#' Compares the actual column names of a parameter data frame against the set of +#' recognised names and issues a single warning about any names that are a near +#' match (a likely typo) but not an exact match. Names are not corrected, only +#' flagged, so that legitimate custom columns are left untouched. +#' +#' @param actual Character vector of the column names present in the data frame. +#' @param known Character vector of recognised parameter names. +#' @param df_type A short description of the data frame used in the warning +#' message, e.g. `"gear parameter"` or `"species parameter"`. +#' @param curated Character vector of known problematic names that should always +#' be flagged even when they are further than the fuzzy-match threshold from +#' any recognised name (e.g. familiar abbreviations). +#' +#' @return Called for its side effect (a warning). Returns `NULL` invisibly. +#' @concept helper +#' @noRd +check_for_misspellings <- function(actual, known, df_type, + curated = character(0)) { + unknown <- setdiff(actual, known) + if (length(unknown) == 0) { + return(invisible(NULL)) + } + # Only fuzzy-match against names long enough that a near miss is meaningful. + known_fuzzy <- known[nchar(known) >= 3] + hits <- character(0) + guess <- character(0) + for (nm in unknown) { + if (length(known_fuzzy) == 0) { + j <- integer(0) + near <- FALSE + } else { + d <- as.vector(adist(nm, known_fuzzy, ignore.case = TRUE)) + j <- which.min(d) + near <- nchar(nm) >= 3 && + (d[j] == 1 || (d[j] <= 2 && nchar(known_fuzzy[j]) >= 6)) + } + if (nm %in% curated || near) { + hits <- c(hits, nm) + guess <- c(guess, if (length(j) == 1) known_fuzzy[j] else NA_character_) + } + } + if (length(hits) > 0) { + suggestions <- ifelse(is.na(guess), paste0("`", hits, "`"), + paste0("`", hits, "` (did you mean `", guess, "`?)")) + warning("Some column names in your ", df_type, " data ", + "frame are very close to standard parameter names: ", + paste(suggestions, collapse = ", "), + ". Please check for mis-spellings.") + } + invisible(NULL) +} diff --git a/R/setFishing.R b/R/setFishing.R index 8896b3c7..66c4eb11 100644 --- a/R/setFishing.R +++ b/R/setFishing.R @@ -324,7 +324,7 @@ setFishing.MizerParams <- function(params, selectivity = NULL, catchability = NU #' gear = c("gear1", "gear2", "gear1"), #' species = c("Cod", "Cod", "Haddock"), #' catchability = c(0.5, 2, 1), -#' sel_fun = c("sigmoid_weight", "knife_edge", "sigmoid_weight"), +#' sel_func = c("sigmoid_weight", "knife_edge", "sigmoid_weight"), #' sigmoidal_weight = c(1000, NA, 800), #' sigmoidal_sigma = c(100, NA, 100), #' knife_edge_size = c(NA, 1000, NA) @@ -391,16 +391,22 @@ is.gear_params <- function(x) { } check_gear_params <- function(x) { - # Check for misspellings - misspellings <- c("selfunc", "selectivity_function", "catch", "catchab", - "sigmoid_weight", "sigmoid_sigma", "knife_edge") - query <- intersect(misspellings, names(x)) - if (length(query) > 0) { - warning("Some column names in your gear parameter data ", - "frame are very close to standard parameter names: ", - paste(query, collapse = ", "), - ". Did you perhaps mis-spell the names?") + # Warn about column names that look like mis-spelled parameter names. + # Recognised names are the core columns plus the parameters of the + # selectivity functions (both the built-in ones and any function actually + # referenced in the `sel_func` column, so custom parameters are recognised). + known <- c("species", "gear", "sel_func", "catchability", "yield_observed", + "l25", "l50", "l50_right", "l25_right", "knife_edge_size", + "sigmoidal_weight", "sigmoidal_sigma") + if ("sel_func" %in% names(x)) { + for (sf in unique(x$sel_func[!is.na(x$sel_func)])) { + args <- tryCatch(names(formals(sf)), error = function(e) NULL) + known <- union(known, setdiff(args, c("w", "species_params", "..."))) + } } + curated <- c("selfunc", "selectivity_function", "catch", "catchab", + "sigmoid_weight", "sigmoid_sigma", "knife_edge") + check_for_misspellings(names(x), known, "gear parameter", curated) # Auto-populate missing argument columns for selectivity functions if ("sel_func" %in% names(x)) { diff --git a/R/species_params.R b/R/species_params.R index 3e3ad71d..772cbe7a 100644 --- a/R/species_params.R +++ b/R/species_params.R @@ -243,19 +243,51 @@ is.species_params <- function(x) { inherits(x, "species_params") } +# Recognised species_params column names, used by check_for_misspellings() to +# flag likely typos. This is not an exhaustive list of every possible column +# (users may add custom columns), but covers the standard parameters so that a +# near miss can be detected. Grouped roughly by purpose. +known_species_params_columns <- function() { + c(# identity and sizes + "species", "w_max", "w_mat", "w_mat25", "w_min", "w_inf", + "w_repro_max", "w_min_idx", + # length-based equivalents and length-weight parameters + "l_max", "l_mat", "l_mat25", "l_min", "l_inf", "l_repro_max", "a", "b", + # von Bertalanffy growth + "k_vb", "t0", "age_mat", + # physiology + "h", "k", "ks", "gamma", "alpha", "beta", "sigma", + "n", "p", "q", "m", "z0", "fc", "f0", "erepro", + "d", "z_ext", "D_ext", "E_ext", + # reproduction + "R_max", "r_max", "constant_recruitment", "constant_reproduction", + "ricker_b", "sheperd_b", "sheperd_c", + # predation kernel + "pred_kernel_type", "kernel_exp", "kernel_l_l", "kernel_u_l", + "kernel_l_r", "kernel_u_r", "ppmr_min", "ppmr_max", + # fishing + "gear", "sel_func", "catchability", "knife_edge_size", + "yield_observed", "catch_observed", + # interactions + "interaction_resource", "interaction_p", + # observations + "biomass_observed", "biomass_cutoff", "number_observed", "number_cutoff", + # flags and plotting + "is_background", "linecolour", "linetype", "legend_name") +} + +# Familiar abbreviations / capitalisation mistakes that should always be flagged +# even when further than the fuzzy-match threshold from a recognised name. +curated_species_params_misspellings <- function() { + c("wmin", "wmax", "wmat", "wmat25", "w_mat_25", "Rmax", + "Species", "Gamma", "Beta", "Sigma", "Alpha", + "W_min", "W_max", "W_mat", "e_repro", "Age_mat", "w_max_mat") +} + check_and_convert_species_params <- function(x) { - # Check for misspellings - misspellings <- c("wmin", "wmax", "wmat", "wmat25", "w_mat_25", "Rmax", - "Species", "Gamma", "Beta", "Sigma", "Alpha", - "W_min", "W_max", "W_mat", "e_repro", "Age_mat", - "w_max_mat") - query <- intersect(misspellings, names(x)) - if (length(query) > 0) { - warning("Some column names in your species parameter data ", - "frame are very close to standard parameter names: ", - paste(query, collapse = ", "), - ". Did you perhaps mis-spell the names?") - } + check_for_misspellings(names(x), known_species_params_columns(), + "species parameter", + curated_species_params_misspellings()) # Auto convert length to weight if allometric parameters exist if (all(c("a", "b") %in% names(x))) { @@ -413,19 +445,10 @@ given_species_params.data.frame <- function(object, strict = FALSE, ...) { # Convert a tibble back to an ordinary data frame sp <- as.data.frame(object, stringsAsFactors = FALSE) - # Check for misspellings - misspellings <- c("wmin", "wmax", "wmat", "wmat25", "w_mat_25", "Rmax", - "Species", "Gamma", "Beta", "Sigma", "Alpha", - "W_min", "W_max", "W_mat", "e_repro", "Age_mat", - "w_max_mat") - query <- intersect(misspellings, names(sp)) - if (length(query) > 0) { - warning("Some column names in your species parameter data ", - "frame are very close to standard parameter names: ", - paste(query, collapse = ", "), - ". Did you perhaps mis-spell the names?") - } - + check_for_misspellings(names(sp), known_species_params_columns(), + "species parameter", + curated_species_params_misspellings()) + # check species if (!("species" %in% colnames(sp))) { stop("The species params dataframe needs a column 'species' with the species names") diff --git a/man/gear_params.Rd b/man/gear_params.Rd index 9ffe7e6c..4b94a112 100644 --- a/man/gear_params.Rd +++ b/man/gear_params.Rd @@ -68,7 +68,7 @@ gear_params(params) <- data.frame( gear = c("gear1", "gear2", "gear1"), species = c("Cod", "Cod", "Haddock"), catchability = c(0.5, 2, 1), - sel_fun = c("sigmoid_weight", "knife_edge", "sigmoid_weight"), + sel_func = c("sigmoid_weight", "knife_edge", "sigmoid_weight"), sigmoidal_weight = c(1000, NA, 800), sigmoidal_sigma = c(100, NA, 100), knife_edge_size = c(NA, 1000, NA) diff --git a/tests/testthat/test-setFishing.R b/tests/testthat/test-setFishing.R index 6d6ba017..78683600 100644 --- a/tests/testthat/test-setFishing.R +++ b/tests/testthat/test-setFishing.R @@ -408,6 +408,15 @@ test_that("gear_params reactive validation works", { df <- data.frame(species = "Sprat", gear = "g", selfunc = "knife_edge") expect_warning(gp <- gear_params(df), "very close to standard parameter names") + # 1b. Fuzzy typo (issue #442): `sel_fun` should be flagged as `sel_func` + df_typo <- data.frame(species = "Sprat", gear = "g", sel_fun = "knife_edge") + expect_warning(gear_params(df_typo), "did you mean `sel_func`") + # A legitimate custom column must not be flagged + df_custom <- data.frame(species = "Sprat", gear = "g", + sel_func = "knife_edge", knife_edge_size = 10, + my_custom_note = "abc") + expect_no_warning(gear_params(df_custom)) + # 2. Parameter checks for sigmoid_length (l25 >= l50) df2 <- data.frame(species = "Sprat", gear = "g", sel_func = "sigmoid_length", l25 = 15, l50 = 10) expect_warning(gp2 <- gear_params(df2), "must be smaller than l50") diff --git a/tests/testthat/test-species_params.R b/tests/testthat/test-species_params.R index 114bd7f7..75efe4fe 100644 --- a/tests/testthat/test-species_params.R +++ b/tests/testthat/test-species_params.R @@ -298,6 +298,12 @@ test_that("Reactive validation and conversions work", { df <- data.frame(species = c("Sprat", "Herring"), w_inf = c(10, 100)) sp <- species_params(df) expect_warning(sp$wmin <- 0.1, "very close to standard parameter names") + # Fuzzy typo of a recognised name is flagged with a suggestion ... + expect_warning(sp$w_maxx <- 100, "did you mean `w_max`") + # ... but a genuine custom column is not (use a fresh object without the + # typo'd columns added above) + sp_clean <- species_params(df) + expect_no_warning(sp_clean$my_note <- "x") # 2. Length-to-weight conversion df2 <- data.frame(species = "Sprat", a = 0.01, b = 3, l_mat = 10)