From ec363ccc7640b8b20950636ea4b9b4ef3af07233 Mon Sep 17 00:00:00 2001 From: leppott Date: Thu, 21 Feb 2019 10:15:54 -0500 Subject: [PATCH] v2.0.5.9012 ggplot in QC report, issue #83, issue #84 update file import to na.strings to inclue "NA" not just "". --- .Rhistory | 882 ++++++++++++++++++------------------ DESCRIPTION | 4 +- NEWS | 10 +- NEWS.rmd | 7 + R/fun.PeriodStats.R | 2 +- R/fun.QC.File.R | 6 +- R/fun.QC.R | 33 +- R/fun.Report.File.R | 2 +- R/fun.Report.R | 4 +- R/fun.Stats.File.R | 2 +- R/fun.Stats.R | 4 +- R/zfun.AggregateData.File.R | 4 +- R/zfun.AggregateData.R | 24 +- R/zfun.ContDataQC.R | 19 + inst/rmd/Report_QC.rmd | 428 +++++++++++------ 15 files changed, 808 insertions(+), 623 deletions(-) diff --git a/.Rhistory b/.Rhistory index b9ab60d..c2a1be1 100644 --- a/.Rhistory +++ b/.Rhistory @@ -1,408 +1,453 @@ -?read.csv -df_CDQC <- read.csv(file.path(system.file(package = "ContDataQC"), "extdata", fn_CDQC), stringsAsFactors = FALSE) -str(df_CDQC) -df_CDQC[, "Date.Time"] <- as.POSIXct(df_CDQC[, "Date.Time"]) -str(df_CDQC) -# NEWS -# Render then Copy NEWS so picked up in help -rmarkdown::render("NEWS.rmd", "all") -file.copy("NEWS.md", "NEWS", overwrite = TRUE) -file.remove("NEWS.html") -file.remove("NEWS.md") +# 5.1. Cycle each present field +for (j in myNames.DataFields2Mod) {##FOR.j.START # -# Library Name -myLibrary <- "ContDataQC" -# Load Library -library(devtools) -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# Create Package -# create(myLibrary) -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# A. Add comment field and leave blank +data.import[,paste(myName.Comment.Mod,j,sep=".")] <- "" +# B. Add data.RAW and populate with original data +data.import[,paste(myName.Raw,j,sep=".")] <- data.import[,j] # -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# Document, Install, and Reload Library -## Generate Documentation -setwd(paste0("./",myLibrary)) -devtools::document() -## Install New Package (locally) -setwd("..") # return to root directory first -devtools::install(myLibrary) -## Reload library -library(myLibrary,character.only = TRUE) -# change wd back to package -setwd(paste0("./",myLibrary)) -pkg <- "ContDataQC" -library(pkg, character.only = TRUE) -help(package=(pkg)) -# Convert Data for use with rLakeAnalyzer -# Data -fn_CDQC <- "TestLake_Water_20180702_20181012.csv" -df_CDQC <- read.csv(file.path(system.file(package = "ContDataQC"), "extdata", fn_CDQC)) -# Convert Date.Time from factor to POSIXct (make it a date and time field in R) -df_CDQC[, "Date.Time"] <- as.POSIXct(df_CDQC[, "Date.Time"]) -# Columns, date listed first -col_depth <- "Depth" -col_CDQC <- c("Date.Time", "temp_F", "DO_conc") -col_rLA <- c("datetime", "wtr", "doobs") -# Output Options -dir_export <- getwd() -fn_export <- paste0("rLA_", fn_CDQC) -# Run function -df_rLA <- Export.rLakeAnalyzer(df_CDQC, col_depth, col_CDQC, col_rLA -, dir_export, fn_export) -# use rLakeAnalyzer -library(rLakeAnalyzer) -# Filter Data for only temperature -col_wtr <- colnames(df_rLA)[grepl("wtr_", colnames(df_rLA))] -df_rLA_wtr <- df_rLA[, c("datetime", col_wtr)] -# Generate Heat Map -wtr.heat.map(df_rLA_wtr) -# Plot, Create -p <- ggplot(df_CDQC, aes(x=Date.Time, y=temp_F)) + geom_point(aes(color=Depth)) -+ scale_color_continuous(trans="reverse") -+ scale_x_datetime(date_labels = "%Y-%m") -# Plot, Show -p -library(ggplot2) -# Plot, Create -p <- ggplot(df_CDQC, aes(x=Date.Time, y=temp_F)) + geom_point(aes(color=Depth)) -+ scale_color_continuous(trans="reverse") -+ scale_x_datetime(date_labels = "%Y-%m") -# Plot, Show -p -# NEWS -# Render then Copy NEWS so picked up in help -rmarkdown::render("NEWS.rmd", "all") -file.copy("NEWS.md", "NEWS", overwrite = TRUE) -file.remove("NEWS.html") -file.remove("NEWS.md") +}##FOR.j.END # -# Library Name -myLibrary <- "ContDataQC" -# Load Library -library(devtools) -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# Create Package -# create(myLibrary) -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# # leave as a loop so get RAW and Comment together +# j <- myNames.DataFields2Mod +# # A. Add comment field and leave blank +# data.import[,paste(myName.Comment.Mod,j,sep=".")] <- "" +# # B. Add data.RAW and populate with original data +# data.import[,paste(myName.Raw,j,sep=".")] <- data.import[,j] # -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# Document, Install, and Reload Library -## Generate Documentation -setwd(paste0("./",myLibrary)) -devtools::document() -## Install New Package (locally) -setwd("..") # return to root directory first -devtools::install(myLibrary) -## Reload library -library(myLibrary,character.only = TRUE) -# change wd back to package -setwd(paste0("./",myLibrary)) -pkg <- "ContDataQC" -library(pkg, character.only = TRUE) -help(package=(pkg)) -# Convert Data for use with rLakeAnalyzer -# Data -fn_CDQC <- "TestLake_Water_20180702_20181012.csv" -df_CDQC <- read.csv(file.path(system.file(package = "ContDataQC"), "extdata", fn_CDQC)) -# Convert Date.Time from factor to POSIXct (make it a date and time field in R) -df_CDQC[, "Date.Time"] <- as.POSIXct(df_CDQC[, "Date.Time"]) -# Columns, date listed first -col_depth <- "Depth" -col_CDQC <- c("Date.Time", "temp_F", "DO_conc") -col_rLA <- c("datetime", "wtr", "doobs") -# Output Options -dir_export <- getwd() -fn_export <- paste0("rLA_", fn_CDQC) -# Run function -df_rLA <- Export.rLakeAnalyzer(df_CDQC, col_depth, col_CDQC, col_rLA -, dir_export, fn_export) -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# use rLakeAnalyzer -library(rLakeAnalyzer) -# Filter Data for only temperature -col_wtr <- colnames(df_rLA)[grepl("wtr_", colnames(df_rLA))] -df_rLA_wtr <- df_rLA[, c("datetime", col_wtr)] -# Generate Heat Map -wtr.heat.map(df_rLA_wtr) -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# Plot original data in ggplot -library(ggplot2) -# Plot, Create -p <- ggplot(df_CDQC, aes(x=Date.Time, y=temp_F)) + -geom_point(aes(color=Depth)) + -scale_color_continuous(trans="reverse") + -scale_x_datetime(date_labels = "%Y-%m") -# Plot, Show -p -library(ContDataQC) -pkg <- "ContDataQC" -library(pkg, character.only = TRUE) -help(package=(pkg)) -# Convert Data for use with rLakeAnalyzer -# Data -fn_CDQC <- "TestLake_Water_20180702_20181012.csv" -df_CDQC <- read.csv(file.path(system.file(package = "ContDataQC"), "extdata", fn_CDQC)) -# Convert Date.Time from factor to POSIXct (make it a date and time field in R) -df_CDQC[, "Date.Time"] <- as.POSIXct(df_CDQC[, "Date.Time"]) -# Columns, date listed first -col_depth <- "Depth" -col_CDQC <- c("Date.Time", "temp_F", "DO_conc") -col_rLA <- c("datetime", "wtr", "doobs") -# Output Options -dir_export <- getwd() -fn_export <- paste0("rLA_", fn_CDQC) -# Run function -df_rLA <- Export.rLakeAnalyzer(df_CDQC, col_depth, col_CDQC, col_rLA -, dir_export, fn_export) -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# use rLakeAnalyzer -library(rLakeAnalyzer) -# Filter Data for only temperature -col_wtr <- colnames(df_rLA)[grepl("wtr_", colnames(df_rLA))] -df_rLA_wtr <- df_rLA[, c("datetime", col_wtr)] -# Generate Heat Map -wtr.heat.map(df_rLA_wtr) -?schmidt.plot -# Get system data file paths -wtr.path <- system.file('extdata', 'Sparkling.wtr', package="rLakeAnalyzer") -bth.path <- system.file('extdata', 'Sparkling.bth', package="rLakeAnalyzer") -# Load data for example lake, Sparkilng Lake, Wisconsin. -wtr = load.ts(wtr.path) -bth = load.bathy(bth.path) -## Not run: -# Generate default plot -schmidt.plot(wtr,bth) -head(wtr) -head(bth) -head(df_rLA_wtr) -depths <- c(3, 6, 9) -df_rLA_bth <- as.data.frame(depths=c(3,6,9), areas=c(1,1,1)) -?as.data.frame -df_rLA_bth <- data.frame(depths=c(3,6,9), areas=c(1,1,1)) -head(df_rLA_bth) -?schmidt.plot -schmidt.plot(df_rLA_wtr, df_rLA_bth) -df_rLA_bth <- data.frame(depths=c(3,6,9), areas=c(1,2,3)) -schmidt.plot(df_rLA_wtr, df_rLA_bth) -df_rLA_bth <- data.frame(depths=c(3,6,9), areas=c(100,200,300)) -schmidt.plot(df_rLA_wtr, df_rLA_bth) -head(df_rLA) -?schmidt.plot -# Get system data file paths -wtr.path <- system.file('extdata', 'Sparkling.wtr', package="rLakeAnalyzer") -bth.path <- system.file('extdata', 'Sparkling.bth', package="rLakeAnalyzer") -# Load data for example lake, Sparkilng Lake, Wisconsin. -wtr = load.ts(wtr.path) -bth = load.bathy(bth.path) -## Not run: -# Generate default plot -schmidt.plot(wtr,bth) -head(wtr) -head(bth) -df_rLA_bth <- data.frame(depths=c(3,6,9), areas=c(300,200,100)) -schmidt.plot(df_rLA_wtr, df_rLA_bth) -bthA <- c(1000,900,864,820,200,10) -bthD <- c(0,2.3,2.5,4.2,5.8,7) -wtr <- c(28,27,26.4,26,25.4,24,23.3) -depths <- c(0,1,2,3,4,5,6) -cat('Schmidt stability for input is: ') -cat(schmidt.stability(wtr, depths, bthA, bthD)) -ts.schmidt.stability(df_rLA_wtr, df_rLA_bth) -pkg <- "ContDataQC" -library(pkg, character.only = TRUE) -help(package=(pkg)) -# Convert Data for use with rLakeAnalyzer -# Data -fn_CDQC <- "TestLake_Water_20180702_20181012.csv" -df_CDQC <- read.csv(file.path(system.file(package = "ContDataQC"), "extdata", fn_CDQC)) -# Convert Date.Time from factor to POSIXct (make it a date and time field in R) -df_CDQC[, "Date.Time"] <- as.POSIXct(df_CDQC[, "Date.Time"]) -# Columns, date listed first -col_depth <- "Depth" -col_CDQC <- c("Date.Time", "temp_F", "DO_conc") -col_rLA <- c("datetime", "wtr", "doobs") -# Output Options -dir_export <- getwd() -fn_export <- paste0("rLA_", fn_CDQC) -# Run function -df_rLA <- Export.rLakeAnalyzer(df_CDQC, col_depth, col_CDQC, col_rLA -, dir_export, fn_export) -head(df_rLA) -# use rLakeAnalyzer -library(rLakeAnalyzer) -# Filter Data for only temperature -col_wtr <- colnames(df_rLA)[grepl("wtr_", colnames(df_rLA))] -df_rLA_wtr <- df_rLA[, c("datetime", col_wtr)] -# Generate Heat Map -wtr.heat.map(df_rLA_wtr) -df_rLA_bth <- data.frame(depths=c(3,6,9), areas=c(300,200,100)) -schmidt.plot(df_rLA_wtr, df_rLA_bth) -df_rLA_Schmidt <- ts.schmidt.stability(df_rLA_wtr, df_rLA_bth) -head(df_rLA_Schmidt) -# Convert Data for use with rLakeAnalyzer -# Data -fn_CDQC <- "TestLake_Water_20180702_20181012.csv" -df_CDQC <- read.csv(file.path(system.file(package = "ContDataQC"), "extdata", fn_CDQC)) -# Convert Date.Time from factor to POSIXct (make it a date and time field in R) -df_CDQC[, "Date.Time"] <- as.POSIXct(df_CDQC[, "Date.Time"]) -# Columns, date listed first -col_depth <- "Depth" -col_CDQC <- c("Date.Time", "temp_F", "DO_conc") -col_rLA <- c("datetime", "wtr", "doobs") -# Output Options -dir_export <- getwd() -fn_export <- paste0("rLA_", fn_CDQC) -# Run function -df_rLA <- Export.rLakeAnalyzer(df_CDQC, col_depth, col_CDQC, col_rLA -, dir_export, fn_export) -# Visualize Input and Output -knitr::kable(head(df_CDQC), caption = "Example ContDataQC to rLakeAnalyze format function input.") -knitr::kable(head(df_rLA), caption = "Example ContDataQC to rLakeAnalyze format function output.") -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# use rLakeAnalyzer -library(rLakeAnalyzer) -#library(knitr) -# Filter Data for only temperature -col_wtr <- colnames(df_rLA)[grepl("wtr_", colnames(df_rLA))] -df_rLA_wtr <- df_rLA[, c("datetime", col_wtr)] -# Create bathymetry data frame -df_rLA_bth <- data.frame(depths=c(3,6,9), areas=c(300,200,100)) -# Visualize Input Data -knitr::kable(head(df_rLA_wtr), caption = "rLakeAnalyzer; Example water temperature data") -knitr::kable(head(df_rLA_bth), caption = "rLakeAnalyzer; Example depth and area data") -# Generate Heat Map -wtr.heat.map(df_rLA_wtr) -# Generate Schmidt Plot -schmidt.plot(df_rLA_wtr, df_rLA_bth) -# Generate Schmidt Stability Values -df_rLA_Schmidt <- ts.schmidt.stability(df_rLA_wtr, df_rLA_bth) -# Visualize Output Data -knitr::kable(head(df_rLA_Schmidt), caption = "rLakeAnalyzer; Example Schmidt Stability output.") -# Plot original data in ggplot -library(ggplot2) -# Plot, Create -p <- ggplot(df_CDQC, aes(x=Date.Time, y=temp_F)) + -geom_point(aes(color=Depth)) + -scale_color_continuous(trans="reverse") + -scale_x_datetime(date_labels = "%Y-%m") -# Plot, Show -p -# Convert Data for use with rLakeAnalyzer -# Data -fn_CDQC <- "TestLake_Water_20180702_20181012.csv" -df_CDQC <- read.csv(file.path(system.file(package = "ContDataQC"), "extdata", fn_CDQC)) -# Convert Date.Time from factor to POSIXct (make it a date and time field in R) -df_CDQC[, "Date.Time"] <- as.POSIXct(df_CDQC[, "Date.Time"]) -# Columns, date listed first -col_depth <- "Depth" -col_CDQC <- c("Date.Time", "temp_F", "DO_conc") -col_rLA <- c("datetime", "wtr", "doobs") -# Output Options -dir_export <- getwd() -fn_export <- paste0("rLA_", fn_CDQC) -# Run function -df_rLA <- Export.rLakeAnalyzer(df_CDQC, col_depth, col_CDQC, col_rLA -, dir_export, fn_export) -# Visualize Input and Output -knitr::kable(head(df_CDQC), caption = "Example ContDataQC to rLakeAnalyze format function input.") -knitr::kable(head(df_rLA), caption = "Example ContDataQC to rLakeAnalyze format function output.") -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# Plot original data in ggplot -library(ggplot2) -# Plot, Create -p <- ggplot(df_CDQC, aes(x=Date.Time, y=temp_F)) + -geom_point(aes(color=Depth)) + -scale_color_continuous(trans="reverse") + -scale_x_datetime(date_labels = "%Y-%m") -# Plot, Show -print(p) -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# use rLakeAnalyzer -library(rLakeAnalyzer) -#library(knitr) -# Filter Data for only temperature -col_wtr <- colnames(df_rLA)[grepl("wtr_", colnames(df_rLA))] -df_rLA_wtr <- df_rLA[, c("datetime", col_wtr)] -# Create bathymetry data frame -df_rLA_bth <- data.frame(depths=c(3,6,9), areas=c(300,200,100)) -# Visualize Input Data -knitr::kable(head(df_rLA_wtr), caption = "rLakeAnalyzer; Example water temperature data") -knitr::kable(head(df_rLA_bth), caption = "rLakeAnalyzer; Example depth and area data") -# Generate Heat Map -wtr.heat.map(df_rLA_wtr) -# Generate Schmidt Plot -schmidt.plot(df_rLA_wtr, df_rLA_bth) -# Generate Schmidt Stability Values -df_rLA_Schmidt <- ts.schmidt.stability(df_rLA_wtr, df_rLA_bth) -# Visualize Output Data -knitr::kable(head(df_rLA_Schmidt), caption = "rLakeAnalyzer; Example Schmidt Stability output.") +# 6-9 #not here +# +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# save file then run QC Report in a separate Script #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# Plot original data in ggplot -library(ggplot2) -# Plot, Create -p <- ggplot(df_CDQC, aes(x=Date.Time, y=temp_F)) + -geom_point(aes(color=Depth)) + -scale_color_continuous(trans="reverse") + -scale_x_datetime(date_labels = "%Y-%m") -# Plot, Show -p -# NEWS -# Render then Copy NEWS so picked up in help -rmarkdown::render("NEWS.rmd", "all") -file.copy("NEWS.md", "NEWS", overwrite = TRUE) -file.remove("NEWS.html") -file.remove("NEWS.md") +wd <- "C:/Users/Erik.Leppo/OneDrive - Tetra Tech, Inc/MyDocs_OneDrive/GitHub/ContDataQC" +setwd(wd) +if(boo_DEBUG==TRUE){ +myConfig <- file.path(system.file(package="ContDataQC"), "extdata", "config.ORIG.R") +source(myConfig) +} +# DATA FILE INFORMATION +# Report Info +myReportDate <- format(Sys.Date(),ContData.env$myFormat.Date) +cat(paste("**Report Date:** ",myReportDate,"\n\n",sep="")) +myUser <- Sys.getenv("USERNAME") +cat(paste("**Generated By:** ",myUser,"\n\n",sep="")) +#filename +cat("**Filename:** ",strFile,"\n\n",sep="") +mySiteID <- data.import[1,ContData.env$myName.SiteID] +cat(paste("**SiteID:** ",mySiteID,"\n\n",sep="")) +if(exists("fun.myData.DateRange.Start")==TRUE){ +POR.Requested <- paste(fun.myData.DateRange.Start," to ",fun.myData.DateRange.End, sep="") +} else { +POR.Requested <- "NA" +} +cat(paste("**Period of Record, Requested:** ",POR.Requested,sep="",collapse="\n\n")) +myNumRecords <- nrow(data.import) # 20170228, mod from records 10 and 11 to half way point +# myTimeDiff <- difftime(data.import[10,ContData.env$myName.DateTime],data.import[11,ContData.env$myName.DateTime],units="mins") +#x <- data.import[,ContData.env$myName.DateTime] +myT <- strptime(data.import[,ContData.env$myName.DateTime],format=ContData.env$myFormat.DateTime) +myTimeDiff.all <- difftime(myT[-1],myT[-length(myT)],units="mins") +myTimeDiff <- median(as.vector(myTimeDiff.all),na.rm=TRUE) +cat(paste("\n\n**Period of Record, Actual:** ",min(data.import[,ContData.env$myName.Date])," to ",max(data.import[,ContData.env$myName.Date]),"\n\n",sep="")) +cat(paste("**Recording Interval:** ",myTimeDiff[1]," minutes\n\n",sep="")) +if(exists("strFile.DataType")==TRUE){ +myDataType <- strFile.DataType +} else { +myDataType <- "NA" +} +cat(paste("**Data Type:** ",myDataType,"\n\n",sep="")) # need to do better +myParameters.ALL <- ContData.env$myNames.DataFields[ContData.env$myNames.DataFields +%in% names(data.import)==TRUE] +myParameters.Lab.ALL <- ContData.env$myNames.DataFields.Lab[ContData.env$myNames.DataFields +%in% names(data.import)==TRUE] +# Filter out Discrete +myParameters <- myParameters.ALL[!grepl(ContData.env$myPrefix.Discrete,myParameters.ALL)] +myParameters.Lab <- myParameters.Lab.ALL[!grepl(ContData.env$myPrefix.Discrete,myParameters.Lab.ALL)] +#cat("**Parameters:** ",paste(myParameters.Lab,", ",sep=""),"\n\n",sep="") +# above line not working, preventing pandoc conversion to WORD +#cat("**Included Parameters:** \n\n") +cat("**Parameters Included:** ",paste(myParameters.ALL,", ",sep=""),"\n\n",sep="") +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# 2.1. Records by Month/Day +# split so easier to put on paper +# number of records by month/day (split 1:15 and 16:31) # -# Library Name -myLibrary <- "ContDataQC" -# Load Library -library(devtools) -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# Create Package -# create(myLibrary) -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# format = markdown/pandoc = seems to be the same. All rows but no columns in Word. +# Have to use on table not ftable. ftable better by itself but doesn't work with knitr::kable. +# # QC, if days less than count = 15 +#*Error in table. Only printing half.* (fixed for sites with <15 days) +# if((max(data.import[,"day"])-min(data.import[,"day"]))<15) {##IF.daycount.START +# myTable <- table(data.import[,"month"],data.import[,"day"]) +# print(knitr::kable(myTable, format="markdown",row.names=TRUE)) +# } else { +# # +# #myTable.month.day.rec.LTE15 <- +# myTable <- table(data.import[,"month"][data.import[,"day"]<=15],data.import[,"day"][data.import[,"day"]<=15]) +# print(knitr::kable(myTable, format="markdown", row.names=TRUE)) +# #knitr::kable(myTable.month.day.rec.LTE15, format="pandoc", caption = "Title of the table") +# cat("\n\n") +# # +# # myTable.month.day.rec.GT15 <- +# myTable <- table(data.import[,"month"][data.import[,"day"]>15],data.import[,"day"][data.import[,"day"]>15]) +# print(knitr::kable(myTable, format="markdown", row.names=TRUE)) # -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# Document, Install, and Reload Library -## Generate Documentation -setwd(paste0("./",myLibrary)) -devtools::document() -## Install New Package (locally) -setwd("..") # return to root directory first -devtools::install(myLibrary) -## Reload library -library(myLibrary,character.only = TRUE) -# change wd back to package -setwd(paste0("./",myLibrary)) -# NEWS -# Render then Copy NEWS so picked up in help -rmarkdown::render("NEWS.rmd", "all") -file.copy("NEWS.md", "NEWS", overwrite = TRUE) -file.remove("NEWS.html") -file.remove("NEWS.md") +# }##IF.daycount.END +# Convert time interval (minutes) to number per day +records.expected <- round(24*60/as.numeric(myTimeDiff[1]),1) +cat(paste("Estimated number of records per day is ",records.expected,".",sep="")) +cat("\n\n") +cat("Number of records by year and month (with totals).") +cat("\n") +myTable <- addmargins(table(data.import[,ContData.env$myName.Yr],data.import[,ContData.env$myName.Mo])) +print(knitr::kable(myTable, format="markdown", row.names=TRUE)) +cat("\n\n") +# revert to longer table (20170228) +cat("Number of records by day and month (with totals).") +cat("\n") +myTable <- addmargins(table(data.import[,ContData.env$myName.Day],data.import[,ContData.env$myName.Mo])) +print(knitr::kable(myTable, format="markdown", row.names=TRUE)) +cat("\n\n") # -# Library Name -myLibrary <- "ContDataQC" -# Load Library -library(devtools) -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# Create Package -# create(myLibrary) -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# pandoc.table(myTable.month.day.rec.GT15,style="rmarkdown") # -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# Document, Install, and Reload Library -## Generate Documentation -setwd(paste0("./",myLibrary)) -devtools::document() -## Install New Package (locally) -setwd("..") # return to root directory first -devtools::install(myLibrary) -## Reload library -library(myLibrary,character.only = TRUE) -# change wd back to package -setwd(paste0("./",myLibrary)) +# +myTable.month.day.rec <- table(data.import[,ContData.env$myName.Mo],data.import[,ContData.env$myName.Day]) +# use apply function to count number of records not equal to the expected value +cat("\n\n") +# +myTable.DateTime.N <- aggregate(data.import[,ContData.env$myName.SiteID] +~ data.import[,ContData.env$myName.DateTime] +, data=data.import,FUN=length) +# myTable <- myTable.DateTime.N[myTable.DateTime.N[,ContData.env$myName.SiteID]!=1,] +# cat(paste0("Date and time records with more than one entry; N=",nrow(myTable),". Duplicate date.time records are shown below.")) +# cat("\n") +# print(knitr::kable(myTable, format="markdown", row.names=TRUE)) +# mask error, 20170307 +# Missing Dates +myDateRange.Data <- seq(as.Date(min(data.import[,ContData.env$myName.Date])) +,as.Date(max(data.import[,ContData.env$myName.Date])) +,by="day") +if(exists("fun.myData.DateRange.Start")==TRUE){ +myDateRange.Target <- seq(as.Date(fun.myData.DateRange.Start) +,as.Date(fun.myData.DateRange.End) +,by="day") +} else { +myDateRange.Target <- myDateRange.Data +} +myDateRange.Target.Missing <- myDateRange.Target[!myDateRange.Target %in% myDateRange.Data] +cat(paste0("Below are the dates with missing data between the min (",min(myDateRange.Data) +,") and max(",max(myDateRange.Data)," for the provided data. There are " +,length(myDateRange.Target.Missing)," records.")) +cat("\n\n") +print(ifelse(length(myDateRange.Target.Missing)==0,"",myDateRange.Target.Missing)) +#~~~~~~~~~~~~~~~~~~~~~~ +cat("\n\n") +print("Parameters:") +cat("\n\n") +print(myParameters) +i <- myParameters[1] +i.num <- match(i,myParameters) +myTitle.Sub <- myParameters.Lab[i.num] +cat("## QC TESTS, ",i,"\n\n",sep="") +#cat(paste("**QC TESTS,",myTitle.Sub,sep="")) +# 3.1. Flags, overall +cat(myTitle.Sub <- "### Flags") +cat("\n\n") +cat("#### Flag summary, overall number of records.") +cat("\n\n") +myTable <- addmargins(table(data.import[,paste("Flag",i,sep=".")]),1) +print(knitr::kable(t(as.matrix(myTable)), format = "markdown")) +cat("\n\n") +# +# 3.1. Number of Records (revised 20170228) +# Convert time interval (minutes) to number per day +records.expected <- round(24*60/as.numeric(myTimeDiff[1]),1) +cat(paste("Estimated number of records per day is ",records.expected,".",sep="")) +cat("\n\n") +# +cat("Number of records by year and month (with totals)") +cat("\n") +myTable <- addmargins(table(data.import[,ContData.env$myName.Yr],data.import[,ContData.env$myName.Mo])) +print(knitr::kable(myTable, format="markdown", row.names=TRUE)) +cat("\n\n") +# +cat("Number of records by day and month (with totals)") +cat("\n") +myTable <- addmargins(table(data.import[,ContData.env$myName.Day],data.import[,ContData.env$myName.Mo])) +print(knitr::kable(myTable, format="markdown", row.names=TRUE)) +cat("\n\n") +# +# identify days/months where not the expected number of records +# (expect first and last day) +# print("days where not the expected number of records") +# +# 3.2. Flags by QC Test +cat("\n\n") +cat("#### Flags by QC Test") +cat("\n\n") +cat("##### Flags, Gross\n\n") +myTable <- addmargins(table(data.import[,paste(ContData.env$myName.Flag,"Gross",i,sep=".")]),1) +print(knitr::kable(t(as.matrix(myTable)), format = "markdown")) +cat("\n\n") +cat("##### Flags, Spike\n\n") +myTable <- addmargins(table(data.import[,paste(ContData.env$myName.Flag,"Spike",i,sep=".")]),1) +print(knitr::kable(t(as.matrix(myTable)), format = "markdown")) +cat("\n\n") +cat("##### Flags, RoC\n\n") +myTable <- addmargins(table(data.import[,paste(ContData.env$myName.Flag,"RoC",i,sep=".")]),1) +print(knitr::kable(t(as.matrix(myTable)), format = "markdown")) +cat("\n\n") +cat("##### Flags, Flat\n\n") +myTable <- addmargins(table(data.import[,paste(ContData.env$myName.Flag,"Flat",i,sep=".")]),1) +print(knitr::kable(t(as.matrix(myTable)), format = "markdown")) +cat("\n\n") +cat("QC Test Flag fields are saved in the data file so the user can identify data points that have been flagged as suspect or fail.") +# +#myFlagTests <- c("Gross","Spike","RoC","Flat") +#(myTable.Flags.Flat <- ftable(data.import[,paste("Flag",myFlagTests,i,sep=".")])) +# +cat(paste("\n\n Test results marked as ",ContData.env$myFlagVal.NoData," (No/Missing Data) if unable to calculate the end point needed for the test. For example, the first record does not have a previous record for comparison for the Gross QC Test. QC Test flags are saved in the data file.",sep="")) +# +# 3.3. Plot +data.plot <- data.import +# +plot_format <- "ggplot" # "base" +data.plot[, ContData.env$myName.DateTime] <- as.POSIXct(data.plot[, ContData.env$myName.DateTime]) +# ggplot, main +scale_lab <- c("Continuous", "Discrete") +scale_col <- c("dark gray", "black") +scale_shape <- c(21, 24) +scale_fill <- scale_col +p_i <- ggplot2::ggplot(data=data.plot, ggplot2::aes_string(x=ContData.env$myName.DateTime, y=i)) + +ggplot2::geom_point(ggplot2::aes(color="continuous" +, shape="continuous" +, fill="continuous"), na.rm=TRUE) + +ggplot2::scale_x_datetime(date_labels = "%Y-%m-%d") + +ggplot2::labs(title=mySiteID, x=ContData.env$myLab.Date, y=myParameters.Lab[i.num]) + +ggplot2::theme(plot.title=ggplot2::element_text(hjust=0.5) +, plot.subtitle=ggplot2::element_text(hjust=0.5)) +myDiscrete <- paste(ContData.env$myPrefix.Discrete,i,sep=".") +myDiscrete +myDiscrete %in% myParameters.ALL == TRUE +data.plot[, ContData.env$myName.DateTime] <- as.POSIXct(data.plot[, ContData.env$myName.DateTime]) +# ggplot, main +scale_lab <- c("Continuous", "Discrete") +scale_col <- c("dark gray", "black") +scale_shape <- c(21, 24) +scale_fill <- scale_col +p_i <- ggplot2::ggplot(data=data.plot, ggplot2::aes_string(x=ContData.env$myName.DateTime, y=i)) + +ggplot2::geom_point(ggplot2::aes(color="continuous" +, shape="continuous" +, fill="continuous"), na.rm=TRUE) + +ggplot2::scale_x_datetime(date_labels = "%Y-%m-%d") + +ggplot2::labs(title=mySiteID, x=ContData.env$myLab.Date, y=myParameters.Lab[i.num]) + +ggplot2::theme(plot.title=ggplot2::element_text(hjust=0.5) +, plot.subtitle=ggplot2::element_text(hjust=0.5)) +# ggplot, discrete points +# Add discrete (only if present) +myDiscrete <- paste(ContData.env$myPrefix.Discrete,i,sep=".") +if (myDiscrete %in% myParameters.ALL == TRUE){##IF.Discrete.START +p_i <- p_i + ggplot2::geom_point(data=data.plot +, ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) +, y=as.name(myDiscrete) +, color="discrete" +, shape="discrete" +, fill="discrete"), na.rm=TRUE) +} else { +p_i <- p_i + ggplot2::geom_blank(ggplot2::aes(color="discrete" +, shape="discrete" +, fill="discrete")) +}##IF.Discrete.END +# ggplot, Legend +p_i <- p_i + +ggplot2::scale_color_manual(name="Data", labels=scale_lab, values=scale_col) + +ggplot2::scale_shape_manual(name="Data", labels=scale_lab, values=scale_shape) + +ggplot2::scale_fill_manual(name="Data", labels=scale_lab, values=scale_fill) +# ggplot, show +print(p_i) +cat("\n\n") +data.plot <- data.import +plot_format <- "ggplot" # "base" or "ggplot" +data.plot[, ContData.env$myName.DateTime] <- as.POSIXct(data.plot[, ContData.env$myName.DateTime]) +ContData.env$myName.AirTemp %in% myParameters & ContData.env$myName.WaterTemp %in% myParameters +cat("## PLOT, Temperature (Air vs. Water) \n\n" ) +# +# ggplot, main +scale_lab <- c("Air", "Water") +scale_col <- c("green", "blue") +scale_fill <- scale_col +scale_shape <- c(21, 21) +p2_t_aw <- ggplot2::ggplot(data=data.plot, ggplot2::aes(color="a" +, fill="b" +, shape="c")) + +ggplot2::geom_path(ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) +, y=as.name(ContData.env$myName.AirTemp) +, color="air"), na.rm=TRUE) + +ggplot2::geom_path(ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) +,y=as.name(ContData.env$myName.WaterTemp) +, color="water", na.rm=TRUE) + +ggplot2::scale_x_datetime(date_labels = "%Y-%m-%d") + +ggplot2::labs(title=mySiteID +, x=ContData.env$myLab.Date +, y=ContData.env$myLab.Temp.BOTH) + +ggplot2::theme(plot.title=ggplot2::element_text(hjust=0.5) +, plot.subtitle=ggplot2::element_text(hjust=0.5)) +# ggplot, discrete points +myDiscrete <- paste(ContData.env$myPrefix.Discrete,i,sep=".") +p2_t_aw <- ggplot2::ggplot(data=data.plot, ggplot2::aes(color="a" +, fill="b" +, shape="c")) + +ggplot2::geom_path(ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) +, y=as.name(ContData.env$myName.AirTemp) +, color="air"), na.rm=TRUE) + +ggplot2::geom_path(ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) +,y=as.name(ContData.env$myName.WaterTemp) +, color="water", na.rm=TRUE)) + +ggplot2::scale_x_datetime(date_labels = "%Y-%m-%d") + +ggplot2::labs(title=mySiteID +, x=ContData.env$myLab.Date +, y=ContData.env$myLab.Temp.BOTH) + +ggplot2::theme(plot.title=ggplot2::element_text(hjust=0.5) +, plot.subtitle=ggplot2::element_text(hjust=0.5)) +?geom_path +# ggplot, main +scale_lab <- c("Air", "Water") +scale_col <- c("green", "blue") +scale_fill <- scale_col +scale_shape <- c(21, 21) +p2_t_aw <- ggplot2::ggplot(data=data.plot, ggplot2::aes(color="a" +, fill="b" +, shape="c")) + +ggplot2::geom_path(ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) +, y=as.name(ContData.env$myName.AirTemp) +, color="air")) + +ggplot2::geom_path(ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) +,y=as.name(ContData.env$myName.WaterTemp) +, color="water")) + +ggplot2::scale_x_datetime(date_labels = "%Y-%m-%d") + +ggplot2::labs(title=mySiteID +, x=ContData.env$myLab.Date +, y=ContData.env$myLab.Temp.BOTH) + +ggplot2::theme(plot.title=ggplot2::element_text(hjust=0.5) +, plot.subtitle=ggplot2::element_text(hjust=0.5)) +p_t_aw +p2_t_aw +ggplot2::ggplot(data=data.plot, ggplot2::aes(color="a" +, fill="b" +, shape="c")) + +ggplot2::geom_path(ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) +, y=as.name(ContData.env$myName.AirTemp) +, color="air")) +ggplot2::ggplot(data=data.plot, ggplot2::aes(color="a" +, fill="b" +, shape="c")) + +ggplot2::geom_path(ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) +, y=as.name(ContData.env$myName.AirTemp) +, color="air")) + +ggplot2::geom_path(ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) +,y=as.name(ContData.env$myName.WaterTemp) +, color="water")) + +ggplot2::scale_x_datetime(date_labels = "%Y-%m-%d") + +ggplot2::labs(title=mySiteID +, x=ContData.env$myLab.Date +, y=ContData.env$myLab.Temp.BOTH) + +ggplot2::theme(plot.title=ggplot2::element_text(hjust=0.5) +, plot.subtitle=ggplot2::element_text(hjust=0.5)) +myDiscrete <- paste(ContData.env$myPrefix.Discrete,i,sep=".") +if (myDiscrete %in% myParameters.ALL == TRUE){##IF.Discrete.START +p2_t_aw <- p2_t_aw + ggplot2::geom_point(data=data.plot +, ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) +, y=as.name(myDiscrete) +, color="discrete" +, shape="discrete" +, fill="discrete"), na.rm=TRUE) +} else { +p2_t_aw <- p2_t_aw + ggplot2::geom_blank(ggplot2::aes(color="discrete" +, shape="discrete" +, fill="discrete")) +}##IF.Discrete. +p2_t_aw +p2_t_aw + +ggplot2::scale_color_manual(name="Data Type", labels=c("air", "water", "discrete") +) +p2_t_aw + +ggplot2::scale_color_manual(name="Data Type", labels=c("air", "water", "discrete"), values=c("green", "blue", "black")) +?ContDataQC +# Examples of each operation +# Parameters +Selection.Operation <- c("GetGageData","QCRaw", "Aggregate", "SummaryStats") +Selection.Type <- c("Air","Water","AW","Gage","AWG","AG","WG") +Selection.SUB <- c("Data0_Original", "Data1_RAW","Data2_QC","Data3_Aggregated","Data4_Stats") +myDir.BASE <- getwd() +# Create data directories +myDir.create <- paste0("./",Selection.SUB[1]) +ifelse(dir.exists(myDir.create)==FALSE,dir.create(myDir.create),"Directory already exists") +myDir.create <- paste0("./",Selection.SUB[2]) +ifelse(dir.exists(myDir.create)==FALSE,dir.create(myDir.create),"Directory already exists") +myDir.create <- paste0("./",Selection.SUB[3]) +ifelse(dir.exists(myDir.create)==FALSE,dir.create(myDir.create),"Directory already exists") +myDir.create <- paste0("./",Selection.SUB[4]) +ifelse(dir.exists(myDir.create)==FALSE,dir.create(myDir.create),"Directory already exists") +myDir.create <- paste0("./",Selection.SUB[5]) +ifelse(dir.exists(myDir.create)==FALSE,dir.create(myDir.create),"Directory already exists") +# Save example data (assumes directory ./Data1_RAW/ exists) +myData <- data_raw_test2_AW_20130426_20130725 +write.csv(myData,paste0("./",Selection.SUB[2],"/test2_AW_20130426_20130725.csv")) +myData <- data_raw_test2_AW_20130725_20131015 +write.csv(myData,paste0("./",Selection.SUB[2],"/test2_AW_20130725_20131015.csv")) +myData <- data_raw_test2_AW_20140901_20140930 +write.csv(myData,paste0("./",Selection.SUB[2],"/test2_AW_20140901_20140930.csv")) +myData <- data_raw_test4_AW_20160418_20160726 +write.csv(myData,paste0("./",Selection.SUB[2],"/test4_AW_20160418_20160726.csv")) +myFile <- "config.TZ.Central.R" +file.copy(file.path(path.package("ContDataQC"),"extdata",myFile) +,file.path(getwd(),Selection.SUB[2],myFile)) +# QC Raw Data +myData.Operation <- "QCRaw" #Selection.Operation[2] +myData.SiteID <- "test2" +myData.Type <- Selection.Type[3] #"AW" +myData.DateRange.Start <- "2013-01-01" +myData.DateRange.End <- "2014-12-31" +myDir.import <- file.path(myDir.BASE,Selection.SUB[2]) #"Data1_RAW" +myDir.export <- file.path(myDir.BASE,Selection.SUB[3]) #"Data2_QC" +myReport.format <- "docx" +ContDataQC(myData.Operation, myData.SiteID, myData.Type, myData.DateRange.Start +, myData.DateRange.End, myDir.import, myDir.export +, fun.myReport.format=myReport.format) +# QC Raw Data (offset collection times for air and water sensors) +myData.Operation <- "QCRaw" #Selection.Operation[2] +myData.SiteID <- "test4" +myData.Type <- Selection.Type[3] #"AW" +myData.DateRange.Start <- "2016-04-28" +myData.DateRange.End <- "2016-07-26" +myDir.import <- file.path(myDir.BASE,Selection.SUB[2]) #"Data1_RAW" +myDir.export <- file.path(myDir.BASE,Selection.SUB[3]) #"Data2_QC" +myReport.format <- "html" +ContDataQC(myData.Operation, myData.SiteID, myData.Type, myData.DateRange.Start +, myData.DateRange.End, myDir.import, myDir.export +, fun.myReport.format=myReport.format) +# Aggregate Data +myData.Operation <- "Aggregate" #Selection.Operation[3] +myData.SiteID <- "test2" +myData.Type <- Selection.Type[3] #"AW" +myData.DateRange.Start <- "2013-01-01" +myData.DateRange.End <- "2014-12-31" +myDir.import <- file.path(myDir.BASE,Selection.SUB[3]) #"Data2_QC" +myDir.export <- file.path(myDir.BASE,Selection.SUB[4]) #"Data3_Aggregated" +#Leave off myReport.format and get default (docx). +ContDataQC(myData.Operation, myData.SiteID, myData.Type, myData.DateRange.Start +, myData.DateRange.End, myDir.import, myDir.export) +# Summary Stats +myData.Operation <- "SummaryStats" #Selection.Operation[4] +myData.SiteID <- "test2" +myData.Type <- Selection.Type[3] #"AW" +myData.DateRange.Start <- "2013-01-01" +myData.DateRange.End <- "2014-12-31" +myDir.import <- file.path(myDir.BASE,Selection.SUB[4]) #"Data3_Aggregated" +myDir.export <- file.path(myDir.BASE,Selection.SUB[5]) #"Data4_Stats" +#Leave off myReport.format and get default (docx). +ContDataQC(myData.Operation, myData.SiteID, myData.Type, myData.DateRange.Start +, myData.DateRange.End, myDir.import, myDir.export) # NEWS # Render then Copy NEWS so picked up in help rmarkdown::render("NEWS.rmd", "all") @@ -434,51 +479,6 @@ setwd(paste0("./",myLibrary)) pkg <- "ContDataQC" library(pkg, character.only = TRUE) help(package=(pkg)) -# -# Convert Data for use with rLakeAnalyzer -# Data -fn_CDQC <- "TestLake_Water_20180702_20181012.csv" -df_CDQC <- read.csv(file.path(system.file(package = "ContDataQC"), "extdata", fn_CDQC)) -# Convert Date.Time from factor to POSIXct (make it a date and time field in R) -df_CDQC[, "Date.Time"] <- as.POSIXct(df_CDQC[, "Date.Time"]) -# Columns, date listed first -col_depth <- "Depth" -col_CDQC <- c("Date.Time", "temp_F", "DO_conc") -col_rLA <- c("datetime", "wtr", "doobs") -# Output Options -dir_export <- getwd() -fn_export <- paste0("rLA_", fn_CDQC) -# Run function -df_rLA <- Export.rLakeAnalyzer(df_CDQC, col_depth, col_CDQC, col_rLA -, dir_export, fn_export) -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# use rLakeAnalyzer - heat map -library(rLakeAnalyzer) -# Filter Data for only temperature -col_wtr <- colnames(df_rLA)[grepl("wtr_", colnames(df_rLA))] -df_rLA_wtr <- df_rLA[, c("datetime", col_wtr)] -# Create bathymetry data frame -df_rLA_bth <- data.frame(depths=c(3,6,9), areas=c(300,200,100)) -# Generate Heat Map -wtr.heat.map(df_rLA_wtr) -# Generate Schmidt Plot -schmidt.plot(df_rLA_wtr, df_rLA_bth) -# Generate Schmidt Stability Values -df_rLA_Schmidt <- ts.schmidt.stability(df_rLA_wtr, df_rLA_bth) -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# Plot original data in ggplot -library(ggplot2) -# Plot, Create -p <- ggplot(df_CDQC, aes(x=Date.Time, y=temp_F)) + -geom_point(aes(color=Depth)) + -scale_color_continuous(trans="reverse") + -scale_x_datetime(date_labels = "%Y-%m") -# Plot, Show -p -# generate Vignette -library(ContDataQC) -library(devtools) -devtools::build_vignettes() # NEWS # Render then Copy NEWS so picked up in help rmarkdown::render("NEWS.rmd", "all") diff --git a/DESCRIPTION b/DESCRIPTION index 50ed820..61e4044 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ContDataQC Title: Quality Control (QC) of Continous Monitoring Data -Version: 2.0.5.9011 +Version: 2.0.5.9012 Authors@R: c( person("Erik W.", "Leppo", email="Erik.Leppo@tetratech.com",role=c("aut","cre")), person("Ann","Roseberry Lincoln", role="ctb"), @@ -17,13 +17,13 @@ BugReports: https://github.com/leppott/ContDataQC/issues Imports: dataRetrieval, doBy, + ggplot2, knitr, rmarkdown, shiny, survival, zoo Suggests: - ggplot2, IHA, installr, rLakeAnalyzer, diff --git a/NEWS b/NEWS index 0e8734c..f8ed222 100644 --- a/NEWS +++ b/NEWS @@ -3,7 +3,7 @@ NEWS-ContDataQC - #> Last Update: 2019-02-19 13:24:28 + #> Last Update: 2019-02-21 10:13:18 # Planned Updates @@ -35,6 +35,14 @@ NEWS-ContDataQC # Version History +## v2.0.5.9012 + +2019-02-21 + + - Update plots in QC Report to ggplot. Issues \#83 and 84. + - Import files fix, na.strings= + - Use c(“”,“NA”) not just “”. + ## v2.0.5.9011 2019-02-19 diff --git a/NEWS.rmd b/NEWS.rmd index ee09d14..993f78c 100644 --- a/NEWS.rmd +++ b/NEWS.rmd @@ -44,6 +44,13 @@ cat(paste0("Last Update: ",Sys.time())) # Version History +## v2.0.5.9012 +2019-02-21 + +* Update plots in QC Report to ggplot. Issues #83 and 84. +* Import files fix, na.strings= + + Use c("","NA") not just "". + ## v2.0.5.9011 2019-02-19 diff --git a/R/fun.PeriodStats.R b/R/fun.PeriodStats.R index c669def..2841544 100644 --- a/R/fun.PeriodStats.R +++ b/R/fun.PeriodStats.R @@ -228,7 +228,7 @@ PeriodStats <- function(fun.myDate # }##IF.file.END # 2.2. Load File - df.load <- read.csv(file.path(fun.myDir.import, fun.myFile),as.is=TRUE,na.strings="") + df.load <- read.csv(file.path(fun.myDir.import, fun.myFile),as.is=TRUE,na.strings=c("","NA")) # 2.3. Error Checking, data field names param.len <- length(fun.myParam.Name) myNames2Match <- c(fun.myParam.Name, fun.myDateTime.Name) diff --git a/R/fun.QC.File.R b/R/fun.QC.File.R index 41ce248..8baf301 100644 --- a/R/fun.QC.File.R +++ b/R/fun.QC.File.R @@ -244,8 +244,8 @@ fun.QC.File <- function(fun.myFile #data.import=read.table(strFile,header=F,varSep) #varSep = "\t" (use read.delim instead of read.table) # as.is = T so dates come in as text rather than factor - #data.import <- read.delim(strFile,as.is=TRUE,na.strings="") - data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings="") + #data.import <- read.delim(strFile,as.is=TRUE,na.strings=c("","NA")) + data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings=c("","NA")) # # QC required fields: SiteID & (DateTime | (Date & Time)) fun.QC.ReqFlds(names(data.import),file.path(myDir.data.import,strFile)) @@ -806,7 +806,7 @@ fun.QC.File <- function(fun.myFile #************************ - #data.import <- read.csv(paste(myDir.data.import,strFile,sep="/"),as.is=TRUE,na.strings="") + #data.import <- read.csv(paste(myDir.data.import,strFile,sep="/"),as.is=TRUE,na.strings=c("","NA")) # # B.4.0. Columns # B.4.1. Check for DataFields (may have already been done) diff --git a/R/fun.QC.R b/R/fun.QC.R index 76d8986..9b26b6f 100644 --- a/R/fun.QC.R +++ b/R/fun.QC.R @@ -60,6 +60,8 @@ fun.QC <- function(fun.myData.SiteID , fun.myReport.Dir , fun.CreateReport=TRUE) {##FUN.fun.QC.START # + boo_DEBUG <- "FALSE" + # A. Data Prep #### # Convert Data Type to proper case fun.myData.Type <- paste(toupper(substring(fun.myData.Type,1,1)),tolower(substring(fun.myData.Type,2,nchar(fun.myData.Type))),sep="") @@ -207,8 +209,8 @@ fun.QC <- function(fun.myData.SiteID #varSep = "\t" (use read.delim instead of read.table) # as.is = T so dates come in as text rather than factor #data.import <- read.delim(strFile,as.is=TRUE,na.strings="") - # data.import <- read.csv(paste(myDir.data.import,strFile,sep="/"),as.is=TRUE,na.strings="") - data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings="") + # data.import <- read.csv(paste(myDir.data.import,strFile,sep="/"),as.is=TRUE,na.strings=c("","NA")) + data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings=c("","NA")) # # QC required fields: SiteID & (DateTime | (Date & Time)) fun.QC.ReqFlds(names(data.import),paste(myDir.data.import,strFile,sep="/")) @@ -794,7 +796,7 @@ fun.QC <- function(fun.myData.SiteID #************************ - #data.import <- read.csv(paste(myDir.data.import,strFile,sep="/"),as.is=TRUE,na.strings="") + #data.import <- read.csv(paste(myDir.data.import,strFile,sep="/"),as.is=TRUE,na.strings=c("","NA")) # # B.4.0. Columns # B.4.1. Check for DataFields (may have already been done) @@ -860,6 +862,18 @@ fun.QC <- function(fun.myData.SiteID #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # insert QC Report so runs without user intervention #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # DEBUG, REPORT #### + if(boo_DEBUG==TRUE){##IF~boo_DEBUG~START + fun.myData.SiteID <- strFile.SiteID + fun.myData.Type <- strFile.DataType + fun.myData.DateRange.Start <- fun.myData.DateRange.Start + fun.myData.DateRange.End <- fun.myData.DateRange.End + fun.myDir.BASE <- fun.myDir.BASE + fun.myDir.SUB.import <- fun.myDir.SUB.export + fun.myDir.SUB.export <- fun.myDir.SUB.export + fun.myFile.Prefix <- strFile.Out.Prefix + }##IF~boo_DEBUG~END + #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # run with same import and export directory ### # B.10.3. Report #### @@ -876,19 +890,6 @@ fun.QC <- function(fun.myData.SiteID ) }##IF.CreateReport.END #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# QC -# ## -# fun.myData.SiteID <- strFile.SiteID -# fun.myData.Type <- strFile.DataType -# fun.myData.DateRange.Start <- fun.myData.DateRange.Start -# fun.myData.DateRange.End <- fun.myData.DateRange.End -# fun.myDir.BASE <- fun.myDir.BASE -# fun.myDir.SUB.import <- fun.myDir.SUB.export -# fun.myDir.SUB.export <- fun.myDir.SUB.export -# fun.myFile.Prefix <- strFile.Out.Prefix - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # B.11. Clean up # B.11.1. Inform user of progress and update LOG diff --git a/R/fun.Report.File.R b/R/fun.Report.File.R index 9160b91..2ff4ea0 100644 --- a/R/fun.Report.File.R +++ b/R/fun.Report.File.R @@ -124,7 +124,7 @@ fun.Report.File <- function(fun.myFile } #import the file - data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings="") + data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings=c("","NA")) # pick 'report' based on prefix diff --git a/R/fun.Report.R b/R/fun.Report.R index db60e85..5145698 100644 --- a/R/fun.Report.R +++ b/R/fun.Report.R @@ -109,8 +109,8 @@ fun.Report <- function(fun.myData.SiteID }##IF.file.END #import the file - #data.import <- read.csv(paste(myDir.data.import,strFile,sep="/"),as.is=TRUE,na.strings="") - data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings="") + #data.import <- read.csv(paste(myDir.data.import,strFile,sep="/"),as.is=TRUE,na.strings=c("","NA")) + data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings=c("","NA")) # pick 'report' based on prefix diff --git a/R/fun.Stats.File.R b/R/fun.Stats.File.R index f8c45d9..fbf4b13 100644 --- a/R/fun.Stats.File.R +++ b/R/fun.Stats.File.R @@ -174,7 +174,7 @@ fun.Stats.File <- function(fun.myFile #import the file - data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings="") + data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings=c("","NA")) # # QC required fields: SiteID & (DateTime | (Date & Time)) #fun.QC.ReqFlds(names(data.import),paste(myDir.data.import,strFile,sep="/")) diff --git a/R/fun.Stats.R b/R/fun.Stats.R index a6e99c1..ceea06f 100644 --- a/R/fun.Stats.R +++ b/R/fun.Stats.R @@ -140,8 +140,8 @@ fun.Stats <- function(fun.myData.SiteID }##IF.file.END #import the file - #data.import <- read.csv(paste(myDir.data.import,strFile,sep="/"),as.is=TRUE,na.strings="") - data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings="") + #data.import <- read.csv(paste(myDir.data.import,strFile,sep="/"),as.is=TRUE,na.strings=c("","NA")) + data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings=c("","NA")) # # QC required fields: SiteID & (DateTime | (Date & Time)) #fun.QC.ReqFlds(names(data.import),paste(myDir.data.import,strFile,sep="/")) diff --git a/R/zfun.AggregateData.File.R b/R/zfun.AggregateData.File.R index 36dd8c0..7a7dafc 100644 --- a/R/zfun.AggregateData.File.R +++ b/R/zfun.AggregateData.File.R @@ -267,8 +267,8 @@ fun.AggregateData.File <- function(fun.myFile #data.import=read.table(strFile,header=F,varSep) #varSep = "\t" (use read.delim instead of read.table) # as.is = T so dates come in as text rather than factor - #data.import <- read.delim(strFile,as.is=TRUE,na.strings="") - data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings="") + #data.import <- read.delim(strFile,as.is=TRUE,na.strings=c("","NA")) + data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings=c("","NA")) # # QC required fields: SiteID & (DateTime | (Date & Time)) fun.QC.ReqFlds(names(data.import),file.path(myDir.data.import,strFile)) diff --git a/R/zfun.AggregateData.R b/R/zfun.AggregateData.R index 9b26f82..09a712a 100644 --- a/R/zfun.AggregateData.R +++ b/R/zfun.AggregateData.R @@ -228,9 +228,9 @@ fun.AggregateData <- function(fun.myData.SiteID #data.import=read.table(strFile,header=F,varSep) #varSep = "\t" (use read.delim instead of read.table) # as.is = T so dates come in as text rather than factor - #data.import <- read.delim(strFile,as.is=TRUE,na.strings="") - #data.import <- read.csv(paste(myDir.data.import,strFile,sep="/"),as.is=TRUE,na.strings="") - data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings="") + #data.import <- read.delim(strFile,as.is=TRUE,na.strings=c("","NA")) + #data.import <- read.csv(paste(myDir.data.import,strFile,sep="/"),as.is=TRUE,na.strings=c("","NA")) + data.import <- read.csv(file.path(myDir.data.import,strFile),as.is=TRUE,na.strings=c("","NA")) # # QC required fields: SiteID & (DateTime | (Date & Time)) #fun.QC.ReqFlds(names(data.import),paste(myDir.data.import,strFile,sep="/")) @@ -438,10 +438,10 @@ fun.AggregateData <- function(fun.myData.SiteID # fun.Name.myDF.2 <- myDF.Name.2 # # Load Files - #data.DF.1 <- read.csv(paste(myDir.data.export,fun.Name.myDF.1,sep="/"),as.is=TRUE,na.strings="") - #data.DF.2 <- read.csv(paste(myDir.data.export,fun.Name.myDF.2,sep="/"),as.is=TRUE,na.strings="") - data.DF.1 <- read.csv(file.path(myDir.data.export,fun.Name.myDF.1),as.is=TRUE,na.strings="") - data.DF.2 <- read.csv(file.path(myDir.data.export,fun.Name.myDF.2),as.is=TRUE,na.strings="") + #data.DF.1 <- read.csv(paste(myDir.data.export,fun.Name.myDF.1,sep="/"),as.is=TRUE,na.strings=c("","NA")) + #data.DF.2 <- read.csv(paste(myDir.data.export,fun.Name.myDF.2,sep="/"),as.is=TRUE,na.strings=c("","NA")) + data.DF.1 <- read.csv(file.path(myDir.data.export,fun.Name.myDF.1),as.is=TRUE,na.strings=c("","NA")) + data.DF.2 <- read.csv(file.path(myDir.data.export,fun.Name.myDF.2),as.is=TRUE,na.strings=c("","NA")) # # strip non file specific columns ???? # drop overlapping field names in data.DF.2 (typically the gage file) but keep DateTime @@ -759,8 +759,8 @@ fun.AggregateData <- function(fun.myData.SiteID # # # # Load Files -# data.air <- read.csv(paste(myDir.data.export,Name.File.Air,sep="/"),as.is=TRUE,na.strings="") -# data.water <- read.csv(paste(myDir.data.export,Name.File.Water,sep="/"),as.is=TRUE,na.strings="") +# data.air <- read.csv(paste(myDir.data.export,Name.File.Air,sep="/"),as.is=TRUE,na.strings=c("","NA")) +# data.water <- read.csv(paste(myDir.data.export,Name.File.Water,sep="/"),as.is=TRUE,na.strings=c("","NA")) # # strip non-file specific columns # myNames.Order.Air <- c(myName.SiteID,myName.Date,myName.Time,myName.DateTime,myName.AirTemp,myName.LoggerID.Air,myName.RowID.Air) # myNames.Order.Water <-c(myName.DateTime,myName.WaterTemp,myName.WaterP,myName.AirBP,myName.SensorDepth,myName.LoggerID.Water,myName.RowID.Water) @@ -822,7 +822,7 @@ fun.AggregateData <- function(fun.myData.SiteID # # # } else if (files.match[3]==TRUE) { # # -# data.AW <- read.csv(paste(myDir.data.export,Name.File.AW,sep="/"),as.is=TRUE,na.strings="") +# data.AW <- read.csv(paste(myDir.data.export,Name.File.AW,sep="/"),as.is=TRUE,na.strings=c("","NA")) # # # }##IF.air/water.END # @@ -904,7 +904,7 @@ fun.AggregateData <- function(fun.myData.SiteID # # Air # if(files.match[1]==TRUE){##IF.filesmatch_air.START # # -# data.air <- read.csv(paste(myDir.data.export,Name.File.Air,sep="/"),as.is=TRUE,na.strings="") +# data.air <- read.csv(paste(myDir.data.export,Name.File.Air,sep="/"),as.is=TRUE,na.strings=c("","NA")) # data.plot <- data.air # # cheat on Date/Time axis # n.Total <- length(data.plot[,myName.Date]) @@ -927,7 +927,7 @@ fun.AggregateData <- function(fun.myData.SiteID # # Water # if(files.match[2]==TRUE){##IF.filesmatch_water.START # # -# data.water <- read.csv(paste(myDir.data.export,Name.File.Water,sep="/"),as.is=TRUE,na.strings="") +# data.water <- read.csv(paste(myDir.data.export,Name.File.Water,sep="/"),as.is=TRUE,na.strings=c("","NA")) # data.plot <- data.water # # cheat on Date/Time axis # n.Total <- length(data.plot[,myName.Date]) diff --git a/R/zfun.ContDataQC.R b/R/zfun.ContDataQC.R index 97fedbf..9063455 100644 --- a/R/zfun.ContDataQC.R +++ b/R/zfun.ContDataQC.R @@ -276,6 +276,25 @@ ContDataQC <- function(fun.myData.Operation , fun.myReport.format="" , fun.myReport.Dir="" , fun.CreateReport=TRUE) {##FUN.fun.Master.START + # DEBUG #### + boo_DEBUG <- FALSE + if(boo_DEBUG==TRUE){##IF~boo_DEBUG~START + fun.myData.Operation <- myData.Operation + fun.myData.SiteID <- myData.SiteID + fun.myData.Type <- myData.Type + fun.myData.DateRange.Start <- myData.DateRange.Start + fun.myData.DateRange.End <- myData.DateRange.End + fun.myDir.import <- myDir.import + fun.myDir.export <- myDir.export + fun.myConfig <- "" + #fun.myFile <- "" + fun.myFile <- myFile + fun.myReport.format <- myReport.format + fun.myReport.Dir <- "" + source(file.path(getwd(), "inst", "extdata", "config.ORIG.R")) + source(file.path(getwd(), "R", "fun.Helper.R")) + }##IF~boo_DEBUG~END + # config file load, 20170517 if (fun.myConfig!="") {##IF.fun.myConfig.START config.load(fun.myConfig) diff --git a/inst/rmd/Report_QC.rmd b/inst/rmd/Report_QC.rmd index 1084880..c6924a2 100644 --- a/inst/rmd/Report_QC.rmd +++ b/inst/rmd/Report_QC.rmd @@ -14,8 +14,11 @@ output: ```{r setup, include=FALSE} knitr::opts_chunk$set(results='asis', echo=FALSE, warning=FALSE) # needed for trouble shooting -#myConfig <- file.path(system.file(package="ContDataQC"), "extdata", "config.ORIG.R") -#source(myConfig) +boo_DEBUG <- FALSE +if(boo_DEBUG==TRUE){ + myConfig <- file.path(system.file(package="ContDataQC"), "extdata", "config.ORIG.R") + source(myConfig) +} ``` # DATA FILE INFORMATION @@ -843,28 +846,77 @@ Overall flags by parameter # 3.3. Plot data.plot <- data.import # - # cheat on Date/Time axis - n.Total <- length(data.plot[,ContData.env$myName.Date]) - pct <- c(20,40,60,80,100)*.01 - myAT <- c(1,round(n.Total * pct,0)) - myLab <- data.plot[,ContData.env$myName.Date][myAT] + plot_format <- "ggplot" # "base" or "ggplot" # - myPlot.Y <- na.omit(as.numeric(data.plot[,i])) #20170518, v2.0.1.9008, coming in as text add na.omit(as.numeric(x)) - myPlot.Ylab <- myParameters.Lab[i.num] - plot(myPlot.Y,type="l",main=mySiteID,xlab=ContData.env$myLab.Date,ylab=myPlot.Ylab,col="gray", xaxt="n") - axis(1,at=myAT,labels=myLab,tick=TRUE) - # Add discrete (only if present) - myDiscrete <- paste(ContData.env$myPrefix.Discrete,i,sep=".") - if (myDiscrete %in% myParameters.ALL == TRUE){##IF.Discrete.START - data.plot[,myDiscrete] <- as.numeric(data.plot[,myDiscrete]) # coerce "NA" to NA - data.plot.points <- na.omit(data.plot[,c(ContData.env$myName.DateTime,myDiscrete)]) # remove NA - myPoints.X <- as.numeric(rownames(data.plot.points)) - myPoints.Y <- data.plot.points[,myDiscrete] - points(myPoints.Y~myPoints.X,col="black",pch=19) - }##IF.Discrete.END - cat("\n\n") - cat("Discrete measurements, if any, show up as points on the plot.") - cat("\n\n") + if(plot_format=="base"){##IF~plot_format~START + # plot, base #### + # cheat on Date/Time axis + n.Total <- length(data.plot[,ContData.env$myName.Date]) + pct <- c(20,40,60,80,100)*.01 + myAT <- c(1,round(n.Total * pct,0)) + myLab <- data.plot[,ContData.env$myName.Date][myAT] + # + myPlot.Y <- na.omit(as.numeric(data.plot[,i])) + #20170518, v2.0.1.9008, coming in as text add na.omit(as.numeric(x)) + myPlot.Ylab <- myParameters.Lab[i.num] + plot(myPlot.Y,type="l",main=mySiteID,xlab=ContData.env$myLab.Date + ,ylab=myPlot.Ylab,col="gray", xaxt="n") + axis(1,at=myAT,labels=myLab,tick=TRUE) + # Add discrete (only if present) + myDiscrete <- paste(ContData.env$myPrefix.Discrete,i,sep=".") + if (myDiscrete %in% myParameters.ALL == TRUE){##IF.Discrete.START + data.plot[,myDiscrete] <- as.numeric(data.plot[,myDiscrete]) # coerce "NA" to NA + data.plot.points <- na.omit(data.plot[,c(ContData.env$myName.DateTime,myDiscrete)]) + # remove NA + myPoints.X <- as.numeric(rownames(data.plot.points)) + myPoints.Y <- data.plot.points[,myDiscrete] + points(myPoints.Y~myPoints.X,col="black",pch=19) + }##IF.Discrete.END + cat("\n\n") + cat("Discrete measurements, if any, show up as points on the plot.") + cat("\n\n") + } else if(plot_format=="ggplot"){ + # plot, ggplot #### + data.plot[, ContData.env$myName.DateTime] <- as.POSIXct(data.plot[, ContData.env$myName.DateTime]) + # ggplot, main + scale_lab <- c("Continuous", "Discrete") + scale_col <- c("dark gray", "black") + scale_shape <- c(21, 24) + scale_fill <- scale_col + p_i <- ggplot2::ggplot(data=data.plot, ggplot2::aes_string(x=ContData.env$myName.DateTime, y=i)) + + ggplot2::geom_point(ggplot2::aes(color="continuous" + , shape="continuous" + , fill="continuous"), na.rm=TRUE) + + ggplot2::scale_x_datetime(date_labels = "%Y-%m-%d") + + ggplot2::labs(title=mySiteID, x=ContData.env$myLab.Date, y=myParameters.Lab[i.num]) + + ggplot2::theme(plot.title=ggplot2::element_text(hjust=0.5) + , plot.subtitle=ggplot2::element_text(hjust=0.5)) + # ggplot, discrete points + # Add discrete (only if present) + myDiscrete <- paste(ContData.env$myPrefix.Discrete,i,sep=".") + if (myDiscrete %in% myParameters.ALL == TRUE){##IF.Discrete.START + p_i <- p_i + ggplot2::geom_point(data=data.plot + , ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) + , y=as.name(myDiscrete) + , color="discrete" + , shape="discrete" + , fill="discrete"), na.rm=TRUE) + } else { + p_i <- p_i + ggplot2::geom_blank(ggplot2::aes(color="discrete" + , shape="discrete" + , fill="discrete")) + }##IF.Discrete.END + # ggplot, Legend + p_i <- p_i + + ggplot2::scale_color_manual(name="Data Type", labels=scale_lab, values=scale_col) + + ggplot2::scale_shape_manual(name="Data Type", labels=scale_lab, values=scale_shape) + + ggplot2::scale_fill_manual(name="Data Type", labels=scale_lab, values=scale_fill) + # ggplot, show + print(p_i) + cat("\n\n") + }##IF~plot_format~END + + # }##FOR.i.END @@ -879,126 +931,224 @@ Multiparameter plots if exist in the data. # 3.3. Plot data.plot <- data.import - # - # cheat on Date/Time axis - n.Total <- length(data.plot[,ContData.env$myName.Date]) - pct <- c(20,40,60,80,100)*.01 - myAT <- c(1,round(n.Total * pct,0)) - myLab <- data.plot[,ContData.env$myName.Date][myAT] - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - # Need to check for parameters before plot - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - # Temp, Air vs. Water - if (ContData.env$myName.AirTemp %in% myParameters & ContData.env$myName.WaterTemp - %in% myParameters == TRUE){##IF.Temp.START - cat("## PLOT, Temperature (Air vs. Water) \n\n" ) - # - par.orig <- par(no.readonly=TRUE) # save original par settings - layout(rbind(1,2),heights=c(7,1)) - # - myPlot.Y <- na.omit(as.numeric(data.plot[,ContData.env$myName.AirTemp])) # 20170518, v2.0.1.9008 - myPlot.Y2 <- na.omit(as.numeric(data.plot[,ContData.env$myName.WaterTemp])) # 20170518, v2.0.1.9008 - myPlot.Ylab <- ContData.env$myLab.Temp.BOTH - plot(myPlot.Y,type="l",main=mySiteID,xlab=ContData.env$myLab.Date,ylab=myPlot.Ylab,col="green", xaxt="n") - # Revised myAT for lots of NA (20170518) - data.length <- length(myPlot.Y) - myAT <- c(1,round(data.length * pct,0)) - # - axis(1,at=myAT,labels=myLab,tick=TRUE) - lines(myPlot.Y2,type="l",col="blue") - #legend(x="bottomright",lty=1,col=c("green","blue"),legend=c("air","water")) - # Add discrete, AirTemp (only if present) - myDiscrete <- paste(ContData.env$myPrefix.Discrete,ContData.env$myName.AirTemp,sep=".") - if (myDiscrete %in% myParameters.ALL == TRUE){##IF.Discrete.START - data.plot[,myDiscrete] <- as.numeric(data.plot[,myDiscrete]) # coerce "NA" to NA - data.plot.points <- na.omit(data.plot[,c(ContData.env$myName.DateTime,myDiscrete)]) # remove NA - myPoints.X <- as.numeric(rownames(data.plot.points)) - myPoints.Y <- data.plot.points[,myDiscrete] - points(myPoints.Y~myPoints.X,col="green",pch=19) - }##IF.Discrete.END - # Add discrete, Water.Temp (only if present) - myDiscrete <- paste(ContData.env$myPrefix.Discrete,ContData.env$myName.WaterTemp,sep=".") - if (myDiscrete %in% myParameters.ALL == TRUE){##IF.Discrete.START - data.plot[,myDiscrete] <- as.numeric(data.plot[,myDiscrete]) # coerce "NA" to NA - data.plot.points <- na.omit(data.plot[,c(ContData.env$myName.DateTime,myDiscrete)]) # remove NA - myPoints.X <- as.numeric(rownames(data.plot.points)) - myPoints.Y <- data.plot.points[,myDiscrete] - points(myPoints.Y~myPoints.X,col="blue",pch=19) - }##IF.Discrete.END - # - # LEGEND - par(mar=c(0,0,0,0)) - plot.new() - legend(x="center",lty=1,col=c("green","blue"),legend=c("air","water"),bty="n") - # - par(par.orig) # return to original par settings - # - # Future mod, add points to legend - cat("\n\n") - cat("Discrete measurements, if any, show up as points on the plot.") - cat("\n\n") + plot_format <- "ggplot" # "base" or "ggplot" + + # Plot + if(plot_format=="base"){##IF~plot_format~START + # plot, base #### + # cheat on Date/Time axis + n.Total <- length(data.plot[,ContData.env$myName.Date]) + pct <- c(20,40,60,80,100)*.01 + myAT <- c(1,round(n.Total * pct,0)) + myLab <- data.plot[,ContData.env$myName.Date][myAT] + #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # Need to check for parameters before plot + #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + # Temp, Air vs. Water + if (ContData.env$myName.AirTemp %in% myParameters & ContData.env$myName.WaterTemp + %in% myParameters == TRUE){##IF.Temp.START + cat("## PLOT, Temperature (Air vs. Water) \n\n" ) + # + par.orig <- par(no.readonly=TRUE) # save original par settings + layout(rbind(1,2),heights=c(7,1)) + # + myPlot.Y <- na.omit(as.numeric(data.plot[,ContData.env$myName.AirTemp])) # 20170518, v2.0.1.9008 + myPlot.Y2 <- na.omit(as.numeric(data.plot[,ContData.env$myName.WaterTemp])) # 20170518, v2.0.1.9008 + myPlot.Ylab <- ContData.env$myLab.Temp.BOTH + plot(myPlot.Y,type="l",main=mySiteID,xlab=ContData.env$myLab.Date,ylab=myPlot.Ylab,col="green", xaxt="n") + # Revised myAT for lots of NA (20170518) + data.length <- length(myPlot.Y) + myAT <- c(1,round(data.length * pct,0)) + # + axis(1,at=myAT,labels=myLab,tick=TRUE) + lines(myPlot.Y2,type="l",col="blue") + #legend(x="bottomright",lty=1,col=c("green","blue"),legend=c("air","water")) + # Add discrete, AirTemp (only if present) + myDiscrete <- paste(ContData.env$myPrefix.Discrete,ContData.env$myName.AirTemp,sep=".") + if (myDiscrete %in% myParameters.ALL == TRUE){##IF.Discrete.START + data.plot[,myDiscrete] <- as.numeric(data.plot[,myDiscrete]) # coerce "NA" to NA + data.plot.points <- na.omit(data.plot[,c(ContData.env$myName.DateTime,myDiscrete)]) # remove NA + myPoints.X <- as.numeric(rownames(data.plot.points)) + myPoints.Y <- data.plot.points[,myDiscrete] + points(myPoints.Y~myPoints.X,col="green",pch=19) + }##IF.Discrete.END + # Add discrete, Water.Temp (only if present) + myDiscrete <- paste(ContData.env$myPrefix.Discrete,ContData.env$myName.WaterTemp,sep=".") + if (myDiscrete %in% myParameters.ALL == TRUE){##IF.Discrete.START + data.plot[,myDiscrete] <- as.numeric(data.plot[,myDiscrete]) # coerce "NA" to NA + data.plot.points <- na.omit(data.plot[,c(ContData.env$myName.DateTime,myDiscrete)]) # remove NA + myPoints.X <- as.numeric(rownames(data.plot.points)) + myPoints.Y <- data.plot.points[,myDiscrete] + points(myPoints.Y~myPoints.X,col="blue",pch=19) + }##IF.Discrete.END + # + # LEGEND + par(mar=c(0,0,0,0)) + plot.new() + legend(x="center",lty=1,col=c("green","blue"),legend=c("air","water"),bty="n") + # + par(par.orig) # return to original par settings + # + # Future mod, add points to legend + cat("\n\n") + cat("Discrete measurements, if any, show up as points on the plot.") + cat("\n\n") + + # + }##IF.Temp.END # - }##IF.Temp.END - # - # Water, Temp vs Level - if (ContData.env$myName.WaterTemp %in% myParameters & ContData.env$myName.SensorDepth - %in% myParameters == TRUE){##IF.Temp_Level.START - cat("## PLOT, Sensor Depth vs. Water Temperature \n\n") - # - par.orig <- par(no.readonly=TRUE) # save original par settings - layout(rbind(1,2),heights=c(7,1)) - par(oma=c(0,0,0,2)) - # - myPlot.Y <- na.omit(as.numeric(data.plot[,ContData.env$myName.WaterTemp])) # 20170518, v2.0.1.9008 - myPlot.Ylab <- ContData.env$myLab.WaterTemp - myPlot.Y2 <- na.omit(as.numeric(data.plot[,ContData.env$myName.SensorDepth])) # 20170518, v2.0.1.9008 - myPlot.Y2lab <- ContData.env$myLab.SensorDepth - # - plot(myPlot.Y,type="l",main=mySiteID,xlab=ContData.env$myLab.Date,ylab=myPlot.Ylab,col="blue", xaxt="n") - # Revised myAT for lots of NA (20170518) - data.length <- length(myPlot.Y) - myAT <- c(1,round(data.length * pct,0)) - # - axis(1,at=myAT,labels=myLab,tick=TRUE) - # Add discrete, Water.Temp (only if present) - myDiscrete <- paste(ContData.env$myPrefix.Discrete,ContData.env$myName.WaterTemp,sep=".") - if (myDiscrete %in% myParameters.ALL == TRUE){##IF.Discrete.START - data.plot[,myDiscrete] <- as.numeric(data.plot[,myDiscrete]) # coerce "NA" to NA - data.plot.points <- na.omit(data.plot[,c(ContData.env$myName.DateTime,myDiscrete)]) # remove NA - myPoints.X <- as.numeric(rownames(data.plot.points)) - myPoints.Y <- data.plot.points[,myDiscrete] - points(myPoints.Y~myPoints.X,col="blue",pch=19) - }##IF.Discrete.END - # - # Add 2nd y axis (2nd color is black) - par(new=TRUE) - plot(myPlot.Y2,type="l",col="black",axes=FALSE,ann=FALSE) - axis(4) - mtext(myPlot.Y2lab,side=4,line=2.5) - # Add discrete, SensorDepth (only if present) - myDiscrete <- paste(ContData.env$myPrefix.Discrete,ContData.env$myName.SensorDepth,sep=".") - if (myDiscrete %in% myParameters.ALL == TRUE){##IF.Discrete.START - data.plot[,myDiscrete] <- as.numeric(data.plot[,myDiscrete]) # coerce "NA" to NA - data.plot.points <- na.omit(data.plot[,c(ContData.env$myName.DateTime,myDiscrete)]) # remove NA - myPoints.X <- as.numeric(rownames(data.plot.points)) - myPoints.Y <- data.plot.points[,myDiscrete] - points(myPoints.Y~myPoints.X,col="black",pch=19) - }##IF.Discrete.END + # Water, Temp vs Level + if (ContData.env$myName.WaterTemp %in% myParameters & ContData.env$myName.SensorDepth + %in% myParameters == TRUE){##IF.Temp_Level.START + cat("## PLOT, Sensor Depth vs. Water Temperature \n\n") + # + par.orig <- par(no.readonly=TRUE) # save original par settings + layout(rbind(1,2),heights=c(7,1)) + par(oma=c(0,0,0,2)) + # + myPlot.Y <- na.omit(as.numeric(data.plot[,ContData.env$myName.WaterTemp])) # 20170518, v2.0.1.9008 + myPlot.Ylab <- ContData.env$myLab.WaterTemp + myPlot.Y2 <- na.omit(as.numeric(data.plot[,ContData.env$myName.SensorDepth])) # 20170518, v2.0.1.9008 + myPlot.Y2lab <- ContData.env$myLab.SensorDepth + # + plot(myPlot.Y,type="l",main=mySiteID,xlab=ContData.env$myLab.Date,ylab=myPlot.Ylab,col="blue", xaxt="n") + # Revised myAT for lots of NA (20170518) + data.length <- length(myPlot.Y) + myAT <- c(1,round(data.length * pct,0)) + # + axis(1,at=myAT,labels=myLab,tick=TRUE) + # Add discrete, Water.Temp (only if present) + myDiscrete <- paste(ContData.env$myPrefix.Discrete,ContData.env$myName.WaterTemp,sep=".") + if (myDiscrete %in% myParameters.ALL == TRUE){##IF.Discrete.START + data.plot[,myDiscrete] <- as.numeric(data.plot[,myDiscrete]) # coerce "NA" to NA + data.plot.points <- na.omit(data.plot[,c(ContData.env$myName.DateTime,myDiscrete)]) # remove NA + myPoints.X <- as.numeric(rownames(data.plot.points)) + myPoints.Y <- data.plot.points[,myDiscrete] + points(myPoints.Y~myPoints.X,col="blue",pch=19) + }##IF.Discrete.END + # + # Add 2nd y axis (2nd color is black) + par(new=TRUE) + plot(myPlot.Y2,type="l",col="black",axes=FALSE,ann=FALSE) + axis(4) + mtext(myPlot.Y2lab,side=4,line=2.5) + # Add discrete, SensorDepth (only if present) + myDiscrete <- paste(ContData.env$myPrefix.Discrete,ContData.env$myName.SensorDepth,sep=".") + if (myDiscrete %in% myParameters.ALL == TRUE){##IF.Discrete.START + data.plot[,myDiscrete] <- as.numeric(data.plot[,myDiscrete]) # coerce "NA" to NA + data.plot.points <- na.omit(data.plot[,c(ContData.env$myName.DateTime,myDiscrete)]) # remove NA + myPoints.X <- as.numeric(rownames(data.plot.points)) + myPoints.Y <- data.plot.points[,myDiscrete] + points(myPoints.Y~myPoints.X,col="black",pch=19) + }##IF.Discrete.END + # + # LEGEND + par(mar=c(0,0,0,0)) + plot.new() + legend(x="center",lty=1,col=c("blue","black"),legend=c("temperature","sensor depth"),bty="n") # - # LEGEND - par(mar=c(0,0,0,0)) - plot.new() - legend(x="center",lty=1,col=c("blue","black"),legend=c("temperature","sensor depth"),bty="n") - # - # Future mod, add points to legend + # Future mod, add points to legend + # + par(par.orig) # return to original par settings + cat("\n\n") + cat("Discrete measurements, if any, show up as points on the plot.") + cat("\n\n") + }##IF.Temp_Level.END + } else if(plot_format=="ggplot"){ + # date to POSIX + data.plot[, ContData.env$myName.DateTime] <- as.POSIXct(data.plot[, ContData.env$myName.DateTime]) + # plot, ggplot #### + if (ContData.env$myName.AirTemp %in% myParameters & ContData.env$myName.WaterTemp %in% myParameters ){##IF.Temp.START + cat("## PLOT, Temperature (Air vs. Water) \n\n" ) + # + # ggplot, main + scale_lab <- c("Air", "Water") + scale_col <- c("green", "blue") + scale_fill <- scale_col + scale_shape <- c(21, 21) + + p2_t_aw <- ggplot2::ggplot(data=data.plot, ggplot2::aes(color="a" + , fill="b" + , shape="c")) + + ggplot2::geom_path(ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) + , y=as.name(ContData.env$myName.AirTemp) + , color="air")) + + ggplot2::geom_path(ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) + ,y=as.name(ContData.env$myName.WaterTemp) + , color="water")) + + ggplot2::scale_x_datetime(date_labels = "%Y-%m-%d") + + ggplot2::labs(title=mySiteID + , x=ContData.env$myLab.Date + , y=ContData.env$myLab.Temp.BOTH) + + ggplot2::theme(plot.title=ggplot2::element_text(hjust=0.5) + , plot.subtitle=ggplot2::element_text(hjust=0.5)) + # ggplot, discrete points + ## skip + + # ggplot, Legend + p2_t_aw <- p2_t_aw + + ggplot2::scale_color_manual(name="Data Type", labels=scale_lab, values=scale_col) + + # ggplot, show + print(p2_t_aw) + cat("\n\n") + # + }##IF.Temp.END # - par(par.orig) # return to original par settings - cat("\n\n") - cat("Discrete measurements, if any, show up as points on the plot.") - cat("\n\n") - }##IF.Temp_Level.END + # Water, Temp vs Level + if (ContData.env$myName.WaterTemp %in% myParameters & ContData.env$myName.SensorDepth %in% myParameters){##IF.Temp_Level.START + cat("## PLOT, Sensor Depth vs. Water Temperature \n\n") + # + # ggplot, main + scale_lab <- c("Water Temp", "Sensor Depth") + scale_col <- c("blue", "black") + scale_fill <- scale_col + scale_shape <- c(21, 21) + + # ggplot intentionaly not designed for dual y plotting + min_diff <- min(data.plot[, ContData.env$myName.WaterTemp], na.rm=TRUE) - min(data.plot[, ContData.env$myName.SensorDepth], na.rm=TRUE) + rd_y1 <- diff(range(data.plot[, ContData.env$myName.WaterTemp], na.rm = TRUE)) + rd_y2 <- diff(range(data.plot[, ContData.env$myName.SensorDepth], na.rm = TRUE)) + min_y1 <- min(data.plot[, ContData.env$myName.WaterTemp]) + max_y1 <- max(data.plot[, ContData.env$myName.WaterTemp]) + avg_y1 <- mean(data.plot[, ContData.env$myName.WaterTemp]) + data.plot[, "depth4plot"] <- (data.plot[, ContData.env$myName.SensorDepth] * rd_y1/rd_y2) + min_diff + + p3_td <- ggplot2::ggplot(data=data.plot) + + ggplot2::geom_path(ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) + , y=as.name(ContData.env$myName.WaterTemp) + , color="water")) + + ggplot2::geom_path(ggplot2::aes_q(x=as.name(ContData.env$myName.DateTime) + ,y=as.name("depth4plot") + , color="depth")) + + ggplot2::scale_x_datetime(date_labels = "%Y-%m-%d") + + ggplot2::labs(title=mySiteID + , x=ContData.env$myLab.Date + , y=ContData.env$myLab.WaterTemp) + + ggplot2::theme(plot.title=ggplot2::element_text(hjust=0.5) + , plot.subtitle=ggplot2::element_text(hjust=0.5)) + # ggplot, add 2nd Y + p3_td <- p3_td + ggplot2::scale_y_continuous(sec.axis = ggplot2::sec_axis( + trans=~./(rd_y1/rd_y2)-(min_diff/(rd_y1/rd_y2)) + , name=ContData.env$myLab.SensorDepth)) + + # ggplot, discrete points + ## skip + + # ggplot, Legend + ## need to reverse legend items to be correct. + p3_td <- p3_td + + ggplot2::scale_color_manual(name="Data Type", labels=rev(scale_lab), values=rev(scale_col)) + + # ggplot, show + print(p3_td) + cat("\n\n") + # + }##IF.Temp_Level.END + }##IF~plot_format~START + # ''' ```