Merge pull request #199 from miraisolutions/develop

2.5.10 release

DESCRIPTION

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

NAMESPACE

@@ -99,6 +99,7 @@ importFrom(golem,with_golem_options)
 importFrom(grDevices,colorRampPalette)
 importFrom(grid,grid.draw)
 importFrom(leaflet,leafletOutput)
+importFrom(lubridate,day)
 importFrom(plotly,ggplotly)
 importFrom(plotly,layout)
 importFrom(plotly,plotlyOutput)

NEWS.md

@@ -1,3 +1,6 @@
+### Covid19Mirai 2.5.10
+- Fixed some small issues in labels (#197)
+
 ### Covid19Mirai 2.5.9 (2021-09-26)
 - Improved lineplot, adding time frame and barplot option (#191)
 - Axis labels shortened using K and M for thousands and millions

R/get_data.R

@@ -183,23 +183,6 @@ combine_hospvars_lev2 <- function(data1, data2, country = "Switzerland") {
 
   # aggregate hosp data at country level
   data2 <- data2 %>% select(Country.Region, date, as.character(.hosp_vars))
-  #maxdate1 = max(data1$date[data1$Country.Region == country])
-
-  # datC = data1 %>% dplyr::filter(Country.Region == country) %>% select(date)
-  # stackhosp = function(dat, datC) {
-  #   if (!identical(dat$date, datC$date)) {
-  #     dat = datC %>% left_join(dat, by = "date") %>% fill()
-  #     dat[, .hosp_vars][is.na(dat[, .hosp_vars])] = 0
-  #   }
-  #   # if(max(dat$date) < maxd) {
-  #   #   dat = rbind(dat,
-  #   #               data.frame(date = seq(max(dat$date)+1, maxd, 1), hosp = tail(dat$hosp, 1), icuvent = tail(dat$icuvent, 1), stringsAsFactors = FALSE)
-  #   #   )
-  #   # }
-  #   dat
-  # }
-  # # impute last days hosp data
-  # data2 = data2 %>% group_by(Country.Region) %>% group_modify(~stackhosp(.x, datC))
 
   data2_1 = data2 %>%
     select(date, all_of(as.vector(.hosp_vars))) %>%
@@ -855,6 +838,10 @@ get_pop_datahub <- function(){
   # populationOLD to be used for checks vs new DF
   population = population[, c("Country.Region", "continent", "subcontinent")]
 
+  noCont = sum(is.na(population$continent))
+  if (noCont > 0)
+    warning(noCont, " countries have unknown continent")
+
   population
 }
 

R/mod_continent_comparison.R

@@ -68,9 +68,11 @@ mod_continent_comparison_server <- function(input, output, session, orig_data_ag
     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(lw_continent_data_filtered %>% select(-population))  %>%
+    left_join(pw_continent_data_filtered %>% select(-population))
 
   callModule(mod_lineplots_day_contagion_server, "lineplots_day_contagion_cont", continent_data, nn = nn, statuses = c("confirmed", "deaths", "vaccines", "active"))
 

R/mod_country.R

@@ -331,7 +331,6 @@ mod_country_server <- function(input, output, session, data, countries, nn = 100
     levs <- areaplot_hospvars()
     # for country plot start from the beginning
     df_hosp = tsdata_areplot(country_data,levs, 1) # start from day with >nn
-
     callModule(mod_plot_log_linear_server, "plot_areahosp_tot", df = df_hosp, type = "area", hosp = TRUE)
 
 
@@ -382,13 +381,12 @@ mod_country_server <- function(input, output, session, data, countries, nn = 100
       if (exists("area2id") && lev2id() == 1) {
 
         message("remove level 2 UI for ", req(input$select_country))
-
-        id <<- area2id
+        #id <<- area2id
 
         # remove the ui generated previously
-        message("remove id = ", id )
+        message("remove id = ", area2id )
         removeUI(
-          selector = paste0("#",ns(id)),
+          selector = paste0("#",ns(area2id)),
           #selector = paste0("#area",lev2id()), # it works
           immediate = TRUE
         )
@@ -643,7 +641,7 @@ mod_country_area_server <- function(input, output, session, data, n2 = 1, w = 7,
                  plottitle = c("Stringency Index"),
                  g_palette = list("plot_1" = barplots_colors$stringency$calc,
                                   calc = TRUE),
-                 pickvariable = list("plot_1" = "confirmed_rate_1M_pop")) # pick top 10 confirmed countries
+                 pickvariable = list("plot_1" = "lm_confirmed_rate_1M_pop"))
     } else{
       if (exists("stridx2id")) {
         message("remove level 2 Stringency Index UI barplot")
@@ -679,7 +677,7 @@ mod_country_area_server <- function(input, output, session, data, n2 = 1, w = 7,
         }
 
         vaxid_arg(vaxid_arg()+1)
-        id = paste0("area_vaccines",strid_arg())
+        id = paste0("area_vaccines",vaxid_arg())
         message("id vaccines insert = ", id)
 
         message('Level 2 Vaccines data present: insertUI for barplot ', vaxid_arg())
@@ -701,7 +699,7 @@ mod_country_area_server <- function(input, output, session, data, n2 = 1, w = 7,
                  plottitle = c("Vaccinations"),
                  g_palette = list("plot_1" = barplots_colors$vaccines$calc,
                                   calc = TRUE),
-                 pickvariable = list("plot_1" = "confirmed_rate_1M_pop")) # pick top 10 confirmed countries
+                 pickvariable = list("plot_1" = "lm_confirmed_rate_1M_pop")) # pick top 10 confirmed countries
     } else{
       if (exists("vaxidx2id")) {
         message("remove vaccines id = ", vaxidx2id )

R/mod_individual_country.R

@@ -231,7 +231,7 @@ mod_ind_country_server <- function(input, output, session, data, data2, country
     build_data_aggr(area_data_2)
 
   output$ind_subarea <- renderUI({
-    areaUI(ns("ind_country_subarea"), tab = FALSE, stringency = FALSE)
+    areaUI(ns("ind_country_subarea"), tab = FALSE, stringency = FALSE, vaxflag = FALSE)
     #areaUI("ind_country_subarea")
   })
   callModule(mod_country_area_server, "ind_country_subarea", data = area_data_2_aggregate, n2 = 10, tab = FALSE, stringencyFlag = FALSE, vaccinesFlag = FALSE, country = "Switzerland")

R/mod_plot_log_linear.R

@@ -119,7 +119,6 @@ mod_plot_log_linear_server <- function(input, output, session, df, type, g_palet
       output$plot_log_linear <- renderPlotly({
         p <- df %>%
             time_evol_line_plot(log = log(), text = "Area" , g_palette = graph_palette)
-       # p <- p + scale_y_continuous(labels = label_number(big.mark = "'")) # add label
 
         p <- p %>%
           #ggplotly(tooltip = c("x", "y", "text")) %>%

R/mod_vaccines_text.R

@@ -11,7 +11,12 @@
 
 #' @rdname mod_vaccines_text
 #' @import shiny
+#' @importFrom lubridate day
 mod_vaccines_text_ui <- function(id) {
+  targetdate = Sys.Date()+50
+  targetdate_day = lubridate::day(targetdate)
+  targetdate = targetdate - targetdate_day + 1
+
   ns <- NS(id)
   tagList(
     div(h4("Vaccination Pace"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
@@ -28,7 +33,7 @@ mod_vaccines_text_ui <- function(id) {
                             choices = c(0,1,2),
                             selected = 1)),
       column(3, dateInput(inputId = ns("tdate"), label = div(style = "font-size:10px","Target date"),
-                          value = "2021-11-01",
+                          value = targetdate,
                           min = Sys.Date()
       ))
     ),
@@ -93,10 +98,12 @@ mod_vaccines_text_server <- function(input, output, session, df, dftoday) {
   dftday$vaccines_per_day = dftday$vaccines/dftday$vaccines_days
 
   data = reactive({
-
     dftday %>% # if target already reached then 0
-      mutate(vaccines_left_to_target = max(0, input$target/100 * (as.integer(req(input$doses)) * (population- round(vaccines/as.integer(req(input$doses))) - (confirmed-deaths)) +
-                                                             as.integer(req(input$confdoses)) * (confirmed-deaths)))) %>%
+      mutate(vaccinated_people = (round(vaccines/as.integer(req(input$doses))) - (confirmed-deaths)) +
+                as.integer(req(input$confdoses)) * (confirmed-deaths)) %>%
+      mutate(target_pop = input$target/100* population) %>%
+      #  target*population -   (doses * ((population - vaccines/doses - (confirmed - deaths)) +
+      mutate(vaccines_left_to_target = max(0, target_pop - vaccinated_people)) %>%
       # achieved_date = today + (target% * (targetdose * (population- round(vaccines/targetdose) - (confirmed-deaths)) + targetdoseconf * (confirmed-deaths))) / (lw_vaccines/7)
       mutate(lw_achieved_date = date + ceiling((vaccines_left_to_target) / (lw_vaccines_per_day)),
              # achieved_date = today + (target% * targetdose * (population- vaccines- (confirmed-deaths))) + targetdoseconf * (confirmed-deaths)) / (vaccines/(today-startdate))
@@ -121,7 +128,7 @@ mod_vaccines_text_server <- function(input, output, session, df, dftoday) {
          style = "color: white; max-width: 100%; background-color: #3c8dbc; overflow-x: scroll; margin-left: 20px; margin-right: 20px; font-style: italic; white-space: nowrap; word-wrap: break-word",
          HTML(
            paste0("  ",strong(dftday$Country.Region), ". Population: ", .format_num(dftday$population),". Doses per population: ",paste(round(dftday$vaccines_rate_pop*100,1), "%"),"<br/>",
-                  "  Target Date: <b>", input$tdate,"</b>. <b>", .format_num(data()$days_to_target), "</b> days remaining. Vaccines left to target: <b>", .format_num(data()$vaccines_left_to_target), "</b>.<br/>",
+                  "  Target Date: <b>", input$tdate,"</b>. <b>", .format_num(data()$days_to_target), "</b> days remaining. Doses left to target: <b>", .format_num(data()$vaccines_left_to_target), "</b>.<br/>",
                   "  Target Coverage: <b>", input$target,"%</b>. Target Doses: <b>", req(input$doses),"</b>. Doses for already infected: <b>", req(input$confdoses),"</b>.<br/>",
                   "  Required vaccines per day to cover ",input$target," % of the population by <b>", input$tdate,"</b>: <b>",
                   .format_num(data()$target_vaccines_per_day),"</b>.<br/>",

R/plots.R

@@ -978,22 +978,23 @@ plot_rate_hist <- function(df, percent =  FALSE, y_min = 0, g_palette, labsize =
   pply
 }
 
-#' scatterplot between prevalence and growth rate
+#' scatter plot between prevalence and growth rate
 #'
 #' @param df data.frame
 #' @param med list with median values for x and y
-#' @param x.min numeric adjustment for cartesian x axis
-#' @param y.min numeric adjustment for cartesian y axis
+#' @param x.min numeric adjustment for Cartesian x axis
+#' @param y.min numeric adjustment for Cartesian y axis
 #' @param xvar character variable name for x axis
 #' @param yvar character variable name for y axis
 #' @param coefflm numeric, intercept and slop of simple lm model
+#' @param addLabels logical,if TRUE then labels are added to points
 #'
 #' @import ggplot2
 #' @importFrom scales label_number
 #'
 #' @return ggplot plot
 #' @export
-scatter_plot <- function(df, med, x.min = c(0.875, 1.125), y.min = c(0.99,1.01), xvar = "confirmed_rate_1M_pop", yvar = "growth_factor_3", coefflm = NULL) {
+scatter_plot <- function(df, med, x.min = c(0.875, 1.125), y.min = c(0.99,1.01), xvar = "confirmed_rate_1M_pop", yvar = "growth_factor_3", coefflm = NULL, addLabels = TRUE) {
 
   if (nrow(df) == 0) {
     p = ggplot()
@@ -1063,18 +1064,21 @@ scatter_plot <- function(df, med, x.min = c(0.875, 1.125), y.min = c(0.99,1.01),
     #p <- p +   geom_line(aes(y = predlm, x = !! sym(xvar)), size = 1)
     #p <- p +   geom_smooth(method = "lm", se = FALSE)
   }
+  if (addLabels) {
+    p <- p +
+      geom_text(aes(x = !! sym(xvar), y = !! sym(yvar), label= Country.Region),
+                check_overlap = TRUE, color = color_cntry, size = 2.8)
+  }
   p <- p +
-    geom_text(aes(x = !! sym(xvar), y = !! sym(yvar), label= Country.Region),
-              check_overlap = TRUE, color = color_cntry, size = 3.3) +
     coord_cartesian(ylim = ylim,
                     xlim = xlim) +
     basic_plot_theme()
 
 
-  percent = ifelse(yvar %in% .rate_vars, TRUE, FALSE)
-  labfun = ifelse(percent, lab_percent, lab_num)
-  p <- p + scale_y_continuous(labels = labfun, breaks = breaks_lab(ylim, .breaks.yaxis)) +
-            scale_x_continuous(labels = labfun, breaks = breaks_lab(xlim, .breaks.xaxis)) # add label
+  labfuny = ifelse(percenty, lab_percent, lab_num)
+  labfunx = ifelse(percentx, lab_percent, lab_num)
+  p <- p + scale_y_continuous(labels = labfuny, breaks = breaks_lab(ylim, .breaks.yaxis)) +
+            scale_x_continuous(labels = labfunx, breaks = breaks_lab(xlim, .breaks.xaxis)) # add label
 
   p
 }

R/utils.R

@@ -580,7 +580,8 @@ tsdata_areplot <- function(data, levs, nn = 1000) {
   data = data %>% filter(date >= mindate)
 
   # data are in descending order, first dates at the end
-  idx = rowSums(data[, levs] > 0) == length(levs)
+  #idx = rowSums(data[, levs] > 0) == length(levs)
+  idx = rowSums(data[, levs] > 0) >0
 
   data = data[idx, , drop = FALSE] # remove also in the middles and at th end, no problem
 

man-roxygen/ex-cases.R

@@ -47,7 +47,7 @@ if (interactive()) {
   library(leaflet)
   library(leaflet.extras)
 
-  #sapply(file.path("R",list.files("R")), source)
+  # sapply(file.path("R",list.files("R")), source)
   #devtools::load_all()
   long_title <- "Lorem ipsum dolor sit amet, consectetur adipisicing elit."
   ui <- fluidPage(

man-roxygen/ex-mod_scatterplot.R

@@ -192,9 +192,11 @@ if (interactive()) {
       left_join(lw_orig_data_aggregate %>% select(-population))
 
     #inputcountries = c("Italy","Germany", "Switzerland", "Sweden", "UK", "France", "Spain", "Russia") # example with countries
-    orig_data_aggregate_today = orig_data_aggregate_today %>% filter(continent == "Africa")
+    orig_data_aggregate_today = orig_data_aggregate_today %>% filter(continent == "Europe" & population > 1000000)
 
-    callModule(mod_scatterplot_server, "plot", orig_data_aggregate_today, countries = inputcountries, nmed = 10000, wmed = 7, n_highlight = 10, istop = TRUE, xvar = "vaccines_rate_pop", growth = FALSE, fitted = FALSE)
+    inputcountries = unique(orig_data_aggregate_today$Country.Region)
+
+    callModule(mod_scatterplot_server, "plot", orig_data_aggregate_today, countries = inputcountries, nmed = 10000, wmed = 7, n_highlight = 10, istop = FALSE, xvar = "vaccines_rate_pop", growth = FALSE, fitted = TRUE)
 
   }
   runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE)

man-roxygen/ex-mod_vaccines_text.R

@@ -10,7 +10,7 @@ if (interactive()) {
     w <- 7 # number of days of outbreak. Default 7
 
     # Data ----
-    orig_data <- get_datahub(country = "USA") %>%
+    orig_data <- get_datahub(country = "Switzerland") %>%
       get_timeseries_by_contagion_day_data()