Skip to content

Commit

Permalink
yay dynamic UI for maps no more error loading messages
Browse files Browse the repository at this point in the history
  • Loading branch information
@emmamendelsohn
emmamendelsohn committed Jan 5, 2024
1 parent c6e6991 commit 459a238
Showing 1 changed file with 107 additions and 79 deletions.
186 changes: 107 additions & 79 deletions scripts/eda/app.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -130,93 +130,96 @@ ui <- fluidPage(
animate = TRUE)), # animationOptions to set faster but data load cant keep up
),

mainPanel(
uiOutput("maps")
)

## Maps
### Recorded
conditionalPanel(
condition = "input.selected_dataset == 'ndvi' || input.selected_dataset == 'temperature' || input.selected_dataset == 'precipitation' || input.selected_dataset == 'relative_humidity'",

fluidRow(
#### 30 days
column(4,
tags$h5("1-30 days previous"),
leaflet::leafletOutput("anomalies_map_recorded_30")
),
#### 60 days
column(4,
tags$h5("31-60 days previous"),
leaflet::leafletOutput("anomalies_map_recorded_60")
),
#### 90 days
column(4,
tags$h5("61-90 days previous"),
leaflet::leafletOutput("anomalies_map_recorded_90")
)
)
),
# conditionalPanel(
# condition = "input.selected_dataset == 'ndvi' || input.selected_dataset == 'temperature' || input.selected_dataset == 'precipitation' || input.selected_dataset == 'relative_humidity'",
#
# fluidRow(
# #### 30 days
# column(4,
# tags$h5("1-30 days previous"),
# leaflet::leafletOutput("anomalies_map_recorded_30")
# ),
# #### 60 days
# column(4,
# tags$h5("31-60 days previous"),
# leaflet::leafletOutput("anomalies_map_recorded_60")
# ),
# #### 90 days
# column(4,
# tags$h5("61-90 days previous"),
# leaflet::leafletOutput("anomalies_map_recorded_90")
# )
# )
# ),

## Maps
### Recorded
conditionalPanel(
condition = "input.selected_dataset == 'temperature_forecast' || input.selected_dataset == 'precipitation_forecast' || input.selected_dataset == 'relative_humidity_forecast'",
fluidRow(
#### 29 days
column(3,
tags$h5("0-29 day forecast"),
leaflet::leafletOutput("anomalies_map_forecast_29")
),
#### 59 days
column(3,
tags$h5("30-59 day forecast"),
leaflet::leafletOutput("anomalies_map_forecast_59")
),
#### 89 days
column(3,
tags$h5("60-89 day forecast"),
leaflet::leafletOutput("anomalies_map_forecast_89")
),
#### 119 days
column(3,
tags$h5("90-119 day forecast"),
leaflet::leafletOutput("anomalies_map_forecast_119")
),
#### 149 days
column(3,
tags$h5("120-149 day forecast"),
leaflet::leafletOutput("anomalies_map_forecast_149")

)
)
)
# conditionalPanel(
# condition = "input.selected_dataset == 'temperature_forecast' || input.selected_dataset == 'precipitation_forecast' || input.selected_dataset == 'relative_humidity_forecast'",
# fluidRow(
# #### 29 days
# column(3,
# tags$h5("0-29 day forecast"),
# leaflet::leafletOutput("anomalies_map_forecast_29")
# ),
# #### 59 days
# column(3,
# tags$h5("30-59 day forecast"),
# leaflet::leafletOutput("anomalies_map_forecast_59")
# ),
# #### 89 days
# column(3,
# tags$h5("60-89 day forecast"),
# leaflet::leafletOutput("anomalies_map_forecast_89")
# ),
# #### 119 days
# column(3,
# tags$h5("90-119 day forecast"),
# leaflet::leafletOutput("anomalies_map_forecast_119")
# ),
# #### 149 days
# column(3,
# tags$h5("120-149 day forecast"),
# leaflet::leafletOutput("anomalies_map_forecast_149")
#
# )
# )
# )
)

# server ----------------------------------------------------------------------
server <- function(input, output, session) {

# TODO add explanatory text
# TODO allow user to select the days viewing (check boxes)
# TODO check forecast colors
# TODO shiny spinner only when switching tabs
# TODO create comparison tab (this might require targets to compare same exact dates)
# TODO scaled option?

# Update input options based on user selection
observeEvent(input$data_options, {
if (input$data_options == "recorded_data") {
dataset_choices <- c("NDVI" = "ndvi",
"Temperature" = "temperature",
"Precipitation" = "precipitation",
"Relative Humidity" = "relative_humidity")
"Temperature" = "temperature",
"Precipitation" = "precipitation",
"Relative Humidity" = "relative_humidity")
period_choices <- c("1-30" = 30, "31-60" = 60, "61-90" = 90)
} else if (input$data_options %in% c("forecast_data", "comparison")) {
dataset_choices <- c("Temperature" = "temperature_forecast",
"Precipitation" = "precipitation_forecast",
"Relative Humidity" = "relative_humidity_forecast")
"Precipitation" = "precipitation_forecast",
"Relative Humidity" = "relative_humidity_forecast")
period_choices <- c("0-29" = 29, "30-59" = 59, "60-89" = 89, "90-119" = 119, "120-149" = 149)
}
updateRadioButtons(session, "selected_dataset", choices = dataset_choices, inline = FALSE)
updateCheckboxGroupInput(session, "selected_period", choices = period_choices, selected = period_choices)
})

})

# Connection to data
conn <- reactive({
if(input$data_options %in% c("recorded_data", "forecast_data")){
arrow::open_dataset(augmented_data) |>
Expand All @@ -227,43 +230,68 @@ server <- function(input, output, session) {
}
})

# Range of values for maps
dom <- reactive({
get(glue::glue("dom_{stringr::str_remove(input$selected_dataset, '_forecast')}"))
})

# Palettes for maps
pal <- reactive({
get(glue::glue("pal_{stringr::str_remove(input$selected_dataset, '_forecast')}_anomalies"))
})

render_arrow_leaflet <- function(map_type, day, include_legend) {

output_id <- glue::glue("anomalies_map_{map_type}_{day}")

output[[output_id]] <- renderLeaflet({

shiny::req(conn(), pal(), dom())

# Render the maps
output$maps <- renderUI({
maps <- lapply(input$selected_period, function(i) {

create_arrow_leaflet(
conn = conn(),
field = paste0("anomaly_", input$selected_dataset, "_", day),
field = paste0("anomaly_", input$selected_dataset, "_", i),
selected_date = input$selected_date,
palette = pal(),
domain = dom(),
include_legend = include_legend
include_legend = TRUE
)
})
}
do.call(tagList, maps)
})

# render_arrow_leaflet <- function(map_type, day, include_legend) {
#
# output_id <- glue::glue("anomalies_map_{map_type}_{day}")
#
# output[[output_id]] <- renderLeaflet({
#
# shiny::req(conn(), pal(), dom())
#
# create_arrow_leaflet(
# conn = conn(),
# field = paste0("anomaly_", input$selected_dataset, "_", day),
# selected_date = input$selected_date,
# palette = pal(),
# domain = dom(),
# include_legend = include_legend
# )
# })
# }

# DO THIS DYNAMICALLY FOR PERIODS IN selected_period
# this can be in UI
# mainPanel(
# uiOutput("maps")
# )

# do the below as part of renderUI

render_arrow_leaflet(map_type = "recorded", day = "30", include_legend = TRUE)
render_arrow_leaflet(map_type = "recorded", day = "60", include_legend = FALSE)
render_arrow_leaflet(map_type = "recorded", day = "90", include_legend = FALSE)
render_arrow_leaflet(map_type = "forecast", day = "29", include_legend = TRUE)
render_arrow_leaflet(map_type = "forecast", day = "59", include_legend = FALSE)
render_arrow_leaflet(map_type = "forecast", day = "89", include_legend = FALSE)
render_arrow_leaflet(map_type = "forecast", day = "119", include_legend = FALSE)
render_arrow_leaflet(map_type = "forecast", day = "149", include_legend = FALSE)
# render_arrow_leaflet(map_type = "recorded", day = "30", include_legend = TRUE)
# render_arrow_leaflet(map_type = "recorded", day = "60", include_legend = FALSE)
# render_arrow_leaflet(map_type = "recorded", day = "90", include_legend = FALSE)
# render_arrow_leaflet(map_type = "forecast", day = "29", include_legend = TRUE)
# render_arrow_leaflet(map_type = "forecast", day = "59", include_legend = FALSE)
# render_arrow_leaflet(map_type = "forecast", day = "89", include_legend = FALSE)
# render_arrow_leaflet(map_type = "forecast", day = "119", include_legend = FALSE)
# render_arrow_leaflet(map_type = "forecast", day = "149", include_legend = FALSE)

}

Expand Down

0 comments on commit 459a238

Please sign in to comment.