leppott/BCGcalc
Biological Condition Gradient, calculator

Package index
Search the leppott/BCGcalc package
Vignettes
Functions
14
Source code
60
Man pages
8
Home
/
GitHub
/
leppott/BCGcalc
/

In leppott/BCGcalc: Biological Condition Gradient, calculator 

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

Purpose

The BCGcalc package was created to enable users to generate Biological Condition Gradient (BCG) model outputs for macroinvertebrate data from freshwater wadeable streams in the Puget Lowlands and Willamette Valley ecoregions (Stamp and Gerritsen 2018). With modification, this R code can be used to generate outputs for other BCG models as well.

This vignette covers the basics going from raw data to model results. Any of the code in this Vignette can be copied and pasted to an R session and it will produce the same results as shown here. Each section of code (gray box) is independent such that no other code needs to be run except what is in that section. Thus, there is some repetition of steps between sections.

No files are exported in the examples in the vignette. All “write” statements have been commented out. If you wish to save the output remove the “#” from before each line of code. Several different “write” functions were used in the examples. This was intentional such that intermediate files are output as TSV (tab-separated values) files and final results are output as CSV (comma-separated values) files. Both formats will open in Excel.

Background

When applying the BCG, users should keep in mind that they can run any data through the model and get a result. However, if samples for the Puget Lowlands and Willamette Valley macroinvertebrate BCG model do not meet the criteria below, results should be interpreted with caution because they are outside the experience of this particular BCG model.

Criteria

Results should be interpreted with caution if they are flagged for any of the criteria listed in the ‘Flags’ section at the end of the vignette (e.g., brackish influence, extreme dominance by one or two taxa).

Disclaimer

Version 1 of the Puget Lowlands and Willamette Valley macroinvertebrate BCG model has known limitations and will need further testing in coming years. The model should be regarded as a beta version, with potential for refinement over time as the model is used with new data.

Literature cited

Stamp, J. and J. Gerritsen. 2018. Calibration of the Biological Condition Gradient (BCG) for Macroinvertebrate Assemblages in Puget Lowland/Willamette Valley Freshwater Wadeable Streams. Prepared by Tetra Tech for the US EPA Office of Water, Office of Science and Technology and US EPA Region 10.

Installation

The package is hosted on GitHub (https://github.com/leppott/BCGcalc) and can be installed using the following lines of code. It is necessary to install the devtools package.

# Installing the BCGcalc library (with the vignette) from GitHub
library(devtools) 
install_github("leppott/BCGcalc", force=TRUE, build_vignettes=TRUE)

Help

After the BCGcalc package has been installed running the following line of code will open the help file with links to all functions.

help(package="BCGcalc")

‘extdata’ files

When you install the BCGcalc R package, the following files are contained in the ‘extdata’ folder in the BCGcalc library folder:

Data Preparation

There are a number of required fields for the input file. If any fields are missing the user will be prompted as to which are missing and the user can decide whether to continue or quit. If the user continues, the missing fields will be added but will be filled with zero or NA (as appropriate). Any metrics based on the missing fields will not be valid.

Required Fields:

Fields that are optional but encouraged: Area_mi2, SurfaceArea, Density_m2, Density_ft2. These fields are used for flagging unusual samples (see Flag section below). The R code can be adapted to include these fields in the output (see examples below).

Important!

The master taxa list is a data object in the package. It can be viewed or saved with the code below.

library(BCGcalc)

View(TaxaMaster_Ben_BCG_PugLowWilVal)

# Save to working directory
#write.csv(TaxaMaster_Ben_BCG_PugLowWilVal
#          , "TaxaMaster_Ben_BCG_PugLowWilVal_20180927.csv")

The first few lines are also displayed below.

library(BCGcalc)
library(knitr)
kable(head(TaxaMaster_Ben_BCG_PugLowWilVal)
      , caption="PugLowWilVal BCG Master Taxa")

Package Functions

The suite of functions in the BCGcalc package are presented in two sections.
The first section will cover the core functions from metric calculation to model results. The example will cover all steps in a single example. Additional functions will be covered individually and each function will have its own self contained example.

  1. BCG Core Functions

    A. Metric Calculation (BioMonTools package)

    B. Metric Membership (Scoring)

    C. Level Membership

    D. Level Assignment

    E. Add Flags

  2. Additional (Optional) Functions

    A. Subsample (BioMonTools package)

    B. Metric Calculation, Save Specific Metrics

    C. Flags (BioMonTools package)

Core Functions

Once your input file is formatted and ready to go, the next step is to run it through the R code. The R code generates BCG level assignments for each sample. Along the way it calculates the following: metric values, metric membership values, BCG level membership and BCG level assignments. It also adds flags to the BCG level assignment file.

Below are two examples of R code that can be used to generate BCG model outputs. This code is written for 500-count samples (which is what the PugLowWilVal BCG model is calibrated for).

The first example below is for test data that is automatically downloaded onto your computer when you install the BCGcalc R package. If it’s your first time running this code, and you are a novice R user, we recommend trying this code first (you can follow it verbatim, no edits needed, and it should generate the desired output).

The second example is for a ‘new’ data file (to simulate you running the R code on your own data).

Example, Test Data

The code below uses the test data that is contained in the package and is already of the proper format.

If you decide to run the example below, the following four files will appear in your working directory.

# Packages
library(BCGcalc)
library(readxl)
library(reshape2)
library(BioMonTools)

# Import
df.samps.bugs <- read_excel(system.file("./extdata/Data_BCG_PugLowWilVal.xlsx"
                                        , package="BCGcalc")
                            , guess_max = 10^6)

# QC for TRUE/FALSE (both ok) 
# Exclude to TRUE/FALSE
table(df.samps.bugs$Exclude)
# NonTarget to TRUE/FALSE
table(df.samps.bugs$NonTarget)

# Add missing columns
col_add_char <- c("INFRAORDER", "HABITAT", "ELEVATION_ATTR", "GRADIENT_ATTR"
                  , "WSAREA_ATTR", "HABSTRUCT")
col_add_num <- "UFC"
df.samps.bugs[, col_add_char] <- NA_character_
df.samps.bugs[, col_add_num] <- NA_integer_

# 1.A. Calculate Metrics
# Extra columns to keep in results
keep.cols <- c("Area_mi2"
               , "SurfaceArea"
               , "Density_m2"
               , "Density_ft2"
               , "Site_Type")
# Run Function
df.metrics <- metric.values(df.samps.bugs, "bugs", fun.cols2keep = keep.cols)
# QC
dim(df.metrics)
View(df.metrics)
# Save
write.table(df.metrics
            , "Metric.Values.Test.tsv"
            , col.names=TRUE
            , row.names=FALSE
            , sep="\t")

# 1.B. Metric Membership
# Import Rules
df.rules <- read_excel(system.file("./extdata/Rules.xlsx"
                             , package="BCGcalc")
                       , sheet="BCG_PugLowWilVal_500ct") 
# Run function
df.Metric.Membership <- BCG.Metric.Membership(df.metrics, df.rules)
# Show Results
View(df.Metric.Membership)
# Save Results
write.table(df.Metric.Membership, "Metric.Membership.Test.tsv"
              , row.names=FALSE, col.names=TRUE, sep="\t")

# 1.C. Level Assignment
# Run Function
df.Level.Membership <- BCG.Level.Membership(df.Metric.Membership, df.rules)
# Show results
View(df.Level.Membership)
# Save Results
write.table(df.Level.Membership, "Level.Membership.Test.tsv"
             , row.names=FALSE, col.names=TRUE, sep="\t")

# 1.D. Level Membership
# Run Function
df.Levels <- BCG.Level.Assignment(df.Level.Membership)

# 1.E. Flags
# Import QC Checks
df.checks <- read_excel(system.file("./extdata/MetricFlags.xlsx"
                                          , package="BCGcalc")
                        , sheet="Flags") 
# Run Function
df.flags <- qc.checks(df.metrics, 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 <- 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.Levels.Flags <- merge(df.Levels, df.flags.wide, by="SAMPLEID", all.x=TRUE)
# Show Results
View(df.Levels.Flags)
# Summarize Results
table(df.flags[,"CHECKNAME"], df.flags[,"FLAG"], useNA="ifany")
# Save Results
write.csv(df.Levels.Flags, "Levels.Flags.Test.csv")

Example, New Data

The flexibility of R allows the user to get data from a multitude of sources and then manipulate (munge) it to fit the format needed for the functions in BCGcalc. The example below shows how to import a file, add slope from a 2nd file, and to make a few changes to the data in order to use it with the package. When the data source is fixed this routine can be modified and then used on all future datasets to prepare them for use with BCGcalc.

Before running this on your own data, you will need to update the directories, the name of the input file and potentially a few other fields. In this example, the input file is called ‘ExampleMunge_UnformatedData.xlsx’. Remember - when you type in your working directory that you either need two backslashes "\" or one forward slash "/". If you copy and paste the directory from Windows File Explorer , it comes in as one backslash so you will need to manually correct this for the code to work.

# Setup
library(readxl)
library(dplyr)
library(BCGcalc)
library(BioMonTools)

# Read File
## FileName
fn.data <- system.file("./extdata/ExampleMunge_UnformatedData.xlsx"
                       , package="BCGcalc")
# wd <- "F:\\myDocs"
# fn.data <- file.path(wd, "ExampleMunge_UnformatedData.xlsx")

## Worksheet
sh.data <- "SamplesWithBioticAttributesAndR"
## Import
### set "guess" to a large number to avoid type being wrong
df.data <- read_excel(fn.data, sheet = sh.data, guess_max=12000)
dim(df.data)

# Munge
## Col Names
### convert to upper case
names(df.data) <- toupper(names(df.data))
### Rename Columns (base R) [dplyr::rename not working]
names(df.data)[names(df.data)=="SAMPLE ID"] <- "SAMPLEID"
names(df.data)[names(df.data)=="TAXON"] <- "TAXAID"
names(df.data)[names(df.data)=="SAMPLE ID"] <- "SAMPLEID"
names(df.data)[names(df.data)=="QUANTITY SUBSAMPLING"] <- "N_TAXA"
#names(df.data)[names(df.data)=="HILSENHOFF BIOTIC TOLERANCE INDEX"] <- "TOLVAL"
# df.data <- df.data %>% rename("SAMPLEID"="SAMPLE ID"
#                              , "TAXAID"="TAXON"
#                              , "N_TAXA"="QUANTITY SUBSAMPLING"
#                              , "TOLVAL"="HILSENHOFF BIOTIC TOLERANCE INDEX"
#                              )
### Create columns
df.data$EXCLUDE    <- !df.data$UNIQUE
df.data$NONTARGET  <- df.data$`OUTSIDE PROTOCOL`
# df.data$FFG        <- NA
# df.data$FFG[df.data$PREDATOR==TRUE]  <- "PR"
# df.data$HABIT      <- NA
# df.data$HABIT[df.data$CLINGER==TRUE] <- "CN"
# df.data$LIFE_CYCLE <- NA
df.data$SITE_TYPE  <- NA
# df.data$BCG_ATTR   <- NA
# df.data$THERMAL_INDICATOR <- NA
df.data$INDEX_NAME <- "BCG_PugLowWilVal_500ct"
df.data$SURFACEAREA <- df.data$`SURFACE AREA`
df.data$AREA_MI2 <- NA
df.data$DENSITY_M2 <- NA
df.data$DENSITY_FT2 <- NA

# Add slope (and then gradient for SiteType) from NHD+ v2
fn.slope <- system.file("./extdata/ExampleMunge_Slope.xlsx", package="BCGcalc")
# fn.slope <- file.path(wd, "ExampleMunge_Slope.xlsx")
df.slope <- read_excel(fn.slope)
names(df.slope) <- toupper(names(df.slope))
# merge files
df.comb.slope <- merge(df.data
                       , df.slope
                       , by.x="SITE CODE"
                       , by.y="SITE_CODE"
                       , all.x=TRUE)
# QC (rows)
dim(df.data)
dim(df.comb.slope)
nrow(df.data) == nrow(df.comb.slope)
df.comb.slope$SITE_TYPE <- df.comb.slope$`SLOPE CATEGORY`

# Update Taxa Attributes from Master Taxa List in Package
df.taxamaster <- TaxaMaster_Ben_BCG_PugLowWilVal
names(df.taxamaster) <- toupper(names(df.taxamaster))
## Assume phylogenetic information is correct.
col.auteco <- c("TAXAID", "BCG_ATTR", "THERMAL_INDICATOR", "LONG_LIVED", "FFG"
                , "HABIT", "LIFE_CYCLE", "TOLVAL")
df.comb.slope.auteco <- merge(df.comb.slope, df.taxamaster[, col.auteco]
                              , by.x="TAXAID", by.y="TAXAID", all.x=TRUE)
nrow(df.comb.slope) == nrow(df.comb.slope.auteco)

# Create Anlaysis File
col2keep <- c("SAMPLEID", "INDEX_NAME", "SITE_TYPE"
              , "AREA_MI2", "SURFACEAREA", "DENSITY_M2", "DENSITY_FT2"
              , "TAXAID", "N_TAXA", "EXCLUDE", "NONTARGET"
              , "PHYLUM", "SUBPHYLUM", "CLASS", "ORDER", "FAMILY", "SUBFAMILY"
              , "TRIBE", "GENUS"
              , "FFG", "HABIT", "LIFE_CYCLE", "TOLVAL", "BCG_ATTR"
              , "THERMAL_INDICATOR")
df.samps.bugs <- as.data.frame(df.comb.slope.auteco[, col2keep ])

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Repeat code from previous example
# (with minor edits)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# QC for TRUE/FALSE (both ok) 
# Exclude to TRUE/FALSE
table(df.samps.bugs$EXCLUDE)
# NonTarget to TRUE/FALSE
table(df.samps.bugs$NONTARGET)

# 1.A. Calculate Metrics
# Extra columns to keep in results
keep.cols <- toupper(c("Area_mi2"
                       , "SurfaceArea"
                       , "Density_m2"
                       , "Density_ft2"
                       , "Site_Type"))
# Run Function
df.metrics <- metric.values(df.samps.bugs, "bugs", fun.cols2keep = keep.cols)
# QC
dim(df.metrics)
View(df.metrics)
# Save
write.table(df.metrics
            , "Metric.Values.New.tsv"
            , col.names=TRUE
            , row.names=FALSE
            , sep="\t")

# 1.B. Metric Membership
# Import Rules
df.rules <- read_excel(system.file("./extdata/Rules.xlsx"
                             , package="BCGcalc")
                       , sheet="BCG_PugLowWilVal_500ct") 
# Run function
df.Metric.Membership <- BCG.Metric.Membership(df.metrics, df.rules)
# Show Results
View(df.Metric.Membership)
# Save Results
write.table(df.Metric.Membership, "Metric.Membership.New.tsv"
              , row.names=FALSE, col.names=TRUE, sep="\t")

# 1.C. Level Assignment
# Run Function
df.Level.Membership <- BCG.Level.Membership(df.Metric.Membership, df.rules)
# Show results
View(df.Level.Membership)
# Save Results
write.table(df.Level.Membership, "Level.Membership.New.tsv"
             , row.names=FALSE, col.names=TRUE, sep="\t")

# 1.D. Level Membership
# Run Function
df.Levels <- BCG.Level.Assignment(df.Level.Membership)

# 1.E. Flags
# Import QC Checks
df.checks <- read_excel(system.file("./extdata/MetricFlags.xlsx"
                                          , package="BCGcalc")
                        , sheet="Flags") 
# Run Function
df.flags <- qc.checks(df.metrics, 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 <- 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.Levels.Flags <- merge(df.Levels, df.flags.wide, by="SAMPLEID", all.x=TRUE)
# Show Results
View(df.Levels.Flags)
# Summarize Results
table(df.flags[,"CHECKNAME"], df.flags[,"FLAG"], useNA="ifany")
# Save Results
write.csv(df.Levels.Flags, "Levels.Flags.New.csv")

Additional (Optional) Functions

There are some ancillary tasks that are included in the BCGcalc package for convenience.

Subsample (Rarify)

The rarify function subsamples count data to a fixed count per sample. It takes as an input a 3 column data frame (SampleID, TaxonID, Count) and returns a similar dataframe with revised Counts. The names of the columns does not matter as they are specified in the code. Any non-count taxa (e.g., fish in a bug sample) should be removed prior to using the rarify function. The function code is from USEPA Corvallis John Van Sickle's R code for RIVPACS (v1.0, 2005-06-10) and was tweaked for the addition of a user provided seed so repeatable results can be obtained. It is included in the package BioMonTools (https://github.com/leppott/BioMonTools).

The other function inputs are subsample size (target number of organisms in each sample) and seed. The seed is given so the results can be reproduced from the same input file. If no seed is given a random seed is used. An example seed is the date of admission to the Union for each state where the data is collected (e.g., Washington is 18891111). These values can be found on Wikipedia on the right sidebar for each State.

If you are running the 500-count BCG model and any of your samples have more than 600 organisms (the upper limit for the model), you should randomly subsample your data to 600 (600 is +20% of the 500-count target). This is done to make richness metrics comparable across the 500-count samples. You can do this with the Rarify routine.

Before you run the code below on your own data, you’ll need to update the directories, the name of the input file and potentially a few other fields. In this example, the input file is called ‘ExampleMunge_UnformatedData.xlsx’.

After you are done with the subsampling, bring the updated N_Taxa field into your input file (see example file titled ‘ExampleDataFile’; we retained the original data in an optional field called N_Taxa_orig). Then run your data file through the BCGcalc example code described previously in this document.

library(BCGcalc)
library(knitr)
library(BioMonTools)

# Subsample to 600 organisms (from over 600 organisms) for 12 samples.

## FileName
### Package example
df_data <- BioMonTools::data_bio2rarify
### Excel
# wd <- "F:\\myDocs"
# fn_data <- file.path(wd, "ExampleMunge_UnformatedData.xlsx")
# readxl::read_excel(fn.data)
### CSV
# fn_data <- 
# df_data <- read.csv(fn_data)
#
df_biodata <- df_data
#dim(df_biodata)
#View(df_biodata)

# subsample
mySize <- 600
Seed_OR <- 18590214
Seed_WA <- 18891111
Seed_US <- 17760704
bugs_mysize <- BioMonTools::rarify(inbug=df_biodata, sample.ID="SampleID"
                     ,abund="N_Taxa",subsiz=mySize, mySeed=Seed_US)
#dim(bugs.mysize)
#View(bugs.mysize)

# Compare pre- and post- subsample counts
df_compare <- merge(df_biodata, bugs_mysize, by=c("SampleID", "TaxaID")
                    , suffixes = c("_Orig","_600"))
df_compare <- df_compare[,c("SampleID", "TaxaID", "N_Taxa_Orig", "N_Taxa_600")]
#View(df.compare)

# compare totals
tbl_compare <- head(df_compare)
tbl_compare_caption <- "First few rows of original and rarified data."
kable(tbl_compare, caption=tbl_compare_caption)

tbl_totals <- aggregate(cbind(N_Taxa_Orig, N_Taxa_600) ~ SampleID
                        , df_compare, sum)
tbl_totals_caption <- "Comparison of total individuals per sample."
kable(tbl_totals, caption=tbl_totals_caption)

# save the data
#write.table(bugs.mysize,paste("bugs",mySize,"txt",sep="."),sep="\t")

Metric Calculation, Save Specific Metrics

You can adapt the code so that the metric calculation output only includes a subset of the metrics.

For example, you may only want to view the following metrics;

You can select specific metrics one of two ways:

  1. If you know the names of the metrics, write them into the metric.values
    function R code as shown in Example #1 below; or

  2. Run the ‘normal’ metrics.values R code for to generate an output that includes the full set of metrics, then examine the results and run additional code as shown in Example # 2 to limit the output to the desired metrics.

Example 1

Knowing the names of the metrics, use them as input in the metric.values function.

# Packages
library(BCGcalc)
library(readxl)
library(knitr)
library(BioMonTools)

# Load Data
df.data <- read_excel(system.file("./extdata/Data_BCG_PugLowWilVal.xlsx"
                                       , package="BCGcalc")
                      , guess_max = 10^6)
# Columns to keep
myCols <- c("Area_mi2", "SurfaceArea", "Density_m2", "Density_ft2", "Site_Type")
# Metrics of Interest (BCG)
col.met2keep <- c("ni_total", "nt_total", "nt_BCG_att1i2", "pt_BCG_att1i23"
                  , "pi_BCG_att1i23", "pt_BCG_att56", "pi_BCG_att56"
                  , "nt_EPT_BCG_att1i23", "pi_NonInsJugaRiss_BCG_att456"
                  , "pt_NonIns_BCG_att456", "nt_EPT", "pi_NonIns_BCG_att456")
# Run Function
df.metval <- metric.values(df.data, "bugs"
                           , fun.cols2keep=myCols
                           , fun.MetricNames = col.met2keep)
1 # YES

# Select columns
col.ID <- c("SAMPLEID", toupper(myCols), "INDEX_NAME", "SITE_TYPE")
# Ouput
df.metval.bcg12 <- df.metval[, c(col.ID, col.met2keep)]
# RMD table
kable(head(df.metval.bcg12), caption = "Select Metrics, Example 1")

Example 2

Examine the results file and select certain metrics to keep.

# Packages
library(BCGcalc)
library(readxl)
library(knitr)
library(BioMonTools)

# Load Data
df.data <- read_excel(system.file("./extdata/Data_BCG_PugLowWilVal.xlsx"
                                       , package="BCGcalc")
                      , guess_max = 10^6)

# Add missing columns
col_add_char <- c("INFRAORDER", "HABITAT", "ELEVATION_ATTR", "GRADIENT_ATTR"
                  , "WSAREA_ATTR", "HABSTRUCT")
col_add_num <- "UFC"
df.data[, col_add_char] <- NA_character_
df.data[, col_add_num] <- NA_integer_

# Columns to keep
myCols <- c("Area_mi2", "SurfaceArea", "Density_m2", "Density_ft2", "Site_Type")

# Run Function
df.metval <- metric.values(df.data, "bugs", fun.cols2keep=myCols)
# Metrics of Interest
## thermal indicator (_ti_)
#names(df.metval)[grepl("_ti_", names(df.metval))]
col.met2keep <- c("ni_total", "nt_total"
         , paste0("nt_ti_", c("stenocold", "cold", "cool", "warm", "stenowarm"))
         , paste0("pi_ti_", c("stenocold", "cold", "cool", "warm", "stenowarm"))
         , paste0("pt_ti_", c("stenocold", "cold", "cool", "warm", "stenowarm"))
          )
col.ID <- c("SAMPLEID", toupper(myCols), "INDEX_NAME", "SITE_TYPE")
# Ouput
df.metval.ci <- df.metval[, c(col.ID, col.met2keep)]
# RMD table
kable(head(df.metval.ci), caption = "Select Metrics, Example 2")

Flags

Results should be interpreted with caution if they are flagged for any of the criteria listed below. If you run the BCGcalc code on the Test data above, columns with flags will be added into the file with the Level Assignments.

The checks for hi and lo gradient are the same so only one set of checks is shown below.

# Packages
library(BCGcalc)
library(readxl)
library(reshape2)
library(knitr)
library(BioMonTools)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Need to run some code to get results for display tables.
# Repeat code from CoreFun_TestData
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# Import
df.samps.bugs <- read_excel(system.file("./extdata/Data_BCG_PugLowWilVal.xlsx"
                                        , package="BCGcalc")
                            , guess_max = 10^6)

# Add missing columns
col_add_char <- c("INFRAORDER", "HABITAT", "ELEVATION_ATTR", "GRADIENT_ATTR"
                  , "WSAREA_ATTR", "HABSTRUCT")
col_add_num <- "UFC"
df.samps.bugs[, col_add_char] <- NA_character_
df.samps.bugs[, col_add_num] <- NA_integer_

# 1.A. Calculate Metrics
# Extra columns to keep in results
keep.cols <- c("Area_mi2"
               , "SurfaceArea"
               , "Density_m2"
               , "Density_ft2"
               , "Site_Type")
# Run Function
df.metrics <- metric.values(df.samps.bugs, "bugs", fun.cols2keep = keep.cols)
# # QC
# dim(df.metrics)
# View(df.metrics)
# # Save
# write.table(df.metrics, "Metric.Values.Test.tsv", col.names=TRUE
#, row.names=FALSE, sep="\t")

# 1.B. Metric Membership
# Import Rules
df.rules <- read_excel(system.file("./extdata/Rules.xlsx"
                             , package="BCGcalc")
                       , sheet="Rules") 
# Run function
df.Metric.Membership <- BCG.Metric.Membership(df.metrics, df.rules)
# # Show Results
# View(df.Metric.Membership)
# # Save Results
# write.table(df.Metric.Membership, "Metric.Membership.Test.tsv"
#               , row.names=FALSE, col.names=TRUE, sep="\t")

# 1.C. Level Assignment
# Run Function
df.Level.Membership <- BCG.Level.Membership(df.Metric.Membership, df.rules)
# # Show results
# View(df.Level.Membership)
# # Save Results
# write.table(df.Level.Membership, "Level.Membership.Test.tsv"
#              , row.names=FALSE, col.names=TRUE, sep="\t")

# 1.D. Level Membership
# Run Function
df.Levels <- BCG.Level.Assignment(df.Level.Membership)

# 1.E. Flags
# Import QC Checks
df.checks <- read_excel(system.file("./extdata/MetricFlags.xlsx"
                                    , package="BCGcalc")
                        , sheet="Flags") 
# Run Function
df.flags <- qc.checks(df.metrics, 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 <- 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.Levels.Flags <- merge(df.Levels, df.flags.wide
                         , by.x = "SampleID", by.y = "SAMPLEID"
                         , all.x=TRUE)
# # Show Results
# View(df.Levels.Flags)
# # Summarize Results
# table(df.flags[,"CHECKNAME"], df.flags[,"FLAG"], useNA="ifany")
# # Save Results
# write.csv(df.Levels.Flags, "Levels.Flags.Test.csv")


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


# Flags
# Filter for "hi"
tbl.checks.hi <- df.checks[df.checks[,"Site_Type"]=="Hi", ]
# Display
tbl.checks.caption <- "Flags, Hi Gradient"
kable(tbl.checks.hi, caption = tbl.checks.caption)

# Levels and Flags
tbl.Levels.Flags.caption <- "Levels and Flags."
kable(head(df.Levels.Flags), caption = tbl.Levels.Flags.caption)

# Flags
tbl.flags.caption <- "Flag Summary."
kable(table(df.flags[,"CHECKNAME"], df.flags[,"FLAG"], useNA="ifany")
      , caption = tbl.flags.caption)


leppott/BCGcalc documentation built on April 12, 2024, 8:35 a.m.

R Package Documentation

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.

Close