In leppott/CASTfxn: Functions for Causal Assessment Screening Tool (CAST)

knitr::opts_chunk$set(results='asis', echo=FALSE, warning=FALSE)
# Debugging
boo.DEBUG <- FALSE
DEBUG.CaseNumber <- 1
#
if(boo.DEBUG==TRUE){##IF.boo.DEBUG.START
  if(DEBUG.CaseNumber==1){##IF.DEBUG.CaseNumber.START
    TargetSiteID <- "SRCKN001.61"
    dir_results <- "C:/Users/Erik.Leppo/OneDrive - Tetra Tech, Inc/MyDocs_OneDrive/GitHub/CASTfxn/Results"
  } else if(DEBUG.CaseNumber==2){
    TargetSiteID <- "LCBIL000.15"
    dir_results <- "C:/Users/Erik.Leppo/OneDrive - Tetra Tech, Inc/MyDocs_OneDrive/AZ/"
  }##IF.DEBUG.CaseNumber.END
}##IF.boo.DEBUG.END

REPORT INFORMATION

  myReportDate <- format(Sys.time(), "%Y-%m-%d %H:%M:%S")
  cat(paste("**Report Date and Time:** ",myReportDate,"\n\n",sep=""))
  myUser <- Sys.getenv("USERNAME")
  cat(paste("**Generated By:** ",myUser,"\n\n",sep=""))
  cat(paste("**CASTfxn Package Version:** ",packageVersion("CASTfxn"),"\n\n",sep=""))

SITE INFORMATION

#list.dirs(file.path(getwd(), "Results"), full.names=FALSE, recursive=FALSE)

  cat(paste("**Site ID:** ",TargetSiteID,"\n\n",sep=""))

MAP

dir.sub3 <- "SiteInfo"
#TargetSiteID <- "SRCKN001.61"
myJPG <- paste0(TargetSiteID,".map.jpg")
fn_img <- file.path(dir_results, TargetSiteID, dir.sub3, myJPG)
if(file.exists(fn_img)==TRUE){
  knitr::include_graphics(fn_img)
} else {
  cat("No file exists; map.\n")
}

BOX PLOTS

Box plots by stressor category.

dir.sub3 <- "CandidateCauses"
txt_grp_file <- "boxes"
txt_grp_msg <- "box"
fn_target <- paste0(TargetSiteID,".", txt_grp_file, ".ALL.pdf")
fn_all <- list.files(file.path(dir_results, TargetSiteID, dir.sub3))
boo_file <- fn_target %in% fn_all
#
if(boo_file==TRUE){##IF.boo.pdf.START
  msg_files <- paste0("All ", txt_grp_msg," plots are in the file '"
                      , fn_target, "' in the'",  paste0("Results/",dir.sub3), "' folder.\n")
} else if(boo_file==FALSE){
  msg_files <- paste0("No ", txt_grp_msg," plots exist.\n")
} else {
  msg_files <- ""
}##IF.boo.pdf.START
#
cat(msg_files)

dir.sub3 <- "CandidateCauses"
dir_SiteID <- file.path(dir_results, TargetSiteID, dir.sub3)
fn_BoxPlots  <- list.files(path=dir_SiteID, full.names = TRUE
                                 , pattern=".boxes.")
fn_BoxPlots_jpg <- fn_BoxPlots[grep(".jpg", fn_BoxPlots)]
if(length(fn_BoxPlots_jpg)==0){
  txt_NoFile <- "No file exists; box plots.\n"
  cat(txt_NoFile)
} else if(file.exists(fn_BoxPlots_jpg[1])==TRUE){
  #
  fn_img <- fn_BoxPlots_jpg
  knitr::include_graphics(fn_img)
  #
} else {
  cat(txt_NoFile)
}

Clusters

dir.sub3 <- "ClusterInfo"
txt_grp_file <- "cluster"
txt_grp_msg <- "cluster box"
fn_target <- paste0(TargetSiteID,".", txt_grp_file, ".ALL.pdf")
fn_all <- list.files(file.path(dir_results, dir.sub3, TargetSiteID))
boo_file <- fn_target %in% fn_all
#
if(boo_file==TRUE){##IF.boo.pdf.START
  msg_files <- paste0("All ", txt_grp_msg," plots are in the file '"
                      , fn_target, "' in the '", paste0("Results/", dir.sub3), "' folder.\n")
} else if(boo_file==FALSE){
  msg_files <- paste0("No ", txt_grp_msg," plots exist.\n")
} else {
  msg_files <- ""
}##IF.boo.pdf.START
#
cat(msg_files)

STRESSOR RESPONSE

BMI

dir.sub3 <- "StressoResponse"
txt_grp_file <- "SR.BMI.Corrs"
txt_grp_msg <- "stressor response benthic macroinvertebrate correlations"
fn_target <- paste0(TargetSiteID,".", txt_grp_file, ".txt")
fn_all <- list.files(file.path(dir_results, dir.sub3, TargetSiteID))
boo_file <- fn_target %in% fn_all
#
if(boo_file==TRUE){##IF.boo.pdf.START
  msg_files <- paste0("The ", txt_grp_msg," data are in the file '"
                      , fn_target, "' in the 'Results' folder.\n")
  #
  df_target <- read.delim(file.path(dir_results, TargetSiteID, dir.sub3, fn_target))
  #knitr::kable(df_target, Caption = "txt_grp_msg")
  DT::datatable(df_target, rownames = FALSE, filter="top", options=list(scrollX=TRUE))
  #
} else if(boo_file==FALSE){
  msg_files <- paste0("No ", txt_grp_msg," plots exist.\n")
} else {
  msg_files <- ""
}##IF.boo.pdf.START
#
cat(msg_files)

dir.sub3 <- "StressorResponse"
txt_grp_file <- "SR.BMI.Scores"
txt_grp_msg <- "stressor response benthic macroinvertebrate scores"
fn_target <- paste0(TargetSiteID,".", txt_grp_file, ".txt")
fn_all <- list.files(file.path(dir_results, TargetSiteID, dir.sub3))
boo_file <- fn_target %in% fn_all
#
if(boo_file==TRUE){##IF.boo.pdf.START
  msg_files <- paste0("The ", txt_grp_msg," data are in the file '"
                      , fn_target, "' in the '", paste0("Results/", dir.sub3), "' folder.\n")
  #
  df_target <- read.delim(file.path(dir_results, TargetSiteID, dir.sub3, fn_target))
  #knitr::kable(df_target, Caption = "txt_grp_msg")
  DT::datatable(df_target, rownames = FALSE, filter="top", options=list(scrollX=TRUE))
  #
} else if(boo_file==FALSE){
  msg_files <- paste0("No ", txt_grp_msg," plots exist.\n")
} else {
  msg_files <- ""
}##IF.boo.pdf.START
#
cat(msg_files)

Tables

Correlograms are used instead of tables to visually display the stressor and response metrics for correlations and scores.

Correlations

dir.sub3 <- "StressorResponse"
fn_SR_BMI_Corrs  <- file.path(dir_results, TargetSiteID, dir.sub3
                              , paste0(TargetSiteID, ".SR.BMI.Corrs.txt"))
# fn_SR_BMI_Scores <- file.path(dir_results, TargetSiteID
#                               , paste0(TargetSiteID, ".SR.BMI.Scores.txt"))
#
# captions
cap_SR_BMI_Corrs  <- "Stressor Response, BMI, Correlations"
# cap_SR_BMI_Scores <- "Stressor Response, BMI, Scores"
#
# Corrs
if(file.exists(fn_SR_BMI_Corrs)==TRUE){##IF.corrs.START
  cat(paste0("\n", cap_SR_BMI_Corrs,"\n"))
  df_SR_BMI_Corrs <- read.delim(fn_SR_BMI_Corrs)
  #
  # QC header row
  df_corr <- df_SR_BMI_Corrs
  fp_corr <- fn_SR_BMI_Corrs
  cn_cor_pref <- c("stressName", "respName", "statistic", "p.value", "estimate", "r2")
  cn_cor_x    <- colnames(df_corr)
  cn_cor_match <- sum(cn_cor_x %in% cn_cor_pref)
  if(cn_cor_match!=length(cn_cor_pref)){##IF~length~START
    df_corr <- read.delim(fp_corr, header = FALSE, col.names = cn_cor_pref)
    write.table(df_corr, fp_corr, sep="\t", quote=FALSE, row.names=FALSE )
    df_SR_BMI_Corrs <- df_corr
  }##IF~length~END
  #
  # Plot
  df_corr_r <- reshape2::dcast(df_SR_BMI_Corrs, stressName ~ respName, value.var="estimate"
                               , fun.aggregate = mean, na.rm=TRUE)
  df_corrplot <- t(df_corr_r[,-1])
  colnames(df_corrplot) <- df_corr_r[,1]
  corrplot::corrplot(df_corrplot, method="circle")
} else {
  cat("No file exists; Stressor Response BMI correlations.\n")
}

# # Table, Corrs
# if(file.exists(fn_SR_BMI_Corrs)==TRUE){##IF.corrs.START
#   df_SR_BMI_Corrs <- read.delim(fn_SR_BMI_Corrs)
#   # Table
#   print(knitr::kable(df_SR_BMI_Corrs, caption=cap_SR_BMI_Corrs))
# } else {
#   cat("No file exists; Stressor Response BMI correlations.\n")
# }##IF.corrs.START


# # Scores
# if(file.exists(fn_SR_BMI_Scores)==TRUE){##IF.scores.START
#   cat(paste0("\n#### ", cap_SR_BMI_Scores,"\n"))
#   df_SR_BMI_Scores <- read.delim(fn_SR_BMI_Scores)
#   #knitr::kable(df_SR_BMI_Scores, caption=cap_SR_BMI_Scores)
#   df_score <- reshape2::dcast(df_SR_BMI_Scores, Param_Name ~ BMI_Metric, value.var="SR_Score")
#   df_corrplot <- t(df_score[,-1])
#   colnames(df_corrplot) <- df_score[,1]
#   corrplot::corrplot(df_corrplot, is.corr=FALSE, method="circle")
# } else {
#   cat("No file exists; Stressor Response BMI scores.\n")
# }##IF.scores.START

Scores

Scores are from stressor specific regressions and are scored -1, 0, or 1.

dir.sub3 <- "StressorResponse"
# fn_SR_BMI_Corrs  <- file.path(dir_results, TargetSiteID
#                               , paste0(TargetSiteID, ".SR.BMI.Corrs.txt"))
fn_SR_BMI_Scores <- file.path(dir_results, TargetSiteID, dir.sub3
                              , paste0(TargetSiteID, ".SR.BMI.Scores.txt"))
#
# captions
# cap_SR_BMI_Corrs  <- "Stressor Response, BMI, Correlations"
cap_SR_BMI_Scores <- "Stressor Response, BMI, Scores, all data"
#
# # Corrs
# if(file.exists(fn_SR_BMI_Corrs)==TRUE){##IF.corrs.START
#   cat(paste0("\n#### ", cap_SR_BMI_Corrs,"\n"))
#   df_SR_BMI_Corrs <- read.delim(fn_SR_BMI_Corrs)
#   # Plot
#   df_corr_r <- reshape2::dcast(df_SR_BMI_Corrs, stressName ~ respName, value.var="estimate")
#   df_corrplot <- t(df_corr_r[,-1])
#   colnames(df_corrplot) <- df_corr_r[,1]
#   corrplot::corrplot(df_corrplot, method="circle")
# }
# 
# # # Table, Corrs
# # if(file.exists(fn_SR_BMI_Corrs)==TRUE){##IF.corrs.START
# #   df_SR_BMI_Corrs <- read.delim(fn_SR_BMI_Corrs)
# #   # Table
# #   print(knitr::kable(df_SR_BMI_Corrs, caption=cap_SR_BMI_Corrs))
# # } else {
# #   cat("No file exists; Stressor Response BMI correlations.\n")
# # }##IF.corrs.START


# Scores
if(file.exists(fn_SR_BMI_Scores)==TRUE){##IF.scores.START
  cat(paste0("\n", cap_SR_BMI_Scores,"\n"))
  df_SR_BMI_Scores <- read.delim(fn_SR_BMI_Scores)
  #knitr::kable(df_SR_BMI_Scores, caption=cap_SR_BMI_Scores)
  df_score <- reshape2::dcast(df_SR_BMI_Scores, stressName ~ respName, value.var="SR_Score_all"
                              , fun.aggregate = mean, na.rm=TRUE)
  df_corrplot <- t(df_score[,-1])
  colnames(df_corrplot) <- df_score[,1]
  corrplot::corrplot(df_corrplot, is.corr=FALSE, method="circle")
} else {
  cat("No file exists; Stressor Response BMI scores.\n")
}##IF.scores.START

Plots

dir.sub3 <- "StressorResponse"
txt_grp_file <- "SR.BMI"
txt_grp_msg <- "stressor specific benthic macroinvertebrate"
fn_target <- paste0(TargetSiteID,".", txt_grp_file, ".ALL.pdf")
fn_all <- list.files(file.path(dir_results, TargetSiteID, dir.sub3))
boo_file <- fn_target %in% fn_all
#
if(boo_file==TRUE){##IF.boo.pdf.START
  msg_files <- paste0("All ", txt_grp_msg," plots are in the file '"
                      , fn_target, "' in the 'Results' folder.\n")
} else if(boo_file==FALSE){
  msg_files <- paste0("No ", txt_grp_msg," plots exist.\n")
} else {
  msg_files <- ""
}##IF.boo.pdf.START
#
cat(msg_files)

dir.sub3 <- "StressorResponse"
fn_SR_BMI_Corrs  <- file.path(dir_results, TargetSiteID, dir.sub3
                              , paste0(TargetSiteID, ".SR.BMI.Corrs.txt"))
#
if(file.exists(fn_SR_BMI_Corrs)==TRUE){
  df_SR_BMI_Corrs <- read.delim(fn_SR_BMI_Corrs)
  # significant data
  df_SR_BMI_Corrs_sig <- df_SR_BMI_Corrs[df_SR_BMI_Corrs[,"p.value"]<0.05, ]
  fn_jpg_sig <- sort(paste0(TargetSiteID, ".SR.BMI."
                      , paste(df_SR_BMI_Corrs_sig[,1], df_SR_BMI_Corrs_sig[,2], sep="_")
                      , ".jpg"))
  # Number of plots
  plots_n_total <- nrow(df_SR_BMI_Corrs)
  plots_n_signif <- nrow(df_SR_BMI_Corrs_sig)
  cat(paste0("Only significant plots (p < 0.05) are displayed below ("
             , plots_n_signif,"/", plots_n_total,").\n\n"))
  # plots
  ## pattern gets all relevant SR.BMI plots
  ## Starts with (^) "SiteID.SR.BMI.", includes and underscore, and ends with ($) ".jpg"
  myPattern <- paste0("^(", TargetSiteID, "\\.SR\\.BMI\\.).*[_].*\\.jpg?")
  fn_img_all <- list.files(file.path(dir_results, TargetSiteID, dir.sub3), pattern=myPattern
                           , full.names = TRUE)
  # ensure filenames exist then check if significant.
  fn_img_sig <- fn_img_all[basename(fn_img_all) %in% fn_jpg_sig]
  knitr::include_graphics(fn_img_sig)
} else {
  cat("No file exists; Stressor Response BMI correlation plots.\n")
}
#

SSTV

Plots

dir.sub3 <- "VerifiedPredictions"
txt_grp_file <- "SR.SSTV"
txt_grp_msg <- "stressor specific stressor response"
fn_target <- paste0(TargetSiteID,".", txt_grp_file, ".ALL.pdf")
fn_all <- list.files(file.path(dir_results, TargetSiteID, dir.sub3))
boo_file <- fn_target %in% fn_all
#
if(boo_file==TRUE){##IF.boo.pdf.START
  msg_files <- paste0("All ", txt_grp_msg," plots are in the file '"
                      , fn_target, "' in the 'Results' folder.\n")
} else if(boo_file==FALSE){
  msg_files <- paste0("No ", txt_grp_msg," plots exist.\n")
} else {
  msg_files <- ""
}##IF.boo.pdf.START
#
cat(msg_files)

dir.sub3 <- "VerifiedPredictions"
fn_SSTV_plots  <- list.files(path=file.path(dir_results, TargetSiteID, dir.sub3)
                                 , full.names = TRUE
                                 , pattern=".SR.SSTV.")
fn_SSTV_plots_jpg <- fn_SSTV_plots[grep(".jpg", fn_SSTV_plots)]
numPlots <- length(fn_SSTV_plots_jpg)

if(length(numPlots)==0){
  txt_NoFile <- "No file exists; SSTV plots.\n"
  cat(txt_NoFile)
} else {
  knitr::include_graphics(fn_SSTV_plots_jpg)
}

Algae

Tables

Correlograms instead of long tables are used to visually display the stressor and response metrics for correlations and scores.

Correlations

fn_SR_Alg_Corrs  <- file.path(dir_results, TargetSiteID
                              , paste0(TargetSiteID, ".SR.Alg.Corrs.txt"))

# captions
cap_SR_Alg_Corrs  <- "Stressor Response, Algae, Correlations"

# Corrs
if(file.exists(fn_SR_Alg_Corrs)==TRUE){##IF.corrs.START
  cat(paste0("\n", cap_SR_Alg_Corrs,"\n"))
  df_SR_Alg_Corrs <- read.delim(fn_SR_Alg_Corrs)
  #
  # QC header row
  df_corr <- df_SR_Alg_Corrs
  fp_corr <- fn_SR_Alg_Corrs
  cn_cor_pref <- c("stressName", "respName", "statistic", "p.value", "estimate", "r2")
  cn_cor_x    <- colnames(df_corr)
  cn_cor_match <- sum(cn_cor_x %in% cn_cor_pref)
  if(cn_cor_match!=length(cn_cor_pref)){##IF~length~START
    df_corr <- read.delim(fp_corr, header = FALSE, col.names = cn_cor_pref)
    write.table(df_corr, fp_corr, sep="\t", quote=FALSE, row.names=FALSE )
    df_SR_Alg_Corrs <- df_corr
  }##IF~length~END
  #
  # Plot
  df_corr_r <- reshape2::dcast(df_SR_Alg_Corrs, stressName ~ respName, value.var="estimate"
                               , fun.aggregate = mean, na.rm=TRUE)
  df_corrplot <- t(df_corr_r[,-1])
  colnames(df_corrplot) <- df_corr_r[,1]
  corrplot::corrplot(df_corrplot, method="circle")
} else {
  cat("No file exists; Stressor Response Algae correlations.\n")
}

OTHER

Co-Occurence

Table

dir.sub3 <- "CoOccurrence"
#dir_results <- file.path(getwd(), "Results", "_CoOccur", "hi")
# dir_SiteID <- file.path(dir_results, TargetSiteID)

fn_CoOccur_Scores  <- list.files(path=file.path(dir_results, TargetSiteID, dir.sub3)
                                 , full.names = TRUE
                                 , pattern=".CoOccurrence.bmi.Scores.txt")
if(length(fn_CoOccur_Scores)==0){
  txt_NoFile <- "No file exists; co-occurrence scores.\n"
  cat(txt_NoFile)
} else if(file.exists(fn_CoOccur_Scores)==TRUE){
  df_CoOccur_Scores <- read.delim(fn_CoOccur_Scores)
  cap_CoOccur_Scores <- "Co-Occurrence Scores"
  #knitr::kable(df_CoOccur_Scores, caption=cap_CoOccur_Scores)
  DT::datatable(df_CoOccur_Scores, rownames = FALSE, filter="top", options=list(scrollX=TRUE))
} else {
  cat(txt_NoFile)
}
#

Plots

Plots are saved from the function in pairs in a PDF.

dir.sub3 <- "CoOccurrence"
txt_grp_file <- "CoOccurrence"
txt_grp_msg <- "cooccurrence"
fn_target <- paste0(TargetSiteID,".", txt_grp_file, ".ALL.pdf")
fn_all <- list.files(file.path(dir_results, TargetSiteID, dir.sub3))
boo_file <- fn_target %in% fn_all
#
if(boo_file==TRUE){##IF.boo.pdf.START
  msg_files <- paste0("All ", txt_grp_msg," plots are in the file '"
                      , fn_target, "' in the 'Results' folder.\n")
} else if(boo_file==FALSE){
  msg_files <- paste0("No ", txt_grp_msg," plots exist.\n")
} else {
  msg_files <- ""
}##IF.boo.pdf.START
#
cat(msg_files)

dir.sub3 <- "CoOccurrence"
fn_CoOccur_plots_box  <- list.files(path=file.path(dir_results, TargetSiteID, dir.sub3)
                                 , full.names = TRUE
                                 , pattern=".CoOccurrence.Box.")
fn_CoOccur_plots_SR  <- list.files(path=file.path(dir_results, TargetSiteID, dir.sub3)
                                 , full.names = TRUE
                                 , pattern=".CoOccurrence.SR.")

len_box   <- length(fn_CoOccur_plots_box)
len_SR    <- length(fn_CoOccur_plots_SR)
len_total <- len_box + len_SR
len_min   <- min(len_box,len_SR)
len_max   <- max(len_box,len_SR)

length(fn_CoOccur_plots_box) <- len_max
length(fn_CoOccur_plots_SR)  <- len_max

fn_img_all <- suppressWarnings(c(rbind(fn_CoOccur_plots_box, fn_CoOccur_plots_SR)))
len_img <- length(fn_img_all)

txt_NoFile <- "No file exists; co-occurrence box plots.\n"
if(length(len_total)==0){
  cat(txt_NoFile)
} else {
  # Combine plot names in a vector (alternating)
  ## assumes have one of each
  # fn_img_all <- vector(class(fn_CoOccur_plots_box)
  #                      , length(c(fn_CoOccur_plots_box, fn_CoOccur_plots_SR)))
  # fn_img_all[c(TRUE, FALSE)] <- fn_CoOccur_plots_box
  # fn_img_all[c(FALSE, TRUE)] <- fn_CoOccur_plots_SR

  fn_img_all_plot <- fn_img_all[!is.na(fn_img_all)]

  knitr::include_graphics(fn_img_all)
}

Chem, Percent Rank

dir.sub3 <- "CandidateCauses"
txt_grp_file <- "chem.pctrank.bmi"
txt_grp_msg <- "chemistry percent rank"
fn_target <- paste0(TargetSiteID,".", txt_grp_file, ".txt")
fn_all <- list.files(file.path(dir_results, TargetSiteID, dir.sub3))
boo_file <- fn_target %in% fn_all
#
if(boo_file==TRUE){##IF.boo.pdf.START
  msg_files <- paste0("The ", txt_grp_msg," data are in the file '"
                      , fn_target, "' in the '", paste0("Results/", dir.sub3), "' folder.\n")
} else if(boo_file==FALSE){
  msg_files <- paste0("No ", txt_grp_msg," plots exist.\n")
} else {
  msg_files <- ""
}##IF.boo.pdf.START
#
cat(msg_files)

Table

dir.sub3 <- "CandidateCauses"
fn_ChemPctRank  <- file.path(dir_results, TargetSiteID, dir.sub3
                               , paste0(TargetSiteID, ".chem.pctrank.bmi.txt"))

if(file.exists(fn_ChemPctRank)==TRUE){
  df_ChemPctRank <- read.delim(fn_ChemPctRank)
  cap_ChemPctRank <- "Chemical Analytes, Percent Rank"
  knitr::kable(df_ChemPctRank, caption=cap_ChemPctRank)
  DT::datatable(df_ChemPctRank, rownames = FALSE, filter="top", options=list(scrollX=TRUE))
} else {
  cat("No files exists; chemistry percent ranks.\n")
}

leppott/CASTfxn documentation built on Sept. 6, 2019, 11:04 p.m.