问题描述
我用瑞士的 Covid19 数据构建了一个闪亮的仪表板。 当我从 RStudio 运行仪表板时，仪表板运行良好，但在部署后我得到了：
**An error has occurred
The application Failed to start: exited unexpectedly with code 1
Attaching package: ‘dplyr’
The following objects are masked from ‘package:stats’:
filter,lag
The following objects are masked from ‘package:base’:
intersect,setdiff,setequal,union
Loading required package: ggplot2
Attaching package: ‘plotly’
The following object is masked from ‘package:ggplot2’:
last_plot
The following object is masked from ‘package:stats’:
filter
The following object is masked from ‘package:graphics’:
layout
Registered S3 method overwritten by 'quantmod':
method from
as.zoo.data.frame zoo
── Attaching packages ─────────────────────────────────────── tidyverse 1.3.0 ──
✔ tibble 3.0.3 ✔ stringr 1.4.0
✔ tidyr 1.1.2 ✔ forcats 0.5.0
✔ purrr 0.3.4
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ plotly::filter() masks dplyr::filter(),stats::filter()
✖ dplyr::lag() masks stats::lag()
Attaching package: ‘lubridate’
The following objects are masked from ‘package:base’:
date,intersect,union
Linking to GEOS 3.5.1,GDAL 2.2.2,PROJ 4.9.2
Attaching package: ‘maps’
The following object is masked from ‘package:purrr’:
map
Google's Terms of Service: https://cloud.google.com/maps-platform/terms/.
Please cite ggmap if you use it! See citation("ggmap") for details.
Attaching package: ‘ggmap’
The following object is masked from ‘package:plotly’:
wind
Attaching package: ‘shinydashboard’
The following object is masked from ‘package:graphics’:
Box
Attaching package: ‘rsconnect’
The following object is masked from ‘package:shiny’:
serverInfo
Parsed with column specification:
cols(
date = col_date(format = ""),time = col_time(format = ""),abbreviation_canton_and_fl = col_character(),ncumul_tested = col_double(),ncumul_conf = col_double(),new_hosp = col_double(),current_hosp = col_double(),current_icu = col_double(),current_vent = col_double(),ncumul_released = col_double(),ncumul_deceased = col_double(),source = col_character(),current_isolated = col_double(),current_quarantined = col_double(),current_quarantined_riskareatravel = col_double(),TotalPosTests1 = col_character(),ninst_ICU_intub = col_character()
)
Warning: 8254 parsing failures.
row col expected actual file
1 -- 17 columns 15 columns 'https://raw.githubusercontent.com/openZH/covid_19/master/COVID19_Fallzahlen_CH_total_v2.csv'
2 -- 17 columns 15 columns 'https://raw.githubusercontent.com/openZH/covid_19/master/COVID19_Fallzahlen_CH_total_v2.csv'
3 -- 17 columns 15 columns 'https://raw.githubusercontent.com/openZH/covid_19/master/COVID19_Fallzahlen_CH_total_v2.csv'
4 -- 17 columns 15 columns 'https://raw.githubusercontent.com/openZH/covid_19/master/COVID19_Fallzahlen_CH_total_v2.csv'
5 -- 17 columns 15 columns 'https://raw.githubusercontent.com/openZH/covid_19/master/COVID19_Fallzahlen_CH_total_v2.csv'
... ... .......... .......... .............................................................................................
See problems(...) for more details.
The rnaturalearthhires package needs to be installed.
Installing the rnaturalearthhires package.
Error in value[[3L]](cond) :
Failed to install the rnaturalearthhires package.
Please try installing the package for yourself using the following command:
install.packages("rnaturalearthhires",repos = "http://packages.ropensci.org",type = "source")
Calls: local ... tryCatch -> tryCatchList -> tryCatchOne -> <Anonymous>
Execution halted**
似乎 rnaturalearthhires 包是问题所在，但我不需要它来构建传单地图并在 RStudio 上运行应用程序。我试图在闪亮的仪表板代码中调用 library(rnaturalearthhires) 甚至添加 install.packages("rnaturalearthhires",type = "source")，但它确实不工作，我什至在部署结束之前收到一条错误消息。 有没有人遇到同样的问题或知道问题出在哪里？ 谢谢
解决方法
这是应用程序的代码：
library(readr)
library(readxl)
library(dplyr)
library(plotly)
library(forcats)
library(ggplot2)
library(tidyverse)
library(lubridate)
library(rnaturalearth)
library(rnaturalearthdata)
library(sf)
library(maps)
library(gifski)
library(leaflet)
library(ggmap)
library(htmlwidgets)
library(htmltools)
library(leaflet.extras)
library(purrr)
library(shiny)
library(shinydashboard)
library(RColorBrewer)
library(rsconnect)
# Data sets
# Load Covid data for Switzerland from GitHub repository
data_swiss <- read_csv("https://raw.githubusercontent.com/openZH/covid_19/master/COVID19_Fallzahlen_CH_total_v2.csv")
# Load Canton population data from excell csv file made from Wikipedia data
canton_swiss <- read_xlsx("swiss_cantons.xlsx")
# Load Switzerland spatial data (canton polygons)
switzerland <- ne_states(country = 'switzerland',returnclass = 'sf')
switzerland <- st_as_sf(switzerland)
# Join data frames
data_swiss = left_join(data_swiss,canton_swiss,by = c(abbreviation_canton_and_fl = "Canton_abbr"))
# Modify dataframe by adding more variables
data_swiss <- data_swiss %>% group_by(abbreviation_canton_and_fl) %>%
mutate(new_cases = ncumul_conf - lag(ncumul_conf,default = first(ncumul_conf),order_by = date))
data_swiss <- data_swiss %>% group_by(abbreviation_canton_and_fl) %>%
mutate(new_deaths = ncumul_deceased - lag(ncumul_deceased,default = first(ncumul_deceased),order_by = date))
data_swiss <- data_swiss %>%
mutate(pop_10thous = Pop/10000)
data_swiss <- data_swiss %>%
mutate(new_cases_per_10thous = new_cases/pop_10thous)
data_swiss <- data_swiss %>%
mutate(new_deaths_per_10thous = new_deaths/pop_10thous)
data_swiss <- data_swiss %>%
mutate(new_cases_smoothed = zoo::rollmean(new_cases,k = 7,fill = NA))
data_swiss <- data_swiss %>%
mutate(new_deaths_smoothed = zoo::rollmean(new_deaths,fill = NA))
data_swiss <- data_swiss%>%
mutate(ncumul_deceased_per_10thous = ncumul_deceased/pop_10thous)
data_swiss <- data_swiss%>%
mutate(ncumul_conf_per_10thous = ncumul_conf/pop_10thous)
# Merge with geo data
data_swiss_geo <- left_join(switzerland,data_swiss,by = c(postal = "abbreviation_canton_and_fl"))
# Create new data frame with Switzerland totals
data_swiss_noNA <- data_swiss %>%
mutate_if(is.numeric,funs(ifelse(is.na(.),.)))
switzerland_new_cases <- data_swiss_noNA %>%
group_by(date) %>%
summarize(switzerland_new_cases = sum(new_cases,na.rm = TRUE))
switzerland_new_cases_smoothed <- data_swiss_noNA %>%
group_by(date) %>%
summarize(switzerland_new_cases_smoothed = sum(new_cases_smoothed,na.rm = TRUE)) %>%
select(-date)
switzerland_new_deaths <- data_swiss_noNA %>%
group_by(date) %>%
summarize(switzerland_new_deaths = sum(new_deaths,na.rm = TRUE))%>%
select(-date)
switzerland_new_deaths_smoothed <- data_swiss_noNA %>%
group_by(date) %>%
summarize(switzerland_new_deaths_smoothed = sum(new_deaths_smoothed,na.rm = TRUE)) %>%
select(-date)
data_total_swiss <- cbind(switzerland_new_cases,switzerland_new_cases_smoothed,switzerland_new_deaths,switzerland_new_deaths_smoothed)
# Calculate trend
tot14days_last <- data_swiss %>%
group_by(abbreviation_canton_and_fl) %>%
filter(date <= max(date),date >= max(date)-14) %>%
summarize(tot14days_last = sum(new_cases,na.rm = TRUE))
tot14days_previous <- data_swiss %>%
group_by(abbreviation_canton_and_fl) %>%
filter(date <= max(date)-15,date >= max(date)-29) %>%
summarize(tot14days_previous = sum(new_cases,na.rm = TRUE)) %>%
select(-abbreviation_canton_and_fl)
trend <- cbind(tot14days_last,tot14days_previous)
trend <- trend %>%
mutate(change_percemt = round((tot14days_last-tot14days_previous)/tot14days_last*100,0))
trend_swiss_geo <- left_join(switzerland,trend,by = c(postal = "abbreviation_canton_and_fl"))
trend <- left_join(canton_swiss,by = c(Canton_abbr = "abbreviation_canton_and_fl"))
# App
header <- dashboardHeader(title = "Covid-19 Switzerland")
sidebar <- dashboardSidebar(
sidebarMenu (
menuItem("Timeline",tabName = "Timeline",icon = icon("calendar-alt")),menuItem("Maps and Stats",tabName = "Maps",icon = icon("chart-bar")),menuItem("14 days trend",tabName = "Trend",icon = icon("chart-line")),menuItem("About",tabName = "About",icon = icon("comment-alt")),menuItem("Source code",icon = icon("code"),href = "https://github.com/vivvi87/Swiss-Covid-Shiny-Dashboard"),menuItem("Source data",icon = icon("database"),href = "https://github.com/openZH/covid_19")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "Timeline",fluidRow(
valueBoxOutput("box_cases"),valueBoxOutput("box_deaths"),valueBoxOutput("box_canton")
),fluidRow(
tabBox(width = 10,title ="Switzerland Covid-19 timeline",tabPanel("Cases",plotlyOutput("swiss_timeline")),tabPanel("Deaths",plotlyOutput("swiss_timeline_d"))
),box(width = 2,sliderInput("dates","Select dates:",min(data_total_swiss$date),max(data_total_swiss$date),value = c(as.Date("2020-09-20"),max(data_total_swiss$date))
)
)
),title ="Swiss cantons Covid-19 timeline",plotlyOutput("canton_timeline")),plotlyOutput("canton_timeline_d"))
),sliderInput("dates_canton",min(data_swiss$date),max(data_swiss$date),max(data_swiss$date))
),selectInput("canton","Select canton:",selected = "Geneva",choices = c(levels(as.factor(data_swiss$Canton))),multiple = FALSE
)
)
)
),tabItem(tabName = "Maps",fluidRow(
tabBox(title = "Total cases",tabPanel("Absolute",leafletOutput("map_cases_abs")),tabPanel("Every 10000 people",leafletOutput("map_cases"))
),tabBox(title = "Total deaths",leafletOutput("map_deaths_abs")),leafletOutput("map_deaths"))
)
),plotlyOutput("cases_abs")),plotlyOutput("cases"))
),plotlyOutput("deaths_abs")),plotlyOutput("deaths"))
)
)
),tabItem(tabName = "About",fluidRow(
box(width = 12,h2("About"),"This dashboard has been built using the data found in the GitHub repository ",em("https://github.com/openZH/covid_19")," which collect Covid-19 data for Switzerland and Lichtenstain.","The data is updated at best once a day at varying times,but in order to avoid missing values and errors,the data in Maps and stats are displayed with a 2 days delay,as indicated when hovering on the data.","The data analysis as well as the source code of the dashboard can be found at ",em("https://github.com/vivvi87/Swiss-Covid-Shiny-Dashboard"),". Both source code and data can be directly accessed from the sidebar."
)
)
),tabItem(tabName = "Trend",fluidRow(
valueBoxOutput("swiss_trend")
),fluidRow(
box(title = "Map - 14 days variation %",width = 6,leafletOutput("variation_map")
),box(title = "Chart - 14 days variation %",plotlyOutput("variation_chart")
)
),fluidRow(
DT::dataTableOutput("trend_table")
)
)
)
)
server <- function(input,output) {
output$swiss_timeline <- renderPlotly({
data_total_swiss %>%
filter(date >= input$dates[1] & date <= input$dates[2]) %>%
plot_ly() %>%
add_bars(x = ~date,y = ~switzerland_new_cases,color = I("black"),opacity = 0.5,text = ~paste(date,"<br>","New cases: ",round(switzerland_new_cases,1)),hoverinfo = "text",name = "New cases") %>%
add_lines(x = ~date,y = ~switzerland_new_cases_smoothed,color = I("orange"),"New cases (7-days average): ",round(switzerland_new_cases_smoothed,0)),name = "new cases (7-days average)") %>%
layout(yaxis = list(title = "Number of Covid-19 cases",showgrid = F,range = c(0,11500)),xaxis = list(title = " "),legend = list(x = 0,y = 1)) %>%
config(displayModeBar = FALSE,displaylogo = FALSE)
})
output$swiss_timeline_d <- renderPlotly({
data_total_swiss %>%
filter(date >= input$dates[1] & date <= input$dates[2]) %>%
plot_ly() %>%
add_bars(x = ~date,y = ~switzerland_new_deaths,"New deaths: ",round(switzerland_new_deaths,name = "New deaths") %>%
add_lines(x = ~date,y = ~switzerland_new_deaths_smoothed,"New deaths (7-days average): ",round(switzerland_new_deaths_smoothed,name = "new deaths (7-days average)") %>%
layout(yaxis = list(title = "Number of deaths",125)),displaylogo = FALSE)
})
output$canton_timeline <- renderPlotly({
data_swiss %>%
filter(date >= input$dates_canton[1] & date <= input$dates_canton[2]) %>%
filter(Canton == input$canton) %>%
plot_ly() %>%
mutate(Canton = as.character(Canton)) %>%
add_lines(x = ~date,y = ~new_cases,fill = "tozeroy",fillcolor= 'rgba(153,102,204,0.5)',line = list(color = 'rgba(153,0.6)'),text = ~paste(Canton,"Date: ",date,"New Cases: ",new_cases),hoverinfo = "text") %>%
layout(yaxis = list(title = "Number of Covid-19 Cases",showgrid = F),xaxis = list(title = " ",showgrid = F)) %>%
config(displayModeBar = FALSE,displaylogo = FALSE)
})
output$canton_timeline_d <- renderPlotly({
data_swiss %>%
filter(date >= input$dates_canton[1] & date <= input$dates_canton[2]) %>%
filter(Canton == input$canton) %>%
plot_ly() %>%
mutate(Canton = as.character(Canton)) %>%
add_lines(x = ~date,y = ~new_deaths,new_deaths),hoverinfo = "text") %>%
layout(yaxis = list(title = "Number of deaths",displaylogo = FALSE)
})
output$variation_map <- renderLeaflet({
rc1 <- colorRampPalette(colors = c("purple","white"),space = "Lab")(length(which(trend_swiss_geo$change_percemt < 0)))
rc2 <- colorRampPalette(colors = c("moccasin","orange"),space = "Lab")(length(which(trend_swiss_geo$change_percemt > 0)))
rampcols <- c(rc1,rc2)
pal <- colorNumeric(palette = rampcols,domain = trend_swiss_geo$change_percemt)
trend_swiss_geo %>%
leaflet(options = leafletOptions(minZoom = 7.2)) %>%
setView(lat = 46.9,lng = 8.3,zoom = 7.2) %>%
addProviderTiles("CartoDB") %>%
addPolygons(fillColor = ~pal(change_percemt),weight = 1,opacity = 1,color = "white",dashArray = "3",fillOpacity = 0.7,highlight = highlightOptions(weight = 2,color = "#666",dashArray = "",bringToFront = TRUE),label = ~paste0(name_en,": ",round(change_percemt,0)," %")) %>%
addLegend(pal = pal,values = ~change_percemt,opacity = 0.7,title = NULL,position = "bottomright")
})
output$variation_chart <- renderPlotly({
trend %>%
plot_ly() %>%
add_bars(x = ~Canton,y= ~change_percemt,color = ~change_percemt < 0,colors = c("darkorange3","mediumpurple3"),opacity = 0.6,"% variation"),hoverinfo = "text") %>%
layout(yaxis = list(title = "14 days variation %",showgrid = F)) %>%
hide_legend() %>%
config(displayModeBar = FALSE,displaylogo = FALSE)
})
output$map_cases_abs <- renderLeaflet({
data_swiss_geo_last <- data_swiss_geo %>%
filter(date == max(date)-2)
labels2 <- sprintf(
"%s<br/><strong>%s</strong><br/> %s total Covid-19 cases",data_swiss_geo_last$date,data_swiss_geo_last$Canton,data_swiss_geo_last$ncumul_conf
) %>% lapply(htmltools::HTML)
data_swiss_geo_last %>%
leaflet(options = leafletOptions(minZoom = 7.2)) %>%
setView(lat = 46.9,zoom = 7) %>%
addProviderTiles("CartoDB") %>%
addPolygons(weight = 1,col = "grey") %>%
addCircleMarkers(~longitude,~latitude,radius = ~data_swiss_geo_last$ncumul_conf/2200,stroke = TRUE,color = "orange",weight = 2,fillOpacity = 0.5,label = labels2)
})
output$map_cases <- renderLeaflet({
data_swiss_geo_last <- data_swiss_geo %>%
filter(date == max(date)-2)
labels1 <- sprintf(
"%s<br/><strong>%s</strong><br/> %s Covid-19 cases every 10000 people",round(data_swiss_geo_last$ncumul_conf_per_10thous,0)
) %>% lapply(htmltools::HTML)
data_swiss_geo_last %>%
leaflet(options = leafletOptions(minZoom = 7.2)) %>%
setView(lat = 46.9,radius = ~(data_swiss_geo_last$ncumul_conf_per_10thous/50),label = labels1)
})
output$map_deaths_abs <- renderLeaflet({
data_swiss_geo_last <- data_swiss_geo %>%
filter(date == max(date)-2)
labels4 <- sprintf(
"%s<br/><strong>%s</strong><br/> %s total deaths",data_swiss_geo_last$ncumul_deceased
) %>% lapply(htmltools::HTML)
data_swiss_geo_last %>%
leaflet(options = leafletOptions(minZoom = 7.2)) %>%
setView(lat = 46.9,radius = ~data_swiss_geo_last$ncumul_deceased/40,color = "mediumorchid",fillOpacity = 0.4,label = labels4)
})
output$map_deaths <- renderLeaflet({
data_swiss_geo_last <- data_swiss_geo %>%
filter(date == max(date)-2)
labels3 <- sprintf(
"%s<br/><strong>%s</strong><br/> %s deaths every 10000 people",round(data_swiss_geo_last$ncumul_deceased_per_10thous,radius = ~data_swiss_geo_last$ncumul_deceased_per_10thous,label = labels3)
})
output$cases_abs <- renderPlotly({
data_swiss %>%
plot_ly() %>%
filter(date == max(date)-2) %>%
add_bars(x = ~reorder(Canton,-ncumul_conf),y = ~ncumul_conf,Canton,ncumul_conf,"total cases")) %>%
layout(yaxis = list(title = "Total Covid-19 cases",xaxis = list(title = " ")) %>%
config(displayModeBar = FALSE,displaylogo = FALSE)
})
output$cases <- renderPlotly({
data_swiss %>%
plot_ly() %>%
filter(date == max(date)-2) %>%
add_bars(x = ~reorder(Canton,-ncumul_conf_per_10thous),y = ~ncumul_conf_per_10thous,round(ncumul_conf_per_10thous,"total cases every 10000 people")) %>%
layout(yaxis = list(title = "Total Covid-19 cases",displaylogo = FALSE)
})
output$deaths_abs <- renderPlotly({
data_swiss %>%
plot_ly() %>%
filter(date == max(date)-2) %>%
add_bars(x = ~reorder(Canton,-ncumul_deceased),y = ~ncumul_deceased,ncumul_deceased,"total deaths")) %>%
layout(yaxis = list(title = "Total deaths",displaylogo = FALSE)
})
output$deaths <- renderPlotly({
data_swiss %>%
plot_ly() %>%
filter(date == max(date)-2) %>%
add_bars(x = ~reorder(Canton,-ncumul_deceased_per_10thous),y = ~ncumul_deceased_per_10thous,round(ncumul_deceased_per_10thous,"total deaths every 10000 people")) %>%
layout(yaxis = list(title = "Total deaths",displaylogo = FALSE)
})
output$box_cases <- renderValueBox({
box_cases_val <- summarize(data_total_swiss,sum(switzerland_new_cases))
valueBox(box_cases_val,"Total cases in Switzerland",color = "yellow",icon = icon("virus"))
})
output$box_deaths <- renderValueBox({
box_deaths_val <- summarize(data_total_swiss,sum(switzerland_new_deaths))
valueBox(box_deaths_val,"Total deaths in Switzerland",icon = icon("skull"))
})
output$box_canton <- renderValueBox({
a <- data_swiss %>% filter(date == max(date))
box_canton_val <- a$Canton[which.max(a$ncumul_conf)]
valueBox(box_canton_val,"Canton with highest number of cases",icon = icon("arrow-up"))
})
output$swiss_trend <- renderValueBox({
tot14days_last_swiss <- summarize(trend,sum(tot14days_last))
tot14days_previous_swiss <- summarize(trend,sum(tot14days_previous))
swiss_trend_val <- (tot14days_last_swiss-tot14days_previous_swiss)/tot14days_last_swiss*100
valueBox(paste0(round(swiss_trend_val,"%"),"14 days variation of cases in Switzerland",icon = if(swiss_trend_val >= 0){icon("arrow-alt-circle-up")} else {icon("arrow-alt-circle-down")})
})
output$trend_table <- DT::renderDataTable({
trend_table <- trend %>%
select(-Pop,-Canton_abbr)
DT::datatable(trend_table,rownames = FALSE,class = "hover",colnames = c("Canton","total cases last 14 days","total cases previous 14 days","variation %"))
})
}
ui <- dashboardPage(skin = "purple",header,sidebar,body)
shiny::shinyApp(ui,server)