Nothing
#' Graphical representation in a 4x4 raster of a qlifetable data frame.
#'
#' @description Plot method for a data frame of events or time exposed occurring in each Lexis-diagram quarter for a set of ages.
#' This is a plot method for the objects typically obtained using the function \code{\link{count_events_quarter}} or whatever of the time_exposed_ functions (e.g., \code{\link{time_exposed_outs}}).
#'
#' @author Josep Lledo \email{josep.lledo@@uv.es}
#' @author Jose M. Pavia, \email{pavia@@uv.es}
#'
#' @param x A data frame of quarterly summary statistics. Typically an output of the function \code{\link{count_events_quarter}} or whatever of the time_exposed_ functions (e.g., \code{\link{time_exposed_outs}}).
#' @param ... Other arguments passed on to methods. Not currently used.
#' @param range.ages A vector of integers informing the aggregation of ages for which the graphical representation should be plotted. Default, NULL, the agggregation of all ages is shown.
#' @param key Type of statistic to be presented in the plot. Either "numbers" or relative "percentages". Default, "numbers".
#' @param decimal.digits Integer indicating the number of decimal places to be shown. Default, 2.
#' @param color.palette Background base color for cells. Default, "grey".
#' @param alpha.max A number in the interval [0, 1]. Maximum level of transparency to be applied for the background to build the palette. Default, 1.
#' @param alpha.min A number in the interval [0, 1]. Minimum level of transparency to be applied for the background to build the palette. Default, 0.4.
#' @param color.values Base color for numbers printed in each cell. Default, "black".
#' @param big.mark A character string indicating the symbol to be used as thousand separator. Default, NULL.
#' @param size.values A number indicating the font size to be used for inner-cells values. Default, 3.
#' @param legend.name Name to be use as name in the legend. Default, NULL.
#' @param name.labels.age Names to be used for the (y) age axis. Default, c("Q1", "Q2", "Q3", "Q4").
#' @param name.labels.season Names to be used for the (x) season axis. Default, c("Winter", "Spring", "Summer", "Autumn").
#' @param show.plot A TRUE/FALSE indicating if the plot should be displayed as a side-effect. By default, TRUE.
#'
#' @return
#' Invisibly returns the (ggplot) description of the plot, which is a list with components that contain the plot itself, the data, information about the scales, panels, etc.
#'
#' @note ggplot2 is needed to be installed for this function to work.
#'
# @import ggplot2
#'
#' @export
#'
#' @method plot qlifetable
#'
#' @examples
#' dates.b <- c("1920-05-13", "1999-04-12", "2019-01-01")
#' dates.e <- c("2002-03-23", "2009-04-12", "2019-01-01")
#' x <- quarterly_variables(dates.b, dates.e)
#' out <- time_exposed_outs(x)
#' p <- plot(out, show.plot = FALSE)
plot.qlifetable <- function(x, ..., range.ages = NULL, key = "numbers", decimal.digits = 2,
color.palette = "grey", alpha.max = 1, alpha.min = 0.4,
color.values = "black", big.mark = NULL,
size.values = 3, legend.name = NULL,
name.labels.age = c("Q1", "Q2", "Q3", "Q4"),
name.labels.season = c("Winter", "Spring", "Summer", "Autumn"),
show.plot = TRUE
){
# argg <- c(as.list(environment()), list(...))
if (key != "numbers" & key != "percentages")
stop("The 'key' argument is not properly defined. Only 'numbers' and 'percentages' are allowed.")
if (dim(x)[2L] != 4L | dim(x)[1L] %% 16L != 0L)
stop("'x' does not have the expected structure")
names(x) <- c("age", "quarter.age", "quarter.calendar", "number.events")
# if ("colour.values" %in% names(argg)) color.values <- colour.values
# if ("colour.palette" %in% names(argg)) color.palette <- colour.palette
datos <- x
number.decimals <- decimal.digits
if (!is.null(range.ages))
datos <- datos[datos$age %in% range.ages, ]
if (is.null(big.mark)) big.mark <- ""
total_events <- sum(datos$number.events)
edades <- dim(datos)[1L]/16L
tabla <- datos[1L:16L, 1L:4L]
names(tabla) <- c("label", "quarter.age", "quarter.calendar", "Total_quarter")
tabla$Total_quarter <- 0L
for (i in 1L:edades){
tabla$Total_quarter <- tabla$Total_quarter +
datos$number.events[(1L + (i - 1) * 16L):(i * 16L)]
}
tabla$Total_quarter <- tabla$Total_quarter*100 / ifelse(key == "numbers", 100L , total_events)
tabla$quarter.calendar <- factor(as.factor(tabla$quarter.calendar),
labels = name.labels.season)
tabla$quarter.age <- as.factor(tabla$quarter.age)
tabla$label <- format(round(tabla$Total_quarter, number.decimals),
nsmall = number.decimals,
big.mark = big.mark)
# tabla <- datos %>%
# group_by(quarter.calendar, quarter.age) %>%
# summarise(Total_quarter = sum(number.events) / ifelse(key == "numbers", 1 , total_events))
p <- ggplot2::ggplot(data = tabla,
mapping = ggplot2::aes(x = !!quote(quarter.calendar),
y = !!quote(quarter.age))) +
ggplot2::geom_raster(mapping = ggplot2::aes(fill = !!quote(Total_quarter)),
position = "identity") +
ggplot2::scale_size_continuous(range = c(min(tabla$Total_quarter), max(tabla$Total_quarter))) +
ggplot2::scale_fill_continuous(high = scales::alpha(colour = color.palette, alpha = alpha.max),
low = scales::alpha(colour = color.palette, alpha = alpha.min)) +
ggplot2::theme(
panel.background = ggplot2::element_blank(),
axis.ticks = ggplot2::element_blank()
) +
ggplot2::labs(fill = legend.name) +
ggplot2::scale_x_discrete(labels = name.labels.season) +
ggplot2::scale_y_discrete(labels = name.labels.age) +
ggplot2::xlab("Season quarter") +
ggplot2::ylab("Age quarter") +
ggplot2::geom_text(ggplot2::aes(label = !!quote(label)),
size = size.values,
col = color.values)
if (show.plot) print(p)
return(p)
}
qlifetable <- setClass("qlifetable", contains = "data.frame")
setMethod("plot", signature(x = "qlifetable", y = "missing"), plot.qlifetable)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.