Skip to content

Commit

Permalink
Merge pull request #359 from thongsav-usgs/master
Browse files Browse the repository at this point in the history 
Changes and improvements spawned from the update of DV date formats.
  • Loading branch information
Lindsay Carr authored Jun 24, 2016
2 parents 193815e + 51558d5 commit 105d1a0
Show file tree
Hide file tree
Showing 28 changed files with 479,627 additions and 743,655 deletions.
10 changes: 5 additions & 5 deletions R/dvhydrograph-data.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ parseDVData <- function(data){
min_iv <- getMaxMinIv(data, 'MIN')

approvals <- getApprovals(data, chain_nm="firstDownChain", legend_nm=data[['reportMetadata']][["downChainDescriptions1"]],
appr_var_all=c("appr_approved", "appr_inreview", "appr_working"), plot_type="dvhydro")
appr_var_all=c("appr_approved", "appr_inreview", "appr_working"), isDV=TRUE)

if ("fieldVisitMeasurements" %in% names(data)) {
meas_Q <- getFieldVisitMeasurementsQPoints(data)
Expand Down Expand Up @@ -42,7 +42,7 @@ parseRefData <- function(data, series) {

ref_name <- paste0(series, "ReferenceTimeSeries")

ref_data <- list(time = formatDates(data[[ref_name]]$points$time),
ref_data <- list(time = formatDates(data[[ref_name]]$points$time, isDV=TRUE),
value = data[[ref_name]]$points$value,
legend.name = data$reportMetadata[[legend_name]])

Expand All @@ -57,7 +57,7 @@ parseRefData <- function(data, series) {

# add in approval lines from primary plot
approvals <- getApprovals(data, chain_nm=ref_name, legend_nm=data[['reportMetadata']][[legend_name]],
appr_var_all=c("appr_approved", "appr_inreview", "appr_working"), plot_type="dvhydro")
appr_var_all=c("appr_approved", "appr_inreview", "appr_working"), isDV=TRUE)

allVars <- as.list(environment())
allVars <- append(approvals, allVars)
Expand Down Expand Up @@ -95,14 +95,14 @@ parseDVSupplemental <- function(data, parsedData){

getMaxMinIv <- function(data, stat){
stat_vals <- data[['maxMinData']][[1]][[1]][['theseTimeSeriesPoints']][[stat]]
list(time = formatDates(stat_vals[['time']][1]),
list(time = formatDates(stat_vals[['time']][1], isDV=TRUE),
value = stat_vals[['value']][1])
}

getStatDerived <- function(data, chain_nm, legend_nm, estimated){

points <- data[[chain_nm]][['points']]
points$time <- formatDates(points[['time']])
points$time <- formatDates(points[['time']], isDV=TRUE)

date_index <- getEstimatedDates(data, chain_nm, points$time)

Expand Down
22 changes: 14 additions & 8 deletions R/extremes-data.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,14 +53,20 @@ extremesTable <- function(rawData){
dateTime[,1] <- strftime(dateTime[,1], "%m-%d-%Y")

#Break apart, format dates/times, put back together.
timeFormatting <- sapply(dateTime[,2], function(s) {
m <- regexec("([^-+]+)([+-].*)", s)
splitTime <- unlist(regmatches(s, m))[2:3]
return(splitTime)
})
timeFormatting[1,] <- sapply(timeFormatting[1,], function(s) sub(".000","",s))
timeFormatting[2,] <- paste0(" (UTC ",timeFormatting[2,], ")")
timeFormatting <- paste(timeFormatting[1,],timeFormatting[2,])
if(ncol(dateTime) > 1) {
timeFormatting <- sapply(dateTime[,2], function(s) {
m <- regexec("([^-+]+)([+-].*)", s)
splitTime <- unlist(regmatches(s, m))[2:3]
return(splitTime)
})
timeFormatting[1,] <- sapply(timeFormatting[1,], function(s) sub(".000","",s))
timeFormatting[2,] <- paste0(" (UTC ",timeFormatting[2,], ")")
timeFormatting <- paste(timeFormatting[1,],timeFormatting[2,])
} else {
timeFormatting <- sapply(dateTime[,1], function(s) {
return("")
})
}

if(any(names(x) == "relatedPrimary")) {

Expand Down
10 changes: 5 additions & 5 deletions R/fiveyeargwsum-data.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@ parseFiveYrData <- function(data){
min_iv <- getMaxMinIv_fiveyr(data, 'MIN')

approvals <- getApprovals(data, chain_nm=stat_info$data_nm, legend_nm=data[['reportMetadata']][[stat_info$descr_nm]],
appr_var_all=c("appr_approved", "appr_inreview", "appr_working"), plot_type="fiveyr")
appr_var_all=c("appr_approved", "appr_inreview", "appr_working"), isDV=TRUE)

gw_level <- getGroundWaterLevels(data)

Expand All @@ -36,8 +36,8 @@ parseFiveYrSupplemental <- function(data, parsedData){

horizontalGrid <- signif(seq(from=seq_horizGrid[1], to=seq_horizGrid[2], along.with=seq_horizGrid), 1)

startDate <- formatDates(data$reportMetadata$startDate, "fiveyr", "start")
endDate <- formatDates(data$reportMetadata$endDate, "fiveyr", "end")
startDate <- formatDates(data$reportMetadata$startDate, "start")
endDate <- formatDates(data$reportMetadata$endDate, "end")

date_seq_mo <- seq(from=startDate, to=endDate, by="month")
first_yr <- date_seq_mo[which(month(date_seq_mo) == 1)[1]]
Expand All @@ -59,7 +59,7 @@ parseFiveYrSupplemental <- function(data, parsedData){

getMaxMinIv_fiveyr <- function(data, stat){
stat_vals <- data[['maxMinData']][[1]][[1]][['theseTimeSeriesPoints']][[stat]]
list(time = formatDates(stat_vals[['time']][1], plot_type="fiveyr", type=NA),
list(time = formatDates(stat_vals[['time']][1], type=NA),
value = stat_vals[['value']][1])
}

Expand All @@ -81,7 +81,7 @@ getPriorityStat <- function(data){
getStatDerived_fiveyr <- function(data, chain_nm, legend_nm, estimated){

points <- data[[chain_nm]][['points']]
points$time <- formatDates(points[['time']], plot_type="fiveyr", type=NA)
points$time <- formatDates(points[['time']], type=NA, isDV=TRUE)

date_index <- getEstimatedDates(data, chain_nm, points$time)

Expand Down
78 changes: 66 additions & 12 deletions R/utils-json.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -164,23 +164,21 @@ getEstimatedDates <- function(data, chain_nm, time_data){
return(date_index)
}

getApprovals <- function(data, chain_nm, legend_nm, appr_var_all, plot_type=NULL, month=NULL, point_type=NULL){
getApprovals <- function(data, chain_nm, legend_nm, appr_var_all, month=NULL, point_type=NULL, subsetByMonth=FALSE, isDV=FALSE){
appr_type <- c("Approved", "In Review", "Working")
approvals_all <- list()

isDV <- grepl("derivedSeries", chain_nm)

for(approval in appr_type){
appr_var <- appr_var_all[which(appr_type == approval)]

if(plot_type == "uvhydro"){
points <- subsetByMonth(getUvHydro(data, chain_nm), month)
if(subsetByMonth){
points <- subsetByMonth(getTimeSeries(data, chain_nm, isDV=isDV), month)
} else {
points <- data[[chain_nm]][['points']]
points$time <- formatDates(points[['time']], plot_type, type=NA)
points$time <- formatDates(points[['time']], type=NA)
}

appr_dates <- getApprovalDates(data, plot_type, chain_nm, approval)
appr_dates <- getApprovalDates(data, chain_nm, approval)
date_index <- apply(appr_dates, 1, function(d, points){
which(points$time >= d[1] & points$time <= d[2])},
points=points)
Expand All @@ -195,11 +193,11 @@ getApprovals <- function(data, chain_nm, legend_nm, appr_var_all, plot_type=NULL
for(i in seq_along(date_index_list)){
d <- date_index_list[[i]]

applicable_dates <- points[['time']][d]

if(isDV){
applicable_dates <- points[['time']][d] - hours(12)
applicable_values <- points[['value']][d]
} else {
applicable_dates <- points[['time']][d]
applicable_values <- substitute(getYvals_approvals(plot_object, length(applicable_dates)))
}

Expand All @@ -222,13 +220,69 @@ getYvals_approvals <- function(object, num_vals){
yvals <- rep(ylim, num_vals)
}

getApprovalDates <- function(data, plot_type, chain_nm, approval){
getApprovalDates <- function(data, chain_nm, approval){
i <- which(data[[chain_nm]]$approvals$description == approval)
startTime <- formatDates(data[[chain_nm]]$approvals$startTime[i], plot_type, type=NA)
endTime <- formatDates(data[[chain_nm]]$approvals$endTime[i], plot_type, type=NA)
startTime <- formatDates(data[[chain_nm]]$approvals$startTime[i], type=NA)
endTime <- formatDates(data[[chain_nm]]$approvals$endTime[i], type=NA)
return(data.frame(startTime=startTime, endTime=endTime))
}

#'@importFrom lubridate parse_date_time
getTimeSeries <- function(ts, field, estimatedOnly = FALSE, isDV = FALSE){
y <- ts[[field]]$points[['value']]
x <- ts[[field]]$points[['time']]

if(!is.null(y) & !is.null(x)){
if(isDV) {
format <- "Ymd"
} else {
format <- "Ymd HMOS z"
}

time <- parse_date_time(x,format, tz=ts$reportMetadata$timezone,quiet = TRUE)
if(isDV) { #want to render DVs at noon, convert to string to add noon and convert back to POSIXct
time <- time + hours(12)
}

month <- format(time, format = "%y%m") #for subsetting later by month
uv_series <- data.frame(time=time, value=y, month=month, stringsAsFactors = FALSE)

if(estimatedOnly) {
s <- ts[[field]]$estimatedPeriods[['startTime']]
estimatedStartTimes <- as.POSIXct(strptime(s, "%FT%T"))
e <- ts[[field]]$estimatedPeriods[['endTime']]
estimatedEndTimes <- as.POSIXct(strptime(e, "%FT%T"))
estimatedPeriods <- data.frame(start=estimatedStartTimes, end=estimatedEndTimes)

estimatedSubset <- data.frame(time=as.POSIXct(NA), value=as.character(NA), month=as.character(NA))
estimatedSubset <- na.omit(estimatedSubset)
for(i in 1:nrow(estimatedPeriods)) {
p <- estimatedPeriods[i,]
startTime <- p$start
endTime <- p$end
estimatedSubset <- rbind(estimatedSubset, uv_series[uv_series$time > startTime & uv_series$time < endTime,])
}
uv_series <- estimatedSubset
}

} else {
uv_series <- NULL
}

return(uv_series)
}

getTimeSeriesLabel<- function(ts, field){
param <- ts[[field]]$type
units <- ts[[field]]$units

if(!is.null(units)) {
return(paste(param, " (", units, ")"))
} else {
return(param)
}
}

#'Import a JSON file to use for report
#'@importFrom jsonlite fromJSON
#'@param file incoming json file
Expand Down
19 changes: 11 additions & 8 deletions R/utils-shared.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -95,14 +95,17 @@ isLogged <- function(all_data, ts_data, series){

############ used in dvhydrograph-data, correctionsataglance-data, fiveyeargwsum-data, uvhydrograph-data ############

formatDates <- function(char_date, plot_type=NULL, type=NA){
date_formatted <- as.POSIXct(strptime(char_date, "%FT%T"))
if(!is.null(plot_type) && plot_type == "fiveyr"){
if(!is.na(type) && type=="start"){
date_formatted <- as.POSIXct(format(date_formatted, format="%Y-%m-01"))
} else if(!is.na(type) && type=="end"){
date_formatted <- as.POSIXct(format(date_formatted, format="%Y-%m-30"))
}
formatDates <- function(char_date, type=NA, isDV=FALSE){
if(isDV) {
format <- "%F"
} else {
format <- "%FT%T"
}
date_formatted <- as.POSIXct(strptime(char_date, format))
if(!is.na(type) && type=="start"){
date_formatted <- as.POSIXct(format(date_formatted, format="%Y-%m-01"))
} else if(!is.na(type) && type=="end"){
date_formatted <- as.POSIXct(format(date_formatted, format="%Y-%m-30"))
}
return(date_formatted)
}
Expand Down
Loading

0 comments on commit 105d1a0

Please sign in to comment.