Biological Condition Gradient level assignment (1st and 2nd) given Level memberships.
BCG.Level.Assignment(
df.level.membership,
col_SampleID = "SAMPLEID",
col_Index_Name = "INDEX_NAME",
col_Index_Class = "INDEX_CLASS",
col_L1 = "L1",
col_L2 = "L2",
col_L3 = "L3",
col_L4 = "L4",
col_L5 = "L5",
col_L6 = "L6"
)Wide data frame with level memberships (0-1).
Column name for sample id. Default = "SAMPLEID"
Column name for index name. Default = "INDEX_NAME"
Column name for index class. Default = "INDEX_CLASS"
Column name for memberships, Level 1. Default = "L1"
Column name for memberships, Level 2. Default = "L2"
Column name for memberships, Level 3. Default = "L3"
Column name for memberships, Level 4. Default = "L4"
Column name for memberships, Level 5. Default = "L5"
Column name for memberships, Level 6. Default = "L6"
Returns a data frame of results in the wide format.
Input is L1 to L6 with membership values of 0 to 1. Result is 1st Level (Primary_BCG_Level) and 2nd Level (Secondary_BCG_Level). Also give close (Membership_Close) and a continuous proportional Level assignment ("Continuous_BCG_Level").
# Example 1
# construct a dummy dataset
L1 <- c(rep(0, 12))
L2 <- c(0.4, 0, 0.4, rep(0,7), 0, 0)
L3 <- c(0.6, 0, 0.6, 0, 0.42, 0, 1, 1, 0.22, 0.33, 0.5, 0)
L4 <- c(0, 0.9, 0, 0, 0.58, 0.05, 0, 0, 0.78, 0.67, 0.5, 0)
L5 <- c(0, 0.1, 0, 1, 0, 0.95, rep(0,4), 0, 1)
L6 <- c(rep(0, length(L1)))
SAMPLEID <- LETTERS[1:length(L1)]
df_lev_memb <- data.frame(SAMPLEID = SAMPLEID
, INDEX_NAME = "TEST_NAME"
, INDEX_CLASS = "TEST_CLASS"
, L1 = L1
, L2 = L2
, L3 = L3
, L4 = L4
, L5 = L5
, L6 = L6)
# Run Function
df_Levels <- BCG.Level.Assignment(df_lev_memb)
# Show Results
#View(df_Levels)
# Save Results
write.table(df_Levels
, file.path(tempdir(), "Levels.tsv")
, row.names = FALSE
, col.names = TRUE
, sep = "\t")
#~~~~~~~~~~~~~~~~~~~~~~~
# Example 2
# library(readxl)
# library(reshape2)
# library(BioMonTools)
# Calculate Metrics
df_samps_bugs <- readxl::read_excel(system.file(
"extdata/Data_BCG_PugLowWilVal.xlsx"
, package="BCGcalc")
, guess_max = 10^6)
# Run Function
myDF <- df_samps_bugs[1:250, ]
myCols <- c("Area_mi2",
"SurfaceArea",
"Density_m2",
"Density_ft2")
#' # populate missing columns prior to metric calculation
col_missing <- c("INFRAORDER",
"HABITAT",
"ELEVATION_ATTR",
"GRADIENT_ATTR",
"WSAREA_ATTR",
"HABSTRUCT",
"UFC",
"SAMP_AREA_M2")
myDF[, col_missing] <- NA
df_met_val_bugs <- BioMonTools::metric.values(myDF
, "bugs"
, fun.cols2keep = myCols)
#> Joining with `by = join_by(SAMPLEID, INDEX_NAME, INDEX_CLASS)`
# Import Rules
df_rules <- readxl::read_excel(system.file("extdata/Rules.xlsx"
, package="BCGcalc")
, sheet="Rules")
#> Warning: Expecting logical in S2409 / R2409C19: got '1'
#> Warning: Expecting logical in S2410 / R2410C19: got '11'
#> Warning: Expecting logical in S2411 / R2411C19: got '12'
#> Warning: Expecting logical in S2412 / R2412C19: got '15'
#> Warning: Expecting logical in S2413 / R2413C19: got '16'
#> Warning: Expecting logical in S2414 / R2414C19: got '17'
#> Warning: Expecting logical in S2415 / R2415C19: got '18'
#> Warning: Expecting logical in S2416 / R2416C19: got '19'
#> Warning: Expecting logical in S2417 / R2417C19: got '25'
#> Warning: Expecting logical in S2418 / R2418C19: got '29'
#> Warning: Expecting logical in S2419 / R2419C19: got '4'
#> Warning: Expecting logical in S2420 / R2420C19: got '5'
#> Warning: Expecting logical in S2421 / R2421C19: got '8'
#> Warning: Expecting logical in S2422 / R2422C19: got '9'
#> Warning: Expecting logical in S2423 / R2423C19: got '1'
#> Warning: Expecting logical in S2424 / R2424C19: got '11'
#> Warning: Expecting logical in S2425 / R2425C19: got '12'
#> Warning: Expecting logical in S2426 / R2426C19: got '15'
#> Warning: Expecting logical in S2427 / R2427C19: got '16'
#> Warning: Expecting logical in S2428 / R2428C19: got '17'
#> Warning: Expecting logical in S2429 / R2429C19: got '18'
#> Warning: Expecting logical in S2430 / R2430C19: got '19'
#> Warning: Expecting logical in S2431 / R2431C19: got '25'
#> Warning: Expecting logical in S2432 / R2432C19: got '29'
#> Warning: Expecting logical in S2433 / R2433C19: got '4'
#> Warning: Expecting logical in S2434 / R2434C19: got '5'
#> Warning: Expecting logical in S2435 / R2435C19: got '8'
#> Warning: Expecting logical in S2436 / R2436C19: got '9'
#> Warning: Expecting logical in S2437 / R2437C19: got '1'
#> Warning: Expecting logical in S2438 / R2438C19: got '12'
#> Warning: Expecting logical in S2439 / R2439C19: got '15'
#> Warning: Expecting logical in S2440 / R2440C19: got '19'
#> Warning: Expecting logical in S2441 / R2441C19: got '25'
#> Warning: Expecting logical in S2442 / R2442C19: got '29'
#> Warning: Expecting logical in S2443 / R2443C19: got '4'
#> Warning: Expecting logical in S2444 / R2444C19: got '5'
#> Warning: Expecting logical in S2445 / R2445C19: got '9'
#> Warning: Expecting logical in S2446 / R2446C19: got '1'
#> Warning: Expecting logical in S2447 / R2447C19: got '19'
#> Warning: Expecting logical in S2448 / R2448C19: got '29'
#> Warning: Expecting logical in S2449 / R2449C19: got '4'
#> Warning: Expecting logical in S2450 / R2450C19: got '1'
#> Warning: Expecting logical in S2451 / R2451C19: got '11'
#> Warning: Expecting logical in S2452 / R2452C19: got '12'
#> Warning: Expecting logical in S2453 / R2453C19: got '15'
#> Warning: Expecting logical in S2454 / R2454C19: got '16'
#> Warning: Expecting logical in S2455 / R2455C19: got '17'
#> Warning: Expecting logical in S2456 / R2456C19: got '18'
#> Warning: Expecting logical in S2457 / R2457C19: got '19'
#> Warning: Expecting logical in S2458 / R2458C19: got '25'
#> Warning: Expecting logical in S2459 / R2459C19: got '29'
#> Warning: Expecting logical in S2460 / R2460C19: got '4'
#> Warning: Expecting logical in S2461 / R2461C19: got '5'
#> Warning: Expecting logical in S2462 / R2462C19: got '8'
#> Warning: Expecting logical in S2463 / R2463C19: got '9'
#> Warning: Expecting logical in S2464 / R2464C19: got '1'
#> Warning: Expecting logical in S2465 / R2465C19: got '11'
#> Warning: Expecting logical in S2466 / R2466C19: got '12'
#> Warning: Expecting logical in S2467 / R2467C19: got '15'
#> Warning: Expecting logical in S2468 / R2468C19: got '16'
#> Warning: Expecting logical in S2469 / R2469C19: got '17'
#> Warning: Expecting logical in S2470 / R2470C19: got '19'
#> Warning: Expecting logical in S2471 / R2471C19: got '25'
#> Warning: Expecting logical in S2472 / R2472C19: got '29'
#> Warning: Expecting logical in S2473 / R2473C19: got '4'
#> Warning: Expecting logical in S2474 / R2474C19: got '5'
#> Warning: Expecting logical in S2475 / R2475C19: got '8'
#> Warning: Expecting logical in S2476 / R2476C19: got '9'
#> Warning: Expecting logical in S2477 / R2477C19: got '1'
#> Warning: Expecting logical in S2478 / R2478C19: got '12'
#> Warning: Expecting logical in S2479 / R2479C19: got '15'
#> Warning: Expecting logical in S2480 / R2480C19: got '19'
#> Warning: Expecting logical in S2481 / R2481C19: got '25'
#> Warning: Expecting logical in S2482 / R2482C19: got '29'
#> Warning: Expecting logical in S2483 / R2483C19: got '4'
#> Warning: Expecting logical in S2484 / R2484C19: got '5'
#> Warning: Expecting logical in S2485 / R2485C19: got '9'
#> Warning: Expecting logical in S2486 / R2486C19: got '1'
#> Warning: Expecting logical in S2487 / R2487C19: got '19'
#> Warning: Expecting logical in S2488 / R2488C19: got '29'
#> Warning: Expecting logical in S2489 / R2489C19: got '4'
# Calculate Metric Memberships
df_met_memb <- BCG.Metric.Membership(df_met_val_bugs, df_rules)
# Calculate Level Memberships
df_lev_memb <- BCG.Level.Membership(df_met_memb, df_rules)
# Run Function
df_Levels <- BCG.Level.Assignment(df_lev_memb)
# QC Checks (flags)
#
# Import Checks
df_checks <- readxl::read_excel(system.file("extdata/MetricFlags.xlsx"
, package="BCGcalc")
, sheet="Flags")
# Run Function
df_flags <- BioMonTools::qc.checks(df_met_val_bugs, df_checks)
# Change terminology; PASS/FAIL to NA/flag
df_flags[, "FLAG"][df_flags[, "FLAG"] == "FAIL"] <- "flag"
df_flags[, "FLAG"][df_flags[, "FLAG"] == "PASS"] <- NA
# long to wide format
df_flags_wide <- reshape2::dcast(df_flags
, SAMPLEID ~ CHECKNAME
, value.var="FLAG")
# Calc number of "flag"s by row.
df_flags_wide$NumFlags <- rowSums(df_flags_wide == "flag", na.rm = TRUE)
# Rearrange columns
NumCols <- ncol(df_flags_wide)
df_flags_wide <- df_flags_wide[, c(1, NumCols, 2:(NumCols - 1))]
# Merge Levels and Flags
df_lev_flags <- merge(df_Levels
, df_flags_wide
, by.x = "SampleID"
, by.y = "SAMPLEID"
, all.x = TRUE)
# Summarize Results
table(df_flags[, "CHECKNAME"], df_flags[, "FLAG"], useNA = "ifany")
#>
#> flag <NA>
#> Low density (ft2) 0 74
#> Ramellogammarus 0 74
#> brackish organisms present 0 74
#> catchment, Large 0 74
#> catchment, small 15 59
#> individuals, Large 0 74
#> individuals, dominant 02, Large 73 1
#> individuals, small 74 0
#> surface area, small 10 64
table(df_lev_flags$BCG_Status)
#>
#> 6
#> 74
# Show Results
# View(df_lev_flags)
# Save Results
write.csv(df_lev_flags, file.path(tempdir(), "Level_Flags.csv"))
# # Summary Report
# strFile.RMD <- system.file(paste0("rmd/Results_Summary.Rmd")
# , package = "BCGcalc")
# strFile.RMD.format <- "html_document"
# strFile.out <- "_bcgcalc_RESULTS.html"
# dir.export <- tempdir()
# rmarkdown::render(strFile.RMD
# , output_format = strFile.RMD.format
# , output_file = strFile.out
# , output_dir = dir.export
# , quiet = TRUE)