Completed coding of all functionality.

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: wqbc
 Type: Package
 Title: Water Quality Thresholds and Index Calculation for British Columbia
-Version: 0.0.0.9002
-Date: 2015-01-29
+Version: 0.0.0.9003
+Date: 2015-01-30
 Authors@R: as.person(c(
     "Joe Thorley <[email protected]> [aut, cre]",
     "Colin Millar <[email protected]> [aut]",

NEWS.md

@@ -1,3 +1,7 @@
+# wqbc 0.0.0.9003
+
+- Completed coding of all functionality.
+
 # wqbc 0.0.0.9002
 
 - Finalized limits.csv and codes.csv files

R/calc-wqis.R

@@ -41,11 +41,7 @@ wqi <- function (x, v, nv, nt) {
 resample_wqi <- function (x, i, nt = nt, nv = nv) {
   x <- x[i,,drop = FALSE]
   wqi <- wqi(x = x$Excursion, v = x$Variable, nt = nt, nv = nv)["WQI"]
-  if(is.na(wqi) || is.nan(wqi)) {
-    print(x)
-    stop()
-    print(wqi)
-  }
+  stopifnot(!is.na(wqi) && !is.nan(wqi))
   wqi(x = x$Excursion, v = x$Variable, nt = nt, nv = nv)["WQI"]
 }
 
@@ -66,7 +62,6 @@ bootstrap_wqi <- function (x, nt, nv) {
 calc_wqi <- function (x) {
 
   x$Excursion <- get_excursions(x$Value, x$LowerLimit, x$UpperLimit)
-
   x <- dplyr::select_(x, ~Excursion, ~Variable)
 
   nt <- nrow(x)
@@ -106,6 +101,9 @@ calc_wqis <- function (x, by = NULL,
 
   check_rows(x)
   check_columns(x, c("Variable", "Value", "UpperLimit"))
+
+  if(messages) message("Calculating Water Quality Indices...")
+
   x <- add_missing_columns(x, list("Date" = as.Date("2000-01-01"),
                                    "LowerLimit" = NA_real_), messages = messages)
   check_class_columns(x, list("Date" = "Date",
@@ -118,15 +116,19 @@ calc_wqis <- function (x, by = NULL,
 
   x <- delete_columns(x, colnames(x)[!colnames(x) %in% c("Date", "Variable", "Value", "LowerLimit", "UpperLimit", by)], messages = FALSE)
 
-
   x$Value <- replace_negative_values_with_na(x$Value, messages = messages)
+  x$LowerLimit <- replace_negative_values_with_na(x$LowerLimit, messages = messages)
+  x$UpperLimit <- replace_negative_values_with_na(x$UpperLimit, zero = TRUE, messages = messages)
   x <- delete_rows_with_missing_values(x, list("Date", "Value", "Variable",
                                                c("LowerLimit", "UpperLimit")),
                                        messages = messages)
   check_rows(x)
 
-  if(is.null(by))
-    return(calc_wqi(x))
-
-  plyr::ddply(x, .variables = by, .fun = calc_wqi, .parallel = parallel)
+  if(is.null(by)) {
+    x <- calc_wqi(x)
+  } else {
+    x <- plyr::ddply(x, .variables = by, .fun = calc_wqi, .parallel = parallel)
+  }
+  if(messages) message("Calculated.")
+  x
 }

R/utils.R

@@ -16,7 +16,7 @@ add_missing_columns <- function (x, columns, messages) {
 
   for(column in names(columns)) {
     if(!column %in% colnames(x)) {
-      if(messages) message("Adding missing column ", column, " to x.")
+      if(messages) message("Added missing column ", column, " to x.")
       x[[column]] <-  columns[[column]]
     }
   }
@@ -59,11 +59,15 @@ delete_rows_with_missing_values <- function (x, columns, messages) {
   x
 }
 
-replace_negative_values_with_na <- function (x, messages) {
-  bol <- !is.na(x) & x < 0
+replace_negative_values_with_na <- function (x, zero = FALSE, messages) {
+  if(!zero) {
+    bol <- !is.na(x) & x < 0
+  } else {
+    bol <- !is.na(x) & x <= 0
+  }
   if(any(bol)) {
-    if(messages) message("Replaced ", sum(bol), " negative ",
-                         plural("value", sum(bol) > 1), " with missing values")
+    if(messages) message("Replaced ", sum(bol), " negative ", ifelse(zero, "or zero ", ""),
+                         plural("value", sum(bol) > 1), " with a missing value.")
     is.na(x[bol]) <- TRUE
   }
   x

demo/dummy.R

@@ -1,13 +1,16 @@
 library(dplyr)
 
-data(dummy)
+msgs <- TRUE
 
+data(dummy)
 print(dummy)
-dummy_standardized <- standardize_wqdata(dummy, messages = TRUE)
+
+dummy_standardized <- standardize_wqdata(dummy, messages = msgs)
 print(dummy_standardized)
 print(filter(dummy, !ID %in% dummy_standardized$ID))
 
-dummy_cleansed <- clean_wqdata(dummy_standardized, messages = TRUE)
+dummy_cleansed <- clean_wqdata(dummy_standardized, messages = msgs)
 print(dummy_cleansed)
 
-dummy_limits <- calc_limits(dummy_cleansed, term = "short", messages = TRUE)
+dummy_limits <- calc_limits(dummy_cleansed, term = "short", messages = msgs)
+print(dummy_limits)

demo/fraser.R

@@ -4,18 +4,27 @@ library(ggplot2)
 library(sp)
 library(rgdal)
 
+msgs <- TRUE
+
 data(fraser)
+print(summary(fraser))
 
 fraser$SiteID <-  factor(sub("BC08", "", as.character(fraser$SiteID)))
 plot_map(fraser, fill = "SiteID")
 
-fraser_clean <- clean_wqdata(fraser, by = c("SiteID", "Lat", "Long"), messages = TRUE)
-fraser_limits <- calc_limits(fraser_clean, by = c("SiteID", "Lat", "Long"),
-                             messages = TRUE)
+fraser_standard <- standardize_wqdata(fraser, messages = msgs)
+fraser_clean <- clean_wqdata(fraser_standard, by = c("SiteID", "Lat", "Long"), messages = msgs)
+
+for(term in c("short", "long")) {
+  print(paste0(term, "-term"))
+
+  fraser_limits <- calc_limits(fraser_clean, by = c("SiteID", "Lat", "Long"),
+                               term = term, messages = msgs)
 
-fraser_limits$Year <- year(fraser_limits$Date)
-fraser_wqis <- calc_wqis(fraser_limits, by = c("SiteID", "Year", "Lat", "Long"))
+  fraser_limits$Year <- year(fraser_limits$Date)
+  fraser_limits <- calc_wqis(fraser_limits, by = c("SiteID", "Year", "Lat", "Long"))
 
-plot_wqis(fraser_wqis, x = "Year") + facet_wrap(~SiteID)
+  print(plot_wqis(fraser_limits, x = "Year") + facet_wrap(~SiteID))
 
-plot_map_wqis(filter(fraser_wqis, Year %in% c(2000,2010)), keep = "Year") + facet_wrap(~Year, ncol = 1)
+  print(plot_map_wqis(filter(fraser_limits, Year %in% c(2000,2010)), keep = "Year") + facet_wrap(~Year, ncol = 1))
+}