covidfrance_shiny.R

library(leaflet)
library(sf)
library(rmapshaper)
library(dplyr, warn.conflicts = FALSE)
library(smoothr)
library(shiny)

u <- httr::GET('https://www.data.gouv.fr/api/1/datasets/5e7e104ace2080d9162b61d8/')
url_search <- httr::content(u)$resources

df_date <- tibble(url = url_search %>% purrr::map_chr('url'),
                  timestamp = url_search %>% purrr::map_chr('last_modified')) %>% 
    filter(grepl('hospitalieres-covid', url)) %>% 
    arrange(desc(timestamp)) %>% 
    pull(timestamp) %>% 
    .[1] %>% 
    lubridate::as_datetime() %>% 
    format(., '%Y-%m-%d à %Hh%Mm')

dat_cov <- readr::read_csv2('https://www.data.gouv.fr/fr/datasets/r/63352e38-d353-4b54-bfd1-f1b3ee1cabd7') %>% 
    filter(sexe == 0) %>% 
    filter(!is.na(jour)) %>% 
    select(dep, jour, hosp, rad, rea, dc)

ui <- bootstrapPage(
    
    tags$head(
        tags$link(href = "https://fonts.googleapis.com/css?family=Oswald", rel = "stylesheet"),
        tags$style(type = "text/css", "html, body {width:100%;height:100%; font-family: Oswald, sans-serif;}"),
        #includeHTML("meta.html"),
        tags$script(src="https://cdnjs.cloudflare.com/ajax/libs/iframe-resizer/3.5.16/iframeResizer.contentWindow.min.js",
                    type="text/javascript")),
    
    leafletOutput("covid", width = "100%", height = "100%"),
    
    absolutePanel(
        bottom = 20, left = 40, draggable = TRUE, width = "20%", style = "z-index:500; min-width: 300px;",
        titlePanel("France | Covid"),
        # br(),
        em('La donnée est affichée en plaçant la souris sur la carte'),
        sliderInput("jour",h3(""),
                    min = min(dat_cov$jour), max = max(dat_cov$jour), step = 1, 
                    value = max(dat_cov$jour),
                    animate = animationOptions(interval = 1700, loop = FALSE)),
        tags$style(".form-control {background-color: #d4dcdc !important; color: #333}"),
        dateInput(
            inputId = "date_1", 
            # value = min(dat_cov$jour),
            value = '2020-06-01',
            weekstart = 1,
            startview = "year",
            label = "Date de début",
            format = "D dd/mm/yyyy",
            min = min(dat_cov$jour),
            language = "fr",
            max = Sys.Date()
        ),
        shinyWidgets::prettyRadioButtons('sel_data', 'Donnée affichée', 
                                         choices = c('Hospitalisés', 'En réanimation', 'Retours à domicile (cumulés depuis 1ère vague)', 'Décès (cumulés depuis 1ère vague)'), 
                                         selected = 'Hospitalisés', 
                                         shape = "round", animation = "jelly",plain = TRUE,bigger = FALSE,inline = FALSE),
        shinyWidgets::prettySwitch('pop', "Ratio / 100 000 habitants*", FALSE),
        em(tags$small("*à noter sur ce ratio : un patient peut être hospitalisé plus d'une fois")),
        em(tags$small(br(), "Pour les décès, il s'agit de ceux ayant lieu à l'hôpital")),
        h5(tags$a(href = 'http://github.com/GuillaumePressiat', 'Guillaume Pressiat')),
        
        h5(em('Dernière mise à jour le ' , df_date)),
        
        #br(),
        tags$small(tags$li(tags$a(href = 'https://www.data.gouv.fr/fr/datasets/donnees-hospitalieres-relatives-a-lepidemie-de-covid-19', 'Données recueil Covid')),
                   tags$li(tags$a(href = 'https://github.com/gregoiredavid/france-geojson', 'Geojson contours départements')),
                   tags$li(tags$a(href = 'https://www.insee.fr/fr/statistiques/2012713#tableau-TCRD_004_tab1_departements', 'Populations Insee')),
                   tags$li(tags$a(href = 'http://r.iresmi.net/2020/04/01/covid-19-decease-animation-map/', 'Voir également ce lissage territorial')),
                   tags$li(tags$a(href = 'http://www.fabiocrameri.ch/resources/ScientificColourMaps_FabioCrameri.png', 'Scientific colour maps'), ' with ',
                           tags$a(href = 'https://cran.r-project.org/web/packages/scico/index.html', 'scico package'))))
    
    
)


#data.p <- sf::st_read("Downloads/contours-simplifies-des-departements-francais-2015.geojson") %>% 
# https://raw.githubusercontent.com/gregoiredavid/france-geojson/master/departements.geojson
# data.p <- sf::st_read("https://raw.githubusercontent.com/gregoiredavid/france-geojson/master/departements-avec-outre-mer.geojson") %>%
# #  filter(! code_reg %in% c('01', '02', '03', '04', '06')) %>%
#   ms_simplify(keep = 0.03) %>%
#   smooth(method = "chaikin")

pops <- readr::read_csv2('pop_insee.csv')

#st_write(data.p, 'deps.geojson', delete_dsn = TRUE)
 data.p <- st_read('deps.geojson')

data <- data.p %>% 
    #left_join(dat_cov, by = c('code_dept' = 'dep')) %>% 
    left_join(dat_cov, by = c('code' = 'dep')) %>% 
    left_join(pops, by = c('code' = 'dep'))


server <- function(input, output, session) {
    
    dataa <- reactive({
        data %>% filter(jour >= input$date_1)
    })
    
    observeEvent({input$date_1}, {
    updateSliderInput('jour', min = input$date_1, session = session)
    })
    
    get_data <- reactive({
        temp <- dataa()[which(dataa()$jour == input$jour),]
        if (input$sel_data == "Hospitalisés"){
            temp$val <- temp$hosp
        } else if (input$sel_data == "En réanimation"){
            temp$val <- temp$rea
        } else if (input$sel_data == "Retours à domicile (cumulés depuis 1ère vague)"){
            temp$val <- temp$rad
        } else if (input$sel_data == "Décès (cumulés depuis 1ère vague)"){
            temp$val <- temp$dc
        } 
        
        
        
        temp$label <- temp$val
        
        if (input$pop){
            temp$val <- (temp$val * 100000) / temp$pop2020
            temp$label <- paste0(temp$label, '<br><em>', round(temp$val,1), ' / 100 000 hab.</em><br>', prettyNum(temp$pop2020, big.mark = ' '), ' habitants')
        }
        
        temp <- temp %>% filter(jour >= input$date_1)
        return(temp)
        
    })
    values_leg <- reactive({
        temp <- dataa()
        if (input$sel_data == "Hospitalisés"){
            temp$leg <- temp$hosp
        } else if (input$sel_data == "En réanimation"){
            temp$leg <- temp$rea
        } else if (input$sel_data == "Retours à domicile (cumulés depuis 1ère vague)"){
            temp$leg <- temp$rad
        } else if (input$sel_data == "Décès (cumulés depuis 1ère vague)"){
            temp$leg <- temp$dc
        } 
        if (input$pop){
            temp$leg <- (temp$leg * 100000) / temp$pop2020
        }
        temp <- temp$leg
        # if (input$log){
        # temp <- log(temp)
        # temp[temp < 0] <- 0
        # }
        return(temp)
    })
    
    leg_title <- reactive({
        if (input$pop){
            htmltools::HTML('Nb pour<br>100 000 hab.')
        } else{
            'Nb'
        }
    })
    
    output$covid <- renderLeaflet({
        leaflet(data = data.p) %>%
            addProviderTiles("CartoDB", options = providerTileOptions(opacity = 1, minZoom = 3, maxZoom = 7), group = "Open Street Map") %>%
            setView(lng = 1, lat = 46.71111, zoom = 6) %>%
            addPolygons(group = 'base', 
                        fillColor = NA, 
                        color = 'white',
                        weight = 1.5)  %>%
            addLegend(pal = pal(), values = values_leg(), opacity = 1, title = leg_title(), 
                      position = "topright")
    })
    
    
    
    pal <- reactive({
        
        if (input$sel_data != "Retours à domicile (cumulés depuis 1ère vague)"){
            return(colorNumeric(scico::scico(n = 300, palette = "tokyo", direction = - 1, end = 0.85), values_leg(), na.color = NA))
        } else { 
            return(colorNumeric(scico::scico(n = 300, palette = "oslo", direction = - 1, begin = 0.2, end = 0.85), domain = values_leg(), na.color = NA))
        }
    })
    
    
    observe({
        if(input$jour == min(dat_cov$jour)){
            data <- get_data()
            leafletProxy('covid', data = data) %>%
                clearGroup('polygons') %>%
                addPolygons(group = 'polygons', 
                            fillColor = ~pal()(val), 
                            fillOpacity = 1, 
                            stroke = 2,
                            color = 'white',
                            weight = 1.5, label = ~ lapply(paste0("<b>", code, " - ", nom, "</b><br>",jour, ' : ', label), htmltools::HTML))
        } else {
            data <- get_data()
            leafletProxy('covid', data = data) %>%
                #clearGroup('polygons') %>%
                addPolygons(group = 'polygons',
                            fillColor = ~pal()(val), 
                            fillOpacity = 1, 
                            stroke = 2,
                            color = 'white',
                            weight = 1.5, label = ~ lapply(paste0("<b>", code, " - ", nom, "</b><br>",jour, ' : ', label), htmltools::HTML))
        }
        
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

Hi,

You have to simplify your shape file I think.

Whereas for @fsvm78 there are maybe too many shapes on his level, for US-states level it's ok. (100 departments in France, so ~50 states is ok).

For US-counties level (a better level to see more precisely COVID in this big country?), leafgl maybe is a package to consider.

But for states, it should work with your data.

Another thing to consider is to keep only variables that you will use for the data you have to put inside the shiny app server, same thing for leaflet maps.

You can run something like this to simplify and smooth (one time) your shapefile.

library(leaflet)
library(sf)
library(rmapshaper)
library(dplyr, warn.conflicts = FALSE)
library(smoothr)
library(shiny)


 data.p <- sf::st_read("state.geo.json") %>%
    ms_simplify(keep = 0.025) %>%
    smooth(method = "chaikin") %>% 
    select(STATEFP10, geometry, NAME10, STUSPS10)

st_write(data.p, 'states_light.geojson', delete_dsn = TRUE)
data.p <- st_read('states_light.geojson')

Smoothing is not essential but sometimes pretty it depends. keep parameter set the amount of details you want to keep in shapes.

then you can test for one day and watch Sys.time:

> tictoc::tic()
> leaflet(data  %>% 
+           filter(day_file == lubridate::as_date('2020-07-17'))) %>% 
+   #addTiles() %>% 
+   addProviderTiles("CartoDB", options = providerTileOptions(opacity = 1, minZoom = 3, maxZoom = 5), group = "Open Street Map") %>%
+   setView(lng = -100, lat = 40, zoom = 3) %>% 
+   addPolygons(color = 'white', weight = 1.4, 
+               group = 'base', 
+               fillColor = ~pal_fun(Confirmed), 
+               fillOpacity = 1, stroke = 2, 
+               label = ~ popup) %>% 
+   addLegend("bottomleft", pal = pal_fun, values = ~Confirmed, 
+             title = 'Confirmed', opacity = 1)
> tictoc::toc()
0.689 sec elapsed

Simpler shape file and a possible app code tweaked for your US data is here https://github.com/GuillaumePressiat/covidusa (ok, I was really curious to see the result! see if it works first then explore data of another country is a good experience ; best manner to help through advices is to do the thing first...).

Lighter shape file is here : https://github.com/GuillaumePressiat/covidusa/blob/master/states_light.geojson

Let me know if it's ok on your side.

If you want to integrate your code and ideas with mine (I'm really novice for US states level and IDs so maybe there are some errors in my code).
I wrote a map function call to read daily files.

Lastly we could host an application on this theme on shinyapps.io (yours if you want) to play a little bit.

Hi @fsvm78,

Sorry for the delay.

I build the app with your data from 10/03 to 11/03

Code is here : https://github.com/GuillaumePressiat/covidbrasil

Not what you want (map on unidades da federação, not municipios) but time animation works.

Hope it helps.

Otherwise I see that in you dataset.csv, data are always the same for 10/03 and 11/03.

Hi, GuillaumePressiat,

with your help in simplifying the geojson, I am now able to make it fast. Thanks! (this really work) and I really appreciate the work you have done which I see it as a way to give more awareness during the COVID season. Respect!
While you are adding authentication on it which is another really cool feature! I feel astonished how you learned about this can be achieved by Shiny (through documentation? maybe).
As my first R project (new to R). basically learn the whole thing about shiny here and from the documentation. Thanks, I have already see you as a great teacher.

I am considering adding more features on this map.
An example which makes great sense for me is a map from:
https://coronavirus.1point3acres.com/en

I thought some great ideas can be found out when you explore this info site in design and make this app more attractive.

Hi @Halfbakedpanda,

Thanks for the feedback.

In case you haven't seen it : many shiny apps are collected here : https://www.statsandr.com/blog/top-r-resources-on-covid-19-coronavirus/ with open source code

Hi @GuillaumePressiat! I've been terrified these past few weeks and ended up not giving a return. Much work! Follow the code I made. I am grateful because I learned almost everything here and in the tutorials for shiny and leaflet. I am also improving in general in r (I am new), I have worked a lot in the analysis of scientific data. If my article is accepted I will make a special thanks to your help !!!

I am still trying to solve some problems with my code due to the size of the shapefile and the need to assess the level of the municipalities. I used Qgis to simplify my shapefile and now the app works better. If you have any more tips, thank you in advance!

https://drive.google.com/file/d/17D2CDQmyzoafQtf5n0DMOaw1b8Z3Tn5C/view?usp=sharing