#' RMevents.plotQ
#'
#' Function to graph rainfall and flow for a given x-day window around
#' specified event periods
#'
#' @param df dataframe with unit value rainfall data
#' @param dfQ dataframe with unit value Q data
#' @param date string Date column in df as POSIXct
#' @param Qdate string Date column in dfQ as POSIXct
#' @param rain string Column in df with instantaneous rain values
#' @param Q string Column in dfQ with instantaneous Q values
#' @param df.events dataframe with start and end dates/times for events
#' @param sdate string Start date column in df.events rain file as POSIXct
#' @param edate string End date column in df.events as POSIXct
#' @param erain string Event rainfall depth column in df.events
#' @param plot.buffer numeric Used to define plotting window in days. Graphs
#' will include
# data Time period preceding beginning of event for including in the graphs
#' @param logy string "y" if log y-axis for Q or "" if linear axis. Will default
#' to "".
# if not specific or if minimum Q <= 0.
#' @param site.name site name as data type character
#' @param SampleInfo if TRUE then sample start and end dates/times are plotted
#' on the hydrograph;
#' if FALSE then sample start and end dates/times are not plotted on the
#' hydrograph.
#' @param sampbdate character column name in df.events for the beginning of the
#' sampling period
#' @param sampedate character column name in df.events for the ending of the
#' sampling period
#' @export
#' @return plots of rainfall events and discharge
#' @examples
#' #Example 1 - Rainfall/Q plots without sample start/end arrows
#' RDB <- CedarRRain
#' dfQ <- cedarq
#' dfQ <- RMprep(dfQ,prep.type=1,date.type=3,tz="CST6CDT")
#' RDB2 <- RMprep(RDB,prep.type=1,date.type=1,dates.in="CST.Time",tz="CST6CDT")
#' RDB3 <- subset(RDB2,
#' upload.ph3_site_basin_cedar_creek.Id.0....Geographical.Mean.kg.m.2.>-1)
#' event.list <- RMevents(df=RDB3,ieHr=6,rainthresh=0.2,
#' rain="upload.ph3_site_basin_cedar_creek.Id.0....Geographical.Mean.kg.m.2.")
#' events.0.2 <- event.list$storms2
#' site.name <- "Example Site"
#' SampleInfo <- FALSE
#'
#' RMevents.plotQ(RDB3,dfQ,
#' rain="upload.ph3_site_basin_cedar_creek.Id.0....Geographical.Mean.kg.m.2.",
#' df.events=events.0.2,erain="rain",
#' site.name=site.name,SampleInfo=SampleInfo)
#'
#' #Example 2- Rainfall/Q plots with sample start/end arrows
#' RDB <- CedarRRain
#' cedarSamples <- cedarSamples
#' names(RDB)[2] <- "UVRain"
#' RDB2 <- RMprep(RDB,
#' prep.type=1,
#' date.type=1,
#' dates.in="CST.Time",
#' tz="CST6CDT")
#' eventListSamples <- RMevents_sample(df=RDB2,
#' ieHr=6,
#' rain="UVRain",
#' time="pdate",
#' dfsamples=cedarSamples,
#' bdate="pSstart",edate="pSend")
#' dfQ <- cedarq
#' dfQ <- RMprep(dfQ,prep.type=1,date.type=3,tz="CST6CDT")
#' site.name <- "Example Site"
#' SampleInfo <- TRUE
#' sampbdate <- "pSstart"
#' sampedate <- "pSend"
#' #RMevents.plotQ(RDB2,
#' # dfQ,
#' # rain="UVRain",
#' # df.events=eventListSamples,
#' # sdate="Braindate",
#' # edate="Eraindate",
#' # erain="depth",logy="",site.name=site.name,
#' # sampbdate="pSstart",sampedate="pSend")
RMevents.plotQ <- function(df,dfQ,date="pdate",Qdate="pdate",rain = "rain",Q="Q",
df.events,sdate="StartDate",edate="EndDate", erain="depth",
plot.buffer=3,logy="",site.name="",SampleInfo, sampbdate='', sampedate='') {
df.events[,sdate] <- as.POSIXct(df.events[,sdate])
df.events[,edate] <- as.POSIXct(df.events[,edate])
df <- rbind(df[1,],subset(df[-1,],rain>0.0))
# pdf(paste(site.name,"_events.pdf",sep=""))
# Define plot layout: panel 1 for Q and panel 2 for FIB
mylayout <- matrix(c(1,
1,
2,
2,
2),5,1,byrow=TRUE)
graphics::layout(mylayout)
main.title <- paste(site.name,"Precipitation and Q Event")
for (i in 1:(nrow(df.events))) {
########################## Graph Precip ###########################################
p.sdate <- as.POSIXct(df.events[i,sdate] - plot.buffer*24*3600/2,tz="")
p.edate <- as.POSIXct(df.events[i,edate] + plot.buffer*24*3600/2,tz="")
subdf <- subset(df, df[,date]>=p.sdate & df[,date]<=p.edate)
subdf1 <- subdf[order(subdf[,date]),]
rmax <- max(subdf[,rain] + 0.3)
subrain <- subdf1[,rain]
subdate <- as.POSIXct(subdf1[,date])
#Set Margins for first plot
graphics::par(mar= c(0, 4, 4, 2) + 0.1)
plot(subrain~subdate,
# data=subdf,
type="h",
xaxt="n",
ylab="precipitation (mm)",
xlab="",
col="blue",
lwd=1,
yaxs="i",
ylim=c(rmax,0),
xlim=c(p.sdate,p.edate),
main = "")
graphics::mtext(main.title,side=3,line=2,cex=1.5)
graphics::mtext(paste("Event depth =",
round(df.events[i,erain],2),"mm"),
side=3,line=0.5,col= grDevices::colors()[84])
graphics::arrows(df.events[i,sdate],(rmax-0.15),
df.events[i,edate],(rmax-0.15),
length=0.07,angle=20,col= grDevices::colors()[84],
code=3)
########################## Graph Q ################################################
subdfQ <- subset(dfQ, dfQ[,Qdate]>=p.sdate & dfQ[,Qdate]<=p.edate)
subdfQ1 <- subdfQ[order(subdfQ[,Qdate]),]
Qmax <- max(subdfQ[,Q] *1.05)
if(Qmax < 0) {Qmax <- Qmax*0.95}
if(Qmax > 0) {Qmax <- Qmax*1.05}
Qmin <- min(c(subdfQ[,Q]))
if(Qmin <= 0) {Qmin <- Qmin*1.05; logy <- ""}
if(Qmin > 0) {Qmin <- Qmin*0.95; logy <- logy}
subQ <- subdfQ1[,Q]
subdateQ <- as.POSIXct(subdfQ1[,date])
#Set Margins for second plot
graphics::par(mar= c(5, 4, 0, 2) + 0.1)
plot(subQ~subdateQ,
# data=subdf,
type="l",
xaxt="n",
ylab="Flow (cfs)",
xlab="",
col="red",
lwd=1,
yaxs="i",
log=logy,
ylim=c(Qmin,Qmax),
xlim=c(p.sdate,p.edate),
main = "")
r <- as.POSIXct(trunc(range(subdf[,date]), "days"))
r[2] <- r[2]+24*3600
rhour <- seq(r[1], r[2], by=24*3600/4)
rday <- seq(r[1], r[2], by="days")
graphics::axis.POSIXct(1,subdf[,date],at=rhour,format=" ",tcl=-0.2)
graphics::axis.POSIXct(1,subdf[,date],at=rday,format=" ",tcl=-0.5)
graphics::axis.POSIXct(3,subdf[,date],at=rhour,format=" ",tcl=0.2)
graphics::axis.POSIXct(3,subdf[,date],at=rday,format=" ",tcl=0.5)
graphics::axis.POSIXct(1,subdf[,date],format = "%m/%d/%y")
# timeline <-
graphics::abline(v=p.sdate,lty=3,col= grDevices::colors()[100])
graphics::abline(v=p.edate,lty=3,col= grDevices::colors()[100])
if(SampleInfo){
graphics::arrows(df.events[i,sampbdate],(max(subdfQ[,Q])),
df.events[i,sampedate],(max(subdfQ[,Q])),
length=0.07,angle=20,col = grDevices::colors()[84],
code=3)}
# abline(v=df.events[i,sdate])
# abline(v=df.events[i,edate])
# axis.POSIXct(3,subdf$date,format = "%m/%d/%y",
# at=c(df.events[i,sdate],df.events[i,edate]),
# tcl=2)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.