In leppott/ContDataQC: Quality Control (QC) of Continous Monitoring Data

knitr::opts_chunk$set(results = 'asis', echo = FALSE, warning = FALSE)
# needed for trouble shooting
boo_QC <- TRUE
if (boo_QC) {
  myConfig <- file.path(system.file(package = "ContDataQC")
                      , "extdata", "config.ORIG.R")
  source(myConfig)
}## IF ~ boo_QC

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 = "")

  cat(paste("**SiteID:** ",strFile.SiteID,"\n\n",sep = ""))

  cat(paste("**Period of Record, Requested:** ",fun.myData.DateRange.Start," to ",fun.myData.DateRange.End,sep = "",collapse = "\n\n"))

  # myTimeDiff <- difftime(data.import[11,ContData.env$myName.DateTime],data.import[10,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[,myName.Date])
            , " to "
            , max(data.import[,myName.Date])
            , "\n\n"
            , sep = ""))

  cat(paste("**Recording Interval:** ", myTimeDiff[1], " minutes\n\n" ,sep = ""))

#  cat(paste("**Data Type:** ",strFile.DataType,"\n\n",sep=""))  # need to do better

   myParameters <- ContData.env$myNames.DataFields[ContData.env$myNames.DataFields %in% names(data.import) == TRUE] 
   myParameters.Lab <- ContData.env$myNames.DataFields.Lab[ContData.env$myNames.DataFields %in% names(data.import) == TRUE]
 #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,", ",sep = ""), "\n\n",sep = "")

  # new stuff, 20220520
  myParameters.Flags <-  ContData.env$myNames.Flags[ContData.env$myNames.Flags
                                              %in% names(data.import) == TRUE]
  cat("**Parameters with Flags:**"
      , paste(myParameters.Flags, ", ", sep = "")
      , "\n\n"
      , sep = "")

FLAGS

Each data point is checked by each of the four QC tests below.

Gross Range Test (Gross): Test if data point exceeds sensor or user defined min/max. The values are user defined based on parameter being measured and measuring instrument.
Spike Test (Spike): Test if data point exceeds a user defined threshold relative to the previous data point. The user defined values are based on the parameter being measured.
Rate of Change Test (RoC): Test if a data point exceeds a number of standard deviations from the previous data points over a user defined time period. Default is a 25 hour time period and 3 standard deviations.
Flat Line Test (Flat): Test if a data point is within a user defined threshold from previous data points over a user defined range. Default is 3 previous points for suspect and 5 points for failure. The threshold is user defined and based on the measured parameter and sensitivity of the measuring instrument.

Flags are assigned to each data point (a single measured parameter at a unique point in time) first by each of the QC tests below. Flags are assigned numerical values;

cat(paste("* **"
          ,ContData.env$myFlagVal.Pass
          , "** = Pass"
          , sep = ""))
cat("\n")
cat(paste("* **"
          , ContData.env$myFlagVal.Suspect
          , "** = Suspect"
          , sep = ""))  
cat("\n")
cat(paste("* **",ContData.env$myFlagVal.Fail
          , "** = Fail"
          , sep = ""))
cat("\n")
cat(paste("* **",ContData.env$myFlagVal.NoData
          , "** = No Data or Not Applicable (NA)"
          , sep = ""))

Overall flags are assigned by examining the results of the four tests below.

cat(paste("* **",ContData.env$myFlagVal.Pass
          , "** = no Fail or Suspect and at least one Pass"
          , sep = ""))
cat("\n")
cat(paste("* **",ContData.env$myFlagVal.Suspect
          , "** = no Fail and at least one Suspect"
          , sep = "")) 
cat("\n") 
cat(paste("* **", ContData.env$myFlagVal.Fail
          , "** = at least one Fail"
          , sep = ""))
cat("\n")
cat(paste("* **", ContData.env$myFlagVal.NoData
          , "** = all tests were Missing Data"
          , sep = ""))

The thresholds used in the tests are defined in the config file.

New stuff

20220520

# Check for parameters and flags
# when have both create table

# Parameters with Flags
p <- "Water.Temp.C"
p_flag <- paste0("Flag.", p)
df_p <- data.import[data.import[, p_flag] != "P",  ]
t_p <- table(df_p[, "Date"], df_p[, p_flag])
cap_p <- paste0("Flags by Date, ", p)
knitr::kable(t_p, caption = cap_p)

## NA
# NA by date
df_NA <- data.import[is.na(data.import[, p]), ]
t_p_NA <- table(df_NA[, "Date"], useNA = "ifany")
cap_NA <- paste0("Missing Data by Date, ", p)
knitr::kable(t_p_NA, caption = cap_NA)
cap_NA_DateTime <- paste0("Missing Data by Date Time, ", p)
knitr::kable(df_NA[, c("Date.Time", p)])

# Detailed Flags
flag_names <- c("Gross", "Spike", "RoC", "Flat")
col_p_flags <- paste0("Flag.", flag_names, ".", p)
df_p_flags <- df_p[rownames(t_p) %in% df_p[, "Date"]
                   , c("Date.Time", p, p_flag, col_p_flags)]
df_p_flags_kable <- df_p_flags[!is.na(df_p_flags[, p]), ]
# change names so shorter
names(df_p_flags_kable)[grepl("Flag.Gross", names(df_p_flags_kable))] <- "Gross"
names(df_p_flags_kable)[grepl("Flag.Spike", names(df_p_flags_kable))] <- "Spike"
names(df_p_flags_kable)[grepl("Flag.RoC", names(df_p_flags_kable))] <- "RoC"
names(df_p_flags_kable)[grepl("Flag.Flat", names(df_p_flags_kable))] <- "Flat"
cap_p_flags <-  paste0("Flags by Date Time, ", p)
knitr::kable(df_p_flags_kable, caption = cap_p_flags)