I created a new stat and geom and now I was testing it. However I face an error that I didn't have when I did the transformation of the data outside geoms.
Is there any way to evaluate the output of a stat?
Thanks
(I tried with stat_histTime$compute_group(ciber)
but didn't work out)
ciber <- structure(list(
Ciber = c("CIBERFES", "CIBERES", "CIBEREHD", "CIBERER", "CIBERSAM", "CIBEREHD"),
SEXO = structure(c(1L, 2L, 2L, 1L, 2L, 2L), .Label = c("Hombre", "Mujer"), class = "factor"),
FechaNacimiento = structure(c(2089, 4686, 8612, 8772, 2300, 9932), class = "Date"),
Categoria = structure(c(3L, 2L, 1L, 3L, 2L, 4L), .Label = c("Diplomado", "Doctor", "Licenciado", "Técnico"), class = "factor"),
ProvinciaCentro = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = c("BARCELONA", "SIN ESPECIFICAR"), class = "factor"),
TipoContrato = structure(c(3L, 4L, 5L, 7L, 1L, 5L), .Label = c("Indefinido", "Interinidad", "Obra y servicio", "Postdoctoral 5 años", "Prácticas", "Predoctoral 4 años", "Proyecto de investigación"), class = "factor"),
FechaInicio = structure(c(17501,16770, 18155, 17688, 14061, 18141), class = "Date"),
Mesa = structure(c(1L, 2L, 2L, 2L, 1L, 1L), .Label = c("MESA 1 CLINIC CELLEX", "MESA 2 VHIR VALL HEBRÓN"), class = "factor"),
EdadInicio = c(42.1957563312799, 33.0841889117043, 26.1273100616016, 24.4106776180698, 32.1998631074606, 22.4750171115674),
FechaFinal = structure(c(NA, 18597, NA, NA, NA, NA), class = "Date")),
row.names = c(NA, 6L), class = "data.frame")
library("ggplot2")
StatHistTime <- ggproto("StatHistTime", Stat,
compute_group = function(data, scales) {
c0 <- data[!is.na(data$xmax), c("xmin", "xmax")]
xy <- sort(unique(c(data$xmin, data$xmax)))
xy <- xy[!is.na(xy)]
z <- data.frame(Var1 = xy[-length(xy)],
Var2 = xy[-1],
count = 0,
n = seq_along(xy[-1]))
for (n in seq_len(nrow(c0))) {
fi <- c0[n, "xmin"]
ff <- c0[n, "xmax"]
interval <- z$Var2 <= ff & z$Var1 >= fi
z$count[interval] <- z$count[interval] + 1
}
z
},
required_aes = c("x|y", "xmin|ymin", "xmax|ymax"),
default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
setup_params = function(data, params) {
params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE)
# if flipped_aes == TRUE then y, xmin, xmax is present
if (!(params$flipped_aes || all(c("x", "ymin", "ymax") %in% c(names(data), names(params))))) {
abort("Either, `x`, `ymin`, and `ymax` or `y`, `xmin`, and `xmax` must be supplied")
}
params
}
)
stat_histTime <- function(mapping = NULL, data = NULL, geom = "line",
position = "identity", na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE, ...) {
ggplot2::layer(
stat = StatHistTime, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
ggplot(ciber) +
stat_histTime(aes(y = "Contratados", xmin = FechaInicio, xmax = FechaFinal, x = 1)) +
theme_minimal()