Skip to content

Commit

Permalink
Merge pull request #93 from ldecicco-USGS/master
Browse files Browse the repository at this point in the history 
makeAnnualSeries update
  • Loading branch information
@ldecicco-USGS
ldecicco-USGS authored Jul 26, 2016
2 parents c19c23d + 1782a2a commit 0a44aa9
Show file tree
Hide file tree
Showing 4 changed files with 105 additions and 64 deletions.
74 changes: 34 additions & 40 deletions R/makeAnnualSeries.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,9 +30,8 @@ makeAnnualSeries<-function(eList, edgeAdjust = TRUE) {

localINFO <- getInfo(eList)
localDaily <- getDaily(eList)

if (sum(c("paStart", "paLong", "window") %in% names(localINFO)) ==
3) {
3) {
paLong <- localINFO$paLong
paStart <- localINFO$paStart
window <- localINFO$window
Expand All @@ -41,11 +40,9 @@ makeAnnualSeries<-function(eList, edgeAdjust = TRUE) {
paStart <- 10
window <- 20
}

if("edgeAdjust" %in% names(localINFO)){
if ("edgeAdjust" %in% names(localINFO)) {
edgeAdjust <- localINFO$edgeAdjust
}

numDays <- length(localDaily$DecYear)
yearFirst <- trunc(localDaily$DecYear[1])
yearLast <- trunc(localDaily$DecYear[numDays])
Expand All @@ -58,73 +55,70 @@ makeAnnualSeries<-function(eList, edgeAdjust = TRUE) {
Starts <- seq(paStartLow, monthSeqLast, 12)
Ends <- Starts + paLong - 1
startEndSeq <- data.frame(Starts, Ends)
startEndSeq <- subset(startEndSeq, (Ends >= monthSeqFirst) & (Starts <= monthSeqLast))
startEndSeq <- subset(startEndSeq, (Ends >= monthSeqFirst) &
(Starts <= monthSeqLast))
numYSeq <- length(startEndSeq$Ends)

for (i in 1:numYSeq) {
startSeq <- startEndSeq$Starts[i]
endSeq <- startEndSeq$Ends[i]
yearDaily <- localDaily[localDaily$MonthSeq >= startSeq & (localDaily$MonthSeq <= endSeq),]

yearDaily <- localDaily[localDaily$MonthSeq >= startSeq &
(localDaily$MonthSeq <= endSeq), ]
goodDay <- length(yearDaily$Q) - sum(is.na(yearDaily$Q))

if (goodDay > 26 * paLong){
annualSeries[1, 1:3, i] <- mean(yearDaily$DecYear,na.rm = TRUE)
annualSeries[2, 1, i] <- min(yearDaily$Q, na.rm = TRUE)
annualSeries[2, 2, i] <- min(yearDaily$Q7, na.rm = TRUE)
annualSeries[2, 3, i] <- min(yearDaily$Q30, na.rm = TRUE)
if (goodDay > 26 * paLong) {
annualSeries[1, 1:3, i] <- mean(yearDaily$DecYear,
na.rm = TRUE)
annualSeries[2, 1, i] <- min(yearDaily$Q, na.rm = TRUE)
annualSeries[2, 2, i] <- min(yearDaily$Q7, na.rm = TRUE)
annualSeries[2, 3, i] <- min(yearDaily$Q30, na.rm = TRUE)
}

}
Starts <- seq(paStart, monthSeqLast, 12)
Ends <- Starts + paLong - 1
startEndSeq <- data.frame(Starts, Ends)
startEndSeq <- subset(startEndSeq, (Ends >= monthSeqFirst) & (Starts <= monthSeqLast))
startEndSeq <- subset(startEndSeq, (Ends >= monthSeqFirst) &
(Starts <= monthSeqLast))
numYSeq <- length(startEndSeq$Ends)
for (i in 1:numYSeq) {
startSeq <- startEndSeq$Starts[i]
endSeq <- startEndSeq$Ends[i]
yearDaily <- localDaily[localDaily$MonthSeq >= startSeq & (localDaily$MonthSeq <= endSeq),]

yearDaily <- localDaily[localDaily$MonthSeq >= startSeq &
(localDaily$MonthSeq <= endSeq), ]
goodDay <- length(yearDaily$Q) - sum(is.na(yearDaily$Q))

if(goodDay > 26 * paLong){
annualSeries[1, 4:8, i] <- mean(yearDaily$DecYear, na.rm = TRUE)
if (goodDay > 26 * paLong) {
annualSeries[1, 4:8, i] <- mean(yearDaily$DecYear,
na.rm = TRUE)
annualSeries[2, 4, i] <- median(yearDaily$Q, na.rm = TRUE)
annualSeries[2, 5, i] <- mean(yearDaily$Q, na.rm = TRUE)
annualSeries[2, 6, i] <- max(yearDaily$Q30, na.rm = TRUE)
annualSeries[2, 7, i] <- max(yearDaily$Q7, na.rm = TRUE)
annualSeries[2, 8, i] <- max(yearDaily$Q, na.rm = TRUE)
annualSeries[2, 8, i] <- max(yearDaily$Q, na.rm = TRUE)
}
}
for (istat in 1:8) {
x <- annualSeries[1, istat, ]
y <- log(annualSeries[2, istat, ])
originalYear <- x
numYear <- length(x)
xy <- data.frame(x, y)
baseYear <- trunc(x[1])
numYears <- length(x)
xVec <- seq(1,numYears)
xy <- data.frame(x,y,xVec)
xy <- na.omit(xy)
numXY <- length(xy$x)
goodYears <- length(xy$x)
x <- xy$x
newYear <- x
numNewYear <- length(newYear)
x1 <- newYear[1]
xn <- newYear[numNewYear]
orYear <- originalYear[1:numNewYear]
diff <- newYear - orYear
meanDiff <- mean(diff, na.rm = TRUE)
offset <- round(meanDiff)
for (i in 1:numXY) {
x1 <- x[1]
xn <- x[goodYears]
for (i in 1:goodYears) {
xi <- x[i]
distToEdge <- min((xi - x1),(xn - xi))
distToEdge <- min((xi - x1), (xn - xi))
close <- (distToEdge < window)
thisWindow <- if(edgeAdjust & close) (2*window) - distToEdge else window
thisWindow <- if (edgeAdjust & close)
(2 * window) - distToEdge
else window
w <- triCube(x - xi, thisWindow)
mod <- lm(xy$y ~ x, weights = w)
new <- data.frame(x = x[i])
z <- exp(predict(mod, new))
ioffset <- i + offset
annualSeries[3, istat, ioffset] <- z
iYear <- xy$xVec[i]
annualSeries[3, istat, iYear] <- z
}
}
return(annualSeries)
Expand Down
25 changes: 20 additions & 5 deletions R/readNWISDaily.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,12 +53,27 @@ readNWISDaily <- function (siteNumber,parameterCd="00060",
if(nrow(data)>0){
names(data) <- c('agency', 'site', 'dateTime', 'value', 'code')
data$dateTime <- as.Date(data$dateTime)
#####################################
qConvert <- ifelse("00060" == parameterCd, 35.314667, 1)
qConvert<- ifelse(convert,qConvert,1)

localDaily <- populateDaily(data,qConvert,interactive=interactive)
} else {
localDaily <- data.frame(Date=as.Date(character()),
Q=numeric(),
Julian=numeric(),
Month=numeric(),
Day=numeric(),
DecYear=numeric(),
MonthSeq=numeric(),
Qualifier=character(),
i=integer(),
LogQ=numeric(),
Q7=numeric(),
Q30=numeric(),
stringsAsFactors=FALSE)
}

#####################################
qConvert <- ifelse("00060" == parameterCd, 35.314667, 1)
qConvert<- ifelse(convert,qConvert,1)

localDaily <- populateDaily(data,qConvert,interactive=interactive)

return (localDaily)
}
29 changes: 23 additions & 6 deletions R/readNWISSample.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,12 +42,29 @@
readNWISSample <- function(siteNumber,parameterCd,startDate="",endDate="",interactive=TRUE){

rawSample <- dataRetrieval::readNWISqw(siteNumber,parameterCd,startDate,endDate, expanded=FALSE)
dataColumns <- grep("p\\d{5}",names(rawSample))
remarkColumns <- grep("r\\d{5}",names(rawSample))
totalColumns <-c(grep("sample_dt",names(rawSample)), dataColumns, remarkColumns)
totalColumns <- totalColumns[order(totalColumns)]
compressedData <- compressData(rawSample[,totalColumns], interactive=interactive)
Sample <- populateSampleColumns(compressedData)
if(nrow(rawSample) > 0){
dataColumns <- grep("p\\d{5}",names(rawSample))
remarkColumns <- grep("r\\d{5}",names(rawSample))
totalColumns <-c(grep("sample_dt",names(rawSample)), dataColumns, remarkColumns)
totalColumns <- totalColumns[order(totalColumns)]
compressedData <- compressData(rawSample[,totalColumns], interactive=interactive)
Sample <- populateSampleColumns(compressedData)
} else {
Sample <- data.frame(Date=as.Date(character()),
ConcLow=numeric(),
ConcHigh=numeric(),
Uncen=numeric(),
ConcAve=numeric(),
Julian=numeric(),
Month=numeric(),
Day=numeric(),
DecYear=numeric(),
MonthSeq=numeric(),
SinDY=numeric(),
CosDY=numeric(),
stringsAsFactors=FALSE)
}

return(Sample)
}

Expand Down
41 changes: 28 additions & 13 deletions R/readWQPSample.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,21 +40,36 @@ readWQPSample <- function(siteNumber,characteristicName,startDate,endDate,intera

url <- constructWQPURL(siteNumber,characteristicName,startDate,endDate)
retval <- importWQP(url)

#Check for pcode:
if(all(nchar(characteristicName) == 5)){
suppressWarnings(pCodeLogic <- all(!is.na(as.numeric(characteristicName))))
} else {
pCodeLogic <- FALSE
}

if(nrow(retval) > 0){
data <- processQWData(retval,pCodeLogic)
#Check for pcode:
if(all(nchar(characteristicName) == 5)){
suppressWarnings(pCodeLogic <- all(!is.na(as.numeric(characteristicName))))
} else {
pCodeLogic <- FALSE
}

if(nrow(retval) > 0){
data <- processQWData(retval,pCodeLogic)
} else {
data <- NULL
}

compressedData <- compressData(data, interactive=interactive)
Sample <- populateSampleColumns(compressedData)
} else {
data <- NULL
Sample <- data.frame(Date=as.Date(character()),
ConcLow=numeric(),
ConcHigh=numeric(),
Uncen=numeric(),
ConcAve=numeric(),
Julian=numeric(),
Month=numeric(),
Day=numeric(),
DecYear=numeric(),
MonthSeq=numeric(),
SinDY=numeric(),
CosDY=numeric(),
stringsAsFactors=FALSE)
}

compressedData <- compressData(data, interactive=interactive)
Sample <- populateSampleColumns(compressedData)
return(Sample)
}

0 comments on commit 0a44aa9

Please sign in to comment.