R/makePeakMatrix.R

In MGBT: Multiple Grubbs-Beck Low-Outlier Test

"makePeakMatrix" <-
function(x, lo=0, hi=NA, eps=sqrt(.Machine$double.eps), wypad=FALSE) {

  if(! exists("anyCodes", as.list(x))) x <- splitPeakCodes( x )
  x$peak_va <- as.numeric(x$peak_va) # just in case--expectation is that
  # readNWISpeak is called with convertType=FALSE to more seamless deal with dates
  x <- x[x$appearsSystematic,]

  if(! exists("water_yr", as.list(x))) x <- makeWaterYear(  x )

     n <- nrow(x)
  if(n == 0) return(NULL)

  zvl <- zvr <- rep(NA, n) # initialize the lower and upper limits for flows

        wnt  <- as.logical( x$isCode4 ) # less than data flag
    zvr[wnt] <- x$peak_va[wnt]
  if(is.na(hi)) {
    zvl[wnt] <- pmin(0, min(x$peak_va, na.rm=TRUE) - eps) # protection from negatives
  } else {
    zvl[wnt] <- lo
  }

        wnt  <- as.logical( x$isCode8 ) # greater than data flag
    zvl[wnt] <- x$peak_va[wnt]
  if(is.na(hi)) {
    zvr[wnt] <- max(x$peak_va, na.rm=TRUE) + eps
  } else {
    zvr[wnt] <- hi
  }

  if(wypad) {
    zmat <- cbind(rep(NA, n), rep(NA, n), zvl, zvr)
  } else {
    zmat <- cbind(zvl, zvr)
  }
  row.names(zmat) <- x$water_yr
  return(zmat)
}