Предупреждение: ошибка в операторе $: $ недействительна для атомарных векторов в приложении Shiny Web.

Я пытаюсь создать интерактивную карту, используя Plotly в приложении Shiny, которая позволяет пользователю выбирать регион с помощью выбора поля и выбора лассо на карте, затем он может вернуть диаграмму движения GoogleVis, показывающую статистику по региону, выбранному в Shiny приложение. Однако когда дело доходит до функции вывода GoogleVis:

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

Выдает ошибку:

Warning: Error in $: $ operator is invalid for atomic vectors
  96: renderText [/Users/b.w.h/Documents/JHU/Summer 1/COVID-19 Modeling Project/County Polygon Visualization with Shiny/USMapWithCountyPolygon/server.R#114]
  95: func
  82: origRenderFunc
  81: output$brush
   1: runApp

Это очень странно, потому что, когда я проверил в консоли, фрейм данных, который я пытаюсь подмножить с помощью $, не является атомарным.

is.atomic(totalComfirmed)
[1] FALSE

Почему это произошло? Вот мой полный пользовательский интерфейс и функция сервера:

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)


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)]
    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)
    colnames(covidDeath)[6] <- "countyNames"
    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))
              %>% 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")
        #    selectedCountyCases <- as.integer(unlist(selected[3]))
        #    brush <- selectedCounties
        #})

        
        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, server)

Спасибо за вашу помощь!


person Kaihua Hou    schedule 04.08.2020    source источник


Ответы (1)


Когда я бегу

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)]
names(totalComfirmed) <- c("countyNames", "cases")

а затем попробуйте is.atomic, я получаю

is.atomic(totalComfirmed)
# [1] TRUE

Вы извлекли один столбец из data.frame, который по умолчанию возвращает только атомарный вектор. Затем, когда вы пытаетесь сделать

totalComfirmed$cases %in% selectedCountyCases

Вы получите сообщение об ошибке, потому что totalComfirmed не имеет столбцов. Возможно, вы имели в виду

totalComfirmed <- covidCases[,c(which(names(covidCases)=="countyNames"), ncol(covidCases))]

И totalComfirmed тоже опечатка? Должно быть totalConfirmed?

person MrFlick    schedule 04.08.2020