Closed xhee0013 closed 3 years ago
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
library(coronavirus)
library(tidyverse)
library(DT)
#>
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#>
#> dataTableOutput, renderDataTable
library(formattable)
library(lubridate)
#>
#> Attaching package: 'lubridate'
#> The following objects are masked from 'package:base':
#>
#> date, intersect, setdiff, union
library(plotly)
#>
#> Attaching package: 'plotly'
#> The following object is masked from 'package:formattable':
#>
#> style
#> 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
library(nCov2019)
library(leaflet)
library(shinythemes)
# province data -----------------------------------------------------------
coronavirus %>%
filter(country %in% c("Australia","United Kingdom","China"), date >= "2020-01-27")%>%
mutate(Month=month(date))%>%
group_by(type,province,Month,country,long,lat) %>%
summarise(Cases = sum(cases),.groups = 'drop')%>%
rename(Type=type)->data
data<-data[-c(1:9),]
region<-coronavirus %>%
filter(country %in% c("Australia","United Kingdom","China"))%>%
mutate(Month=month(date))%>%
group_by(type,country,province,long,lat) %>%
summarise(Cases = sum(cases),.groups = 'drop')%>%
filter(type=="confirmed")
region <- region[-c(42),]
country<-tibble(country=c("China","United Kingdom","Australia"),
long=c(104.1954,-3.4360,133.7751),
lat=c(35.8617,55.3781,-25.2744))
data%>%
select(Type,Month,country,Cases)%>%
group_by(Type,Month,country) %>%
summarise(Cases = sum(Cases))%>%
pivot_wider(names_from = Type,
values_from = Cases)->new_data
#> `summarise()` regrouping output by 'Type', 'Month' (override with `.groups` argument)
# Define UI for application that draws a histogram
ui <- fluidPage(
br(),
# Application title
#titlePanel("Covid 19 Case situation acorss each country"),
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
"COVID-19 tracker", id="nav",
tabPanel("Country/Region plots",
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("country", "Which country do you want to examine?", choices = unique(data$country),
selected = "China"),
selectInput("province", "Which province?", choices = ""),
leafletOutput("leaflet")
),
# Show a plot of the generated distribution
mainPanel(
plotlyOutput("lineplot")
)
)
), tabPanel("Covid-19 Case Summary",
sidebarLayout(
sidebarPanel(
radioButtons("comparison_summary", h3("Select country:"),
choices =unique(new_data$country)),
),
mainPanel(htmlOutput("table1")))),
tabPanel("About",
fluidRow(
column(8,
includeMarkdown('./about/about.rmd')
)
)
)
))
#> Warning in file(con, "r"): cannot open file './about/about.rmd': No such file or
#> directory
#> Error in file(con, "r"): cannot open the connection
# Define server logic required to draw a histogram
server <- function(input, output,session) {
observeEvent(input$country, {
updateSelectInput(session, "province",
choices = filter(region, country==input$country)$province)
})
output$leaflet <- renderLeaflet({
country_df <- filter(country, country==input$country)
leaflet() %>%
setView(lat = country_df$lat, lng = country_df$long, zoom = 3) %>%
addTiles() %>%
#addCircleMarkers(
addMarkers(
data = filter(region, country==input$country),
layerId = ~province,
lng = ~long,
lat = ~lat,
#radius = ~(Cases/2000),
label = ~paste("Region: ",province,"; Confirmed case:",Cases)
#weight = 2,
#color = "#EF0F21"
)
})
clicked_leaflet <- reactiveValues(clickedMarker=NULL)
observeEvent(input$leaflet_marker_click,{
clicked_leaflet$clickedMarker <- input$leaflet_marker_click
})
observeEvent(input$leaflet_marker_click, { # update the location selectInput on map clicks
p <- input$leaflet_marker_click
if(!is.null(p$id)){
if(is.null(input$province) || input$province!=p$id)
updateSelectInput(session, "province", selected=p$id)
}
})
selected_coordinates= reactive(({
c(clicked_leaflet$clickedMarker$lng,clicked_leaflet$clickedMarker$lat)
}))
output$fish=renderTable({
selected_data()
})
selected_data= reactive(({
if(is.null(clicked_leaflet$clickedMarker))
return(NULL)
filter(data, long == as.numeric(as.character(selected_coordinates()[1])),lat==as.numeric(as.character(selected_coordinates()[2])))
}))
output$lineplot <- renderPlotly({
temp=selected_data()
if(is.null(temp))
return(NULL)
plot_country<-ggplot(data=temp,#filter(data,province==input$province,country==input$country),
aes(x=Month,y=Cases,col=Type))+
#geom_sf(data=filter(data,country==input$country))+
geom_line()+
geom_point()+
labs(x = "Month", y = "Cases count", title = temp$province)+
theme_bw()+
theme(legend.position="bottom",
legend.direction="horizontal",
legend.box.background = element_rect(fill = "transparent"),
legend.background = element_rect(fill = "transparent",linetype="solid",color = "#BDD9EC"),
axis.text = element_text(size = 10),
legend.text = element_text(size = 10,color = "#1B6D9C"), #1B6D9C#0E629B
#legend.title = element_text(size=12,colour = "#6F767A"),
legend.title = element_blank(),
axis.title = element_text(size = 12,color="#6F767A"),
axis.line = element_line(size = 0.4, colour = "white"),
plot.background = element_rect(fill = "#96c0dc"),##9bc1e0
panel.background = element_rect(fill="transparent"),
panel.border = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line.x = element_line(siz=0),
axis.ticks.x.bottom = element_line(colour = "white",size = 0),
plot.margin = margin(10,20,10,20))+
scale_x_continuous(breaks = seq(1, 9,1))
#panel.grid.minor = element_line(vjust=0))
ggplotly(plot_country)
})
output$table1 <- renderText({
filter(new_data,country==input$comparison_summary)%>%
kableExtra::kable(
align = "lrrrr",
booktabs=TRUE,
caption = "summary statistic")%>%
kableExtra:: kable_styling(bootstrap_options = c("striped", "hover"))%>%
kableExtra:: row_spec( 1:9,
bold = T,
color = "white",
background = "#518abb")
})
}
# Run the application
shinyApp(ui = ui, server = server)
#> Error in force(ui): object 'ui' not found
Created on 2020-10-06 by the reprex package (v0.3.0)
Hi,
I am trying to use ggplot to draw a line graph. But the graph of x-axis with date variable are congested and it's difficult to read them. I have selected some of my data and try to reproduce the line graph in here. Can someone help me to solve this problem? Thank you in advance.
Created on 2020-08-13 by the reprex package (v0.3.0)
Session info
``` r devtools::session_info() #> ─ Session info ─────────────────────────────────────────────────────────────── #> setting value #> version R version 3.6.3 (2020-02-29) #> os macOS Catalina 10.15.6 #> system x86_64, darwin15.6.0 #> ui X11 #> language (EN) #> collate en_AU.UTF-8 #> ctype en_AU.UTF-8 #> tz Australia/Melbourne #> date 2020-08-13 #> #> ─ Packages ─────────────────────────────────────────────────────────────────── #> package * version date lib source #> assertthat 0.2.1 2019-03-21 [1] CRAN (R 3.6.0) #> backports 1.1.5 2019-10-02 [1] CRAN (R 3.6.0) #> callr 3.4.3 2020-03-28 [1] CRAN (R 3.6.2) #> cli 2.0.2 2020-02-28 [1] CRAN (R 3.6.0) #> colorspace 1.4-1 2019-03-18 [1] CRAN (R 3.6.0) #> crayon 1.3.4 2017-09-16 [1] CRAN (R 3.6.0) #> curl 4.3 2019-12-02 [1] CRAN (R 3.6.0) #> desc 1.2.0 2018-05-01 [1] CRAN (R 3.6.0) #> devtools 2.3.1 2020-07-21 [1] CRAN (R 3.6.2) #> digest 0.6.25 2020-02-23 [1] CRAN (R 3.6.0) #> dplyr 0.8.5 2020-03-07 [1] CRAN (R 3.6.0) #> ellipsis 0.3.0 2019-09-20 [1] CRAN (R 3.6.0) #> evaluate 0.14 2019-05-28 [1] CRAN (R 3.6.0) #> fansi 0.4.1 2020-01-08 [1] CRAN (R 3.6.0) #> farver 2.0.3 2020-01-16 [1] CRAN (R 3.6.0) #> fs 1.3.2 2020-03-05 [1] CRAN (R 3.6.0) #> ggplot2 * 3.3.2 2020-06-19 [1] CRAN (R 3.6.2) #> glue 1.4.1 2020-05-13 [1] CRAN (R 3.6.2) #> gtable 0.3.0 2019-03-25 [1] CRAN (R 3.6.0) #> highr 0.8 2019-03-20 [1] CRAN (R 3.6.0) #> htmltools 0.4.0 2019-10-04 [1] CRAN (R 3.6.0) #> httr 1.4.1 2019-08-05 [1] CRAN (R 3.6.0) #> knitr 1.28 2020-02-06 [1] CRAN (R 3.6.0) #> labeling 0.3 2014-08-23 [1] CRAN (R 3.6.0) #> lifecycle 0.2.0 2020-03-06 [1] CRAN (R 3.6.0) #> magrittr 1.5 2014-11-22 [1] CRAN (R 3.6.0) #> memoise 1.1.0 2017-04-21 [1] CRAN (R 3.6.0) #> mime 0.9 2020-02-04 [1] CRAN (R 3.6.0) #> munsell 0.5.0 2018-06-12 [1] CRAN (R 3.6.0) #> pillar 1.4.3 2019-12-20 [1] CRAN (R 3.6.0) #> pkgbuild 1.0.6 2019-10-09 [1] CRAN (R 3.6.0) #> pkgconfig 2.0.3 2019-09-22 [1] CRAN (R 3.6.0) #> pkgload 1.0.2 2018-10-29 [1] CRAN (R 3.6.0) #> prettyunits 1.1.1 2020-01-24 [1] CRAN (R 3.6.0) #> processx 3.4.2 2020-02-09 [1] CRAN (R 3.6.0) #> ps 1.3.2 2020-02-13 [1] CRAN (R 3.6.0) #> purrr 0.3.3 2019-10-18 [1] CRAN (R 3.6.0) #> R6 2.4.1 2019-11-12 [1] CRAN (R 3.6.0) #> Rcpp 1.0.3 2019-11-08 [1] CRAN (R 3.6.0) #> remotes 2.2.0 2020-07-21 [1] CRAN (R 3.6.2) #> rlang 0.4.6 2020-05-02 [1] CRAN (R 3.6.2) #> rmarkdown 2.3 2020-06-18 [1] CRAN (R 3.6.2) #> rprojroot 1.3-2 2018-01-03 [1] CRAN (R 3.6.0) #> scales 1.1.0 2019-11-18 [1] CRAN (R 3.6.0) #> sessioninfo 1.1.1 2018-11-05 [1] CRAN (R 3.6.0) #> stringi 1.4.6 2020-02-17 [1] CRAN (R 3.6.0) #> stringr 1.4.0 2019-02-10 [1] CRAN (R 3.6.0) #> testthat 2.3.2 2020-03-02 [1] CRAN (R 3.6.0) #> tibble * 3.0.1 2020-04-20 [1] CRAN (R 3.6.2) #> tidyselect 1.1.0 2020-05-11 [1] CRAN (R 3.6.2) #> usethis 1.6.1 2020-04-29 [1] CRAN (R 3.6.2) #> vctrs 0.3.1 2020-06-05 [1] CRAN (R 3.6.2) #> withr 2.1.2 2018-03-15 [1] CRAN (R 3.6.0) #> xfun 0.12 2020-01-13 [1] CRAN (R 3.6.0) #> xml2 1.2.2 2019-08-09 [1] CRAN (R 3.6.0) #> yaml 2.2.1 2020-02-01 [1] CRAN (R 3.6.0) #> #> [1] /Library/Frameworks/R.framework/Versions/3.6/Resources/library ```