如何在gvisGeoChart中为NA条目设置不同提示文本？

问题出在gvisGeoChart默认会将colorvar字段的信息附加到tooltip中，即使你指定了hovervar。要实现完全自定义的tooltip，需要用HTML格式构造提示内容并开启HTML渲染：

修改步骤 #

• 重构Tooltip列，用HTML标签自定义显示内容，完全控制有/无数据时的提示文本
• 确保tooltip的isHtml配置为true，让Google Charts解析HTML内容
• 修正UI中selectInput的默认选中值（原选中值不在选项列表中，会引发错误）

修改后的完整代码 #

library(shiny)
library(googleVis)
library(dplyr)
library(DT)

# Load your data
combined_vul_data <- 
  structure(list(ISO3 = c("AF", "AL", "DZ", "AD", "AO", "AG", "AR", 
                          "AM", "AU", "AT", "AZ", "BS", "BH", "BD", "BB", "BY", "BE", "BZ", 
                          "BJ", "BT"), Name = c("Afghanistan", "Albania", "Algeria", "Andorra", 
                                                "Angola", "Antigua and Barbuda", "Argentina", "Armenia", "Australia", 
                                                "Austria", "Azerbaijan", "Bahamas", "Bahrain", "Bangladesh", 
                                                "Barbados", "Belarus", "Belgium", "Belize", "Benin", "Bhutan"
                          ), vul_capacity_Rank_2021 = c(0.709035449, 0.511126182, 0.523332101, 
                                                        NA, 0.740026186, 0.621133795, 0.446088596, 0.462491218, 0.296565054, 
                                                        0.26689445, 0.47917568, NA, 0.453936004, 0.649876424, 0.398904506, 
                                                        0.386808093, 0.27763708, 0.547525366, 0.763503499, 0.635633065
                          )), class = "data.frame", row.names = c(NA, -20L))


# Define UI for the map
ui <- fluidPage(
  titlePanel(div(span("Country Rankings"), style={'padding-top: 15px'})),
  tabsetPanel(
    tabPanel("Vulnerability Map",
             sidebarLayout(
               sidebarPanel(
                 selectInput("year", "Select Year", choices = 2021, selected = 2021),
                 selectInput("category", "Select Category", 
                             choices = list("Adaptive Capacity" = "vul_capacity"), selected = "vul_capacity")
               ),
               mainPanel(
                 htmlOutput("map")
               )
             )
    )
  )
)

# Define server logic for the map
server <- function(input, output) {
  output$map <- renderGvis({
    year <- input$year
    category <- input$category
    
    # Create the column name for the selected year and category
    rank_column <- paste(category, "_Rank_", year, sep = "")
    
    # Filter and prepare the data
    map_data <- combined_vul_data %>%
      select(ISO3, Name, Rank = !!sym(rank_column)) %>%
      # 用HTML构造完全自定义的Tooltip内容
      mutate(Tooltip = case_when(
        is.na(Rank) ~ paste0("<div><strong>", Name, "</strong><br>数据不足</div>"),
        TRUE ~ paste0("<div><strong>", Name, "</strong><br>Rank: ", round(Rank, 3), "</div>")
      ))
    
    # Update locationvar column
    map_data <- map_data %>%
      mutate(Location = ifelse(Name %in% c("Congo (Brazzaville)", "Congo (Kinshasa)"), ISO3, Name))
    
    # Determine the range of the Rank values
    min_rank <- min(map_data$Rank, na.rm = TRUE)
    max_rank <- max(map_data$Rank, na.rm = TRUE)
    
    # Create the map
    gvisGeoChart(map_data, locationvar = "Location", colorvar = "Rank",
                 hovervar = "Tooltip",  
                 options = list(colorAxis = paste0("{minValue:", min_rank, ", maxValue:", max_rank, ", colors:['#00FF00', '#FFFF00', '#FF0000']}"),
                                backgroundColor = '#81d4fa', datalessRegionColor = '#f5f5f5',
                                defaultColor = '#f5f5f5',
                                tooltip = "{isHtml: true}",
                                width = "100%",
                                height = "500px"))  
  })
  
}

shinyApp(ui = ui, server = server)

说明 #

• 用case_when和HTML标签构造Tooltip，确保有数据时显示国名+排名，无数据时显示国名+“数据不足”
• tooltip = "{isHtml: true}"让Google Charts渲染HTML格式的提示框，完全覆盖默认的字段信息
• 修正了UI中selectInput的默认选中值，避免因不存在的列引发错误

内容的提问来源于stack exchange，提问作者hks