Merge pull request #57 from California-Data-Collaborative/develop

christophertull · web-flow · commit 4422a3d6427f · 2017-08-31T13:15:56.000-07:00
removed hardcoding and fixed bugs
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -4,7 +4,7 @@ Description: The RateComparison package is an R Shiny application for exploring
     revenue, demand and equity impacts caused by a shift in water rates. The app compares
     a baseline rate structure (usually the utility's current/historical rates) against
     a hypothetical rate structure specified by the user.
-Version: 0.2.0
+Version: 0.3.0
 Imports:
     dplyr,
     tidyr,
diff --git a/R/class_graphs.R b/R/class_graphs.R
@@ -108,7 +108,7 @@ classGraphOutput <- function(id, rate_codes){
                          )
                   )
                 ),#end row
-                fluidRow(paste("Enter the starting value for each tier either as a CCF value, ",
+                fluidRow(paste("Enter the starting value for each tier either as a billing unit value, ",
                                " or as a percent of budget (water budget assumed as Indoor + Outdoor). ",
                                "Where:")
                 ),
@@ -172,7 +172,7 @@ classGraph <- function(input, output, session, cust_class, df_original, df_total
 
   rate_part_name2 <- "flat_rate"
   input_list[[rate_part_name2]] <- callModule(ratePart, rate_part_name2, 
-             part_name=rate_part_name2, part_name_long="Charge per CCF",
+             part_name=rate_part_name2, part_name_long="Charge per unit",
              depends_col_list=dropdown_cols, 
              value_map = rate_list()$rate_structure[[active_class()]][[rate_part_name2]]$values)   
   
@@ -208,15 +208,15 @@ classGraph <- function(input, output, session, cust_class, df_original, df_total
   
   rate_part_name7 <- "tiered_starts"
   input_list[[rate_part_name7]] <- callModule(tierBox, rate_part_name7, 
-                                              part_name=rate_part_name7, part_name_long="Tier Starts (CCF)", 
+                                              part_name=rate_part_name7, part_name_long="Tier Starts (billing units)", 
                                               rate_type=rate_list()$rate_structure[[active_class()]][["commodity_charge"]], 
                                               rate_type_provided="Tiered", 
                                               rate_part=rate_list()$rate_structure[[active_class()]][["tier_starts"]]
   )
   
   rate_part_name8 <- "budget_starts"
   input_list[[rate_part_name8]] <- callModule(tierBox, rate_part_name8, 
-                                              part_name=rate_part_name8, part_name_long="Tier Starts (CCF)", 
+                                              part_name=rate_part_name8, part_name_long="Tier Starts (billing units)", 
                                               rate_type=rate_list()$rate_structure[[active_class()]][["commodity_charge"]], 
                                               rate_type_provided="Budget", 
                                               rate_part=rate_list()$rate_structure[[active_class()]][["tier_starts"]]
diff --git a/R/helper_fns.R b/R/helper_fns.R
@@ -88,14 +88,19 @@ get_monthly_usage_by_account <- function(data){
     group_by(cust_id,usage_month) %>% 
     summarise(usage_ccf = mean(usage_ccf,na.rm=TRUE))
   
+  customer_means <- data %>%
+    group_by(cust_id) %>% 
+    summarise(customer_usage = mean(usage_ccf,na.rm=TRUE))
+  
   rate_code_means <- data %>% 
     group_by(rate_code, usage_month) %>% 
     summarise(rate_code_usage = mean(usage_ccf,na.rm=TRUE))
   
-  
   df_out <- months %>% left_join(cust_id_with_rate_code, by="cust_id")  %>% 
     left_join(df_out, by=c("usage_month", "cust_id")) %>%
     left_join(rate_code_means, by=c("usage_month", "rate_code")) %>%
+    left_join(customer_means, by=c("cust_id")) %>%
+    mutate(usage_ccf = ifelse(is.na(usage_ccf), customer_usage, usage_ccf)) %>%
     mutate(usage_ccf = ifelse(is.na(usage_ccf), rate_code_usage, usage_ccf)) %>%
     dplyr::select(usage_month, cust_id, usage_ccf) %>%
     distinct(cust_id, usage_month, .keep_all=TRUE)
diff --git a/R/make_plots.R b/R/make_plots.R
@@ -54,8 +54,8 @@ plot_revenue_over_time <- function(data, display_type){
     monthly_usage <- data %>%  group_by(usage_date) %>%  
       summarise(hypothetical_usage=sum(hypothetical_usage, na.rm=TRUE),
                 baseline_usage=sum(baseline_usage, na.rm=TRUE)) %>% 
-      mutate(Baseline = baseline_usage/1000000) %>%
-      mutate(Hypothetical = hypothetical_usage/1000000) %>%
+      mutate(Baseline = baseline_usage*af_conversion/1000) %>%
+      mutate(Hypothetical = hypothetical_usage*af_conversion/1000) %>%
       select(usage_date,Baseline,Hypothetical)
     monthly_usage <- melt(monthly_usage, id="usage_date") %>% rename(Usage=variable)
     
@@ -71,7 +71,7 @@ plot_revenue_over_time <- function(data, display_type){
       #geom_vline(xintercept=as.numeric(max(df$usage_date)),color='red3',linetype=2) +
       scale_linetype_manual(values = c("Baseline"="dashed", "Hypothetical"="solid")) +
       scale_color_manual(values=c("Baseline"="black", "Hypothetical"="steelblue")) +
-      xlab("") + ylab("Usage (Million ccf)") + 
+      xlab("") + ylab("Usage (Thousand AF)") + 
       # theme(axis.text.x = element_text(angle = 30, hjust = 1)) +
       # scale_x_date(labels = date_format("%m-%y"), date_breaks="1 months") +
       scale_y_continuous(labels = comma)
@@ -130,7 +130,7 @@ plot_bill_change_histogram <- function(data, display_type, bar_type){
       p <- ggplot() + 
         geom_vline(xintercept = 0, color="#CC0000")
       if(bar_type == "Absolute"){
-        p <- p + xlab("Change in total amount used (ccf)")
+        p <- p + xlab(paste("Change in total amount used (",unit_type,")") )
       }else{
         p <- p + xlab("% Change in total amount used")   
       }
@@ -140,7 +140,7 @@ plot_bill_change_histogram <- function(data, display_type, bar_type){
         geom_vline(xintercept = mean(data$changes_in_usage, na.rm=TRUE), color="#CC0000") +
         theme(axis.ticks = element_blank(), axis.text.y = element_blank())
       if(bar_type == "Absolute"){
-        p <- p + xlab("Change in total amount used (ccf)") + ylab("")
+        p <- p + xlab(paste("Change in total amount used (",unit_type,")") ) + ylab("")
       }else{
         p <- p + xlab("% Change in total amount used") + ylab("")   
       }
@@ -217,6 +217,9 @@ plot_barchart_by_tiers <- function(data, display_type, bar_type){
     if(!("TR1" %in% names(data)) || (sum(data$TR1, na.rm=TRUE) == 0 && sum(data$variable_ped_bill, na.rm=TRUE) > 0)){
       data$TR1 <- data$variable_ped_bill
     }
+    if(!("BR1" %in% names(data)) || (sum(data$BR1, na.rm=TRUE) == 0 && sum(data$baseline_variable_bill, na.rm=TRUE) > 0)){
+      data$BR1 <- data$baseline_variable_bill
+    }
     # Select revenue in each tier
     d <- colSums(data %>% select(matches("[B|T]R[0-9]")), na.rm=TRUE)
     d <- tbl_df(data.frame(lapply(d, function(x) t(data.frame(x))))) %>%
@@ -229,8 +232,11 @@ plot_barchart_by_tiers <- function(data, display_type, bar_type){
   }  
   else{
    # flat rates leave TR1 as null so need to populate it 
-   if(!("T1" %in% names(data)) || (sum(data$T1, na.rm=TRUE) == 0 && sum(data$variable_ped_bill, na.rm=TRUE) > 0)){
-     data$X1 <- data$hypothetical_usage
+   if(!("T1" %in% names(data)) || (sum(data$T1, na.rm=TRUE) == 0 && sum(data$hypothetical_usage, na.rm=TRUE) > 0)){
+     data$T1 <- data$hypothetical_usage
+   }
+   if(!("B1" %in% names(data)) || (sum(data$B1, na.rm=TRUE) == 0 && sum(data$baseline_usage, na.rm=TRUE) > 0)){
+     data$B1 <- data$baseline_usage
    }
    # Select usage in each tier
    d <- colSums(data %>% select(matches("[B|T][0-9]")), na.rm=TRUE)
@@ -239,7 +245,7 @@ plot_barchart_by_tiers <- function(data, display_type, bar_type){
    d <- melt(d, id.vars="id" ) %>% 
      mutate(type=ifelse(grepl("B.*", variable), "Baseline", "Hypothetical"),
             Tier = get_tier_name(variable),
-            value = value*0.00229569/1000)
+            value = value*af_conversion/1000)
    lab_str <- "Usage During Time Period (Thousand AF)"
  }
 
diff --git a/R/utility_code.R b/R/utility_code.R
diff --git a/README.md b/README.md
@@ -19,6 +19,8 @@ It's easy to get the tool running locally using [data](https://data.smgov.net/Pu
 
 3. Clone this repository.
 
+4. Copy the three files in the `smc_example` directory into the `data` directory.
+
 4. Run the Shiny app, either [from the command line](http://shiny.rstudio.com/articles/running.html) or using the "Run App" button from within RStudio.
 
 \**The data provided in this github has been modified by dropping unneeded columns and by renaming others.*
diff --git a/global.R b/global.R
@@ -6,10 +6,18 @@ library(lubridate)
 library(data.table)
 
 #set the utility_code from the config file
-source("R/utility_code.R")
+unit_type <- NULL
+source("data/config.R")
+if(!is.null(unit_type) && unit_type == "kgal"){
+  af_conversion <- 0.00306889
+}else{
+  unit_type <- "ccf"
+  af_conversion <- 0.00229569
+}
+
+
 source("R/helper_fns.R", local=TRUE)
 source("R/make_plots.R", local=TRUE)
-
 source("R/class_graphs.R")
 source("R/rate_inputs.R")
 
@@ -39,11 +47,11 @@ read_data <- function(filename, cust_col, usage_col, month_col, year_col, et_col
     dplyr::mutate(cust_class = as.character(cust_class)) %>%
     dplyr::mutate(water_type = as.character(water_type)) %>%
     dplyr::mutate(meter_size = as.character(meter_size)) %>%
-    dplyr::filter(usage_date < as.Date(less_than_date)) %>%
+    # dplyr::filter(usage_date < as.Date(less_than_date)) %>%
     dplyr::arrange(usage_date, cust_class) %>%
     dplyr::mutate(sort_index=1:nrow(.))
   
-  if(!is.null(et_col)&!is.null(hhsize_col)&!is.null(irr_area_col)){
+  if( all( c(et_col, hhsize_col, irr_area_col) %in% names(data)) ){
     data <- data %>%
       dplyr::rename_(.dots=setNames(list(et_col), "et_amount")) %>%
       dplyr::rename_(.dots=setNames(list(hhsize_col), "hhsize")) %>%
@@ -64,55 +72,21 @@ read_data <- function(filename, cust_col, usage_col, month_col, year_col, et_col
 generated_inputs <- list()
 
 
-owrs_file <- switch(utility_code,
-                    "IRWD"="",
-                    "MNWD"="mnwd.owrs",
-                    "LVMWD"="data/lvmwd_simplified.owrs",
-                    "SMWD"="data/smwd-2017-01-01_simplified.owrs",
-                    "SMC"="data/smc-2017-01-01_simplified.owrs",
-                    "EMWD"="data/emwd_simplified.owrs")
-
+owrs_file <- "data/ratefile.owrs"
 baseline_rate_list <- RateParser::read_owrs_file(owrs_file)
 
-is_budget <- switch(utility_code,
-                    "IRWD"=,
-                    "MNWD"=,
-                    "LVMWD"=,
-                    "EMWD"=,
-                    "SMWD"=TRUE,
-                    "SMC"=FALSE)
-
-less_than_date <- switch(utility_code,
-                         "IRWD"="2017-01-01",
-                         "MNWD"="2017-01-01",
-                         "LVMWD"="2017-01-01",
-                           "SMWD"="2016-01-01",
-                         "SMC"="2017-01-01",
-                         "EMWD"="2017-01-01")
-
-test_file <- switch(utility_code,
-                    "IRWD"="data/irwd_test.csv",
-                    "MNWD"="data/mnwd_sample_revised.csv",
-                    "LVMWD"="data/lvmwd_test2_comm_budgets_monthly.csv",
-                    "SMWD"="data/smwd_test2.csv",
-                    "SMC"="data/smc_test2.csv",
-                    "EMWD"="data/emwd_sample.csv")
+data_file <- "data/data.csv"
 
 
 
 # Read data from file and rename the columns to be compatable with internal calls
-if(is_budget){
-  df <- read_data(test_file, cust_col="cust_loc_id", usage_col="usage_ccf", month_col="usage_month", 
-                  year_col="usage_year", et_col="usage_et_amount", hhsize_col="cust_loc_hhsize", 
-                  irr_area_col="cust_loc_irr_area_sf", cust_class_col= "cust_loc_rate_class", 
-                  rate_code_col = "cust_loc_class_from_utility", water_type_col="cust_loc_water_type",
-                  meter_size_col="cust_loc_meter_size", less_than_date=less_than_date)
-} else{
-  df <- read_data(test_file, cust_col="cust_loc_id", usage_col="usage_ccf", month_col="usage_month", 
-                  year_col="usage_year", cust_class_col= "cust_loc_rate_class", 
-                  rate_code_col = "cust_loc_class_from_utility", water_type_col="cust_loc_water_type",
-                  meter_size_col="cust_loc_meter_size", less_than_date=less_than_date)
-}
+df <- read_data(data_file, cust_col="cust_loc_id", usage_col="usage_ccf", month_col="usage_month", 
+                year_col="usage_year", et_col="usage_et_amount", hhsize_col="cust_loc_hhsize", 
+                irr_area_col="cust_loc_irr_area_sf", cust_class_col= "cust_loc_rate_class", 
+                rate_code_col = "cust_loc_class_from_utility", water_type_col="cust_loc_water_type",
+                meter_size_col="cust_loc_meter_size")
+is_budget <- all( c("et_amount", "hhsize", "irr_area") %in% names(data))
+
 
 #error checking of data
 check_duplicated_rate_codes(df)
diff --git a/server.R b/server.R
@@ -478,7 +478,7 @@ shinyServer(function(input, output, clientData, session) {
 
   
   #******************************************************************
-  # Calculate bills and tiers for the MNWD residential baseline rate
+  # Calculate bills and tiers for the baseline rate
   #******************************************************************
   baseline_bill_info <- reactive({
     baseline(basedata=DF())
diff --git a/smc_example/config.R b/smc_example/config.R
@@ -0,0 +1,2 @@
+
+utility_code <- "SMC"
diff --git a/smc_example/data.csv b/smc_example/data.csv
diff --git a/smc_example/ratefile.owrs b/smc_example/ratefile.owrs
diff --git a/ui.R b/ui.R
@@ -43,7 +43,7 @@ shinyUI(navbarPage(
      fluidRow(
        column(2),
        column(2, h4("Monthly Growth/Decline\n(# of accounts)")),
-       column(2, h4("Estimated Usage per\nNew Account (ccf)"))
+       column(2, h4("Estimated Usage per\nNew Account (# billing units)"))
      ),
  
      lapply(1:length(cust_class_list), function(i) {
