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

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)

DATA FILE INFORMATION

# Report Info
myReportDate <- format(Sys.Date(), fun.myDate.Format)
# myReportDate <- format(Sys.Date(),fd01)
cat(paste("**Report Date:** ", myReportDate, "\n\n", sep = ""))
myUser <- Sys.getenv("USERNAME")
cat(paste("**Generated By:** ", myUser, "\n\n", sep = ""))

cat("**Benchmark Date:** ", fun.myDate, collapse = "\n\n", sep = "")

cat("**Period (N, Units):** ", paste(fun.myPeriod.N[1:numPeriods]
                                     , fun.myPeriod.Units[1:numPeriods], collapse = ", ", sep = "")
    , collapse = "\n\n", sep = "")

cat(paste("**Period Start Date:** ", paste(as.Date(myDate.Start[1:numPeriods]), collapse = ", "), sep = ""), collapse = "\n\n")

cat("**Minimum Date in File:** ", myDate.File.Min, collapse = "\n\n", sep = "")

cat("**Difference (Benchmark-Minimum Date):** ", myDate.Diff.FileMin.Benchmark, collapse = "\n\n", sep = "")

cat("**Parameter(s):** ", paste(fun.myParam.Name, collapse=", ", sep = ""), collapse = "\n\n", sep = "")

cat("**Threshold:** ",fun.myThreshold, collapse = "\n\n", sep = "")

cat("**QC Flag Failures Exclude:** "
    , ContData.env$myStats.Fails.Exclude
    ,  collapse = "\n\n"
    , sep = "")

cat("**Filename, Input:** ", fun.myFile, "\n\n", sep = "")

#cat("**Filename, Output:** ",paste0(myFile.Export.part,myFile.Export.ext),sep="")

PLOTS

Mean daily values for requested date ranges with line for threshold (if provided).

# par
par.orig <- par(no.readonly = TRUE) # save original par settings

# Loop through 2 parameters
for (m in fun.myParam.Name){##FOR.m.START
  #
  m.num <- match(m, fun.myParam.Name)
  # print header 2
  cat("\n\n")
  cat("## ", fun.myParam.Name[m.num], sep = "")
  cat("\n\n")
  flush.console()
  #
  # select df based on iteration
  if (m.num == 1) {##IF.m.num.START
    df.summary.plot <- df.summary.plot.1
  } else if (m.num == 2) {
    df.summary.plot <- df.summary.plot.2
  }##IF.m.num.END
  #


  for (n in 1:numPeriods){##FOR.n.START
    # subset
    df.plot <- df.summary.plot[df.summary.plot[, myDate.Name] >= as.Date(myDate.Start[n]) & df.summary.plot[, myDate.Name] <= as.Date(myDate.End), ]

    # Plot format
    plot_format <- "base" # "base" or "ggplot"
    #
    if (plot_format == "base") {
      # plot, base ####
      # Add extra space to right of plot area
      par(mar = c(10, 4.1, 4.1, 2))
      # main
      str_main <- paste0(fun.myDate
                         , " \n("
                         , fun.myPeriod.N[n]
                         , fun.myPeriod.Units[n]
                         , ")")
      # plot
      plot(df.plot[, 1:2], main = str_main, type = "n")
      # Add min/max range
      myCol_minmax <- "light gray"
      lines(df.plot[, c(1,5)], col = myCol_minmax) #max
      lines(df.plot[, c(1,4)], col = myCol_minmax) #min
      polygon(c(df.plot[, 1], rev(df.plot[, 1]))
              , c(df.plot[, 5],rev(df.plot[, 4]))
              , col = myCol_minmax
              , border = NA)
      lines(df.plot[, 1:2], lwd = 1) # mean (replot on top)
      # Add line
      if (!is.na(fun.myThreshold)){##IF.threshold.START
        abline(h = fun.myThreshold, col = "blue", lty = "dashed")
        # Legend (w/ threshold)
        legend("bottom"
               , legend = c("mean", "Range (min, max)", "Threshold")
               , col = c("black", "light gray", "blue")
               , lty = c("solid", NA, "dashed")
               , pch = c(NA, 15, NA)
               , pt.cex = 2
               , bty = "n"
               , inset = c(0, -1.5)
               , xpd = TRUE
               )
      } else {
        # Legend (w/o threshold)
        legend("bottom"
               , legend = c("mean", "Range (min, max)")
               , col = c("black", "light gray")
               , lty = c("solid", NA)
               , pch = c(NA, 15)
               , pt.cex = 2
               , bty = "n"
               , inset = c(0, -1.5)
               , xpd = TRUE
               )
      }##IF.threshold.END
      #
      par(par.orig)
      #
    } else if (plot_format == "ggplot") {
      # missing legend

      # plot, ggplot ####
      x_name <- names(df.summary.plot)[1]
      y_name <- names(df.summary.plot)[2]
      str_title    <- fun.myDate 
      str_subtitle <- paste0("(", fun.myPeriod.N[n], fun.myPeriod.Units[n], ")")
      #
      p_ps <- ggplot2::ggplot(df.summary.plot) +
               ggplot2::geom_point(ggplot2::aes_q(x = as.name(x_name)
                                                  , y = as.name(y_name))) + 
               ggplot2::labs(title = str_title, subtitle = str_subtitle) +
               ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5)
                          , plot.subtitle = ggplot2::element_text(hjust = 0.5))
      #
      # Add line (if have data)
      if (!is.na(fun.myThreshold)) {##IF.threshold.START
        p_ps <- p_ps +
          ggplot2::geom_hline(ggplot2::aes_string(yintercept = fun.myThreshold))
      }##IF.threshold.START
      #
      print(p_ps)
      #
    }##IF~plot_format~START
    #

  }##FOR.n.END
  #
}##FOR.m.END

PLOTS, MULTIPARAMETER

Multiparameter plots if exist in the data.

# only run this section if have more than a single parameter
if (param.len == 2) {##IF.len.START

  #cat("# PLOTS, MULTIPARAMETER\n\n") 
  #cat("Multiparameter plots if exist in the data.\n\n") 
  cat("## ",fun.myParam.Name[1]," and ",fun.myParam.Name[2]," \n\n",sep="")

  # par
  par.orig <- par(no.readonly = TRUE) # save original par settings

  # data
  ## Data to plot
  df.merge <- merge(df.summary.plot.1[, 1:2], df.summary.plot.2[, 1:2], )
  ## munge date
  df.merge[,1] <- as.Date(df.merge[, 1], format = ContData.env$myFormat.Date)

  # Plot parameters
  col.Y  <- "blue"
  col.Y2 <- "black"
  pch.Y  <- 21
  pch.Y2 <- 22
  lab.Y  <- names(df.merge[2])
  lab.Y2 <- names(df.merge[3])


  # Plots
  ## Loop through each period
  #p <- 1   
  for (p in 1:numPeriods) {##FOR.n.START
    # subset
    df.plot.multi <- df.merge[df.merge[,myDate.Name] >= as.Date(myDate.Start[p]) & df.merge[,myDate.Name] <= as.Date(myDate.End), ]
    #
    plot_format <- "base" # "base" or "ggplot"
    #
    if (plot_format == "base") {##IF~plot_format~START
    # plot, base ####

    # Add extra space to right of plot area; change clipping to figure
    #par(mar=c(5.1, 4.1, 4.1, 8.1), xpd=TRUE)

    # Add space on right margin for Y2 axis (4)
    par(oma = c(0, 0, 0, 2.5))

    # create plot
    plot(df.plot.multi[,1:2]
         , main = paste0(fun.myDate
                         , " \n("
                         , fun.myPeriod.N[p]
                         , fun.myPeriod.Units[p]
                         , ")")
         , col = col.Y
         #, pch = pch.Y
         , type = "l"
         )
    # Add line
    if (!is.na(fun.myThreshold)) {
      abline(h = fun.myThreshold, col = col.Y)
    }

    # Add 2nd y axis (2nd color is black)
    par(new = TRUE)
    plot(df.plot.multi[, c(1,3)]
         , col = col.Y2
         #, pch = pch.Y2
         , type = "l"
         , axes = FALSE
         , ann = FALSE)
    # Y2, axis numbers
    axis(4)
    # Y2, label
    mtext(lab.Y2, side = 4, line = 2.5)

    #Margin Legend
    ## Current version creates a 2nd plot, works ok for output.  Not part of original plot.
    #https://stackoverflow.com/questions/3932038/plot-a-legend-outside-of-the-plotting-area-in-base-graphics
    #http://benfradet.github.io/blog/2014/04/30/Display-legend-outside-plot-R
    # LEGEND
      par(mar = c(0,0,0,0))
      plot.new()
      legend(x = "center"
             , inset = c(-0.25,0)
             , pch = c(pch.Y, pch.Y2)
             , col = c(col.Y, col.Y2)
             , legend = fun.myParam.Name
             , bty = "n")
    # par (original)
    par(par.orig) # return to original par settings
    #
    } else if (plot_format == "ggplot") {
      # plot, ggplot ####




    }##IF~plot_format~START
  }##FOR.p.END

  # par
  par(par.orig) # return to original par settings
  #
}##IF.len.END