R 从图形地图中获取和修改长方体选择信息

我正在尝试创建一个交互式闪亮应用程序，向用户显示一张地图，允许用户选择美国的不同县。然后，它可以使用所选县的信息生成图形和绘图。但是，choropleth映射似乎仅在选择时返回CurveEnumber、pointNumber和z值。如何从该信息中识别所选县？或者我怎样才能让它在选择后给出县名？以下是我的ui和服务器功能：

library(shiny)
library(shinyWidgets)
library(plotly)
library(leaflet)

ui <- fluidPage(
    
    titlePanel("Johns Hopkins COVID-19 Modeling Visualization Map"),
    setBackgroundImage(
        src = "https://brand.jhu.edu/assets/uploads/sites/5/2014/06/university.logo_.small_.horizontal.blue_.jpg"
    ),
    
    sidebarLayout(
        sidebarPanel(
            radioButtons("countyFill", "Choose the County Map Type", c("Map by total confirmed", "Map by total death"), selected = "Map by total confirmed"),
            checkboxGroupInput("statesInput", "Choose the State(s)", 
                               c("AL", "MO", "AK", "MT", "AZ", "NE", 
                                 "AR", "NV", "CA", "NH", "CO", "NJ", 
                                 "CT", "NM", "DE", "NY", "DC", "NC", 
                                 "FL", "ND", "GA", "OH", "HI", "OK", 
                                 "ID", "OR", "IL", "PA", "IN", "RI", 
                                 "IA", "SC", "KS", "SD", "KY", "TN", 
                                 "LA", "TX", "ME", "UT", "MD", "VT", 
                                 "MA", "VA", "MI", "WA", "MN", "WV", 
                                 "MS", "WI", "WY"),
                               inline = TRUE),                       
            actionButton("submit", "Submit (may take 30s to load)")
        ), 
        
        mainPanel(
            tabsetPanel(type = "tabs", 
                        tabPanel("County Level", plotlyOutput("countyPolygonMap"), 
                                 htmlOutput("motionChart"), 
                                 verbatimTextOutput("brush")), 
                        tabPanel("State Level", leafletOutput("statePolygonMap")),
                        tags$div(
                            tags$p(
                                "JHU.edu Copyright © 2020 by Johns Hopkins University & Medicine. All rights reserved."
                            ),
                            tags$p(
                                tags$a(href="https://it.johnshopkins.edu/policies/privacystatement",
                                       "JHU Information Technology Privacy Statement for Websites and Mobile Applications")
                            )
                        )
            )
        )
    )
)
library(shiny)
library(leaflet)
library(magrittr)
library(rgdal)
library(plotly)
library(rjson)
library(dplyr)
library(viridis) 
library(googleVis)
library(lubridate)
library(reshape2)
library(data.table)
library(shinyWidgets)


server <- function(input, output, session) {
    statepolygonZip <- download.file("https://www2.census.gov/geo/tiger/GENZ2018/shp/cb_2018_us_state_500k.zip", 
                                     destfile = "cb_2018_us_state_500k.zip");
    unzip("cb_2018_us_state_500k.zip");
    statePolygonData <- readOGR("cb_2018_us_state_500k.shp", layer = "cb_2018_us_state_500k", 
                                GDAL1_integer64_policy = TRUE);
    ## obtaning the state shape file data provided by cencus.gov 
    ## for more categories of region shape file: 
    ## https://www.census.gov/geographies/mapping-files/time-series/geo/carto-boundary-file.html
    
    url <- 'https://raw.githubusercontent.com/plotly/datasets/master/geojson-counties-fips.json'
    countyGeo <- rjson::fromJSON(file=url)
    ## Obtaining the geographical file for all U.S. counties
    
    url2<- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_confirmed_US.csv"
    covidCases <- read.csv(url2, header = TRUE)
    fips <- sprintf("%05d",covidCases$FIPS)
    colnames(covidCases)[6] <- "countyNames"
    totalComfirmed <- covidCases[,c(which(names(covidCases)=="countyNames"), ncol(covidCases))]
    names(totalComfirmed) <- c("countyNames", "cases")
    
    destroyX = function(es) {
        f = es
        for (col in c(1:ncol(f))){ #for each column in dataframe
            if (startsWith(colnames(f)[col], "X") == TRUE)  { #if starts with 'X' ..
                colnames(f)[col] <- substr(colnames(f)[col], 2, 100) #get rid of it
            }
        }
        assign(deparse(substitute(es)), f, inherits = TRUE) #assign corrected data to original name
    }
    destroyX(covidCases)
    
    gvisCasesData <- cbind.data.frame(covidCases$countyNames, covidCases[11,ncol(covidCases)])
    gvisCasesData <- melt(data = setDT(covidCases), id.vars = "countyNames",measure.vars = c(colnames(covidCases)[c(12:ncol(covidCases))]))
    colnames(gvisCasesData)[2:3] <- c("Date", "numCases")
    gvisCasesData$Date <- mdy(gvisCasesData$Date)
    
    
    url3 <- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_deaths_US.csv"
    covidDeath <- read.csv(url3, header = TRUE)
    fips <- sprintf("%05d",covidCases$FIPS)
    colnames(covidDeath)[6] <- "countyNames"
    totalDeath <- covidDeath[,c(which(names(covidDeath)=="countyNames"), ncol(covidDeath))]
    names(totalDeath) <- c("countyNames", "totalDeath")
    
    v <- reactiveValues(data = totalComfirmed)
    observeEvent(input$countyFill, {
        if (input$countyFill == "Map by total confirmed") {
            v$data <-  totalComfirmed$cases;
            v$zmin = 100;
            v$zmax = 12000;
            v$hover <- with(covidCases, paste(countyNames));
        }
        if (input$countyFill == "Map by total death") {
            v$data <-  totalDeath;
            v$zmin = 0;
            v$zmax = 1600;
            v$hover <- with(covidDeath, paste(countyNames));
        }
    })
    
    observeEvent(input$submit, {
        req(input$submit)
        
        output$countyPolygonMap <- renderPlotly({
            countyPolygonMap <- plot_ly(source = "countyMap") %>% add_trace(
                countyName <- covidCases$countyNames,
                type="choroplethmapbox",
                geojson=countyGeo,
                locations=fips,
                z=v$data,
                colorscale="Viridis",
                zmin= v$zmin,
                zmax= v$zmax,
                text = ~v$hover,
                marker=list(line=list(width=0),opacity=0.5)
            ) %>% layout(
                mapbox=list(
                    style="carto-positron",
                    zoom =2,
                    center=list(lon= -95.71, lat=37.09))
                %>% event_register(event = "plotly_selected")
            );
            countyPolygonMap;
            ## generating the interactive plotly map
        })
        
        #output$motionChart <- renderGvis({
        #    selected <- event_data(event = "plotly_selected", source = "countyMap")
        #    selectedCountyCases <- as.integer(unlist(selected[3]))
        #    selectedCounties <- subset(totalComfirmed, totalComfirmed$cases %in% selectedCountyCases)
        #    gvisCasesDataSubset <- subset(gvisCasesData, countyNames %in% c(selectedCounties$countyNames))
        #    motionChart <- gvisMotionChart(gvisCasesDataSubset, "countyNames", "Date", options=list(width=800, height=400))
        #})
        
        output$brush <- renderText({
            selected <- event_data(event = "plotly_selected", source = "countyMap")
            brush <- selected
        })
        
        
        output$statePolygonMap <-renderLeaflet ({
            statesAbbr <- subset(statePolygonData, input$statesInput %in% statePolygonData$STUSPS);
            ## subsetting the shape file with the selected states
            
            leaflet(statesAbbr) %>%
                addPolygons(color = "#444444", weight = 1, smoothFactor = 0.5,
                            opacity = 1.0, fillOpacity = 0.5,
                            fillColor = ~colorQuantile("YlOrRd", ALAND)(ALAND),
                            highlightOptions = highlightOptions
                            (color = "white", weight = 2,bringToFront = TRUE))
        })
        ## producing the map with polygon boundary on the state level
    })
    
}
shinyApp(ui = ui, server = server)

---

非常感谢你的帮助

您可以在plotly的添加跟踪中添加自定义数据

add_trace(..., customdata = ~yourid,...)

然后可通过事件_数据获取id：

yourid <- event_data("plotly_click")$customdata

---

另请参见

是否可以减少代码？那会增加你得到帮助的机会。难道不能只包含与plotly相关的代码吗？您可以对countyName使用fips，因为它对于美国的每个县都是唯一的。是的，这是唯一的。但plotly似乎不会使用我分配给每个县的参数。相反，它给每个县分配了自己的唯一编号，我不知道如何修改，这让我很难识别。