End date 22-06 (#263)

Added actionButtons
Fixed bug map
Added data to rds

R/app_server.R

@@ -31,6 +31,10 @@ app_server <- function(input, output, session) {
   pop_data <- DATA$pop_data
   countries_data_map <- DATA$countries_data_map
   TOTAL <- DATA$TOTAL
+  CONTINENTS <- DATA$CONTINENTS
+  ONE.CONTINENT <- DATA$ONE.CONTINENT
+
+
   # pop_data <- get_pop_datahub()
 
   #align continents from map with pop
@@ -87,7 +91,7 @@ app_server <- function(input, output, session) {
 
     if (req(input$main_ui) == "Continents"  && summary_var() == 0) {
       message("-- Do Continents module")
-      callModule(mod_continent_comparison_server, "continent_comparison", orig_data_aggregate = orig_data_aggregate, nn = n, w = w, pop_data = pop_data)
+      callModule(mod_continent_comparison_server, "continent_comparison", orig_data_aggregate = orig_data_aggregate, conts_data = CONTINENTS, nn = n, w = w, pop_data = pop_data)
       summary_var(1)
     }
 
@@ -103,7 +107,7 @@ app_server <- function(input, output, session) {
         message("-- Do mod_continent_server module for ",contInfo$tab[i.cont])
 
         callModule(mod_continent_server, paste(contInfo$mainui[i.cont], "comparison", sep = "_"),
-                   orig_data_aggregate = orig_data_aggregate, nn = n, w = w,
+                   orig_data_aggregate = orig_data_aggregate, ONE.CONTINENT, nn = n, w = w,
                    pop_data = pop_data, countries_data_map = countries_data_map,
                    cont = contInfo$names[i.cont], uicont = contInfo$ui[i.cont])
         continents_var[[contInfo$ui[i.cont]]] = 1

R/app_ui.R

@@ -61,7 +61,7 @@ app_ui <- function(request) {
             span(
               id = "subtitle",
               #"Data source: worldometers from 26.03.2020, JHU CSSE before.",
-              tags$p(paste("Data source: COVID-19 Data Hub, latest update on", AsOfDate)) %>%
+              tags$p(paste("Data source: COVID-19 Data Hub, updates on", AsOfDate)) %>%
               #textOutput("last_update", inline = TRUE) %>%
                 bs_embed_tooltip(title = "Data Repository by COVID-19 Data Hub. More information in the README on our github page.", placement = "right")
 

R/build_data.R

@@ -106,12 +106,106 @@ build_data <- function() {
     total_today = total_today
   )
 
+  # Data for continent comparison module
+
+  # aggregate data to continent
+  message("Data for continent comparison module")
+  continent_data <- aggr_to_cont(orig_data_aggregate %>% filter(!is.na(continent)), "continent", "date")
+
+  continents = unique(continent_data$Country.Region)
+
+  nn <- 1000; w <- 7
+  # create data for comparison with common starting point
+  continent_data_filtered <- continent_data %>%
+    rescale_df_contagion(n = nn, w = w)
+
+  continent_data_filtered_today = continent_data_filtered %>%
+    add_growth_death_rate()
+
+  lw_continent_data_filtered =  lw_vars_calc(continent_data_filtered)
+  pw_continent_data_filtered =  lw_vars_calc(continent_data_filtered, 14)
+
+  continent_data_filtered_today = continent_data_filtered_today  %>%
+    left_join(lw_continent_data_filtered %>% select(-population))  %>%
+    left_join(pw_continent_data_filtered %>% select(-population))
+
+  CONTINENTS <- list(
+    continent_data = continent_data, continent_data_filtered_today = continent_data_filtered_today, continent_data_filtered = continent_data_filtered
+  )
+
+  # DATA for one continent;
+
+  build_continent <- function(cont) {
+    message("Build Continent ", cont)
+    orig_data_aggregate_cont <-
+      orig_data_aggregate %>% filter(continent == cont)
+
+    # subcontinents = reactive({sort(unique(orig_data_aggregate_cont$subcontinent))})
+    subcontinents = sort(unique(orig_data_aggregate_cont$subcontinent))
+
+    continent_data <-
+      aggr_to_cont(orig_data_aggregate_cont, "continent", "date" )
+
+    subcontinent_data <-
+      aggr_to_cont(orig_data_aggregate_cont, "subcontinent", "date" )
+
+    subcontinent_data_filtered <-
+      subcontinent_data %>% # select sub-continents with longer outbreaks
+      rescale_df_contagion(n = nn, w = w)
+
+    subcontinent_data_filtered_today = subcontinent_data_filtered %>%
+      add_growth_death_rate()
+
+    lw_subcontinent_data_filtered =  lw_vars_calc(subcontinent_data_filtered)
+    pw_subcontinent_data_filtered =  lw_vars_calc(subcontinent_data_filtered, 14)
+
+    subcontinent_data_filtered_today = subcontinent_data_filtered_today  %>%
+      left_join(lw_subcontinent_data_filtered %>% select(-population))  %>%
+      left_join(pw_subcontinent_data_filtered %>% select(-population))
+
+
+    continent_data_today <-
+      continent_data %>%
+      filter(date == AsOfDate)
+    lw_continent_data_today =  lw_vars_calc(continent_data)
+    pw_continent_data_today =  lw_vars_calc(continent_data, 14)
+
+    continent_data_today = continent_data_today  %>%
+      left_join(lw_continent_data_today %>% select(-population))  %>%
+      left_join(pw_continent_data_today %>% select(-population))
+
+    # Compute Last week variables
+    data7_aggregate_cont = lw_vars_calc(orig_data_aggregate_cont)
+    data14_aggregate_cont = lw_vars_calc(orig_data_aggregate_cont, 14)
+
+    orig_data_aggregate_cont_today = orig_data_aggregate_cont %>%
+      add_growth_death_rate()
+
+    # scatterplot
+
+    # remove small countries
+    countries200000 = sort(unique(orig_data_aggregate_cont_today$Country.Region[orig_data_aggregate_cont_today$population > 200000]))
+
+    # create datasets for maps merging today with data7
+    data_cont_maps = orig_data_aggregate_cont_today  %>%
+      left_join(data7_aggregate_cont %>% select(-population))  %>%
+      left_join(data14_aggregate_cont %>% select(-population))
+
+    list(continent_data_today = continent_data_today, continent_data = continent_data,
+         subcontinent_data = subcontinent_data, subcontinent_data_filtered = subcontinent_data_filtered,
+         subcontinent_data_filtered_today = subcontinent_data_filtered_today,
+         data_cont_maps = data_cont_maps)
+  }
+  continents <- unique(orig_data_aggregate$continent[!is.na(orig_data_aggregate$continent)])
+
+  ONE.CONTINENT <- lapply(continents, build_continent) %>% setNames(continents)
+
   message("** Save data as DATA.rds **")
   saveRDS(list(orig_data_aggregate = orig_data_aggregate,
                countries_data_map = countries_data_map,
                pop_data = pop_data,
                orig_data_ch_2 = orig_data_ch_2,
-               TOTAL = TOTAL), "inst/datahub/DATA.rds")
+               TOTAL = TOTAL, CONTINENTS = CONTINENTS, ONE.CONTINENT = ONE.CONTINENT), "inst/datahub/DATA.rds")
 
   # read data for default country at level 2
   area_data_2 <- get_datahub(country = .Selected_Country, lev = 2, verbose = FALSE)

R/get_data.R

@@ -140,7 +140,7 @@ get_timeseries_full_data <- function() {
   data
 }
 
-END.DATE <- "2022-09-01" # NULL to get the latest
+END.DATE <- "2022-06-01" # NULL to get the latest
 
 #' Get timeseries full data from datahub adding CH hospitalised data from level 2
 #' @rdname get_datahub

R/mod_compare_nth_cases_plot.R

@@ -355,12 +355,14 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
     df_data_roll <- reactive({
 
       if (rollw()) {
-        message("compute rolling average")
+        message("compare_nth_cases_plot: compute rolling average")
         data = df_data_1Mpop() %>%
           group_by(Country.Region) %>%
           #mutate(WeeklyAvg = zoo::rollapplyr(Value, 7, mean, partial=TRUE, align = "right")) %>%
           mutate(WeeklyAvgVal := rollAvg(!!sym(reactSelectVar()),date)) %>%
           ungroup()
+        message("compare_nth_cases_plot: compute rolling average done")
+
       } else
         data = df_data_1Mpop()
       if (FALSE) #TODO

R/mod_compare_nth_cases_years_plot.R

@@ -352,12 +352,13 @@ mod_compare_nth_cases_years_plot_server <- function(input, output, session, df,
 
       if (rollw()) {
 
-        message("compute rolling average")
+        message("compare_nth_cases_years_plot: compute rolling average")
         # override variable.
         data = data %>%
           #mutate(WeeklyAvg = zoo::rollapplyr(Value, 2, mean, partial=TRUE, align = "right")) %>%
           #mutate(!!sym(input$radio_indicator) := rollAvg(!!sym(input$radio_indicator),date))
           mutate(WeeklyAvgVal := rollAvg(!!sym(input$radio_indicator),date))
+        message("compare_nth_cases_years_plot; compute rolling average done")
 
       }