etc5523-2020 / exercise2C

For students to submit their reproducible example in the issue
0 stars 0 forks source link

Issue for line graph on x-axis about overlapping date label #18

Closed xhee0013 closed 3 years ago

xhee0013 commented 3 years ago

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.

library(ggplot2)
library(tibble)
count_date1 <- tribble(~Date, ~freq,
                       "13-04-2015", 24,
                       "13-05-2015", 12,
                       "13-06-2015", 32,
                       "14-04-2015", 23,
                       "14-05-2015", 15,
                       "14-06-2015", 16,
                       "15-04-2015", 12,
                       "15-04-2015", 12,
                       "15-06-2015", 34,
                       "16-04-2015", 20,
                       "4/1/2015", 18,
                       "4/10/2015", 21,
                       "4/11/2015", 5,
                       "4/12/2015", 15,
                       "4/2/2015", 27,
                       "4/7/2015", 15,
                       "4/4/2015", 12,
                       "4/5/2015", 6,
                       "4/6/2015", 13,
                       "4/7/2015", 25)

ggplot(count_date1, aes(Date,freq)) + 
  geom_point() + 
  geom_line(aes(group=Date)) +
  xlab("Date") + 
  ylab("No. of Complaints")

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 ```
xhee0013 commented 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)

Session info ``` r devtools::session_info() #> ─ Session info ─────────────────────────────────────────────────────────────── #> setting value #> version R version 4.0.2 (2020-06-22) #> os macOS Catalina 10.15.6 #> system x86_64, darwin17.0 #> ui X11 #> language (EN) #> collate en_AU.UTF-8 #> ctype en_AU.UTF-8 #> tz Australia/Melbourne #> date 2020-10-06 #> #> ─ Packages ─────────────────────────────────────────────────────────────────── #> package * version date lib #> assertthat 0.2.1 2019-03-21 [1] #> backports 1.1.7 2020-05-13 [1] #> blob 1.2.1 2020-01-20 [1] #> broom 0.5.6 2020-04-20 [1] #> callr 3.4.3 2020-03-28 [1] #> cellranger 1.1.0 2016-07-27 [1] #> cli 2.0.2 2020-02-28 [1] #> colorspace 1.4-1 2019-03-18 [1] #> coronavirus * 0.3.0.9000 2020-09-17 [1] #> crayon 1.3.4 2017-09-16 [1] #> crosstalk 1.1.0.1 2020-03-13 [1] #> data.table 1.12.8 2019-12-09 [1] #> DBI 1.1.0 2019-12-15 [1] #> dbplyr 1.4.4 2020-05-27 [1] #> desc 1.2.0 2018-05-01 [1] #> devtools 2.3.1 2020-07-21 [1] #> digest 0.6.25 2020-02-23 [1] #> downloader 0.4 2015-07-09 [1] #> dplyr * 1.0.2 2020-08-18 [1] #> DT * 0.15 2020-08-05 [1] #> ellipsis 0.3.1 2020-05-15 [1] #> evaluate 0.14 2019-05-28 [1] #> fansi 0.4.1 2020-01-08 [1] #> fastmap 1.0.1 2019-10-08 [1] #> forcats * 0.5.0 2020-03-01 [1] #> formattable * 0.2.0.1 2016-08-05 [1] #> fs 1.4.1 2020-04-04 [1] #> generics 0.0.2 2018-11-29 [1] #> ggplot2 * 3.3.0 2020-03-05 [1] #> glue 1.4.1 2020-05-13 [1] #> gtable 0.3.0 2019-03-25 [1] #> haven 2.2.0 2019-11-08 [1] #> highr 0.8 2019-03-20 [1] #> hms 0.5.3 2020-01-08 [1] #> htmltools 0.5.0 2020-06-16 [1] #> htmlwidgets 1.5.1 2019-10-08 [1] #> httpuv 1.5.4 2020-06-06 [1] #> httr 1.4.2 2020-07-20 [1] #> jsonlite 1.6.1 2020-02-02 [1] #> knitr 1.29 2020-06-23 [1] #> later 1.0.0 2019-10-04 [1] #> lattice 0.20-41 2020-04-02 [1] #> lazyeval 0.2.2 2019-03-15 [1] #> leaflet * 2.0.3 2019-11-16 [1] #> lifecycle 0.2.0 2020-03-06 [1] #> lubridate * 1.7.8 2020-04-06 [1] #> magrittr 1.5 2014-11-22 [1] #> markdown 1.1 2019-08-07 [1] #> memoise 1.1.0 2017-04-21 [1] #> mime 0.9 2020-02-04 [1] #> modelr 0.1.8 2020-05-19 [1] #> munsell 0.5.0 2018-06-12 [1] #> nCov2019 * 0.3.6 2020-09-27 [1] #> nlme 3.1-148 2020-05-24 [1] #> pillar 1.4.4 2020-05-05 [1] #> pkgbuild 1.0.8 2020-05-07 [1] #> pkgconfig 2.0.3 2019-09-22 [1] #> pkgload 1.0.2 2018-10-29 [1] #> plotly * 4.9.2.1 2020-04-04 [1] #> prettyunits 1.1.1 2020-01-24 [1] #> processx 3.4.2 2020-02-09 [1] #> promises 1.1.0 2019-10-04 [1] #> ps 1.3.3 2020-05-08 [1] #> purrr * 0.3.4 2020-04-17 [1] #> R6 2.4.1 2019-11-12 [1] #> RColorBrewer 1.1-2 2014-12-07 [1] #> Rcpp 1.0.4.6 2020-04-09 [1] #> readr * 1.3.1 2018-12-21 [1] #> readxl 1.3.1 2019-03-13 [1] #> remotes 2.2.0 2020-07-21 [1] #> reprex 0.3.0 2019-05-16 [1] #> rlang 0.4.7 2020-07-09 [1] #> rmarkdown 2.3 2020-06-18 [1] #> rprojroot 1.3-2 2018-01-03 [1] #> rvest 0.3.5 2019-11-08 [1] #> scales 1.1.1 2020-05-11 [1] #> sessioninfo 1.1.1 2018-11-05 [1] #> shiny * 1.5.0 2020-06-23 [1] #> shinythemes * 1.1.2 2018-11-06 [1] #> stringi 1.4.6 2020-02-17 [1] #> stringr * 1.4.0 2019-02-10 [1] #> testthat 2.3.2 2020-03-02 [1] #> tibble * 3.0.1 2020-04-20 [1] #> tidyr * 1.0.3 2020-05-07 [1] #> tidyselect 1.1.0 2020-05-11 [1] #> tidyverse * 1.3.0 2019-11-21 [1] #> usethis 1.6.1 2020-04-29 [1] #> vctrs 0.3.4 2020-08-29 [1] #> viridisLite 0.3.0 2018-02-01 [1] #> withr 2.2.0 2020-04-20 [1] #> xfun 0.16 2020-07-24 [1] #> xml2 1.3.2 2020-04-23 [1] #> xtable 1.8-4 2019-04-21 [1] #> yaml 2.2.1 2020-02-01 [1] #> source #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> Github (RamiKrispin/coronavirus@bf29dc4) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.2) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> Github (GuangchuangYu/nCov2019@218c30f) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.2) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.2) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> CRAN (R 4.0.2) #> CRAN (R 4.0.0) #> #> [1] /Library/Frameworks/R.framework/Versions/4.0/Resources/library ```