diff --git a/R/validationHeatmap.R b/R/validationHeatmap.R index 0f17454..543670c 100644 --- a/R/validationHeatmap.R +++ b/R/validationHeatmap.R @@ -28,70 +28,101 @@ validationHeatmap <- function(df, x_facet = "model", y_facet = "scenario") { - # possible extension: when giving multiple vars, plot as facets in same row + # wip: when giving multiple vars, plot as facets in same row if (length(var) > 1) { - } + d <- df3 %>% + filter(.data$metric == met) + if (historical) { + d <- filter(d, ref_scenario == "historical") + plot_title <- paste0("Summary ", met, " (historical)") + } else { + d <- filter(d, (ref_scenario != "historical" | is.na(ref_scenario))) + plot_title <- paste0("Summary ", met) + } + + # gg tile plot using data along dimensions as given in function call + x_plot <- "scenario" + y_plot <- "variable" + p <- ggplot(d, aes(x = .data[[x_plot,]], + y = .data[[y_plot,]], + fill = score)) + + geom_tile(color="white", linewidth=0.0) + + scale_fill_gradient2(low="#008450", high="#B81D13", guide="colorbar") + + labs(x = NULL, y = NULL, title = plot_title) + + theme_tufte(base_family = "Helvetica") + # creates warnings + theme(axis.ticks = element_blank()) + + theme(axis.text = element_text(size = 10)) + + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + + theme(strip.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + + coord_equal() + + theme(legend.position = "none") - # prepare data slice which will be plotted - d <- df %>% - filter(.data$variable == var, - .data$metric == met) + # create small gap to "World" data by creating white outline + if("World" %in% d$region) { + p <- p + geom_vline(xintercept = 1.5, linewidth = 0.8, color = "white") + } + fig <- ggplotly(p, tooltip = "text") - if (historical) { - d <- filter(d, ref_scenario == "historical") - plot_title <- paste0(var, " [", d$unit[1], "] - ", met, " (historical)") + # if only one variable if passed to function } else { - d <- filter(d, (ref_scenario != "historical" | is.na(ref_scenario))) - plot_title <- paste0(var, " [", d$unit[1], "] - ", met) - } - # warn if no data is found for combination of var, cat and met - # TODO: fix for case without category - # if (nrow(d) == 0) { - # data$cm <- paste(metric, sep = "-") - # warning( - # paste0( - # "No data found for variable in this category and metric.\n - # variable ", var ," is available for the following category-metric - # combinations: ", unique(data[data$variable == var, "cm"]) - # ) - # ) - # } + # prepare data slice which will be plotted + d <- df %>% + filter(.data$variable == var, + .data$metric == met) - d$period <- as.character(d$period) - colors <- c(green = "#008450", - yellow = "#EFB700", - red = "#B81D13", - grey = "#808080") + if (historical) { + d <- filter(d, ref_scenario == "historical") + plot_title <- paste0(var, " [", d$unit[1], "] - ", met, " (historical)") + } else { + d <- filter(d, (ref_scenario != "historical" | is.na(ref_scenario))) + plot_title <- paste0(var, " [", d$unit[1], "] - ", met) + } + # warn if no data is found for combination of var, cat and met + # TODO: fix for case without category + # if (nrow(d) == 0) { + # data$cm <- paste(metric, sep = "-") + # warning( + # paste0( + # "No data found for variable in this category and metric.\n + # variable ", var ," is available for the following category-metric + # combinations: ", unique(data[data$variable == var, "cm"]) + # ) + # ) + # } - # gg tile plot using data along dimensions as given in function call - p <- ggplot(d, aes(x = .data[[x_plot,]], - y = .data[[y_plot,]], - fill = check, - text = text)) + - geom_tile(color="white", linewidth=0.0) + - scale_fill_manual(values = colors, breaks = colors) + - facet_grid(.data[[y_facet,]] ~ .data[[x_facet,]]) + - labs(x = NULL, y = NULL, title = plot_title) + - theme_tufte(base_family = "Helvetica") + # creates warnings - theme(axis.ticks = element_blank()) + - theme(axis.text = element_text(size = 10)) + - theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + - coord_equal() + - theme(legend.position = "none") + d$period <- as.character(d$period) + colors <- c(green = "#008450", + yellow = "#EFB700", + red = "#B81D13", + grey = "#808080") - # create small gap to "World" data by creating white outline - if("World" %in% d$region) { - p <- p + geom_vline(xintercept = 1.5, linewidth = 0.8, color = "white") - } - fig <- ggplotly(p, tooltip = "text") - # improve plotly layout, kinda works but very manual - # TODO: can this be extended to a general, useful function? - #fig <- fig %>% subplot(heights = 0.3) %>% - # layout(title = list(y=0.64)) + # gg tile plot using data along dimensions as given in function call + p <- ggplot(d, aes(x = .data[[x_plot,]], + y = .data[[y_plot,]], + fill = check)) + + geom_tile(color="white", linewidth=0.0) + + scale_fill_manual(values = colors, breaks = colors) + + facet_grid(.data[[y_facet,]] ~ .data[[x_facet,]]) + + labs(x = NULL, y = NULL, title = plot_title) + + theme_tufte(base_family = "Helvetica") + # creates warnings + theme(axis.ticks = element_blank()) + + theme(axis.text = element_text(size = 9)) + + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + + theme(strip.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + + theme(strip.text.y = element_text(angle = 0, vjust = 0.5, hjust=1)) + + coord_equal() + + theme(legend.position = "none") + + # create small gap to "World" data by creating white outline + if("World" %in% d$region) { + p <- p + geom_vline(xintercept = 1.5, linewidth = 0.8, color = "white") + } + fig <- ggplotly(p, tooltip = "text") + } if (interactive) { return(fig) diff --git a/man/validationHeatmap.Rd b/man/validationHeatmap.Rd index ffb6bd8..73122b9 100644 --- a/man/validationHeatmap.Rd +++ b/man/validationHeatmap.Rd @@ -1,9 +1,21 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/validationHeatmap.R +% Please edit documentation in R/summaryHeatmap.R, R/validationHeatmap.R \name{validationHeatmap} \alias{validationHeatmap} \title{takes the output of "validateScenarios()" and plots heatmaps per variable} \usage{ +validationHeatmap( + df, + var, + met, + historical = TRUE, + interactive = TRUE, + x_plot = "region", + y_plot = "period", + x_facet = "model", + y_facet = "scenario" +) + validationHeatmap( df, var, @@ -38,5 +50,7 @@ and ``appendTooltips()``} \item{y_facet}{choose dimension to display on x-dim of facets, default: scenario} } \description{ +takes the output of "validateScenarios()" and plots heatmaps per variable + takes the output of "validateScenarios()" and plots heatmaps per variable }