From a98cb9ecb21154b1b182577ac82711d70f2389b4 Mon Sep 17 00:00:00 2001 From: Christian Christiansen Date: Wed, 24 Jan 2024 10:26:03 +0000 Subject: [PATCH] Include downloadable KML of map (#30) Include functionality to allow download of spatial circuit data as a KML file. Changes include: including button to download KML file updating all buttons in the GUI to make them more legible/useful adding documentation to documentation tab additional out_of_tool_processing tool to create voltage label KMLs from CSVs. --------- Co-authored-by: Phoebe <53634732+phoebeheywood@users.noreply.github.com> --- docs/documentation_tab.R | 6 + export/export_kml.R | 721 ++++++++++++++++++ load_tool_environment.R | 2 + out_of_tool_processing/create_voltage_kml.R | 157 ++++ out_of_tool_processing/run_tests.R | 3 + .../tests/test_create_voltage_kml.R | 133 ++++ out_of_tool_processing/tests/voltage.csv | 3 + run_all_tests.R | 1 + shiny.R | 39 +- 9 files changed, 1058 insertions(+), 7 deletions(-) create mode 100644 export/export_kml.R create mode 100644 out_of_tool_processing/create_voltage_kml.R create mode 100644 out_of_tool_processing/run_tests.R create mode 100644 out_of_tool_processing/tests/test_create_voltage_kml.R create mode 100644 out_of_tool_processing/tests/voltage.csv diff --git a/docs/documentation_tab.R b/docs/documentation_tab.R index 0a882eaf..28c2fbb7 100644 --- a/docs/documentation_tab.R +++ b/docs/documentation_tab.R @@ -230,6 +230,12 @@ documentation_panel <- function() { Cleaned data is dispalyed if available else raw data is used. Be aware that the density of dots does not represent the density of pv systems, rather it represents the density of postcodes." ), + div( + "The chart is also available as a KML file, which can be imported into mapping programs (such as Google Earth). + A copy of the power lines data can be found here + (https://digital.atlas.gov.au/datasets/digitalatlas::electricity-transmission-lines/about). + To add voltage labels, follow the instructions in out_of_tool_processing/create_voltage_kml.R" + ), h4("Circuit count table"), div( "This table shows the number of circuits in each combination of the user specified grouping variables. Note for diff --git a/export/export_kml.R b/export/export_kml.R new file mode 100644 index 00000000..83262f33 --- /dev/null +++ b/export/export_kml.R @@ -0,0 +1,721 @@ +#' Create a Keyhole Markup Language (KML) export of circuits to import to other mapping solutions +#' +#' Points and shapes in KMLs are rendered from top to bottom in Google Earth. So features which should be rendered last +#' (i.e. on top of other elements) should be at the bottom of the file. +#' +#' Other resources +#' =============== +#' For more documentation on KML, see Google's documentation: https://developers.google.com/kml/documentation/kml_tut +#' For other possible icons to use, see http://kml4earth.appspot.com/icons.html +export_kml <- function(map_data, + event_longitude, + event_latitude, + zone_one_radius, + zone_two_radius, + zone_three_radius, + scaling = TRUE) { + # TODO: Add in UFLS detection? + + # Each KML file has to open with the following header. + # Document tag is needed because there can only be one parent element. + # The styles are currently hardcoded in. Colours are defined by aabbggrr where a: alpha, b: blue, g: green, r: red. + kml_header <- paste( + c( + "", + "", + " ", + " Postcode disconnections from DERDAT", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " " + ), + collapse = "\n" + ) + + # Create KML for event location. + kml_event_location <- kml_snippet("Event location", event_longitude, event_latitude, "#eventLocation") + + # Create KML for each postcode point. Postcodes are grouped by disconnection percentages. + grouped_circuit_data <- group_by_percentage_disconnect(map_data, scaling) + grouped_circuit_data_list <- split(grouped_circuit_data, grouped_circuit_data$percentage_bins) + kml_circuits <- kml_for_grouped_circuits(grouped_circuit_data_list) + + # Add concentric circles. + kml_circles <- paste( + kml_circle("zone 1", event_longitude, event_latitude, zone_one_radius), + kml_circle("zone 2", event_longitude, event_latitude, zone_two_radius), + kml_circle("zone 3", event_longitude, event_latitude, zone_three_radius), + sep = "\n" + ) + + # Each KML has to end with the following footer. + kml_footer <- " \n" + kml_output <- paste(c(kml_header, kml_circuits, kml_circles, kml_event_location, kml_footer), collapse = "\n") + return(kml_output) +} + +#' From each row within the map_data row, create KML snippet +#' using its postcode, percentage of disconnections, number of sites, longitude and latitude. +kml_snippet_from_row <- function(row, scaling) { + name <- paste0("Postcode ", row[["s_postcode"]]) + # Change colour depending on percentage of disconnections. + # FIXME: Change colour to go from blue to red instead of orange. + if (row[["num_disconnects"]] == 0) { + urlStylePercentages <- "#noDisconnections" + } else if (row[["num_disconnects"]] == row[["system_count"]]) { + urlStylePercentages <- "#100disconnections" + } else { + # Change the colour depending on the percentage of disconnections. + rounded_percentage <- (floor(as.double(row[["percentage_disconnect"]]) * 10) + 1) * 10 + urlStylePercentages <- paste0("#", rounded_percentage, "disconnections") + } + # Change size depending on number of circuits. + if (isTRUE(scaling)) { + if (as.numeric(row[["system_count"]]) < 3) { + urlStyleSize <- "Tiny" + } else if (as.numeric(row[["system_count"]]) < 6) { + urlStyleSize <- "Small" + } else if (as.numeric(row[["system_count"]]) < 10) { + urlStyleSize <- "Medium" + } else if (as.numeric(row[["system_count"]]) < 15) { + urlStyleSize <- "Big" + } else { + urlStyleSize <- "Huge" + } + } else { + urlStyleSize <- "Medium" + } + styleUrl <- paste0(urlStylePercentages, urlStyleSize) + description <- paste0( + "Postcode: ", + row[["s_postcode"]], + "\nPercentage disconnect: ", + row[["percentage_disconnect"]], + "\nNumber of sites: ", + row[["system_count"]] + ) + kml <- kml_snippet("", row[["lon"]], row[["lat"]], styleUrl, description) + return(kml) +} + +#' Create KML snippet from name, longitude, latitude, styleUrl and description. +kml_snippet <- function(name, lon, lat, styleUrl, description = "") { + snippet <- paste( + c( + " ", + paste0(" ", name, ""), + paste0(" ", description, ""), + paste0(" ", styleUrl, ""), + " ", + paste0(" ", lon, ",", lat, ""), + " ", + " " + ), + collapse = "\n" + ) + return(snippet) +} + +#' Create KML snippet for a circle with longitude, latitude and radius provided. +kml_circle <- function(name, longitude, latitude, radius, colour = "#ffaaaaaa", description = "", width = 2) { + kml_coordinates <- generate_circle_coordinates(longitude, latitude, radius) + circle_kml_snippet <- paste( + c( + " ", + paste0(" ", name, ""), + paste0(" ", description, ""), + " ", + " ", + " 1", + paste0(" ", kml_coordinates, ""), + " ", + " " + ), + collapse = "\n" + ) + return(circle_kml_snippet) +} + +#' Helper function for generating KML circle coordinates. Stitches together the longitude and latitude with a comma. +coord_to_string <- function(row) { + return(paste0(row[["lon"]], ",", row[["lat"]])) +} + +#' Helper function for generating KML circle coordinates. +generate_circle_coordinates <- function(longitude, latitude, radius) { + coordinates <- circle.polygon( + longitude, + latitude, + radius, + sides = 100, + units = "km", + poly.type = "gc.earth", + by.length = FALSE + ) + coordinates <- paste(apply(coordinates, 1, coord_to_string), collapse = " ") + return(coordinates) +} + +#' Takes a number between 0 and 1 and returns 0, 10, 20, ..., 100 depending on in which percentage bin it is in. +#' e.g. 0 -> 0% +#' 0.06 -> 10% +#' 0.61 -> 70% +#' 0.95 -> 100% +calculate_percentage_bin <- function(number) { + return(ceiling(as.double(number) * 10) * 10) +} + +#' Group map data by percentage disconnects (separated into 0%, 10%, 20%, ..., 100% frequency bins). +#' Also creates the column kml_snippet. +group_by_percentage_disconnect <- function(map_data, scaling = TRUE) { + map_data <- map_data %>% + mutate(percentage_bins = calculate_percentage_bin(percentage_disconnect)) %>% + rowwise %>% + do({ + result <- as_tibble(.) + result$kml_snippet <- kml_snippet_from_row(result, scaling) + result + }) %>% + group_by(percentage_bins) + return(map_data) +} + +#' Create KML for groups of circuits. Create a folder for each 10% percentage disconnect interval, +#' i.e. no disconnects, 10% disconnects, 20% disconnects, ..., 90% disconnects, 100% disconnects. +#' By putting each group into its own folder, we can easily hide/show the group in Google Earth. +kml_for_grouped_circuits <- function(grouped_circuit_data) { + kml <- "" + for (name in names(grouped_circuit_data)) { + if (kml == "") { + kml <- paste( + c( + " ", + paste0(" ", name, "% disconnections"), + paste(grouped_circuit_data[[name]]$kml_snippet, collapse = "\n"), + " " + ), + collapse = "\n" + ) + } else { + kml <- paste( + c( + kml, + " ", + paste0(" ", name, "% disconnections"), + paste(grouped_circuit_data[[name]]$kml_snippet, collapse = "\n"), + " " + ), + collapse = "\n" + ) + } + } + return(kml) +} diff --git a/load_tool_environment.R b/load_tool_environment.R index 560a8059..743f0d28 100644 --- a/load_tool_environment.R +++ b/load_tool_environment.R @@ -46,3 +46,5 @@ source("island_assessment/island_assessment_functions.R") source("load_data/load_data.R") source("run_analysis/run_analysis.R") source("anti_islanding_detection/anti_islanding.R") +source("export/export_kml.R") +source("out_of_tool_processing/create_voltage_kml.R") diff --git a/out_of_tool_processing/create_voltage_kml.R b/out_of_tool_processing/create_voltage_kml.R new file mode 100644 index 00000000..f76f45f7 --- /dev/null +++ b/out_of_tool_processing/create_voltage_kml.R @@ -0,0 +1,157 @@ +library(dplyr) + +## To create a voltage label KML: +## 1. create a CSV file (for an example, see out_of_tool_processing/tests/voltage.csv), +## 2. uncomment out the code at the bottom of this file. + +create_voltage_kml <- function(data) { + kml_header <- paste( + c( + "", + "", + " ", + " Manual pu voltages", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " " + ), + collapse = "\n" + ) + data <- data %>% + rowwise %>% + do({ + result <- as_tibble(.) + result$kml_snippet <- create_placemark_kml( + result$label, + result$voltage, + result$nominal_line_voltage, + result$latitude, + result$longitude + ) + result + }) %>% + select(kml_snippet) %>% + unlist() + kml_body <- paste(data, collapse = "\n") + kml_footer <- " \n" + kml_output <- paste(c(kml_header, kml_body, kml_footer), collapse = "\n") + return(kml_output) +} + +create_placemark_kml <- function(label, voltage, nominal_line_voltage, latitude, longitude) { + placemark_kml <- paste( + c( + " ", + paste0(" ", voltage, ""), + paste0(" ", label, ""), + paste0(" #", nominal_line_voltage, ""), + " ", + paste0(" ", longitude, ",", latitude, ""), + " ", + " " + ), + collapse = "\n" + ) + return(placemark_kml) +} + +## ## Code to uncomment +## data <- read.csv("voltage.csv", sep = ",") +## output <- create_voltage_kml(data) +## cat(output, file = "output.kml") diff --git a/out_of_tool_processing/run_tests.R b/out_of_tool_processing/run_tests.R new file mode 100644 index 00000000..eecac08f --- /dev/null +++ b/out_of_tool_processing/run_tests.R @@ -0,0 +1,3 @@ +library(testthat) +source("out_of_tool_processing/create_voltage_kml.R") +testthat::test_dir("out_of_tool_processing/tests") diff --git a/out_of_tool_processing/tests/test_create_voltage_kml.R b/out_of_tool_processing/tests/test_create_voltage_kml.R new file mode 100644 index 00000000..76e6f9b0 --- /dev/null +++ b/out_of_tool_processing/tests/test_create_voltage_kml.R @@ -0,0 +1,133 @@ +testthat::context("Test creating voltage KML function.") + +test_that("Test creating voltage KML", { + data <- read.csv("voltage.csv", sep=",") + expected_result = paste( + c( + "", + "", + " ", + " Manual pu voltages", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " 500", + " Central Label", + " #500kV", + " ", + " 151.29,-33.86", + " ", + " ", + " ", + " 120", + " South West Sydney", + " #120kV", + " ", + " 151.09,-33.96", + " ", + " ", + " ", + "" + ), + collapse="\n" + ) + result <- create_voltage_kml(data) + testthat::expect_equivalent(result, expected_result) +}) diff --git a/out_of_tool_processing/tests/voltage.csv b/out_of_tool_processing/tests/voltage.csv new file mode 100644 index 00000000..8f6ecb49 --- /dev/null +++ b/out_of_tool_processing/tests/voltage.csv @@ -0,0 +1,3 @@ +label,voltage,nominal_line_voltage,latitude,longitude +Central Label,500,500kV,-33.86,151.29 +South West Sydney,120,120kV,-33.96,151.09 diff --git a/run_all_tests.R b/run_all_tests.R index 215a77e5..9af50ee1 100644 --- a/run_all_tests.R +++ b/run_all_tests.R @@ -7,6 +7,7 @@ source("load_tool_environment.R") testthat::test_dir("db_interface/tests", stop_on_failure = STOP_ON_FAILURE) testthat::test_dir("island_assessment/tests", stop_on_failure = STOP_ON_FAILURE) testthat::test_dir("location_analysis/tests", stop_on_failure = STOP_ON_FAILURE) +testthat::test_dir("out_of_tool_processing/tests", stop_on_failure = STOP_ON_FAILURE) testthat::test_dir("preprocess_cer_data/tests", stop_on_failure = STOP_ON_FAILURE) testthat::test_dir("process_input_data/tests", stop_on_failure = STOP_ON_FAILURE) testthat::test_dir("reconnect_compliance/tests", stop_on_failure = STOP_ON_FAILURE) diff --git a/shiny.R b/shiny.R index 6f240a9e..c02b5b32 100644 --- a/shiny.R +++ b/shiny.R @@ -165,6 +165,7 @@ ui <- fluidPage( plotlyOutput(outputId = "ZoneCount"), uiOutput("save_zone_count"), plotlyOutput(outputId = "map"), + uiOutput(outputId = "save_circuit_kml"), HTML("

"), dataTableOutput("sample_count_table"), HTML("

"), @@ -402,7 +403,9 @@ reset_sidebar <- function(input, output, session, stringsAsFactors) { output$update_plots <- renderUI({}) } -reset_chart_area <- function(input, output, session, stringsAsFactors) { +reset_chart_area <- function(output) { + #' Clear all of the charts. + #' @param output output$PlotlyTest <- renderPlotly({}) output$save_agg_power <- renderUI({}) output$save_underlying <- renderUI({}) @@ -419,6 +422,7 @@ reset_chart_area <- function(input, output, session, stringsAsFactors) { output$distance_response <- renderPlotly({}) output$save_distance_response <- renderUI({}) output$map <- renderPlotly({}) + output$save_circuit_kml <- renderUI({}) } reset_data_cleaning_tab <- function(input, output, session, stringsAsFactors) { @@ -428,7 +432,7 @@ reset_data_cleaning_tab <- function(input, output, session, stringsAsFactors) { } -server <- function(input,output,session) { +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."), @@ -1236,7 +1240,7 @@ server <- function(input,output,session) { ) }) output$save_response_count <- renderUI({ - shinySaveButton("save_response_count", "Save data", "Save file as ...", filetype = list(xlsx = "csv")) + shinySaveButton("save_response_count", "Save response count data", "Save file as ...", filetype = list(xlsx = "csv")) }) output$ZoneCount <- renderPlotly({ @@ -1254,7 +1258,7 @@ server <- function(input,output,session) { ) }) output$save_zone_count <- renderUI({ - shinySaveButton("save_zone_count", "Save data", "Save file as ...", filetype = list(xlsx = "csv")) + shinySaveButton("save_zone_count", "Save zone response data", "Save file as ...", filetype = list(xlsx = "csv")) }) if (dim(v$frequency_data)[1] > 0) { output$Frequency <- renderPlotly({ @@ -1288,7 +1292,7 @@ server <- function(input,output,session) { ) }) output$save_distance_response <- renderUI({ - shinySaveButton("save_distance_response", "Save data", "Save file as ...", filetype = list(xlsx = "csv")) + shinySaveButton("save_distance_response", "Save cumulative distance response data", "Save file as ...", filetype = list(xlsx = "csv")) }) z1 <- data.frame( circle.polygon( @@ -1373,6 +1377,9 @@ server <- function(input,output,session) { ) ) }) + output$save_circuit_kml <- renderUI({ + shinySaveButton("save_circuit_kml", "Save map overlay for Google Earth", "Save file as ...", filetype = list(kml = "kml")) + }) output$compliance_cleaned_or_raw <- renderUI({ radioButtons( @@ -1395,7 +1402,7 @@ server <- function(input,output,session) { } else { # If there is no data left after filtering, alert the user and create an empty plot. shinyalert("Oops", "There is no data to plot") - reset_chart_area(input, output, session) + reset_chart_area(output) removeNotification(id) } } else { @@ -1403,7 +1410,7 @@ server <- function(input,output,session) { "Wow", "You are trying to plot more than 1000 series, maybe try narrowing down those filters and agg settings." ) - reset_chart_area(input, output, session) + reset_chart_area(output) removeNotification(id) } logdebug("Update plots completed", logger = app_logger) @@ -1727,6 +1734,24 @@ server <- function(input,output,session) { } }) + # Save spatial data on circuit responses + observeEvent(input$save_circuit_kml, { + volumes <- c(home = getwd()) + shinyFileSave(input, "save_circuit_kml", roots = volumes, session = session) + fileinfo <- parseSavePath(volumes, input$save_circuit_kml) + if (nrow(fileinfo) > 0) { + kml_output <- export_kml( + v$geo_data, + event_longitude(), + event_latitude(), + zone_one_radius(), + zone_two_radius(), + zone_three_radius() + ) + write(kml_output, file = as.character(fileinfo$datapath)) + } + }) + # Save ideal response curve observeEvent(input$save_ideal_response, { volumes <- c(home = getwd())