2.7.2 release (#212)

### Covid19Mirai 2.7.2 - Adjusted margins and padding for mobile (#210) - More countries in rds dump - Separated Individual country page
miraisolutions · Mar 5, 2022 · 0c6f55f · 0c6f55f
1 parent 9992ebf
commit 0c6f55f
Show file tree

Hide file tree

Showing 30 changed files with 534 additions and 278 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: Covid19Mirai
 Title: Covid-19 Data Analysis
-Version: 2.7.1
+Version: 2.7.2
 Authors@R: 
     c(person("Riccardo", "Porreca", role = ("aut"),
              email = "riccardo.porreca@mirai-solutions.com"),

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,8 @@
+### Covid19Mirai 2.7.2
+- Adjusted margins and padding for mobile (#210)
+- More countries in rds dump
+- Separated Individual country page
+
 ### Covid19Mirai 2.7.1 (2022-02-28)
 - Build data in package, updated with github action (#207)
 

diff --git a/R/app_server.R b/R/app_server.R
@@ -73,7 +73,9 @@ app_server <- function(input, output, session) {
       callModule(mod_global_server, "global", orig_data_aggregate = orig_data_aggregate,
                  countries_data_map)
       glob_var(1)
-    }
+    } else
+      message("Current SubTab: ", req(input$continents_ui) )
+
 
     orig_data_aggregate = orig_data_aggregate %>%
                 filter(!is.na(continent))
@@ -84,8 +86,6 @@ app_server <- function(input, output, session) {
       summary_var(1)
     }
 
-    message("Current SubTab: ", req(input$continents_ui) )
-
     # select continents in tabs
     # tabuicontinents = c("Europe", "Asia", "Africa", "Lat. America & Carib.", "Northern America", "Oceania")
     # continents = c("Europe", "Asia", "Africa", "LatAm & Carib.", "Northern America", "Oceania")
@@ -125,7 +125,7 @@ app_server <- function(input, output, session) {
     })
 
     # country choice, remove Switzerland
-   # orig_data_aggregate_noswiss = orig_data_aggregate %>% filter(Country.Region != "Switzerland")
+    # orig_data_aggregate_noswiss = orig_data_aggregate %>% filter(Country.Region != "Switzerland")
     countriesnoswiss = reactive({
       countries()[countries()[,1] != "Switzerland",]
     })

diff --git a/R/app_ui.R b/R/app_ui.R
@@ -104,7 +104,11 @@ app_ui <- function(request) {
                  mod_global_ui("global")),
         tabPanel("Continents",
                  #tabsetPanel(
+
                  navbarPage(
+                   collapsible = TRUE,
+                   fluid = TRUE,
+                   #position = "fixed-bottom",
                    "",
                    id = "continents_ui",
                    tabPanel("Summary",

diff --git a/R/build_data.R b/R/build_data.R
@@ -0,0 +1,69 @@
+#' Build data in GutHub action yml and save as RDS
+#' @rdname get_datahub
+#'
+#' @import dplyr
+#' @export
+build_data <- function() {
+
+  message("Start build_data, read Level 1 and CH at Level 2")
+  orig_data_with_ch <- get_datahub_fix_ch()
+  orig_data <- orig_data_with_ch$orig_data
+  orig_data_ch_2 <- orig_data_with_ch$orig_data_ch_2
+
+  orig_data <- orig_data %>%
+    get_timeseries_by_contagion_day_data()
+
+  orig_data_ch_2 <- orig_data_ch_2 %>%
+    get_timeseries_by_contagion_day_data()
+
+  message("** Save data as DATA.rds **")
+  saveRDS(list(orig_data = orig_data, orig_data_ch_2 = orig_data_ch_2), "inst/datahub/DATA.rds")
+
+  # read data for default country at level 2
+  area_data_2 <- get_datahub(country = .Selected_Country, lev = 2, verbose = FALSE)
+
+  # take main European countries:
+  pop_data <- get_pop_datahub()
+  europe <- pop_data %>% filter(continent == "Europe")
+
+  all_data <- merge_pop_data(orig_data, pop_data)
+
+  top_europe <- all_data %>%
+    filter(continent == "Europe") %>%
+    distinct(Country.Region,population) %>%
+    slice_max(population, n = 25) %>% as.data.frame() %>% .[,"Country.Region"]
+
+  top_counties <- all_data %>% distinct(Country.Region,population) %>%
+    slice_max(population, n = 25) %>% as.data.frame() %>% .[,"Country.Region"]
+
+  add_countries <- c("Australia", "Canada", "Argentina", "South Africa", "South Korea")
+  top_counties <- c(top_counties, add_countries)
+  # remove Switzerland and USA
+  all_countries <- union(top_counties, top_europe) %>% setdiff(c("Switzerland", "USA"))
+
+  message("reading data at level 2 for country: ", paste(all_countries, collapse = ","))
+
+  all_lev2_data <- sapply(all_countries, function(cntr) {
+    orig_data_2_tmp <- get_datahub(country = cntr, lev = 2, verbose = FALSE, cache = TRUE)
+    # cant use get_timeseries_by_contagion_day_data because of reconciliation of hosp data
+    # if (nrow(orig_data_2_tmp)>0)
+    #   orig_data_2_tmp <- orig_data_2_tmp %>%
+    #     get_timeseries_by_contagion_day_data()
+    orig_data_2_tmp
+  })
+
+  # remove those whithout data
+  idx <- sapply(1:length(all_lev2_data), function(x)
+    nrow(all_lev2_data[[x]])) >0
+  message("Level 2 data not found for ", sum(!idx), " countries out of ", length(idx))
+  all_lev2_data <- all_lev2_data[idx]
+
+  message("** Save data as Selected_Country.rds **")
+
+  saveRDS(list(area_data_2 = area_data_2), "inst/datahub/Selected_Country.rds")
+
+  message("** Save data as Top_Countries.rds **")
+
+  saveRDS(list(all_lev2_data = all_lev2_data, all_countries = all_countries), "inst/datahub/Top_Countries.rds")
+  NULL
+}
diff --git a/R/get_data.R b/R/get_data.R
@@ -244,9 +244,10 @@ combine_hospvars_lev2 <- function(data1, data2, country = "Switzerland") {
 #'
 #' @param country character country, to chose with lev = 2
 #' @param startdate character staring date
-#' @param lev integer 1 for country level, 2 for reagions
+#' @param lev integer 1 for country level, 2 for regions
 #' @param verbose logical. Print data sources? Default FALSE (opposite from \code{covid19})
-#' @param hosp logical. If TRUE hospitalised detailed data are retrieved. Default TRUE since release 2.3.1
+#' @param hosp logical. If TRUE hospitalized detailed data are retrieved. Default TRUE since release 2.3.1
+#' @param cache logical. If TRUE cache argument is used in the covid19() call
 #'
 #' @details data sourced from https://github.com/covid19datahub/COVID19/
 #'
@@ -257,7 +258,7 @@ combine_hospvars_lev2 <- function(data1, data2, country = "Switzerland") {
 #' @import zoo
 #'
 #' @export
-get_datahub = function(country = NULL, startdate = "2020-01-22", lev = 1, verbose = FALSE, hosp = TRUE) {
+get_datahub = function(country = NULL, startdate = "2020-01-22", lev = 1, verbose = FALSE, hosp = TRUE, cache = FALSE) {
   # country = NULL; startdate = "2020-01-22"; lev = 1; verbose = FALSE; hosp = TRUE
   message("get_datahub: country = ", country, "/ startdate = ", startdate, "/ level = ", lev)
   rawarg = TRUE
@@ -274,7 +275,8 @@ get_datahub = function(country = NULL, startdate = "2020-01-22", lev = 1, verbos
                      "U.S. Virgin Islands" = "U.S. Virgin Islands",
     )
   }
-  dataHub <- covid19(country = country, start = startdate, level = lev, verbose = verbose, raw = rawarg, cache = TRUE) # select level2 to add states
+  # cache = TRUE not needed since there are rds
+  dataHub <- covid19(country = country, start = startdate, level = lev, verbose = verbose, raw = rawarg, cache = cache) # select level2 to add states
   #dataHub <- covid19(country = country, level = lev) #
 
   # raw = FALSE then NAs replaced with 0s

diff --git a/R/mod_caseBoxes.R b/R/mod_caseBoxes.R
@@ -237,7 +237,7 @@ mod_caseBoxes_server <- function(input, output, session, counts, hosp = FALSE, v
   } else {
     if(!renderui) {
       insertUI(paste0("#",ns("hosp")),
-               ui = countBox3(title1 = "Hospitalised: ",
+               ui = countBox3(title1 = "Hospitalized: ",
                               subtitle1 = counts[["hosp"]],
                               title2 = "Last Week: ",
                               subtitle2 =  counts[["lw_hosp"]],
@@ -290,7 +290,7 @@ mod_caseBoxes_server <- function(input, output, session, counts, hosp = FALSE, v
       )
     } else {
       output$hosp <- renderUI({
-        countBox3(title1 = "Hospitalised: ",
+        countBox3(title1 = "Hospitalized: ",
                  subtitle1 = counts[["hosp"]],
                  title2 = "Last Week: ",
                  subtitle2 =  counts[["lw_hosp"]],

diff --git a/R/mod_compare_nth_cases_plot.R b/R/mod_compare_nth_cases_plot.R
@@ -59,6 +59,7 @@ choice_nthcases_plot = function(vars = .vars_nthcases_plot, actives = TRUE, test
 #' @param oneMpop if TRUE then rescaled vars over 1M pop are available.
 #' @param selectvar character variable selected in ui.
 #' @param areasearch logical if TRUE replace with Country.Region selectInput
+#' @param writetitle logical if TRUE title id is set
 #'
 #' @noRd
 #'
@@ -77,7 +78,9 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = .vars_nthcases_plot,
   if (istop) {
     plottitle = paste0("Top ",n_highlight," countries for the chosen variable")
   } else {
-    plottitle = paste0("Timeline from day with ", nn ," contagions")
+    plottitle = paste0("Timeline per variable",
+                       ifelse(areasearch, paste0(" area", ifelse(oneMpop, " & Pop. size", "")), "")
+                       )
   }
   # UI ----
   divtitle =  switch(writetitle ,div(class = "plottitle", plottitle, align = "center"),NULL)
@@ -103,7 +106,9 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = .vars_nthcases_plot,
                              selected = "lstmonth"))
           )
         ),
-        withSpinner(plotlyOutput(ns("plot"), height = 400)),
+        fluidRow(
+          withSpinner(plotlyOutput(ns("plot"), height = 400))
+        ),
         #div(uiOutput(ns("caption")), align = "center")
         div(htmlOutput(ns("caption")), align = "center", class = "plottext")
 
@@ -135,7 +140,9 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = .vars_nthcases_plot,
 
           )
         ),
-        withSpinner(plotlyOutput(ns("plot"), height = 400)),
+        fluidRow(
+          withSpinner(plotlyOutput(ns("plot"), height = 400))
+        ),
         #div(uiOutput(ns("caption")), align = "center")
         div(htmlOutput(ns("caption")), align = "center", class = "plottext", height = 10) # TODO: check why height = 10
 
@@ -169,8 +176,9 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = .vars_nthcases_plot,
                              choices = c("Last Month" = "lstmonth", "Last 6 Months" = "lst6month","Since Start" = "sincestart"), selected = "lstmonth"))
           ),
         ),
-        withSpinner(plotlyOutput(ns("plot"), height = 400)),
-        #div(uiOutput(ns("caption")), align = "center")
+        fluidRow(
+          withSpinner(plotlyOutput(ns("plot"), height = 400))
+        ),        #div(uiOutput(ns("caption")), align = "center")
         div(htmlOutput(ns("caption")), align = "center", class = "plottext", height = 10)
 
       )
@@ -200,8 +208,9 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = .vars_nthcases_plot,
                              multiple = TRUE))
           )
         ),
-        withSpinner(plotlyOutput(ns("plot"), height = 400)),
-        #div(uiOutput(ns("caption")), align = "center")
+        fluidRow(
+          withSpinner(plotlyOutput(ns("plot"), height = 400))
+        ),        #div(uiOutput(ns("caption")), align = "center")
         div(htmlOutput(ns("caption")), align = "center", class = "plottext", height = 10)
 
       )
@@ -254,7 +263,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
         filter(date == AsOfDate) %>%
         arrange(desc(confirmed)) %>% .[,"Country.Region"]
       selected_countries = head(countries$Country.Region,3)
-
     }
     # Update radio_indicator, if oneMpop then some variables must be excluded
     observe({
@@ -300,7 +308,7 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
   }
 
   cum_vars = intersect(get_cumvars(), names(df))
-  rollw = reactive(!req(input$radio_indicator) %in% cum_vars) # do not roll if cumulativ var
+  rollw = reactive(!req(input$radio_indicator) %in% cum_vars) # do not roll if cumulative var
 
   calc_line_plot = function(dat, vars, cum_vars) {
 
@@ -324,7 +332,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
     dat = dat[dat$date >= date_first_contagion, , drop = FALSE]
     # Give dat standard structure; reacts to input$radio_indicator
     df_data_1Mpop <- reactive({
-      message("df_data_1Mpop:")
       data = dat
       if (oneMpop && !is.null(input$radio_1Mpop) && input$radio_1Mpop == "oneMpop")  {
         if (all(is.na(data$population))) {
@@ -333,7 +340,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
         #if (!(paste(req(input$radio_indicator),"rate_1M_pop", sep = "_") %in% names(data))) {
         #varname = gsub("rate_1M_pop$","",reactSelectVar$radio_indicator)
         #reactSelectVar$radio_indicator = gsub("rate_1M_pop$","",reactSelectVar())
-        message("divide by pop size")
         data[, reactSelectVar()] = round(10^6*data[, reactSelectVar()] / data$population, 3)
         #}
       }
@@ -346,7 +352,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
       )
 
     df_data_roll <- reactive({
-      message("df_data_roll")
 
       if (rollw()) {
         message("compute rolling average")
@@ -369,7 +374,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
       data
     })
     df_data_timeframe <- reactive({
-      message("df_data_timeframe")
 
       data = df_data_roll()
       if (!is.null(input$time_frame)) {
@@ -412,7 +416,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
       data
     })
     df_istop <- reactive({
-      message("df_istop")
       data = df_data_timeframe()
       if(istop) {
         # countries_order =  data %>% filter(date == max(date)) %>%
@@ -430,7 +433,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
 
 
     df_out <- reactive({
-      message("df_out")
       data = df_istop()
       varsfinal = c("Country.Region", reactSelectVar(), "Date")
       if (strindx)
@@ -461,9 +463,10 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
     #rollw = TRUE
     # Plot -----
     output$plot <- renderPlotly({
-
       if (length(reactSelectVar()) == 0) {
         p <- blank_plot(where = "selected area", add = " All data missing")
+      # } else if (length(reactSelectVar()) == 0){
+      #   p <- blank_plot(where = "Variables have", add = " All data missing", what = reactSelectVar())
       } else {
         #secondline = NULL
         #if (!(input$radio_indicator %in% get_aggrvars()) || (input$time_frame != "sincestart"))

diff --git a/R/mod_compare_nth_cases_years_plot.R b/R/mod_compare_nth_cases_years_plot.R
@@ -101,7 +101,7 @@ mod_compare_timeline_plot_ui <- function(id, titles = 1:3,
 
   plottitleTLSE = "Timeline per variable"
   plottitleTLCY = "Timeline per calendar year"
-  plottitleTLTE = "Pandemic time evolution"
+  plottitleTLTE = "Pandemic evolution over time"
   alltitles = c(plottitleTLSE, plottitleTLCY, plottitleTLTE)[titles]
 
   plot_tabs <- tabsetPanel(
@@ -119,7 +119,7 @@ mod_compare_timeline_plot_ui <- function(id, titles = 1:3,
                                                  istop = istop, tests = tests, hosp = hosp, strindx = strindx, vax = vax,
                                                  selectvar = "new_deaths", writetitle = FALSE)
     ),
-    tabPanel("Pandemic time evolution",
+    tabPanel("Pandemic evolution over time",
              mod_plot_log_linear_ui(ns("timelinearea_plot"))
     )
   )
@@ -129,14 +129,21 @@ mod_compare_timeline_plot_ui <- function(id, titles = 1:3,
     #uiOutput(ns("title")),
     #div(h4(plottitle), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
     fluidRow(
-      column(7,
-             offset = 4,
-             div(class = "plottext", selectInput(inputId = ns("plot_indicator"), label = "Select view",
-                         choices = alltitles, selected = alltitles[1]))
-      )#,
+      #tagList(
+        column(7,
+               offset = 4,
+               div(class = "plottext", selectInput(inputId = ns("plot_indicator"), label = "Select view",
+                           choices = alltitles, selected = alltitles[1]))
+        )#,
+      #   tabPanel("Panel plot",
+      #            plot_tabs
+      #   )
+      # )
     ),
-    tabPanel("Panel plot",
-             plot_tabs
+    fluidRow(
+      tabPanel("Panel plot",
+               plot_tabs
+      )
     )
   )
 
@@ -187,7 +194,7 @@ mod_compare_timeline_plot_server <- function(input, output, session, df,
                         n_highlight = n_highlight, istop = istop, g_palette = graph_palette, datevar = "date",
                         actives = actives, tests = tests, hosp = hosp, strindx = strindx, vax = vax, oneMpop = oneMpop, secondline = secondline, areasearch = areasearch)#, secondline = "stringency_index")
 
-           }, "Pandemic time evolution" ={
+           }, "Pandemic evolution over time" ={
              levs <- areaplot_vars()
              callModule(mod_plot_log_linear_server, "timelinearea_plot", df = df, type = "area", process_data = TRUE, fun.args = list(levs = levs, nn = nn))
 
@@ -225,7 +232,8 @@ mod_compare_timeline_plot_server <- function(input, output, session, df,
 #' @importFrom shinycssloaders withSpinner
 mod_compare_nth_cases_years_plot_ui <- function(id, vars = .vars_nthcases_plot,
                                                 istop = TRUE, n_highlight = 10,
-                                                actives = TRUE, tests = TRUE, hosp = TRUE, strindx = TRUE, vax = TRUE, selectvar = "new_deaths", writetitle = TRUE){
+                                                actives = TRUE, tests = TRUE, hosp = TRUE, strindx = TRUE, vax = TRUE,
+                                                selectvar = "new_deaths", writetitle = TRUE){
   ns <- NS(id)
 
   choices_plot = choice_nthcases_plot(vars, actives = actives, tests = tests, hosp = hosp, strindx = strindx, vax = vax) # do not add stringency_index in possible choices
@@ -251,8 +259,9 @@ mod_compare_nth_cases_years_plot_ui <- function(id, vars = .vars_nthcases_plot,
                          choices = c("Last Month" = "lstmonth", "Full year" = "sincestart"), selected = "lstmonth"))
       ),
     ),
-    withSpinner(plotlyOutput(ns("plot"), height = 400)),
-    #div(uiOutput(ns("caption")), align = "center")
+    fluidRow(
+      withSpinner(plotlyOutput(ns("plot"), height = 400))
+    ),    #div(uiOutput(ns("caption")), align = "center")
     div(htmlOutput(ns("caption")), align = "center", height = 10, class = "plottext")
   )