根据高图表地图中选择的状态将用户引导到不同的选项卡面板

问题描述 投票：0回答：2

如何在有两个选项卡“十六进制地图”和“状态信息”的闪亮应用程序中实现该功能？

在“十六进制地图”选项卡中，有一个高图表显示美国的十六进制地图。在“状态信息”选项卡上，有一个 selectInput 元素，允许用户选择一个状态并查看有关该状态的信息。

我想要实现的是，当用户单击“十六进制地图”选项卡中的某个状态时，他们应该自动重定向到“状态信息”选项卡。此外，我希望“状态信息”选项卡中的 selectInput 与“十六进制映射”选项卡中单击的状态一起预先选择。例如，如果用户单击阿拉斯加，则应显示“州信息”选项卡，并在 selectInput 下拉列表中选择阿拉斯加。

您能否提供有关如何使用 R 和 Shiny 包实现此功能的指导？我想我很接近下面的代码。

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)
javascript r shiny r-highcharter
2个回答
3
投票

所以只需进行一些更改。首先，所选状态的名称将是 

this.name
而不是 
this.abb
（您可以添加 
console.log(this)
并在控制台中检查哪个是正确的名称）。其次，为 
tabsetPanel
添加一个 id，在 JS 函数中，您需要使用要选择的选项卡的标题。最后添加一个观察者，以便在通过 JS 更改选项卡时更新选项卡。更新后的代码如下：

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)
2
投票
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)
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.