fsotoj/spp_v3
0
1server <- function(input, output, session) {2 # ==== 0.1) END POINT =======================================3 send_ga_event <- function(client_id, event_name, params = list()) {4 secret <- Sys.getenv("ZKNkvKGbTV6504car3fmFw")5 mid <- Sys.getenv("G-2D6B3PWVGG")6 7 url <- paste0(8 "https://www.google-analytics.com/mp/collect",9 "?measurement_id=", mid,10 "&api_secret=", secret11 )12 13 body <- list(14 client_id = client_id,15 events = list(16 list(name = event_name, params = params)17 )18 )19 20 request(url) %>%21 req_body_json(body) %>%22 req_perform()23 }24 25 26 pr <- plumber::pr()27 28 pr$handle("POST", "/ga", function(req, res) {29 body <- jsonlite::fromJSON(req$postBody)30 send_ga_event(body)31 return("ok")32 })33 34 session$registerDataObj("ga_proxy", pr, filter = "plumber")35 36 # print(session$getTestEndpointUrl("ga_proxy"))37 38 39 # ==== 0) BLOCKER FOR MAP- CAMERA SYNCRO =======================================40 41 is_navigating <- reactiveVal(FALSE)42 43 # ==== 0) CONSTANTS / INITIALIZATION =======================================44 current_tab <- reactiveVal("map_tab")45 46 map_saved_year <- reactiveVal("2005")47 48 observeEvent(input$tabs, {49 current_tab(input$tabs)50 })51 52 53 # Initialize Fancytree with default selection54 observeEvent(session, {55 fancytree_states_json <- get_fancytree_data_states(data)56 57 session$sendCustomMessage(58 "fancytree_states_data",59 list(60 # IMPORTANT: keep nested lists, NOT data.frame61 data = jsonlite::fromJSON(fancytree_states_json, simplifyVector = FALSE),62 default_selected = c(63 "ARGENTINA-CAPITAL FEDERAL",64 "BRAZIL-DISTRITO FEDERAL",65 "MEXICO-CDMX"66 )67 )68 )69 })70 71 72 ## fancy tree map73 74 observeEvent(session, {75 fancytree_json_vars <- get_fancytree_data_vars(76 dict %>%77 filter(viewable_map == 1, variable != "chamber_sub_leg")78 )79 80 session$sendCustomMessage(81 "fancytree_vars_data",82 list(83 data = jsonlite::fromJSON(fancytree_json_vars, simplifyVector = FALSE),84 default_selected = list("Executive Elections-Valid Votes")85 )86 )87 })88 89 90 ## fancy tree graph91 observeEvent(session, {92 fancytree_json_vars_graph <- get_fancytree_data_vars(93 dict %>%94 filter(viewable_graph == 1, variable != "chamber_sub_leg"),95 FALSE96 )97 98 session$sendCustomMessage(99 "fancytree_vars_data_graph",100 list(101 data = jsonlite::fromJSON(fancytree_json_vars_graph, simplifyVector = FALSE),102 default_selected = list("Executive Elections-Valid Votes")103 )104 )105 })106 107 108 #109 110 # ==== 1) GLOBAL REACTIVES ==================================================111 112 observeEvent(input$year_sel, {113 req(input$year_sel) # Ensure it's not NULL114 map_saved_year(as.character(input$year_sel))115 })116 117 # -- 1.0) states JSTree graph ----------------------118 119 selected_states_vector <- reactive({120 x <- input$selected_nodes_states121 if (is.null(x) || x == "" || x == "[]") {122 return(character(0))123 }124 125 # Fancytree sends: "COUNTRY-STATE"126 ids <- jsonlite::fromJSON(x)127 128 # Ensure vector129 if (!length(ids)) {130 return(character(0))131 }132 133 # Only state nodes contain "-" (countries do not)134 state_ids <- ids[grepl("-", ids)]135 136 # Extract the state part after "-"137 sapply(strsplit(state_ids, "-", fixed = TRUE), function(x) x[2])138 })139 140 141 selected_vars_vector <- reactive({142 x <- input$selected_nodes_vars2143 if (is.null(x) || x == "") {144 return(NULL)145 }146 147 # Fancytree sends a simple string (not a JSON array), so no fromJSON148 key <- x149 parts <- strsplit(key, "-", fixed = TRUE)[[1]]150 151 # Check SLED structure152 if (identical(parts[1], "Legislative Elections") &&153 length(parts) >= 3 &&154 parts[2] %in% c("Lower Chamber", "Upper Chamber")) {155 chamber <- parts[2]156 n_chamber <- ifelse(chamber == "Lower Chamber", 1, 2)157 158 pretty <- paste(parts[3:length(parts)], collapse = "-")159 160 dict %>%161 filter(pretty_name == pretty) %>%162 pull(variable) %>%163 paste0("_", n_chamber)164 } else {165 # Generic format: DATASET-Pretty Name166 pretty <- paste(parts[2:length(parts)], collapse = "-")167 168 dict %>%169 filter(pretty_name == pretty) %>%170 pull(variable)171 }172 })173 174 175 selected_vars_vector_graph <- reactive({176 key <- input$selected_nodes_vars_graph2177 if (is.null(key) || key == "") {178 return(NULL)179 }180 181 parts <- strsplit(key, "-", fixed = TRUE)[[1]]182 183 184 if (identical(parts[1], "Legislative Elections") &&185 length(parts) >= 3 &&186 parts[2] %in% c("Lower Chamber", "Upper Chamber")) {187 n_chamber <- dplyr::case_when(188 parts[2] == "Lower Chamber" ~ 1,189 parts[2] == "Upper Chamber" ~ 2190 )191 192 pretty <- paste(parts[3:length(parts)], collapse = "-")193 194 base_var <- dict %>%195 dplyr::filter(pretty_name == pretty) %>%196 dplyr::pull(variable)197 198 return(paste0(base_var, "_", n_chamber))199 }200 201 pretty <- paste(parts[2:length(parts)], collapse = "-")202 203 dict %>%204 dplyr::filter(pretty_name == pretty) %>%205 dplyr::pull(variable)206 })207 208 209 # -- 1.0) DATA MAP ---------------------210 data_map <- reactive({211 req(input$country_sel, input$year_sel)212 geom_filtered <- geom %>% dplyr::filter(country_name == input$country_sel)213 data_filtered <- data %>% dplyr::filter(country_name == input$country_sel, year == input$year_sel)214 dplyr::left_join(geom_filtered, data_filtered, by = "country_state_code")215 })216 217 218 # ==== 1.3) CAMERA TAB SELECTORS (SLED-driven) ==============================219 # UI renderers (camera-only)220 output$country_selector_camera <- renderUI({221 # Get all available countries222 choices <- sort(unique(SLED$country_name))223 224 # 1. Check if we are Navigating (Priority 1)225 if (isTRUE(is_navigating()) && !is.null(input$switch_to_camera$country)) {226 sel <- input$switch_to_camera$country227 } else {228 # 2. If NOT navigating, try to keep the CURRENT selection (Priority 2)229 # We use isolate() to peek at the value without triggering a re-render loop230 current_val <- isolate(input$country_sel_camera)231 232 if (!is.null(current_val) && current_val %in% choices) {233 sel <- current_val234 } else {235 # 3. Fallback to default (Priority 3)236 sel <- "BRAZIL"237 }238 }239 240 selectInput(241 "country_sel_camera", "Country",242 choices = choices,243 selected = sel244 )245 })246 247 output$state_selector_camera <- renderUI({248 req(input$country_sel_camera)249 250 # Get choices for the current country251 choices_vals <- SLED |>252 dplyr::filter(country_name == input$country_sel_camera) |>253 dplyr::pull(state_name) |>254 unique() |>255 sort()256 257 # Create labels258 choices_labs <- stringr::str_to_title(choices_vals)259 names(choices_vals) <- choices_labs260 261 # LOGIC TO DETERMINE SELECTION262 if (isTRUE(is_navigating()) && !is.null(input$switch_to_camera$state)) {263 # Case A: Navigating -> Use the target state264 sel <- input$switch_to_camera$state265 } else {266 # Case B: Standard interaction267 # First, check if there is ALREADY a valid selection in the box268 current_val <- isolate(input$state_sel_camera)269 270 if (!is.null(current_val) && current_val %in% choices_vals) {271 # Keep the current state (this preserves the state set during navigation)272 sel <- current_val273 } else {274 # Fallback to default (18th state) only if nothing valid is selected275 sel <- if (length(choices_vals)) {276 choices_vals[[min(18, length(choices_vals))]]277 } else {278 NULL279 }280 }281 }282 283 selectInput(284 inputId = "state_sel_camera",285 label = "State",286 choices = choices_vals,287 selected = sel288 )289 })290 291 292 # Year scoping helpers (camera)293 sled_years_scoped_camera <- reactive({294 df <- SLED295 296 # country filter297 if (!is.null(input$country_sel_camera) && nzchar(input$country_sel_camera)) {298 df <- df[df$country_name == input$country_sel_camera, , drop = FALSE]299 }300 301 # state filter302 if (!is.null(input$state_sel_camera) && nzchar(input$state_sel_camera)) {303 df <- df[df$state_name == input$state_sel_camera, , drop = FALSE]304 }305 306 # chamber filter ← THIS WAS MISSING307 # if (!is.null(input$chamber_sel_camera) && nzchar(input$chamber_sel_camera)) {308 # df <- df[df$chamber_election_sub_leg == input$chamber_sel_camera, , drop = FALSE]309 # }310 311 312 sort(unique(df$year))313 })314 315 target_camera_year <- reactiveVal(NULL)316 saved_camera_year <- reactiveVal(NULL) # persists across slider recreation317 318 # Keep saved_camera_year in sync with the actual slider319 observeEvent(input$year_sel_camera,320 {321 saved_camera_year(input$year_sel_camera)322 },323 ignoreInit = TRUE324 )325 326 output$year_selector_camera_ui <- renderUI({327 req(current_tab() == "camera")328 329 # 1. Get available years (This SHOULD stay reactive)330 yrs <- sled_years_scoped_camera()331 req(length(yrs) > 0)332 333 yrs_num <- sort(as.integer(yrs))334 yrs_chr <- as.character(yrs_num)335 336 # 2. Determine selection337 # --- LOGIC SELECTION ---338 nav_target <- isolate(target_camera_year())339 if (!is.null(nav_target)) {340 # CASE A: Navigation target available -> Force the target year341 target <- nav_target342 if (target %in% yrs_chr) {343 sel <- target344 } else {345 # Nearest Lower Logic346 t_int <- as.integer(target)347 lower <- yrs_num[yrs_num <= t_int]348 sel <- if (length(lower) > 0) as.character(max(lower)) else tail(yrs_chr, 1)349 }350 } else {351 # CASE B: Standard interaction (no navigation)352 # Use saved_camera_year which survives slider recreation353 current_val <- isolate(saved_camera_year())354 if (!is.null(current_val) && current_val %in% yrs_chr) {355 sel <- current_val356 } else if (!is.null(current_val)) {357 # Nearest available year to what the user had selected358 t_int <- as.integer(current_val)359 lower <- yrs_num[yrs_num <= t_int]360 sel <- if (length(lower) > 0) as.character(max(lower)) else yrs_chr[1]361 } else {362 sel <- tail(yrs_chr, 1) # Default to last year363 }364 }365 366 # 3. Build the Slider367 shinyWidgets::sliderTextInput(368 inputId = "year_sel_camera",369 label = "Year",370 choices = yrs_chr,371 selected = sel,372 grid = TRUE,373 width = "100%",374 animate = shiny::animationOptions(interval = 1500, loop = FALSE)375 )376 })377 378 379 # Keep chamber selector in sync380 observeEvent(381 list(current_tab(), input$country_sel_camera, input$state_sel_camera),382 {383 req(current_tab() == "camera")384 385 # 1. Setup386 if (is.null(input$chamber_sel_camera)) {387 return()388 }389 ch <- available_chambers_camera()390 391 # If no chambers available (data gap), disable and exit392 if (!length(ch)) {393 shinyjs::disable("chamber_sel_camera")394 updateSelectInput(session, "chamber_sel_camera",395 choices = setNames(numeric(0), character(0)),396 selected = character(0)397 )398 return(invisible(NULL))399 }400 401 shinyjs::enable("chamber_sel_camera")402 choices_named <- .label_chambers(ch)403 404 # 2. Determine Selection405 # Get the current value without creating a dependency406 old_sel <- suppressWarnings(as.integer(isolate(input$chamber_sel_camera)))407 408 # LOGIC:409 # If we are navigating and a specific chamber was requested, use it (Optional feature)410 # Otherwise, try to keep 'old_sel'.411 # If 'old_sel' is not valid for the new state, default to the first available (ch[1]).412 413 target_chamber <- if (isTRUE(is_navigating()) && !is.null(input$switch_to_camera$chamber)) {414 as.integer(input$switch_to_camera$chamber)415 } else {416 NULL417 }418 419 if (!is.null(target_chamber) && target_chamber %in% ch) {420 new_sel <- target_chamber421 } else if (length(old_sel) && !is.na(old_sel) && old_sel %in% ch) {422 new_sel <- old_sel423 } else {424 new_sel <- ch[1]425 }426 427 # 3. Update428 updateSelectInput(session, "chamber_sel_camera",429 choices = choices_named,430 selected = new_sel431 )432 },433 ignoreInit = FALSE434 )435 436 437 # output$chamber_selector_camera <- renderUI({438 # selectInput(439 # "chamber_sel_camera", "Chamber",440 # choices = c("Lower chamber" = 1, "Upper chamber" = 2),441 # selected = 1442 # )443 # })444 445 446 # Available chambers (scoped)447 available_chambers_camera <- reactive({448 df <- SLED449 if (!is.null(input$country_sel_camera) && nzchar(input$country_sel_camera)) {450 df <- df[df$country_name == input$country_sel_camera, , drop = FALSE]451 }452 if (!is.null(input$state_sel_camera) && nzchar(input$state_sel_camera)) {453 df <- df[df$state_name == input$state_sel_camera, , drop = FALSE]454 }455 456 # --- CHANGE START: Commented out the Year filter ---457 # We want to know if a chamber exists *at all* for this state,458 # regardless of the specific year selected.459 460 # if (!is.null(input$year_sel_camera) && nzchar(input$year_sel_camera)) {461 # df <- df[df$year == as.integer(input$year_sel_camera), , drop = FALSE]462 # }463 # --- CHANGE END ---464 465 ch <- sort(unique(suppressWarnings(as.integer(df$chamber_election_sub_leg))))466 ch <- ch[!is.na(ch) & ch %in% c(1L, 2L)]467 ch468 })469 470 .label_chambers <- function(v) {471 labs <- ifelse(v == 1L, "Lower chamber", ifelse(v == 2L, "Upper chamber", as.character(v)))472 stats::setNames(v, labs)473 }474 475 # Keep chamber selector in sync476 # Keep chamber selector in sync477 observeEvent(478 # --- CHANGE: Removed input$year_sel_camera from this list ---479 list(current_tab(), input$country_sel_camera, input$state_sel_camera),480 {481 req(current_tab() == "camera")482 483 # Note: We do NOT need to check input$year_sel_camera here anymore484 485 if (is.null(input$chamber_sel_camera)) {486 return()487 }488 489 ch <- available_chambers_camera()490 491 if (!length(ch)) {492 shinyjs::disable("chamber_sel_camera")493 updateSelectInput(session, "chamber_sel_camera",494 choices = setNames(numeric(0), character(0)),495 selected = character(0)496 )497 return(invisible(NULL))498 }499 500 shinyjs::enable("chamber_sel_camera")501 choices_named <- .label_chambers(ch)502 503 old_sel <- suppressWarnings(as.integer(isolate(input$chamber_sel_camera)))504 505 # Logic: If the previously selected chamber exists in the new list (e.g., Lower), keep it.506 # If not, default to the first available.507 new_sel <- if (length(old_sel) && !is.na(old_sel) && old_sel %in% ch) old_sel else ch[1]508 509 updateSelectInput(session, "chamber_sel_camera",510 choices = choices_named,511 selected = new_sel512 )513 },514 ignoreInit = FALSE515 )516 517 518 # ==== 2) MODALS / MESSAGES ================================================519 520 521 # observe({522 # tab <- current_tab()523 # country <- input$country_sel524 # selvar <- selected_vars_vector()525 #526 # is_legislative <- FALSE527 #528 # if (!is.null(selvar)) {529 #530 # # remove trailing _1 or _2 from the variable531 # selvar_clean <- sub("_[12]$", "", selvar)532 #533 # dataset_val <- dict %>%534 # dplyr::filter(variable == selvar_clean) %>%535 # dplyr::pull(dataset) %>%536 # unique()537 #538 # is_legislative <- identical(dataset_val, "Legislative Elections")539 #540 # }541 #542 # if (543 # tab == "camera" ||544 # (tab == "map_tab" && identical(country, "MEXICO") && is_legislative)545 # ) {546 # showModal(547 # tags$div(548 # id = "devNoticeModal",549 # modalDialog(550 # title = HTML(""),551 # HTML("552 # <div style='color:#fff; font-size: 1em; text-align:center;'>553 # <p>554 # <strong>UNDER CONSTRUCTION</strong>555 # </p>556 # <p>557 # COMING SOON!558 # </p>559 # </div>560 # "),561 # easyClose = FALSE,562 # size = "s",563 # footer = modalButton("Back to the tool")564 # )565 # )566 # )567 # }568 # })569 570 # ==== HOW-TO MODAL ======================================================571 572 573 observeEvent(input$btn_howto, {574 # Pick the right explanation based on the current tab575 tab_name <- current_tab()576 577 howto_html <- switch(tab_name,578 "map_tab" = "579 <h4><i class='fa fa-map'></i> Mapping tool</h4>580 <p>581 Explore subnational data visually on an interactive map.582 Use the variable tree on the left to select an indicator,583 choose a country, and move the year slider to see how it changes over time.584 </p>585 <p>586 Hover over subnational unit for details or play the animation to view trends.587 </p>588 ",589 "graph_tab" = "590 <h4><i class='fa fa-chart-line'></i> Graphing tool</h4>591 <p>592 Create time-series plots comparing subnational indicators.593 Select one or more states from different countries and choose a variable.594 The graph updates dynamically to show trends across time.595 </p>596 <p>597 Use the legend box to toggle series visibility.598 </p>599 ",600 "camera" = "601 <h4><i class='fa fa-landmark'></i> Camera Viz tool</h4>602 <p>603 Visualize the composition of subnational legislatures.604 Select a country, state, and chamber (lower or upper chamber) to view605 party seat distributions for each election year.606 </p>607 608 ",609 "codebook" = "610 <h4><i class='fa fa-book-open'></i> Codebook</h4>611 <p>612 The codebook provides full definitions and sources for all variables613 included in the Subnational Politics Project datasets.614 </p>615 <p>616 Use it to understand variable meanings, coding schemes, and references.617 </p>618 ",619 "data_tab" = "620 <h4><i class='fa fa-table'></i> Databases</h4>621 <p>622 Access and download the SPP databases through the Harvard Dataverse repository.623 </p>624 ",625 "about" = "626 <h4><i class='fa fa-circle-info'></i> About</h4>627 <p>628 Learn about the Subnational Politics Project (SPP):629 its mission, team, and data infrastructure for the study of subnational politics in Latin America.630 </p>631 ",632 633 # default fallback634 "635 <h4><i class='fa fa-circle-question'></i> Welcome to SPP</h4>636 <p>637 Use the sidebar or the top navigation tabs to explore the different sections of the app.638 </p>639 "640 )641 642 643 showModal(644 tags$div(645 id = "howToModal",646 modalDialog(647 title = NULL,648 easyClose = TRUE,649 size = "m",650 footer = modalButton("Close"),651 HTML(howto_html)652 )653 )654 )655 })656 657 658 # “No data” message (map)659 output$no_data_message <- renderText("⚠ No data available for this country, variable and year.")660 661 662 # ==== 4) DYNAMIC UI (SELECTORS) ===========================================663 664 # -- 4.4) Country/Year selectors (map_tab) ---------------------------------665 output$country_selector <- renderUI({666 selectInput("country_sel", "Country",667 # choices = c("Select a country", unique(data$country_name)),668 choices = unique(data$country_name),669 selected = "MEXICO"670 )671 })672 673 674 output$year_selector <- renderUI({675 # We depend on structural changes (Country or Variable)676 req(current_tab() == "map_tab", input$country_sel, selected_vars_vector())677 678 # Static dataset679 df <- data680 681 # Core column names682 country_col <- "country_name"683 year_col <- "year"684 685 # Selected variable686 var_name <- selected_vars_vector()687 if (length(var_name) > 1) var_name <- var_name[[1]]688 req(is.character(var_name), var_name %in% names(df))689 690 # --- Filter early to minimize data in memory ---691 df_filtered <- df |>692 dplyr::filter(.data[[country_col]] == input$country_sel) |>693 dplyr::select(dplyr::all_of(c(country_col, year_col, var_name)))694 695 # Determine the first non-NA year696 y_min <- if (nrow(df_filtered) == 0) {697 1983L698 } else {699 valid_years <- df_filtered |>700 dplyr::filter(!is.na(.data[[var_name]])) |>701 dplyr::pull(.data[[year_col]])702 703 if (length(valid_years) > 0) min(valid_years, na.rm = TRUE) else min(df_filtered[[year_col]], na.rm = TRUE)704 }705 706 # Determine the latest available year707 y_max <- if (nrow(df_filtered) > 0) max(df_filtered[[year_col]], na.rm = TRUE) else max(df[[year_col]], na.rm = TRUE)708 709 # Safety fallback710 if (!is.finite(y_min) || !is.finite(y_max) || y_min > y_max) {711 y_min <- 1983L712 y_max <- 2024L713 }714 715 # --- NEW SELECTION LOGIC ---716 choices_vec <- as.character(seq(y_min, y_max, by = 1))717 718 # 1. Retrieve value from memory WITH ISOLATE719 # This breaks the re-rendering loop.720 target <- isolate(map_saved_year())721 722 # 2. Check if the saved year exists in the new Country's range723 final_selected <- if (!is.null(target) && target %in% choices_vec) {724 target725 } else {726 # Fallback: Try 2005, otherwise use the latest available year727 if ("2005" %in% choices_vec) "2005" else as.character(y_max)728 }729 730 shinyWidgets::sliderTextInput(731 inputId = "year_sel",732 label = "Year",733 choices = choices_vec,734 grid = TRUE,735 width = "90%",736 animate = shiny::animationOptions(interval = 1500, loop = FALSE), # Added proper animation options737 selected = final_selected738 )739 })740 741 # ==== 5) SHOW / HIDE CONTROLS BY TAB ======================================742 # “No data” visibility (map)743 observe({744 req(current_tab() == "map_tab", data_map())745 if (nrow(data_map()) == 0 || all(is.na(data_map()[[selected_vars_vector()]]))) {746 shinyjs::show("no_data_message")747 } else {748 shinyjs::hide("no_data_message")749 }750 })751 752 # Batch toggle helpers753 .combine_selector <- function(ids) if (length(ids)) paste0("#", ids, collapse = ", ") else NULL754 .batch_show <- function(ids) {755 sel <- .combine_selector(ids)756 if (!is.null(sel)) shinyjs::show(selector = sel)757 }758 .batch_hide <- function(ids) {759 sel <- .combine_selector(ids)760 if (!is.null(sel)) shinyjs::hide(selector = sel)761 }762 763 # Everything we may toggle anywhere in the app764 ALL_TOGGLES <- c(765 # map/graph controls766 "country_selector", "var_sel", "var_description_map", "var_description_graph", "jstree_container",767 "state_selector", # "jstree_vars_container",768 "jstree_vars_container_graph", "fancytree_vars_demo_container", "fancytree_vars_container_graph",769 "fancytree_states_container",770 # data-tab selectors771 # "country_sel2","state_sel2","db_selector","years",772 # legacy camera selector773 "camera_selector",774 # camera-tab selectors (SLED driven)775 "country_selector_camera", "state_selector_camera",776 # "chamber_selector_camera", "year_selector_camera"777 "chamber_sel_camera", "year_sel_camera"778 )779 780 # Given a tab, return vector of IDs to show781 .ids_to_show_for_tab <- function(tab) {782 switch(tab,783 "map_tab" = c("country_selector", "var_sel", "var_description_map", "fancytree_vars_demo_container"),784 "graph_tab" = c("var_description_graph", "state_selector", "fancytree_states_container", "fancytree_vars_container_graph"),785 # "data_tab" = c("country_sel2","state_sel2","db_selector","years"),786 "camera" = c(787 "country_selector_camera", "state_selector_camera",788 # "chamber_selector_camera","year_selector_camera"789 "chamber_sel_camera", "year_sel_camera"790 ),791 character(0)792 )793 }794 795 # Main visibility controller796 observeEvent(current_tab(),797 {798 to_show <- .ids_to_show_for_tab(current_tab())799 to_hide <- setdiff(ALL_TOGGLES, to_show)800 .batch_hide(to_hide)801 .batch_show(to_show)802 },803 ignoreInit = FALSE804 )805 806 807 # ==== 6.1) FILTERED DATA FOR CAMERA =======================================808 sled_cam_filtered <- reactive({809 df <- SLED810 if (!is.null(input$country_sel_camera) && nzchar(input$country_sel_camera)) {811 df <- df[df$country_name == input$country_sel_camera, , drop = FALSE]812 }813 if (!is.null(input$state_sel_camera) && nzchar(input$state_sel_camera)) {814 df <- df[df$state_name == input$state_sel_camera, , drop = FALSE]815 }816 if (!is.null(input$chamber_sel_camera)) {817 df <- df[df$chamber_election_sub_leg == as.integer(input$chamber_sel_camera), , drop = FALSE]818 }819 if (!is.null(input$year_sel_camera) && nzchar(input$year_sel_camera)) {820 df <- df[df$year == as.integer(input$year_sel_camera), , drop = FALSE]821 }822 df823 })824 825 826 # -- 6.2) Camera info text (camera tab) ------------------------------------827 output$text_camera <- renderUI({828 req(current_tab() == "camera", sled_cam_filtered(), input$state_sel_camera)829 df <- sled_cam_filtered()830 831 # helpers --------------------------------------------------------832 first_or_summary <- function(x) {833 vals <- unique(na.omit(x))834 if (length(vals) == 0) {835 return("—")836 }837 if (length(vals) == 1) {838 return(as.character(vals))839 }840 paste0("varies (", paste(sort(vals), collapse = ", "), ")")841 }842 843 map_renewal <- function(x) {844 labs <- c(845 `1` = "Staggered every 2 years",846 `2` = "Full renewal"847 )848 u <- unique(na.omit(as.integer(x)))849 if (!length(u)) {850 return("—")851 }852 out <- ifelse(as.character(u) %in% names(labs), labs[as.character(u)], as.character(u))853 if (length(out) == 1) out else paste0("varies (", paste(out, collapse = ", "), ")")854 }855 856 map_system <- function(x) {857 labs <- c(858 `1` = "Proportional Representation",859 `2` = "Simple Majority",860 `3` = "Mixed (PR + Simple Majority)",861 `4` = "Mixed (PR with predefined districts)"862 )863 u <- unique(na.omit(as.integer(x)))864 if (!length(u)) {865 return("—")866 }867 out <- ifelse(as.character(u) %in% names(labs), labs[as.character(u)], as.character(u))868 if (length(out) == 1) out else paste0("varies (", paste(out, collapse = ", "), ")")869 }870 871 # compute --------------------------------------------------------872 total_chamber <- first_or_summary(df$total_chamber_seats_sub_leg)873 seats_contest <- first_or_summary(df$total_seats_in_contest_sub_leg)874 renewal_type <- map_renewal(df$renewal_type_sub_leg)875 elec_system <- map_system(df$electoral_system_sub_leg)876 n_parties_cont <- first_or_summary(df$num_parties_election_contest_sub_leg)877 878 enp_vals <- sort(unique(na.omit(as.numeric(df$enp_sub_leg))))879 enp_txt <- if (!length(enp_vals)) {880 "—"881 } else if (length(enp_vals) == 1) {882 sprintf("%.2f", enp_vals)883 } else {884 sprintf("varies (%.2f–%.2f)", min(enp_vals), max(enp_vals))885 }886 887 # assemble -------------------------------------------------------888 HTML(paste0(889 "<b>Chamber seats (total):</b> ", total_chamber, "<br/>",890 "<b>Seats in contest:</b> ", seats_contest, "<br/>",891 "<b>Renewal type:</b> ", renewal_type, "<br/>",892 "<b>Electoral system:</b> ", elec_system, "<br/>",893 "<b>Parties contesting:</b> ", n_parties_cont, "<br/>",894 "<b>ENPL:</b> ", enp_txt895 ))896 })897 898 899 # ==== 7) VARIABLE DESCRIPTIONS (map & graph) ==============================900 output$var_description_map <- renderUI({901 req(selected_vars_vector())902 903 # Fancytree sends a single string key904 key <- input$selected_nodes_vars2905 if (is.null(key) || key == "") {906 return(NULL)907 }908 909 parts <- strsplit(key, "-", fixed = TRUE)[[1]]910 911 # Detect chamber (only applies to Legislative Elections)912 chamber <- NULL913 if (identical(parts[1], "Legislative Elections") &&914 length(parts) >= 3 &&915 parts[2] %in% c("Lower Chamber", "Upper Chamber")) {916 chamber <- parts[2]917 }918 919 # Remove _1/_2 suffix from variable ID920 clean_var <- sub("_[12]$", "", selected_vars_vector())921 922 # Retrieve metadata923 var_info <- dict %>%924 dplyr::filter(variable == clean_var) %>%925 dplyr::slice(1)926 927 # Build text928 text_d <- paste0(929 "<div>You are seeing <strong>",930 var_info$description_for_ui[1], "</strong>",931 if (!is.null(chamber)) paste0(" (", chamber, ")") else "",932 "; from the Subnational <strong>", parts[1],933 "</strong> Database.", ifelse(is.na(var_info$add_indices[1]), "", var_info$add_indices[1]), "</div>"934 )935 936 HTML(text_d)937 })938 939 940 output$var_description_graph <- renderUI({941 req(selected_vars_vector_graph())942 943 # Fancytree sends a single string key944 key <- input$selected_nodes_vars_graph2945 if (is.null(key) || key == "") {946 return(NULL)947 }948 949 parts <- strsplit(key, "-", fixed = TRUE)[[1]]950 951 # Detect chamber type (only for Legislative Elections)952 chamber <- NULL953 if (identical(parts[1], "Legislative Elections") &&954 length(parts) >= 3 &&955 parts[2] %in% c("Lower Chamber", "Upper Chamber")) {956 chamber <- parts[2]957 }958 959 # Clean variable (remove _1 or _2 suffix)960 clean_var <- sub("_[12]$", "", selected_vars_vector_graph())961 962 # Metadata row963 var_info <- dict %>%964 dplyr::filter(variable == clean_var) %>%965 dplyr::slice(1)966 967 # Build UI string968 text_d <- paste0(969 "<div>You are seeing <strong>",970 var_info$description_for_ui[1], "</strong>",971 if (!is.null(chamber)) paste0(" (", chamber, ")") else "",972 "; from the Subnational <strong>",973 parts[1],974 "</strong> Database.</div>"975 )976 977 HTML(text_d)978 })979 980 981 # Keep default options of var_sel and var_sel2 in sync982 observe({983 updateSelectInput(984 session, "var_sel",985 choices = dict$pretty_name[dict$viewable_map == 1],986 selected = "Valid Votes"987 )988 updateSelectInput(989 session, "var_sel2",990 choices = dict$pretty_name[dict$viewable_graph == 1],991 selected = "Voter Turnout Percentage"992 )993 })994 995 996 # ==== 9) MODULES (map / lines / table / camera) ===========================997 998 999 mapModuleServer(1000 id = "map1",1001 data_map = data_map,1002 input_var_sel = selected_vars_vector,1003 dict = dict,1004 country_bboxes = country_bboxes,1005 input_country_sel = reactive(input$country_sel),1006 active_tab = current_tab1007 )1008 1009 linePlotModuleServer(1010 id = "lp",1011 data = reactive(data),1012 dict = dict,1013 input_variable = selected_vars_vector_graph,1014 input_states = selected_states_vector,1015 Ymin = reactive(if (isTRUE(input$force_y0)) 0 else NULL),1016 active_tab = current_tab,1017 input_color_by = reactive({1018 if (input$color_by_state) "state" else "country"1019 })1020 )1021 1022 1023 # Hemicycle: still using original module (with inputs), now pointing to camera-only selectors.1024 camaraServer(1025 id = "cam",1026 data = SLED, # if you later refactor the module, change to data_r = sled_cam_filtered1027 state_r = reactive(input$state_sel_camera),1028 country_sel_camera = reactive(input$country_sel_camera),1029 chamber_r = reactive(input$chamber_sel_camera),1030 year_r = reactive(input$year_sel_camera),1031 party_col = "party_name_sub_leg",1032 seats_col = "total_seats_party_sub_leg",1033 state_col = "state_name",1034 chamber_filter_col = "chamber_election_sub_leg",1035 year_col = "year"1036 )1037 1038 1039 sppAboutModuleServer("about")1040 1041 spp_mvp_server("spp1", current_tab = current_tab)1042 1043 1044 # ==== 11) PDF VIEWER ======================================================1045 output$pdf_visor <- renderUI({1046 tags$iframe(1047 style = "height:800px; width:100%;",1048 src = "docs/SPP_codebook.pdf"1049 )1050 })1051 # ==== 12) TABS ======================================================1052 #1053 # observeEvent(input$tab_about, { updateTabItems(session, "tabs", "about") })1054 # observeEvent(input$tab_map, { updateTabItems(session, "tabs", "map_tab") })1055 # observeEvent(input$tab_graph, { updateTabItems(session, "tabs", "graph_tab") })1056 # observeEvent(input$tab_camera, { updateTabItems(session, "tabs", "camera") })1057 # observeEvent(input$tab_codebook, { updateTabItems(session, "tabs", "codebook") })1058 # observeEvent(input$tab_data, { updateTabItems(session, "tabs", "data_tab") })1059 #1060 #1061 #1062 #1063 1064 # ==== 13) SWIPE ======================================================1065 observeEvent(input$sidebar_swipe, {1066 if (input$sidebar_swipe == "left") {1067 shinyjs::runjs("1068 console.log('Force closing sidebar (server).');1069 $('body')1070 .removeClass('sidebar-open')1071 .addClass('sidebar-collapse');1072 ")1073 }1074 })1075 1076 # ==== 14) GO to camera tab ======================================================1077 1078 observeEvent(input$switch_to_camera, {1079 req(input$switch_to_camera)1080 1081 # 0. Store navigation target BEFORE anything else (timing-independent)1082 target_camera_year(as.character(input$switch_to_camera$year))1083 1084 # 1. LOCK & LOAD1085 is_navigating(TRUE)1086 shinyjs::show("global-loader")1087 1088 # 2. SWITCH TAB1089 updateTabItems(session, "tabs", selected = "camera")1090 1091 # 3. UNLOCK (safety delay for loader only)1092 shinyjs::delay(2000, {1093 is_navigating(FALSE)1094 shinyjs::hide("global-loader")1095 print("LOG [Switch]: Navigation complete.")1096 })1097 })1098 1099 # Clear navigation target when user manually changes camera selectors1100 # (but NOT during navigation, so the cascade can finish first)1101 observeEvent(1102 list(input$country_sel_camera, input$state_sel_camera, input$chamber_sel_camera),1103 {1104 if (!isTRUE(is_navigating())) {1105 target_camera_year(NULL)1106 }1107 },1108 ignoreInit = TRUE1109 )1110 1111 1112 # ==== 14) GO to graph tab ======================================================1113 1114 # ==== 14) GO to graph tab (UPDATER) =========================================1115 # ==== 14) GO to graph tab (UPDATER) =========================================1116 observeEvent(input$switch_to_graph, {1117 req(input$switch_to_graph)1118 1119 print("LOG [Switch]: Button clicked.")1120 1121 # 1. PREPARE IDS1122 # A) States (Always valid, logic remains same)1123 target_country <- toupper(input$switch_to_graph$country)1124 target_state <- toupper(input$switch_to_graph$state)1125 state_node_id <- paste0(target_country, "-", target_state)1126 1127 # B) Variable (New Validation Logic)1128 target_var <- input$switch_to_graph$variable1129 var_node_id <- NULL1130 variable_is_missing <- FALSE1131 1132 if (!is.null(target_var)) {1133 # Remove suffix to match dictionary1134 clean_var <- sub("_[12]$", "", target_var)1135 1136 # Look up metadata ONLY for variables allowed in the graph1137 var_meta <- dict %>%1138 dplyr::filter(variable == clean_var, viewable_graph == 1) %>%1139 dplyr::slice(1)1140 1141 if (nrow(var_meta) > 0) {1142 # Success: Variable exists in Graph1143 ds <- var_meta$dataset1144 pretty <- var_meta$pretty_name1145 1146 if (ds == "Legislative Elections") {1147 chamber_str <- if (grepl("_2$", target_var)) "Upper Chamber" else "Lower Chamber"1148 var_node_id <- paste(ds, chamber_str, pretty, sep = "-")1149 } else {1150 var_node_id <- paste(ds, pretty, sep = "-")1151 }1152 } else {1153 # Failure: Variable is Map-only1154 variable_is_missing <- TRUE1155 }1156 }1157 1158 # 2. HANDLE MISSING VARIABLE (Show Warning)1159 if (variable_is_missing) {1160 showModal(modalDialog(1161 # Use tags$span to group the icon and text safely1162 title = tags$span(1163 # No manual color needed: it will pick up the dark color (#111) from your CSS header1164 shiny::icon("exclamation-triangle", style = "margin-right: 8px;"),1165 "Variable Not Available"1166 ),1167 HTML(paste0(1168 "<div style='margin-top: 5px;'>",1169 "<p><strong>", target_var, "</strong> is available in the Map tool but cannot be graphed.</p>",1170 "<p>Switching to Graph view with the current state selection only.</p>",1171 "</div>"1172 )),1173 easyClose = TRUE,1174 size = "m",1175 # The footer will automatically pick up your purple button style1176 footer = modalButton("OK")1177 ))1178 }1179 1180 # 3. LOCK & LOAD1181 is_navigating(TRUE)1182 shinyjs::show("global-loader")1183 1184 # 4. SWITCH TAB1185 updateTabItems(session, "tabs", selected = "graph_tab")1186 1187 # 5. SEND UPDATE COMMANDS1188 shinyjs::delay(500, {1189 # Update State Tree (Always)1190 session$sendCustomMessage("update_fancytree_selection", list(id = state_node_id))1191 1192 # Update Variable Tree (Only if valid)1193 if (!is.null(var_node_id)) {1194 session$sendCustomMessage("update_fancytree_variable_graph", list(id = var_node_id))1195 }1196 })1197 1198 # 6. UNLOCK1199 shinyjs::delay(1500, {1200 is_navigating(FALSE)