【问题标题】:Issue with retaining the info of lasso select and box select in Plotly map with Shiny在带有 Shiny 的 Plotly 地图中保留套索选择和框选择的信息的问题
【发布时间】:2020-08-03 22:21:42
【问题描述】:

我正在尝试在 Shiny 应用程序中使用 Plotly 创建一个交互式地图,该地图允许用户通过地图上的框选择和套索选择来选择区域,然后它可以返回一个 GoogleVis 动态图表,显示所选区域的统计信息在闪亮的应用程序中。这是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

你能帮帮我吗?

【问题讨论】:

    标签: r shiny r-plotly googlevis


    【解决方案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)
    

    【讨论】:

    • 非常感谢您的帮助,但是当我取消注释该部分时,并未生成 googleVis 动态图表。我在想这可能与 event_register() 和 event_data() 有关系
    • 我目前无法安装 googleVis。所以我无法验证那部分。此外,您需要更新状态级别,因为它在您之前的设置中提供了随机状态。但现在看起来很好。你的电话是allstates %in% input,而应该是input %in% allstates
    猜你喜欢
    • 2023-03-04
    • 2019-09-12
    • 2021-06-10
    • 1970-01-01
    • 1970-01-01
    • 2023-03-23
    • 2017-04-24
    • 1970-01-01
    • 2016-11-28
    相关资源
    最近更新 更多