diff --git a/DESCRIPTION b/DESCRIPTION
index 0574fbb4..919372ba 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: Covid19Mirai
Title: Covid-19 Data Analysis
-Version: 2.7.1-9000
+Version: 2.7.2-9000
Authors@R:
c(person("Riccardo", "Porreca", role = ("aut"),
email = "riccardo.porreca@mirai-solutions.com"),
diff --git a/NEWS.md b/NEWS.md
index becf76ce..fa045f89 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,4 +1,7 @@
-### Covid19Mirai 2.7.1-9000
+### Covid19Mirai 2.7.2-9000
+- Adjusted margins and padding for mobile (#210)
+- More countries in rds dump
+- Separated Individual country page
### Covid19Mirai 2.7.1 (2022-02-28)
- Build data in package, updated with github action (#207)
diff --git a/R/app_server.R b/R/app_server.R
index db80d7dc..b96329bd 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -73,7 +73,9 @@ app_server <- function(input, output, session) {
callModule(mod_global_server, "global", orig_data_aggregate = orig_data_aggregate,
countries_data_map)
glob_var(1)
- }
+ } else
+ message("Current SubTab: ", req(input$continents_ui) )
+
orig_data_aggregate = orig_data_aggregate %>%
filter(!is.na(continent))
@@ -84,8 +86,6 @@ app_server <- function(input, output, session) {
summary_var(1)
}
- message("Current SubTab: ", req(input$continents_ui) )
-
# select continents in tabs
# tabuicontinents = c("Europe", "Asia", "Africa", "Lat. America & Carib.", "Northern America", "Oceania")
# continents = c("Europe", "Asia", "Africa", "LatAm & Carib.", "Northern America", "Oceania")
@@ -125,7 +125,7 @@ app_server <- function(input, output, session) {
})
# country choice, remove Switzerland
- # orig_data_aggregate_noswiss = orig_data_aggregate %>% filter(Country.Region != "Switzerland")
+ # orig_data_aggregate_noswiss = orig_data_aggregate %>% filter(Country.Region != "Switzerland")
countriesnoswiss = reactive({
countries()[countries()[,1] != "Switzerland",]
})
diff --git a/R/app_ui.R b/R/app_ui.R
index ac7d5829..5c59444f 100644
--- a/R/app_ui.R
+++ b/R/app_ui.R
@@ -104,7 +104,11 @@ app_ui <- function(request) {
mod_global_ui("global")),
tabPanel("Continents",
#tabsetPanel(
+
navbarPage(
+ collapsible = TRUE,
+ fluid = TRUE,
+ #position = "fixed-bottom",
"",
id = "continents_ui",
tabPanel("Summary",
diff --git a/R/build_data.R b/R/build_data.R
new file mode 100644
index 00000000..824e2578
--- /dev/null
+++ b/R/build_data.R
@@ -0,0 +1,69 @@
+#' Build data in GutHub action yml and save as RDS
+#' @rdname get_datahub
+#'
+#' @import dplyr
+#' @export
+build_data <- function() {
+
+ message("Start build_data, read Level 1 and CH at Level 2")
+ orig_data_with_ch <- get_datahub_fix_ch()
+ orig_data <- orig_data_with_ch$orig_data
+ orig_data_ch_2 <- orig_data_with_ch$orig_data_ch_2
+
+ orig_data <- orig_data %>%
+ get_timeseries_by_contagion_day_data()
+
+ orig_data_ch_2 <- orig_data_ch_2 %>%
+ get_timeseries_by_contagion_day_data()
+
+ message("** Save data as DATA.rds **")
+ saveRDS(list(orig_data = orig_data, orig_data_ch_2 = orig_data_ch_2), "inst/datahub/DATA.rds")
+
+ # read data for default country at level 2
+ area_data_2 <- get_datahub(country = .Selected_Country, lev = 2, verbose = FALSE)
+
+ # take main European countries:
+ pop_data <- get_pop_datahub()
+ europe <- pop_data %>% filter(continent == "Europe")
+
+ all_data <- merge_pop_data(orig_data, pop_data)
+
+ top_europe <- all_data %>%
+ filter(continent == "Europe") %>%
+ distinct(Country.Region,population) %>%
+ slice_max(population, n = 25) %>% as.data.frame() %>% .[,"Country.Region"]
+
+ top_counties <- all_data %>% distinct(Country.Region,population) %>%
+ slice_max(population, n = 25) %>% as.data.frame() %>% .[,"Country.Region"]
+
+ add_countries <- c("Australia", "Canada", "Argentina", "South Africa", "South Korea")
+ top_counties <- c(top_counties, add_countries)
+ # remove Switzerland and USA
+ all_countries <- union(top_counties, top_europe) %>% setdiff(c("Switzerland", "USA"))
+
+ message("reading data at level 2 for country: ", paste(all_countries, collapse = ","))
+
+ all_lev2_data <- sapply(all_countries, function(cntr) {
+ orig_data_2_tmp <- get_datahub(country = cntr, lev = 2, verbose = FALSE, cache = TRUE)
+ # cant use get_timeseries_by_contagion_day_data because of reconciliation of hosp data
+ # if (nrow(orig_data_2_tmp)>0)
+ # orig_data_2_tmp <- orig_data_2_tmp %>%
+ # get_timeseries_by_contagion_day_data()
+ orig_data_2_tmp
+ })
+
+ # remove those whithout data
+ idx <- sapply(1:length(all_lev2_data), function(x)
+ nrow(all_lev2_data[[x]])) >0
+ message("Level 2 data not found for ", sum(!idx), " countries out of ", length(idx))
+ all_lev2_data <- all_lev2_data[idx]
+
+ message("** Save data as Selected_Country.rds **")
+
+ saveRDS(list(area_data_2 = area_data_2), "inst/datahub/Selected_Country.rds")
+
+ message("** Save data as Top_Countries.rds **")
+
+ saveRDS(list(all_lev2_data = all_lev2_data, all_countries = all_countries), "inst/datahub/Top_Countries.rds")
+ NULL
+}
diff --git a/R/get_data.R b/R/get_data.R
index dbd3228b..6a22f3d5 100644
--- a/R/get_data.R
+++ b/R/get_data.R
@@ -171,36 +171,6 @@ get_datahub_fix_ch <- function(country = NULL, startdate = "2020-01-22", lev = 1
list(orig_data = orig_data, orig_data_ch_2 = orig_data_ch_2)
}
-#' Build data in GutHub action yml and save as RDS
-#' @rdname get_datahub
-#'
-#'
-#' @export
-build_data <- function() {
-
- orig_data_with_ch <- get_datahub_fix_ch()
- orig_data <- orig_data_with_ch$orig_data
- orig_data_ch_2 <- orig_data_with_ch$orig_data_ch_2
-
- orig_data <- orig_data %>%
- get_timeseries_by_contagion_day_data()
-
- orig_data_ch_2 <- orig_data_ch_2 %>%
- get_timeseries_by_contagion_day_data()
-
- message("** Save data as DATA.rds **")
- saveRDS(list(orig_data = orig_data, orig_data_ch_2 = orig_data_ch_2), "inst/datahub/DATA.rds")
-
- # read data for default country at level 2
- area_data_2 <- get_datahub(country = .Selected_Country, lev = 2, verbose = FALSE)
-
- message("** Save data as Selected_Country.rds **")
-
- saveRDS(list(area_data_2 = area_data_2), "inst/datahub/Selected_Country.rds")
-
- NULL
-}
-
#' replace hospital data of level1 with level2 data
#'
@@ -244,9 +214,10 @@ combine_hospvars_lev2 <- function(data1, data2, country = "Switzerland") {
#'
#' @param country character country, to chose with lev = 2
#' @param startdate character staring date
-#' @param lev integer 1 for country level, 2 for reagions
+#' @param lev integer 1 for country level, 2 for regions
#' @param verbose logical. Print data sources? Default FALSE (opposite from \code{covid19})
-#' @param hosp logical. If TRUE hospitalised detailed data are retrieved. Default TRUE since release 2.3.1
+#' @param hosp logical. If TRUE hospitalized detailed data are retrieved. Default TRUE since release 2.3.1
+#' @param cache logical. If TRUE cache argument is used in the covid19() call
#'
#' @details data sourced from https://github.com/covid19datahub/COVID19/
#'
@@ -257,7 +228,7 @@ combine_hospvars_lev2 <- function(data1, data2, country = "Switzerland") {
#' @import zoo
#'
#' @export
-get_datahub = function(country = NULL, startdate = "2020-01-22", lev = 1, verbose = FALSE, hosp = TRUE) {
+get_datahub = function(country = NULL, startdate = "2020-01-22", lev = 1, verbose = FALSE, hosp = TRUE, cache = FALSE) {
# country = NULL; startdate = "2020-01-22"; lev = 1; verbose = FALSE; hosp = TRUE
message("get_datahub: country = ", country, "/ startdate = ", startdate, "/ level = ", lev)
rawarg = TRUE
@@ -274,7 +245,8 @@ get_datahub = function(country = NULL, startdate = "2020-01-22", lev = 1, verbos
"U.S. Virgin Islands" = "U.S. Virgin Islands",
)
}
- dataHub <- covid19(country = country, start = startdate, level = lev, verbose = verbose, raw = rawarg, cache = TRUE) # select level2 to add states
+ # cache = TRUE not needed since there are rds
+ dataHub <- covid19(country = country, start = startdate, level = lev, verbose = verbose, raw = rawarg, cache = cache) # select level2 to add states
#dataHub <- covid19(country = country, level = lev) #
# raw = FALSE then NAs replaced with 0s
diff --git a/R/mod_caseBoxes.R b/R/mod_caseBoxes.R
index 1e3b94da..e7962d24 100644
--- a/R/mod_caseBoxes.R
+++ b/R/mod_caseBoxes.R
@@ -237,7 +237,7 @@ mod_caseBoxes_server <- function(input, output, session, counts, hosp = FALSE, v
} else {
if(!renderui) {
insertUI(paste0("#",ns("hosp")),
- ui = countBox3(title1 = "Hospitalised: ",
+ ui = countBox3(title1 = "Hospitalized: ",
subtitle1 = counts[["hosp"]],
title2 = "Last Week: ",
subtitle2 = counts[["lw_hosp"]],
@@ -290,7 +290,7 @@ mod_caseBoxes_server <- function(input, output, session, counts, hosp = FALSE, v
)
} else {
output$hosp <- renderUI({
- countBox3(title1 = "Hospitalised: ",
+ countBox3(title1 = "Hospitalized: ",
subtitle1 = counts[["hosp"]],
title2 = "Last Week: ",
subtitle2 = counts[["lw_hosp"]],
diff --git a/R/mod_compare_nth_cases_plot.R b/R/mod_compare_nth_cases_plot.R
index c5881cb1..d5d1695f 100644
--- a/R/mod_compare_nth_cases_plot.R
+++ b/R/mod_compare_nth_cases_plot.R
@@ -59,6 +59,7 @@ choice_nthcases_plot = function(vars = .vars_nthcases_plot, actives = TRUE, test
#' @param oneMpop if TRUE then rescaled vars over 1M pop are available.
#' @param selectvar character variable selected in ui.
#' @param areasearch logical if TRUE replace with Country.Region selectInput
+#' @param writetitle logical if TRUE title id is set
#'
#' @noRd
#'
@@ -77,7 +78,9 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = .vars_nthcases_plot,
if (istop) {
plottitle = paste0("Top ",n_highlight," countries for the chosen variable")
} else {
- plottitle = paste0("Timeline from day with ", nn ," contagions")
+ plottitle = paste0("Timeline per variable",
+ ifelse(areasearch, paste0(" area", ifelse(oneMpop, " & Pop. size", "")), "")
+ )
}
# UI ----
divtitle = switch(writetitle ,div(class = "plottitle", plottitle, align = "center"),NULL)
@@ -103,7 +106,9 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = .vars_nthcases_plot,
selected = "lstmonth"))
)
),
- withSpinner(plotlyOutput(ns("plot"), height = 400)),
+ fluidRow(
+ withSpinner(plotlyOutput(ns("plot"), height = 400))
+ ),
#div(uiOutput(ns("caption")), align = "center")
div(htmlOutput(ns("caption")), align = "center", class = "plottext")
@@ -135,7 +140,9 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = .vars_nthcases_plot,
)
),
- withSpinner(plotlyOutput(ns("plot"), height = 400)),
+ fluidRow(
+ withSpinner(plotlyOutput(ns("plot"), height = 400))
+ ),
#div(uiOutput(ns("caption")), align = "center")
div(htmlOutput(ns("caption")), align = "center", class = "plottext", height = 10) # TODO: check why height = 10
@@ -169,8 +176,9 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = .vars_nthcases_plot,
choices = c("Last Month" = "lstmonth", "Last 6 Months" = "lst6month","Since Start" = "sincestart"), selected = "lstmonth"))
),
),
- withSpinner(plotlyOutput(ns("plot"), height = 400)),
- #div(uiOutput(ns("caption")), align = "center")
+ fluidRow(
+ withSpinner(plotlyOutput(ns("plot"), height = 400))
+ ), #div(uiOutput(ns("caption")), align = "center")
div(htmlOutput(ns("caption")), align = "center", class = "plottext", height = 10)
)
@@ -200,8 +208,9 @@ mod_compare_nth_cases_plot_ui <- function(id, vars = .vars_nthcases_plot,
multiple = TRUE))
)
),
- withSpinner(plotlyOutput(ns("plot"), height = 400)),
- #div(uiOutput(ns("caption")), align = "center")
+ fluidRow(
+ withSpinner(plotlyOutput(ns("plot"), height = 400))
+ ), #div(uiOutput(ns("caption")), align = "center")
div(htmlOutput(ns("caption")), align = "center", class = "plottext", height = 10)
)
@@ -254,7 +263,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
filter(date == AsOfDate) %>%
arrange(desc(confirmed)) %>% .[,"Country.Region"]
selected_countries = head(countries$Country.Region,3)
-
}
# Update radio_indicator, if oneMpop then some variables must be excluded
observe({
@@ -300,7 +308,7 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
}
cum_vars = intersect(get_cumvars(), names(df))
- rollw = reactive(!req(input$radio_indicator) %in% cum_vars) # do not roll if cumulativ var
+ rollw = reactive(!req(input$radio_indicator) %in% cum_vars) # do not roll if cumulative var
calc_line_plot = function(dat, vars, cum_vars) {
@@ -324,7 +332,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
dat = dat[dat$date >= date_first_contagion, , drop = FALSE]
# Give dat standard structure; reacts to input$radio_indicator
df_data_1Mpop <- reactive({
- message("df_data_1Mpop:")
data = dat
if (oneMpop && !is.null(input$radio_1Mpop) && input$radio_1Mpop == "oneMpop") {
if (all(is.na(data$population))) {
@@ -333,7 +340,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
#if (!(paste(req(input$radio_indicator),"rate_1M_pop", sep = "_") %in% names(data))) {
#varname = gsub("rate_1M_pop$","",reactSelectVar$radio_indicator)
#reactSelectVar$radio_indicator = gsub("rate_1M_pop$","",reactSelectVar())
- message("divide by pop size")
data[, reactSelectVar()] = round(10^6*data[, reactSelectVar()] / data$population, 3)
#}
}
@@ -346,7 +352,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
)
df_data_roll <- reactive({
- message("df_data_roll")
if (rollw()) {
message("compute rolling average")
@@ -369,7 +374,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
data
})
df_data_timeframe <- reactive({
- message("df_data_timeframe")
data = df_data_roll()
if (!is.null(input$time_frame)) {
@@ -412,7 +416,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
data
})
df_istop <- reactive({
- message("df_istop")
data = df_data_timeframe()
if(istop) {
# countries_order = data %>% filter(date == max(date)) %>%
@@ -430,7 +433,6 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
df_out <- reactive({
- message("df_out")
data = df_istop()
varsfinal = c("Country.Region", reactSelectVar(), "Date")
if (strindx)
@@ -461,9 +463,10 @@ mod_compare_nth_cases_plot_server <- function(input, output, session, df,
#rollw = TRUE
# Plot -----
output$plot <- renderPlotly({
-
if (length(reactSelectVar()) == 0) {
p <- blank_plot(where = "selected area", add = " All data missing")
+ # } else if (length(reactSelectVar()) == 0){
+ # p <- blank_plot(where = "Variables have", add = " All data missing", what = reactSelectVar())
} else {
#secondline = NULL
#if (!(input$radio_indicator %in% get_aggrvars()) || (input$time_frame != "sincestart"))
diff --git a/R/mod_compare_nth_cases_years_plot.R b/R/mod_compare_nth_cases_years_plot.R
index acb5072d..a04b0496 100644
--- a/R/mod_compare_nth_cases_years_plot.R
+++ b/R/mod_compare_nth_cases_years_plot.R
@@ -101,7 +101,7 @@ mod_compare_timeline_plot_ui <- function(id, titles = 1:3,
plottitleTLSE = "Timeline per variable"
plottitleTLCY = "Timeline per calendar year"
- plottitleTLTE = "Pandemic time evolution"
+ plottitleTLTE = "Pandemic evolution over time"
alltitles = c(plottitleTLSE, plottitleTLCY, plottitleTLTE)[titles]
plot_tabs <- tabsetPanel(
@@ -119,7 +119,7 @@ mod_compare_timeline_plot_ui <- function(id, titles = 1:3,
istop = istop, tests = tests, hosp = hosp, strindx = strindx, vax = vax,
selectvar = "new_deaths", writetitle = FALSE)
),
- tabPanel("Pandemic time evolution",
+ tabPanel("Pandemic evolution over time",
mod_plot_log_linear_ui(ns("timelinearea_plot"))
)
)
@@ -129,14 +129,21 @@ mod_compare_timeline_plot_ui <- function(id, titles = 1:3,
#uiOutput(ns("title")),
#div(h4(plottitle), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
fluidRow(
- column(7,
- offset = 4,
- div(class = "plottext", selectInput(inputId = ns("plot_indicator"), label = "Select view",
- choices = alltitles, selected = alltitles[1]))
- )#,
+ #tagList(
+ column(7,
+ offset = 4,
+ div(class = "plottext", selectInput(inputId = ns("plot_indicator"), label = "Select view",
+ choices = alltitles, selected = alltitles[1]))
+ )#,
+ # tabPanel("Panel plot",
+ # plot_tabs
+ # )
+ # )
),
- tabPanel("Panel plot",
- plot_tabs
+ fluidRow(
+ tabPanel("Panel plot",
+ plot_tabs
+ )
)
)
@@ -187,7 +194,7 @@ mod_compare_timeline_plot_server <- function(input, output, session, df,
n_highlight = n_highlight, istop = istop, g_palette = graph_palette, datevar = "date",
actives = actives, tests = tests, hosp = hosp, strindx = strindx, vax = vax, oneMpop = oneMpop, secondline = secondline, areasearch = areasearch)#, secondline = "stringency_index")
- }, "Pandemic time evolution" ={
+ }, "Pandemic evolution over time" ={
levs <- areaplot_vars()
callModule(mod_plot_log_linear_server, "timelinearea_plot", df = df, type = "area", process_data = TRUE, fun.args = list(levs = levs, nn = nn))
@@ -225,7 +232,8 @@ mod_compare_timeline_plot_server <- function(input, output, session, df,
#' @importFrom shinycssloaders withSpinner
mod_compare_nth_cases_years_plot_ui <- function(id, vars = .vars_nthcases_plot,
istop = TRUE, n_highlight = 10,
- actives = TRUE, tests = TRUE, hosp = TRUE, strindx = TRUE, vax = TRUE, selectvar = "new_deaths", writetitle = TRUE){
+ actives = TRUE, tests = TRUE, hosp = TRUE, strindx = TRUE, vax = TRUE,
+ selectvar = "new_deaths", writetitle = TRUE){
ns <- NS(id)
choices_plot = choice_nthcases_plot(vars, actives = actives, tests = tests, hosp = hosp, strindx = strindx, vax = vax) # do not add stringency_index in possible choices
@@ -251,8 +259,9 @@ mod_compare_nth_cases_years_plot_ui <- function(id, vars = .vars_nthcases_plot,
choices = c("Last Month" = "lstmonth", "Full year" = "sincestart"), selected = "lstmonth"))
),
),
- withSpinner(plotlyOutput(ns("plot"), height = 400)),
- #div(uiOutput(ns("caption")), align = "center")
+ fluidRow(
+ withSpinner(plotlyOutput(ns("plot"), height = 400))
+ ), #div(uiOutput(ns("caption")), align = "center")
div(htmlOutput(ns("caption")), align = "center", height = 10, class = "plottext")
)
diff --git a/R/mod_country.R b/R/mod_country.R
index 621fada4..f9c03ed2 100644
--- a/R/mod_country.R
+++ b/R/mod_country.R
@@ -12,8 +12,8 @@
#' @importFrom shinycssloaders withSpinner
mod_country_ui <- function(id, nn = 1000, n.select = 1000){
ns <- NS(id)
- from_nth_case_msg = paste(message_conf_case("Countries",n.select),
- message_firstday(nn),
+ from_nth_case_msg <- paste(message_conf_case("Countries",n.select),
+ #message_firstday(nn),
message_missing_recovered(),
message_missing_data(),
message_hosp_data(),
@@ -21,18 +21,20 @@ mod_country_ui <- function(id, nn = 1000, n.select = 1000){
tagList(
hr(),
- div( h4("Covid 19 Single Country Dashboard"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
+ div( h4("COVID-19 Single Country Dashboard"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
hr(),
div(
HTML(from_nth_case_msg), class = "bodytext"
#uiOutput(ns("from_nth_case"))
),
- hr(),
+ #hr(),
div(
htmlOutput(ns("ind_missing_days")), class = "bodytext"
),
hr(),
- selectInput(label = "Country", inputId = ns("select_country"), choices = NULL, selected = NULL),
+ div(class = "plottext", style = "font-size:14px",
+ selectInput(label = "Country", inputId = ns("select_country"), choices = NULL, selected = NULL)
+ ),
tags$head(tags$style(HTML(".small-box {width: 300px; margin: 20px;}"))),
mod_caseBoxes_ui(ns("count-boxes"), outputui = TRUE),
@@ -46,13 +48,13 @@ mod_country_ui <- function(id, nn = 1000, n.select = 1000){
fluidRow(
column(6,
br(),
- div( h4("Covid-19 time evolution"), align = "center",
+ div( h4("COVID-19 evolution over time"), align = "center",
div(style = "visibility: hidden", radioButtons("dummy1", "", choices = "dummy")),
withSpinner(mod_plot_log_linear_ui(ns("plot_area_tot"), area = TRUE))
)
),
column(6,
- div( h4("Time evolution of Hospitalised cases"), align = "center",
+ div( h4("Evolution over time of Hospitalizations"), align = "center",
div(style = "visibility: hidden", radioButtons("dummy1", "", choices = "dummy")),
withSpinner(mod_plot_log_linear_ui(ns("plot_areahosp_tot"), area = TRUE))
)
@@ -74,44 +76,52 @@ mod_country_ui <- function(id, nn = 1000, n.select = 1000){
)
}
+#' Level 2 top messages
+#'
+#' @param n2 min number of cases for a country to be considered. Default n
+#'
+#' @noRd
+from_nth_case_area2_msg <- function(n2){
+ paste(
+ "Some countries have unreliable or inconsistent data at regional level in our data source.",
+ "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."),
+ message_missing_data(),
+ #message_firstday(n2),
+ #paste0("1st day is the day when ", n2 ," confirmed cases are reached."),
+ message_hosp_data(where = "some areas"),
+ sep = "
")
+}
+
+
#' Level 2 areas UI function
#' @description A shiny Module.
#'
#' @param id, Internal parameters for {shiny}.
#' @param tab logical, if TRUE then also the data table ui is called
#' @param stringency logical, if TRUE then also the group plot stringency ui is called
-#' @param vaxflag logical, if TRUE then also the group plot of vaccines ui is called
-#' @param hospflag logical, if TRUE then also the group plot of hosppitalization ui is called
+#' @param vaxflag logical, if TRUE then also the group plot of vaccines ui is called
+#' @param hospflag logical, if TRUE then also the group plot of hospitalization ui is called
#' @param n2 min number of cases for a country to be considered. Default n
#'
#' @noRd
#'
#' @import shiny
#' @importFrom shinycssloaders withSpinner
-areaUI = function(id, tab = TRUE, hospflag = TRUE, stringency = TRUE, vaxflag = TRUE, n2 = 100){
+areaUI <- function(id, tab = TRUE, hospflag = TRUE, stringency = TRUE, vaxflag = TRUE, n2 = 100){
ns = shiny::NS(id)
- from_nth_case_area2_msg = paste(
- "Some countries have unreliable or inconsistent data at regional level in our data source.",
- "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."),
- message_missing_data(),
- message_firstday(n2),
- #paste0("1st day is the day when ", n2 ," confirmed cases are reached."),
- message_hosp_data(where = "some areas"),
- sep = "
")
-
- tg = tagList(
+ tg <- tagList(
div(id = id,
hr(),
- div("Country split at level 2", align = "center", class = "sectiontitle"),
+ div("Country Report at 2nd administrative level", align = "center", class = "sectiontitle"),
hr(),
div(
- HTML(from_nth_case_area2_msg), class = "bodytext"
+ HTML(from_nth_case_area2_msg(n2)), class = "bodytext"
),
- hr(),
+ #hr(),
div(
- htmlOutput(ns("ind_missing_days_area")), class = "bodytext"
+ htmlOutput(ns("country_missing_days_area2")), class = "bodytext"
),
# hr(),
fluidRow(
@@ -122,18 +132,13 @@ areaUI = function(id, tab = TRUE, hospflag = TRUE, stringency = TRUE, vaxflag =
hr(),
fluidRow(
column(6,
- div(h4("Covid-19 time evolution"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
+ div(h4("COVID-19 evolution over time"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
#withSpinner(uiOutput(ns("plot_area_area2")))
withSpinner( mod_plot_log_linear_ui(ns("plot_area2_area2"), select = TRUE, area = TRUE))
),
column(6,
withSpinner(uiOutput(ns("plot_compare_nth_area2")))
-
- )#,
- # column(6,
- # div(h4("Confirmed cases for top 5 Areas"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
- # withSpinner(uiOutput(ns("plot_log_linear_top_n_area2")))
- # )
+ )
),
hr(),
fluidRow(
@@ -155,21 +160,20 @@ areaUI = function(id, tab = TRUE, hospflag = TRUE, stringency = TRUE, vaxflag =
div(HTML(section_info("hosp", infotext = TRUE)), class = "bodytext"),
hr(),
fluidRow(
-
column(6,
- withSpinner(uiOutput(ns("plot_compare_hosp_nth_area2")))
-
- ),
- column(6,
- div(h4("Time evolution of Hospitalised cases"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
+ div(h4("Evolution over time of Hospitalizations"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
#withSpinner(uiOutput(ns("plot_areahosp_area2")))
withSpinner(mod_plot_log_linear_ui(ns("plot_areahosp2_area2"), select = TRUE, area = TRUE))
+ ),
+ column(6,
+ withSpinner(uiOutput(ns("plot_compare_hosp_nth_area2")))
)
),
#tags$div(id = "plot_barplot_stringency_area2"),
)
)
if(hospflag) {
+ message("hospflag = TRUE, add hosp_index_area2 UI id")
tg = tagList(
div(id = id,
tg,
@@ -181,6 +185,7 @@ areaUI = function(id, tab = TRUE, hospflag = TRUE, stringency = TRUE, vaxflag =
)
}
if(stringency) {
+ message("stringency = TRUE, add stringency_index_area2 UI id")
tg = tagList(
div(id = id,
tg,
@@ -192,6 +197,7 @@ areaUI = function(id, tab = TRUE, hospflag = TRUE, stringency = TRUE, vaxflag =
)
}
if(vaxflag) {
+ message("stringency = TRUE, add vax_index_area2 UI id")
tg = tagList(
div(id = id,
tg,
@@ -241,6 +247,13 @@ mod_country_server <- function(input, output, session, data, countries, nn = 100
)
lev2id <- reactiveVal(0) # for removeUI
+ message("read from RDS dump Selected_Country.rds")
+
+ selected_country_data <- readRDS(system.file("datahub/Selected_Country.rds", package = "Covid19Mirai"))$area_data_2
+ top_data_2 <- readRDS(system.file("datahub/Top_Countries.rds", package = "Covid19Mirai"))
+ all_countries <- top_data_2$all_countries
+ top_data_2 <- top_data_2$all_lev2_data
+
observeEvent(input$select_country, {
message("process country page ", req(input$select_country))
@@ -255,11 +268,18 @@ mod_country_server <- function(input, output, session, data, countries, nn = 100
arrange(desc(date))
# # Data ----
+
if (req(input$select_country) == .Selected_Country) {
- message("read from RDS dump Selected_Country.rds")
- area_data_2 <- readRDS(system.file("datahub/Selected_Country.rds", package = "Covid19Mirai"))$area_data_2
+ message("take dump Selected_Country.rds")
+ area_data_2 <- selected_country_data
+ } else if (req(input$select_country) %in% all_countries) {
+ # use all_countries because if in this list then it was already excluded in build_data
+ message("take from dump top_data_2")
+ area_data_2 <- top_data_2[[req(input$select_country)]]
+ } else if (!req(input$select_country) %in% all_countries){
+ area_data_2 <- get_datahub(country = req(input$select_country), lev = 2, verbose = FALSE, cache = TRUE)
} else
- area_data_2 <- get_datahub(country = req(input$select_country), lev = 2, verbose = FALSE)
+ area_data_2 <- NULL
if (!is.null(area_data_2) && nrow(area_data_2) >0) {
# Align AsOfDate with level 1
@@ -290,10 +310,15 @@ mod_country_server <- function(input, output, session, data, countries, nn = 100
build_data_aggr() # recompute other variables
}
}
- hospflag = sum(country_data$hosp, na.rm = TRUE) > 0
- vaxflag = sum(country_data$vaccines, na.rm = TRUE) > 0
+
+
+ hospflag = check_flag(country_data, "hosp")
+ strflag = check_flag(country_data, "stringency_index")
+
+ vaxflag = check_flag(country_data, "vaccines")
message("hospflag = ", hospflag)
message("vaxflag = ", vaxflag)
+
last10days = max(country_data$date) - 0:9
country_data[, c("Country.Region","date", get_cumvars())] %>%
filter(date %in% last10days) %>% # take
@@ -381,8 +406,9 @@ mod_country_server <- function(input, output, session, data, countries, nn = 100
insertUI(paste0("#","subarea"),
'afterEnd',
- #ui = areaUI(ns(paste0("area",lev2id()))),#, good for example
ui = areaUI(ns(id), n2 = max(1,nn/10)),#, good for example
+ # ui = areaUI(ns(id), n2 = max(1,nn/10), hospflag = hospflag,
+ # stringency = strflag, vaxflag = vaxflag),#, better not to add anything
session = session,
immediate = TRUE
)
@@ -442,7 +468,7 @@ mod_country_server <- function(input, output, session, data, countries, nn = 100
mod_country_area_server <- function(input, output, session, data, n2 = 1, w = 7, tab = TRUE, hospitalFlag = TRUE, stringencyFlag = TRUE, vaccinesFlag = TRUE, hospid_arg, strid_arg, vaxid_arg, country = NULL) {
ns <- session$ns
- message("mod_country_area_server n2 = ", n2, " Country = " ,country)
+ message("** mod_country_area_server n2 = ", n2, " Country = " ,country, " hospitalFlag = ", hospitalFlag, " **")
data_2_filtered <-
data %>%
@@ -451,11 +477,11 @@ mod_country_area_server <- function(input, output, session, data, n2 = 1, w = 7,
data_2_filtered_today = data_2_filtered %>%
filter(date == AsOfDate)
- data_today = data %>%
+ data_today <- data %>%
add_growth_death_rate()
- lw_data = lw_vars_calc(data)
- pw_data = lw_vars_calc(data, 14)
+ lw_data = lw_vars_calc(data)
+ pw_data = lw_vars_calc(data, 14)
data_today = data_today %>%
left_join(lw_data %>% select(-population)) %>%
@@ -463,7 +489,7 @@ mod_country_area_server <- function(input, output, session, data, n2 = 1, w = 7,
#TODO? to be filtered with date == AsOfDate?
- output$ind_missing_days_area <- renderText({
+ output$country_missing_days_area2 <- renderText({
HTML(
message_missing_country_days(data)
)})
@@ -474,28 +500,11 @@ mod_country_area_server <- function(input, output, session, data, n2 = 1, w = 7,
distinct() #%>% .$Country.Region
#})
- if (FALSE) {
- area_data_2_aggregate_today <-
- data %>%
- filter( date == AsOfDate) #??
-
- area_2_top_5_today <-
- area_data_2_aggregate_today %>%
- arrange(desc(confirmed)) %>%
- head(5)
-
- area_2_top_5_confirmed <-
- data %>%
- filter(Country.Region %in% area_2_top_5_today$Country.Region) %>%
- select(Country.Region, date, confirmed)
- }
-
# plots ----
- testsflag = TRUE
- if (all(is.na(data_today$tests)) || all(data_today$tests == 0, na.rm = TRUE) || length(table(data_today$tests)) == 1)
- testsflag = FALSE
+ testsflag = check_flag(data_today, "tests")
+
# confirmed session
relevant_countries = unique(data_today$Country.Region[data_today$confirmed>n2])
@@ -542,58 +551,29 @@ mod_country_area_server <- function(input, output, session, data, n2 = 1, w = 7,
#
df_area_2 = purrr::map(relevant_countries,
function(un) {
- dat = tsdata_areplot(data[data$Country.Region == un, ], levs, nn = 1) #n = 0 for area plot hosp, do not filter
+ dat = tsdata_areplot(data[data$Country.Region == un, ], levs, nn = 1) #n = 1 for area plot hosp, do not filter
dat$Country.Region = rep(un, nrow(dat))
dat
})
df_area_2 = Reduce("rbind",df_area_2)
#
- hospflag = sum(data$hosp, na.rm = TRUE) > 0
- oneMpopflag = TRUE
- if (all(is.na(data_today$population)))
- oneMpopflag = FALSE
-
- # # some have no data here
- # output[["plot_areahosp_area2"]] <- renderUI({
- # mod_plot_log_linear_ui(ns("plot_areahosp2_area2"), select = TRUE, area = TRUE)
- # })
- # #if (hospflag)
- callModule(mod_plot_log_linear_server, "plot_areahosp2_area2", df = df_area_2, type = "area" , countries = reactive(areas), hosp = TRUE)
- #else
- # callModule(mod_nodata_areaplot_server,"plot_areahosp2_area2", country = country, what = "Hospital")
-
-
- # > line plot top 5
-
- if (FALSE) {
- mindate = min(area_2_top_5_confirmed$date[area_2_top_5_confirmed$confirmed>n2], na.rm = TRUE)
-
- # create factors with first top confirmed
- countries_order = area_2_top_5_confirmed %>% filter(date == AsOfDate) %>%
- arrange(desc(confirmed)) %>%
- .[,"Country.Region"] %>% as.vector()
- df_top_n = area_2_top_5_confirmed %>% filter(date >= mindate) %>% # take only starting point where greater than n
- mutate(status = factor(Country.Region, levels = countries_order[, "Country.Region", drop = T])) %>%
- mutate(value = confirmed) %>%
- capitalize_names_df()
- output[["plot_log_linear_top_n_area2"]] <- renderUI({
- mod_plot_log_linear_ui(ns("log_linear_top_n_area2"), area = FALSE)
- })
- callModule(mod_plot_log_linear_server, "log_linear_top_n_area2", df = df_top_n, type = "line")
+ hospflag = check_flag(data, "hosp")
+ oneMpopflag = check_flag(data, "population")
+
+ callModule(mod_plot_log_linear_server, "plot_areahosp2_area2", df = df_area_2, type = "area" , countries = reactive(areas), hosp = TRUE)
- }
# > comparison plot from day of nth contagion
- strFlag = TRUE
+ strFlag = check_flag(data_today, "stringency_index") # use data_today
# do not use stringency v is the same for all areas
- if (all(is.na(data_today$stringency_index)) || all(data_today$stringency_index == 0, na.rm = TRUE) || length(table(data_today$stringency_index)) == 1)
- strFlag = FALSE
+ # if (all(is.na(data_today$stringency_index)) || all(data_today$stringency_index == 0, na.rm = TRUE) || length(table(data_today$stringency_index)) == 1)
+ # strFlag = FALSE
- vaxFlag = TRUE
- # do not use stringency v is the same for all areas
- if (all(is.na(data_today$vaccines)) || all(data_today$vaccines == 0, na.rm = TRUE) || length(table(data_today$vaccines)) == 1)
- vaxFlag = FALSE
+ vaxFlag = check_flag(data, "vaccines")
+ # # do not use stringency v is the same for all areas
+ # if (all(is.na(data_today$vaccines)) || all(data_today$vaccines == 0, na.rm = TRUE) || length(table(data_today$vaccines)) == 1)
+ # vaxFlag = FALSE
message("hospflag: ", hospflag, "/ oneMpopflag: ", oneMpopflag,"/ strFlag: ", strFlag,"/ testsflag: ", testsflag, "/ vaxFlag: ", vaxFlag)
# paste0("lines_plots_area2_",country) because of problems with selectInputID after USA page. not solved, TBD
@@ -646,7 +626,7 @@ mod_country_area_server <- function(input, output, session, data, n2 = 1, w = 7,
id = paste0("area_hosp",hospid_arg())
message("id hosp insert = ", id)
- message('Level 2 Stringency Index present: insertUI for barplot ', hospid_arg())
+ message('Level 2 Hosp present: insertUI for barplot ', hospid_arg())
insertUI(paste0("#","hosp_index_area2"),
'afterEnd',
diff --git a/R/mod_country_comparison.R b/R/mod_country_comparison.R
index 271c4c96..6e202d66 100644
--- a/R/mod_country_comparison.R
+++ b/R/mod_country_comparison.R
@@ -17,7 +17,7 @@ mod_country_comparison_ui <- function(id, nn = 1000){
message_missing_recovered(),
message_missing_data("Recovered and Tests", "some countries"),
#paste0("1st day is the day when ", nn ," confirmed cases are reached.")
- message_firstday(nn),
+ #message_firstday(nn),
sep = "
")
@@ -29,7 +29,9 @@ mod_country_comparison_ui <- function(id, nn = 1000){
#uiOutput(ns("from_nth_case"))
),
hr(),
- div(class = "plottext",selectInput(label = "Select Countries", inputId = ns("select_countries"), choices = NULL, selected = NULL, multiple = TRUE))
+ div(class = "plottext", style = "font-size:14px",
+ selectInput(label = "Select Countries", inputId = ns("select_countries"), choices = NULL, selected = NULL, multiple = TRUE)
+ )
),
#tagList(
div(h4("Countries Comparison"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
diff --git a/R/mod_global.R b/R/mod_global.R
index abfb4f5d..a1ac3f2e 100644
--- a/R/mod_global.R
+++ b/R/mod_global.R
@@ -13,6 +13,7 @@ mod_global_ui <- function(id){
n = 1000 # define areaplot start
ns <- NS(id)
+ message("global ui: ")
tagList(
tags$head(tags$style(HTML(".small-box {width: 300px; margin: 20px;}"))),
mod_caseBoxes_ui(ns("count-boxes")),
@@ -21,11 +22,13 @@ mod_global_ui <- function(id){
),
div(h4("Global view of the pandemic"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
hr(),
- div(timeline_info(hosp = FALSE), class = "bodytext"),
+ fluidRow(
+ div(timeline_info(hosp = FALSE), class = "bodytext"),
+ ),
br(),
fluidRow(
column(6,
- div(h4("Global Covid-19 time evolution"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
+ div(h4("Global Covid-19 evolution over time"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
withSpinner(mod_plot_log_linear_ui(ns("plot_area_global")))
),
column(6,
diff --git a/R/mod_growth_death_rate.R b/R/mod_growth_death_rate.R
index 992ba64d..fe595fa3 100644
--- a/R/mod_growth_death_rate.R
+++ b/R/mod_growth_death_rate.R
@@ -41,7 +41,10 @@ mod_barplot_ui <- function(id, plot1 = "ui_growth", plot2 = "ui_death", text =
choices = varsNames(c(prefix_var("confirmed", c("")),
prefix_var("confirmed_rate_1M_pop", c("")),
prefix_var("tests_rate_1M_pop", c("")),
- prefix_var("positive_tests_rate", c("")))),
+ prefix_var("positive_tests_rate", c(""))
+ # prefix_var("deaths_rate_1M_pop", c("")),
+ # prefix_var("lethality_rate", c(""))
+ )),
selected = "confirmed_rate_1M_pop"),
time = list(label = "Time-line",
choices = list("Total" = "total", "Last Week" = "lw", "Past Week" = "pw"),
@@ -92,8 +95,8 @@ mod_barplot_ui <- function(id, plot1 = "ui_growth", plot2 = "ui_death", text =
barplot_info <- function(sep = "
"){
#tags$p(
- paste("Units with no data for the selected variable will not appear in the 'barplot'.",
- "Select the variable, if avaialble, to see different views. Compare using rescaled data over population size using variables.
+ paste("Units or variables with no data will not appear in the 'barplot'.",
+ "Select the variable to see different views. Use rescaled data to compare.
If all data are missing for the chosen variable the plot will display a message.", sep = sep)
#)
}
@@ -106,8 +109,8 @@ mod_barplot_ui <- function(id, plot1 = "ui_growth", plot2 = "ui_death", text =
fluidRow(
column(6,
tagList(
- div(HTML(test_bp), class = "bodytextplot"),
div(uiOutput(ns("title_plot_1")),class = "plottitle", align = "center"),
+ div(HTML(test_bp), class = "bodytextplot"),
fluidRow(
#shinyjs::useShinyjs(),
column(width = 5,
@@ -118,13 +121,15 @@ mod_barplot_ui <- function(id, plot1 = "ui_growth", plot2 = "ui_death", text =
div(class = "plottext",selectInput(inputId = ns("plot_1_time"), label = uichoice1$time$label,
choices = uichoice1$time$choices ,
selected = uichoice1$time$selected)))),
- withSpinner(plotlyOutput(ns("plot_plot_1_hist"), height = 400)),
+ fluidRow(
+ withSpinner(plotlyOutput(ns("plot_plot_1_hist"), height = 400))
+ ),
div(htmlOutput(ns("caption1")), align = "center", class = "plottext"))
),
column(6,
tagList(
- div(HTML(test_bp), class = "bodytextplot"),
div(class = "plottitle", align = "center", uiOutput(ns("title_plot_2"))),
+ div(HTML(test_bp), class = "bodytextplot"),
fluidRow(
#shinyjs::useShinyjs(),
@@ -135,8 +140,11 @@ mod_barplot_ui <- function(id, plot1 = "ui_growth", plot2 = "ui_death", text =
column(width = 5,offset = 1,
div(class = "plottext",selectInput(inputId = ns("plot_2_time"), label = uichoice2$time$label,
choices = uichoice2$time$choices ,
- selected = uichoice2$time$selected)))),
- withSpinner(plotlyOutput(ns("plot_plot_2_hist"), height = 400)),
+ selected = uichoice2$time$selected)))
+ ),
+ fluidRow(
+ withSpinner(plotlyOutput(ns("plot_plot_2_hist"), height = 400))
+ ),
div(htmlOutput(ns("caption2")), align = "center", class = "plottext")
)
)
@@ -155,8 +163,8 @@ mod_barplot_ui <- function(id, plot1 = "ui_growth", plot2 = "ui_death", text =
div(id = id,
fluidRow(
- div(HTML(test_bp), class = "bodytextplot"),
div(class = "plottitle", align = "center", uiOutput(ns("title_plot_1"))),
+ div(HTML(test_bp), class = "bodytextplot"),
fluidRow(
#shinyjs::useShinyjs(),
column(width = 4,
@@ -166,8 +174,11 @@ mod_barplot_ui <- function(id, plot1 = "ui_growth", plot2 = "ui_death", text =
column(width = 4,offset = 1,
div(class = "plottext",selectInput(inputId = ns("plot_1_time"), label = uichoice1$time$label,
choices = uichoice1$time$choices ,
- selected = uichoice1$time$selected)))),
- withSpinner(plotlyOutput(ns("plot_plot_1_hist"), height = 400)),
+ selected = uichoice1$time$selected)))
+ ),
+ fluidRow(
+ withSpinner(plotlyOutput(ns("plot_plot_1_hist"), height = 400))
+ ),
div(htmlOutput(ns("caption1")), align = "center", class = "plottext")
)
)
@@ -175,8 +186,6 @@ mod_barplot_ui <- function(id, plot1 = "ui_growth", plot2 = "ui_death", text =
} else {
stop("If only one plot to be done then use plot1")
}
-
-
}
#' growth_death_rate Server Function
diff --git a/R/mod_individual_country.R b/R/mod_individual_country.R
index 4389c26f..e6e8ba7e 100644
--- a/R/mod_individual_country.R
+++ b/R/mod_individual_country.R
@@ -10,18 +10,19 @@
#' @importFrom shinycssloaders withSpinner
mod_ind_country_ui <- function(id){
ns <- NS(id)
+ n2 <- 10
tagList(
hr(),
tags$head(tags$style(HTML(".small-box {width: 300px; margin: 20px;}"))),
mod_caseBoxes_ui(ns("ind_count-boxes")),
mod_caseBoxes_ui(ns("ind_count-boxes_hosp"), hosp = TRUE),
hr(),
- div( h4("Covid 19 Swiss Dashboard"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
+ div( h4("COVID-19 Dashboard Switzerland"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
hr(),
div(
htmlOutput(ns("ind_from_nth_case")), class = "bodytext"
),
- hr(),
+ #hr(),
div(
htmlOutput(ns("ind_missing_days")), class = "bodytext"
),
@@ -35,14 +36,14 @@ mod_ind_country_ui <- function(id){
fluidRow(
column(6,
br(),
- div( h4("Covid-19 time evolution"), align = "center",
+ div( h4("COVID-19 evolution over time"), align = "center",
div(style = "visibility: hidden", radioButtons("dummy1", "", choices = "dummy")),
withSpinner(mod_plot_log_linear_ui(ns("ind_plot_area_tot"), area = TRUE))
)
),
column(6,
br(),
- div( h4("Time evolution of Hospitalised cases"), align = "center",
+ div( h4("Evolution over time of Hospitalizations"), align = "center",
div(style = "visibility: hidden", radioButtons("dummy1", "", choices = "dummy")),
withSpinner(mod_plot_log_linear_ui(ns("ind_plot_areahosp_tot"), area = TRUE))
)
@@ -60,8 +61,8 @@ mod_ind_country_ui <- function(id){
# hr(),
# mod_add_table_ui(ns("ind_add_table_country")), # table at country level
hr(),
- withSpinner(uiOutput(ns("ind_subarea"))),
- hr(),
+ # withSpinner(uiOutput(ns("ind_subarea"))),
+ # hr(),
# fluidRow(
# column(6,
# withSpinner(mod_scatterplot_ui(ns("scatterplot_plots_canton"), growth = FALSE))
@@ -72,14 +73,54 @@ mod_ind_country_ui <- function(id){
# )
# )
# ),
+ hr(),
+ div("Country Report at Cantonal level", align = "center", class = "sectiontitle"),
+ hr(),
+ div(
+ HTML(from_nth_case_area2_msg(n2)), class = "bodytext"
+ ),
+ #hr(),
+ div(
+ htmlOutput(ns("ind_missing_days_area2")), class = "bodytext"
+ ),
+ fluidRow(
+ column(12,
+ #withSpinner(mod_group_plot_ui(ns("ind_country_hosp"), type = "hosp", infotext = FALSE, titlesection = FALSE))
+ withSpinner(mod_group_plot_ui(ns("ind_country_confirmed_2"), type = "confirmed"))
+ )
+ ),
+ hr(),
+ fluidRow(
+ column(6,
+ div(h4("COVID-19 evolution over time"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
+ #withSpinner(uiOutput(ns("plot_area_area2")))
+ withSpinner( mod_plot_log_linear_ui(ns("plot_ind_area2"), select = TRUE, area = TRUE))
+ ),
+ column(6,
+ withSpinner(uiOutput(ns("plot_compare_nth_ind_area2")))
+
+ )
+ ),
fluidRow(
column(12,
- withSpinner(mod_group_plot_ui(ns("ind_country_hosp"), type = "hosp", infotext = FALSE, titlesection = FALSE))
+ #withSpinner(mod_group_plot_ui(ns("ind_country_hosp"), type = "hosp", infotext = FALSE, titlesection = FALSE))
+ withSpinner(mod_group_plot_ui(ns("ind_country_hosp_2"), type = "hosp", infotext = TRUE, titlesection = TRUE))
+
)
),
+ fluidRow(
+ column(6,
+ div(h4("Evolution over time of Hospitalizations"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
+ #withSpinner(uiOutput(ns("plot_areahosp_area2")))
+ withSpinner(mod_plot_log_linear_ui(ns("plot_areahosp2_ind_area2"), select = TRUE, area = TRUE))
+ ),
+ column(6,
+ withSpinner(uiOutput(ns("plot_compare_hosp_nth_ind_area2")))
+ ),
+ ),
fluidRow(
column(12,
- withSpinner(mod_group_plot_ui(ns("ind_country_vax"), type = "vaccines"))
+ withSpinner(mod_group_plot_ui(ns("ind_country_vax_2"), type = "vaccines"))
)
),
hr(),
@@ -100,7 +141,7 @@ mod_ind_country_ui <- function(id){
#'
#' @import shiny
#' @importFrom shinycssloaders withSpinner
-areamapUI = function(id, country){
+areamapUI <- function(id, country){
ns = shiny::NS(id)
message("areamapUI")
tagList(
@@ -162,7 +203,7 @@ mod_ind_country_server <- function(input, output, session, data, data2, country
output$ind_from_nth_case<- renderText({
HTML(paste(
message_missing_data("Recovered and Tests",where = "most of Cantons"),
- message_firstday(nn),
+ #message_firstday(nn),
message_hosp_data(where = "Cantons"), sep = "
"))
})
@@ -188,7 +229,7 @@ mod_ind_country_server <- function(input, output, session, data, data2, country
# country_data_today <- country_data %>%
# filter(date == max(date))
- vaxflag = sum(country_data_today$vaccines, na.rm = TRUE) > 0
+ vaxflag = check_flag(country_data, "vaccines")
message("vaxflag = ", vaxflag)
vaxarg = NULL
if (vaxflag)
@@ -270,31 +311,107 @@ mod_ind_country_server <- function(input, output, session, data, data2, country
select(Country.Region) %>%
distinct() %>% .$Country.Region
- output$ind_subarea <- renderUI({
- areaUI(ns("ind_country_subarea"), tab = FALSE, stringency = FALSE, vaxflag = FALSE)
- #areaUI("ind_country_subarea")
- })
+ # output$ind_subarea <- renderUI({
+ # areaUI(ns("ind_country_subarea"), tab = FALSE, stringency = FALSE, vaxflag = FALSE)
+ # #areaUI("ind_country_subarea")
+ # })
+ output$ind_missing_days_area2 <- renderText({
+ HTML(
+ message_missing_country_days(area_data_2)
+ )})
- callModule(mod_country_area_server, "ind_country_subarea", data = area_data_2_aggregate, n2 = 10, tab = FALSE, hospitalFlag = FALSE, stringencyFlag = FALSE, vaccinesFlag = FALSE, country = "Switzerland")
+ n2 <- 10
+ # callModule(mod_country_area_server, "ind_country_subarea", data = area_data_2_aggregate, n2 = n2, tab = FALSE, hospitalFlag = FALSE, stringencyFlag = FALSE, vaccinesFlag = FALSE, country = "Switzerland")
+ testsflag = check_flag(area_data_2_aggregate, "tests")
- # callModule(mod_scatterplot_server, "scatterplot_plots_canton",
- # area_data_2_aggregate_today, nmed = 10, n_highlight = length(areas),
- # istop = FALSE, countries = areas, xvar = "vaccines_rate_pop", growth = FALSE, fitted = FALSE)
- #
- # callModule(mod_barplot_server, "barplot_vax_index_canton", area_data_2_aggregate_today,
- # n_highlight = length(areas), istop = FALSE,
- # plottitle = c("Vaccinations"),
- # g_palette = list("plot_1" = barplots_colors$vaccines$calc,
- # calc = TRUE),
- # pickvariable = list("plot_1" = "lm_confirmed_rate_1M_pop"))
-
- callModule(mod_group_plot_server, "ind_country_hosp", data_today = area_data_2_aggregate_today, nn = 10, type = "hosp", istop = FALSE,
+ # confirmed session
+ relevant_countries = unique(area_data_2_aggregate_today$Country.Region[area_data_2_aggregate_today$confirmed>n2])
+
+ callModule(mod_group_plot_server, "ind_country_confirmed_2", area_data_2_aggregate_today, type = "confirmed", istop = FALSE,
+ # scatterplotargs = list(nmed = n2, countries = relevant_countries),
+ tests = testsflag,
scatterplotargs = list(nmed = 10),
barplotargs = list(pickvariable = list("plot_1" = "lm_confirmed_rate_1M_pop")))
- callModule(mod_group_plot_server, "ind_country_vax", data_today = area_data_2_aggregate_today, nn = 10, type = "vaccines", istop = FALSE,
- scatterplotargs = list(nmed = 10),
+ levs <- areaplot_vars()
+ data_area = area_data_2
+ active_hosp = FALSE
+ hospflag = FALSE
+ if (sum(data$hosp, na.rm = TRUE)>0) {
+ message("Adding hospitalised data for areaplot")
+ levs = c(levs, "hosp")
+ active_hosp = TRUE
+ hospflag = TRUE
+ }
+ oneMpopflag = check_flag(area_data_2, "population")
+
+ # relevant_countries = unique(data_area$Country.Region[data_area$confirmed>n2])
+ df_area_2 = purrr::map(relevant_countries,
+ function(un) {
+ dat = tsdata_areplot(area_data_2[area_data_2$Country.Region == un, ], levs, nn = n2) #n = 0 for area plot
+ dat$Country.Region = rep(un, nrow(dat))
+ dat
+ })
+ df_area_2 = Reduce("rbind",df_area_2)
+
+
+ areas <- #reactive({
+ area_data_2 %>%
+ select(Country.Region) %>%
+ distinct() #%>% .$Country.Region
+
+ callModule(mod_plot_log_linear_server, "plot_ind_area2", df = df_area_2, type = "area" , countries = reactive(areas), active_hosp = active_hosp)
+
+
+ levs <- areaplot_hospvars()
+ #
+ #relevant_countries = unique(data_area$Country.Region[data_area$confirmed>1])
+ #
+ df_area_2 = purrr::map(relevant_countries,
+ function(un) {
+ dat = tsdata_areplot(area_data_2[area_data_2$Country.Region == un, ], levs, nn = 1) #n = 0 for area plot hosp, do not filter
+ dat$Country.Region = rep(un, nrow(dat))
+ dat
+ })
+ df_area_2 = Reduce("rbind",df_area_2)
+
+ callModule(mod_plot_log_linear_server, "plot_areahosp2_ind_area2", df = df_area_2, type = "area" , countries = reactive(areas), hosp = TRUE)
+
+
+
+ strFlag = check_flag(area_data_2_aggregate, "stringency_index")
+ # # do not use stringency v is the same for all areas
+
+ vaxFlag = check_flag(area_data_2_aggregate, "vaccines")
+ # do not use vax is the same for all areas
+
+ message("hospflag: ", hospflag, "/ oneMpopflag: ", oneMpopflag,"/ strFlag: ", strFlag,"/ testsflag: ", testsflag, "/ vaxFlag: ", vaxFlag)
+
+ # paste0("lines_plots_area2_",country) because of problems with selectInputID after USA page. not solved, TBD
+ output[["plot_compare_nth_ind_area2"]] <- renderUI({
+ mod_compare_nth_cases_plot_ui(ns(paste0("lines_plots_ind_area2_",country)), vars = setdiff(.vars_nthcases_plot, prefix_var(.hosp_vars, c("", "new"))),
+ nn = n2, istop = FALSE, tests = testsflag, hosp = FALSE, strindx = strFlag,vax = vaxFlag, selectvar = "new_confirmed", oneMpop = oneMpopflag, areasearch = TRUE)
+ })
+
+ callModule(mod_compare_nth_cases_plot_server, paste0("lines_plots_ind_area2_",country), df = area_data_2_aggregate, nn = n2, istop = FALSE, tests = testsflag, hosp = FALSE, strindx = strFlag ,vax = vaxFlag,
+ n_highlight = length(unique(area_data_2_aggregate$Country.Region)), oneMpop = oneMpopflag, areasearch = TRUE,
+ vars = setdiff(.vars_nthcases_plot, prefix_var(.hosp_vars, c("", "new"))))
+
+ output[["plot_compare_hosp_nth_ind_area2"]] <- renderUI({
+ mod_compare_nth_cases_plot_ui(ns(paste0("lines_plots_hosp_ind_area2_",country)), vars = intersect(.vars_nthcases_plot, prefix_var(.hosp_vars, c("", "new"))),
+ nn = n2, istop = FALSE, tests = FALSE, hosp = hospflag, strindx = FALSE,vax = vaxFlag, selectvar = "new_hosp", oneMpop = oneMpopflag, areasearch = TRUE)
+ })
+ callModule(mod_compare_nth_cases_plot_server, paste0("lines_plots_hosp_ind_area2_",country), df = area_data_2_aggregate, nn = n2, istop = FALSE, tests = FALSE, hosp = hospflag, strindx = FALSE ,vax = vaxFlag,
+ n_highlight = length(unique(area_data_2_aggregate$Country.Region)), oneMpop = oneMpopflag, areasearch = TRUE,
+ vars = intersect(.vars_nthcases_plot, prefix_var(.hosp_vars, c("", "new"))))
+
+ callModule(mod_group_plot_server, "ind_country_hosp_2", data_today = area_data_2_aggregate_today, nn = n2, type = "hosp", istop = FALSE,
+ scatterplotargs = list(nmed = n2),
+ barplotargs = list(pickvariable = list("plot_1" = "lm_confirmed_rate_1M_pop")))
+
+ callModule(mod_group_plot_server, "ind_country_vax_2", data_today = area_data_2_aggregate_today, nn = n2, type = "vaccines", istop = FALSE,
+ scatterplotargs = list(nmed = n2),
barplotargs = list(pickvariable = list("plot_1" = "lm_confirmed_rate_1M_pop")))
@@ -341,14 +458,14 @@ mod_country_area_maps_server <- function(input, output, session, data, country){
}
spmap
}
- getmap <- function(country) {
+ .getmap <- function(country) {
if (country == "Switzerland")
area2_data_map = leaflet::gadmCHE
else
stop("Map for ", country, " not available")
.adjustmap(area2_data_map, country)
}
- area2_map = getmap(country)
+ area2_map = .getmap(country)
message("process at level 2 individual country ", country)
# Data ----
@@ -372,9 +489,7 @@ mod_country_area_maps_server <- function(input, output, session, data, country){
callModule(mod_map_area_calc_server, "map_ind_confirmed", df = data_maps, area2_map,
area = country, variable = "confirmed", max.pop = 0, countrymap = TRUE)
- #maps active
- # callModule(mod_map_area_calc_server, "map_ind_active", df = data_maps, area2_map,
- # area = country, variable = "active", max.pop = 0, countrymap = TRUE)
+ #maps vaccines
callModule(mod_map_area_calc_server, "map_ind_vaccines", df = data_maps, area2_map,
area = country, variable = "vaccines", max.pop = 0, countrymap = TRUE)
@@ -383,8 +498,6 @@ mod_country_area_maps_server <- function(input, output, session, data, country){
area = country, variable = "growth vs prev", max.pop = 0, countrymap = TRUE)
#maps prevalence
- # callModule(mod_map_area_calc_server, "map_ind_prev", df = data_maps, area2_map,
- # area = country, variable = "prevalence rate", max.pop = 0, countrymap = TRUE)
callModule(mod_map_area_calc_server, "map_ind_growth", df = data_maps, area2_map,
area = country, variable = "growth factor", max.pop = 0, countrymap = TRUE)
diff --git a/R/mod_mod_country_hosp.R b/R/mod_mod_country_hosp.R
index c2b5f5a8..b17f7e25 100644
--- a/R/mod_mod_country_hosp.R
+++ b/R/mod_mod_country_hosp.R
@@ -24,7 +24,7 @@ mod_mod_country_hosp_ui <- function(id){
),
column(6,
- div(h4("Time evolution of Hospitalised cases"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
+ div(h4("Evolution over time of Hospitalizations"), align = "center", style = "margin-top:20px; margin-bottom:20px;"),
#withSpinner(uiOutput(ns("plot_areahosp_area2")))
withSpinner(mod_plot_log_linear_ui(ns("plot_areahosp2_area2"), select = TRUE, area = TRUE))
diff --git a/R/mod_plot_log_linear.R b/R/mod_plot_log_linear.R
index a3bce540..f94ef52e 100644
--- a/R/mod_plot_log_linear.R
+++ b/R/mod_plot_log_linear.R
@@ -15,20 +15,29 @@ mod_plot_log_linear_ui <- function(id, select = FALSE, area = TRUE){
if (!select && (!area)) {
# linear plot
tagList(
- div(class = "plottext", radioButtons(inputId = ns("radio_log_linear"), label = "",
- choices = c("Log Scale" = "log", "Linear Scale" = "linear"), selected = "linear", inline = TRUE)),
- withSpinner(plotlyOutput(ns("plot_log_linear"), height = 500))#,
+ fluidRow(
+ div(class = "plottext", align = "center",
+ radioButtons(inputId = ns("radio_log_linear"), label = "",
+ choices = c("Log Scale" = "log", "Linear Scale" = "linear"), selected = "linear", inline = TRUE))
+ ),
+ fluidRow(
+ withSpinner(plotlyOutput(ns("plot_log_linear"), height = 500))#,
+ )
)
} else if (!select && (area)){
# global page
- tagList(
+ fluidRow(
withSpinner(plotlyOutput(ns("plot_area"), height = 500))#,
)
} else if (select && (area)) {
# country page
tagList(
- uiOutput(ns("select_area_ui")),
- withSpinner(plotlyOutput(ns("plot_area_select"), height = 450))#,
+ fluidRow(
+ uiOutput(ns("select_area_ui"))
+ ),
+ fluidRow(
+ withSpinner(plotlyOutput(ns("plot_area_select"), height = 450))#,
+ )
)
} else {
stop("wrong selection in mod_plot_log_linear_ui")
diff --git a/R/mod_scatterplot.R b/R/mod_scatterplot.R
index 6650290e..3a705e6e 100644
--- a/R/mod_scatterplot.R
+++ b/R/mod_scatterplot.R
@@ -71,8 +71,8 @@ mod_scatterplot_ui <- function(id, growth = TRUE, varsx = NULL, varsy = NULL, ho
} else
varsx = varsx
tagList(
- div(HTML(test_sc), class = "bodytextplot"),
div(htmlOutput(ns("title_scatterplot")), class = "plottitle", align = "center"),
+ div(HTML(test_sc), class = "bodytextplot"),
fluidRow(
column(6,
div(selectInput(inputId = ns("yvar"), label = varsy$label,
@@ -83,8 +83,9 @@ mod_scatterplot_ui <- function(id, growth = TRUE, varsx = NULL, varsy = NULL, ho
choices = varsx$choices,
selected = varsx$selected), class = "plottext"))
),
-
- withSpinner(plotlyOutput(ns("plot_scatterplot_xy"), height = 400)),
+ fluidRow(
+ withSpinner(plotlyOutput(ns("plot_scatterplot_xy"), height = 400)),
+ ),
div(htmlOutput(ns("caption")), align = "center", height = 10, class = "plottext")
)
@@ -100,21 +101,23 @@ mod_scatterplot_ui <- function(id, growth = TRUE, varsx = NULL, varsy = NULL, ho
} else
varsy = varsy
tagList(
- div(HTML(test_sc), class = "bodytextplot"),
div(htmlOutput(ns("title_scatterplot")), class = "plottitle", align = "center"),
+ div(HTML(test_sc), class = "bodytextplot"),
fluidRow(
column(6, #offset = 6,
div(selectInput(inputId = ns("yvar"), label = varsy$label,
choices = varsy$choices,
selected = varsy$selected), class = "plottext"))
),
- withSpinner(plotlyOutput(ns("plot_scatterplot_xy"), height = 400)),
+ fluidRow(
+ withSpinner(plotlyOutput(ns("plot_scatterplot_xy"), height = 400)),
+ ),
div(htmlOutput(ns("caption")), align = "center", height = 10, class = "plottext")
)
}
}
-#' Scatterplot prevalence vs growth
+#' Scatter plot prevalence vs growth
#'
#' @param df data.frame for multiple countries
#' @param nmed number of cases of countries to be used for median computation
diff --git a/R/mod_stackedbarplot_status.R b/R/mod_stackedbarplot_status.R
index 669f2e00..1ae09282 100644
--- a/R/mod_stackedbarplot_status.R
+++ b/R/mod_stackedbarplot_status.R
@@ -11,9 +11,9 @@
#' @noRd
mod_stackedbarplot_ui <- function(id){
ns <- NS(id)
- caption_explain <- "The plot shows what areas have more to recover from their Confirmed cases. Not all of them may have provided Recovered or Hospitalised cases"
+ caption_explain <- "The plot shows what areas have more to recover from their Confirmed cases. Not all of them may have provided Recoveries or Hospitalizations"
- tagList(
+ fluidRow(
div(htmlOutput(ns("title_stackedbarplot_status")), align = "center", class = "plottitle"),
withSpinner(plotlyOutput(ns("plot_stackedbarplot_status"), height = 500)),
diff --git a/R/mode_group_plots_server.R b/R/mode_group_plots_server.R
index d913f1ca..16961818 100644
--- a/R/mode_group_plots_server.R
+++ b/R/mode_group_plots_server.R
@@ -5,7 +5,7 @@
timeline_info <- function(sep = "
", hosp = TRUE, country = "the world") {
#tags$p(
paste(paste0("Check how indicators developed over time for ",country,". 3 main type of plots are proposed: (1) area plot for confirmed infections",
- ifelse(hosp, ", area plot of hospitalised an ICU admisions", ""), ", (2) time line of each single variable from \"start\", \"6 months\" and \"1 month\" ago, (3) calendar comparison for the \"full year\" or for the \"last month\".
+ ifelse(hosp, ", area plot of hospitalized an ICU admisions", ""), ", (2) time line of each single variable from \"start\", \"6 months\" and \"1 month\" ago, (3) calendar comparison for the \"full year\" or for the \"last month\".
Change \"Select View\" to \"Timeline per calendar year\" to see the years' comparison."),
sep = sep)
#)
@@ -68,10 +68,10 @@ hosp_info <- function(sep = "
") {
#' @param tit logical, print title
section_title <- function(type, tit) {
text = switch(type,
- "confirmed" = "Confirmed infections",
+ "confirmed" = "COVID-19 main variables",
"stringency" = "Stringency Lock-Down Index",
"vaccines" = "Vaccination status",
- "hosp" = "Hospitalization",
+ "hosp" = "Hospitalizations and Intensive Care Units",
"")
if (tit)
div(hr(), text, align = "center", class = "sectiontitle")
@@ -120,21 +120,22 @@ mod_group_plot_ui <- function(id, type = c("vaccines", "stringency", "confirmed"
"keep")
}
- tagList(
+ fluidPage(
section_title(type, titlesection),
br(),
# conditionalPanel(
# condition = "infotext == 'TRUE'",
- fluidRow(
- column(12,
- div(
- HTML(section_info(type, infotext)), class = "bodytext"),
- htmlOutput(ns(paste0("text_report_", type))),
-
- )
- #)
+ fluidRow(
+ # column(12,
+ div(
+ HTML(section_info(type, infotext)), class = "bodytext")#,
+ #htmlOutput(ns(paste0("text_report_", type))), class = "bodytext")#,
),
- br(),
+ fluidRow(
+ #div(
+ htmlOutput(ns(paste0("text_report_", type)))#, class = "bodytext")
+ ),
+ #br(),
fluidRow(
column(6,
mod_scatterplot_ui(ns(paste0("scatterplot_", type)), growth = growth, hospvars = hosp_vars(type), text = TRUE)
@@ -218,7 +219,7 @@ mod_group_plot_server <- function(input, output, session, data_today , nn = 1,
report_var = gsub("_rate_1M_pop$","", report_var)
}
- text_lw_report_fun <- function(data, var, n = 5) {
+ .text_lw_report_fun <- function(data, var, n = 5) {
aod = max(data$AsOfDate)
n.countries = length(unique(data$Country.Region))
if (n < n.countries) {
@@ -286,7 +287,7 @@ mod_group_plot_server <- function(input, output, session, data_today , nn = 1,
}
output[[paste0("text_report_", type)]] <- #renderUI({
renderUI({
- text_lw_report_fun(data_today, report_var)
+ .text_lw_report_fun(data_today, report_var)
})
callModule(mod_scatterplot_server, paste0("scatterplot_", type),
@@ -295,8 +296,8 @@ mod_group_plot_server <- function(input, output, session, data_today , nn = 1,
barplottitle <- ifelse(type == "vaccines", "Vaccine Doses",
ifelse(type == "stringency","Stringency Index",
- ifelse(type == "confirmed", "Confirmed Cases",
- ifelse(type == "hosp", "Hospitalised / ICU Cases",
+ ifelse(type == "confirmed", "Confirmed Infections and Tests",
+ ifelse(type == "hosp", "Hospitalized / ICU",
stop("wrong type argument")))))
sortbyvar = ifelse(is.null(barplotargs[["sortbyvar"]]), TRUE, barplotargs[["sortbyvar"]])
diff --git a/R/utils.R b/R/utils.R
index 17e56897..ce47948b 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -506,7 +506,7 @@ clean_plotly_leg <- function(.plotly_x, .extract_str) {
#'
#' @importFrom rlang sym
#' @export
-aggr_to_cont = function(data, group, time,
+aggr_to_cont <- function(data, group, time,
allstatuses = intersect(get_aggrvars(), names(data))) {
aggrvars = setdiff(intersect(get_aggrvars(), names(data)), "population")
@@ -514,6 +514,7 @@ aggr_to_cont = function(data, group, time,
select(Country.Region, population, contagion_day, date, !!group, date, !!allstatuses) %>%
mutate(population = as.numeric(population)) %>%
group_by(.dots = c(time,group)) %>%
+ #group_by(across(all_of(time,group))) %>%
summarise_at(c(allstatuses), sum, na.rm = TRUE) %>%
#add_growth_death_rate(group, time) %>%
#left_join(popdata_cont[,c(group, "population")], by = group) %>% #TODO: why left_join not earlier?
@@ -594,7 +595,7 @@ tsdata_areplot <- function(data, levs, nn = 1000) {
mutate(status = factor(status, levels = levs)) %>%
capitalize_names_df()
}
-#' creates message of countries within subcountries
+#' creates message of countries within sub countries
#' @param data data.frame aggregated data per region
#' @param area character main area
#' @param region character sub area
@@ -604,10 +605,11 @@ tsdata_areplot <- function(data, levs, nn = 1000) {
message_subcountries <- function(data, area, region) {
# remove where subcontinent could be NA
list.countries = data[,c(area,region)] %>% filter(!is.na(!!rlang::sym(area))) %>% unique() %>%
+ #group_by(across(all_of(area))) %>%
group_by(.dots = area) %>% group_split()
list.message = lapply(list.countries, function(x)
paste0("",as.character(unique(x[[area]])),": ",
- paste(x[[region]], collapse = ",")))
+ paste(x[[region]], collapse = ", ")))
c("Continent Area composition: ", list.message)
}
#' Calculates growth vs prevalence, growth vs stringency factors
@@ -1009,7 +1011,7 @@ message_conf_case = function(where = "Countries", ncases = 1000, suffix = "can b
#'
#' @return character vector
#'
-message_firstday = function(ncases, var = "confirmed") {
+message_firstday <- function(ncases, var = "confirmed") {
paste("1st day is the day when", ncases ,var, "cases are reached.")
}
#'Message text, missing data
@@ -1018,7 +1020,7 @@ message_firstday = function(ncases, var = "confirmed") {
#'
#' @return character vector
#'
-message_missing_data = function(what = "Recovered, Hospitalised and Tests", where = "some countries and areas") {
+message_missing_data <- function(what = "Recovered, Hospitalized and Tests", where = "some countries and areas") {
paste(what, "data can be partially/completely unavailable in our data source for",where, ".")
}
@@ -1107,7 +1109,7 @@ message_missing_recovered = function(what = "Recovered", where = "Some countries
#'
#' @return character vector
#'
-message_hosp_data = function(what = "Hospitalised, Vaccine doses and Test", where = "some countries and areas", suffix = "where available") {
+message_hosp_data <- function(what = "Hospitalized, Vaccine doses and Test", where = "some countries and areas", suffix = "where available") {
paste(what, "data are updated with delay for", where, "in our data source", suffix, ".")
}
#' Color Palette for simple barplots
@@ -1142,3 +1144,17 @@ barplots_colors <- list(
"calc" = c(col = "Reds", rev = TRUE, skip = 2)
)
)
+
+#' Check whether data are available
+#' @param data data.frame
+#' @param var character string, variable name
+#'
+#' @return logical
+#' @noRd
+check_flag <- function(data, var) {
+ Flag = TRUE
+ # do not use stringency v is the same for all areas
+ if (all(is.na(data[[var]])) || all(data[[var]] == 0, na.rm = TRUE) || length(table(data[[var]])) == 1)
+ Flag = FALSE
+ Flag
+}
diff --git a/inst/app/www/style.css b/inst/app/www/style.css
index 3b2fc70e..4e775653 100644
--- a/inst/app/www/style.css
+++ b/inst/app/www/style.css
@@ -169,8 +169,9 @@ ul.bodytextplot {
font-family: Arial, sans-serif;
font-size: 11px;
color: black;
- margin-left: 2em;
- margin-right:2em;
+ margin-left: 1.5em;
+ margin-right: 1.5em;
+ margin-bottom: 1em;
padding: 1em 2em 1em 2px";
}
@@ -179,8 +180,9 @@ ul.bodytextplot {
font-family: Arial, sans-serif;
font-size: 12px;
color: black;
- margin-left: 1.5em;
- margin-right:1.5em;
+ margin-left: 1em;
+ margin-right: 1em;
+ margin-bottom: 2em;
padding: 1em 2em 1em 2px";
align-content: center;
}
@@ -197,7 +199,9 @@ ul.bodytextplot {
background-color: #fff;
font-family: Arial, sans-serif;
font-size: 10px;
- color: black;<
+ color: black;
+ padding: 0em;
+ padding-left: 1em;
}
.plottitle {
@@ -243,18 +247,32 @@ input[type=checkbox], input[type=radio] {
.navbar {
margin-left: 0em;
margin-right: 0em;
+ padding: 1em;
+ padding-left: 0.5em;
+/*
+ padding: 5px;
+ padding-left: 2px;
+ */
}
/* tabsetPanel style */
.nav-tabs {
border-bottom: 1px solid #FF9966;
+ padding: 1em;
+ padding-left: 0.5em;
/*
+ padding: 5px;
+ padding-left: 2px
border-bottom: 0 solid #008cc3;
*/
}
.tab-content {
- padding: 10px;
+ padding: 1em;
+ padding-left: 0.5em;
+ padding-top: 1em;
+/* 10px;
+ padding: 5px;
+ padding-left: 2px
padding-top: 15px;
-/*
padding: 6px 12px;
border: 1px solid #008cc3;
border-radius: 3px;
@@ -263,9 +281,10 @@ input[type=checkbox], input[type=radio] {
*/
}
.tabbable > .nav > li > a {
- margin-left: 20px;
+ margin-left: 1em;
min-width: 100px;
/*
+ margin-left: 20px;
font-size: 13px;
font-weight: bold;
background-color: white;
diff --git a/inst/datahub/DATA.rds b/inst/datahub/DATA.rds
index e42126fe..ac994287 100644
Binary files a/inst/datahub/DATA.rds and b/inst/datahub/DATA.rds differ
diff --git a/inst/datahub/Selected_Country.rds b/inst/datahub/Selected_Country.rds
index bff941a9..b0422b64 100644
Binary files a/inst/datahub/Selected_Country.rds and b/inst/datahub/Selected_Country.rds differ
diff --git a/inst/datahub/Top_Countries.rds b/inst/datahub/Top_Countries.rds
new file mode 100644
index 00000000..1149f6e1
Binary files /dev/null and b/inst/datahub/Top_Countries.rds differ
diff --git a/man-roxygen/ex-individual_country.R b/man-roxygen/ex-individual_country.R
index 5ff88992..a5b44507 100644
--- a/man-roxygen/ex-individual_country.R
+++ b/man-roxygen/ex-individual_country.R
@@ -9,8 +9,11 @@ if (interactive()) {
country = "Switzerland"
- orig_data <- get_datahub(country = country) %>%
- get_timeseries_by_contagion_day_data()
+ rds_data = "DATA.rds"
+ orig_data_with_ch = readRDS(file = file.path(system.file("./datahub", package = "Covid19Mirai"),rds_data))
+
+ orig_data = orig_data_with_ch$orig_data
+ orig_data_ch_2 = orig_data_with_ch$orig_data_ch_2
pop_data = get_pop_datahub()
orig_data_aggregate = build_data_aggr(orig_data, pop_data)
@@ -18,18 +21,18 @@ if (interactive()) {
orig_data_aggregate = orig_data_aggregate %>% filter(Country.Region == country)
n = 100; w = 7
- data_filtered <-
- orig_data_aggregate %>%
- Covid19Mirai:::rescale_df_contagion(n = n, w = w)
-
- countries <- reactive({
- data_filtered %>%
- select(Country.Region) %>%
- distinct()
- })
+ # data_filtered <-
+ # orig_data_aggregate %>%
+ # Covid19Mirai:::rescale_df_contagion(n = n, w = w)
+ #
+ # countries <- reactive({
+ # data_filtered %>%
+ # select(Country.Region) %>%
+ # distinct()
+ # })
callModule(mod_ind_country_server, "ind_country",
- data = data_filtered, country = country, nn = n, w = w)
+ data = orig_data_aggregate, data2 = orig_data_ch_2, country = country, nn = n, w = w)
}
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 acc52861..cb5d67f2 100644
--- a/man-roxygen/ex-mod_compare_nth_cases_plot.R
+++ b/man-roxygen/ex-mod_compare_nth_cases_plot.R
@@ -105,6 +105,8 @@ if (interactive()) {
orig_data <- get_datahub(country = "USA", lev = 2) %>%
get_timeseries_by_contagion_day_data()
+ # selected_country_data <- readRDS(system.file("datahub/Selected_Country.rds", package = "Covid19Mirai"))$area_data_2
+
#pop_data = get_pop_datahub()
#orig_data_aggregate = build_data_aggr(orig_data, pop_data)
orig_data_aggregate = build_data_aggr(orig_data)
diff --git a/man-roxygen/ex-mod_growth_death_rate.R b/man-roxygen/ex-mod_growth_death_rate.R
index 51419fac..3f085e47 100644
--- a/man-roxygen/ex-mod_growth_death_rate.R
+++ b/man-roxygen/ex-mod_growth_death_rate.R
@@ -209,7 +209,7 @@ if (interactive()) {
"plot_2" = barplots_colors$hosp$uniform,
calc = FALSE),
#pickvariable = list("plot_1" = "confirmed_rate_1M_pop","plot_2" = "hosp_rate_1M_pop"),
- plottitle = c("Confirmed positive cases per area", "Hospitalised and Intensive Care per area")
+ plottitle = c("Confirmed positive cases per area", "Hospitalized and Intensive Care per area")
#pickvariable = list("plot_1" = "confirmed")
)
diff --git a/man-roxygen/ex-plot_log_linear.R b/man-roxygen/ex-plot_log_linear.R
index e68e6f49..7f1401a0 100644
--- a/man-roxygen/ex-plot_log_linear.R
+++ b/man-roxygen/ex-plot_log_linear.R
@@ -3,21 +3,19 @@ if (interactive()) {
long_title <- "Lorem ipsum dolor sit amet, consectetur adipisicing elit."
ui <- fluidPage(
- Covid19Mirai:::mod_plot_log_linear_ui("test", select = FALSE, area = FALSE)
+ mod_plot_log_linear_ui("test", select = FALSE, area = FALSE)
)
server <- function(input, output) {
# Data ----
orig_data <- readRDS(system.file("datahub/DATA.rds", package = "Covid19Mirai"))$orig_data
-
n = 100
w = 7
data_filtered <-
orig_data %>%
Covid19Mirai:::rescale_df_contagion(n = n, w = w)
-
country_data <- reactive({data_filtered %>%
filter(Country.Region %in% "Switzerland") %>%
filter(contagion_day > 0) %>%
diff --git a/man/get_datahub.Rd b/man/get_datahub.Rd
index d8a7b574..2aa05e38 100644
--- a/man/get_datahub.Rd
+++ b/man/get_datahub.Rd
@@ -1,11 +1,13 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/get_data.R
-\name{get_datahub_fix_ch}
-\alias{get_datahub_fix_ch}
+% Please edit documentation in R/build_data.R, R/get_data.R
+\name{build_data}
\alias{build_data}
+\alias{get_datahub_fix_ch}
\alias{get_datahub}
-\title{Get timeseries full data from datahub adding CH hospitalised data from level 2}
+\title{Build data in GutHub action yml and save as RDS}
\usage{
+build_data()
+
get_datahub_fix_ch(
country = NULL,
startdate = "2020-01-22",
@@ -13,14 +15,13 @@ get_datahub_fix_ch(
verbose = FALSE
)
-build_data()
-
get_datahub(
country = NULL,
startdate = "2020-01-22",
lev = 1,
verbose = FALSE,
- hosp = TRUE
+ hosp = TRUE,
+ cache = FALSE
)
}
\arguments{
@@ -28,11 +29,13 @@ get_datahub(
\item{startdate}{character staring date}
-\item{lev}{integer 1 for country level, 2 for reagions}
+\item{lev}{integer 1 for country level, 2 for regions}
\item{verbose}{logical. Print data sources? Default FALSE (opposite from \code{covid19})}
-\item{hosp}{logical. If TRUE hospitalised detailed data are retrieved. Default TRUE since release 2.3.1}
+\item{hosp}{logical. If TRUE hospitalized detailed data are retrieved. Default TRUE since release 2.3.1}
+
+\item{cache}{logical. If TRUE cache argument is used in the covid19() call}
}
\value{
data tibble of confirmed, deaths, active and recovered etc Country.Region
@@ -40,10 +43,10 @@ data tibble of confirmed, deaths, active and recovered etc Country.Region
data tibble of confirmed, deaths, active and recovered Country.Region
}
\description{
-Get timeseries full data from datahub adding CH hospitalised data from level 2
-
Build data in GutHub action yml and save as RDS
+Get timeseries full data from datahub adding CH hospitalised data from level 2
+
Get timeseries full data from datahub
}
\details{
diff --git a/man/message_hosp_data.Rd b/man/message_hosp_data.Rd
index 5036a900..95067091 100644
--- a/man/message_hosp_data.Rd
+++ b/man/message_hosp_data.Rd
@@ -5,7 +5,7 @@
\title{Message text, missing data}
\usage{
message_hosp_data(
- what = "Hospitalised, Vaccine doses and Test",
+ what = "Hospitalized, Vaccine doses and Test",
where = "some countries and areas",
suffix = "where available"
)
diff --git a/man/message_missing_data.Rd b/man/message_missing_data.Rd
index 8cef5e3c..ece3db38 100644
--- a/man/message_missing_data.Rd
+++ b/man/message_missing_data.Rd
@@ -5,7 +5,7 @@
\title{Message text, missing data}
\usage{
message_missing_data(
- what = "Recovered, Hospitalised and Tests",
+ what = "Recovered, Hospitalized and Tests",
where = "some countries and areas"
)
}
diff --git a/man/message_subcountries.Rd b/man/message_subcountries.Rd
index 41154827..774fd539 100644
--- a/man/message_subcountries.Rd
+++ b/man/message_subcountries.Rd
@@ -2,7 +2,7 @@
% Please edit documentation in R/utils.R
\name{message_subcountries}
\alias{message_subcountries}
-\title{creates message of countries within subcountries}
+\title{creates message of countries within sub countries}
\usage{
message_subcountries(data, area, region)
}
@@ -17,5 +17,5 @@ message_subcountries(data, area, region)
list messages printing Country.Region within subcontinent
}
\description{
-creates message of countries within subcountries
+creates message of countries within sub countries
}