Merge pull request #12 from California-Data-Collaborative/fixTierRounding

Updated rounding for budget-based tiers closes #8

Author: christophertull

R/rateParser.R

@@ -117,7 +117,7 @@ add_rate_part_to_frame <- function(df, name, name_list, class_rate, cust_class){
       df <- bind_cols( df, variable_bills )
     }
     else{
-      df[[name]] <- eval_field_or_formula(df, rate_part)
+      df[[name]] <- eval_field_or_formula(df, name, rate_part)
     }
 
     return(df)
@@ -181,14 +181,31 @@ read_owrs_file <- function(filepath){
 #' the provided dataframe.
 #'
 #' @param df Data frame containing all data values referenced in field or formula.
+#' @param name Name of the rate part
 #' @param rate_part List representing a portion of a rate structure, defined in the
 #' \href{https://github.com/California-Data-Collaborative/Open-Water-Rate-Specification}{OWRS file}
 #'
 #' @return Either a single value or a vector the length of \code{df}. The result of
 #' evaluating a field or formula in the context of the dataframe.
 #'
 #' @keywords internal
-eval_field_or_formula <- function(df, rate_part){
+eval_field_or_formula <- function(df, name, rate_part){
+  #if field/formula represent a budget, we round each of the budget components
+  if(grepl("budget", name)){
+    rate_part <- gsub("\\+", " + ", rate_part)
+    rate_part <- gsub("\\*", " * ", rate_part)
+    rate_part <- gsub("\\^", " ^ ", rate_part)
+
+    ls <- unlist(strsplit(rate_part, " +"))
+    for(i in 1:length(ls)){
+      s <- ls[i]
+      if(!(s %in% c("+","*","^")))
+        ls[i] <- paste("round(",s,")")
+    }
+    rate_part <- paste(ls, collapse=" ")
+  }
+
+
   return(eval(parse(text=rate_part), df))
 }
 

R/tier_calcs.R

@@ -12,6 +12,10 @@ calculate_variable_bill <- function(data, rate_type, start_name="tier_starts",
 
   #call correct bill calculator function
   if(rate_type == "Tiered"){
+    stopif(grepl("%", tier_start_str),
+           paste("Tiers are formatted for budget-based rates, but commodity_charge is set to 'Tiered'.",
+                 "Please set 'commodity_charge: Budget' or change your tier_starts to billing units."))
+
     tier_starts <- parse_numerics(tier_start_str)
     tier_prices <- parse_numerics(tier_price_str)
     #check that prices are same length as tiers
@@ -69,7 +73,7 @@ get_usage_in_tiers <- function(data, tier_starts, budget_based=FALSE){
   for(i in 1:(num_tiers-1) ){
     # tier_stars is a matrix if budget, else is a vector
     if(budget_based){
-      t <- ceiling( tier_starts[,i+1] )
+      t <- tier_starts[,i+1] + 1
     }
     else{
       t <- tier_starts[i+1]
@@ -128,16 +132,16 @@ get_budget_tiers <- function(data, tier_start_strs, budget_col){
       budget_tiers[,i] <- suppressWarnings(as.numeric(t))
     }
     else if(tolower(t) == "indoor"){
-      budget_tiers[,i] <- data$indoor
+      budget_tiers[,i] <- round(data$indoor)
     }
     else if(tolower(t) == "outdoor"){
-      budget_tiers[,i] <- data$outdoor
+      budget_tiers[,i] <- round(data$outdoor)
     }
     else if( grepl("%", t) ){
       percent <- as.numeric( gsub("[^0-9\\.]", "", t, "") )
       stopifnot(is.finite(percent))
 
-      budget_tiers[,i] <- (percent/100)*budget
+      budget_tiers[,i] <- round((percent/100)*budget)
     }
   }
 

man/eval_field_or_formula.Rd

@@ -60,6 +60,13 @@ rows[[8]] <- list("usage_ccf"=27.3,
                   "et_amount"=4.8,
                   "irrigable_area"=1300,
                   "hhsize"=3)
+rows[[9]] <- list("usage_ccf"=27.3,
+                  "meter_size"='5/8"',
+                  "cust_class"="ERROR_CLASS4",
+                  "water_type"="POTABLE",
+                  "et_amount"=4.8,
+                  "irrigable_area"=1300,
+                  "hhsize"=3)
 df_test <- do.call(rbind.data.frame, rows[1:3])
 
 yaml_rates <- '
@@ -110,14 +117,14 @@ rate_structure:
     tier_starts:
       - 0
       - indoor
-      - 100%
-      - 125%
+      - 101%
+      - 126%
     tier_prices:
       - 2.87
       - 4.29
       - 6.44
       - 10.07
-    commodity_charge: Tiered
+    commodity_charge: Budget
     bill: commodity_charge + service_charge
   IRRIGATION:
     service_charge:
@@ -242,6 +249,15 @@ rate_structure:
         - 6.33
     commodity_charge: Tiered
     bill: commodity_charge + service_charge
+  ERROR_CLASS4:
+    tier_starts:
+      - 0
+      - 101%
+    tier_prices:
+      - 4.07
+      - 10.03
+    commodity_charge: Tiered
+    bill: commodity_charge
 '
 test_rates <- yaml.load(yaml_rates)
 
@@ -253,15 +269,16 @@ calc <- function(df){
 manual_bill_1 <- 33 + (4.07*388) + (2*10 + 0*378)
 manual_bill_2 <- 11 + (2.87*14 + 4.29*6 + 6.44*5 + 10.07*2.3) + (2*10 + 0*17.3)
 
-manual_budget_3 <- 0.7*4.8*4500*0.62*(1/748)
-manual_bill_3 <- 22 + 3.66*floor(manual_budget_3) + 6.33*(41 - floor(manual_budget_3) ) + 1.5*41
+manual_budget_3 <- round(0.7*4.8*4500*0.62*(1/748))
+manual_bill_3 <- 22 + 3.66*manual_budget_3 + 6.33*(41 - manual_budget_3 ) + 1.5*41
 
-# manual_indoor_8 <- 60*3*30.4*(1/748)
-# manual_outdoor_8 <- 0.7 * 1300 * 4.8 * 0.62 * (1/748)
-# manual_budget_8 <- manual_indoor_8 + manual_outdoor_8
-# manual_bill_8 <- 11 + 2.87*floor(manual_indoor) +
-#                   4.29*floor(manual_outdoor) +
-#                   6.44*floor(1.25*manual_budget_8 - manual_budget_8) + 10.07*(27.3-1.25*manual_budget_8)
+manual_indoor_8 <- round(60*3*30.4*(1/748))
+manual_outdoor_8 <- round(0.7 * 1300 * 4.8 * 0.62 * (1/748))
+manual_budget_8 <- round(manual_indoor_8 + manual_outdoor_8)
+manual_bill_8 <- 11 + 2.87*manual_indoor_8 +
+                  4.29*manual_outdoor_8 +
+                  6.44*(round(1.26*manual_budget_8) - manual_budget_8) +
+                  10.07*(27.3-round(1.26*manual_budget_8))
 
 manual_bills <- c(manual_bill_1, manual_bill_2, manual_bill_3)
 
@@ -270,7 +287,7 @@ test_that("Individual bills calculated accurately", {
  expect_equal(calc(as.data.frame(rows[[1]]))$bill, manual_bill_1)
  expect_equal(calc(as.data.frame(rows[[2]]))$bill, manual_bill_2)
  expect_equal(calc(as.data.frame(rows[[3]]))$bill, manual_bill_3)
- # expect_equal(calc(as.data.frame(rows[[8]]))$bill, manual_bill_8)
+ expect_equal(calc(as.data.frame(rows[[8]]))$bill, manual_bill_8)
 })
 
 test_that("Bills accurate when summed accross customer classes", {
@@ -289,5 +306,9 @@ test_that("Error thrown when a field is missing", {
   expect_error(calc(as.data.frame(rows[[7]])), "is not present in the OWRS file for customer class")
 })
 
+test_that("Error thrown when % tiers used in 'Tiered' rate", {
+  expect_error(calc(as.data.frame(rows[[9]])), "Tiers are formatted for budget-based rates")
+})
+