R/dvhydrograph-render.R

Defines functions plotDVHydroLegend getDVHydrographRefPlotConfig getDVHydrographPlotConfig createDVHydrographRefPlot createDVHydrographPlot

Documented in createDVHydrographPlot createDVHydrographRefPlot getDVHydrographPlotConfig getDVHydrographRefPlotConfig plotDVHydroLegend

#' Create DV Hydrograph Plot
#'
#' @description Given a full report JSON object, extracts
#' relevant data, formats it, and then creates a DV Hydrogrpah
#' plot from it.
#' @param reportObject the full report JSON object
createDVHydrographPlot <- function(reportObject){
  #Rendering Options
  options(scipen=8)

  #Validate Report Metadata
  metaData <- fetchReportMetadata(reportObject)

  requiredMetadataFields <- c(
    'startDate',
    'endDate',
    'isInverted',
    'timezone',
    'stationId',
    'title'
  )

  #Get Necessary Report Metadata
  if(validateFetchedData(metaData, "metadata", requiredMetadataFields)){
    timezone <- fetchReportMetadataField(reportObject, 'timezone')
    excludeZeroNegativeFlag <- parseReportMetadataField(reportObject, 'excludeZeroNegative', FALSE)
    excludeMinMaxFlag <- parseReportMetadataField(reportObject, 'excludeMinMax', FALSE)
    invertedFlag <- parseReportMetadataField(reportObject, 'isInverted', FALSE)
    startDate <- flexibleTimeParse(fetchReportMetadataField(reportObject, 'startDate'), timezone=timezone)
    endDate <- toEndOfDay(flexibleTimeParse(fetchReportMetadataField(reportObject, 'endDate'), timezone=timezone))
    plotDates <- toStartOfDay(seq(startDate, endDate, by = 7 * 24 * 60 * 60))
  }

  #Get Basic Plot data
  stat1TimeSeries <- parseTimeSeries(reportObject, 'firstStatDerived', 'firstStatDerivedLabel', timezone, isDV=TRUE)
  stat2TimeSeries <- parseTimeSeries(reportObject, 'secondStatDerived', 'secondStatDerivedLabel', timezone, isDV=TRUE)
  stat3TimeSeries <- parseTimeSeries(reportObject, 'thirdStatDerived', 'thirdStatDerivedLabel', timezone, isDV=TRUE)
  stat4TimeSeries <- parseTimeSeries(reportObject, 'fourthStatDerived', 'fourthStatDerivedLabel', timezone, isDV=TRUE)
  stat1TimeSeriesEst <- parseTimeSeries(reportObject, 'firstStatDerived', 'firstStatDerivedLabel', timezone, estimated=TRUE, isDV=TRUE)
  stat2TimeSeriesEst <- parseTimeSeries(reportObject, 'secondStatDerived', 'secondStatDerivedLabel', timezone, estimated=TRUE, isDV=TRUE)
  stat3TimeSeriesEst <- parseTimeSeries(reportObject, 'thirdStatDerived', 'thirdStatDerivedLabel', timezone, estimated=TRUE, isDV=TRUE)
  stat4TimeSeriesEst <- parseTimeSeries(reportObject, 'fourthStatDerived', 'fourthStatDerivedLabel', timezone, estimated=TRUE, isDV=TRUE)

  #Validate Basic Plot Data
  if(all(isEmptyOrBlank(c(stat1TimeSeries, stat1TimeSeriesEst, stat2TimeSeries, stat2TimeSeriesEst, stat3TimeSeries, stat3TimeSeriesEst, stat4TimeSeries, stat4TimeSeriesEst)))){
    return(NULL)
  }

  #Find the highest priority TS that has data
  priorityTS <- list(stat1TimeSeries, stat2TimeSeries, stat3TimeSeries, stat4TimeSeries, stat1TimeSeriesEst, stat2TimeSeriesEst, stat3TimeSeriesEst, stat4TimeSeriesEst)
  priorityTS <- priorityTS[unlist(lapply(priorityTS, function(ts){!isEmptyOrBlank(ts)}))][[1]]

  #Get Additional Plot Data
  comparisonTimeSeries <- parseTimeSeries(reportObject, 'comparisonSeries', 'comparisonSeriesLabel', timezone, isDV=TRUE)
  comparisonTimeSeriesEst <- parseTimeSeries(reportObject, 'comparisonSeries', 'comparisonSeriesLabel', timezone, estimated=TRUE, isDV=TRUE)
  groundWaterLevels <- parseGroundWaterLevels(reportObject)
  waterQualityData <- parseWaterQualityMeasurements(reportObject)
  fieldVisitMeasurements <- parseFieldVisitMeasurements(reportObject, excludeZeroNegativeFlag)
  minMaxIVs <- parseMinMaxIVs(reportObject, timezone, priorityTS[['type']], invertedFlag, excludeMinMaxFlag, excludeZeroNegativeFlag)
  minMaxLabels <- NULL
  minMaxEst <- list()
  minMaxPoints <- NULL
  minMaxCanLog <- TRUE
  fieldVisitMeasurementsCanLog <- NULL

  if(!isEmptyOrBlank(minMaxIVs)){
    primarySeriesQualifiers <- parsePrimarySeriesQualifiers(reportObject, filterCode = 'E')
    minMaxEst[['max_iv']] <- any((minMaxIVs$max_iv$time >= primarySeriesQualifiers$startTime) & (minMaxIVs$max_iv$time <= primarySeriesQualifiers$endTime))
    minMaxEst[['min_iv']] <- any((minMaxIVs$min_iv$time >= primarySeriesQualifiers$startTime) & (minMaxIVs$min_iv$time <= primarySeriesQualifiers$endTime))
    minMaxLabels <- minMaxIVs[grepl("label", names(minMaxIVs))]
    minMaxPoints <- minMaxIVs[!grepl("label", names(minMaxIVs))]
    minMaxCanLog <- minMaxIVs[['canLog']]
  }

  primarySeriesApprovals <- parsePrimarySeriesApprovals(reportObject, startDate, endDate)
  primarySeriesLegend <- fetchReportMetadataField(reportObject, 'primarySeriesLabel')
  approvals <- readApprovalBar(primarySeriesApprovals, timezone, legend_nm=primarySeriesLegend, snapToDayBoundaries=TRUE)
  primaryTSCanLog <- isLogged(priorityTS[['points']], priorityTS[['isVolumetricFlow']], excludeZeroNegativeFlag)
  if (!isEmptyOrBlank(fieldVisitMeasurements)) {
    fieldVisitMeasurementsCanLog <- fieldVisitMeasurements[['canLog']] 
  }
  
  if (!isEmptyOrBlank(fieldVisitMeasurementsCanLog) && fieldVisitMeasurementsCanLog) {
      fieldVisitMeasurements <- removeZeroNegative(fieldVisitMeasurements)
  }
  
  logAxis <- primaryTSCanLog && (isEmptyOrBlank(fieldVisitMeasurementsCanLog) || fieldVisitMeasurementsCanLog) && minMaxCanLog
  yLabel <- paste0(priorityTS[['type']], ", ", priorityTS[['unit']])

  #Get Estimated / Non-Estimated Edges
  estimated1Edges <- getEstimatedEdges(stat1TimeSeries, stat1TimeSeriesEst, excludeZeroNegativeFlag)
  estimated2Edges <- getEstimatedEdges(stat2TimeSeries, stat2TimeSeriesEst, excludeZeroNegativeFlag)
  estimated3Edges <- getEstimatedEdges(stat3TimeSeries, stat3TimeSeriesEst, excludeZeroNegativeFlag)
  estimated4Edges <- getEstimatedEdges(stat4TimeSeries, stat4TimeSeriesEst, excludeZeroNegativeFlag)
  comparisonEdges <- getEstimatedEdges(comparisonTimeSeries, comparisonTimeSeriesEst, excludeZeroNegativeFlag)
  
  estimated1EdgesDf <- as.data.frame(estimated1Edges, stringsAsFactors = FALSE)
  estimated2EdgesDf <- as.data.frame(estimated2Edges, stringsAsFactors = FALSE)
  estimated3EdgesDf <- as.data.frame(estimated3Edges, stringsAsFactors = FALSE)
  estimated4EdgesDf <- as.data.frame(estimated4Edges, stringsAsFactors = FALSE)
  comparisonEdgesDf <- as.data.frame(comparisonEdges, stringsAsFactors = FALSE)

  #Subset the estimated/non estimated edges so we can style them differently
  estimated1EdgesEst <- as.list(estimated1EdgesDf[which(estimated1EdgesDf$newSet=='est'), ])
  estimated1EdgesStat <- as.list(estimated1EdgesDf[which(estimated1EdgesDf$newSet=='stat'), ])
  estimated2EdgesEst <- as.list(estimated2EdgesDf[which(estimated2EdgesDf$newSet=='est'), ])
  estimated2EdgesStat <- as.list(estimated2EdgesDf[which(estimated2EdgesDf$newSet=='stat'), ])
  estimated3EdgesEst <- as.list(estimated3EdgesDf[which(estimated3EdgesDf$newSet=='est'), ])
  estimated3EdgesStat <- as.list(estimated3EdgesDf[which(estimated3EdgesDf$newSet=='stat'), ])
  estimated4EdgesEst <- as.list(estimated4EdgesDf[which(estimated4EdgesDf$newSet=='est'), ])
  estimated4EdgesStat <- as.list(estimated4EdgesDf[which(estimated4EdgesDf$newSet=='stat'), ])
  comparisonEdgesEst <- as.list(comparisonEdgesDf[which(comparisonEdgesDf$newSet=='est'), ])
  comparisonEdgesStat <- as.list(comparisonEdgesDf[which(comparisonEdgesDf$newSet=='stat'), ])

  #Create Base Plot Object
  plot_object <- gsplot(yaxs = 'i') %>%
      grid(nx = 0, ny = NULL, equilogs = FALSE, lty = 3, col = "gray") %>%
      axis(1, at = plotDates, labels = format(plotDates, "%b\n%d"), padj = 0.5) %>%
      axis(2, reverse = invertedFlag, las=0) %>%
      view(xlim = c(startDate, endDate), log=ifelse(logAxis, 'y', ''))
    
  plot_object <-
    XAxisLabelStyle(plot_object, startDate, endDate, timezone, plotDates)

  #Plot Time Series
  plot_object <- plotTimeSeries(plot_object, stat1TimeSeries, 'stat1TimeSeries', timezone, getDVHydrographPlotConfig, list(yLabel=yLabel), excludeZeroNegativeFlag, isDV=TRUE)
  plot_object <- plotTimeSeries(plot_object, stat2TimeSeries, 'stat2TimeSeries', timezone, getDVHydrographPlotConfig, list(yLabel=yLabel), excludeZeroNegativeFlag, isDV=TRUE)
  plot_object <- plotTimeSeries(plot_object, stat3TimeSeries, 'stat3TimeSeries', timezone, getDVHydrographPlotConfig, list(yLabel=yLabel), excludeZeroNegativeFlag, isDV=TRUE)
  plot_object <- plotTimeSeries(plot_object, stat4TimeSeries, 'stat4TimeSeries', timezone, getDVHydrographPlotConfig, list(yLabel=yLabel), excludeZeroNegativeFlag, isDV=TRUE)
  plot_object <- plotTimeSeries(plot_object, stat1TimeSeriesEst, 'stat1TimeSeriesEst', timezone, getDVHydrographPlotConfig, list(yLabel=yLabel), excludeZeroNegativeFlag, isDV=TRUE)
  plot_object <- plotTimeSeries(plot_object, stat2TimeSeriesEst, 'stat2TimeSeriesEst', timezone, getDVHydrographPlotConfig, list(yLabel=yLabel), excludeZeroNegativeFlag, isDV=TRUE)
  plot_object <- plotTimeSeries(plot_object, stat3TimeSeriesEst, 'stat3TimeSeriesEst', timezone, getDVHydrographPlotConfig, list(yLabel=yLabel), excludeZeroNegativeFlag, isDV=TRUE)
  plot_object <- plotTimeSeries(plot_object, stat4TimeSeriesEst, 'stat4TimeSeriesEst', timezone, getDVHydrographPlotConfig, list(yLabel=yLabel), excludeZeroNegativeFlag, isDV=TRUE)
  plot_object <- plotTimeSeries(plot_object, comparisonTimeSeries, 'comparisonTimeSeries', timezone, getDVHydrographPlotConfig, list(yLabel=yLabel), excludeZeroNegativeFlag, isDV=TRUE)
  plot_object <- plotTimeSeries(plot_object, comparisonTimeSeriesEst, 'comparisonTimeSeriesEst', timezone, getDVHydrographPlotConfig, list(yLabel=yLabel), excludeZeroNegativeFlag, isDV=TRUE)
  
  #Plot Other Items
  plot_object <- plotItem(plot_object, estimated1EdgesEst, getDVHydrographPlotConfig, list(estimated1EdgesEst, 'estimated1EdgesEst'), isDV=TRUE)
  plot_object <- plotItem(plot_object, estimated1EdgesStat, getDVHydrographPlotConfig, list(estimated1EdgesStat, 'estimated1EdgesStat'), isDV=TRUE)
  plot_object <- plotItem(plot_object, estimated2EdgesEst, getDVHydrographPlotConfig, list(estimated2EdgesEst, 'estimated2EdgesEst'), isDV=TRUE)
  plot_object <- plotItem(plot_object, estimated2EdgesStat, getDVHydrographPlotConfig, list(estimated2EdgesStat, 'estimated2EdgesStat'), isDV=TRUE)
  plot_object <- plotItem(plot_object, estimated3EdgesEst, getDVHydrographPlotConfig, list(estimated3EdgesEst, 'estimated3EdgesEst'), isDV=TRUE)
  plot_object <- plotItem(plot_object, estimated3EdgesStat, getDVHydrographPlotConfig, list(estimated3EdgesStat, 'estimated3EdgesStat'), isDV=TRUE)
  plot_object <- plotItem(plot_object, estimated4EdgesEst, getDVHydrographPlotConfig, list(estimated4EdgesEst, 'estimated4EdgesEst'), isDV=TRUE)
  plot_object <- plotItem(plot_object, estimated4EdgesStat, getDVHydrographPlotConfig, list(estimated4EdgesStat, 'estimated4EdgesStat'), isDV=TRUE)
  plot_object <- plotItem(plot_object, comparisonEdgesEst, getDVHydrographPlotConfig, list(comparisonEdgesEst, 'comparisonEdgesEst'), isDV=TRUE)
  plot_object <- plotItem(plot_object, comparisonEdgesStat, getDVHydrographPlotConfig, list(comparisonEdgesStat, 'comparisonEdgesStat'), isDV=TRUE)
  plot_object <- plotItem(plot_object, groundWaterLevels, getDVHydrographPlotConfig, list(groundWaterLevels, 'groundWaterLevels'), isDV=TRUE)
  plot_object <- plotItem(plot_object, waterQualityData, getDVHydrographPlotConfig, list(waterQualityData, 'waterQualityData'), isDV=TRUE)
  plot_object <- plotItem(plot_object, minMaxPoints[['min_iv']], getDVHydrographPlotConfig, list(minMaxPoints[['min_iv']], 'min_iv', minMaxEst=minMaxEst[['min_iv']]), isDV=TRUE)
  plot_object <- plotItem(plot_object, minMaxPoints[['max_iv']], getDVHydrographPlotConfig, list(minMaxPoints[['max_iv']], 'max_iv', minMaxEst=minMaxEst[['max_iv']]), isDV=TRUE)
  
  #field visit measurements true or false splitting
  if(!isEmptyVar(fieldVisitMeasurements)){
    meas_Q_true <- fieldVisitMeasurements[which(fieldVisitMeasurements[['publish']]=='TRUE'),]
    meas_Q_false <- fieldVisitMeasurements[which(fieldVisitMeasurements[['publish']]=='FALSE'),]
    if(!isEmptyVar(meas_Q_true)) {
      plot_object <- plotItem(plot_object, meas_Q_true, getDVHydrographPlotConfig, list(meas_Q_true, 'fieldVisitMeasurementsTrue'), isDV=TRUE)
    }
    if(!isEmptyVar(meas_Q_false)) {
      plot_object <- plotItem(plot_object, meas_Q_false, getDVHydrographPlotConfig, list(meas_Q_false, 'fieldVisitMeasurementsFalse'), isDV=TRUE)
    }
  }
  
  
  

  # approval bar styles are applied last, because it makes it easier to align
  # them with the top of the x-axis line
  plot_object <- addToGsplot(plot_object, getApprovalBarConfig(approvals, ylim(plot_object, side = 2), logAxis))
  
  #Remove any duplicate legend items
  plot_object <- rmDuplicateLegendItems(plot_object)
  
  # custom gridlines below approval bar
  plot_object <- plot_object %>% 
    abline(v=seq(from=toStartOfDay(startDate), to=toStartOfDay(endDate), by="days"), lty=3, col="gray", where='first') %>%
    abline(v=seq(from=toStartOfDay(startDate), to=toStartOfDay(endDate), by="weeks"), col="darkgray", lwd=1, where='first')
  
  # Add space to the top of the Y Axis
  plot_object <- RescaleYTop(plot_object)
  
  #Add invalid GW Levels note
  if(!isEmptyOrBlank(fetchReportMetadataField(reportObject, 'gwlevelAllValid')) && fetchReportMetadataField(reportObject, 'gwlevelAllValid') == FALSE){
    plot_object <- mtext(plot_object, text = "Note: Water levels with improper date/time formats not plotted.", side=3, cex=0.85, line=1.2, adj=1, axes=FALSE)
  }

  #Add approval explanation label to the top of the plot
  plot_object <- mtext(plot_object, text = "Displayed approval level(s) are from the source TS that statistics are derived from.", side=3, cex=0.85, line=0.33, adj=1, axes=FALSE)

  #Legend
  initialOffset <- getDvHydrographStyles()[['primary_legend_offset']]
  plot_object <- plotDVHydroLegend(plot_object, startDate, endDate, timezone, initialOffset)

  #Add Min/Max lbaels if we aren't plotting the min and max 
  formattedLabels <- lapply(minMaxLabels, function(l) {formatMinMaxLabel(l, priorityTS[['unit']])})
  plot_object <- plotItem(plot_object, formattedLabels[['min_iv_label']], getDVHydrographPlotConfig, list(formattedLabels[['min_iv_label']], 'min_iv_label'), isDV=TRUE)
  plot_object <- plotItem(plot_object, formattedLabels[['max_iv_label']], getDVHydrographPlotConfig, list(formattedLabels[['max_iv_label']], 'max_iv_label', ylabel="", minMaxEst=FALSE, maxIvLabelOnTop=length(minMaxLabels) > 1), isDV=TRUE)

  return(plot_object)
}

#' Create DV Hdyrograph Reference Plot
#'
#' @description Given the full report object, a series field name, and
#' a series description field name, creates a DV Hydrograph Reference
#' plot using the specific parameters.
#' @param reportObject the full report JSON object
#' @param series the series field name to extract from the JSON
#' @param descriptions the description field name to extract from the JSON
createDVHydrographRefPlot <- function(reportObject, series, descriptions) {
  #Rendering Options
  options(scipen=8)

  #Get Necessary Report Metadata
  series_number <- switch(series,
    'firstReferenceTimeSeries' = '1',
    'secondReferenceTimeSeries' = '2',
    'thirdReferenceTimeSeries' = '3'
  )
  seriesEst <- paste0(series, 'Est', setp="")
  seriesEstEdges <- paste0(series, 'EstEdges', setp="")
  timezone <- fetchReportMetadataField(reportObject, 'timezone')
  excludeZeroNegativeFlag <- fetchReportMetadataField(reportObject, 'excludeZeroNegative')
  excludeMinMaxFlag <- fetchReportMetadataField(reportObject, 'excludeMinMax')
  invertedFlag <- fetchReportMetadataField(reportObject, 'isInverted')
  startDate <- flexibleTimeParse(fetchReportMetadataField(reportObject, 'startDate'), timezone=timezone)
  endDate <- toEndOfDay(flexibleTimeParse(fetchReportMetadataField(reportObject, 'endDate'), timezone=timezone))
  plotDates <- toStartOfDay(seq(startDate, endDate, by = 7 * 24 * 60 * 60))

  #Get Basic Plot Data
  referenceSeries <- parseTimeSeries(reportObject, series, descriptions, timezone, isDV=TRUE)
  referenceSeriesEst <- parseTimeSeries(reportObject, series, descriptions, timezone, estimated=TRUE, isDV=TRUE)

  #Validate Basic Plot Data
  if(all(isEmptyOrBlank(c(referenceSeries, referenceSeriesEst)))){
    return(NULL)
  }

  #Get Estimated / Non-Estimated Edges
  estEdges <- getEstimatedEdges(referenceSeries, referenceSeriesEst, excludeZeroNegativeFlag)

  #Get Additional Plot Data
  logAxis <- isLogged(referenceSeries[['points']], referenceSeries[['isVolumetricFlow']], excludeZeroNegativeFlag)
  yLabel <- paste0(referenceSeries[['type']], ", ", referenceSeries[['unit']])
  approvals <- readApprovalBar(referenceSeries, timezone, legend_nm=referenceSeries[['legend.name']], snapToDayBoundaries=TRUE)

  #Do Plotting
  plot_object <- gsplot(yaxs = 'i') %>%
    grid(nx = NA, ny = NULL, lty = 3, col = "gray") %>%
    axis(2, reverse = invertedFlag, las=0) %>%
    view(xlim = c(startDate, endDate), log=ifelse(logAxis, 'y', '')) %>%
    title(main = paste("\n\n", "Reference Time Series", series_number))
  
  plot_object <-
    XAxisLabelStyle(plot_object, startDate, endDate, timezone, plotDates)

  #Plot Time Series
  plot_object <- plotTimeSeries(plot_object, referenceSeries, series, timezone, getDVHydrographRefPlotConfig, list(yLabel=yLabel), excludeZeroNegativeFlag, isDV=TRUE)
  plot_object <- plotTimeSeries(plot_object, referenceSeriesEst, paste0(series, "Est"), timezone, getDVHydrographRefPlotConfig, list(yLabel=yLabel), excludeZeroNegativeFlag, isDV=TRUE)

  #Plot Other Items
  plot_object <- plotItem(plot_object, estEdges, getDVHydrographRefPlotConfig, list(estEdges, paste0(series, "EstEdges")))
  
  # approval bar styles are applied last, because it makes it easier to align
  # them with the top of the x-axis line
  plot_object <- addToGsplot(plot_object, getApprovalBarConfig(approvals, ylim(plot_object, side = 2), logAxis))
  
  #Remove any duplicate legend items
  plot_object <- rmDuplicateLegendItems(plot_object)
  
  # custom gridlines below approval bar
  plot_object <- plot_object %>% 
    abline(v=seq(from=startDate, to=endDate, by="days"), lty=3, col="gray", where='first') %>%
    abline(v=seq(from=startDate, to=endDate, by="weeks"), col="darkgray", lwd=1, where='first')
  
  # Add space to the top of the Y Axis
  plot_object <- RescaleYTop(plot_object)

  #Legend
  initialOffset <- getDvHydrographStyles()[['ref_legend_offset']]
  plot_object <- plotDVHydroLegend(plot_object, startDate, endDate, timezone, initialOffset)
  
  return(plot_object)
}

#' Get DV Hydrograph Plot Config
#'
#' @description Given an item to plot, fetch the associated
#' plot feature(s) and their styles. 
#' @param plotItem the item to fetch styles and plot features for
#' @param plotItemName the string to use for matching the configuration and styles
#' @param yLabel the string to use for the Y-Axis label for this object (if applicable) (Default: "")
#' @param maxIvLabelOnTop for the maximum IV point styling, set if label is aboe or below point (if applicable) (Default: FALSE)
#' @param minMaxEst Whether or not the min/max IV point is estimated
#' @param ... any additional parameters to pass into the function
getDVHydrographPlotConfig <- function(plotItem, plotItemName, yLabel="", minMaxEst=FALSE, maxIvLabelOnTop=FALSE, ...){
  styles <- getDvHydrographStyles()

  if(length(plotItem) > 1 || (!is.null(nrow(plotItem)) && nrow(plotItem) > 1)){
    x <- plotItem[['time']]
    y <- plotItem[['value']]
    legend.name <- nullMask(plotItem[['legend.name']])
  }
  
  args <- list(...)
  
  plotConfig <- switch(plotItemName, 
    stat1TimeSeries = list(
      lines = append(list(x=x, y=y, ylab=yLabel, legend.name=paste("Stat 1:", legend.name)), styles$stat1_lines)
    ),
    stat2TimeSeries = list(
      lines = append(list(x=x, y=y, ylab=yLabel, legend.name=paste("Stat 2:", legend.name)), styles$stat2_lines)
    ),
    stat3TimeSeries = list(
      lines = append(list(x=x, y=y, ylab=yLabel, legend.name=paste("Stat 3:", legend.name)), styles$stat3_lines)
    ),
    stat4TimeSeries = list(
      lines = append(list(x=x, y=y, ylab=yLabel, legend.name=paste("Stat 4:", legend.name)), styles$stat4_lines)
    ),
    comparisonTimeSeries = list(
      lines = append(list(x=x, y=y, ylab=yLabel, legend.name=legend.name), styles$comp_lines)
    ),
    stat1TimeSeriesEst = list(
      lines = append(list(x=x, y=y, ylab=yLabel, legend.name=paste("Estimated Stat 1:", legend.name)), styles$stat1e_lines)
    ),
    stat2TimeSeriesEst = list(
      lines = append(list(x=x, y=y, ylab=yLabel, legend.name=paste("Estimated Stat 2:", legend.name)), styles$stat2e_lines)
    ),
    stat3TimeSeriesEst = list(
      lines = append(list(x=x, y=y, ylab=yLabel, legend.name=paste("Estimated Stat 3:", legend.name)), styles$stat3e_lines)
    ),
    stat4TimeSeriesEst = list(
      lines = append(list(x=x, y=y, ylab=yLabel, legend.name=paste("Estimated Stat 4:", legend.name)), styles$stat4e_lines)
    ),
    comparisonTimeSeriesEst = list(
      lines = append(list(x=x, y=y, ylab=yLabel, legend.name=paste("Estimated", legend.name)), styles$compe_lines)
    ),
    estimated1EdgesEst = list(
      arrows = append(list(x0=plotItem[['time']], x1=plotItem[['time']], y0=plotItem[['y0']], y1=plotItem[['y1']]), styles$estimated1EdgesEst)
    ),
    estimated1EdgesStat = list(
      arrows = append(list(x0=plotItem[['time']], x1=plotItem[['time']], y0=plotItem[['y0']], y1=plotItem[['y1']]), styles$estimated1EdgesStat)
    ),
    estimated2EdgesEst = list(
      arrows = append(list(x0=plotItem[['time']], x1=plotItem[['time']], y0=plotItem[['y0']], y1=plotItem[['y1']]), styles$estimated2EdgesEst)
    ),
    estimated2EdgesStat = list(
      arrows = append(list(x0=plotItem[['time']], x1=plotItem[['time']], y0=plotItem[['y0']], y1=plotItem[['y1']]), styles$estimated2EdgesStat)
    ),
    estimated3EdgesEst = list(
      arrows = append(list(x0=plotItem[['time']], x1=plotItem[['time']], y0=plotItem[['y0']], y1=plotItem[['y1']]), styles$estimated3EdgesEst)
    ),
    estimated3EdgesStat = list(
      arrows = append(list(x0=plotItem[['time']], x1=plotItem[['time']], y0=plotItem[['y0']], y1=plotItem[['y1']]), styles$estimated3EdgesStat)
    ),
    estimated4EdgesEst = list(
      arrows = append(list(x0=plotItem[['time']], x1=plotItem[['time']], y0=plotItem[['y0']], y1=plotItem[['y1']]), styles$estimated4EdgesEst)
    ),
    estimated4EdgesStat = list(
      arrows = append(list(x0=plotItem[['time']], x1=plotItem[['time']], y0=plotItem[['y0']], y1=plotItem[['y1']]), styles$estimated4EdgesStat)
    ),
    comparisonEdgesEst = list(
      arrows = append(list(x0=plotItem[['time']], x1=plotItem[['time']], y0=plotItem[['y0']], y1=plotItem[['y1']]), styles$comparisonEdgesEst)
    ),
    comparisonEdgesStat = list(
      arrows = append(list(x0=plotItem[['time']], x1=plotItem[['time']], y0=plotItem[['y0']], y1=plotItem[['y1']]), styles$comparisonEdgesStat)
    ),
    fieldVisitMeasurementsTrue = list(
      points = append(list(x=x, y=y, legend.name="Measured Discharge, publish = true"), styles$meas_q_points_true),
      callouts = append(list(x=x, y=y, labels = plotItem[['n']]), styles$meas_q_callouts_true)
    ),
    fieldVisitMeasurementsFalse = list(
      points = append(list(x=x, y=y, legend.name="Measured Discharge, publish = false"), styles$meas_q_points_false),
      callouts = append(list(x=x, y=y, labels = plotItem[['n']]), styles$meas_q_callouts_false)
    ),
    groundWaterLevels = list(
      points = append(list(x=x, y=y, legend.name="Measured Water Level (GWSI)"), styles$gw_level_points)
    ),
    waterQualityData = list(
      points = append(list(x=x, y=y, legend.name="Measured Value (QWDATA)"), styles$wq_data_points)
    ),
    max_iv = list(
      points = append(list(x=x, y=y, legend.name=ifelse(minMaxEst, paste("(Estimated)", legend.name), legend.name), col=ifelse(minMaxEst, "red", "blue")), styles$max_iv_points)
    ),
    min_iv = list(
      points = append(list(x=x, y=y, legend.name=ifelse(minMaxEst, paste("(Estimated)", legend.name), legend.name), col=ifelse(minMaxEst, "red", "blue")), styles$min_iv_points)
    ),
    min_iv_label = list(
      mtext = append(list(ifelse(minMaxEst, paste("(Estimated)", plotItem), plotItem)), styles$bottom_iv_label)
    ),
    max_iv_label = list(
      mtext = append(list(ifelse(minMaxEst, paste("(Estimated)", plotItem), plotItem)), if(maxIvLabelOnTop) styles$top_iv_label else styles$bottom_iv_label)
    ),
    stop(paste("Plotting configuration could not be found within DVHydrograph for element:", names(plotItem)))
  )
  
  return(plotConfig)
}

#' Get DV Hydrograph Reference Plot Config
#'
#' @description Given an item to plot, fetch the associated
#' plot feature(s) and their styles. 
#' @param plotItem the item to fetch styles and plot features for
#' @param plotItemName the string to use for matching the configuration and styles
#' @param yLabel the string to use for the Y-Axis label for this object (if applicable) (Default: "")
#' @param ... any additional parameters to pass into the function
getDVHydrographRefPlotConfig <- function(plotItem, plotItemName, yLabel, ...){
  styles <- getDvHydrographStyles()

  x <- plotItem[['time']]
  y <- plotItem[['value']]
  
  legend.name <- nullMask(plotItem[['legend.name']])
  
  args <- list(...)

  plotConfig <- switch(plotItemName, 
    firstReferenceTimeSeries = list(
      lines = append(list(x=x, y=y, ylab=args$yLabel, legend.name=paste("Reference 1:", legend.name)), styles$sref_lines)
    ),
    secondReferenceTimeSeries = list(
      lines = append(list(x=x, y=y, ylab=args$yLabel, legend.name=paste("Reference 2:", legend.name)), styles$tref_lines)
    ),
    thirdReferenceTimeSeries = list(
      lines = append(list(x=x, y=y, ylab=args$yLabel, legend.name=paste("Reference 3:", legend.name)), styles$qref_lines)
    ),
    firstReferenceTimeSeriesEst = list(
      lines = append(list(x=x, y=y, ylab=args$yLabel, legend.name=paste("Est. Reference 1:", legend.name)), styles$srefe_lines)
    ),
    secondReferenceTimeSeriesEst = list(
      lines = append(list(x=x, y=y, ylab=args$yLabel, legend.name=paste("Est. Reference 2:", legend.name)), styles$trefe_lines)
    ),
    thirdReferenceTimeSeriesEst = list(
      lines = append(list(x=x, y=y, ylab=args$yLabel, legend.name=paste("Est. Reference 3:", legend.name)), styles$qrefe_lines)
    ),
    firstReferenceTimeSeriesEstEdges = list(
      arrows = append(list(x0=plotItem$time, x1=plotItem$time, y0=plotItem$y0, y1=plotItem$y1,
                           lty=ifelse(plotItem$newSet == "est", 1, 2), col=ifelse(plotItem$newSet == "est", "blue", "red1")),
                      styles$est_lines)
    ),
    secondReferenceTimeSeriesEstEdges = list(
      arrows = append(list(x0=plotItem$time, x1=plotItem$time, y0=plotItem$y0, y1=plotItem$y1,
                           lty=ifelse(plotItem$newSet == "est", 1, 3), col=ifelse(plotItem$newSet == "est", "orange", "red2")),
                      styles$est_lines)
    ),
    thirdReferenceTimeSeriesEstEdges = list(
      arrows = append(list(x0=plotItem$time, x1=plotItem$time, y0=plotItem$y0, y1=plotItem$y1, 
                           lty=ifelse(plotItem$newSet == "est", 1, 6), col=ifelse(plotItem$newSet == "est", "maroon", "red3")),
                      styles$est_lines)
    )
  )

  return(plotConfig)
}

#' Plot DV Hydro Legend
#'
#' @description Given the plot object and additional necessary parameters, calculates the
#' legend offset and then adds the legend to the plot.
#' @param plot_object The gsplot object to add the legend to
#' @param startDate The start date of the report
#' @param endDate The end date of the report
#' @param timezone The timezone of the report
#' @param initialOffset The initial amount to offset the legend by
#' @param modOffset [Default: 1] An optional amount to multiply the final calculated offset by
#' @return gsplot object with legend added
#' @importFrom lubridate years
plotDVHydroLegend <- function(plot_object, startDate, endDate, timezone, initialOffset, modOffset=1){
  legend_items <- plot_object$legend$legend.auto$legend
  ncol <- ifelse(length(legend_items) > 3, 2, 1)
  
  #Legend offset needs to be calculated based on the number of lines and columns to be consistent in position
  leg_lines <- ifelse(ncol==2, ceiling((length(legend_items) - 6)/2), length(legend_items))
  legend_offset <- ifelse(ncol==2, initialOffset+(0.025*leg_lines), initialOffset/2+(0.025*leg_lines))
  legend_offset <- legend_offset * modOffset

  #Add space to legend so that it doesn't overlap with dates.
  legend_offset <- legend_offset + 0.08

  #Add Legend to the plot
  plot_object <- legend(plot_object, location="below", cex=0.8, legend_offset=legend_offset, y.intersp=1.5, ncol=ncol)

  return(plot_object)
}
USGS-R/repgen documentation built on April 14, 2021, 2:47 p.m.