2.7.1 release (#209)

### Covid19Mirai 2.7.1 (2022-02-28)
- Build data in package, updated with github action (#207)

.Rbuildignore

@@ -8,3 +8,4 @@
 ^man-roxygen$
 ^\.github$
 ^deploy$
+^rsconnect$

.github/workflows/ci-cd.yml

@@ -1,6 +1,10 @@
 # Triggered on push and pull request events
-on: [push, pull_request]
-
+on:
+  push:
+  pull_request:
+  schedule:
+    # every day at 8,16,21 UTC
+    - cron: "0 8,16,21 * * *"
 name: CI-CD
 
 # renv with GitHub actions: https://rstudio.github.io/renv/articles/ci.html#github-actions
@@ -40,12 +44,29 @@ jobs:
         shell: Rscript {0}
         run: renv::restore()
 
+      - name: Fetch and rebuild latest data
+        if: github.event_name == 'schedule'
+        run: |
+          pkgload::load_all(export_all = FALSE, helpers = FALSE, attach_testthat = FALSE)
+          build_data()
+        shell: Rscript {0}
+
       - name: Check package
         shell: Rscript {0}
         run: |
           install.packages("rcmdcheck")
           rcmdcheck::rcmdcheck(args = "--no-manual", error_on = "warning")
 
+      - name: Commit and push updated data
+        if: github.event_name == 'schedule'
+        run: |
+          git config --local user.email "actions@github.com"
+          git config --local user.name "GitHub Actions"
+          git add inst/datahub/\*
+          git commit -m "Update DataHub data" || echo "No changes to commit"
+          git pull --ff-only
+          git push origin
+
       - name: Deploy to shinyapps.io
         if: github.ref == 'refs/heads/master'
         env:

.gitignore

@@ -4,4 +4,6 @@
 .Ruserdata
 dev
 rsconnect
-mystuff
+deploy
+library
+local

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Covid19Mirai
 Title: Covid-19 Data Analysis
-Version: 2.6.1
+Version: 2.7.1
 Authors@R: 
     c(person("Riccardo", "Porreca", role = ("aut"),
              email = "riccardo.porreca@mirai-solutions.com"),

NAMESPACE

@@ -17,6 +17,7 @@ export(align_country_names_pop)
 export(align_country_names_pop_reverse)
 export(barplots_colors)
 export(basic_plot_theme)
+export(build_data)
 export(build_data_aggr)
 export(capitalize_first_letter)
 export(capitalize_names_df)
@@ -100,6 +101,8 @@ importFrom(graphics,plot.new)
 importFrom(grid,grid.draw)
 importFrom(leaflet,leafletOutput)
 importFrom(lubridate,day)
+importFrom(lubridate,hour)
+importFrom(lubridate,with_tz)
 importFrom(plotly,ggplotly)
 importFrom(plotly,layout)
 importFrom(plotly,plotlyOutput)

NEWS.md

@@ -1,3 +1,6 @@
+### Covid19Mirai 2.7.1 (2022-02-28)
+- Build data in package, updated with github action (#207)
+
 ### Covid19Mirai 2.6.1 (2021-11-22)
 - Updated and replaced plots in multiple pages (#200)
 - Added text info in pages

R/app_server.R

@@ -20,19 +20,17 @@ app_server <- function(input, output, session) {
   # map
   rds_map = "WorldMap_sp_spl.rds"
   message("read map from RDS ", rds_map)
-  countries_data_map = readRDS(file =  file.path(system.file("./countries_data", package = "Covid19Mirai"),rds_map))
+  countries_data_map <- readRDS(file =  file.path(system.file("./countries_data", package = "Covid19Mirai"),rds_map))
+
+  # orig_data_with_ch <- get_datahub_fix_ch()
+  rds_data = "DATA.rds"
+  orig_data_with_ch = readRDS(file =  file.path(system.file("./datahub", package = "Covid19Mirai"),rds_data))
 
-  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()
 
-  pop_data = get_pop_datahub()
+  pop_data <- get_pop_datahub()
 
   #align continents from map with pop
   #country_name <- as.character(unique(as.character(countries_data_map$NAME))[charmatch(pop_data$Country.Region, unique(as.character(countries_data_map$NAME)))])
@@ -59,13 +57,6 @@ app_server <- function(input, output, session) {
   orig_data_aggregate <-
     build_data_aggr(orig_data, pop_data)
 
-  # output$last_update <- renderText({
-  #   paste0("Latest updated: ",
-  #          max(orig_data$date)
-  #   )
-  # })
-
-
   glob_var = reactiveVal(0)
   summary_var = reactiveVal(0)
   country_var = reactiveVal(0)

R/app_ui.R

@@ -11,8 +11,10 @@ app_ui <- function(request) {
   n <- 1000 #  min number of cases for a country to be considered. Default 1000
   # to be used in Global and Comparison
   w <- 7 # number of days of outbreak. Default 7
-  now = as.POSIXct(Sys.time()) # given time zone
-  AsOfDate =  as.character(as.Date(now - delay_date()))
+  # now = as.POSIXct(Sys.time()) # given time zone
+  # AsOfDate =  as.character(as.Date(now - delay_date()))
+  AsOfDate <- get_asofdate()
+
 
   message("app_ui")
   tagList(
@@ -77,9 +79,9 @@ app_ui <- function(request) {
 
       ), # end Header fluidRow
       modalDialog(title = "Covid19Mirai loading message",
-                  tags$p("Data is growing. Allow 30 seconds for the first page to load."),
+                  tags$p("Data is growing, allow 15 seconds for the first page to load."),
                   tags$p("Load first page fully before navigating to others."),
-                  tags$p("Dashboard designed for  desktop view.")),
+                  tags$p("Dashboard designed for desktop view.")),
 
       # body ----
       #' tags$head(

R/get_data.R

@@ -38,8 +38,10 @@ get_timeseries_data <- function() {
   )
 }
 #' determine latest date by subtracting from today the below computation
-delay_date <- function(){
-  40*60*60
+#' @param n.hours integer, number of hours to be delayed, default = 40
+#' @noRd
+delay_date <- function(n.hours = 40){
+  n.hours*60*60
 }
 
 #' Get daily data
@@ -164,11 +166,41 @@ get_datahub_fix_ch <- function(country = NULL, startdate = "2020-01-22", lev = 1
 
   message("replace hosp data (",paste(.hosp_vars, collapse = ","), ") in lev1 dataset with lev2 swiss data")
 
-  orig_data = combine_hospvars_lev2(orig_data, orig_data_ch_2, "Switzerland")
+  orig_data <- combine_hospvars_lev2(orig_data, orig_data_ch_2, "Switzerland")
 
   list(orig_data = orig_data, orig_data_ch_2 = orig_data_ch_2)
 }
 
+#' Build data in GutHub action yml and save as RDS
+#' @rdname get_datahub
+#'
+#'
+#' @export
+build_data <- function() {
+
+  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)
+
+  message("** Save data as Selected_Country.rds **")
+
+  saveRDS(list(area_data_2 = area_data_2), "inst/datahub/Selected_Country.rds")
+
+  NULL
+}
+
 
 #' replace hospital data of level1 with level2 data
 #'
@@ -318,8 +350,10 @@ get_datahub = function(country = NULL, startdate = "2020-01-22", lev = 1, verbos
 
     # take yesterday, data are updated hourly and they are complete around mid day, 40h later
     # regardless of the timezone, select the day 40h ago
-    now = as.POSIXct(Sys.time()) # given time zone
-    AsOfDate =  as.character(as.Date(now - delay_date()))
+    # at 17pm CEST the new day is triggered
+    # now = as.POSIXct(Sys.time()) # given time zone
+    # AsOfDate =  as.character(as.Date(now - delay_date()))
+    AsOfDate <- get_asofdate()
 
     message("Maximum date set to: ", AsOfDate)
     #TODO: arrange should go descending, many rows could be filtered out for many countries#
@@ -580,8 +614,9 @@ add_growth_death_rate <- function(df, group = "Country.Region", time = "date"){
   lm60 = max(df$date) - 60
   lm30 = max(df$date) - 30
 
-  now = as.POSIXct(Sys.time()) # given time zone
-  LastDate =  as.Date(now - delay_date())
+  # now = as.POSIXct(Sys.time()) # given time zone
+  # LastDate =  as.Date(now - delay_date())
+  LastDate <- get_asofdate()
 
   res = df %>% #ungroup() %>%
     filter(date >= validdates) %>%
@@ -933,3 +968,27 @@ rescale_df_contagion <- function(df, n, w, group = "Country.Region"){
 
   df_rescaled
 }
+
+#' get as Of date, i.e. latest day in the data
+#' @param char logical, convert date to character
+#' @importFrom lubridate hour with_tz
+#' @noRd
+get_asofdate <- function(char = TRUE) {
+  if (exists("AsOfDateBuildData")) {
+    AsOfDate = get("AsOfDateBuildData")
+  } else {
+
+    now_day_UTC = lubridate::with_tz(as.POSIXct(Sys.time()), tzone = "UTC") # given time zone
+    now_hour_UTC = lubridate::hour(now_day_UTC)
+    # Building happens at 08,16,21  UTC.
+    #It is sufficient to take always yesterday
+    remove_hour_UTC <- ifelse(now_hour_UTC < 16, 48, 24)
+
+    AsOfDate =  as.Date(now_day_UTC - delay_date(remove_hour_UTC))
+  }
+  if (char)
+    AsOfDate = as.character(AsOfDate)
+  AsOfDate
+}
+
+

R/mod_compare_nth_cases_plot.R

@@ -304,6 +304,10 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
 
   calc_line_plot = function(dat, vars, cum_vars) {
 
+    .date_first_var = function(d, var, datevar = "date") {
+      min(d[[datevar]][d[[var]] > 0], na.rm = TRUE)-1 # remove one day
+    }
+
     reactSelectVar = reactive({
 
       if (grepl("rate_1M_pop$", req(input$radio_indicator)) && (!(req(input$radio_indicator) %in% names(dat)))) {
@@ -324,7 +328,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
       data = dat
       if (oneMpop && !is.null(input$radio_1Mpop) && input$radio_1Mpop == "oneMpop")  {
         if (all(is.na(data$population))) {
-          browser()
           stop("Missing population data")
         }
         #if (!(paste(req(input$radio_indicator),"rate_1M_pop", sep = "_") %in% names(data))) {
@@ -338,7 +341,8 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
     })
 
     date_first_var = reactive(
-        min(dat$date[dat[[reactSelectVar()]] > 0], na.rm = TRUE)-1 # remove one day
+      .date_first_var(dat, reactSelectVar())
+        # min(dat$date[dat[[reactSelectVar()]] > 0], na.rm = TRUE)-1 # remove one day
       )
 
     df_data_roll <- reactive({
@@ -361,6 +365,7 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
       # data = data[data$date >= date_first_var, , drop = FALSE]
       #date_first_var = min(data$date[data[[reactSelectVar()]] > 0], na.rm = TRUE)-1 # remove one day
       data = data[data$date >= date_first_var(), , drop = FALSE]
+
       data
     })
     df_data_timeframe <- reactive({
@@ -372,12 +377,20 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
           #data = data[data$date >= date_first_var, , drop = FALSE]
           data = df_data_roll()
         } else {
+          df_year = as.integer(format(data$date, "%Y"))
 
           if (input$time_frame == "lst6month") {
+            # n_days <- max()
+            # dates_keep <- lmonth_dates_calc(df_year, data$date, nmonth = 30*6+1)
+            # data = data[data$Date %in% dates_keep, , drop = FALSE]
+
             date_lst_6month = max(max(data$date) - 30*6+1,date_first_var()) # TODO: to be changed
             data = data[data$date >= date_lst_6month, , drop = FALSE]
 
           } else if (input$time_frame == "lstmonth") {
+            # dates_keep <- lmonth_dates_calc(df_year, data$date)
+            # data = data[data$Date %in% dates_keep, , drop = FALSE]
+
             date_lst_month = max(max(data$date) - 31,date_first_var()) # TODO: to be changed
             data = data[data$date >= date_lst_month, , drop = FALSE]
           }