/
gg_quantiles.R
132 lines (121 loc) · 5.25 KB
/
gg_quantiles.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
#' Quantile-Quantile plots
#'
#' Returns a quantile-quantile plot to compare any given number of groups
#'
#' @param df dataframe
#' @param vble numeric variable to be analized
#' @param group character or factor grouping variable
#' @param combined logical, defaults to FALSE, producing a matrix of pairwise QQ
#' plots. If TRUE, it produces a QQ plot of quantiles of each group versus
#' quantiles calculated by the combination of all groups. This is useful to
#' study residuals from a fit.
#' @param xlabel label for x-axis
#' @param ylabel label for y-axis
#' @param ... parameters to be passed to geom_point(), such as size, color, shape.
#'
#' @return a ggplot
#' @export
#'
#' @importFrom dplyr ungroup pull group_by arrange mutate row_number n vars filter as_tibble rename bind_rows tibble summarise starts_with vars
#' @importFrom stats quantile qqplot median qunif setNames
#' @importFrom ggplot2 ggplot aes xlab ylab coord_fixed facet_grid geom_text geom_jitter geom_line geom_point geom_abline facet_wrap geom_hline stat_qq stat_qq_line labs theme stat_smooth element_blank geom_rect scale_x_continuous labeller
#' @importFrom rlang .data quo_text quo_is_null eval_tidy :=
#'
#' @examples
#' library(ggplot2)
#' data(futbol)
#'
#' # Multiple groups
#' gg_quantiles(futbol, dist, longp)
#' gg_quantiles(futbol, dist, longp, size = 0.4, color = "red", shape = 3) +
#' theme(panel.spacing = unit(2, "lines")) +
#' theme_bw()
#'
#' # Only 2 groups
#' futbol2 <- dplyr::filter(futbol, longp %in% c("< 0.81 m", "0.81 a 0.90 m"))
#' gg_quantiles(futbol2, dist, longp)
#'
#' # Each groups vs quantiles from all groups combined
#' gg_quantiles(futbol, dist, longp, combined = TRUE)
gg_quantiles <- function(df, vble, group, combined = FALSE,
xlabel = NULL, ylabel = NULL, ...) {
# NSE y controles
if (!is.data.frame(df)) stop("The object provided in the argument df is not a data.frame")
vble <- enquo(vble)
group <- enquo(group)
if (!is.numeric(eval_tidy(vble, df)))
stop(paste(quo_text(vble), "provided for the vble argument is not a numeric variable"))
if (!is.character(eval_tidy(group, df)) && !is.factor(eval_tidy(group, df)))
stop(paste(quo_text(group), "provided for the group argument is neither a character nor a factor variable"))
if (!is.logical(combined)) stop("Argument combined must be either TRUE or FALSE")
df <- ungroup(df) # si esta agrupada no deja modificar esa vble
# Identificar los grupos
grupos <- unique(pull(df, !!group))
if (length(grupos) < 2) stop("There's only one group")
if (combined) {
# Grafico de cuantiles de cada grupo vs cuantiles combinados, en paneles (diapo 37)
df <-
df %>%
group_by(!!group) %>%
arrange(!!vble) %>%
mutate(valorf = (row_number() - 0.5) / n()) %>%
# desagrupar para que no siga haciendo cálculos para cada grupo de longp
ungroup() %>%
# con todos los datos, calcular el cuantil que acumula la misma probabilidad que cada dato
mutate(cuantilComb = quantile(!!vble, .data$valorf))
g <- ggplot(df, aes(y = !!vble, x = .data$cuantilComb)) +
geom_point(...) +
geom_abline(intercept = 0, slope = 1) +
facet_wrap(vars(!!group))
} else if (length(grupos) == 2) {
# Dos grupos, un solo grafico de cuantiles (diapo 13)
x <- df %>% filter(!!group == grupos[1]) %>% pull(!!vble)
y <- df %>% filter(!!group == grupos[2]) %>% pull(!!vble)
g <- qqplot(x = x, y = y, plot.it = F) %>%
as_tibble() %>%
ggplot(aes(x = x, y = y)) +
geom_point(...) +
geom_abline(intercept = 0, slope = 1) +
coord_fixed()
} else {
# Mas de dos grupos, matriz de scatterplots de graficos de cuantiles (diapo 18)
# Grilla con las combinaciones de los grupos, saco los que son iguales (la diagonal)
grilla <-
expand.grid(grupos, grupos, stringsAsFactors = F) %>%
rename(grupoX = .data$Var1, grupoY = .data$Var2) %>%
filter(.data$grupoX != .data$grupoY)
# Funcion auxiliar para mapply, dados los nombres de dos grupos genera los
# cuantiles a graficar gx e gy son los nombres de los grupos, devuelve un
# tibble
aux <- function(gx, gy) {
x <- df %>% filter(!!group == gx) %>% pull(!!vble)
y <- df %>% filter(!!group == gy) %>% pull(!!vble)
dat <- qqplot(x, y, plot.it = F) %>% as_tibble()
dat$varX <- gx
dat$varY <- gy
return(dat)
}
# Para cada combinacion de grupos aplicar la funcion anterior y combinar los
# resultantes tibbles
rtdo <- mapply(aux, grilla$grupoX, grilla$grupoY, SIMPLIFY = F) %>% bind_rows()
# Hago un dataset para agregar como texto los nombres de las variables en los
# paneles de la diagonal
dataTexto <- tibble(varX = grupos, varY = grupos)
# Grafico
g <- ggplot(rtdo, aes(x = x, y = y)) +
geom_point(...) +
geom_abline(aes(intercept = 0, slope = 1)) +
facet_grid(varY ~ varX) +
geom_text(data = dataTexto,
mapping = aes(y = mean(range(rtdo$y)), x = mean(range(rtdo$x)),
label = .data$varX))
}
xlabel <- ifelse(!is.null(xlabel), xlabel,
ifelse(combined, "Quantiles of combined data",
ifelse(length(grupos) == 2, as.character(grupos[1]), quo_text(vble))))
ylabel <- ifelse(!is.null(ylabel), ylabel,
ifelse(combined, "Quantiles of each group",
ifelse(length(grupos) == 2, as.character(grupos[2]), quo_text(vble))))
g <- g + labs(x = xlabel, y = ylabel)
return(g)
}