diff --git a/.Rproj.user/shared/notebooks/paths b/.Rproj.user/shared/notebooks/paths index c01ff55..8fde1c5 100644 --- a/.Rproj.user/shared/notebooks/paths +++ b/.Rproj.user/shared/notebooks/paths @@ -1,3 +1,4 @@ + C:/Users/solis/Documents/GitHub/dashdash/DESCRIPTION="71D0336F" C:/Users/solis/Documents/GitHub/dashdash/R/dashdash.R="D09FA657" C:/Users/solis/Documents/GitHub/dashdash/R/plot_aggregates.R="F9FC11BC" @@ -8,3 +9,4 @@ C:/Users/solis/Documents/GitHub/dashdash/inst/rmd/child.Rmd="74162286" C:/Users/solis/Documents/GitHub/dashdash/inst/rmd/dashdash.Rmd="13378A8A" C:/Users/solis/Dropbox/COVID-19 data/nigeria_dashboard.Rmd="A22E330E" C:/Users/solis/Dropbox/KCCA_dashboard/kcca_dashboard.Rmd="50A12C49" + diff --git a/DESCRIPTION b/DESCRIPTION index e1487d5..564f38e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,6 +25,9 @@ Depends: magrittr, maptools, tidyselect, + table1, + checkmate, + gridExtra, data.table, checkmate, zoo diff --git a/NAMESPACE b/NAMESPACE index 82e3457..f13763f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,6 +7,7 @@ export(plot_aggregates) export(plot_d_mov_avg) export(plot_disaggregates) export(plot_mov_avg) +export(plot_disaggregates_row) export(summary_table) importFrom(dplyr,filter) importFrom(dplyr,mutate) diff --git a/R/plot_disaggregates.R b/R/plot_disaggregates.R index 6a53630..baff157 100644 --- a/R/plot_disaggregates.R +++ b/R/plot_disaggregates.R @@ -2,10 +2,100 @@ #' #' #' @param df dataframe +#' @num number of ids #' @param my_vars df with info about variables #' @param pd ggplot dodge parameter #' @export +row_function <- function(num) { + num <- as.integer(num) + if (num > 8){ + row <- ceiling(num/8) + }else { + row <- 1 + } + return(row) +} + +# convert some vars to factor vars +factorize_vars <- function(df, my_vars){ + vars_vec <- names(df) %in% my_vars$variable + factor_vars <- c() + for(i in 1:length(vars_vec)){ + if(vars_vec[i] == T && as.logical(my_vars[my_vars$variable == names(df)[i],]$factor)){ + factor_vars[i] = T + }else{ + factor_vars[i] = F + } + } + # convert to factor vars + df[, factor_vars] <- lapply(df[, factor_vars], factor) + # extract labels of all factor vars + factor_label <- my_vars[my_vars$variable %in% names(df[, factor_vars]), ]$label + # extract factor vars name + factor_var_name <- names(df)[factor_vars] + # change levels of each factor var + for(i in 1:length(factor_var_name)){ + levels(df[[factor_var_name[i]]]) <- unlist(strsplit(factor_label[i], ",")) + } + + return(df) +} + + + +plot_disaggregates_row <- function(df, my_vars, pd = ggplot2::position_dodge(.1), switch = "y", nrow = NULL){ + + # fac_var <- as.logical(my_vars$factor) + vars <- pull(my_vars, variable) + var_labs <- my_vars %>% pull(short_label) + names(var_labs) <- vars + + # Gather mins amd maxs + ranges <- my_vars %>% select(one_of("variable", "min", "max")) + if(!("min" %in% names(ranges))) ranges$min <- NA + if(!("max" %in% names(ranges))) ranges$max <- NA + + # Reshape and bring in mins and maxs + df2 <- df %>% + select(all_of(c("id", "date", vars))) %>% + reshape2::melt(id.vars= c("id", "date")) %>% + group_by(id, date, variable) %>% + summarise_all(list(~mean(., na.rm = TRUE), ~sd(., na.rm = TRUE), n = ~gdata::nobs(.))) %>% + mutate(se = sd / sqrt(n), ymin=mean-1.96*se, ymax=mean+1.96*se) %>% + left_join(ranges) + + + # Row num for layout + if(is.null(nrow)){ + nrow <- row_function(length(unique(df2$id))) + row_id <- split(unique(df2$id), rep(seq(nrow), each = length(unique(df2$id)) /nrow)) + }else{ + row_id <- split(unique(df2$id), rep(seq(nrow), each = length(unique(df2$id)) /nrow)) + } + + # subplot to 4 parts + subplots <- list() + for(i in 1:nrow){ + subplots[[i]]<- + ggplot(data = df2[df2$id %in% row_id[[i]],], aes(x = date, y = mean)) + + geom_point(position=pd) + + geom_errorbar(aes(ymin=ymin, ymax=ymax), width=.1, position=pd) + + geom_line(position=pd) + + facet_grid(variable ~ id, scales = "free_y", + labeller = labeller(variable = var_labs), + switch = switch) + + theme(axis.text.x = element_text(angle = 90, hjust = 1), + strip.text.y.left = element_text(angle = 0)) + } + + # pass every subplot to grid.arrange, followed by nrow + g <- do.call(grid.arrange, c(subplots, list(nrow=nrow))) + + g +} + + plot_disaggregates <- function(df, my_vars, pd = ggplot2::position_dodge(.1), switch = "y"){ vars <- pull(my_vars, variable) diff --git a/docs/index.Rmd b/docs/index.Rmd index 1020e00..25a003c 100644 --- a/docs/index.Rmd +++ b/docs/index.Rmd @@ -112,7 +112,7 @@ my_args %>% kable(caption = "sample `my_args` dataframe") The dashboard is then produced by `dashdash::dashdash` like this: -```{r, message = FALSE, warning = FALSE, include = FALSE} +```{r, message = FALSE, warning = FALSE, include = FALSE, cache = FALSE} setwd("~/Documents/GitHub/dashdash/docs") wd <- getwd() diff --git a/docs/mexample/mex_vars.xlsx b/docs/mexample/mex_vars.xlsx index dba80de..749a09f 100644 Binary files a/docs/mexample/mex_vars.xlsx and b/docs/mexample/mex_vars.xlsx differ diff --git a/inst/rmd/child.Rmd b/inst/rmd/child.Rmd index 75d9f4c..d9526dc 100644 --- a/inst/rmd/child.Rmd +++ b/inst/rmd/child.Rmd @@ -54,8 +54,9 @@ plot_mov_avg(my_data, my_subset, pd = pd, switch = switch) ``` -```{r, eval=(daily|both), echo = FALSE, fig.cap="Disaggregated average responses for a given day (dot) with 95% confidence intervals (whiskers)", message = FALSE, warning = FALSE} -plot_disaggregates(my_data, my_subset, pd = pd, switch = switch) + +plot_disaggregates_row(my_data, my_subset, pd = pd, switch = switch) + ``` ```{r, eval=(mov_average|both), echo = FALSE, fig.cap="Disaggregated 3 day moving average with 95% confidence intervals", fig.height = nrow(my_subset)*1.42 + 1, message = FALSE, warning = FALSE}