Merge pull request #5 from California-Data-Collaborative/addSewerCharges

1. Added support for sewer_charge that can be tiered or allocation based. Uses sewer_tier_starts and sewer_tier_prices fields.
2. Tier start and tier prices no longer need to appear before commodity_charge and sewer_charge.
3. Some minor cleanup.

Author: christophertull

DESCRIPTION

@@ -6,14 +6,15 @@ Date: 2016-10-28
 Author: Christopher Tull
 Maintainer: Christopher Tull <chris@argolabs.org>
 Description: RateParser is designed to parse a machine-readable water rate
-  structure written using the Open Water Rate Specification (OWRS). In addition
-  to parsing the rate structure, this package will also apply the rate structure
-  to properly formatted meter read data in order to calculate water bills.
+    structure written using the Open Water Rate Specification (OWRS). In addition to
+    parsing the rate structure, this package will also apply the rate structure to
+    properly formatted meter read data in order to calculate water bills.
 License: MIT
 LazyData: TRUE
 Imports:
-  dplyr,
-  yaml
+    dplyr,
+    yaml
 Suggests:
-  testthat,
-  covr
+    testthat,
+    covr
+RoxygenNote: 5.0.1

NAMESPACE

@@ -1,9 +1,12 @@
-# Generated by roxygen2 (4.1.1): do not edit by hand
+# Generated by roxygen2: do not edit by hand
 
 export(calculate_bill)
+export(is_map)
 export(read_owrs_file)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,bind_cols)
 importFrom(dplyr,do)
 importFrom(dplyr,group_by)
+importFrom(dplyr,select)
 importFrom(dplyr,tbl_df)
+importFrom(dplyr,ungroup)

R/rateParser.R

@@ -70,7 +70,9 @@ calculate_class_bill <- function(df, parsed_rate){
   return(df)
 }
 
-
+#' Evaluate a rate part and add to the dataframe.
+#'
+#' @importFrom dplyr %>% tbl_df group_by do bind_cols ungroup select
 add_rate_part_to_frame <- function(df, name, name_list, class_rate, cust_class){
   rate_part <- class_rate[[name]]
 
@@ -90,13 +92,26 @@ add_rate_part_to_frame <- function(df, name, name_list, class_rate, cust_class){
     }
     else if(is_rate_type(rate_part)){
 
-      stopif(!(("tier_starts" %in% names(df))&&("tier_prices" %in% names(df))),
-             paste0("Either tier_starts or tier_prices is not present in the ", cust_class,
-                    " rate structure, or they could appear afterwards."))
-
       rate_type <- rate_part
-      variable_bills <- df %>% group_by(tier_starts, tier_prices) %>%
-        do(calculate_variable_bill(., rate_type))
+
+      if(name=="commodity_charge"){
+        stopif(!(("tier_starts" %in% names(df))), "object 'tier_starts' not found")
+        stopif(!(("tier_prices" %in% names(df))), "object 'tier_prices' not found")
+
+        variable_bills <- df %>% group_by(tier_starts, tier_prices) %>%
+          do(calculate_variable_bill(., rate_type)) %>%
+          ungroup() %>% select(-tier_starts, -tier_prices)
+
+      }else if(name=="sewer_charge"){
+        stopif(!(("sewer_tier_starts" %in% names(df))), "object 'sewer_tier_starts' not found")
+        stopif(!(("sewer_tier_prices" %in% names(df))), "object 'sewer_tier_prices' not found")
+
+        variable_bills <- df %>% group_by(sewer_tier_starts, sewer_tier_prices) %>%
+          do(calculate_variable_bill(., rate_type, start_name="sewer_tier_starts",
+                                     price_name="sewer_tier_prices", is_sewer=TRUE)) %>%
+          ungroup() %>% select(-sewer_tier_starts, -sewer_tier_prices)
+      }
+
       #rename the column
       names(variable_bills)[names(variable_bills)=="variable_bill"] <- name
       df <- bind_cols( df, variable_bills )

R/tier_calcs.R

@@ -2,46 +2,48 @@
 #******************************************************************
 # Calculate the variable portion of a bill
 #******************************************************************
-calculate_variable_bill <- function(data, rate_type){
-  tier_start_str <- data$tier_starts[1]
-  tier_price_str <- data$tier_prices[1]
+calculate_variable_bill <- function(data, rate_type, start_name="tier_starts",
+                                    price_name="tier_prices", is_sewer=FALSE){
+  if(is_sewer){budget_col <- "sewer_budget"}
+  else{budget_col <- "budget"}
+
+  tier_start_str <- data[[start_name]][1]
+  tier_price_str <- data[[price_name]][1]
 
   #call correct bill calculator function
   if(rate_type == "Tiered"){
     tier_starts <- parse_numerics(tier_start_str)
     tier_prices <- parse_numerics(tier_price_str)
     #check that prices are same length as tiers
     stopifnot(length(tier_starts)==length(tier_prices))
-    bill_info <- calculate_tiered_charge(data, tier_starts, tier_prices)
+    bill_info <- calculate_tiered_charge(data, tier_starts, tier_prices, is_sewer=is_sewer)
   }
   else if(rate_type == "Budget"){
-    tier_starts <- get_budget_tiers(data, parse_strings(tier_start_str))
+    tier_starts <- get_budget_tiers(data, parse_strings(tier_start_str), budget_col=budget_col)
     tier_prices <- parse_numerics(tier_price_str )
     #check that prices are same length as tiers
     stopifnot(ncol(tier_starts)==length(tier_prices))
-    bill_info <- calculate_tiered_charge(data, tier_starts, tier_prices, budget_based=TRUE)
+    bill_info <- calculate_tiered_charge(data, tier_starts, tier_prices, budget_based=TRUE, is_sewer=is_sewer)
   }
 
   return(bill_info)
 }
 
-#******************************************************************
-# Calculate a flat rate usage charge
-#******************************************************************
-calculate_flat_charge <- function(data, price){
-  tmp <- tbl_df(data.frame(X1=data$usage_ccf, XR1= data$usage_ccf*price ,variable_bill=data$usage_ccf*price))
-  return(tmp)
-}
 
 #******************************************************************
 # Calculate a tiered usage charge
 #******************************************************************
-calculate_tiered_charge <- function(data, tier_starts, tier_prices, budget_based=FALSE){
+calculate_tiered_charge <- function(data, tier_starts, tier_prices, budget_based=FALSE, is_sewer=FALSE){
+  if(is_sewer){suffix <- "_sewer"}
+  else{suffix <- ""}
+
   usage_in_tiers <- get_usage_in_tiers(data, tier_starts, budget_based=budget_based)
   revenue_in_tiers <- t(tier_prices*t(usage_in_tiers))
 
-  #change name of revenue columns to XR#
-  colnames(revenue_in_tiers) <- c( paste("XR", 1:ncol(revenue_in_tiers), sep="") )
+  #change name of usage columns to X#{suffix}
+  colnames(usage_in_tiers) <- c( paste("X", 1:ncol(usage_in_tiers), suffix, sep="") )
+  #change name of revenue columns to XR#{suffix}
+  colnames(revenue_in_tiers) <- c( paste("XR", 1:ncol(revenue_in_tiers), suffix, sep="") )
   usage_in_tiers <- tbl_df(data.frame(usage_in_tiers, revenue_in_tiers, variable_bill=usage_in_tiers%*%tier_prices))
   return(usage_in_tiers)
 }
@@ -114,8 +116,8 @@ parse_numerics <- function(str){
 # and converts them to a matrix of CCF tier starting values for
 # each customer.
 #******************************************************************
-get_budget_tiers <- function(data, tier_start_strs){
-  budget <- data$budget
+get_budget_tiers <- function(data, tier_start_strs, budget_col){
+  budget <- data[[budget_col]]
   budget_tiers <- matrix(0, nrow(data), length(tier_start_strs))
 
   for(i in 1:length(tier_start_strs)){