Merge pull request #132 from miraisolutions/develop

2.2.1 release

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Covid19Mirai
 Title: Covid-19 Data Analysis
-Version: 2.2.0
+Version: 2.2.1
 Authors@R: 
     c(person("Francesca", "Vitalini", role = c("cre", "aut"),
              email = 'francesca.vitalini@mirai-solutions.com'),

NEWS.md

@@ -1,3 +1,8 @@
+### Covid19Mirai 2.2.1 (2020-10-26)
+- Removed contagion day in x axis, replaced with dates (#126)
+- 2 maps added in continent page: tests per 1M, Positive test rates (#127)
+- Enhanced global map in first page (#55)
+
 ### Covid19Mirai 2.2.0 (2020-09-04)
 - Added Switzerland tab with maps at Kanton level (#20)
 - Reviewed calculation and definition of Growth Factors (#122)

R/app_server.R

@@ -62,9 +62,10 @@ app_server <- function(input, output, session) {
 
   # align contagion day for comparisons
   data_filtered <-
-    orig_data_aggregate %>%
+      orig_data_aggregate %>%
       rescale_df_contagion(n = n, w = w)
 
+
   # determine vector of countries to be used in Global and Comparison pages
   # reactive
   countries <- reactive({
@@ -78,29 +79,29 @@ app_server <- function(input, output, session) {
   callModule(mod_global_server, "global", orig_data_aggregate = orig_data_aggregate,
              data_filtered = data_filtered, countries_data_map)
 
-  callModule(mod_continent_comparison_server, "continent_comparison", orig_data_aggregate = orig_data_aggregate, n = n, w = w, pop_data = pop_data)
+  callModule(mod_continent_comparison_server, "continent_comparison", orig_data_aggregate = orig_data_aggregate, nn = n, w = w, pop_data = pop_data)
 
   # select continents in tabs
   continents = c("Europe", "Asia", "Africa", "LatAm & Carib.", "Northern America", "Oceania")
   mainuicontinents = c("Europe", "Asia", "Africa", "LatAm", "NorthernAmerica", "Oceania")
   uicontinents = c("europe", "asia", "africa", "latam", "northernamerica", "oceania")
   for (i.cont in 1:length(continents)) {
     callModule(mod_continent_server, paste(mainuicontinents[i.cont], "comparison", sep = "_"),
-               orig_data_aggregate = orig_data_aggregate, n = n, w = w,
+               orig_data_aggregate = orig_data_aggregate, nn = n, w = w,
                pop_data = pop_data, countries_data_map = countries_data_map,
                cont = continents[i.cont], uicont = uicontinents[i.cont])
   }
   # Switzerland page
-  callModule(mod_ind_country_server, "swiss", data = orig_data_aggregate, country = "Switzerland", n = 10, w = w)
+  callModule(mod_ind_country_server, "swiss", data = orig_data_aggregate, country = "Switzerland", nn = n, w = w)
 
   # country choice, remove Switzerland
   orig_data_aggregate_noswiss = orig_data_aggregate %>% filter(Country.Region != "Switzerland")
   countriesnoswiss = reactive({
     countries()[countries()[,1] != "Switzerland",]
   })
-  callModule(mod_country_server, "country", data = orig_data_aggregate, countries = countriesnoswiss, n = 10, w = w, n.select = n)
+  callModule(mod_country_server, "country", data = orig_data_aggregate, countries = countriesnoswiss, nn = n, w = w, n.select = n)
 
-  callModule(mod_country_comparison_server, "country_comparison", data = orig_data_aggregate, countries = countries, n = 10, w = w, n.select = n)
+  callModule(mod_country_comparison_server, "country_comparison", data = orig_data_aggregate, countries = countries, nn = 100, w = w, n.select = n)
 
   # Modal ----
   # what is new pop-up

R/mod_bar_plot_day_contagion.R

@@ -17,25 +17,31 @@ mod_bar_plot_day_contagion_ui <- function(id){
 #' bar_plot_day_contagion Server Function
 #'
 #' @param country_data data.frame for one country
-#'
+#' @param datevar character variable used for X axis, date or contagion_day
+#' @param nn minimum date derived from first day with more than nn cases. Default 1000
 #' @import dplyr
 #' @import tidyr
 #' @import ggplot2
 #'
 #' @noRd
-mod_bar_plot_day_contagion_server <- function(input, output, session, country_data){
+mod_bar_plot_day_contagion_server <- function(input, output, session, country_data, datevar = "date", nn = 1000){
   ns <- session$ns
 
   statuses <- c("confirmed", "deaths", "recovered", "active")
   # select all variables
   allstatuses = c(statuses, paste0("new_", statuses))
 
   output$bar_plot_day_contagion <- renderPlot({
+
+    mindate = min(country_data$date[country_data$confirmed>nn])
+    country_data = country_data %>% filter(date > mindate)
+
     df <- country_data %>%
       ungroup() %>%
       #select(-Country.Region, -date) %>%
-      select(contagion_day, !!allstatuses) %>%
-      arrange(contagion_day)
+      select(!!datevar, !!allstatuses) %>%
+      arrange(!!as.symbol(datevar)) #%>%
+      #filter(confirmed > nn)
 
     tmp <- sapply(statuses, function(s){
       df[,s] - df[, paste0("new_", s)]
@@ -47,7 +53,7 @@ mod_bar_plot_day_contagion_server <- function(input, output, session, country_da
 
     df <- df %>%
       bind_cols(tmp) %>%
-      pivot_longer(cols = -contagion_day, names_to = "status_all", values_to = "value") %>%
+      pivot_longer(cols = -all_of(datevar), names_to = "status_all", values_to = "value") %>%
       mutate(bool_new = case_when(
         grepl("new_", .$status_all) ~ "new",
         grepl("diff_", .$status_all) ~ "total",

R/mod_compare_nth_cases_plot.R

@@ -7,6 +7,7 @@
 #' @param actives if TRUE then add new_active and active variables to vars.
 #' @param tests if TRUE then add new_test and test variables to vars.
 #' @param hosp if TRUE then add new_hosp and hosp variables to vars.
+#' @param selectvar character variable selected in ui.
 #'
 #' @noRd
 #'
@@ -17,7 +18,7 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = c("confirmed", "deaths", "r
                                                        "new_prevalence_rate_1M_pop",
                                                        "new_tests", "new_tests_rate_1M_pop","new_positive_tests_rate",
                                                         "growth_factor_3", "lethality_rate" ),
-                                          actives = TRUE, tests = FALSE, hosp = FALSE){
+                                          actives = TRUE, tests = FALSE, hosp = FALSE, selectvar = "new_confirmed"){
   ns <- NS(id)
 
   choices_plot = varsNames(vars)
@@ -47,7 +48,7 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = c("confirmed", "deaths", "r
       column(7,
              offset = 1,
              selectInput(inputId = ns("radio_indicator"), label = "",
-                          choices = choices_plot, selected ="new_confirmed")
+                          choices = choices_plot, selected = selectvar)
       ),
       column(4,
              selectInput(inputId = ns("radio_log_linear"), label = "",
@@ -62,7 +63,7 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = c("confirmed", "deaths", "r
 #' compare_nth_cases_plot Server Function
 #'
 #' @param df data.frame
-#' @param n min number of cases for a country to be considered. Default 1000
+#' @param nn minimum date derived from first day with more than nn cases. Default 1000
 #' @param w number of days of outbreak. Default 7
 #' @param n_highligth number of countries to highlight if istop == TRUE
 #' @param istop logical to choose title, if top n_highligth countries are selected
@@ -79,12 +80,14 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = c("confirmed", "deaths", "r
 #'
 #' @noRd
 mod_compare_nth_cases_plot_server <- function(input, output, session, df,
-                                              n = 1000, w = 7,
-                                              n_highligth = 5, istop = TRUE, g_palette = graph_palette){
+                                              nn = 1000, w = 7,
+                                              n_highligth = 5, istop = TRUE, g_palette = graph_palette, datevar = "date"){
   ns <- session$ns
+  df$Date = df[[datevar]]
 
   # Give DF standard structure; reacts to input$radio_indicator
   df_data <- reactive({
+
     if(istop) {
       countries_order =  df %>% filter(date == max(date)) %>%
         arrange(desc(!!as.symbol(req(input$radio_indicator)))) %>%
@@ -95,14 +98,20 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
     } else {
       data = df
     }
-    df_tmp <- data %>% .[,c("Country.Region", req(input$radio_indicator), "contagion_day")] %>%
+
+    # filter off x before nn
+    date_first_contagion = min(data$date[data$confirmed >= nn])
+    data = data[data$date >= date_first_contagion, ]
+
+    df_tmp <- data %>% .[,c("Country.Region", req(input$radio_indicator), "Date")] %>%
       bind_cols(data[,req(input$radio_indicator)] %>% setNames("Value")) %>%
       rename(Status = Country.Region ) %>%
-      rename(Date = contagion_day ) %>%
+      #rename(Date = contagion_day ) %>%
       select(-req(input$radio_indicator))
 
+    # filter dates with 0 contagions
 
-    if (istop && ("China" %in% df_tmp$Status)) {
+    if (istop && ("China" %in% df_tmp$Status) && datevar == "contagion_day") {
       # Day of the country with max contagions after china
       max_contagion_no_china <- df_tmp %>%
         filter(Status != "China") %>%
@@ -125,7 +134,8 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
 
   # Plot -----
   output$plot <- renderPlotly({
-    p <- plot_all_highlight(df_data(), log = log(), text = "Area", n_highligth = n_highligth, percent = ifelse(req(input$radio_indicator) %in% rate_vars, TRUE, FALSE), date_x = FALSE, g_palette)
+    p <- plot_all_highlight(df_data(), log = log(), text = "Area", n_highligth = n_highligth, percent = ifelse(req(input$radio_indicator) %in% rate_vars, TRUE, FALSE),
+                            date_x = ifelse(datevar == "date", TRUE,FALSE), g_palette)
     p <- p %>%
       plotly::ggplotly(tooltip = c("text", "x_tooltip", "y_tooltip")) %>%
       plotly::layout(legend = list(orientation = "h", y = 1.1, yanchor = "bottom", itemsizing = "constant"))
@@ -135,16 +145,18 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
 
   if (istop) {
     output$title <- renderUI({
-      div(h4(paste0("Top ",n_highligth," countries from day of ", n ," contagion")), align = "center", style = "margin-top:20px; margin-bottom:20px;")
+      div(h4(paste0("Top ",n_highligth," countries from day of ", nn ," contagion")), align = "center", style = "margin-top:20px; margin-bottom:20px;")
     })
   } else {
     output$title <- renderUI({
-      div(h4(paste0("Timeline from day of ", n ," contagion")), align = "center", style = "margin-top:20px; margin-bottom:20px;")
+      div(h4(paste0("Timeline from day with ", nn ," contagions")), align = "center", style = "margin-top:20px; margin-bottom:20px;")
     })
   }
 
   output$caption <- renderUI({
-      p(paste0("Computed as rolling weekly average. Day 0 is the day when ", n," confirmed cases are reached."))
+
+      p(paste0("Computed as rolling weekly average. ",ifelse(datevar == "date", "First day", "Contagion day 0"),
+               " is the day when ", nn," confirmed cases are reached."))
   })
 }
 

R/mod_continent.R

@@ -75,6 +75,14 @@ mod_continent_ui <- function(id, uicont){
      column(6,
             withSpinner(uiOutput(ns(paste("map_countries_death", uicont , sep = "_"))))
      )
+   ),
+   fluidRow(
+     column(6,
+            withSpinner(uiOutput(ns(paste("map_countries_tests_1M", uicont , sep = "_"))))
+     ),
+     column(6,
+            withSpinner(uiOutput(ns(paste("map_countries_positive_rate", uicont , sep = "_"))))
+     )
    ),
     mod_add_table_ui(ns(paste("add_table_cont", uicont , sep = "_"))),
     hr(),
@@ -86,15 +94,15 @@ mod_continent_ui <- function(id, uicont){
 #'
 #' @param orig_data_aggregate data.frame with data from 1 continent
 #' @param countries_data_map full sp data.frame with map details
-#' @param n min number of cases for a country to be considered. Default 1000
+#' @param nn min number of cases for a country to be considered. Default 1000
 #' @param w number of days of outbreak. Default 7
 #' @param pop_data data.frame population
 #' @param cont character continent or subcontinent name
 #' @param uicont character continent or subcontinent name of ui
 #' @import dplyr
 #'
 #' @noRd
-mod_continent_server <- function(input, output, session, orig_data_aggregate, countries_data_map, n = 1000, w = 7, pop_data, cont, uicont){
+mod_continent_server <- function(input, output, session, orig_data_aggregate, countries_data_map, nn = 1000, w = 7, pop_data, cont, uicont){
   ns <- session$ns
 
   message("Process continent ", cont)
@@ -125,7 +133,7 @@ mod_continent_server <- function(input, output, session, orig_data_aggregate, co
 
   subcontinent_data_filtered <-
     subcontinent_data %>% # select sub-continents with longer outbreaks
-      rescale_df_contagion(n = n, w = w)
+      rescale_df_contagion(n = nn, w = w)
 
   continent_data_today <-
     continent_data %>%
@@ -155,15 +163,16 @@ mod_continent_server <- function(input, output, session, orig_data_aggregate, co
   levs <- sort_type_hardcoded()
 
   df_continent =
-    tsdata_areplot(continent_data,levs)
+    tsdata_areplot(continent_data,levs, nn = nn)
 
   callModule(mod_plot_log_linear_server, "plot_area_cont", df = df_continent, type = "area", g_palette = subcont_palette)
   output[[paste("from_nth_case", uicont , sep = "_")]]<- renderUI({
     HTML(paste(
       paste0(cont, " countries are grouped in Macro Areas as defined by United Nations."),
       paste0("The Areas are represented by the colors in the heatmap above, used also in the graphs of this page."),
-      paste0("Only Areas with more than ", n, " confirmed cases, and outbreaks longer than ", w, " days considered."),
-      paste0("Contagion day 0 is the first day with more than ", n ," cases."), sep = "<br/>"))
+      paste0("Only Areas with more than ", nn, " confirmed cases, and outbreaks longer than ", w, " days considered."),
+      #paste0("Contagion day 0 is the first day with more than ", nn ," cases."),
+      sep = "<br/>"))
   })
   # list of countries
   list.message =
@@ -182,25 +191,25 @@ mod_continent_server <- function(input, output, session, orig_data_aggregate, co
 
   callModule(mod_lineplots_day_contagion_server,
              "lineplots_day_contagion_cont",
-             subcontinent_data_filtered, g_palette = subcont_palette)
+             subcontinent_data, g_palette = subcont_palette, nn = nn)
 
   # Rate plots ----
   output[[paste("rateplots_cont", uicont , sep = "_")]] <- renderUI({
     mod_growth_death_rate_ui(ns("rate_plots_cont"))
   })
 
   callModule(mod_growth_death_rate_server, "rate_plots_cont", subcontinent_data_filtered,
-             n = n, n_highligth = length(subcontinents), istop = FALSE,
+             nn = nn, n_highligth = length(subcontinents), istop = FALSE,
              g_palette = list("growth_factor" = subcont_palette,
                                        "death_rate" = subcont_palette))
 
   # Line with bullet plot
 
   output[[paste("lines_points_plots_cont", uicont , sep = "_")]] <- renderUI({
-    mod_compare_nth_cases_plot_ui(ns("lines_points_plots_cont"))
+    mod_compare_nth_cases_plot_ui(ns("lines_points_plots_cont"), selectvar = "new_prevalence_rate_1M_pop")
   })
 
-  callModule(mod_compare_nth_cases_plot_server, "lines_points_plots_cont", subcontinent_data_filtered, n = n, w = w,
+  callModule(mod_compare_nth_cases_plot_server, "lines_points_plots_cont", subcontinent_data, nn = nn, w = w,
              n_highligth = length(subcontinents), istop = FALSE , g_palette = subcont_palette)
 
   # scatterplot
@@ -209,15 +218,15 @@ mod_continent_server <- function(input, output, session, orig_data_aggregate, co
   })
 
   callModule(mod_scatterplot_server, "scatterplot_plots_cont",
-             subcontinent_data_filtered, nmed = n, n_highligth = length(subcontinents),
+             subcontinent_data_filtered, nmed = nn, n_highligth = length(subcontinents),
              istop = FALSE, countries = subcontinents)
 
 
   output[[paste("status_stackedbarplot_cont", uicont , sep = "_")]] <- renderUI({
     mod_stackedbarplot_ui(ns("status_stackedbarplot_cont"))
   })
   callModule(mod_stackedbarplot_status_server, "status_stackedbarplot_cont",
-             subcontinent_data_filtered, n = n, n_highligth = length(subcontinents), istop = FALSE)
+             subcontinent_data_filtered, n_highligth = length(subcontinents), istop = FALSE)
 
   # Compute Last week variables
 
@@ -268,6 +277,20 @@ mod_continent_server <- function(input, output, session, orig_data_aggregate, co
   callModule(mod_map_area_calc_server, "map_countries_death", df = data_cont_maps,  countries_data_map_cont,
              area = cont, variable = "death")
 
+  #maps tests
+  output[[paste("map_countries_tests_1M", uicont , sep = "_")]] <- renderUI({
+    mod_map_area_calc_ui(ns("map_countries_tests_1M"))
+  })
+  callModule(mod_map_area_calc_server, "map_countries_tests_1M", df = data_cont_maps,  countries_data_map_cont,
+             area = cont, variable = "tests over 1M")
+
+  #maps positive test rates
+  output[[paste("map_countries_positive_rate", uicont , sep = "_")]] <- renderUI({
+    mod_map_area_calc_ui(ns("map_countries_positive_rate"))
+  })
+  callModule(mod_map_area_calc_server, "map_countries_positive_rate", df = data_cont_maps,  countries_data_map_cont,
+             area = cont, variable = "positive tests rate")
+
   # tables ----
   callModule(mod_add_table_server, paste("add_table_cont", uicont , sep = "_"),
              subcontinent_data_filtered, maxrowsperpage = 10)