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).

# 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"){##IF~plot_format~START
      # plot, base ####
      # 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")
      }##IF.threshold.END
      #
    } else if(plot_format=="ggplot"){
      # 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