add kpi in spain and kpi relative maps in spain

joscani · joscani · commit c0b499f92030 · 2020-03-22T16:07:21.000+01:00
diff --git a/data/pob_ccaa.rds b/data/pob_ccaa.rds
diff --git a/load_data.R b/load_data.R
@@ -7,7 +7,6 @@ library(shinydashboard)
 library(htmltools)
 library(leafpop)
 
-
 source(paste0(getwd(), "/model/generate_data.R"))
 # source(paste0(getwd(), "/model/generate_ccaa_data.R"))
 
@@ -106,8 +105,12 @@ cvirus_map_data <- res %>%
            fallecidos = sum(fallecidos)) %>% 
     ungroup()
 
-var_global_list <-  c("casos","recuperados", "fallecidos", "casos_nuevos", 
-                      "recuperados_nuevos", "fallecidos_nuevos")
+var_ccaa_list <- c("casos_por_100_mil_habitantes",
+                   "recuperados_por_100_mil_habitantes",
+                   "fallecidos_por_100_mil_habitantes",
+                   "casos_nuevos_por_100_mil_habitantes",
+                   "recuperados_diarios_por_100_mil_habitantes",
+                   "fallecidos_diarios_por_100_mil_habitantes")
 
 ## TODO try to change to highcharter and conver to interactive shiny
 
@@ -291,6 +294,10 @@ ccaa_longer <- ccaa_casos_longer %>%
               by = c("cod_ine", "fecha"))
 ccaa_longer$fecha <- as.Date(as.character(ccaa_longer$fecha), format = "%d/%m/%y")
 
+pob_ccaa <- readRDS("data/pob_ccaa.rds")
+
+ccaa_longer <- ccaa_longer %>% left_join(pob_ccaa, by = c("cod_ine" = "Codigo"))
+
 ## Mapa ccaa ----
 
 mapa_ccaa <- readRDS("data/mapa_ccaa.rds")
@@ -303,7 +310,8 @@ ccaa_data_subplots <-  ccaa_longer %>%
         casos = sum(casos),
         recuperados = sum(altas),
         fallecidos = sum(fallecidos),
-        ingresos_uci = sum(ingresos_uci)
+        ingresos_uci = sum(ingresos_uci),
+        pob2019 = first(pob2019)
     ) %>% 
     mutate(
         casos_prev_day = lag(casos, n = 1,  default = 0),
@@ -325,14 +333,16 @@ ccaa_data_subplots <-  ccaa_longer %>%
 
     
 ccaa_map_data <- ccaa_data_subplots %>% 
-    filter(CCAA != "Total") %>% 
-    group_by(cod_ine, CCAA) %>% 
-    filter(fecha == max(fecha)) %>% 
-    mutate(casos = sum(casos),
-           recuperados = sum(recuperados),
-           fallecidos = sum(fallecidos),
-           ingresos_uci = sum(ingresos_uci, na.rm =TRUE)
-           ) %>% 
+    filter(CCAA != "Total" & fecha == max(fecha)) %>% 
+    mutate (
+        casos_por_100_mil_habitantes = 1e5 * casos / pob2019,
+        recuperados_por_100_mil_habitantes = 1e5 * recuperados / pob2019,
+        fallecidos_por_100_mil_habitantes = 1e5 * fallecidos / pob2019,
+        casos_nuevos_por_100_mil_habitantes = 1e5 * casos_nuevos / pob2019,
+        recuperados_diarios_por_100_mil_habitantes = 1e5 * recuperados_nuevos / pob2019,
+        fallecidos_diarios_por_100_mil_habitantes = 1e5 * fallecidos_nuevos / pob2019
+        
+    ) %>% 
     ungroup()
 
 
@@ -379,70 +389,28 @@ mapa_ccaa  <-  mapa_ccaa %>%
     inner_join(ccaa_map_data, by = c("Codigo" = "cod_ine") )
 
 
-mapa_ccaa_leaflet <- 
-    leaflet(mapa_ccaa) %>%
-    addProviderTiles("Stamen.Toner") %>%
-    addPolygons(color = "#444444", weight = 1, smoothFactor = 0.5,
-                group = "Ingresos UCI",
-                opacity = 1.0, fillOpacity = 0.5,
-                fillColor = ~colorNumeric("Reds", ingresos_uci)(ingresos_uci),
-                label = lapply(mapa_ccaa$labs, htmltools::HTML),
-                highlightOptions = highlightOptions(color = "white", weight = 2,
-                                                    bringToFront = TRUE)) %>% 
-    addLegend("bottomleft", pal =  colorNumeric("Reds", mapa_ccaa$ingresos_uci),
-              values = ~ingresos_uci,
-              title = "Ingresos UCI",
-              group = "Ingresos UCI",
-              # labFormat = labelFormat(prefix = "$"),
-              opacity = 1) %>% 
-    
-    addPolygons(color = "#444444", weight = 1, smoothFactor = 0.5,
-                group = "Casos",
-                opacity = 1.0, fillOpacity = 0.5,
-                fillColor = ~colorNumeric("Blues", casos)(casos),
-                label = lapply(mapa_ccaa$labs, htmltools::HTML),
-                highlightOptions = highlightOptions(color = "white", weight = 2,
-                                                    bringToFront = TRUE)) %>% 
-    addLegend("bottomleft", pal =  colorNumeric("Blues", mapa_ccaa$casos),
-              values = ~casos,
-              title = "Casos",
-              group = "Casos",
-              # labFormat = labelFormat(prefix = "$"),
-              opacity = 1) %>% 
-    
-    
-    addPolygons(color = "#444444", weight = 1, smoothFactor = 0.5,
-                group = "Fallecidos",
-                opacity = 1.0, fillOpacity = 0.5,
-                fillColor = ~colorNumeric("Reds", fallecidos)(fallecidos),
-                label = lapply(mapa_ccaa$labs, htmltools::HTML),
-                highlightOptions = highlightOptions(color = "white", weight = 2,
-                                                    bringToFront = TRUE)) %>% 
-    addLegend("bottomright", pal =  colorNumeric("Reds", mapa_ccaa$fallecidos),
-              values = ~fallecidos,
-              title = "Fallecidos",
-              group = "Fallecidos",
-              # labFormat = labelFormat(prefix = "$"),
-              opacity = 1) %>% 
-    addPolygons(color = "#444444", weight = 1, smoothFactor = 0.5,
-                group = "Recuperados",
-                opacity = 1.0, fillOpacity = 0.5,
-                fillColor = ~colorNumeric("Greens", recuperados)(recuperados),
-                label = lapply(mapa_ccaa$labs, htmltools::HTML),
-                highlightOptions = highlightOptions(color = "white", weight = 2,
-                                                    bringToFront = TRUE)) %>% 
-    addLegend("bottomright", pal =  colorNumeric("Greens", mapa_ccaa$recuperados),
-              values = ~recuperados,
-              title = "Recuperados",
-              group = "Recuperados",
-              # labFormat = labelFormat(prefix = "$"),
-              opacity = 1) %>% 
-    
-    # Layers control
-    addLayersControl(
-        baseGroups = c("Casos", "Ingresos UCI","Fallecidos","Recuperados" ),
-        # overlayGroups = c("Quakes", "Outline"),
-        options = layersControlOptions(collapsed = FALSE)
-    )
+pal1 <- colorNumeric(
+    palette = "Reds",
+    domain = mapa_ccaa$casos_por_100_mil_habitantes)
 
-    
+mapa_ccaa_leaflet <-
+    leaflet(mapa_ccaa) %>%
+    addProviderTiles("Stamen.Toner")  %>%
+    addPolygons(
+        color = "#444444",
+        weight = 1,
+        smoothFactor = 0.5,
+        # group = "Ingresos UCI",
+        opacity = 1.0,
+        fillOpacity = 0.5,
+        fillColor = ~ pal1(casos_por_100_mil_habitantes),
+        label = lapply(mapa_ccaa$labs, htmltools::HTML),
+        highlightOptions = highlightOptions(
+            color = "white",
+            weight = 2,
+            bringToFront = TRUE
+        )) %>% 
+    addLegend(position = "topleft",
+                     pal = pal1,
+              values = ~casos_por_100_mil_habitantes,
+                     title = "casos_por_100_mil_habitantes")
diff --git a/server_dir/map_ccaa_server.R b/server_dir/map_ccaa_server.R
@@ -1,10 +1,57 @@
 library(shinydashboard)
 
 
-output$mapa_ccaa <- renderLeaflet({
+
+# paleta reactiva
+colorpal <- reactive({
+    colorNumeric("Reds", mapa_ccaa[[input$var_ccaa]])
+})
+
+# mapa base con
+output$mapa_ccaa_base <- renderLeaflet({
     mapa_ccaa_leaflet
 })
 
+
+# Mapa reactiva
+observe({
+    pal <- colorpal()
+
+   leafletProxy("mapa_ccaa_base", data = mapa_ccaa) %>%
+        # clearShapes() %>%
+        addPolygons(
+            color = "#444444",
+            weight = 1,
+            smoothFactor = 0.5,
+            # group = "Ingresos UCI",
+            opacity = 1.0,
+            fillOpacity = 0.5,
+            fillColor = ~ pal( mapa_ccaa[[input$var_ccaa]]),
+            label = lapply(mapa_ccaa$labs, htmltools::HTML),
+            highlightOptions = highlightOptions(
+                color = "white",
+                weight = 2,
+                bringToFront = TRUE
+            )
+        )
+
+})
+
+# Leynda reactivos
+observe({
+    proxy <-   leafletProxy("mapa_ccaa_base", data = mapa_ccaa)
+    
+    # Remove any existing legend, and only if the legend is
+    # enabled, create a new one.
+    proxy %>% clearControls()
+        pal <- colorpal()
+        proxy %>% addLegend(position = "topleft",
+                            pal = pal, values = ~mapa_ccaa[[input$var_ccaa]],
+                            title = input$var_ccaa
+        )
+})
+
+# Fecha máxima
 output$max_fecha_ccaa <-  renderText({
     fecha_max <- ccaa_longer %>%
         summarise(fecha = max(fecha)) %>%
diff --git a/server_dir/simple_kpis_server.R b/server_dir/simple_kpis_server.R
@@ -1,5 +1,5 @@
 
-
+## global ----
 output$contagiados <- renderValueBox({
     casos_total <- cvirus_map_data %>%
         filter(fecha == max(fecha)) %>%
@@ -12,7 +12,7 @@ output$contagiados <- renderValueBox({
 
 output$recuperados <- renderValueBox({
     recuperados_total <- cvirus_map_data %>%
-        filter(fecha == max(fecha)) %>%
+        # filter(fecha == max(fecha)) %>%
         summarise(recuperados_total = sum(recuperados)) %>%
         pull(recuperados_total)
     
@@ -21,9 +21,66 @@ output$recuperados <- renderValueBox({
 
 output$fallecidos <- renderValueBox({
     fallecidos_total <- cvirus_map_data %>%
+        # filter(fecha == max(fecha)) %>%
+        summarise(fallecidos_total = sum(fallecidos)) %>%
+        pull(fallecidos_total)
+    
+    valueBox(fallecidos_total, subtitle = "Fallecidos", color = "red")
+})
+
+output$activos <- renderValueBox({
+    activos_total <- cvirus_map_data %>%
+        # filter(fecha == max(fecha)) %>%
+        summarise(casos_total = sum(casos),
+                  fallecidos_total = sum(fallecidos),
+                  recuperados_total = sum(recuperados)) %>%
+        mutate(activos_total = casos_total -  fallecidos_total - recuperados_total) %>% 
+    pull(activos_total)
+    
+    valueBox(activos_total, subtitle = "Casos activos ", color = "orange")
+})
+
+
+## Spain -----
+
+output$sp_contagiados <- renderValueBox({
+    casos_total <- mapa_ccaa %>%
         filter(fecha == max(fecha)) %>%
+        summarise(casos_total = sum(casos)) %>%
+        pull(casos_total)
+    
+    valueBox(casos_total, subtitle = "Contagiados", color = "black")
+})
+
+
+output$sp_recuperados <- renderValueBox({
+    recuperados_total <- mapa_ccaa %>%
+        # filter(fecha == max(fecha)) %>%
+        summarise(recuperados_total = sum(recuperados)) %>%
+        pull(recuperados_total)
+    
+    valueBox(recuperados_total, subtitle = "Recuperados", color = "green")
+})
+
+output$sp_fallecidos <- renderValueBox({
+    fallecidos_total <- mapa_ccaa %>%
+        # filter(fecha == max(fecha)) %>%
         summarise(fallecidos_total = sum(fallecidos)) %>%
         pull(fallecidos_total)
     
     valueBox(fallecidos_total, subtitle = "Fallecidos", color = "red")
-})
+})
+
+output$sp_activos <- renderValueBox({
+    activos_total <- mapa_ccaa %>%
+        # filter(fecha == max(fecha)) %>%
+        summarise(casos_total = sum(casos),
+                  fallecidos_total = sum(fallecidos),
+                  recuperados_total = sum(recuperados)) %>%
+        mutate(activos_total = casos_total -  fallecidos_total - recuperados_total) %>% 
+        pull(activos_total)
+    
+    valueBox(activos_total, subtitle = "Casos activos ", color = "orange")
+})
+
+
diff --git a/ui.R b/ui.R
@@ -13,7 +13,6 @@ header <- dashboardHeader( title = "Corona virus \n dashboard",
                            titleWidth = ancho_titulo_side
                            )
 
-
 # sidebar
 sidebar <- dashboardSidebar(
     width = ancho_titulo_side,
diff --git a/ui_dir/map_ccaa_ui.R b/ui_dir/map_ccaa_ui.R
@@ -3,10 +3,31 @@ library(shinydashboard)
 
 tab_mapa_ccaa <- tabItem(
   tabName = "Mapa_ccaa",
-  # h1("Mapa a día"), 
-  h2(textOutput("max_fecha_ccaa")),
+  h2("Fecha actualización datos: ") , h2(textOutput("max_fecha_ccaa")),
+  fluidRow(
+    valueBoxOutput("sp_contagiados"),
+    valueBoxOutput("sp_recuperados"),
+    valueBoxOutput("sp_fallecidos"),
+    valueBoxOutput("sp_activos")
+  ),
   br(),
   fluidRow(
-    leafletOutput("mapa_ccaa",  width="100%",height="600px")
+    
+    
+    column(3,
+           wellPanel(
+             selectInput('var_ccaa', 'Elige variables', choices = var_ccaa_list,
+                         selected = var_ccaa_list[1], width = 280)
+
+           )       
+    ),
+    
+    column(9,
+           leafletOutput("mapa_ccaa_base",  width="100%",height="600px")
+
+    )
   )
+  # fluidRow(
+  #   leafletOutput("mapa_ccaa",  width="100%",height="600px")
+  # )
 )
diff --git a/ui_dir/map_ui.R b/ui_dir/map_ui.R
@@ -9,10 +9,11 @@ library(shinydashboard)
     fluidRow(
       valueBoxOutput("contagiados"),
       valueBoxOutput("recuperados"),
-      valueBoxOutput("fallecidos")
+      valueBoxOutput("fallecidos"),
+      valueBoxOutput("activos")
     ),
     br(),
-    h5("Radio círculos =  3 * log( fallecidos + 1 )"),
+    # h5("Radio círculos =  3 * log( fallecidos + 1 )"),
     fluidRow(
       leafletOutput("mapa_global", width="100%",height="600px")
     )

Original file line number	Diff line number	Diff line change
`@@ -13,7 +13,6 @@ header <- dashboardHeader( title = "Corona virus \n dashboard",`
`13`	`13`	`titleWidth = ancho_titulo_side`
`14`	`14`	`)`
`15`	`15`
`16`		`-`
`17`	`16`	`# sidebar`
`18`	`17`	`sidebar <- dashboardSidebar(`
`19`	`18`	`width = ancho_titulo_side,`