R/main.R

In steckowski/rippl:

library(hydts)
library(ggplot2)

data("us.runoff")
plot(us.runoff)


plotWwp <- function(x, qmin) {
  ggplot(x) + geom_line()

}

x <- window(us.runoff$Columbia_River_at_the_Dalles,1950,1960)
qmean <- mean(x)
x <- x * 3600 * 24
qmin <- qmean * 3600 * 24 *0.9
period <- 365*4*24*3600
plotRipplDiagram(x,qmin,period)

plotRipplDiagram <- function(x,qmin,period) {

  #mindate <- "1950-01-01"
  #maxdate <- "1952-01-01"

  slope <- qmin/(24*3600)
  intercept <- -slope*(as.numeric(firstdate(x)))
  #intercept2 <- intercept - startvolume
  x.cumsum <- cumsum(x)
  x.cumsum.sp <- window(x.cumsum,firstdate(x),firstdate(x)+period)
  # x.df <- hydts::as.data.frame(x)
  x.cumsum.sp.df <- hydts::as.data.frame(x.cumsum.sp)
  x.cumsum.sp.df$yield <- as.numeric(x.cumsum.sp.df$Date)*slope + intercept
  dx <- min(x.cumsum.sp.df$yield-x.cumsum.sp.df[[2]])
  dxDate <- x.cumsum.sp.df$Date[which.min(x.cumsum.sp.df$yield-x.cumsum.sp.df[[2]])]

  x.cumsum.df <- hydts::as.data.frame(x.cumsum)
  x.cumsum.df$upperbound <- as.numeric(x.cumsum.df$Date)*slope + intercept - dx
  x.cumsum.df$upperbound[x.cumsum.df$Date < dxDate] <- NA
  dxDate2 <- x.cumsum.df$Date[which(x.cumsum.df$upperbound<x.cumsum.df[[2]])[1]]
  x.cumsum.df$upperbound[x.cumsum.df$Date > dxDate2] <- NA

  critPeriod <- dxDate2 - dxDate


  x.crit <- window(x.cumsum,as.POSIXct(dxDate),as.POSIXct(dxDate)+critPeriod)
  x.crit.df <- hydts::as.data.frame(x.crit)
  x.crit.df$yield <- as.numeric(x.crit.df$Date)*slope + intercept
  dx2 <- max(x.crit.df$yield-x.crit.df[[2]])



  #x.cumsum.sp.df$yield1 <- x.cumsum.sp.df$yield-dx
  #x.cumsum.sp.df$yield2 <- x.cumsum.sp.df$yield-dx2




  x.cumsum.df$lowerbound <- as.numeric(x.cumsum.df$Date)*slope + intercept - dx2
  x.cumsum.df$lowerbound[x.cumsum.df$Date < dxDate] <- NA
  x.cumsum.df$lowerbound[x.cumsum.df$Date > dxDate2] <- NA


  #x.melt <- reshape::melt(x.df,id.vars = "Date")
  x.cumsum.melt <- reshape::melt(x.cumsum.df,id.vars = "Date")
  ggplot(x.cumsum.melt) +
    geom_line(aes(x=Date, y=value,linetype=variable),colour="black") +
    scale_linetype_manual(values=c("solid","twodash", "twodash"))
}


#meanvals <- aggregate(x.melt$value, list(x.melt$variable), mean)$x

#mindate <- "1950-01-01"
#maxdate <- "1952-01-01"
#qmin <- 6000 * 3600 * 24
#startvolume <- 100000000000

#slope <- qmin/(24*3600)
#intercept <- -slope*(as.numeric(as.POSIXct(mindate)))
#intercept2 <- intercept - startvolume



ggplot(x.cumsum.melt) +
  geom_line(aes(x=Date, y=value,colour=variable))
#geom_abline(intercept=intercept, slope = slope) +
#geom_abline(intercept=intercept2, slope = slope)


ggplot(x.melt) +
  geom_line(aes(x=Date, y=value)) +
  geom_hline(yintercept = meanvals)
x$Columbia_River_at_the_Dalles