在带有 Shiny 的 Plotly 地图中保留套索 select 和框 select 的信息的问题

Question

我正在尝试在 Shiny 应用程序中使用 Plotly 创建交互式地图，允许用户通过地图上的方框 select 和套索 select select 区域，然后它可以 return GoogleVis 动态图表，显示 Shiny 应用程序中 selected 区域的统计数据。这是 UI 函数：

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

shinyUI(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),                       
            submitButton("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)


shinyServer(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[,ncol(covidCases)]
    
    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 = 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)
    totalDeath <- covidDeath[,ncol(covidDeath)]
    
    v <- reactiveValues(data = totalComfirmed)
    observeEvent(input$countyFill, {
        if (input$countyFill == "Map by total confirmed") {
           v$data <-  totalComfirmed;
           v$zmin = 100;
           v$zmax = 12000;
           v$hover <- with(covidCases, paste(countyName));
        }
        if (input$countyFill == "Map by total death") {
            v$data <-  totalDeath;
            v$zmin = 0;
            v$zmax = 1600;
            v$hover <- with(covidDeath, paste(countyName));
        }
    })
    
    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))
        );
        countyPolygonMap;
        ## generating the interactive plotly map
    })
    
    output$motionChart <- renderGvis({
        subset(gvisCasesData, countyNames %in% c(selected))
        motionChart <- gvisMotionChart(gvisCasesDataSubset, "countyNames", "Date", options=list(width=800, height=400))
        plot(motionChart)
    })
   

    
    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
})

但是，它总是尝试跳转到 GoogleVis 图表的网络浏览器，并给出

的错误

Error: $ operator is invalid for atomic vectors

你能帮我吗？

Answer 1

您遇到了一些问题。在您的情况下，actionButton 优于 submitButton。您需要在服务器中为该按钮设置 observeEvent。当你melt，你需要一个数据table。最后，countyNames 在一个案例中被拼写错误。由于我无法安装 googleVis，您应该在您的电脑上取消注释该部分和运行以获得 motionChart。您应该能够修复剩余部分。下面的代码在底部给出了输出。

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")
                    )
                  )
      )
    )
  )
)


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[,ncol(covidCases)]
  
  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)
  totalDeath <- covidDeath[,ncol(covidDeath)]
  
  v <- reactiveValues(data = totalComfirmed)
  observeEvent(input$countyFill, {
    if (input$countyFill == "Map by total confirmed") {
      v$data <-  totalComfirmed;
      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))
      );
      countyPolygonMap;
      ## generating the interactive plotly map
    })
    
    # output$motionChart <- renderGvis({
    #   subset(gvisCasesData, countyNames %in% c(selected))
    #   motionChart <- gvisMotionChart(gvisCasesDataSubset, "countyNames", "Date", options=list(width=800, height=400))
    #   plot(motionChart)
    # })
    
    output$statePolygonMap <-renderLeaflet ({
      statesAbbr <- subset(statePolygonData,  statePolygonData$STUSPS %in% input$statesInput);
      ## 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, server)

在带有 Shiny 的 Plotly 地图中保留套索 select 和框 select 的信息的问题

Issue with retaining the info of lasso select and box select in Plotly map with Shiny

r

shiny

googlevis

r-plotly