diff --git a/app/app/view/main_map/interactive_plot.R b/app/app/view/main_map/interactive_plot.R new file mode 100644 index 0000000..f0c48ec --- /dev/null +++ b/app/app/view/main_map/interactive_plot.R @@ -0,0 +1,62 @@ +box::use( + bslib, + shiny, + ggplot2, +) + + +#' @export +interactive_plot_ui <- function(id) { + ns <- shiny$NS(id) + shiny$absolutePanel( + id = "plot_panel", + class = "panel panel-default", + fixed = TRUE, + draggable = FALSE, + top = 170, + left = 50, + right = "auto", + bottom = "auto", + width = 120, + height = 50, + shiny$checkboxInput( + ns("show_plot_checkbox"), + shiny$HTML("Show plot"), + value = TRUE + ), + shiny$uiOutput(ns("plot_ui")) + ) +} + +#' @export +interactive_plot_server <- function(id, d_poly) { + shiny$moduleServer(id, function(input, output, session) { + ns <- session$ns + output$plot_ui <- shiny$renderUI({ + if (!input$show_plot_checkbox) { + return() + } + + + shiny$plotOutput( + ns("interactive_plot"), + width = 500, height = 400 + # click = "plot_click", + # brush = shiny$brushOpts("plot_brush") + ) + }) + + output$interactive_plot <- shiny$renderPlot({ + shiny$req(d_poly()) + cat(names(d_poly()$data)) + + + rehab_var <- ifelse(d_poly()$outcome == "rehab", "selected_col", "value_rehab") + acute_var <- ifelse(d_poly()$outcome == "acute", "selected_col", "value_acute") + + d_poly()$data |> + ggplot2$ggplot(ggplot2$aes(x = get(rehab_var), y = get(acute_var))) + + ggplot2$geom_point() + }) + }) +} diff --git a/app/app/view/main_map/page.R b/app/app/view/main_map/page.R index 8f95de7..b9ec78c 100644 --- a/app/app/view/main_map/page.R +++ b/app/app/view/main_map/page.R @@ -1,18 +1,20 @@ # main_map page box::use( - shiny, bslib, - leaflet, - sf, - leafgl, dplyr, + ggplot2, + leafgl, + leaflet, + shiny, shinyWidgets, + sf, ) box::use( # mapping module - might change this to rdeck if it's possible - they will need to have # all the same functions in both modules so making generic names like "create map" and "update map" with generic inputs etc mm = app / mapping, + app / view / main_map / interactive_plot, app / view / main_map / make_top_cards, app / logic / load_shapes, app / logic / wrangle_data, @@ -26,7 +28,8 @@ ui <- function(id) { bslib$card( height = "calc(100vh - 100px)", mm$mapOutput(ns("map")), - make_top_cards$make_controls_ui(ns = ns) + make_top_cards$make_controls_ui(ns = ns), + interactive_plot$interactive_plot_ui(id = ns("plot")) ) ) ) @@ -48,6 +51,7 @@ server <- function(id) { ) d_poly <- shiny$reactive({ + # these inputs are from the controls wrangle_data$get_poly_selection( layer_selection = input$layer_selection, seifa = input$seifa, @@ -56,6 +60,7 @@ server <- function(id) { ) }) + interactive_plot$interactive_plot_server(id = "plot", d_poly = d_poly) shiny$observeEvent(list(proxymap(), d_poly(), input$layer_selection), { mm$update_map_shapes( @@ -68,8 +73,6 @@ server <- function(id) { shiny$observe({ - # TODO: reactively update the proxy_map() markers - # - probably worth making some function to clean the name as I have mm$update_map_markers( proxy_map = proxymap(), markers = input$base_layers @@ -77,5 +80,7 @@ server <- function(id) { }) }) + + make_top_cards$make_controls_server(id) }