Skip to content

Commit

Permalink
Merge pull request #29 from dblodgett-usgs/master
Browse files Browse the repository at this point in the history 
Cleaning up utilities and such.
  • Loading branch information
@dblodgett-usgs
dblodgett-usgs committed Apr 30, 2017
2 parents 35ac8da + f0018a0 commit 928e81f
Show file tree
Hide file tree
Showing 26 changed files with 161 additions and 246 deletions.
1 change: 1 addition & 0 deletions .gitignore
View file
@@ -1,3 +1,4 @@
*.Rapp.history
.Rproj.user
.Rhistory
.RData
Expand Down
1 change: 0 additions & 1 deletion NAMESPACE
View file
Expand Up @@ -14,7 +14,6 @@ export(calculate_stat_rmsne)
export(calculate_stat_rsr)
export(calculate_stats_by_group)
export(calculate_stats_diffs)
export(find_peak_flow)
export(get_local_data)
export(get_nwc_huc)
export(get_nwc_wb_data)
Expand Down
10 changes: 2 additions & 8 deletions R/build_nwc_flow_dataset.R
View file
Expand Up @@ -7,7 +7,6 @@
#' @param hucs A character vector of 12-digit HUCs.
#' @param start_date character representation of the start date in YYYY-MM-DD format.
#' @param end_date character representation of the end date in YYYY-MM-DD format.
#' @param choose character as required by \link{find_peak_flow}
#' @importFrom EflowStats dataCheck peakThreshold
#' @export
#' @examples
Expand All @@ -16,7 +15,7 @@
#' end_date <- "2010-09-30"
#' build_nwc_flow_dataset(hucs, start_date, end_date)
build_nwc_flow_dataset <- function(hucs, start_date="1980-10-01",
end_date="2010-09-30", choose = "no") {
end_date="2010-09-30") {

if(any(nchar(hucs)!=12)) stop("Must submit 12-digit HUC ids")

Expand All @@ -38,13 +37,8 @@ build_nwc_flow_dataset <- function(hucs, start_date="1980-10-01",

drainage_area_sqmi[huc] <- as.numeric(get_nwc_huc(huc)$features[[1]]$properties$areasqkm) * 0.386102 # convert to sqmi

peak_flows <- find_peak_flow(fdata, choose = choose)

peak_threshold[huc] <- peakThreshold(fdata[c("date","discharge")],
peak_flows[c("date","peak")])
}

output <- list(daily_streamflow_cfs = nwc_dataset,
drainage_area_sqmi = drainage_area_sqmi,
peak_threshold_cfs = peak_threshold)
drainage_area_sqmi = drainage_area_sqmi)
}
40 changes: 20 additions & 20 deletions R/calculate_GoF_stats.R
View file
Expand Up @@ -24,12 +24,12 @@ calculate_GoF_stats <- function(Modeled,Gaged) {
Gaged <- Gaged[order(Gaged$date),]
Modeled <- Modeled[order(Modeled$date),]

nsev <- calculate_stat_nse(Gaged$discharge,Modeled$discharge)
nselogv <- calculate_stat_nselog(Gaged$discharge,Modeled$discharge)
nsev <- calculate_stat_nse(Modeled$discharge, Gaged$discharge)
nselogv <- calculate_stat_nselog(Modeled$discharge, Gaged$discharge)
rmsev <- calculate_stat_rmse(Gaged$discharge,Modeled$discharge)
rmsnev <- calculate_stat_rmsne(Gaged$discharge,Modeled$discharge)
rmsnev <- calculate_stat_rmsne(Modeled$discharge, Gaged$discharge)
rsrv <- calculate_stat_rsr(Gaged$discharge,Modeled$discharge)
pbiasv <- calculate_stat_pbias(Modeled$discharge,Gaged$discharge)
pbiasv <- calculate_stat_pbias(Gaged$discharge,Modeled$discharge)
pearsonv <- cor(Modeled$discharge,Gaged$discharge,method="pearson")
spearmanv <- cor(Modeled$discharge,Gaged$discharge,method="spearman")

Expand All @@ -45,12 +45,12 @@ calculate_GoF_stats <- function(Modeled,Gaged) {
& Gaged$discharge<obs_percentiles[5])
obs_90_indices <- which(Gaged$discharge>=obs_percentiles[5])

nsev_90 <- calculate_stat_nse(Gaged$discharge[obs_90_indices],Modeled$discharge[obs_90_indices])
nsev_75_90 <- calculate_stat_nse(Gaged$discharge[obs_75_90_indices],Modeled$discharge[obs_75_90_indices])
nsev_50_75 <- calculate_stat_nse(Gaged$discharge[obs_50_75_indices],Modeled$discharge[obs_50_75_indices])
nsev_25_50 <- calculate_stat_nse(Gaged$discharge[obs_25_50_indices],Modeled$discharge[obs_25_50_indices])
nsev_10_25 <- calculate_stat_nse(Gaged$discharge[obs_10_25_indices],Modeled$discharge[obs_10_25_indices])
nsev_10 <- calculate_stat_nse(Gaged$discharge[obs_10_indices],Modeled$discharge[obs_10_indices])
nsev_90 <- calculate_stat_nse(Modeled$discharge[obs_90_indices], Gaged$discharge[obs_90_indices])
nsev_75_90 <- calculate_stat_nse(Modeled$discharge[obs_75_90_indices], Gaged$discharge[obs_75_90_indices])
nsev_50_75 <- calculate_stat_nse(Modeled$discharge[obs_50_75_indices],Gaged$discharge[obs_50_75_indices])
nsev_25_50 <- calculate_stat_nse(Modeled$discharge[obs_25_50_indices],Gaged$discharge[obs_25_50_indices])
nsev_10_25 <- calculate_stat_nse(Modeled$discharge[obs_10_25_indices],Gaged$discharge[obs_10_25_indices])
nsev_10 <- calculate_stat_nse(Modeled$discharge[obs_10_indices],Gaged$discharge[obs_10_indices])

rmsev_90 <- calculate_stat_rmse(Gaged$discharge[obs_90_indices],Modeled$discharge[obs_90_indices])
rmsev_75_90 <- calculate_stat_rmse(Gaged$discharge[obs_75_90_indices],Modeled$discharge[obs_75_90_indices])
Expand All @@ -59,12 +59,12 @@ calculate_GoF_stats <- function(Modeled,Gaged) {
rmsev_10_25 <- calculate_stat_rmse(Gaged$discharge[obs_10_25_indices],Modeled$discharge[obs_10_25_indices])
rmsev_10 <- calculate_stat_rmse(Gaged$discharge[obs_10_indices],Modeled$discharge[obs_10_indices])

rmsnev_90 <- calculate_stat_rmsne(Gaged$discharge[obs_90_indices],Modeled$discharge[obs_90_indices])
rmsnev_75_90 <- calculate_stat_rmsne(Gaged$discharge[obs_75_90_indices],Modeled$discharge[obs_75_90_indices])
rmsnev_50_75 <- calculate_stat_rmsne(Gaged$discharge[obs_50_75_indices],Modeled$discharge[obs_50_75_indices])
rmsnev_25_50 <- calculate_stat_rmsne(Gaged$discharge[obs_25_50_indices],Modeled$discharge[obs_25_50_indices])
rmsnev_10_25 <- calculate_stat_rmsne(Gaged$discharge[obs_10_25_indices],Modeled$discharge[obs_10_25_indices])
rmsnev_10 <- calculate_stat_rmsne(Gaged$discharge[obs_10_indices],Modeled$discharge[obs_10_indices])
rmsnev_90 <- calculate_stat_rmsne(Modeled$discharge[obs_90_indices],Gaged$discharge[obs_90_indices])
rmsnev_75_90 <- calculate_stat_rmsne(Modeled$discharge[obs_75_90_indices],Gaged$discharge[obs_75_90_indices])
rmsnev_50_75 <- calculate_stat_rmsne(Modeled$discharge[obs_50_75_indices],Gaged$discharge[obs_50_75_indices])
rmsnev_25_50 <- calculate_stat_rmsne(Modeled$discharge[obs_25_50_indices],Gaged$discharge[obs_25_50_indices])
rmsnev_10_25 <- calculate_stat_rmsne(Modeled$discharge[obs_10_25_indices],Gaged$discharge[obs_10_25_indices])
rmsnev_10 <- calculate_stat_rmsne(Modeled$discharge[obs_10_indices],Gaged$discharge[obs_10_indices])

rsrv_90 <- calculate_stat_rsr(Gaged$discharge[obs_90_indices],Modeled$discharge[obs_90_indices])
rsrv_75_90 <- calculate_stat_rsr(Gaged$discharge[obs_75_90_indices],Modeled$discharge[obs_75_90_indices])
Expand Down Expand Up @@ -140,14 +140,14 @@ calculate_GoF_stats <- function(Modeled,Gaged) {
monthobs <- monthobs[order(monthobs$date),]
monthmod <- monthmod[order(monthmod$date),]

NSEbyMonth[m] <- calculate_stat_nse(monthobs$discharge,monthmod$discharge)
NSELOGbyMonth[m] <- calculate_stat_nselog(monthobs$discharge,monthmod$discharge)
NSEbyMonth[m] <- calculate_stat_nse(monthmod$discharge, monthobs$discharge)
NSELOGbyMonth[m] <- calculate_stat_nselog(monthmod$discharge, monthobs$discharge)
RMSEbyMonth[m] <- calculate_stat_rmse(monthobs$discharge,monthmod$discharge)
RMSNEbyMonth[m] <- calculate_stat_rmsne(monthobs$discharge,monthmod$discharge)
RMSNEbyMonth[m] <- calculate_stat_rmsne(monthmod$discharge, monthobs$discharge)
RSRbyMonth[m] <- calculate_stat_rsr(monthobs$discharge,monthmod$discharge)

if (nrow(monthmod)>1) {
BiasbyMonth[m] <- calculate_stat_pbias(monthobs$discharge,monthmod$discharge)
BiasbyMonth[m] <- calculate_stat_pbias(monthmod$discharge,monthobs$discharge)
} else {
BiasbyMonth[m] <- NA
}
Expand Down
22 changes: 10 additions & 12 deletions R/calculate_GoF_summary_stats.R
View file
Expand Up @@ -16,9 +16,7 @@
#' Modeled<-mod_data
#' Modeled$date <- as.Date(Modeled$date)
#' Modeled <- dataCheck(Modeled, yearType = "water")
#' GoFstats <- calculate_GoF_stats(Modeled,Gaged)
# This function should @importFrom hydrGOF rmse pbias but
# something is wrong with the rmse function.
#' GoFstats <- calculate_GoF_stats(Gaged, Modeled)
calculate_GoF_summary_stats <- function(Gaged,Modeled) {
NSEv <- vector(length=14)
NSELOGv <- vector(length=length(NSEv))
Expand All @@ -31,10 +29,10 @@ calculate_GoF_summary_stats <- function(Gaged,Modeled) {
c <- 2
GagedTmp <- aggregate(Gaged$discharge, list(Gaged$year_val), FUN = mean, na.rm=TRUE)
ModeledTmp <- aggregate(Modeled$discharge, list(Modeled$year_val), FUN = mean, na.rm=TRUE)
NSEv[i] <- calculate_stat_nse(GagedTmp[,c],ModeledTmp[,c])
NSELOGv[i] <- calculate_stat_nselog(GagedTmp[,c],ModeledTmp[,c])
NSEv[i] <- calculate_stat_nse(ModeledTmp[,c], GagedTmp[,c])
NSELOGv[i] <- calculate_stat_nselog(ModeledTmp[,c], GagedTmp[,c])
RMSEv[i] <- calculate_stat_rmse(GagedTmp[,c],ModeledTmp[,c])
PBIASv[i] <- calculate_stat_pbias(GagedTmp[,c],ModeledTmp[,c])
PBIASv[i] <- calculate_stat_pbias(ModeledTmp[,c],GagedTmp[,c])
PEARSONv[i] <- cor(GagedTmp[,c],ModeledTmp[,c],method="pearson")
SPEARMANv[i] <- cor(GagedTmp[,c],ModeledTmp[,c],method="spearman")

Expand All @@ -44,10 +42,10 @@ calculate_GoF_summary_stats <- function(Gaged,Modeled) {
Modeled$month_val <- format(Gaged$date, "%m")
GagedTmp <- aggregate(Gaged$discharge, list(Gaged$year_val,Gaged$month_val), FUN = mean, na.rm=TRUE)
ModeledTmp <- aggregate(Modeled$discharge, list(Modeled$year_val,Modeled$month_val), FUN = mean, na.rm=TRUE)
NSEv[i] <- calculate_stat_nse(GagedTmp[,c],ModeledTmp[,c])
NSELOGv[i] <- calculate_stat_nselog(GagedTmp[,c],ModeledTmp[,c])
NSEv[i] <- calculate_stat_nse(ModeledTmp[,c], GagedTmp[,c])
NSELOGv[i] <- calculate_stat_nselog(ModeledTmp[,c], GagedTmp[,c])
RMSEv[i] <- calculate_stat_rmse(GagedTmp[,c],ModeledTmp[,c])
PBIASv[i] <- calculate_stat_pbias(GagedTmp[,c],ModeledTmp[,c])
PBIASv[i] <- calculate_stat_pbias(ModeledTmp[,c],GagedTmp[,c])
PEARSONv[i] <- cor(GagedTmp[,c],ModeledTmp[,c],method="pearson")
SPEARMANv[i] <- cor(GagedTmp[,c],ModeledTmp[,c],method="spearman")

Expand All @@ -60,10 +58,10 @@ calculate_GoF_summary_stats <- function(Gaged,Modeled) {
GagedTmp <- aggregate(monthobs$discharge, list(monthobs$year_val), FUN = mean, na.rm=TRUE)
ModeledTmp <- aggregate(monthmod$discharge, list(monthmod$year_val), FUN = mean, na.rm=TRUE)
i <- 2+m
NSEv[i] <- calculate_stat_nse(GagedTmp[,c],ModeledTmp[,c])
NSELOGv[i] <- calculate_stat_nselog(GagedTmp[,c],ModeledTmp[,c])
NSEv[i] <- calculate_stat_nse(ModeledTmp[,c], GagedTmp[,c])
NSELOGv[i] <- calculate_stat_nselog(ModeledTmp[,c], GagedTmp[,c])
RMSEv[i] <- calculate_stat_rmse(GagedTmp[,c],ModeledTmp[,c])
PBIASv[i] <- calculate_stat_pbias(GagedTmp[,c],ModeledTmp[,c])
PBIASv[i] <- calculate_stat_pbias(ModeledTmp[,c],GagedTmp[,c])
PEARSONv[i] <- cor(GagedTmp[,c],ModeledTmp[,c],method="pearson")
SPEARMANv[i] <- cor(GagedTmp[,c],ModeledTmp[,c],method="spearman")
}
Expand Down

0 comments on commit 928e81f

Please sign in to comment.