r - 在带有 Shiny 的 Plotly 地图中保留套索选择和框选择的信息的问题

Question

我正在尝试在 Shiny 应用程序中使用 Plotly 创建一个交互式地图，该地图允许用户通过地图上的框选择和套索选择来选择区域，然后它可以返回一个 GoogleVis 动态图表，显示在 Shiny 中选择的区域的统计信息应用程序。这是用户界面功能：

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

你能帮我吗？

标签： rshinyr-plotlygooglevis

Answer 1

你有几个问题。在您的情况下，actionButton优于submitButton. 您需要observeEvent在服务器中有一个用于此按钮的按钮。当你melt，你需要一个数据表。最后，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)