From 5d87b0437fb6aa7fc7b3735c1b441f7c04d0631b Mon Sep 17 00:00:00 2001 From: Guido Maggio Date: Wed, 9 Sep 2020 22:02:08 +0200 Subject: [PATCH 01/11] New release in develop --- DESCRIPTION | 2 +- NEWS.md | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 80b51cfd..1245bab2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: Covid19Mirai Title: Covid-19 Data Analysis -Version: 2.2.0 +Version: 2.2.1-9000 Authors@R: c(person("Francesca", "Vitalini", role = c("cre", "aut"), email = 'francesca.vitalini@mirai-solutions.com'), diff --git a/NEWS.md b/NEWS.md index f17b6c11..690b9cab 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,5 @@ +### Covid19Mirai 2.2.1-9000 (develop) + ### Covid19Mirai 2.2.0 (2020-09-04) - Added Switzerland tab with maps at Kanton level (#20) - Reviewed calculation and definition of Growth Factors (#122) From a19bb66b2b4ba84569542dd58c945d2e0416d15c Mon Sep 17 00:00:00 2001 From: Guido Maggio Date: Sat, 24 Oct 2020 18:51:43 +0200 Subject: [PATCH 02/11] nn arguments added, used dates in x axis of graphs, removed contagio_day --- NEWS.md | 2 + R/app_server.R | 13 +++-- R/mod_bar_plot_day_contagion.R | 16 ++++-- R/mod_compare_nth_cases_plot.R | 36 ++++++++---- R/mod_continent.R | 25 ++++---- R/mod_continent_comparison.R | 18 +++--- R/mod_country.R | 38 +++++------- R/mod_country_comparison.R | 25 ++++---- R/mod_global.R | 8 +-- R/mod_growth_death_rate.R | 6 +- R/mod_individual_country.R | 16 +++--- R/mod_lineplots_day_contagion.R | 5 +- R/mod_plot_log_linear.R | 2 +- R/mod_stackedbarplot_status.R | 11 ++-- R/plots.R | 64 ++++++++++++--------- R/utils.R | 11 ++-- man-roxygen/ex-country-comparison.R | 7 ++- man-roxygen/ex-country.R | 8 +-- man-roxygen/ex-individual_country.R | 2 +- man-roxygen/ex-mod-barplot-contagion-day.R | 2 +- man-roxygen/ex-mod_compare_nth_cases_plot.R | 18 +++--- man-roxygen/ex-one_continent.R | 2 +- man-roxygen/ex-plot_log_linear.R | 2 +- man/from_contagion_day_bar_facet_plot.Rd | 4 +- man/plot_all_highlight.Rd | 4 +- man/rate_vars.Rd | 2 +- man/reexports.Rd | 2 +- man/tsdata_areplot.Rd | 6 +- 28 files changed, 193 insertions(+), 162 deletions(-) diff --git a/NEWS.md b/NEWS.md index 690b9cab..79a6417b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,6 @@ ### Covid19Mirai 2.2.1-9000 (develop) +- Removed contagion day in x axis, replaced with dates (#126) + ### Covid19Mirai 2.2.0 (2020-09-04) - Added Switzerland tab with maps at Kanton level (#20) diff --git a/R/app_server.R b/R/app_server.R index 322065bb..a1e30402 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -62,9 +62,10 @@ app_server <- function(input, output, session) { # align contagion day for comparisons data_filtered <- - orig_data_aggregate %>% + orig_data_aggregate %>% rescale_df_contagion(n = n, w = w) + # determine vector of countries to be used in Global and Comparison pages # reactive countries <- reactive({ @@ -78,7 +79,7 @@ app_server <- function(input, output, session) { callModule(mod_global_server, "global", orig_data_aggregate = orig_data_aggregate, data_filtered = data_filtered, countries_data_map) - callModule(mod_continent_comparison_server, "continent_comparison", orig_data_aggregate = orig_data_aggregate, n = n, w = w, pop_data = pop_data) + callModule(mod_continent_comparison_server, "continent_comparison", orig_data_aggregate = orig_data_aggregate, nn = n, w = w, pop_data = pop_data) # select continents in tabs continents = c("Europe", "Asia", "Africa", "LatAm & Carib.", "Northern America", "Oceania") @@ -86,21 +87,21 @@ app_server <- function(input, output, session) { uicontinents = c("europe", "asia", "africa", "latam", "northernamerica", "oceania") for (i.cont in 1:length(continents)) { callModule(mod_continent_server, paste(mainuicontinents[i.cont], "comparison", sep = "_"), - orig_data_aggregate = orig_data_aggregate, n = n, w = w, + orig_data_aggregate = orig_data_aggregate, nn = n, w = w, pop_data = pop_data, countries_data_map = countries_data_map, cont = continents[i.cont], uicont = uicontinents[i.cont]) } # Switzerland page - callModule(mod_ind_country_server, "swiss", data = orig_data_aggregate, country = "Switzerland", n = 10, w = w) + callModule(mod_ind_country_server, "swiss", data = orig_data_aggregate, country = "Switzerland", nn = n, w = w) # country choice, remove Switzerland orig_data_aggregate_noswiss = orig_data_aggregate %>% filter(Country.Region != "Switzerland") countriesnoswiss = reactive({ countries()[countries()[,1] != "Switzerland",] }) - callModule(mod_country_server, "country", data = orig_data_aggregate, countries = countriesnoswiss, n = 10, w = w, n.select = n) + callModule(mod_country_server, "country", data = orig_data_aggregate, countries = countriesnoswiss, nn = n, w = w, n.select = n) - callModule(mod_country_comparison_server, "country_comparison", data = orig_data_aggregate, countries = countries, n = 10, w = w, n.select = n) + callModule(mod_country_comparison_server, "country_comparison", data = orig_data_aggregate, countries = countries, nn = 100, w = w, n.select = n) # Modal ---- # what is new pop-up diff --git a/R/mod_bar_plot_day_contagion.R b/R/mod_bar_plot_day_contagion.R index bf7f8cf5..197de8a5 100644 --- a/R/mod_bar_plot_day_contagion.R +++ b/R/mod_bar_plot_day_contagion.R @@ -17,13 +17,14 @@ mod_bar_plot_day_contagion_ui <- function(id){ #' bar_plot_day_contagion Server Function #' #' @param country_data data.frame for one country -#' +#' @param datevar character variable used for X axis, date or contagion_day +#' @param nn minimum date derived from first day with more than nn cases. Default 1000 #' @import dplyr #' @import tidyr #' @import ggplot2 #' #' @noRd -mod_bar_plot_day_contagion_server <- function(input, output, session, country_data){ +mod_bar_plot_day_contagion_server <- function(input, output, session, country_data, datevar = "date", nn = 1000){ ns <- session$ns statuses <- c("confirmed", "deaths", "recovered", "active") @@ -31,11 +32,16 @@ mod_bar_plot_day_contagion_server <- function(input, output, session, country_da allstatuses = c(statuses, paste0("new_", statuses)) output$bar_plot_day_contagion <- renderPlot({ + + mindate = min(country_data$date[country_data$confirmed>nn]) + country_data = country_data %>% filter(date > mindate) + df <- country_data %>% ungroup() %>% #select(-Country.Region, -date) %>% - select(contagion_day, !!allstatuses) %>% - arrange(contagion_day) + select(!!datevar, !!allstatuses) %>% + arrange(!!as.symbol(datevar)) #%>% + #filter(confirmed > nn) tmp <- sapply(statuses, function(s){ df[,s] - df[, paste0("new_", s)] @@ -47,7 +53,7 @@ mod_bar_plot_day_contagion_server <- function(input, output, session, country_da df <- df %>% bind_cols(tmp) %>% - pivot_longer(cols = -contagion_day, names_to = "status_all", values_to = "value") %>% + pivot_longer(cols = -all_of(datevar), names_to = "status_all", values_to = "value") %>% mutate(bool_new = case_when( grepl("new_", .$status_all) ~ "new", grepl("diff_", .$status_all) ~ "total", diff --git a/R/mod_compare_nth_cases_plot.R b/R/mod_compare_nth_cases_plot.R index 1b5671db..92d277d8 100644 --- a/R/mod_compare_nth_cases_plot.R +++ b/R/mod_compare_nth_cases_plot.R @@ -7,6 +7,7 @@ #' @param actives if TRUE then add new_active and active variables to vars. #' @param tests if TRUE then add new_test and test variables to vars. #' @param hosp if TRUE then add new_hosp and hosp variables to vars. +#' @param selectvar character variable selected in ui. #' #' @noRd #' @@ -17,7 +18,7 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = c("confirmed", "deaths", "r "new_prevalence_rate_1M_pop", "new_tests", "new_tests_rate_1M_pop","new_positive_tests_rate", "growth_factor_3", "lethality_rate" ), - actives = TRUE, tests = FALSE, hosp = FALSE){ + actives = TRUE, tests = FALSE, hosp = FALSE, selectvar = "new_confirmed"){ ns <- NS(id) choices_plot = varsNames(vars) @@ -47,7 +48,7 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = c("confirmed", "deaths", "r column(7, offset = 1, selectInput(inputId = ns("radio_indicator"), label = "", - choices = choices_plot, selected ="new_confirmed") + choices = choices_plot, selected = selectvar) ), column(4, selectInput(inputId = ns("radio_log_linear"), label = "", @@ -62,7 +63,7 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = c("confirmed", "deaths", "r #' compare_nth_cases_plot Server Function #' #' @param df data.frame -#' @param n min number of cases for a country to be considered. Default 1000 +#' @param nn minimum date derived from first day with more than nn cases. Default 1000 #' @param w number of days of outbreak. Default 7 #' @param n_highligth number of countries to highlight if istop == TRUE #' @param istop logical to choose title, if top n_highligth countries are selected @@ -79,12 +80,14 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = c("confirmed", "deaths", "r #' #' @noRd mod_compare_nth_cases_plot_server <- function(input, output, session, df, - n = 1000, w = 7, - n_highligth = 5, istop = TRUE, g_palette = graph_palette){ + nn = 1000, w = 7, + n_highligth = 5, istop = TRUE, g_palette = graph_palette, datevar = "date"){ ns <- session$ns + df$Date = df[[datevar]] # Give DF standard structure; reacts to input$radio_indicator df_data <- reactive({ + if(istop) { countries_order = df %>% filter(date == max(date)) %>% arrange(desc(!!as.symbol(req(input$radio_indicator)))) %>% @@ -95,14 +98,20 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df, } else { data = df } - df_tmp <- data %>% .[,c("Country.Region", req(input$radio_indicator), "contagion_day")] %>% + + # filter off x before nn + date_first_contagion = min(data$date[data$confirmed >= nn]) + data = data[data$date >= date_first_contagion, ] + + df_tmp <- data %>% .[,c("Country.Region", req(input$radio_indicator), "Date")] %>% bind_cols(data[,req(input$radio_indicator)] %>% setNames("Value")) %>% rename(Status = Country.Region ) %>% - rename(Date = contagion_day ) %>% + #rename(Date = contagion_day ) %>% select(-req(input$radio_indicator)) + # filter dates with 0 contagions - if (istop && ("China" %in% df_tmp$Status)) { + if (istop && ("China" %in% df_tmp$Status) && datevar == "contagion_day") { # Day of the country with max contagions after china max_contagion_no_china <- df_tmp %>% filter(Status != "China") %>% @@ -125,7 +134,8 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df, # Plot ----- output$plot <- renderPlotly({ - p <- plot_all_highlight(df_data(), log = log(), text = "Area", n_highligth = n_highligth, percent = ifelse(req(input$radio_indicator) %in% rate_vars, TRUE, FALSE), date_x = FALSE, g_palette) + p <- plot_all_highlight(df_data(), log = log(), text = "Area", n_highligth = n_highligth, percent = ifelse(req(input$radio_indicator) %in% rate_vars, TRUE, FALSE), + date_x = ifelse(datevar == "date", TRUE,FALSE), g_palette) p <- p %>% plotly::ggplotly(tooltip = c("text", "x_tooltip", "y_tooltip")) %>% plotly::layout(legend = list(orientation = "h", y = 1.1, yanchor = "bottom", itemsizing = "constant")) @@ -135,16 +145,18 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df, if (istop) { output$title <- renderUI({ - div(h4(paste0("Top ",n_highligth," countries from day of ", n ," contagion")), align = "center", style = "margin-top:20px; margin-bottom:20px;") + div(h4(paste0("Top ",n_highligth," countries from day of ", nn ," contagion")), align = "center", style = "margin-top:20px; margin-bottom:20px;") }) } else { output$title <- renderUI({ - div(h4(paste0("Timeline from day of ", n ," contagion")), align = "center", style = "margin-top:20px; margin-bottom:20px;") + div(h4(paste0("Timeline from day with ", nn ," contagions")), align = "center", style = "margin-top:20px; margin-bottom:20px;") }) } output$caption <- renderUI({ - p(paste0("Computed as rolling weekly average. Day 0 is the day when ", n," confirmed cases are reached.")) + + p(paste0("Computed as rolling weekly average. ",ifelse(datevar == "date", "First day", "Contagion day 0"), + " is the day when ", nn," confirmed cases are reached.")) }) } diff --git a/R/mod_continent.R b/R/mod_continent.R index 48edf465..0d75b3be 100644 --- a/R/mod_continent.R +++ b/R/mod_continent.R @@ -86,7 +86,7 @@ mod_continent_ui <- function(id, uicont){ #' #' @param orig_data_aggregate data.frame with data from 1 continent #' @param countries_data_map full sp data.frame with map details -#' @param n min number of cases for a country to be considered. Default 1000 +#' @param nn min number of cases for a country to be considered. Default 1000 #' @param w number of days of outbreak. Default 7 #' @param pop_data data.frame population #' @param cont character continent or subcontinent name @@ -94,7 +94,7 @@ mod_continent_ui <- function(id, uicont){ #' @import dplyr #' #' @noRd -mod_continent_server <- function(input, output, session, orig_data_aggregate, countries_data_map, n = 1000, w = 7, pop_data, cont, uicont){ +mod_continent_server <- function(input, output, session, orig_data_aggregate, countries_data_map, nn = 1000, w = 7, pop_data, cont, uicont){ ns <- session$ns message("Process continent ", cont) @@ -125,7 +125,7 @@ mod_continent_server <- function(input, output, session, orig_data_aggregate, co subcontinent_data_filtered <- subcontinent_data %>% # select sub-continents with longer outbreaks - rescale_df_contagion(n = n, w = w) + rescale_df_contagion(n = nn, w = w) continent_data_today <- continent_data %>% @@ -155,15 +155,16 @@ mod_continent_server <- function(input, output, session, orig_data_aggregate, co levs <- sort_type_hardcoded() df_continent = - tsdata_areplot(continent_data,levs) + tsdata_areplot(continent_data,levs, nn = nn) callModule(mod_plot_log_linear_server, "plot_area_cont", df = df_continent, type = "area", g_palette = subcont_palette) output[[paste("from_nth_case", uicont , sep = "_")]]<- renderUI({ HTML(paste( paste0(cont, " countries are grouped in Macro Areas as defined by United Nations."), paste0("The Areas are represented by the colors in the heatmap above, used also in the graphs of this page."), - paste0("Only Areas with more than ", n, " confirmed cases, and outbreaks longer than ", w, " days considered."), - paste0("Contagion day 0 is the first day with more than ", n ," cases."), sep = "
")) + paste0("Only Areas with more than ", nn, " confirmed cases, and outbreaks longer than ", w, " days considered."), + #paste0("Contagion day 0 is the first day with more than ", nn ," cases."), + sep = "
")) }) # list of countries list.message = @@ -182,7 +183,7 @@ mod_continent_server <- function(input, output, session, orig_data_aggregate, co callModule(mod_lineplots_day_contagion_server, "lineplots_day_contagion_cont", - subcontinent_data_filtered, g_palette = subcont_palette) + subcontinent_data, g_palette = subcont_palette, nn = nn) # Rate plots ---- output[[paste("rateplots_cont", uicont , sep = "_")]] <- renderUI({ @@ -190,17 +191,17 @@ mod_continent_server <- function(input, output, session, orig_data_aggregate, co }) callModule(mod_growth_death_rate_server, "rate_plots_cont", subcontinent_data_filtered, - n = n, n_highligth = length(subcontinents), istop = FALSE, + nn = nn, n_highligth = length(subcontinents), istop = FALSE, g_palette = list("growth_factor" = subcont_palette, "death_rate" = subcont_palette)) # Line with bullet plot output[[paste("lines_points_plots_cont", uicont , sep = "_")]] <- renderUI({ - mod_compare_nth_cases_plot_ui(ns("lines_points_plots_cont")) + mod_compare_nth_cases_plot_ui(ns("lines_points_plots_cont"), selectvar = "new_prevalence_rate_1M_pop") }) - callModule(mod_compare_nth_cases_plot_server, "lines_points_plots_cont", subcontinent_data_filtered, n = n, w = w, + callModule(mod_compare_nth_cases_plot_server, "lines_points_plots_cont", subcontinent_data, nn = nn, w = w, n_highligth = length(subcontinents), istop = FALSE , g_palette = subcont_palette) # scatterplot @@ -209,7 +210,7 @@ mod_continent_server <- function(input, output, session, orig_data_aggregate, co }) callModule(mod_scatterplot_server, "scatterplot_plots_cont", - subcontinent_data_filtered, nmed = n, n_highligth = length(subcontinents), + subcontinent_data_filtered, nmed = nn, n_highligth = length(subcontinents), istop = FALSE, countries = subcontinents) @@ -217,7 +218,7 @@ mod_continent_server <- function(input, output, session, orig_data_aggregate, co mod_stackedbarplot_ui(ns("status_stackedbarplot_cont")) }) callModule(mod_stackedbarplot_status_server, "status_stackedbarplot_cont", - subcontinent_data_filtered, n = n, n_highligth = length(subcontinents), istop = FALSE) + subcontinent_data_filtered, n_highligth = length(subcontinents), istop = FALSE) # Compute Last week variables diff --git a/R/mod_continent_comparison.R b/R/mod_continent_comparison.R index f78ee037..ac5fc344 100644 --- a/R/mod_continent_comparison.R +++ b/R/mod_continent_comparison.R @@ -38,13 +38,13 @@ mod_continent_comparison_ui <- function(id){ #' continent_comparison Server Function #' #' @param orig_data_aggregate data.frame -#' @param n min number of cases for a country to be considered. Default 1000 +#' @param nn min number of cases for a country to be considered. Default 1000 #' @param w number of days of outbreak. Default 7 #' #' @import dplyr #' #' @noRd -mod_continent_comparison_server <- function(input, output, session, orig_data_aggregate, n = 1000, w = 7, pop_data){ +mod_continent_comparison_server <- function(input, output, session, orig_data_aggregate, nn = 1000, w = 7, pop_data){ ns <- session$ns # aggregate data to continent @@ -54,7 +54,7 @@ mod_continent_comparison_server <- function(input, output, session, orig_data_ag # create data for comparison with common starting point continent_data_filtered <- continent_data %>% - rescale_df_contagion(n = n, w = w) + rescale_df_contagion(n = nn, w = w) output$lineplots_cont <- renderUI({ tagList( @@ -63,22 +63,22 @@ mod_continent_comparison_server <- function(input, output, session, orig_data_ag ) }) - callModule(mod_lineplots_day_contagion_server, "lineplots_day_contagion_cont", continent_data_filtered) + callModule(mod_lineplots_day_contagion_server, "lineplots_day_contagion_cont", continent_data, nn = nn) # Rate plots ---- output$rateplots_cont <- renderUI({ mod_growth_death_rate_ui(ns("rate_plots_cont")) }) - callModule(mod_growth_death_rate_server, "rate_plots_cont", continent_data_filtered, n = n, n_highligth = length(continents), istop = FALSE) + callModule(mod_growth_death_rate_server, "rate_plots_cont", continent_data_filtered, nn = nn, n_highligth = length(continents), istop = FALSE) # Line with bullet plot output$lines_points_plots_cont <- renderUI({ - mod_compare_nth_cases_plot_ui(ns("lines_points_plots_cont"), tests = FALSE, hosp = FALSE) + mod_compare_nth_cases_plot_ui(ns("lines_points_plots_cont"), tests = FALSE, hosp = FALSE, selectvar = "new_prevalence_rate_1M_pop") }) - callModule(mod_compare_nth_cases_plot_server, "lines_points_plots_cont", continent_data_filtered, n = n, w = w, + callModule(mod_compare_nth_cases_plot_server, "lines_points_plots_cont", continent_data, nn = nn, w = w, n_highligth = length(continents), istop = FALSE) # scatterplot @@ -86,12 +86,12 @@ mod_continent_comparison_server <- function(input, output, session, orig_data_ag mod_scatterplot_ui(ns("scatterplot_plots_cont")) }) - callModule(mod_scatterplot_server, "scatterplot_plots_cont", continent_data_filtered, nmed = n, n_highligth = length(continents), istop = FALSE, countries = continents) + callModule(mod_scatterplot_server, "scatterplot_plots_cont", continent_data_filtered, nmed = nn, n_highligth = length(continents), istop = FALSE, countries = continents) output$status_stackedbarplot_cont <- renderUI({ mod_stackedbarplot_ui(ns("status_stackedbarplot_cont")) }) - callModule(mod_stackedbarplot_status_server, "status_stackedbarplot_cont", continent_data_filtered, n = n, n_highligth = length(continents), istop = FALSE) + callModule(mod_stackedbarplot_status_server, "status_stackedbarplot_cont", continent_data_filtered, n_highligth = length(continents), istop = FALSE) # tables ---- callModule(mod_add_table_server, "add_table_cont", continent_data_filtered, maxrowsperpage = 10) diff --git a/R/mod_country.R b/R/mod_country.R index 5cdf692f..1cd9a093 100644 --- a/R/mod_country.R +++ b/R/mod_country.R @@ -116,7 +116,7 @@ areaUI = function(id, tab = TRUE){ #' #' @param data data.frame #' @param countries reactive character vector -#' @param n min number of cases for used to filter country data +#' @param nn min number of cases for used to filter country data #' @param w number of days of outbreak. Default 7 #' @param n.select min number of cases for a country to be considered in selectInput. #' @@ -125,7 +125,7 @@ areaUI = function(id, tab = TRUE){ #' @import shiny #' #' @noRd -mod_country_server <- function(input, output, session, data, countries, n = 1, w = 7, n.select = 1000){ +mod_country_server <- function(input, output, session, data, countries, nn = 100, w = 7, n.select = 1000){ ns <- session$ns message("mod_country_server") observe( @@ -137,7 +137,7 @@ mod_country_server <- function(input, output, session, data, countries, n = 1, w output$from_nth_case<- renderUI({ HTML(paste(paste0("Only Countries with more than ", n.select, " confirmed cases can be chosen."), paste0("Some countries are not providing Recovered data."), - paste0("Contagion day 0 is the day when ", n ," confirmed cases are reached."), sep = "
")) + paste0("1st day is the day when ", nn ," confirmed cases are reached."), sep = "
")) }) observeEvent(input$select_country, { @@ -166,9 +166,9 @@ mod_country_server <- function(input, output, session, data, countries, n = 1, w country_data_area$active = country_data_area$active - country_data_area$hosp } #n_country = select_n(country_data_area$confirmed,n) - message("n for ", req(input$select_country), " = ", n) + message("n for ", req(input$select_country), " = ", nn) # for country plot start from the beginning - df_tot = tsdata_areplot(country_data_area,levs, n) # start from day with >n + df_tot = tsdata_areplot(country_data_area,levs, nn) # start from day with >nn callModule(mod_plot_log_linear_server, "plot_area_tot", df = df_tot, type = "area") @@ -176,9 +176,9 @@ mod_country_server <- function(input, output, session, data, countries, n = 1, w mod_bar_plot_day_contagion_ui(ns("bar_plot_day_contagion")) }) - callModule(mod_compare_nth_cases_plot_server, "lines_points_plots_tot", country_data , n = n, w = w, istop = FALSE) + callModule(mod_compare_nth_cases_plot_server, "lines_points_plots_tot", country_data , nn = nn, w = w, istop = FALSE) - callModule(mod_bar_plot_day_contagion_server, "bar_plot_day_contagion", country_data) + callModule(mod_bar_plot_day_contagion_server, "bar_plot_day_contagion", country_data, nn = nn) # }) # # ##### country split within areas ############################################# @@ -213,7 +213,7 @@ mod_country_server <- function(input, output, session, data, countries, n = 1, w build_data_aggr(area_data_2) # works in example message("id lev2 = ", id) - callModule(mod_country_area_server, id, data = area_data_2_aggregate, n2 = max(1,n/10)) + callModule(mod_country_area_server, id, data = area_data_2_aggregate, n2 = max(1,nn/10)) } else{ message("remove level 2 UI for ", req(input$select_country)) @@ -282,14 +282,14 @@ mod_country_area_server <- function(input, output, session, data, n2 = 1, w = 7, HTML(paste( "Some countries have unreliable or inconsistent data at regional level. They may not match those at Country Level or they may miss information.", paste0("Some countries or some regions within countries are not providing Recovered data."), - paste0("Contagion day 0 is the day when ", n2 ," confirmed cases are reached."), sep = "
")) + paste0("1st day is the day when ", n2 ," confirmed cases are reached."), sep = "
")) }) # plots ---- levs <- sort_type_hardcoded() df_area_2 = purrr::map(unique(data$Country.Region), function(un) { - dat = tsdata_areplot(data[data$Country.Region == un, ], levs, 0) #n = 0 for area plot + dat = tsdata_areplot(data[data$Country.Region == un, ], levs, nn = n2) #n = 0 for area plot dat$Country.Region = rep(un, nrow(dat)) dat }) @@ -321,15 +321,15 @@ mod_country_area_server <- function(input, output, session, data, n2 = 1, w = 7, # > comparison plot from day of nth contagion output[["plot_compare_nth_area2"]] <- renderUI({ - mod_compare_nth_cases_plot_ui(ns("lines_plots_area2"), tests = FALSE, hosp = FALSE) + mod_compare_nth_cases_plot_ui(ns("lines_plots_area2"), tests = FALSE, hosp = FALSE, selectvar = "new_prevalence_rate_1M_pop") }) - callModule(mod_compare_nth_cases_plot_server, "lines_plots_area2", df = data_2_filtered, n = n2, istop = TRUE) + callModule(mod_compare_nth_cases_plot_server, "lines_plots_area2", df = data, nn = n2, istop = TRUE) # > growth_death_rate, output[["plot_growth_death_rate_area2"]] <- renderUI({ mod_growth_death_rate_ui(ns("rate_plots_area2")) }) - callModule(mod_growth_death_rate_server, "rate_plots_area2", df = data, n = n2, istop = FALSE, n_highligth = length(unique(data$Country.Region))) + callModule(mod_growth_death_rate_server, "rate_plots_area2", df = data, nn = n2, istop = FALSE, n_highligth = length(unique(data$Country.Region))) # > scatterplot prevalence vs growth output[["plot_scatterplot_area_2"]] <- renderUI({ @@ -342,7 +342,7 @@ mod_country_area_server <- function(input, output, session, data, n2 = 1, w = 7, callModule(mod_scatterplot_server, "scatterplot_plots_area2", df = data_2_filtered_today, istop = FALSE, nmed = n2, countries = areasC()) # > stacked barplot with status split, use data_2_filtered_today - callModule(mod_stackedbarplot_status_server, "plot_stackedbarplot_status_area2", df = data_2_filtered, n = n2, istop = FALSE, n_highligth = length(unique(data_2_filtered$Country.Region))) + callModule(mod_stackedbarplot_status_server, "plot_stackedbarplot_status_area2", df = data_2_filtered, istop = FALSE, n_highligth = length(unique(data_2_filtered$Country.Region))) if(tab) { # prepare data for table with country data @@ -356,13 +356,3 @@ mod_country_area_server <- function(input, output, session, data, n2 = 1, w = 7, } } - -# select_n <- function(var, n = 100) { -# ifelse(max(var) > 10000, -# n, -# ifelse(max(var) > 1000, -# n/10, -# ifelse(max(var) > 100, -# n/100, -# 1))) -# } diff --git a/R/mod_country_comparison.R b/R/mod_country_comparison.R index e3a34de1..95fb5512 100644 --- a/R/mod_country_comparison.R +++ b/R/mod_country_comparison.R @@ -44,14 +44,14 @@ mod_country_comparison_ui <- function(id){ #' country_comparison Server Function #' #' @param data data.frame with countries -#' @param n min number of cases for used to filter country data +#' @param nn min number of cases for used to filter country data #' @param w number of days of outbreak. Default 7 #' @param n.select min number of cases for a country to be considered in selectInput. #' #' @import dplyr #' #' @noRd -mod_country_comparison_server <- function(input, output, session, data, countries, n = 1000, w = 7, n.select){ +mod_country_comparison_server <- function(input, output, session, data, countries, nn = 1000, w = 7, n.select){ ns <- session$ns # Data ---- @@ -62,7 +62,7 @@ mod_country_comparison_server <- function(input, output, session, data, countrie output$from_nth_case<- renderUI({ HTML(paste(paste0("Only Countries with more than ", n.select, " confirmed cases can be chosen."), paste0("Some countries are not providing Recovered data."), - paste0("Contagion day 0 is the day when ", n ," confirmed cases are reached."), sep = "
")) + paste0("1st day is the day when ", nn ," confirmed cases are reached."), sep = "
")) }) all_countries_data <- data %>% @@ -78,10 +78,9 @@ mod_country_comparison_server <- function(input, output, session, data, countrie arrange(desc(date)) # align contagion day for comparisons - data_filtered <- - countries_data %>% - rescale_df_contagion(n = n, w = w) - + # data_filtered <- + # countries_data %>% + # rescale_df_contagion(n = nn, w = w) # output$from_nth_case <- renderText({ # paste0("Only countries with more than ", n, " confirmed cases, and outbreaks longer than ", w, " days considered. Contagion day 0 is the first day with more than ", n ," cases.") # }) @@ -100,7 +99,7 @@ mod_country_comparison_server <- function(input, output, session, data, countrie lapply(input$select_countries, function(country){ country_data <- countries_data %>% filter(Country.Region %in% country) - callModule(mod_bar_plot_day_contagion_server, paste0(country,"_bar_plot_day_contagion"), country_data) + callModule(mod_bar_plot_day_contagion_server, paste0(country,"_bar_plot_day_contagion"), country_data, nn = nn) }) } @@ -112,22 +111,22 @@ mod_country_comparison_server <- function(input, output, session, data, countrie ) }) - callModule(mod_lineplots_day_contagion_server, "lineplots_day_contagion", countries_data) + callModule(mod_lineplots_day_contagion_server, "lineplots_day_contagion", countries_data, nn = nn) # Rate plots ---- output$rateplots <- renderUI({ mod_growth_death_rate_ui(ns("rate_plots")) }) - callModule(mod_growth_death_rate_server, "rate_plots", countries_data, n = n, n_highligth = length(input$select_countries), istop = F) + callModule(mod_growth_death_rate_server, "rate_plots", countries_data, nn = nn, n_highligth = length(input$select_countries), istop = F) # Line with bullet plot output$lines_points_plots <- renderUI({ - mod_compare_nth_cases_plot_ui(ns("lines_points_plots"), tests = TRUE, hosp = TRUE) + mod_compare_nth_cases_plot_ui(ns("lines_points_plots"), tests = TRUE, hosp = TRUE, selectvar = "new_prevalence_rate_1M_pop") }) - callModule(mod_compare_nth_cases_plot_server, "lines_points_plots", data_filtered, n = n, w = w, n_highligth = length(input$select_countries), istop = FALSE) + callModule(mod_compare_nth_cases_plot_server, "lines_points_plots", countries_data, nn = nn, w = w, n_highligth = length(input$select_countries), istop = FALSE) inputcountries = reactive({input$select_countries}) # pass countries to plot below output$scatterplot_plots <- renderUI({ @@ -139,7 +138,7 @@ mod_country_comparison_server <- function(input, output, session, data, countrie output$status_stackedbarplot <- renderUI({ mod_stackedbarplot_ui(ns("status_stackedbarplot")) }) - callModule(mod_stackedbarplot_status_server, "status_stackedbarplot", countries_data, n = n, n_highligth = length(input$select_countries), istop = FALSE) + callModule(mod_stackedbarplot_status_server, "status_stackedbarplot", countries_data, n_highligth = length(input$select_countries), istop = FALSE) # tables ---- callModule(mod_add_table_server, "add_table_countries", countries_data, maxrowsperpage = 10) diff --git a/R/mod_global.R b/R/mod_global.R index 8c53964a..a869686a 100644 --- a/R/mod_global.R +++ b/R/mod_global.R @@ -39,7 +39,7 @@ mod_global_ui <- function(id){ mod_plot_log_linear_ui(ns("plot_log_linear_top_n"), area = FALSE) ), column(6, - mod_compare_nth_cases_plot_ui(ns("plot_compare_nth")) + mod_compare_nth_cases_plot_ui(ns("plot_compare_nth"), selectvar = "new_prevalence_rate_1M_pop") ) ), hr(), @@ -127,11 +127,11 @@ mod_global_server <- function(input, output, session, orig_data_aggregate, data_ n = 1000 # define areaplot start df_global = - tsdata_areplot(total,levs, n) # start from day with >1000 + tsdata_areplot(total,levs, nn = n) # start from day with >1000 callModule(mod_plot_log_linear_server, "plot_area_global", df = df_global, type = "area") - callModule(mod_compare_nth_cases_plot_server, "lines_points_plots_global", total_aggregate, n = n, istop = FALSE) + callModule(mod_compare_nth_cases_plot_server, "lines_points_plots_global", total_aggregate, nn = n, istop = FALSE) # > line plot top 5 #df_top_n <- @@ -152,7 +152,7 @@ mod_global_server <- function(input, output, session, orig_data_aggregate, data_ # > comparison plot from day of nth contagion - callModule(mod_compare_nth_cases_plot_server, "plot_compare_nth", data_filtered) + callModule(mod_compare_nth_cases_plot_server, "plot_compare_nth", orig_data_aggregate, nn = n) # > growth_death_rate callModule(mod_growth_death_rate_server, "plot_growth_death_rate", orig_data_aggregate, n_highligth = 10) diff --git a/R/mod_growth_death_rate.R b/R/mod_growth_death_rate.R index ae710de7..0d8a0a45 100644 --- a/R/mod_growth_death_rate.R +++ b/R/mod_growth_death_rate.R @@ -38,7 +38,7 @@ mod_growth_death_rate_ui <- function(id){ #' growth_death_rate Server Function #' #' @param df reactive data.frame -#' @param n min number of cases for a country to be considered. Default 1000 +#' @param nn min number of cases for a country to be considered. Default 1000 #' @param w number of days of outbreak. Default 7 #' @param n_highligth number of countries to highlight #' @param istop logical to choose title @@ -50,7 +50,7 @@ mod_growth_death_rate_ui <- function(id){ #' @example ex-mod_growth_death_rate.R #' #' @noRd -mod_growth_death_rate_server <- function(input, output, session, df, n = 1000, w = 7, +mod_growth_death_rate_server <- function(input, output, session, df, nn = 1000, w = 7, n_highligth = 5, istop = TRUE, g_palette = list("growth_factor" = rate_colors["growth_factor"], "death_rate" = rate_colors["death_rate"])){ @@ -60,7 +60,7 @@ mod_growth_death_rate_server <- function(input, output, session, df, n = 1000, w scale_mortality_rate <- function(dat){ df1 <- dat %>% - select_countries_n_cases_w_days(n = n, w = w) %>% + select_countries_n_cases_w_days(n = nn, w = w) %>% filter( date == max(date)) df1 } diff --git a/R/mod_individual_country.R b/R/mod_individual_country.R index f235c728..8c063f85 100644 --- a/R/mod_individual_country.R +++ b/R/mod_individual_country.R @@ -98,7 +98,7 @@ areamapUI = function(id, country){ #' #' @param data data.frame #' @param countries reactive character vector -#' @param n min number of cases for used to filter country data +#' @param nn min number of cases for used to filter country data #' @param w number of days of outbreak. Default 7 #' #' @import dplyr @@ -106,14 +106,14 @@ areamapUI = function(id, country){ #' @import shiny #' #' @noRd -mod_ind_country_server <- function(input, output, session, data, country , n = 1, w = 7){ +mod_ind_country_server <- function(input, output, session, data, country , nn = 1, w = 7){ ns <- session$ns message("mod_ind_country_server") output$ind_from_nth_case<- renderUI({ HTML(paste( paste0("Some Cantons are not providing Recovered data."), - paste0("Contagion day 0 is the day when ", n ," confirmed cases are reached."), sep = "
")) + paste0("1st day is the day when ", nn ," confirmed cases are reached."), sep = "
")) }) message("process individual country ", country) @@ -139,17 +139,17 @@ mod_ind_country_server <- function(input, output, session, data, country , n = 1 levs = c(levs, "hosp") country_data_area$active = country_data_area$active - country_data_area$hosp } - message("n for ", country, " = ", n) + message("n for ", country, " = ", nn) - callModule(mod_bar_plot_day_contagion_server, "ind_bar_plot_day_contagion", country_data) + callModule(mod_bar_plot_day_contagion_server, "ind_bar_plot_day_contagion", country_data, nn = nn) # for country plot start from the beginning - df_tot = tsdata_areplot(country_data_area,levs, n) # start from day with >n + df_tot = tsdata_areplot(country_data_area,levs, nn = nn) # start from day with >nn callModule(mod_plot_log_linear_server, "ind_plot_area_tot", df = df_tot, type = "area") - callModule(mod_compare_nth_cases_plot_server, "ind_lines_points_plots_tot", country_data , n = n, w = w, istop = FALSE) + callModule(mod_compare_nth_cases_plot_server, "ind_lines_points_plots_tot", country_data , nn = nn, w = w, istop = FALSE) # # ##### country split within areas ############################################# @@ -167,7 +167,7 @@ mod_ind_country_server <- function(input, output, session, data, country , n = 1 areaUI(ns("ind_country_subarea"), tab = FALSE) #areaUI("ind_country_subarea") }) - callModule(mod_country_area_server, "ind_country_subarea", data = area_data_2_aggregate, n2 = max(1,n/10), tab = FALSE) + callModule(mod_country_area_server, "ind_country_subarea", data = area_data_2_aggregate, n2 = 10, tab = FALSE) output$maps_ind_subarea <- renderUI({ areamapUI(ns("maps_subarea"), country) diff --git a/R/mod_lineplots_day_contagion.R b/R/mod_lineplots_day_contagion.R index 50fbed62..1ba09a05 100644 --- a/R/mod_lineplots_day_contagion.R +++ b/R/mod_lineplots_day_contagion.R @@ -20,13 +20,14 @@ mod_lineplots_day_contagion_ui <- function(id){ #' #' @param countries_data data.frame for multiple countries #' @param g_palette character vector of colors for the graph and legend +#' @param nn minimum date derived from first day with more than nn cases #' #' @import dplyr #' @import tidyr #' @import ggplot2 #' #' @noRd -mod_lineplots_day_contagion_server <- function(input, output, session, countries_data, g_palette = graph_palette){ +mod_lineplots_day_contagion_server <- function(input, output, session, countries_data, g_palette = graph_palette, nn){ ns <- session$ns # countries_ordered <- reactive({ # countries_data() %>% @@ -38,6 +39,8 @@ mod_lineplots_day_contagion_server <- function(input, output, session, countries # select(Country.Region) %>% # pull() # }) + mindate = min(countries_data$date[countries_data$confirmed>nn]) + countries_data = countries_data %>% filter(date > mindate) statuses <- c("confirmed", "deaths", "recovered", "active") output$line_plot_day_contagion <- renderPlot({ diff --git a/R/mod_plot_log_linear.R b/R/mod_plot_log_linear.R index 3a099a65..4c0eb1bb 100644 --- a/R/mod_plot_log_linear.R +++ b/R/mod_plot_log_linear.R @@ -41,7 +41,7 @@ mod_plot_log_linear_ui <- function(id, select = FALSE, area = TRUE){ #' @param df data.frame #' @param type character string. Either area or line. Used to select plot type. #' @param g_palette character vector of colors for the graph and legend -#' +#' @param countries character vector of countries considered, NULL if only one #' @example man-roxygen/ex-plot_log_linear.R #' #' @import dplyr diff --git a/R/mod_stackedbarplot_status.R b/R/mod_stackedbarplot_status.R index 01cec029..2ff51134 100644 --- a/R/mod_stackedbarplot_status.R +++ b/R/mod_stackedbarplot_status.R @@ -18,6 +18,9 @@ mod_stackedbarplot_ui <- function(id, n_highligth = 5){ #' stackedbarplot_status Server Function #' #' @param df data.frame for multiple countries +#' @param w number of days of outbreak. Default 7 +#' @param n_highligth number of countries considered. +#' @param istop logical to choose title, if top n_highligth countries are selected #' #' @import dplyr #' @import tidyr @@ -25,7 +28,7 @@ mod_stackedbarplot_ui <- function(id, n_highligth = 5){ #' @import purrr #' @importFrom plotly ggplotly layout #' @noRd -mod_stackedbarplot_status_server <- function(input, output, session, df, n = 1000, w = 7, n_highligth = 5, istop = T){ +mod_stackedbarplot_status_server <- function(input, output, session, df, w = 7, n_highligth = 5, istop = TRUE){ ns <- session$ns # titles if (istop) { @@ -34,13 +37,13 @@ mod_stackedbarplot_status_server <- function(input, output, session, df, n = 100 output$title_stackedbarplot_status <- renderUI(div(h4("Status split"), align = "center", style = "margin-top:20px; margin-bottom:20px;")) } - prep_data <- function(data, n, w){ + prep_data <- function(data, w){ df1 <- data %>% #select_countries_n_cases_w_days(n = n, w = w) %>% filter( date == max(date)) df1 } - df_pop <- reactive({prep_data(df, n,w)}) + df_pop <- reactive({prep_data(df,w)}) statuses <- c("deaths", "active", "recovered") @@ -69,7 +72,7 @@ mod_stackedbarplot_status_server <- function(input, output, session, df, n = 100 status = factor(status, levels = statuses)) %>% arrange(status)}) - caption_explain <- "The plot shows what countries have more to recover from their Confirmed cases. Not all of them may have provided Recovered numbers." + caption_explain <- "The plot shows what countries have more to recover from their Confirmed cases. Not all of them may have provided Recovered cases" output$plot_stackedbarplot_status <- renderUI({ tagList( diff --git a/R/plots.R b/R/plots.R index 2ac78cfd..b3771396 100644 --- a/R/plots.R +++ b/R/plots.R @@ -27,7 +27,7 @@ stackedbarplot_plot <- function(df, percent = TRUE, labsize = 10, labangle = 30 basic_plot_theme() + geom_col(position = position_stack(reverse = TRUE)) + theme( - axis.text.x = element_text(angle = labangle, size = labsize) + axis.text.x = element_text(angle = labangle, size = labsize, hjust = 1) ) if (percent) { p <- p + scale_y_continuous(labels = function(x) paste0(x, "%")) @@ -106,10 +106,9 @@ time_evol_line_plot <- function(df, log = FALSE, text = "", g_palette = graph_pa limits = x.d.lim, date_labels = "%d-%m") + scale_y_continuous(labels = label_number(big.mark = "'")) + - # scale_x_date(date_breaks = "2 weeks", date_minor_breaks = "1 week", limits = range(df$Date), - # date_labels = "%d-%m") + + theme( - axis.text.x = element_text(angle = 45), + axis.text.x = element_text(angle = 45, hjust = 1) ) if (log) { @@ -230,7 +229,7 @@ time_evol_area_plot <- function(df, stack = F, log = F, text = "") { scale_y_continuous(labels = label_number(big.mark = "'")) + # add label theme( - axis.text.x = element_text(angle = 45) + axis.text.x = element_text(angle = 45, hjust = 1) ) p <- p %>% @@ -281,7 +280,7 @@ time_evol_line_facet_plot <- function(df, log, g_palette = graph_palette) { date_labels = "%d-%m") + theme( - axis.text.x = element_text(angle = 45, hjust = 1), + axis.text.x = element_text(angle = 45, hjust = 1) ) p <- p %>% @@ -379,6 +378,7 @@ from_contagion_day_bar_plot <- function(df){ #' Evolution from contagion day facet #' #' @param df data.frame to plot +#' @param xdate character variable for x axis #' #' @return barplot facet #' @@ -386,14 +386,28 @@ from_contagion_day_bar_plot <- function(df){ #' @importFrom grid grid.draw #' #' @export -from_contagion_day_bar_facet_plot <- function(df){ - p <- ggplot(df, aes(x = contagion_day, y = value, fill = bool_new)) + +from_contagion_day_bar_facet_plot <- function(df, xdate = "date"){ + df$Date = df[[xdate]] + p <- ggplot(df, aes(x = Date, y = value, fill = bool_new)) + geom_bar(stat = "identity") + scale_fill_manual(values = new_total_colors) + #c("total" = "#C8C8C8", "new" = "#ea8b5b")) + basic_plot_theme() + facet_wrap( ~ status, scales = "free_y", nrow = 1, ncol = 4) + theme(strip.text = element_text(colour = 'white')) + if (xdate == "date") { + # date x axis + x.d.lim = range(df$Date) + x.d.breaks = seq(x.d.lim[1],x.d.lim[2], length.out = 10) + p <- p + scale_x_date(breaks = x.d.breaks, + date_minor_breaks = "1 week", limits = x.d.lim, + date_labels = "%d-%m") + + theme( + axis.text.x = element_text(angle = 45, hjust = 1) + ) + } + + p <- p %>% fix_legend_position() @@ -504,7 +518,7 @@ fix_legend_position <- function(p){ #' @importFrom scales label_number #' #' @export -plot_all_highlight <- function(df, log = FALSE, text = "", n_highligth = 10, percent = F, date_x = F, g_palette = graph_palette) { +plot_all_highlight <- function(df, log = FALSE, text = "", n_highligth = 10, percent = FALSE, date_x = FALSE, g_palette = graph_palette) { #clean df for log case if (log) { @@ -521,7 +535,6 @@ plot_all_highlight <- function(df, log = FALSE, text = "", n_highligth = 10, per } # df_highlight <- df %>% # filter(as.integer(Status) < n_highligth + 1) #pick top n_highligth countries, using factor level (factor is ordered by decreasing Value) - # rolling weekly average (#80), changed alignment to right df_highlight <- df %>% group_by(Status) %>% arrange(Date) %>% @@ -539,7 +552,6 @@ plot_all_highlight <- function(df, log = FALSE, text = "", n_highligth = 10, per # # df$Value = gen_text(df$Variable) # df_highlight$Value = gen_text(df_highlight$Variable) - p <- ggplot(df, aes(x = Date, y = Value, colour = Status, text = paste0(text, ": ", Status), x_tooltip = Date, y_tooltip = Value)) + geom_line(data = df_highlight, aes(x = Date, y = Value, colour = Status)) + basic_plot_theme() + @@ -565,7 +577,7 @@ plot_all_highlight <- function(df, log = FALSE, text = "", n_highligth = 10, per limits = x.d.lim, date_minor_breaks = "1 week", date_labels = "%d-%m") + theme( - axis.text.x = element_text(angle = 45) + axis.text.x = element_text(angle = 45, hjust = 1) ) } @@ -607,7 +619,7 @@ plot_rate_hist <- function(df, percent = FALSE, y_min = 0, g_palette, labsize = theme(panel.background = element_rect(fill = backgroud_map_col))+ # set grey background coord_cartesian(ylim = c(y_min, max(df$Value))) + theme( - axis.text.x = element_text(angle = labangle, size = labsize) + axis.text.x = element_text(angle = labangle, size = labsize, hjust = 1) ) if (percent) { @@ -655,20 +667,6 @@ scatter_plot <- function(df, med, x.min = c(0.875, 1.125), y.min = c(0.99,1.01)) accy = ifelse(diff(ylim)<0.05, 0.001, 0.01) p <- ggplot(df) + basic_plot_theme() + - scale_x_continuous(labels = label_number( - big.mark = "'" - #suffix = "K" - )) + - scale_y_continuous(#limits = c(1, NA), # removed because growthrates can be even <1 - labels = label_number(accuracy = accy), - n.break = 5 - #labels = function(x) paste0(x, "%") - ) + - - # theme( - # axis.text.x = element_text() - # ) + - #labs(x="prevalence over 1M", y = "growth factor") + geom_point(aes(x = prevalence_rate_1M_pop, y = growthfactor, text = paste("prevalence 1M: ", formatC(prevalence_rate_1M_pop, format = "f", big.mark = "'", digits = 1), "
")), color = color_cntry, size = 1.3) + @@ -677,7 +675,17 @@ scatter_plot <- function(df, med, x.min = c(0.875, 1.125), y.min = c(0.99,1.01)) geom_text(aes(x = prevalence_rate_1M_pop, y = growthfactor, label= Country.Region), check_overlap = TRUE, color = color_cntry, size = 3.3) + coord_cartesian(ylim = ylim, - xlim = xlim) + xlim = xlim) + + scale_x_continuous(labels = label_number( + big.mark = "'", + #suffix = "K" + n.break = 5 + )) + + scale_y_continuous(#limits = c(1, NA), # removed because growthrates can be even <1 + labels = label_number(accuracy = accy), + n.break = 5 + #labels = function(x) paste0(x, "%") + ) p } diff --git a/R/utils.R b/R/utils.R index 83a81830..58e72da2 100644 --- a/R/utils.R +++ b/R/utils.R @@ -392,17 +392,20 @@ aggr_to_cont = function(data, group, time, #' creates time series for the area plot #' @param data data.frame aggregated data per region #' @param levs order of statuses -#' @param n minimum number of cases for the start date +#' @param nn minimum number of cases for the start date #' -#' @note starting date based on n, first day with so many confirmed +#' @note starting date based on nn, first day with so many confirmed cases #' #' @return data.frame reshaped #' #' @import tidyr -tsdata_areplot <- function(data, levs, n = 1000) { +tsdata_areplot <- function(data, levs, nn = 1000) { + + mindate = min(data$date[data$confirmed>nn]) + data = data %>% filter(date > mindate) data %>% - filter(confirmed > n) %>% #remove initial dates + #filter(confirmed > nn) %>% #remove initial dates select( date, !!levs) %>% #rename vars with labels #select(Country.Region, date, levs) %>% #renamevars() %>% diff --git a/man-roxygen/ex-country-comparison.R b/man-roxygen/ex-country-comparison.R index 4ed58101..4d501f78 100644 --- a/man-roxygen/ex-country-comparison.R +++ b/man-roxygen/ex-country-comparison.R @@ -10,7 +10,8 @@ if (interactive()) { library(scales) #sapply(file.path("R",list.files("R")), source) - #devtools::load_all() + pkgload::load_all(export_all = FALSE,helpers = FALSE,attach_testthat = FALSE) + long_title <- "Lorem ipsum dolor sit amet, consectetur adipisicing elit." ui <- fluidPage( Covid19Mirai:::mod_country_comparison_ui("country_comparison") @@ -31,13 +32,13 @@ if (interactive()) { Covid19Mirai:::rescale_df_contagion(n = n, w = w) countries <- reactive({ - data_filtered() %>% + data_filtered %>% select(Country.Region) %>% distinct() }) callModule(mod_country_comparison_server, "country_comparison", - data_filtered = data_filtered, countries = countries) + data = orig_data_aggregate, countries = countries, nn = n, n.select = n) } runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE) } diff --git a/man-roxygen/ex-country.R b/man-roxygen/ex-country.R index 82f08766..a24f192a 100644 --- a/man-roxygen/ex-country.R +++ b/man-roxygen/ex-country.R @@ -10,11 +10,11 @@ if (interactive()) { library(grid) library(scales) - #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( - mod_country_ui("country") + Covid19Mirai:::mod_country_ui("country") ) server <- function(input, output) { @@ -36,8 +36,8 @@ if (interactive()) { distinct() }) - callModule(mod_country_server, "country", - data = data_filtered, countries = countries, n = n, w = w) + callModule(Covid19Mirai:::mod_country_server, "country", + data = data_filtered, countries = countries, nn = n, w = w) } runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE) } diff --git a/man-roxygen/ex-individual_country.R b/man-roxygen/ex-individual_country.R index c0054a71..638e94b9 100644 --- a/man-roxygen/ex-individual_country.R +++ b/man-roxygen/ex-individual_country.R @@ -42,7 +42,7 @@ if (interactive()) { }) callModule(Covid19Mirai:::mod_ind_country_server, "ind_country", - data = data_filtered, country = country, n = n, w = w) + data = data_filtered, country = country, nn = n, w = w) } runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE) } diff --git a/man-roxygen/ex-mod-barplot-contagion-day.R b/man-roxygen/ex-mod-barplot-contagion-day.R index 324f31dc..57e4ed30 100644 --- a/man-roxygen/ex-mod-barplot-contagion-day.R +++ b/man-roxygen/ex-mod-barplot-contagion-day.R @@ -33,7 +33,7 @@ if (interactive()) { arrange(desc(date)) - callModule(Covid19Mirai:::mod_bar_plot_day_contagion_server,"bar_plot_day_contagion", country_data = country_data) + callModule(Covid19Mirai:::mod_bar_plot_day_contagion_server,"bar_plot_day_contagion", country_data = country_data, nn = n) } runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE) } diff --git a/man-roxygen/ex-mod_compare_nth_cases_plot.R b/man-roxygen/ex-mod_compare_nth_cases_plot.R index 48ad4fab..bf90cc73 100644 --- a/man-roxygen/ex-mod_compare_nth_cases_plot.R +++ b/man-roxygen/ex-mod_compare_nth_cases_plot.R @@ -10,7 +10,7 @@ if (interactive()) { library(scales) #sapply(file.path("R",list.files("R")), source) - #devtools::load_all() + devtools::load_all() ui <- fluidPage( tagList( Covid19Mirai:::golem_add_external_resources(), @@ -26,12 +26,12 @@ if (interactive()) { pop_data = get_pop_datahub() orig_data_aggregate = build_data_aggr(orig_data, pop_data) - n = 1000; w = 7 - data_filtered <- #reactive({ - orig_data_aggregate %>% - rescale_df_contagion(n = n, w = w) - # }) - callModule(mod_compare_nth_cases_plot_server, "plot_compare_nth", data_filtered) + nn = 1000; w = 7 + # data_filtered <- #reactive({ + # orig_data_aggregate %>% + # rescale_df_contagion(n = n, w = w) + # # }) + callModule(mod_compare_nth_cases_plot_server, "plot_compare_nth", orig_data_aggregate, nn = nn) } runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE) } @@ -67,7 +67,7 @@ if (interactive()) { filter(Country.Region %in% countries) #}) callModule(mod_compare_nth_cases_plot_server, "lines_points_plots", countries_data, - n = n, n_highligth = length(countries), istop = F) + nn = n, n_highligth = length(countries), istop = FALSE) } runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE) } @@ -102,7 +102,7 @@ if (interactive()) { filter(Country.Region %in% countries) callModule(mod_compare_nth_cases_plot_server, "lines_points_plots", countries_data, - n = n, n_highligth = length(countries), istop = F) + nn = n, n_highligth = length(countries), istop = FALSE) } runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE) } diff --git a/man-roxygen/ex-one_continent.R b/man-roxygen/ex-one_continent.R index 0b294ba7..9c368a77 100644 --- a/man-roxygen/ex-one_continent.R +++ b/man-roxygen/ex-one_continent.R @@ -48,7 +48,7 @@ if (interactive()) { # }) callModule(mod_continent_server, "cont_comparison", orig_data_aggregate = orig_data_aggregate, - countries_data_map, n = n, w = w, pop_data, cont = cont, uicont = uicont) + countries_data_map, nn = n, w = w, pop_data, cont = cont, uicont = uicont) } runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE) } diff --git a/man-roxygen/ex-plot_log_linear.R b/man-roxygen/ex-plot_log_linear.R index 6d3c0016..60e94a1f 100644 --- a/man-roxygen/ex-plot_log_linear.R +++ b/man-roxygen/ex-plot_log_linear.R @@ -121,7 +121,7 @@ if (interactive()) { df_area = purrr::map(unique(country_data$Country.Region), function(un) { - dat = tsdata_areplot(country_data[country_data$Country.Region == un, ], levs, 10) #n = 0 for area plot + dat = tsdata_areplot(country_data[country_data$Country.Region == un, ], levs, nn = 10) #n = 0 for area plot dat$Country.Region = rep(un, nrow(dat)) dat }) diff --git a/man/from_contagion_day_bar_facet_plot.Rd b/man/from_contagion_day_bar_facet_plot.Rd index 304ef506..f18757aa 100644 --- a/man/from_contagion_day_bar_facet_plot.Rd +++ b/man/from_contagion_day_bar_facet_plot.Rd @@ -4,10 +4,12 @@ \alias{from_contagion_day_bar_facet_plot} \title{Evolution from contagion day facet} \usage{ -from_contagion_day_bar_facet_plot(df) +from_contagion_day_bar_facet_plot(df, xdate = "date") } \arguments{ \item{df}{data.frame to plot} + +\item{xdate}{character variable for x axis} } \value{ barplot facet diff --git a/man/plot_all_highlight.Rd b/man/plot_all_highlight.Rd index de22793e..8a098666 100644 --- a/man/plot_all_highlight.Rd +++ b/man/plot_all_highlight.Rd @@ -9,8 +9,8 @@ plot_all_highlight( log = FALSE, text = "", n_highligth = 10, - percent = F, - date_x = F, + percent = FALSE, + date_x = FALSE, g_palette = graph_palette ) } diff --git a/man/rate_vars.Rd b/man/rate_vars.Rd index a38d3913..b69066f4 100644 --- a/man/rate_vars.Rd +++ b/man/rate_vars.Rd @@ -5,7 +5,7 @@ \alias{rate_vars} \title{Variables defined as rate in map plot} \format{ -An object of class \code{character} of length 1. +An object of class \code{character} of length 3. } \usage{ rate_vars diff --git a/man/reexports.Rd b/man/reexports.Rd index e534dbe5..bd44fd4a 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -11,6 +11,6 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{dplyr}{\code{\link[dplyr]{\%>\%}}} + \item{dplyr}{\code{\link[dplyr:reexports]{\%>\%}}} }} diff --git a/man/tsdata_areplot.Rd b/man/tsdata_areplot.Rd index 2f40f6bd..3cf04876 100644 --- a/man/tsdata_areplot.Rd +++ b/man/tsdata_areplot.Rd @@ -4,14 +4,14 @@ \alias{tsdata_areplot} \title{creates time series for the area plot} \usage{ -tsdata_areplot(data, levs, n = 1000) +tsdata_areplot(data, levs, nn = 1000) } \arguments{ \item{data}{data.frame aggregated data per region} \item{levs}{order of statuses} -\item{n}{minimum number of cases for the start date} +\item{nn}{minimum number of cases for the start date} } \value{ data.frame reshaped @@ -20,5 +20,5 @@ data.frame reshaped creates time series for the area plot } \note{ -starting date based on n, first day with so many confirmed +starting date based on nn, first day with so many confirmed cases } From ff6d757fe3bd2ec8c72a27cc6a6a64e1175e87b9 Mon Sep 17 00:00:00 2001 From: Guido Maggio Date: Sat, 24 Oct 2020 19:21:23 +0200 Subject: [PATCH 03/11] deprecated old test --- tests/testthat/test-get-data.R | 363 +++++++++++++++++---------------- 1 file changed, 183 insertions(+), 180 deletions(-) diff --git a/tests/testthat/test-get-data.R b/tests/testthat/test-get-data.R index 206c0ad7..cf1cad82 100644 --- a/tests/testthat/test-get-data.R +++ b/tests/testthat/test-get-data.R @@ -1,217 +1,220 @@ context("get data tests") -test_that("get_timeseries_data returns expected headers", { - data <- get_timeseries_data() - expect_equal(names(data), c("confirmed", "deaths", "recovered")) - sapply(names(data), function(i){ - expect_true(all(c("Province.State", "Country.Region", "Lat", "Long") %in% names(data[[i]]))) +if (F) { + test_that("get_timeseries_data returns expected headers", { + data <- get_timeseries_data() + expect_equal(names(data), c("confirmed", "deaths", "recovered")) + sapply(names(data), function(i){ + expect_true(all(c("Province.State", "Country.Region", "Lat", "Long") %in% names(data[[i]]))) + }) + sapply(c("confirmed", "deaths", "recovered"), function(i) { + expect_true(all(c("Province.State", "Country.Region", "Lat", "Long") %in% names(get_timeseries_single_data(i)))) + }) }) - sapply(c("confirmed", "deaths", "recovered"), function(i) { - expect_true(all(c("Province.State", "Country.Region", "Lat", "Long") %in% names(get_timeseries_single_data(i)))) + # commented out because not used + # test_that("get_daily_data returns expected headers", { + # data <- get_daily_data('01-22-2020') + # expect_equal(sort(names(data)), sort(c("Province.State", "Country.Region", "Last.Update", "Confirmed", "Deaths", "Recovered" ))) + # }) + + data_full <- get_timeseries_full_data() + + test_that("get_timeseries_full_data returns expected headers", { + expect_equal(sort(names(data_full)), sort(c("Province.State", "Country.Region", "Lat", "Long", "date", "confirmed", "deaths", "recovered", "active"))) + expect_equal(class(data_full$date),"Date") + }) + + data <- get_timeseries_by_contagion_day_data(data_full) + + test_that("get_timeseries_by_contagion_day_data returns expected headers", { + varnames = c("confirmed", "deaths", "recovered", "active","tests","hosp") + expect_equal(sort(names(data)), sort(c("Province.State", "Country.Region", "Lat", "Long", "date",varnames , + paste0("new_",varnames), "contagion_day"))) + expect_equal(class(data$contagion_day),"numeric") + expect_false(any(is.na(data$contagion_day))) + }) + + test_that("get_timeseries_global_data returns expected headers", { + df <- get_timeseries_global_data(data) + expect_equal(sort(names(df)), sort(c("date", setdiff(get_aggrvars(), c("population",grep("new",get_aggrvars(), value = TRUE)))))) + }) + + test_that("get_timeseries_country_data returns expected headers", { + df <- get_timeseries_country_data(data, "Italy") + expect_equal(sort(names(df)), sort(c("date", "confirmed", "deaths", "recovered", "active", "new_confirmed", "new_deaths", "new_active", "new_recovered", "contagion_day"))) }) -}) -# commented out because not used -# test_that("get_daily_data returns expected headers", { -# data <- get_daily_data('01-22-2020') -# expect_equal(sort(names(data)), sort(c("Province.State", "Country.Region", "Last.Update", "Confirmed", "Deaths", "Recovered" ))) -# }) -data_full <- get_timeseries_full_data() + test_that("get_timeseries_province_data returns expected headers", { + df <- get_timeseries_province_data(data, "Alaska") + expect_equal(sort(names(df)), sort(c("date", "confirmed", "deaths", "recovered", "active","new_confirmed", "new_deaths", "new_active", "new_recovered", "contagion_day"))) + }) + + test_that("get_date_data returns expected headers", { + df <- get_date_data(data, as.Date("2020-01-30")) + expect_equal(sort(names(df)), sort(c("date", "confirmed", "deaths", "recovered", "active","new_confirmed", "new_deaths", "new_active", "new_recovered", "contagion_day"))) + }) + + test_that("aggregate_country_data returns expected headers", { + df <- aggregate_country_data(data) + expect_equal(sort(names(df)), sort(c("Country.Region", "confirmed", "deaths", "recovered", "active","new_confirmed", "new_deaths", "new_active", "new_recovered", "contagion_day"))) + }) -test_that("get_timeseries_full_data returns expected headers", { - expect_equal(sort(names(data_full)), sort(c("Province.State", "Country.Region", "Lat", "Long", "date", "confirmed", "deaths", "recovered", "active"))) - expect_equal(class(data_full$date),"Date") -}) + test_that("aggregate_province_timeseries_data returns expected headers", { + df <- aggregate_province_timeseries_data(data) + expect_equal(sort(names(df)), sort(c("Country.Region", "date", "confirmed", "deaths", "recovered", "active","new_confirmed", "new_deaths", "new_active", "new_recovered", "contagion_day"))) + }) + + + test_that("add_growth_death_rate returns expected headers", { + df <- aggregate_province_timeseries_data(data) %>% add_growth_death_rate() + expect_true(all(c("growth_factor_3", "growth_factor_14", "growth_factor_7", "lethality_rate") %in% names(df))) + }) -data <- get_timeseries_by_contagion_day_data(data_full) -test_that("get_timeseries_by_contagion_day_data returns expected headers", { - varnames = c("confirmed", "deaths", "recovered", "active","tests","hosp") - expect_equal(sort(names(data)), sort(c("Province.State", "Country.Region", "Lat", "Long", "date",varnames , - paste0("new_",varnames), "contagion_day"))) - expect_equal(class(data$contagion_day),"numeric") - expect_false(any(is.na(data$contagion_day))) -}) -test_that("get_timeseries_global_data returns expected headers", { - df <- get_timeseries_global_data(data) - expect_equal(sort(names(df)), sort(c("date", setdiff(get_aggrvars(), c("population",grep("new",get_aggrvars(), value = TRUE)))))) -}) + pop_data = get_pop_data() + na.pop.data = sum(is.na(pop_data$continent)) + # test pop map data + mapdata = load_countries_data_map() -test_that("get_timeseries_country_data returns expected headers", { - df <- get_timeseries_country_data(data, "Italy") - expect_equal(sort(names(df)), sort(c("date", "confirmed", "deaths", "recovered", "active", "new_confirmed", "new_deaths", "new_active", "new_recovered", "contagion_day"))) -}) + test_that("get_pop_data returns expected rows", { -test_that("get_timeseries_province_data returns expected headers", { - df <- get_timeseries_province_data(data, "Alaska") - expect_equal(sort(names(df)), sort(c("date", "confirmed", "deaths", "recovered", "active","new_confirmed", "new_deaths", "new_active", "new_recovered", "contagion_day"))) -}) + orig_data_aggregate = aggregate_province_timeseries_data(data) %>% + arrange(Country.Region) -test_that("get_date_data returns expected headers", { - df <- get_date_data(data, as.Date("2020-01-30")) - expect_equal(sort(names(df)), sort(c("date", "confirmed", "deaths", "recovered", "active","new_confirmed", "new_deaths", "new_active", "new_recovered", "contagion_day"))) -}) + dups = duplicated(orig_data_aggregate[, c("Country.Region", "date")]) -test_that("aggregate_country_data returns expected headers", { - df <- aggregate_country_data(data) - expect_equal(sort(names(df)), sort(c("Country.Region", "confirmed", "deaths", "recovered", "active","new_confirmed", "new_deaths", "new_active", "new_recovered", "contagion_day"))) -}) + expect_true(sum(dups) == 0) # no duplicates -test_that("aggregate_province_timeseries_data returns expected headers", { - df <- aggregate_province_timeseries_data(data) - expect_equal(sort(names(df)), sort(c("Country.Region", "date", "confirmed", "deaths", "recovered", "active","new_confirmed", "new_deaths", "new_active", "new_recovered", "contagion_day"))) -}) + dups = duplicated(pop_data[, c("Country.Region")]) + expect_true(sum(dups) == 0) # no duplicates -test_that("add_growth_death_rate returns expected headers", { - df <- aggregate_province_timeseries_data(data) %>% add_growth_death_rate() - expect_true(all(c("growth_factor_3", "growth_factor_14", "growth_factor_7", "lethality_rate") %in% names(df))) -}) + pop_not_in_data = setdiff(pop_data$Country.Region, orig_data_aggregate$Country.Region) + # pop_data %>% filter(Country.Region %in% pop_not_in_data) + # merge with population + df2 = orig_data_aggregate %>% + merge_pop_data(pop_data) + dups = duplicated(df2[, c("Country.Region", "date")]) -pop_data = get_pop_data() -na.pop.data = sum(is.na(pop_data$continent)) -# test pop map data -mapdata = load_countries_data_map() + expect_true(sum(dups) == 0) # no missing pop -test_that("get_pop_data returns expected rows", { + # countries with NAs population + missingpop = unique(df2$Country.Region[is.na(df2$population)]) - orig_data_aggregate = aggregate_province_timeseries_data(data) %>% - arrange(Country.Region) + expect_true(length(missingpop) <= 3, label = paste("Missing population var in data <= 3 fails, value: ", length(missingpop))) # 2 countries do not match population data + # countries with 0 population + zeropop = unique(df2$Country.Region[!is.na(df2$population) & df2$population == 0]) - dups = duplicated(orig_data_aggregate[, c("Country.Region", "date")]) + expect_true(length(zeropop) == 0) # no zero pop - expect_true(sum(dups) == 0) # no duplicates + countrynames= unique(orig_data_aggregate$Country.Region) - dups = duplicated(pop_data[, c("Country.Region")]) + countrynames2= unique(df2$Country.Region) - expect_true(sum(dups) == 0) # no duplicates + expect_true(identical(countrynames, countrynames2)) - pop_not_in_data = setdiff(pop_data$Country.Region, orig_data_aggregate$Country.Region) - # pop_data %>% filter(Country.Region %in% pop_not_in_data) + # diffdf= orig_data_aggregate %>% filter(Country.Region %in% setdiff(countrynames, countrynames2) & + # date == max(date)) + # + # expect_true(all(diffdf$confirmed <1000)) + # expect_true(all(!is.na(df2$Country.Region))) # no nas + # expect_true(all(!is.na(df2$population))) # no nas - # merge with population - df2 = orig_data_aggregate %>% - merge_pop_data(pop_data) + na.cont= df2 %>% filter(is.na(continent) & + date == max(date)) + na.subcont= df2 %>% filter(is.na(subcontinent) & + date == max(date)) - dups = duplicated(df2[, c("Country.Region", "date")]) + expect_true(all(na.cont$confirmed < 1000)) + expect_true(all(na.subcont$confirmed < 1000)) - expect_true(sum(dups) == 0) # no missing pop + # expect_true(nrow(na.cont) == 0) + # expect_true(nrow(na.subcont) == 0) - # countries with NAs population - missingpop = unique(df2$Country.Region[is.na(df2$population)]) - expect_true(length(missingpop) <= 3, label = paste("Missing population var in data <= 3 fails, value: ", length(missingpop))) # 2 countries do not match population data - # countries with 0 population - zeropop = unique(df2$Country.Region[!is.na(df2$population) & df2$population == 0]) + # check differences with other data + setdiff(mapdata$NAME, pop_data$Country.Region) + setdiff(pop_data$Country.Region, mapdata$NAME) - expect_true(length(zeropop) == 0) # no zero pop - countrynames= unique(orig_data_aggregate$Country.Region) + .align_map_pop <- function(map,pop) { + tmp = map@data[,c("NAME","CONTINENT")] %>% + merge(pop[,c("Country.Region","continent")], by.x = "NAME", by.y = "Country.Region", all.x = T, sort = FALSE, incomparables = NA) + tmp = tmp[match(map@data$NAME,tmp$NAME),] + tmp2 = pop[,c("Country.Region","continent")] %>% + merge(map@data[,c("NAME","CONTINENT")], by.x = "Country.Region", by.y = "NAME", all.x = T, sort = FALSE, incomparables = NA) + tmp2 = tmp2[match(pop$continent,tmp2$continent),] - countrynames2= unique(df2$Country.Region) + map@data$CONTINENT[!is.na(tmp$continent)] = tmp$continent[!is.na(tmp$continent)] + pop$continent[is.na(pop$continent)] = as.character(tmp2$CONTINENT[is.na(pop$continent)]) - expect_true(identical(countrynames, countrynames2)) + list(map = map, pop = pop) + } + res = .align_map_pop(mapdata, pop_data) + pop_data = res$pop + mapdata = res$map - # diffdf= orig_data_aggregate %>% filter(Country.Region %in% setdiff(countrynames, countrynames2) & - # date == max(date)) + setdiff(mapdata$NAME, pop_data$Country.Region) + setdiff(pop_data$Country.Region, mapdata$NAME) + + expect_true(sum(is.na(pop_data$continent)) <= na.pop.data ) + + + }) + + # test_that("aggr_to_cont works correctly", { + # + # orig_data_aggregate = aggregate_province_timeseries_data(data) %>% + # arrange(Country.Region) + # df = orig_data_aggregate %>% + # merge_pop_data(pop_data) + # + # # select all variables + # statuses <- c("confirmed", "deaths", "recovered", "active","tests", "hosp") + # allstatuses = c(statuses, paste0("new_", statuses), "population") + # + # data_conts = aggr_to_cont(df, group = "continent", time = "date", allstatuses)#, popdata = pop_data) + # + # dups = duplicated(data_conts[, c("Country.Region", "date")]) # - # expect_true(all(diffdf$confirmed <1000)) - # expect_true(all(!is.na(df2$Country.Region))) # no nas - # expect_true(all(!is.na(df2$population))) # no nas - - na.cont= df2 %>% filter(is.na(continent) & - date == max(date)) - na.subcont= df2 %>% filter(is.na(subcontinent) & - date == max(date)) - - expect_true(all(na.cont$confirmed < 1000)) - expect_true(all(na.subcont$confirmed < 1000)) - - # expect_true(nrow(na.cont) == 0) - # expect_true(nrow(na.subcont) == 0) - - - # check differences with other data - setdiff(mapdata$NAME, pop_data$Country.Region) - setdiff(pop_data$Country.Region, mapdata$NAME) - - - .align_map_pop <- function(map,pop) { - tmp = map@data[,c("NAME","CONTINENT")] %>% - merge(pop[,c("Country.Region","continent")], by.x = "NAME", by.y = "Country.Region", all.x = T, sort = FALSE, incomparables = NA) - tmp = tmp[match(map@data$NAME,tmp$NAME),] - tmp2 = pop[,c("Country.Region","continent")] %>% - merge(map@data[,c("NAME","CONTINENT")], by.x = "Country.Region", by.y = "NAME", all.x = T, sort = FALSE, incomparables = NA) - tmp2 = tmp2[match(pop$continent,tmp2$continent),] - - map@data$CONTINENT[!is.na(tmp$continent)] = tmp$continent[!is.na(tmp$continent)] - pop$continent[is.na(pop$continent)] = as.character(tmp2$CONTINENT[is.na(pop$continent)]) - - list(map = map, pop = pop) - } - res = .align_map_pop(mapdata, pop_data) - pop_data = res$pop - mapdata = res$map - - setdiff(mapdata$NAME, pop_data$Country.Region) - setdiff(pop_data$Country.Region, mapdata$NAME) - - expect_true(sum(is.na(pop_data$continent)) <= na.pop.data ) - - -}) - -# test_that("aggr_to_cont works correctly", { -# -# orig_data_aggregate = aggregate_province_timeseries_data(data) %>% -# arrange(Country.Region) -# df = orig_data_aggregate %>% -# merge_pop_data(pop_data) -# -# # select all variables -# statuses <- c("confirmed", "deaths", "recovered", "active","tests", "hosp") -# allstatuses = c(statuses, paste0("new_", statuses), "population") -# -# data_conts = aggr_to_cont(df, group = "continent", time = "date", allstatuses)#, popdata = pop_data) -# -# dups = duplicated(data_conts[, c("Country.Region", "date")]) -# -# expect_true(sum(dups) == 0) # no duplicates -# # matching population -# cont_pop_data = pop_data %>% filter(!is.na(continent)) %>% -# group_by(continent) %>% -# summarize(population = sum(population, na.rm = T)) -# -# # popcont = tapply(data_conts$population, -# # data_conts$Country.Region, unique) -# # cont_pop = cont_pop_data$population -# # names(cont_pop) = cont_pop_data$continent -# # cont_pop = as.array(cont_pop[dimnames(popcont)[[1]]]) -# # expect_equal(popcont, -# # cont_pop) -# -# europe_pop_data = pop_data %>% filter(!is.na(continent) & continent %in% "Europe") %>% -# group_by(subcontinent) %>% -# summarize(population = sum(population, na.rm = T)) -# -# df_europe = df %>% -# filter(continent == "Europe") -# -# data_subcont = aggr_to_cont(df_europe, group = "subcontinent", time = "date", allstatuses)#, popdata = europe_pop_data) -# -# dups = duplicated(data_subcont[, c("Country.Region", "date")]) -# -# expect_true(sum(dups) == 0) # no duplicates -# # matching population -# # popsubcont = tapply(data_subcont$population, -# # data_subcont$Country.Region, unique) -# # eur_pop = europe_pop_data$population -# # names(eur_pop) = europe_pop_data$subcontinent -# # eur_pop = as.array(eur_pop[dimnames(popsubcont)[[1]]]) -# # expect_equal(popsubcont, -# # eur_pop) -# -# }) + # expect_true(sum(dups) == 0) # no duplicates + # # matching population + # cont_pop_data = pop_data %>% filter(!is.na(continent)) %>% + # group_by(continent) %>% + # summarize(population = sum(population, na.rm = T)) + # + # # popcont = tapply(data_conts$population, + # # data_conts$Country.Region, unique) + # # cont_pop = cont_pop_data$population + # # names(cont_pop) = cont_pop_data$continent + # # cont_pop = as.array(cont_pop[dimnames(popcont)[[1]]]) + # # expect_equal(popcont, + # # cont_pop) + # + # europe_pop_data = pop_data %>% filter(!is.na(continent) & continent %in% "Europe") %>% + # group_by(subcontinent) %>% + # summarize(population = sum(population, na.rm = T)) + # + # df_europe = df %>% + # filter(continent == "Europe") + # + # data_subcont = aggr_to_cont(df_europe, group = "subcontinent", time = "date", allstatuses)#, popdata = europe_pop_data) + # + # dups = duplicated(data_subcont[, c("Country.Region", "date")]) + # + # expect_true(sum(dups) == 0) # no duplicates + # # matching population + # # popsubcont = tapply(data_subcont$population, + # # data_subcont$Country.Region, unique) + # # eur_pop = europe_pop_data$population + # # names(eur_pop) = europe_pop_data$subcontinent + # # eur_pop = as.array(eur_pop[dimnames(popsubcont)[[1]]]) + # # expect_equal(popsubcont, + # # eur_pop) + # + # }) + +} From 3aaac9dcb8fb6e78cc8edece90ccad8a9203ff83 Mon Sep 17 00:00:00 2001 From: Guido Maggio Date: Sun, 25 Oct 2020 11:02:49 +0100 Subject: [PATCH 04/11] Added maps with tests figures --- NEWS.md | 2 +- R/mod_continent.R | 22 ++++++++++++++++ R/mod_map_calc_continent.R | 39 ++++++++++++++++++++++++----- R/utils.R | 2 +- man-roxygen/ex-map_continent.calc.R | 9 ++++--- 5 files changed, 63 insertions(+), 11 deletions(-) diff --git a/NEWS.md b/NEWS.md index 79a6417b..a4533ace 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ ### Covid19Mirai 2.2.1-9000 (develop) - Removed contagion day in x axis, replaced with dates (#126) - +- 2 maps added in continent page: tests per 1M, Positive test rates (#127) ### Covid19Mirai 2.2.0 (2020-09-04) - Added Switzerland tab with maps at Kanton level (#20) diff --git a/R/mod_continent.R b/R/mod_continent.R index 0d75b3be..bddfcff1 100644 --- a/R/mod_continent.R +++ b/R/mod_continent.R @@ -75,6 +75,14 @@ mod_continent_ui <- function(id, uicont){ column(6, withSpinner(uiOutput(ns(paste("map_countries_death", uicont , sep = "_")))) ) + ), + fluidRow( + column(6, + withSpinner(uiOutput(ns(paste("map_countries_tests_1M", uicont , sep = "_")))) + ), + column(6, + withSpinner(uiOutput(ns(paste("map_countries_positive_rate", uicont , sep = "_")))) + ) ), mod_add_table_ui(ns(paste("add_table_cont", uicont , sep = "_"))), hr(), @@ -269,6 +277,20 @@ mod_continent_server <- function(input, output, session, orig_data_aggregate, co callModule(mod_map_area_calc_server, "map_countries_death", df = data_cont_maps, countries_data_map_cont, area = cont, variable = "death") + #maps tests + output[[paste("map_countries_tests_1M", uicont , sep = "_")]] <- renderUI({ + mod_map_area_calc_ui(ns("map_countries_tests_1M")) + }) + callModule(mod_map_area_calc_server, "map_countries_tests_1M", df = data_cont_maps, countries_data_map_cont, + area = cont, variable = "tests over 1M") + + #maps positive test rates + output[[paste("map_countries_positive_rate", uicont , sep = "_")]] <- renderUI({ + mod_map_area_calc_ui(ns("map_countries_positive_rate")) + }) + callModule(mod_map_area_calc_server, "map_countries_positive_rate", df = data_cont_maps, countries_data_map_cont, + area = cont, variable = "positive tests rate") + # tables ---- callModule(mod_add_table_server, paste("add_table_cont", uicont , sep = "_"), subcontinent_data_filtered, maxrowsperpage = 10) diff --git a/R/mod_map_calc_continent.R b/R/mod_map_calc_continent.R index b2efcf9d..4aba9798 100644 --- a/R/mod_map_calc_continent.R +++ b/R/mod_map_calc_continent.R @@ -219,10 +219,9 @@ varsNames = function(vars) { paste("growth_factor", c(3,7,14), sep = "_"), "lethality_rate", "mortality_rate_1M_pop", "prevalence_rate_1M_pop", "lw_prevalence_rate_1M_pop", "new_prevalence_rate_1M_pop", - "tests_rate_1M_pop","positive_tests_rate", "new_tests_rate_1M_pop","new_positive_tests_rate", - "lw_tests_rate_1M_pop","lw_positive_tests_rate", + "tests_rate_1M_pop","positive_tests_rate","lw_tests_rate_1M_pop", "new_tests_rate_1M_pop","lw_positive_tests_rate","new_positive_tests_rate", "population", paste("growth_vs_prev", c(3,7,14), sep = "_"), - "tests","new_tests") + "tests","lw_tests", "new_tests") allvars = allvars %>% setNames(gsub("_", " ", allvars)) names(allvars) = sapply(gsub("1M pop", "1M people", names(allvars)), capitalize_first_letter) @@ -329,7 +328,31 @@ update_radio<- function(var, growthvar = 7){ caption <- "Total, Last Week and New Confirmed cases" graph_title = "Confirmed cases" textvar = c("growth_factor_3", "active", "tests") - } else { + } else if (grepl("tests", var) && grepl("1M", var)) { + mapvar = grep("tests_rate_1M_pop", varsNames(), value = T) + names(mapvar) = c("Total", "Last Week", + "Last Day") + new_buttons = list(name = "radio", + choices = mapvar, selected = mapvar["Last Week"]) + caption <- "Total, Last Week and New Tests per 1 Million people" + caption_tests <- "Updated Tests figures are unavailable for some countries" + caption =HTML(paste(c(caption,caption_tests), collapse = '
')) + + graph_title = "Tests per population" + textvar = c("tests","lw_tests", "population", "positive_tests_rate", "lw_positive_tests_rate") + } else if (grepl("positive", var)) { + mapvar = grep("positive_tests_rate", varsNames(), value = T) + names(mapvar) = c("Total", "Last Week", + "Last Day") + new_buttons = list(name = "radio", + choices = mapvar, selected = mapvar["Last Week"]) + caption <- "Total, Last Week and New % of positive tests." + caption_tests <- "Updated Tests figures are unavailable for some countries" + caption =HTML(paste(c(caption,caption_tests), collapse = '
')) + + graph_title = "Positive Tests rate" + textvar = c("tests","lw_tests", "confirmed", "lw_confirmed", "prevalence_rate_1M_pop", "lw_prevalence_rate_1M_pop") + } else { new_buttons = NULL caption = NULL } @@ -568,9 +591,13 @@ pal_fun = function(var,x){ } else if (grepl("recovered", var)) { colorNumeric(palette = "Greens", domain = domain(x), na.color = "lightgray") - } else if ((grepl("growth",var) && grepl("fact",var))) { + } else if (grepl("growth",var) && grepl("fact",var)) { colorNumeric(palette = "Oranges", domain = domain(x), na.color = "lightgray") - } else if ((grepl("growth",var) && grepl("prev",var))) { + } else if (grepl("tests", var) && grepl("1M", var)) { + colorNumeric(palette = "Purples", domain = domain(x), na.color = "lightgray") + } else if (grepl("positive", var)) { + colorNumeric(palette = "GnBu", domain = domain(x), na.color = "lightgray") + } else if ((grepl("growth",var) && grepl("prev",var))) { colorFactor(palette = c("darkgreen", "#E69F00", "yellow3","#dd4b39"), domain = domain(x), ordered = TRUE, na.color = "lightgray") } else diff --git a/R/utils.R b/R/utils.R index 58e72da2..db905951 100644 --- a/R/utils.R +++ b/R/utils.R @@ -515,7 +515,7 @@ gen_text = function(x, namvar) { } #' Variables defined as rate in map plot rate_vars <- c( - c("lethality_rate", "new_positive_tests_rate","positive_tests_rate") + c("lethality_rate", "lw_positive_tests_rate", "new_positive_tests_rate","positive_tests_rate") ) #' Variables where negative values are allowed in map plot neg_vars <- c( diff --git a/man-roxygen/ex-map_continent.calc.R b/man-roxygen/ex-map_continent.calc.R index a1b250bf..af3ec296 100644 --- a/man-roxygen/ex-map_continent.calc.R +++ b/man-roxygen/ex-map_continent.calc.R @@ -16,11 +16,14 @@ if (interactive()) { variable = "growth vs prevalence" # set variable #variable = "death rate" # set variable #variable = "prevalence rate" # set variable - variable = "active" # set variable + #variable = "tests_rate_1M_pop" # set variable + variable = "tests over 1M" # set variable + variable = "positive tests rate" # set variable + #variable = "growth factor" # set variable #variable = "confirmed" # set variable - #sapply(file.path("R",list.files("R")), source) + sapply(file.path("R",list.files("R")), source) #pkgload::load_all(export_all = FALSE,helpers = FALSE,attach_testthat = FALSE) long_title <- "Lorem ipsum dolor sit amet, consectetur adipisicing elit." @@ -63,7 +66,7 @@ if (interactive()) { countries_data_map_cont = .subsetmap(countries_data_map, cc = cont) callModule(mod_map_area_calc_server, "map_cont_calc_ui", df = data_cont_maps, - countries_data_map_cont, cont = cont, variable = variable) + countries_data_map_cont, variable = variable, area = cont) } runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE) } From 2d3bb2f60e8ffa80d9843395fd4599bbe61812e4 Mon Sep 17 00:00:00 2001 From: Guido Maggio Date: Sun, 25 Oct 2020 20:31:46 +0100 Subject: [PATCH 05/11] Updated global map --- NEWS.md | 2 + R/mod_global.R | 8 +- R/mod_map.R | 149 +++++++++++++++++++++---------------- R/mod_map_calc_continent.R | 40 +++++++--- man-roxygen/ex-mod_map.R | 14 +++- man/map_popup_data.Rd | 2 +- man/rate_vars.Rd | 2 +- man/update_radio.Rd | 4 +- 8 files changed, 138 insertions(+), 83 deletions(-) diff --git a/NEWS.md b/NEWS.md index a4533ace..f29a5321 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,8 @@ ### Covid19Mirai 2.2.1-9000 (develop) - Removed contagion day in x axis, replaced with dates (#126) - 2 maps added in continent page: tests per 1M, Positive test rates (#127) +- Enhanced global map in first page (#55) + ### Covid19Mirai 2.2.0 (2020-09-04) - Added Switzerland tab with maps at Kanton level (#20) diff --git a/R/mod_global.R b/R/mod_global.R index a869686a..6b5cece5 100644 --- a/R/mod_global.R +++ b/R/mod_global.R @@ -118,7 +118,13 @@ mod_global_server <- function(input, output, session, orig_data_aggregate, data_ # Boxes ---- callModule(mod_caseBoxes_server, "count-boxes", total_today) - # map ---- + # # map ---- + # data7_orig_data_aggregate = lw_vars_calc(orig_data_aggregate) + # + # # create datasets for maps merging today with data7 + # orig_data_aggregate_maps = orig_data_aggregate %>% filter(date == max(date)) %>% + # left_join(data7_orig_data_aggregate %>% select(-population)) + callModule(mod_map_server, "map_ui", orig_data_aggregate, countries_data_map) diff --git a/R/mod_map.R b/R/mod_map.R index fb13114c..1714449f 100644 --- a/R/mod_map.R +++ b/R/mod_map.R @@ -11,21 +11,37 @@ #' @importFrom shinycssloaders withSpinner mod_map_ui <- function(id){ ns <- NS(id) - vars = setdiff(names(case_colors), "hosp") # remove hosp for now + vars = setdiff(names(case_colors), c("hosp","recovered")) # remove hosp for now choices_map <- c(vars, "new_confirmed", "new_active","new_deaths") %>% setNames(gsub("_", " ",c(vars, "new_confirmed", "new_active", "new_deaths"))) %>% as.list() div( + #fluidPage( + style = "position: relative;", # Height needs to be in pixels. Ref https://stackoverflow.com/questions/39085719/shiny-leaflet-map-not-rendering withSpinner(leafletOutput(ns("map"), width = "100%", height = "800")), + tags$head(tags$style( + HTML(' + #input_date_control {background-color: rgba(192,192,192,0.6);;} + #sel_date {background-color: rgba(0,0,255,1);} + #help-block a {color: #ff0000 !important;}' + ) + )), absolutePanel( - id = ns("input_date_control"), class = "panel panel-default", - top = 10, left = 10, draggable = F, + #id = ns("input_date_control"), class = "panel panel-default", + id = "input_date_control", class = "panel panel-default", + width = "27.5vw", + #height = "20vh", + top = 10, left = 10, draggable = FALSE, + #fixed = TRUE, div(style = "margin:10px;", + uiOutput(ns("title_map")), radioButtons(inputId = ns("radio_choices"), label = "", choices = choices_map, selected = "confirmed", inline = T), radioButtons(inputId = ns("radio_pop"), label = "", choices = c("total", "per 1M pop"), selected = "total", inline = T), uiOutput(ns("slider_ui")), - helpText("Click on the country to obtain its details.") + helpText("Click on the country to obtain its details."), + div(uiOutput(ns("caption")), align = "center") + ) ) @@ -48,20 +64,16 @@ mod_map_server <- function(input, output, session, orig_data_aggregate, countrie # Data ---- #load data - #countries_data <- load_countries_data(destpath = system.file("./countries_data", package = "Covid19")) - #data_clean <- reactive({ - data <- orig_data_aggregate #%>% align_country_names() + #data <- orig_data_aggregate #%>% align_country_names() - orig_data_aggregate$country_name <- as.character(unique(as.character(countries_data_map$NAME))[charmatch(orig_data_aggregate$Country.Region, unique(as.character(countries_data_map$NAME)))]) + orig_data_aggregate$country_name <- as.character(unique(as.character(countries_data_map$NAME))[charmatch(orig_data_aggregate$Country.Region, unique(as.character(countries_data_map$NAME)))]) - data_clean <- orig_data_aggregate %>% + data_clean <- orig_data_aggregate %>% filter(!is.na(country_name)) - keepcols = c("country_name","Country.Region","date", + keepcols = c("country_name","Country.Region","date", names(data_clean)[sapply(data_clean, is.numeric)]) - data_clean = data_clean[, keepcols] # remove, not used - data_clean - #}) + data_clean = data_clean[, keepcols] # remove, not used # UI controls ---- output$slider_ui <- renderUI({ @@ -72,13 +84,15 @@ mod_map_server <- function(input, output, session, orig_data_aggregate, countrie # Data for a given date data_date <- reactive({ + maxdate = req(input$slider_day) data_date <- data_clean %>% - filter(date == req(input$slider_day)) %>% - #filter(date == max(date)) %>% + filter(date == maxdate) %>% + filter(date == max(date)) %>% select(-c(Country.Region, date, contagion_day)) %>% group_by(country_name) %>% summarise_each(sum) %>% - ungroup() + ungroup() %>% + mutate(date = maxdate) data_date }) @@ -92,51 +106,29 @@ mod_map_server <- function(input, output, session, orig_data_aggregate, countrie # percentage of indicator per 1M population mutate(indicator = round(1000000 * .$indicator / .$population)) } - data_selected <- data_selected %>% - select(country_name, indicator) + select(country_name, indicator, update_ui()$textvar) data_plot <- sp::merge(countries_data_map, data_selected, by.x = "NAME", by.y = "country_name", sort = FALSE) - - data_plot[["indicator"]] <- replace_na(data_plot[["indicator"]], 0) - #data_plot[["indicator"]] <- data_plot[["indicator"]] # could be removed but the code would have to be adjusted to handle NAs + # removed NAs can be shown + #data_plot[["indicator"]] <- replace_na(data_plot[["indicator"]], 0) data_plot }) + update_ui <- reactive(update_radio(input$radio_choices, global = TRUE)) - country_popup <- reactive({ - paste0("Country: ", - data_plot()$NAME, - "
", - "Value :", - " ", - data_plot()[["indicator"]] + if (isolate(!is.null(update_ui()$caption))) { + output$caption <- renderUI( + div(p(update_ui()$caption), align = "left", + style = "margin-top:5px; margin-bottom:5px;") ) - }) - - max_value <- reactive({ - max(data_plot()[["indicator"]]) - }) - - domain <- reactive({ - c(0,log(roundUp(max_value()))) - }) - - pal2 <- reactive({ - # colorBin(palette = c("#FFFFFFFF",rev(viridis::inferno(256))), domain = c(0,roundUp(max_value())), na.color = "#f2f5f3", bins = 20) - if (input$radio_choices == "confirmed" | input$radio_choices == "new_confirmed") { - colorNumeric(palette = "Reds", domain = domain(), na.color = "white") - } else if (input$radio_choices == "deaths" | input$radio_choices == "new_deaths") { - colorNumeric(palette = "Greys", domain = domain(), na.color = "white") - } else if (input$radio_choices == "active" | input$radio_choices == "new_active") { - colorNumeric(palette = "Blues", domain = domain(), na.color = "grey") - } else if (input$radio_choices == "recovered" | input$radio_choices == "new_recovered") { - colorNumeric(palette = "Greens", domain = domain(), na.color = "white") - } - }) + } + # add Title to output + output$title_map <- renderUI(div(h4(update_ui()$graph_title), align = "center", + style = "margin-top:10px; margin-bottom:0px;")) output$map <- renderLeaflet({ # Using leaflet() to include non dynamic aspects of the map @@ -149,37 +141,62 @@ mod_map_server <- function(input, output, session, orig_data_aggregate, countrie # # update map with reactive part observeEvent(data_plot(),{ + #browser() + + if(req(input$radio_pop) == "per 1M pop") + var1M = "per 1M pop" + else { + var1M = NULL + + } + mapdata = leafletProxy("map", data = data_plot()) %>% addPolygons(layerId = ~NAME, - fillColor = pal2()(dplyr::na_if(log(data_plot()$indicator), -Inf)), + #fillColor = pal2()(dplyr::na_if(log(data_plot()$indicator), -Inf)), + fillColor = pal_fun(input$radio_choices, data_plot()$indicator)(pal_fun_calc(data_plot()$indicator, input$radio_choices)), fillOpacity = 1, color = "#BDBDC3", group = "mapdata", label = ~NAME, weight = 1, - popup = country_popup()) + popup = map_popup_data(data_plot(), "NAME", "indicator", input$radio_choices, update_ui()$textvar, namvarsfx = var1M), + popupOptions = popupOptions(keepInView = T, autoPan = F + #autoPanPadding = c(100, 100) + #offset = c(100,0) + ) + #popup = country_popup() + ) mapdata = addSearchFeatures(mapdata, targetGroups = "mapdata", options = searchFeaturesOptions(zoom=0, openPopup=TRUE, firstTipSubmit = TRUE, position = "topright",hideMarkerOnCollapse = T, moveToLocation = FALSE)) - mapdata + #mapdata + #proxy <- leafletProxy("map", data = countries_data_map) - }) + leg_par <- legend_fun(data_plot()$indicator, input$radio_choices) + mapdata = mapdata %>% clearControls() + do.call(what = "addLegend", args = c(list(map = mapdata), leg_par, list(position = "bottomright"))) - observeEvent(data_plot(),{ - proxy <- leafletProxy("map", data = countries_data_map) - proxy %>% clearControls() %>% - addLegend(position = "bottomright", - pal = pal2(), - opacity = 1, - # values = data_plot()$indicator - bins = log(10^(seq(0,log10(roundUp(max_value())),1))), - values = log(1:roundUp(max_value())), - data = log(1:roundUp(max_value())), - labFormat = labelFormat(transform = function(x) roundUp(exp(x)), suffix = paste0(" cases ", input$radio_pop)) - ) }) + + # observeEvent(data_plot(),{ + # leg_par <- legend_fun(data_plot()$indicator, input$radio_choices) + # do.call(what = "addLegend", args = c(list(map = map), leg_par, list(position = "bottomright"))) + # + # proxy <- leafletProxy("map", data = countries_data_map) + # proxy %>% clearControls() %>% + # addLegend(position = "bottomright", + # pal = pal2(), + # opacity = 1, + # # values = data_plot()$indicator + # bins = log(10^(seq(0,log10(roundUp(max_value())),1))), + # values = log(1:roundUp(max_value())), + # data = log(1:roundUp(max_value())), + # labFormat = labelFormat(transform = function(x) roundUp(exp(x)), suffix = paste0(" cases ", input$radio_pop)) + # ) + # }) + } align_country_names <- function(data) { diff --git a/R/mod_map_calc_continent.R b/R/mod_map_calc_continent.R index 4aba9798..858d54d9 100644 --- a/R/mod_map_calc_continent.R +++ b/R/mod_map_calc_continent.R @@ -221,7 +221,7 @@ varsNames = function(vars) { "prevalence_rate_1M_pop", "lw_prevalence_rate_1M_pop", "new_prevalence_rate_1M_pop", "tests_rate_1M_pop","positive_tests_rate","lw_tests_rate_1M_pop", "new_tests_rate_1M_pop","lw_positive_tests_rate","new_positive_tests_rate", "population", paste("growth_vs_prev", c(3,7,14), sep = "_"), - "tests","lw_tests", "new_tests") + "tests","lw_tests", "new_tests", "date") allvars = allvars %>% setNames(gsub("_", " ", allvars)) names(allvars) = sapply(gsub("1M pop", "1M people", names(allvars)), capitalize_first_letter) @@ -248,13 +248,14 @@ varsNames = function(vars) { #' Updates UI radiobuttons depending to variable va #' @param var variable name #' @param growthvar integer, 3 5 7 depending on choice - +#' @param global logical, TRUE when used in global map +#' #' @return list list(new_buttons = new_buttons, graph_title = graph_title, caption = caption, textvar= textvar) #' new_buttons: UI radiobuttons #' graph_title: graph title #' caption: vaption #' textvar: variables to add in popup -update_radio<- function(var, growthvar = 7){ +update_radio<- function(var, growthvar = 7, global = FALSE){ graph_title = var textvar = NULL @@ -267,6 +268,7 @@ update_radio<- function(var, growthvar = 7){ graph_title = "Growth Factor" textvar = c("new_confirmed","lw_confirmed","confirmed","new_active") + } else if (grepl("(prevalence|rate)(?:.+)(prevalence|rate)",var)) { mapvar = grep("(prevalence|rate)(?:.+)(prevalence|rate)", varsNames(), value = T) #mapvar = varsNames()[mapvar] @@ -291,7 +293,10 @@ update_radio<- function(var, growthvar = 7){ caption =HTML(paste(c(caption_leth_rate,caption_mrt_rate), collapse = '
')) graph_title = "Death Rate" textvar = c("new_deaths", "lw_deaths", "deaths", "population") - + if(global) { + textvar = c(textvar, c("lethality_rate","mortality_rate_1M_pop")) + textvar = textvar[!grepl("deaths",textvar)] + } } else if ((grepl("growth",var) && grepl("prev",var))) { #new_buttons = NULL new_buttons = list(name = "radio", @@ -318,16 +323,22 @@ update_radio<- function(var, growthvar = 7){ caption =HTML(paste(c(caption,caption_color), collapse = '
')) graph_title = "Active cases" - textvar = c("new_confirmed", "confirmed","new_recovered","recovered") + textvar = c("new_active", "new_confirmed", "confirmed","new_recovered","recovered") + if (global) + textvar = c("lw_active",textvar) } else if (grepl("confirmed", var)) { mapvar = grep("confirmed", varsNames(), value = T) names(mapvar) = c("Total", "Last Week", "Last Day") new_buttons = list(name = "radio", choices = mapvar, selected = mapvar["Last Week"]) - caption <- "Total, Last Week and New Confirmed cases" + caption <- "Total, Last Week and New Confirmed Positive cases" graph_title = "Confirmed cases" textvar = c("growth_factor_3", "active", "tests") + if (global) { + textvar = c("lw_confirmed",textvar) + caption <- "Confirmed positive cases" + } } else if (grepl("tests", var) && grepl("1M", var)) { mapvar = grep("tests_rate_1M_pop", varsNames(), value = T) names(mapvar) = c("Total", "Last Week", @@ -356,6 +367,10 @@ update_radio<- function(var, growthvar = 7){ new_buttons = NULL caption = NULL } + if (global) { + textvar = textvar[!grepl("^lw",textvar )] + textvar = c("date",textvar) + } list(new_buttons = new_buttons, graph_title = graph_title, caption = caption, textvar= textvar) @@ -368,11 +383,14 @@ update_radio<- function(var, growthvar = 7){ #' @param namvar character: vector, additional variable names #' @param textvar character: vector, textt for the additional variables #' @return vector pop up messages, html -map_popup_data <- function(data, nam, ind, namvar, textvar){ +map_popup_data <- function(data, nam, ind, namvar, textvar, namvarsfx = NULL){ x = data[[ind]] NAME = data[[nam]] textvars = NULL varName = names(varsNames(namvar)) + if (!is.null(namvarsfx)) { + varName = paste(varName, namvarsfx) + } if (!is.null(textvar)) { textvars = list(data = as.list(data@data[c(textvar)]), NAME = names(varsNames(textvar))) @@ -585,6 +603,8 @@ pal_fun = function(var,x){ # colorRampPalette to customize and mix 2 palettes colorNumeric(palette = colorRampPalette(c("yellow", "#3c8dbc"), interpolate = "linear" )(length(x)), domain = domain(x), na.color = "lightgray") + # colorNumeric(palette = "GnBu", + # domain = domain(x), na.color = "lightgray") } else colorNumeric(palette = "Blues", domain = domain(x), na.color = "lightgray") @@ -594,11 +614,11 @@ pal_fun = function(var,x){ } else if (grepl("growth",var) && grepl("fact",var)) { colorNumeric(palette = "Oranges", domain = domain(x), na.color = "lightgray") } else if (grepl("tests", var) && grepl("1M", var)) { - colorNumeric(palette = "Purples", domain = domain(x), na.color = "lightgray") + colorNumeric(palette = "BuGn", domain = domain(x), na.color = "lightgray") } else if (grepl("positive", var)) { - colorNumeric(palette = "GnBu", domain = domain(x), na.color = "lightgray") + colorNumeric(palette = "YlOrRd", domain = domain(x), na.color = "lightgray") } else if ((grepl("growth",var) && grepl("prev",var))) { - colorFactor(palette = c("darkgreen", "#E69F00", "yellow3","#dd4b39"), domain = domain(x), ordered = TRUE, na.color = "lightgray") + colorFactor(palette = c("darkgreen", "yellow3", "#E69F00","#dd4b39"), domain = domain(x), ordered = TRUE, na.color = "lightgray") } else stop("non existing color palette for ", var) diff --git a/man-roxygen/ex-mod_map.R b/man-roxygen/ex-mod_map.R index 9cbc95dd..7de4b8db 100644 --- a/man-roxygen/ex-mod_map.R +++ b/man-roxygen/ex-mod_map.R @@ -1,14 +1,14 @@ if (interactive()) { library(shiny) library(dplyr) - #devtools::load_all() - #sapply(file.path("R",list.files("R")), source) + devtools::load_all() + sapply(file.path("R",list.files("R")), source) long_title <- "Lorem ipsum dolor sit amet, consectetur adipisicing elit." ui <- fluidPage( tagList( Covid19Mirai:::golem_add_external_resources(), - Covid19Mirai:::mod_map_ui("map_ui") + mod_map_ui("map_ui") ) ) @@ -26,6 +26,14 @@ if (interactive()) { pop_data = get_pop_datahub() orig_data_aggregate = build_data_aggr(orig_data, pop_data) + # map ---- + # data7_orig_data_aggregate = lw_vars_calc(orig_data_aggregate) + # + # # create datasets for maps merging today with data7 + # orig_data_aggregate_maps = orig_data_aggregate %>% + # left_join(data7_orig_data_aggregate %>% select(-population)) + + callModule(mod_map_server, "map_ui", orig_data_aggregate, countries_data_map) } runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE) diff --git a/man/map_popup_data.Rd b/man/map_popup_data.Rd index f8844cc0..8e938f0d 100644 --- a/man/map_popup_data.Rd +++ b/man/map_popup_data.Rd @@ -4,7 +4,7 @@ \alias{map_popup_data} \title{Utility for popup message in map} \usage{ -map_popup_data(data, nam, ind, namvar, textvar) +map_popup_data(data, nam, ind, namvar, textvar, namvarsfx = NULL) } \arguments{ \item{data}{map data} diff --git a/man/rate_vars.Rd b/man/rate_vars.Rd index b69066f4..87f495bf 100644 --- a/man/rate_vars.Rd +++ b/man/rate_vars.Rd @@ -5,7 +5,7 @@ \alias{rate_vars} \title{Variables defined as rate in map plot} \format{ -An object of class \code{character} of length 3. +An object of class \code{character} of length 4. } \usage{ rate_vars diff --git a/man/update_radio.Rd b/man/update_radio.Rd index 456528c7..3f67cbb1 100644 --- a/man/update_radio.Rd +++ b/man/update_radio.Rd @@ -4,12 +4,14 @@ \alias{update_radio} \title{Updates UI radiobuttons depending to variable va} \usage{ -update_radio(var, growthvar = 7) +update_radio(var, growthvar = 7, global = FALSE) } \arguments{ \item{var}{variable name} \item{growthvar}{integer, 3 5 7 depending on choice} + +\item{global}{logical, TRUE when used in global map} } \value{ list list(new_buttons = new_buttons, graph_title = graph_title, caption = caption, textvar= textvar) From 9002fd245442d50d8449f95b05a9626a38ead194 Mon Sep 17 00:00:00 2001 From: Guido Maggio Date: Sun, 25 Oct 2020 20:32:07 +0100 Subject: [PATCH 06/11] Swapped orange and yellow in scatterplot --- R/plots.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/plots.R b/R/plots.R index b3771396..38196678 100644 --- a/R/plots.R +++ b/R/plots.R @@ -647,10 +647,10 @@ scatter_plot <- function(df, med, x.min = c(0.875, 1.125), y.min = c(0.99,1.01)) ) # mean.x = mean(df$prevalence_rate_1M_pop) # mean.y = mean(df$growthfactor) - color_cntry = rep("#E69F00", nrow(df)) + color_cntry = rep("yellow3", nrow(df)) color_cntry[df$prevalence_rate_1M_pop < med$x & df$growthfactor < med$y ] = "darkgreen" color_cntry[df$prevalence_rate_1M_pop > med$x & df$growthfactor > med$y ] = "#dd4b39" - color_cntry[df$prevalence_rate_1M_pop < med$x & df$growthfactor > med$y ] = "yellow3" + color_cntry[df$prevalence_rate_1M_pop < med$x & df$growthfactor > med$y ] = "#E69F00" xlim = c(min(df$prevalence_rate_1M_pop,med$x)- diff(range(df$prevalence_rate_1M_pop,med$x))*(1-x.min[1]), max(df$prevalence_rate_1M_pop,med$x)*x.min[2]) From e8ebcd912aa35ec1fb4ac13cfa6ddb42dca41c8e Mon Sep 17 00:00:00 2001 From: Guido Maggio Date: Sun, 25 Oct 2020 21:49:07 +0100 Subject: [PATCH 07/11] Fixed roxygen --- R/mod_map_calc_continent.R | 4 +++- man/map_popup_data.Rd | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/R/mod_map_calc_continent.R b/R/mod_map_calc_continent.R index 858d54d9..3dfdd1c1 100644 --- a/R/mod_map_calc_continent.R +++ b/R/mod_map_calc_continent.R @@ -381,7 +381,9 @@ update_radio<- function(var, growthvar = 7, global = FALSE){ #' @param nam character: component of country names from data, NAME #' @param ind character: component of values from data, indicator #' @param namvar character: vector, additional variable names -#' @param textvar character: vector, textt for the additional variables +#' @param textvar character: vector, text for the additional variables +#' @param namvarsfx character: vector, text suffix for namevar. Default NULL: no suffix. +#' #' @return vector pop up messages, html map_popup_data <- function(data, nam, ind, namvar, textvar, namvarsfx = NULL){ x = data[[ind]] diff --git a/man/map_popup_data.Rd b/man/map_popup_data.Rd index 8e938f0d..34c8fb46 100644 --- a/man/map_popup_data.Rd +++ b/man/map_popup_data.Rd @@ -15,7 +15,9 @@ map_popup_data(data, nam, ind, namvar, textvar, namvarsfx = NULL) \item{namvar}{character: vector, additional variable names} -\item{textvar}{character: vector, textt for the additional variables} +\item{textvar}{character: vector, text for the additional variables} + +\item{namvarsfx}{character: vector, text suffix for namevar. Default NULL: no suffix.} } \value{ vector pop up messages, html From 1b1c8bd2765b696a7f4403a1cc0f40945875ae21 Mon Sep 17 00:00:00 2001 From: Guido Maggio Date: Mon, 26 Oct 2020 09:40:44 +0100 Subject: [PATCH 08/11] Updated textvar --- R/mod_map_calc_continent.R | 38 ++++++++++++++++++++++---------------- 1 file changed, 22 insertions(+), 16 deletions(-) diff --git a/R/mod_map_calc_continent.R b/R/mod_map_calc_continent.R index 3dfdd1c1..7043670b 100644 --- a/R/mod_map_calc_continent.R +++ b/R/mod_map_calc_continent.R @@ -266,8 +266,7 @@ update_radio<- function(var, growthvar = 7, global = FALSE){ caption <- caption_growth_factor_fun("(3 7 14)") graph_title = "Growth Factor" - textvar = c("new_confirmed","lw_confirmed","confirmed","new_active") - + textvar = c("new_confirmed","lw_confirmed","confirmed","lw_active") } else if (grepl("(prevalence|rate)(?:.+)(prevalence|rate)",var)) { mapvar = grep("(prevalence|rate)(?:.+)(prevalence|rate)", varsNames(), value = T) @@ -280,7 +279,8 @@ update_radio<- function(var, growthvar = 7, global = FALSE){ choices = mapvar, selected = mapvar["Last Week"]) caption <- "Prevalence: confirmed cases over 1 M people" graph_title = "Prevalence of contagion over 1M" - textvar = c("new_confirmed","lw_confirmed","confirmed","population") + textvar = c("new_confirmed","lw_confirmed","confirmed","population", "new_prevalence_rate_1M_pop", "lw_prevalence_rate_1M_pop", "prevalence_rate_1M_pop") + } else if (grepl("death", var) || grepl("mortality", var)) { #mapvar = c("Lethality Rate", "Mortality Rate") mapvar = varsNames()[grepl("Lethality|Mortality", names(varsNames()))] @@ -295,7 +295,7 @@ update_radio<- function(var, growthvar = 7, global = FALSE){ textvar = c("new_deaths", "lw_deaths", "deaths", "population") if(global) { textvar = c(textvar, c("lethality_rate","mortality_rate_1M_pop")) - textvar = textvar[!grepl("deaths",textvar)] + #textvar = textvar[!grepl("deaths",textvar)] } } else if ((grepl("growth",var) && grepl("prev",var))) { #new_buttons = NULL @@ -311,6 +311,7 @@ update_radio<- function(var, growthvar = 7, global = FALSE){ caption =HTML(paste(c(caption_growth_factor,caption_prevalence), collapse = '
')) graph_title = "Growth versus Prevalence" textvar = c("growth_factor_3", "new_prevalence_rate_1M_pop", "lw_prevalence_rate_1M_pop", "prevalence_rate_1M_pop") + } else if (grepl("active", var)) { mapvar = grep("active", varsNames(), value = T) #mapvar = varsNames()[mapvar] @@ -323,9 +324,8 @@ update_radio<- function(var, growthvar = 7, global = FALSE){ caption =HTML(paste(c(caption,caption_color), collapse = '
')) graph_title = "Active cases" - textvar = c("new_active", "new_confirmed", "confirmed","new_recovered","recovered") - if (global) - textvar = c("lw_active",textvar) + textvar = c("new_active","lw_active","active", "new_confirmed", "confirmed","new_recovered","recovered") + } else if (grepl("confirmed", var)) { mapvar = grep("confirmed", varsNames(), value = T) names(mapvar) = c("Total", "Last Week", @@ -333,10 +333,9 @@ update_radio<- function(var, growthvar = 7, global = FALSE){ new_buttons = list(name = "radio", choices = mapvar, selected = mapvar["Last Week"]) caption <- "Total, Last Week and New Confirmed Positive cases" - graph_title = "Confirmed cases" - textvar = c("growth_factor_3", "active", "tests") + graph_title = "Confirmed positive cases" + textvar = c("new_confirmed","lw_confirmed","confirmed","growth_factor_3", "active", "tests") if (global) { - textvar = c("lw_confirmed",textvar) caption <- "Confirmed positive cases" } } else if (grepl("tests", var) && grepl("1M", var)) { @@ -350,7 +349,8 @@ update_radio<- function(var, growthvar = 7, global = FALSE){ caption =HTML(paste(c(caption,caption_tests), collapse = '
')) graph_title = "Tests per population" - textvar = c("tests","lw_tests", "population", "positive_tests_rate", "lw_positive_tests_rate") + textvar = c("new_tests","lw_tests","tests", "population", "lw_positive_tests_rate", "positive_tests_rate") + } else if (grepl("positive", var)) { mapvar = grep("positive_tests_rate", varsNames(), value = T) names(mapvar) = c("Total", "Last Week", @@ -362,14 +362,15 @@ update_radio<- function(var, growthvar = 7, global = FALSE){ caption =HTML(paste(c(caption,caption_tests), collapse = '
')) graph_title = "Positive Tests rate" - textvar = c("tests","lw_tests", "confirmed", "lw_confirmed", "prevalence_rate_1M_pop", "lw_prevalence_rate_1M_pop") + textvar = c("lw_tests","tests", "lw_confirmed","confirmed", "lw_prevalence_rate_1M_pop", "prevalence_rate_1M_pop") } else { new_buttons = NULL caption = NULL } if (global) { textvar = textvar[!grepl("^lw",textvar )] - textvar = c("date",textvar) + textvar = c("date",textvar, "population") + textvar = unique(textvar) } list(new_buttons = new_buttons, graph_title = graph_title, caption = caption, textvar= textvar) @@ -394,9 +395,14 @@ map_popup_data <- function(data, nam, ind, namvar, textvar, namvarsfx = NULL){ varName = paste(varName, namvarsfx) } if (!is.null(textvar)) { - textvars = list(data = as.list(data@data[c(textvar)]), - NAME = names(varsNames(textvar))) - names(textvars$data) = textvar + textvar = setdiff(textvar, namvar) # remove namvar if textvar is present + #TODO: we could taje all lw variables if namvar is lw, same with new + if (length(namvar)>0) { + textvars = list(data = as.list(data@data[c(textvar)]), + NAME = names(varsNames(textvar))) + names(textvars$data) = textvar + } else + textvars = NULL } text.pop.x = gen_text(x, namvar) From fe3986feaea11e7fb1ade1c6ac2814e4d8340f2c Mon Sep 17 00:00:00 2001 From: Guido Maggio Date: Mon, 26 Oct 2020 10:03:47 +0100 Subject: [PATCH 09/11] Swapped var order --- R/mod_map.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/mod_map.R b/R/mod_map.R index 1714449f..7e948bde 100644 --- a/R/mod_map.R +++ b/R/mod_map.R @@ -12,8 +12,8 @@ mod_map_ui <- function(id){ ns <- NS(id) vars = setdiff(names(case_colors), c("hosp","recovered")) # remove hosp for now - choices_map <- c(vars, "new_confirmed", "new_active","new_deaths") %>% - setNames(gsub("_", " ",c(vars, "new_confirmed", "new_active", "new_deaths"))) %>% as.list() + choices_map <- c(vars, "new_confirmed","new_deaths", "new_active") %>% + setNames(gsub("_", " ",c(vars, "new_confirmed", "new_deaths", "new_active"))) %>% as.list() div( #fluidPage( From 43759068f234286d41f2d081cb4dab43232d2e36 Mon Sep 17 00:00:00 2001 From: Guido Maggio Date: Mon, 26 Oct 2020 10:22:14 +0100 Subject: [PATCH 10/11] 2.2.1 release preps * closes #55 * closes #126 * closes #127 --- DESCRIPTION | 2 +- NEWS.md | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1245bab2..06920208 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: Covid19Mirai Title: Covid-19 Data Analysis -Version: 2.2.1-9000 +Version: 2.2.1 Authors@R: c(person("Francesca", "Vitalini", role = c("cre", "aut"), email = 'francesca.vitalini@mirai-solutions.com'), diff --git a/NEWS.md b/NEWS.md index f29a5321..87e88142 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,9 +1,8 @@ -### Covid19Mirai 2.2.1-9000 (develop) +### Covid19Mirai 2.2.1 (2020-10-26) - Removed contagion day in x axis, replaced with dates (#126) - 2 maps added in continent page: tests per 1M, Positive test rates (#127) - Enhanced global map in first page (#55) - ### Covid19Mirai 2.2.0 (2020-09-04) - Added Switzerland tab with maps at Kanton level (#20) - Reviewed calculation and definition of Growth Factors (#122) From 47d1904ec61b8a4a7810d737510f4e73d3c3fcfd Mon Sep 17 00:00:00 2001 From: Guido Maggio Date: Tue, 27 Oct 2020 09:37:20 +0100 Subject: [PATCH 11/11] Last min addition of hospitalised var in country and swiss page --- R/mod_country.R | 11 +++++++++-- R/mod_individual_country.R | 3 +-- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/R/mod_country.R b/R/mod_country.R index 1cd9a093..8bd55c9f 100644 --- a/R/mod_country.R +++ b/R/mod_country.R @@ -287,9 +287,16 @@ mod_country_area_server <- function(input, output, session, data, n2 = 1, w = 7, # plots ---- levs <- sort_type_hardcoded() - df_area_2 = purrr::map(unique(data$Country.Region), + data_area = data + if (sum(data$hosp)>0) { + message("Adding hospitalised data") + levs = c(levs, "hosp") + data_area$active = data_area$active - data_area$hosp + } + + df_area_2 = purrr::map(unique(data_area$Country.Region), function(un) { - dat = tsdata_areplot(data[data$Country.Region == un, ], levs, nn = n2) #n = 0 for area plot + dat = tsdata_areplot(data_area[data_area$Country.Region == un, ], levs, nn = n2) #n = 0 for area plot dat$Country.Region = rep(un, nrow(dat)) dat }) diff --git a/R/mod_individual_country.R b/R/mod_individual_country.R index 8c063f85..d9d07c8f 100644 --- a/R/mod_individual_country.R +++ b/R/mod_individual_country.R @@ -33,14 +33,13 @@ mod_ind_country_ui <- function(id){ ) ), column(6, - withSpinner(mod_compare_nth_cases_plot_ui(ns("ind_lines_points_plots_tot"), tests = TRUE, hosp = FALSE)) + withSpinner(mod_compare_nth_cases_plot_ui(ns("ind_lines_points_plots_tot"), tests = TRUE, hosp = TRUE)) ) ), # hr(), # mod_add_table_ui(ns("ind_add_table_country")), # table at country level hr(), withSpinner(uiOutput(ns("ind_subarea"))), - #withSpinner(areaUI(ns("ind_country_subarea"))), hr(), withSpinner(uiOutput(ns("maps_ind_subarea"))), hr(),