DERDAT 1s duration option (#29)

* Adding_1s_input_option_shiny.R Adding_input_duration_1s in shiny.R * Flag_duration_change_in_criteria change in criteria in "flag_duration_for_updating_if_value_non_standard_and_calced_interval_is_5s" function for the definition of flag duration. * "Adding_1s_input_option_shiny.R" 1s input option is added in shiny.R * remove NAs in UFLS_detection_voltage NAs are removed during the mean voltage calculations. * ignore_downsampling_for_1s_in_ideal_response down-sampling of "ideal response" is ignored while analyzing 1s data because "ideal response" is already with 1s duration. Only column name "time_group" is changes to match with the existing data-frame. * Suggested modification to "Ideal Response Curve" Potential modification for "Ideal Response Curve" is suggested in "Assumptions and Methodology" tab of GUI * Documenting minor discrepancies in the definition of "Reconnection Compliance Status" Minor discrepancies in the definition of "Reconnection Compliance Status" is identified and mentioned in the documentation for future reference. * downsampling "post event response" to 5s during 1s data analysis "post event response" is down-sampled to 5s, only for 1s data analysis, for the definition of "reconnection status". * Typo corrected in "Ideal Response function" * Typo "duration" is corrected * "d" duration is updated from the "reconnection data" * spacing after "if" statement is corrected * remove NAs during minimum and maximum f and v calculations * adding if condition for downsampling from 1s to 5s Down-sampling is done for data with 1s duration to 5s for "post_event_response" and the other duration are allowed with the previous "post_event_response" calculations. * fixed indenting * downsampling from 1s to 5s for reconnection Calculation of "post_event_response" is downsampled from 1s to 5s. Test file is created for dwonsampling. * Spacing issue is fixed Spacing in the added lines of codes in "island_assessment_function.R" and "ufls_detection_voltage.R" are resolved. * Changes in documentation_tab regarding "reconnection_compliance_status" * Spacing in "thicken" argument in "ideal_response_function.R" * spacing inside if condition is fixed * tidying unintended changes * tidy up downsampling --------- Co-authored-by: Phoebe <[email protected]>
UNSW-CEEM · Mar 22, 2024 · ea8e6cb · ea8e6cb
1 parent 7456c39
commit ea8e6cb
Show file tree

Hide file tree

Showing 12 changed files with 140 additions and 27 deletions.
diff --git a/db_interface/interface.R b/db_interface/interface.R
@@ -852,7 +852,7 @@ DBInterface <- R6::R6Class(
     flag_duration_for_updating_if_value_non_standard_and_calced_interval_is_5s = function(time_series) {
       time_series <- dplyr::mutate(
         time_series,
-        d_change = ifelse((!d %in% c(5, 30, 60) & (interval == 5)), TRUE, FALSE)
+        d_change = ifelse((!d %in% c(1, 5, 30, 60) & (interval == 5)), TRUE, FALSE)
       )
       return(time_series)
     },

diff --git a/docs/documentation_tab.R b/docs/documentation_tab.R
@@ -140,6 +140,16 @@ documentation_panel <- function() {
         "Categorised as NA if the circuit does not disconnect/drop to zero during the user specified event window."
       )
     ),
+    h4("Minor discrepancies in the definition of 'Reconnection compliance status' "),
+    div(
+      'Minor discrepancies were identified in the algorithm for Reconnection_compliance_status.
+      The determination of Reconnection_compliance_status relies on on the variable Resource_limited_interval. 
+      The calculation of the Resource_limited_interval shows discrepancies for high resolution data (Ex: 1s duration).
+      Significant and abrupt alterations in ramp_rate_change are observed particularly when the resolution is higher 
+      which lead to inaccurate detection of the Resource_limited_interval.
+      As a temporary measure, the data with 1s duration is downsampled to 5s so that the existing algorithm can still be applied. 
+      However, there is a need to refine the algorithm to make it compatible with data of varying resolutions.'
+    ),
     h3("Further methodology notes on a chart basis"),
     h4("Aggregate power chart"),
     div(
@@ -330,7 +340,11 @@ documentation_panel <- function() {
       after updating plots on the main tab, in order to save the manually assigned categories to the manual_compliance
       column in the circuit summary dataset, the update plots step needs to be run again on the main tab. The circuits
       are ordered randomly but with a consistent seed value, so the order will remain consistent."
-    )
+    ),
+    h4("Ideal Reponse Curve"),
+    div("'Ideal Response Curve (Ideal reconnection profile)' illustrates changes over duration. Potential modifications
+    to the code is necessary to align the 'Ideal Response Curve' with the 'reconnection power profile'."
+        )
   )
   return(panel)
 }
diff --git a/ideal_response/ideal_response_functions.R b/ideal_response/ideal_response_functions.R
@@ -72,21 +72,22 @@ norm_p_over_frequency <- function(f, f_ulco, f_upper) {
 }
 
 down_sample_1s <- function(ideal_response_1_s, duration, offset) {
-  ideal_response_1_s <- thicken(
-    ideal_response_1_s,
-    paste(duration, "s"),
-    colname = "time_group",
-    rounding = "up",
-    start_val = offset - as.numeric(duration)
-  )
-  ideal_response_1_s <- thicken(
-    ideal_response_1_s,
-    paste(duration, "s"),
-    colname = "time_group2",
-    rounding = "down",
-    by = "ts",
-    start_val = offset - as.numeric(duration)
-  )
+  if (duration != 1) {   # down-sampling is ignored for 1s data
+    ideal_response_1_s <- thicken(
+      ideal_response_1_s,
+      paste(duration, "s"),
+      colname = "time_group",
+      rounding = "up",
+      start_val = offset - as.numeric(duration)
+    )
+    ideal_response_1_s <- thicken(
+      ideal_response_1_s,
+      paste(duration, "s"),
+      colname = "time_group2",
+      rounding = "down",
+      by = "ts",
+      start_val = offset - as.numeric(duration)
+    )
   ideal_response_1_s[ideal_response_1_s$ts == ideal_response_1_s$time_group2,]$time_group <-
     ideal_response_1_s[ideal_response_1_s$ts == ideal_response_1_s$time_group2,]$time_group2
   ideal_response_1_s <- ideal_response_1_s %>%
@@ -96,6 +97,12 @@ down_sample_1s <- function(ideal_response_1_s, duration, offset) {
     group_by(time_group) %>%
     summarise(f = last(f), norm_power = mean(norm_power)) %>%
     as.data.frame()
+
+  } else if (duration == 1) {
+      ideal_response_downsampled <- ideal_response_1_s
+      colnames(ideal_response_downsampled)[1] <- "time_group"  # only column name is changed from the ideal response (for 1s data analysis)
+  }
+
   return(ideal_response_downsampled)
 }
 

diff --git a/island_assessment/island_assessment_functions.R b/island_assessment/island_assessment_functions.R
@@ -63,10 +63,10 @@ assess_islands <- function(event_window_data) {
       group_by(c_id, clean) %>%
       summarise(
         response_category = first(response_category),
-        max_f = max(fmax),
-        min_f = min(fmin),
-        max_v = (max(vmax) - 240) / 240,
-        min_v = (240 - min(vmin)) / 240
+        max_f = max(fmax, na.rm = TRUE),
+        min_f = min(fmin, na.rm = TRUE),
+        max_v = (max(vmax, na.rm = TRUE) - 240) / 240,
+        min_v = (240 - min(vmin, na.rm = TRUE)) / 240
       ) %>%
       mutate(island_assessment = ifelse(max_f > 53, "Gateway curtailed", "Undefined")) %>%
       mutate(

diff --git a/load_tool_environment.R b/load_tool_environment.R
@@ -36,6 +36,7 @@ source("reconnect_compliance/calculate_max_ramp_rate.R")
 source("reconnect_compliance/categorise_reconnection_compliance.R")
 source("reconnect_compliance/calculate_ramp_rates.R")
 source("reconnect_compliance/find_first_resource_limited_interval.R")
+source("reconnect_compliance/downsample_for_reconnection.R")
 source("reconnect_compliance/create_reconnection_summary.R")
 source("confidence_intervals/clopper_pearson_binomial_confidence_interval.R")
 source("upscale_disconnections/summarise_disconnections.R")

diff --git a/reconnect_compliance/create_reconnection_summary.R b/reconnect_compliance/create_reconnection_summary.R
@@ -1,22 +1,35 @@
 create_reconnection_summary <- function(combined_data_f,
+                                        duration,
                                         pre_event_interval,
                                         disconnecting_threshold,
                                         reconnect_threshold,
                                         ramp_rate_threshold,
                                         ramp_threshold_for_compliance,
                                         ramp_threshold_for_non_compliance,
                                         ramp_rate_change_resource_limit_threshold) {
-  post_event_response <- select(combined_data_f, ts, c_id, c_id_daily_norm_power, pre_event_norm_power)
+  post_event_response <- select(combined_data_f, ts, c_id, c_id_daily_norm_power, pre_event_norm_power, d)
   post_event_response <- filter(post_event_response, ts > pre_event_interval)
 
+  post_event_response <- post_event_response[order(post_event_response$c_id,post_event_response$ts),]
+
+  # downsample to 5s only during 1s data analysis
+    if (duration == 1) {
+      post_event_response_5s_ds <- downsample_for_reconnection(post_event_response)
+      post_event_response_5s_ds$c_id_daily_norm_power[is.nan(post_event_response_5s_ds$c_id_daily_norm_power)] <- NA
+      post_event_response <- post_event_response_5s_ds
+      post_event_response$d <- 5
+    } else {
+      post_event_response <- post_event_response
+    }
+
   reconnection_times <- calculate_reconnection_times(
     post_event_response,
     event_time = pre_event_interval,
     disconnect_threshold = disconnecting_threshold,
     reconnect_threshold = reconnect_threshold
   )
 
-  ramp_rates <- calculate_ramp_rates(combined_data_f)
+  ramp_rates <- calculate_ramp_rates(post_event_response)
   reconnection_start_times <- find_last_disconnected_intervals(
     post_event_response,
     disconnect_threshold = disconnecting_threshold
@@ -31,7 +44,6 @@ create_reconnection_summary <- function(combined_data_f,
 
   reconnection_data <- inner_join(post_event_response, ramp_rates, by = c("c_id", "ts"))
   reconnection_data <- left_join(reconnection_data, resource_limited_intervals, by = c("c_id"))
-  reconnection_data <- left_join(reconnection_data, select(combined_data_f, c_id, ts, d), by = c("c_id", "ts"))
 
   max_ramp_rates <- calculate_total_ramp_while_exceeding_ramp_rate_compliance_threshold(
     reconnection_data,

diff --git a/reconnect_compliance/downsample_for_reconnection.R b/reconnect_compliance/downsample_for_reconnection.R
@@ -0,0 +1,25 @@
+downsample_for_reconnection <- function(post_event_response) {
+  post_event_response_5s_ds <- post_event_response %>%
+    group_by(c_id) %>%
+    do(downsample_post_event_response(.)) %>%
+    data.frame()
+
+  return(post_event_response_5s_ds)
+}
+
+downsample_post_event_response <- function(post_event_response) {
+  time_intervals <- seq(min(post_event_response$ts), max(post_event_response$ts), by = 5)
+  avg_power <- sapply(time_intervals, function(interval) {
+    mean(post_event_response$c_id_daily_norm_power[post_event_response$ts >= interval &
+                                                   post_event_response$ts < interval + 5],
+         na.rm = TRUE)
+  })
+
+  post_event_response_5S <- data.frame(
+    c_id = unique(post_event_response$c_id)[1],
+    ts = time_intervals,
+    c_id_daily_norm_power = avg_power,
+    pre_event_norm_power = unique(post_event_response$pre_event_norm_power)[1]
+  )
+  return(post_event_response_5S)
+}
diff --git a/reconnect_compliance/tests/test_calculate_downsample.R b/reconnect_compliance/tests/test_calculate_downsample.R
@@ -0,0 +1,49 @@
+testthat::context("Testing downsampling from 1s to 5s for reconnection compliance calculations.")
+
+load_test_df <- function(text) {
+  df <- read.table(text = gsub(" ",  "", text), sep = ",", header = TRUE, stringsAsFactors = FALSE)
+  return(df)
+}
+
+testthat::test_that("Downsampling 1s to 5s works", {
+  post_event_response <- "                 ts, c_id,  c_id_daily_norm_power, pre_event_norm_power, d
+                          2018-01-01 00:01:00,    1,                     NA,                  0.1, 1
+                          2018-01-01 00:01:01,    1,                 0.0020,                  0.1, 1
+                          2018-01-01 00:01:02,    1,                 0.0025,                  0.1, 1
+                          2018-01-01 00:01:03,    1,                 0.0020,                  0.1, 1
+                          2018-01-01 00:01:04,    1,                 0.0021,                  0.1, 1
+                          2018-01-01 00:01:05,    1,                 0.0023,                  0.1, 1
+                          2018-01-01 00:01:06,    1,                 0.0024,                  0.1, 1
+                          2018-01-01 00:01:07,    1,                 0.0023,                  0.1, 1
+                          2018-01-01 00:01:08,    1,                 0.0022,                  0.1, 1
+                          2018-01-01 00:01:09,    1,                 0.0020,                  0.1, 1
+                          2018-01-01 00:01:10,    1,                 0.0023,                  0.1, 1
+                          2018-01-01 00:01:11,    1,                 0.0024,                  0.1, 1
+                          2018-01-01 00:01:12,    1,                 0.0024,                  0.1, 1
+                          2018-01-01 00:01:13,    1,                 0.0022,                  0.1, 1
+                          2018-01-01 00:01:14,    1,                 0.0025,                  0.1, 1
+                          2018-01-01 00:01:15,    1,                 0.0026,                  0.1, 1
+                          2018-01-01 00:01:16,    1,                 0.0030,                  0.1, 1
+                          2018-01-01 00:01:17,    1,                 0.0032,                  0.1, 1
+                          2018-01-01 00:01:19,    1,                 0.0030,                  0.1, 1"
+
+  # first time interval (2018-01-01 00:01:00) to test downsampling with NAs
+  # last time interval (2018-01-01 00:01:15) to test downsampling with a missing time step
+
+  post_event_response <- load_test_df(post_event_response)
+  post_event_response <- dplyr::mutate(post_event_response, ts = as.POSIXct(ts, tz = "Australia/Brisbane"))
+
+  post_event_response_new <- "                 ts, c_id, c_id_daily_norm_power, pre_event_norm_power
+                              2018-01-01 00:01:00,    1,               0.00215,                  0.1
+                              2018-01-01 00:01:05,    1,               0.00224,                  0.1
+                              2018-01-01 00:01:10,    1,               0.00236,                  0.1
+                              2018-01-01 00:01:15,    1,               0.00295,                  0.1"
+
+  post_event_response_new <- load_test_df(post_event_response_new)
+  post_event_response_new <- dplyr::mutate(post_event_response_new, ts = as.POSIXct(ts, tz = "Australia/Brisbane"))
+  post_event_response_new <- post_event_response_new %>% relocate(c_id)
+
+  calculated_downsampled_post_event_response <- downsample_for_reconnection(post_event_response)
+
+  testthat::expect_equal(calculated_downsampled_post_event_response, post_event_response_new, tolerance = 1e-4)
+})
diff --git a/reconnect_compliance/tests/test_create_reconnection_summary.R b/reconnect_compliance/tests/test_create_reconnection_summary.R
@@ -8,7 +8,7 @@ load_test_df <- function(text) {
   return(df)
 }
 
-testthat::test_that("Categorising a circuit with 5s data, and just a breif ramp rate violation works.", {
+testthat::test_that("Categorising a circuit with 5s data, and just a brief ramp rate violation works.", {
   event_time <- as.POSIXct("2018-01-01 00:01:00", tz = "Australia/Brisbane")
 
   ramp_rates <- "                       ts, c_id, d, response_category, c_id_daily_norm_power, pre_event_norm_power
@@ -34,6 +34,7 @@ testthat::test_that("Categorising a circuit with 5s data, and just a breif ramp
 
   calculated_results <- create_reconnection_summary(
     ramp_rates,
+    duration = 5,
     event_time,
     disconnecting_threshold = 0.05,
     reconnect_threshold = 0.95,
@@ -71,6 +72,7 @@ testthat::test_that("Categorising a circuit with 5s data, sustained ramp rate vi
 
   calculated_results <- create_reconnection_summary(
     ramp_rates,
+    duration = 5,
     event_time,
     disconnecting_threshold = 0.05,
     reconnect_threshold = 0.95,
@@ -108,6 +110,7 @@ testthat::test_that("Categorising a circuit with 60s data, no ramp rate violatio
 
   calculated_results <- create_reconnection_summary(
     ramp_rates,
+    duration = 60,
     event_time,
     disconnecting_threshold = 0.05,
     reconnect_threshold = 0.95,
@@ -145,6 +148,7 @@ testthat::test_that("Categorising a circuit with 5s data, sustained ramp rate vi
 
   calculated_results <- create_reconnection_summary(
     ramp_rates,
+    duration = 60,
     event_time,
     disconnecting_threshold = 0.05,
     reconnect_threshold = 0.95,

diff --git a/run_analysis/run_analysis.R b/run_analysis/run_analysis.R
@@ -505,6 +505,7 @@ run_analysis <- function(data, settings) {
       event_window_data <- filter(combined_data_f, ts > settings$pre_event_interval - d)
       reconnection_categories <- create_reconnection_summary(
         event_window_data,
+        settings$duration,
         settings$pre_event_interval,
         settings$disconnecting_threshold,
         reconnect_threshold = settings$reconnection_threshold,

diff --git a/shiny.R b/shiny.R
@@ -436,7 +436,7 @@ server <- function(input, output, session) {
   # Create radio button dyamically so label can be updated
   output$duration <- renderUI({
     radioButtons("duration", label = strong("Sampled duration (seconds), select one."),
-    choices = list("5", "30", "60"),
+    choices = list("1","5", "30", "60"),
     selected = "60",
     inline = TRUE)
   })

diff --git a/ufls_detection/ufls_detection_voltage.R b/ufls_detection/ufls_detection_voltage.R
@@ -38,6 +38,6 @@ ufls_detection_voltage <- function(combined_data,
 calc_average_voltage_per_circuit <- function(ts_data) {
   ts_data <- group_by(ts_data, c_id)
   ts_data <- mutate(ts_data, v = as.numeric(v))
-  ts_data <- data.frame(summarise(ts_data, v_mean = mean(v)))
+  ts_data <- data.frame(summarise(ts_data, v_mean = mean(v, na.rm = TRUE)))
   return(ts_data)
 }