This function calculates metric scores based on a Thresholds data frame. Can generate scores for categories n=3 (e.g., 1/3/5, ScoreRegime="Cat_135") or n=4 (e.g., 0/2/4/6, ScoreRegime="Cat_0246") or continuous (e.g., 0-100, ScoreRegime="Cont_0100").
metric.scores(
DF_Metrics,
col_MetricNames,
col_IndexName,
col_IndexClass,
DF_Thresh_Metric,
DF_Thresh_Index,
col_ni_total = "ni_total",
col_IndexRegion = NULL
)Data frame of metric values (as columns), Index Name, and Index Region (strata).
Names of columns of metric values.
Name of column with index (e.g., MBSS.2005.Bugs)
Name of column with relevant bioregion or site class (e.g., COASTAL).
Data frame of Scoring Thresholds for metrics (INDEX_NAME, INDEX_CLASS, METRIC_NAME, Direction, Thresh_Lo, Thresh_Mid, Thresh_Hi, ScoreRegime , SingleValue_Add, NormDist_Tail_Lo, NormDist_Tail_Hi, CatGrad_xvar , CatGrad_InfPt, CatGrad_Lo_m, CatGrad_Lo_b, CatGrad_Mid_m, CatGrad_Mid_b , CatGrad_Hi_m, CatGrad_Hi_b).
Data frame of Scoring Thresholds for indices (INDEX_NAME, INDEX_CLASS,METRIC_NAME, ScoreRegime, Thresh01, Thresh02 , Thresh03, Thresh04, Thresh05, Thresh06, Thresh07 , Nar01, Nar02, Nar03, Nar04, Nar05, Nar06).
Name of column with total number of individuals. Used for cases where sample was collected but no organisms collected. Default = ni_total.#'
Name of column with relevant bioregion or site class (e.g., COASTAL). Default = NULL. DEPRECATED
vector of scores
The R library dplyr is needed for this function.
For all ScoreRegime cases at the index level a "sum_Index" field is computed that is the sum of all metric scores. Valid "ScoreRegime" values are:
* SUM = all metric scores added together.
* AVERAGE = all metric scores added and divided by the number of metrics. The index is on the same scale as the individual metric scores.
* AVERAGE_100 = AVERAGE is scaled 0 to 100.
FIX, 2024-01-29, v1.0.0.9060 Rename col_IndexRegion to col_IndexClass Add col_IndexRegion as variable at end to avoid breaking existing code Later remove it as an input variable but add code in the function to accept
# Example data
library(readxl)
library(reshape2)
# Thresholds
fn_thresh <- file.path(system.file(package = "BioMonTools")
, "extdata"
, "MetricScoring.xlsx")
df_thresh_metric <- read_excel(fn_thresh, sheet = "metric.scoring")
df_thresh_index <- read_excel(fn_thresh, sheet = "index.scoring")
#~~~~~~~~~~~~~~~~~~~~~~~~
# Pacific Northwest, BCG Level 1 Indicator Taxa Index
df_samps_bugs <- read_excel(system.file("extdata/Data_Benthos.xlsx"
, package = "BioMonTools")
, guess_max = 10^6)
myIndex <- "BCG_PacNW_L1"
df_samps_bugs$Index_Name <- myIndex
df_samps_bugs$INDEX_CLASS <- "ALL"
(myMetrics.Bugs <- unique(as.data.frame(df_thresh_metric)[df_thresh_metric[
, "INDEX_NAME"] == myIndex, "METRIC_NAME"]))
#> [1] "nt_total" "nt_EPT" "nt_BCG_att1i2" "x_Shan_e"
#> [5] "nt_longlived" "nt_Ephemerellid" "nt_Hepta" "nt_Nemour"
#> [9] "nt_Perlid" "nt_Rhya" "nt_ffg_pred" "nt_noteworthy"
# Run Function
df_metric_values_bugs <- metric.values(df_samps_bugs
, "bugs"
, fun.MetricNames = myMetrics.Bugs)
#> Error in dplyr::filter(., N_TAXA > 0 | TAXAID == "NONE"): Can't transform a data frame with duplicate names.
# index to BCG.PacNW.L1
df_metric_values_bugs$INDEX_NAME <- myIndex
#> Error: object 'df_metric_values_bugs' not found
df_metric_values_bugs$INDEX_CLASS <- "ALL"
#> Error: object 'df_metric_values_bugs' not found
# SCORE Metrics
df_metric_scores_bugs <- metric.scores(df_metric_values_bugs
, myMetrics.Bugs
, "INDEX_NAME"
, "INDEX_CLASS"
, df_thresh_metric
, df_thresh_index)
#> Error in eval(expr, envir, enclos): object 'df_metric_values_bugs' not found
if (FALSE) {
# View Results
View(df_metric_scores_bugs)
}
# QC, table
table(df_metric_scores_bugs$Index, df_metric_scores_bugs$Index_Nar)
#> Error in eval(expr, envir, enclos): object 'df_metric_scores_bugs' not found
# QC, plot
hist(df_metric_scores_bugs$Index
, main = "PacNW BCG Example Data"
, xlab = "Level 1 Indicator Taxa Index Score")
#> Error in eval(expr, envir, enclos): object 'df_metric_scores_bugs' not found
abline(v=c(21,30), col = "blue")
#> Error in int_abline(a = a, b = b, h = h, v = v, untf = untf, ...): plot.new has not been called yet
text(21 + c(-2, +2), 200, c("Low", "Medium"), col = "blue")
#> Error in text.default(21 + c(-2, +2), 200, c("Low", "Medium"), col = "blue"): plot.new has not been called yet
#~~~~~~~~~~~~~~~~~~~~~~~~
# Metrics, Index, Benthic Macroinvertebrates, genus
# (generate values then scores)
myIndex <- "MBSS_2005_Bugs"
# Thresholds
# imported above
# get metric names for myIndex
(myMetrics_Bugs_MBSS <- unique(df_thresh_metric[df_thresh_metric[
, "INDEX_NAME"]
== myIndex, "METRIC_NAME", TRUE]))
#> [1] "nt_total" "nt_EPT" "nt_Ephem" "pi_tv2_intol"
#> [5] "pi_Ephem" "nt_ffg_scrap" "pi_habit_climb" "pi_Chiro"
#> [9] "pi_habit_cling" "pi_Tanyt" "pi_ffg_scrap" "pi_habit_swim"
#> [13] "pi_Dipt"
# Taxa Data
myDF_Bugs_MBSS <- data_benthos_MBSS
myDF_Bugs_MBSS$NONTARGET <- FALSE
myDF_Bugs_MBSS$INDEX_CLASS <- toupper(myDF_Bugs_MBSS$INDEX_CLASS)
myDF_Bugs_MBSS$SAMPLEID <- myDF_Bugs_MBSS$SITE
myDF_Bugs_MBSS$INDEX_NAME <- myIndex
myDF_Bugs_MBSS$TAXAID <- myDF_Bugs_MBSS$TAXON
myDF_Bugs_MBSS$SubPhylum <- NA
myDF_Bugs_MBSS$SubFamily <- NA
myDF_Bugs_MBSS$TOLVAL <- myDF_Bugs_MBSS$FinalTolVal07
myDF_Bugs_MBSS$TOLVAL2 <- myDF_Bugs_MBSS$FinalTolVal08
myDF_Bugs_MBSS$EXCLUDE <- myDF_Bugs_MBSS$EXCLUDE=="Y"
myMetric_Values_Bugs_MBSS <- metric.values(myDF_Bugs_MBSS
, "bugs"
, myMetrics_Bugs_MBSS)
#> Error in dplyr::filter(., N_TAXA > 0 | TAXAID == "NONE"): Can't transform a data frame with duplicate names.
if (FALSE) {
View(myMetric_Values_Bugs_MBSS)
}
# SCORE
myMetric_Values_Bugs_MBSS$INDEX_CLASS <- toupper(myMetric_Values_Bugs_MBSS$INDEX_CLASS)
#> Error in eval(expr, envir, enclos): object 'myMetric_Values_Bugs_MBSS' not found
Metrics_Bugs_Scores_MBSS <- metric.scores(myMetric_Values_Bugs_MBSS
, myMetrics_Bugs_MBSS
, "INDEX_NAME"
, "INDEX_CLASS"
, df_thresh_metric
, df_thresh_index)
#> Error in eval(expr, envir, enclos): object 'myMetric_Values_Bugs_MBSS' not found
if (FALSE) {
# View Results
View(Metrics_Bugs_Scores_MBSS)
}
# QC Index Scores and Narratives
# Set Narrative as Ordered Factor
Nar_MBSS <- c("Very Poor", "Poor", "Fair", "Good")
Metrics_Bugs_Scores_MBSS$Index_Nar <- factor(Metrics_Bugs_Scores_MBSS$Index_Nar
, levels=Nar_MBSS
, labels=Nar_MBSS
, ordered=TRUE)
#> Error in eval(expr, envir, enclos): object 'Metrics_Bugs_Scores_MBSS' not found
table(Metrics_Bugs_Scores_MBSS$Index, Metrics_Bugs_Scores_MBSS$Index_Nar, useNA="ifany")
#> Error in eval(expr, envir, enclos): object 'Metrics_Bugs_Scores_MBSS' not found
# QC bug count (manual)
Metrics_Bugs_Scores_MBSS[Metrics_Bugs_Scores_MBSS[,"ni_total"]>120,
"QC_Count"] <- "LARGE"
#> Error: object 'Metrics_Bugs_Scores_MBSS' not found
Metrics_Bugs_Scores_MBSS[Metrics_Bugs_Scores_MBSS[,"ni_total"]<60,
"QC_Count"] <- "SMALL"
#> Error: object 'Metrics_Bugs_Scores_MBSS' not found
Metrics_Bugs_Scores_MBSS[is.na(Metrics_Bugs_Scores_MBSS[,"QC_Count"]),
"QC_Count"] <- "OK"
#> Error: object 'Metrics_Bugs_Scores_MBSS' not found
# table of QC_Count
table(Metrics_Bugs_Scores_MBSS$QC_Count)
#> Error in eval(expr, envir, enclos): object 'Metrics_Bugs_Scores_MBSS' not found
# QC bug count (with function)
# Import Checks
#df_checks <- read_excel(system.file("./extdata/MetricFlags.xlsx"
# , package="BioMonTools"), sheet="Flags")
# Run Function
#df_flags <- qc.checks(Metrics_Bugs_Scores_MBSS, df_checks)
# Summarize Results
# table(df_flags[,"CHECKNAME"], df_flags[,"FLAG"], useNA="ifany")