Produce figures as SVG for web output incl. GitHub workflow for this

.github/workflows/ci.yml

@@ -29,7 +29,7 @@ jobs:
 
     - name: Perform a short debug simulation run
       run: |
-        docker run --rm -v $(pwd):/var/model --env DEBUG=TRUE covid19model:latest $(id -u) $(id -g)
+        docker run --rm -v $(pwd):/var/model --user $(id -u):$(id -g) --env DEBUG=TRUE covid19model:latest 
 
     - name: Push image to GitHub packages
       if: github.event_name == 'push'

.github/workflows/run-model-and-publish.yml

@@ -0,0 +1,58 @@
+# This is a basic workflow to help you get started with Actions
+
+name: RUN_MODEL_AND_PUBLISH
+
+# Controls when the action will run. Triggers the workflow on push or pull request
+# events but only for the master branch
+
+# This workflow can be started manually by using the GitHub API
+# send a POST request to https://api.github.com/repos/ImperialCollegeLondon/covid19model/dispatches
+# with a an Authorization token <GitHub_Token> header and JSON payload:
+# {"event_type": "run-and-publish"}
+on:
+  repository_dispatch:
+    types: run-and-publish
+
+# A workflow run is made up of one or more jobs that can run sequentially or in parallel
+jobs:
+  # This workflow contains a single job called "build"
+  run-and-publish:
+    # Set secret to enable the workflow
+    # The type of runner that the job will run on
+    runs-on: ubuntu-18.04
+
+    # Steps represent a sequence of tasks that will be executed as part of the job
+    steps:
+    # should throw an error if the token is not set, to enable the action only for repos which have set this token
+    - name: Check if access token is set
+      env:
+        SECRET_TEST: ${{ secrets.GH_PAGES_ACCESS_TOKEN }}
+      run: "[ -z \"$SECRET_TEST\" ] && exit 1 || exit 0 "
+    # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it
+    - uses: actions/checkout@v2
+
+    # Docker build
+    - name: Build docker image
+      run: |
+        docker build -f docker/Dockerfile -t covid19model:latest .
+
+    - name: Download the newest data from the ECDC
+      run: |
+        docker run --rm -v $(pwd):/var/model --user $(id -u):$(id -g) covid19model:latest Rscript data/fetch-ecdc.R
+
+    - name: Perform the full model run, aprox. 90 minutes
+      run: |
+        docker run --rm -v $(pwd):/var/model --user $(id -u):$(id -g) --env FULL=TRUE covid19model:latest
+
+    - name: Fix SVG font families for publishing
+      run: |
+        docker run --rm -v $(pwd):/var/model --user $(id -u):$(id -g) covid19model:latest Rscript web-fix-fonts.R
+
+    - name: Deploy
+      uses: peaceiris/actions-gh-pages@v3
+      with:
+        personal_token: ${{ secrets.GH_PAGES_ACCESS_TOKEN }}
+        external_repository: ImperialCollegeLondon/covid19estimates
+        publish_branch: master
+        publish_dir: ./web
+        keep_files: true

.gitignore

@@ -1,3 +1,6 @@
+# Web file output
+web/
+
 # History files
 .Rhistory
 .Rapp.history

base.r

@@ -18,6 +18,10 @@ countries <- c(
   "Switzerland"
 )
 
+# Default run parameters for the model
+DEBUG = FALSE
+FULL = FALSE
+
 args = commandArgs(trailingOnly=TRUE)
 if(length(args) == 0) {
   args = 'base'
@@ -52,17 +56,17 @@ forecast = 0
 if (Sys.getenv("DEBUG") == "TRUE") {
    DEBUG = TRUE
    print("Performing a DEBUG run")   
-}  else  {
-   DEBUG = FALSE
+} else if (Sys.getenv("FULL") == "TRUE") {
+  FULL = TRUE
+  print("Performing a full run")
 }
 
-if(DEBUG == FALSE) {
-  N2 = 75 # Increase this for a further forecast
-}  else  {
+# Time difference between original report and current extension
+deltaT = (max(as.Date(d$DateRep,format='%d/%m/%Y')) - as.Date("28/03/2020",format='%d/%m/%Y'))
+N2 = 75 + as.numeric(deltaT, units = "days")
+
 ### For faster runs:
 # countries = c("Austria","Belgium") #,Spain")
-  N2 = 75
-}
 # countries = c("Italy","United_Kingdom","Spain","Norway","Austria","Switzerland")
 
 dates = list()
@@ -208,8 +212,9 @@ m = stan_model(paste0('stan-models/',StanModel,'.stan'))
 
 if(DEBUG) {
   fit = sampling(m,data=stan_data,iter=40,warmup=20,chains=2)
+} else if (FULL) {
+  fit = sampling(m,data=stan_data,iter=4000,warmup=2000,chains=8,thin=4,control = list(adapt_delta = 0.90, max_treedepth = 10))
 } else { 
-  # fit = sampling(m,data=stan_data,iter=4000,warmup=2000,chains=8,thin=4,control = list(adapt_delta = 0.90, max_treedepth = 10))
   fit = sampling(m,data=stan_data,iter=200,warmup=100,chains=4,thin=4,control = list(adapt_delta = 0.90, max_treedepth = 10))
 }  
 
@@ -252,3 +257,9 @@ g = (mcmc_intervals(Rt,prob = .9))
 ggsave(sprintf("results/%s-covars-final-rt.pdf",filename),g,width=4,height=6)
 system(paste0("Rscript plot-3-panel.r ", filename,'.Rdata'))
 system(paste0("Rscript plot-forecast.r ",filename,'.Rdata')) ## to run this code you will need to adjust manual values of forecast required
+
+# Verify that the whole output for the web has been generated correctly and update last-update dates
+verify_result <- system(paste0("Rscript web-verify-output.R ", filename,'.Rdata'),intern=FALSE)
+if(verify_result != 0){
+  stop("Verification of web output failed!")
+}

docker/Dockerfile

@@ -1,10 +1,14 @@
 FROM jrnold/rstan:latest
 
+RUN echo "deb http://http.debian.net/debian stretch-backports main contrib non-free" >> /etc/apt/sources.list.d/stretch-backports.list
+RUN apt-get update && apt-get install -y \
+    fonts-open-sans \
+    fonts-arkpandora \
+	fonts-adf-verana
+
 RUN install2.r --error --deps TRUE \
-	gdata EnvStats ggpubr \
+	gdata EnvStats ggpubr svglite jsonlite \
 	&& rm -rf /tmp/downloaded_packages/ /tmp/*.rds
 
-COPY docker/run_model_script.sh /root/
 WORKDIR /var/model
-ENTRYPOINT ["sh", "/root/run_model_script.sh"]
-
+CMD Rscript base.r base

plot-3-panel.r

@@ -12,6 +12,7 @@ library(gridExtra)
 library(ggpubr)
 library(bayesplot)
 library(cowplot)
+library(svglite)
 
 source("utils/geom-stepribbon.r")
 #---------------------------------------------------------------------------
@@ -138,7 +139,7 @@ make_plots <- function(data_country, covariates_country_long,
     scale_fill_manual(name = "", labels = c("50%", "95%"),
                       values = c(alpha("deepskyblue4", 0.55), 
                                  alpha("deepskyblue4", 0.45))) + 
-    theme_pubr() + 
+    theme_pubr(base_family="sans") + 
     theme(axis.text.x = element_text(angle = 45, hjust = 1), 
           legend.position = "None") + 
     guides(fill=guide_legend(ncol=1))
@@ -165,7 +166,7 @@ make_plots <- function(data_country, covariates_country_long,
     scale_fill_manual(name = "", labels = c("50%", "95%"),
                       values = c(alpha("deepskyblue4", 0.55), 
                                  alpha("deepskyblue4", 0.45))) + 
-    theme_pubr() + 
+    theme_pubr(base_family="sans") + 
     theme(axis.text.x = element_text(angle = 45, hjust = 1), 
           legend.position = "None") + 
     guides(fill=guide_legend(ncol=1))
@@ -212,10 +213,32 @@ make_plots <- function(data_country, covariates_country_long,
     scale_x_date(date_breaks = "weeks", labels = date_format("%e %b"), 
                  limits = c(data_country$time[1], 
                             data_country$time[length(data_country$time)])) + 
-    theme_pubr() + 
+    theme_pubr(base_family="sans") + 
     theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
     theme(legend.position="right")
   
+  # Special plot settings for mobile
+  p3_mobile <- p3  +
+    theme(legend.position="below")
+  
+  # Plots for Web, Desktop version
+  dir.create("web/figures/desktop/", showWarnings = FALSE, recursive = TRUE)
+  save_plot(filename = paste0("web/figures/desktop/", country, "_infections", ".svg"), 
+            p1, base_height = 4, base_asp = 1.618)
+  save_plot(filename = paste0("web/figures/desktop/", country, "_deaths", ".svg"), 
+            p2, base_height = 4, base_asp = 1.618)
+  save_plot(filename = paste0("web/figures/desktop/", country, "_rt", ".svg"), 
+            p3, base_height = 4, base_asp = 1.618 * 2)
+  
+  # Plots for Web, Mobile version
+  dir.create("web/figures/mobile/", showWarnings = FALSE, recursive = TRUE)
+  save_plot(filename = paste0("web/figures/mobile/", country, "_infections", ".svg"), 
+            p1, base_height = 4, base_asp = 1.1)
+  save_plot(filename = paste0("web/figures/mobile/", country, "_deaths", ".svg"), 
+            p2, base_height = 4, base_asp = 1.1)
+  save_plot(filename = paste0("web/figures/mobile/", country, "_rt", ".svg"), 
+            p3_mobile, base_height = 4, base_asp = 1.1)
+  
   p <- plot_grid(p1, p2, p3, ncol = 3, rel_widths = c(1, 1, 2))
   save_plot(filename = paste0("figures/", country, "_three_pannel_", filename2, ".pdf"), 
             p, base_width = 14)

plot-forecast.r

@@ -127,16 +127,24 @@ make_single_plot <- function(data_country, data_country_forecast, filename, coun
     scale_x_date(date_breaks = "weeks", labels = date_format("%e %b")) + 
     scale_y_continuous(trans='log10', labels=comma) + 
     coord_cartesian(ylim = c(1, 100000), expand = FALSE) + 
-    theme_pubr() + 
+    theme_pubr(base_family="sans") + 
     theme(axis.text.x = element_text(angle = 45, hjust = 1)) + 
     guides(fill=guide_legend(ncol=1, reverse = TRUE)) + 
     annotate(geom="text", x=data_country$time[length(data_country$time)]+8, 
-             y=10000, label="Forecast",
+             y=10000, label="",
              color="black")
   print(p)
   
   ggsave(file= paste0("figures/", country, "_forecast_", filename, ".pdf"), 
          p, width = 10)
+  
+  # Produce plots for Website
+  dir.create("web/figures/desktop/", showWarnings = FALSE, recursive = TRUE)
+  save_plot(filename = paste0("web/figures/desktop/", country, "_forecast", ".svg"), 
+            p, base_height = 4, base_asp = 1.618 * 2 * 8/12)
+  dir.create("web/figures/mobile/", showWarnings = FALSE, recursive = TRUE)
+  save_plot(filename = paste0("web/figures/mobile/", country, "_forecast", ".svg"), 
+            p, base_height = 4, base_asp = 1.1)
 }
 #-----------------------------------------------------------------------------------------------
 make_forecast_plot()

web-fix-fonts.R

@@ -0,0 +1,9 @@
+filenames <- list.files("web/figures/", recursive = TRUE, full.names=TRUE)
+
+for( f in filenames ){
+  
+  x <- readLines(f)
+  y <- gsub( "Aerial", "Arial, Helvetica, sans-serif", x )
+  cat(y, file=f, sep="\n")
+  
+}

web-verify-output.R

@@ -0,0 +1,37 @@
+library(jsonlite)
+
+verify_web_output <- function(){
+  plot_names <- c("deaths", "forecast", "infections", "rt")
+  plot_versions <- c("mobile", "desktop")
+  
+  args <- commandArgs(trailingOnly = TRUE)
+  filename2 <- args[1]
+  load(paste0("results/", filename2))
+  print(sprintf("loading: %s",paste0("results/",filename2)))
+  
+  date_results <- list()
+  
+  for(country in countries) {
+    for (plot_version in plot_versions) {
+      for (plot_name in plot_names) {
+        path = sprintf("web/figures/%s/%s_%s.svg", plot_version, country, plot_name)
+
+        if (! file.exists(path)) {
+          stop(sprintf("Missing web output during verification: %s", path))
+        }
+      }
+    }
+    
+    d1=d[d$Countries.and.territories==Country,]
+    d1$date = as.Date(d1$DateRep,format='%d/%m/%Y')
+    latest_date = max(d1$date)
+    date_results[[country]] = latest_date
+    
+  }
+  
+  
+  dir.create("web/data/", showWarnings = FALSE, recursive = TRUE)
+  write_json(date_results, "web/data/latest-updates.json", auto_unbox=TRUE)
+}
+
+verify_web_output()