Question 167578 in Javascript Question posted in
A very good W3school tutorial can be found here.

Javascript – Shiny App: Direct user to different tabPanel depending on state selected in highchart map in R

How can I implement the functionality in a Shiny App where there are two tabs, "Hex Map" and "State Information"?

In the "Hex Map" tab, there is a highchart displaying a hex map of the United States. On the "State Information" tab, there is a selectInput element that allows the user to choose a state and view information about that state.

What I would like to achieve is that when a user clicks on one of the states in the "Hex Map" tab, they should be automatically redirected to the "State Information" tab. Furthermore, I want the selectInput in the "State Information" tab to be pre-selected with the state that was clicked on in the "Hex Map" tab. For instance, if the user clicks on Alaska, the "State Information" tab should be displayed with Alaska selected in the selectInput dropdown.

Can you please provide guidance on how to implement this functionality using R and the Shiny package? I think I am close with the code below.

library(shiny)
library(highcharter)
library(usmap)

# Define state names vector
state_names <- state.name

# UI function
ui <- fluidPage(
  # Tabset panel
  tabsetPanel(
    # Hex Map panel
    tabPanel(
      "Hex Map",
      highchartOutput("hex_map", width = "100%", height = "500px")
    ),
    
    # State Information panel
    tabPanel(
      "State Information",
      selectInput("state_dropdown", "Select a State", choices = state_names),
      verbatimTextOutput("state_info")
    )
  )
)

# Server function
server <- function(input, output, session) {
  # Generate the hex map using Highcharts
  output$hex_map <- renderHighchart({
    state_df <- data.frame(state = state.name, abb = state.abb) # Create dataframe with state names and abbreviations
    
    hcmap("countries/us/us-all", data = state_df, value = "abb") %>%
      hc_title(text = "US Hex Map") %>%
      hc_plotOptions(
        series = list(
          cursor = "pointer",
          point = list(
            events = list(
              click = JS("function() {
                          var selected_state = this.abb;
                          Shiny.setInputValue('selected_state', selected_state, {priority: 'event'});
                          Shiny.setInputValue('tab_switched', 'state_info_tab', {priority: 'event'});
                        }")
            )
          )
        )
      )
  })
  
  # Update selectInput when a state is clicked
  observeEvent(input$selected_state, {
    selected_state <- input$selected_state
    updateSelectInput(session, "state_dropdown", selected = selected_state)
  })
  
  # Automatically switch to "State Information" tab and select clicked state
  observeEvent(input$tab_switched, {
    if (input$tab_switched == "state_info_tab") {
      selected_state <- input$selected_state
      updateSelectInput(session, "state_dropdown", selected = selected_state)
    }
  }, ignoreInit = TRUE)
  
  # Automatically switch to "State Information" tab when a state is selected
  observeEvent(input$state_dropdown, {
    selected_state <- input$state_dropdown
    updateTabsetPanel(session, "tabsetPanel", selected = "State Information")
    updateSelectInput(session, "selected_state", selected = selected_state)
  })
  
  # Render state information
  output$state_info <- renderPrint({
    state <- input$state_dropdown
    get_state_info(state)
  })
  
  # Helper function to retrieve state information
  get_state_info <- function(state) {
    # Placeholder implementation, replace with your own logic
    paste("State:", state)
  }
}

# Run the app
shinyApp(ui, server)
Tags:

2

Answers


  1. Chosen as BEST ANSWER
    0 
    library(shiny)
library(highcharter)
library(dplyr)

# APP UI
ui <- fluidPage(
  tags$script(src = "https://code.highcharts.com/mapdata/countries/us/us-all.js"),
  
  tabsetPanel(
    id = "tabs",
    tabPanel("Hex Map", 
             highchartOutput("hcmap")),
    tabPanel("State",
             selectInput("stateSelect", "Select State", choices = NULL),
             textOutput("selectedState"))
  )
)

# APP SERVER
server <- function(input, output, session) {
  # Reactive values
  selectedState <- reactiveVal(NULL)
  
  # Data
  data_4_map <- download_map_data("countries/us/us-all") %>%
    get_data_from_map() %>% 
    select(`hc-key`) %>%
    mutate(value = round(100 * runif(nrow(.)), 2))
  
  # Map
  click_js <- JS("function(event) {
    var stateName = event.point.name;
    Shiny.onInputChange('selectedState', stateName);
    $('#tabs a[href="#tabs-2"]').tab('show');
  }")
  
  output$hcmap <- renderHighchart({
    hcmap(map = "countries/us/us-all",
          data =  data_4_map,
          value = "value",
          joinBy = "hc-key",
          name = "Pop",
          download_map_data = FALSE) %>%
      hc_colorAxis(stops = color_stops()) %>%
      hc_plotOptions(series = list(events = list(click = click_js)))
  })
  
  # Redirect to the State tab and update selected state
  observeEvent(input$selectedState, {
    selectedState(input$selectedState)
    updateTabsetPanel(session, "tabs", selected = "State")
  })
  
  # Update selectInput choices based on selected state
  observeEvent(selectedState(), {
    updateSelectInput(session, "stateSelect", selected = selectedState(),
                      choices = ifelse(is.null(selectedState()), NULL, selectedState()))
  })
  
  output$selectedState <- renderText({
    input$selectedState
  })
}

shinyApp(ui, server)

  2. 0

    So just a couple of changes. Firstly, the name of the selected state will be this.name not this.abb (you can add a console.log(this) and check in console for which is the correct name). Secondly add an id for tabsetPanel and in JS function you need to use the title of the tab to be selected. Finally add an observer to update tabs whenever tab is changed via JS. The updated code is below:

    library(shiny)
library(highcharter)
library(usmap)

# Define state names vector
state_names <- state.name

# UI function
ui <- fluidPage(
    # Tabset panel
    tabsetPanel(
        id = 'tabs', #-- add id for tabsetPanel
        # Hex Map panel
        tabPanel(
            "Hex Map",
            highchartOutput("hex_map", width = "100%", height = "500px")
        ),
        
        # State Information panel
        tabPanel(
            "State Information",
            selectInput("state_dropdown", "Select a State", choices = state_names),
            verbatimTextOutput("state_info")
        )
    )
)

# Server function
server <- function(input, output, session) {
    # Generate the hex map using Highcharts
    output$hex_map <- renderHighchart({
        state_df <- data.frame(state = state.name, abb = state.abb) # Create dataframe with state names and abbreviations
        
        hcmap("countries/us/us-all", data = state_df, value = "abb") %>%
            hc_title(text = "US Hex Map") %>%
            hc_plotOptions(
                series = list(
                    cursor = "pointer",
                    point = list(
                        events = list(
                            #--- update what to select and setInputValue for tabs
                            click = JS("function() {
                          var selected_state = this.name;
                          Shiny.setInputValue('selected_state', selected_state, {priority: 'event'});
                          Shiny.setInputValue('tabs', 'State Information', {priority: 'event'});
                        }")
                        )
                    )
                )
            )
    })
    
    #-- add an observer to update tab whenever 'selected' tab is changed
    observeEvent(input$tabs,{
        updateTabsetPanel(session, inputId = "tabs", selected = input$tabs)
    })
    
    # Update selectInput when a state is clicked
    observeEvent(input$selected_state, {
        selected_state <- input$selected_state
        updateSelectInput(session, "state_dropdown", selected = selected_state)
    })

    # Render state information
    output$state_info <- renderPrint({
        state <- input$state_dropdown
        get_state_info(state)
    })
    
    # Helper function to retrieve state information
    get_state_info <- function(state) {
        # Placeholder implementation, replace with your own logic
        paste("State:", state)
    }
}

# Run the app
shinyApp(ui, server)
    Login or Signup to reply.
Please signup or login to give your own answer.

Back To Top
Search