Es exactamente lo que mencionan en el curso. La estética ..density..
establece el tamaño para cada parte de la barra en función de:
- El valor de
x
para el bin
en particular
- ponderado en función de los totales generales de cada categoría
RBMI
Veamos un ejemplo, vamos a achicar un poco el data.frame
original para dejar solo tres edades: 18, 50 y 84, simplemente para poder apreciar mejor las diferencias:
adult %>%
filter(SRAGE_P %in% c(18,50,84)) %>% # Filtramos las edades que nos interesan
select(RBMI, SRAGE_P) -> new.adult # Dejamos solo las dos columnas que necesitamos
str(new.adult)
'data.frame': 1653 obs. of 2 variables:
$ RBMI : Factor w/ 4 levels "Under-weight",..: 3 3 2 2 3 3 2 2 2 2 ...
$ SRAGE_P: num 50 50 50 50 84 50 18 18 84 50 ...
Si hacemos el histograma de estos datos usando ..density..
ggplot(new.adult, aes (x = SRAGE_P, fill= factor(RBMI))) +
geom_histogram(aes(y = ..density..), position="fill", binwidth = 10) +
BMI_fill
Vemos las tres barras correspondientes a las tres edades, lo que ocurre con este gráfico, es que debemos "leerlo" de una forma un poco antinatural, hay que leerlo "horizontalmente", tomemos el caso de la categoría Under-weight
, lo que nos dice esta gráfica es que del total de los Under-weight
más de la mitad esta en los adultos de 18 años y que la menor cantidad está en los adultos de 50. Si lo leyéramos "verticalmente", podríamos suponer que la mitad o más de los adultos de 18 años están debajo del peso normal, cuando en realidad no ocurre esto. Si vemos el gráfico de la otra forma:
ggplot(new.adult, aes (x = SRAGE_P, fill= factor(RBMI))) +
geom_histogram(aes(y = ..count../sum(..count..)), position="fill",binwidth = 10) +
BMI_fill
Vemos ahora sí, que la cantidad de jóvenes de 18 de bajo peso es mínima. En esta gráfica, efectivamente las superficies para cada categoría en cada barra o bin
son proporcionales a las cantidades de casos de cada categoría dentro del bin
Para confirmar este comportamiento con los datos, primero necesitamos los totales de cada categoría:
new.adult %>%
group_by(RBMI) %>% # Agrupamos todos los RBMI
summarize(t_RBMI = n()) %>% # Contamos los casos de cada grupo
ungroup() -> totales_categorias
totales_categorias
# A tibble: 4 x 2
RBMI t_RBMI
<fct> <int>
1 Under-weight 57
2 Healthy-weight 807
3 Over-weight 502
4 Obese 287
De las 1653 observaciones, vemos como se distribuyen por cada categoría, si estos totales los agregamos a los grupos de RBMI
y SRAGE_P
new.adult %>%
group_by(RBMI, SRAGE_P) %>% # Agrupamos todos los RBMI y SRAGE_P
summarize(t_SRAGE_P = n()) %>% # Contamos casos para cada grupo
left_join(totales_categorias) %>% # Join con los totales de RBMI
mutate(perc=t_SRAGE_P/t_RBMI) %>% # Calculamos porc. sobre el total de RBMI
arrange(RBMI, SRAGE_P) # Ordenamos
# A tibble: 12 x 5
# Groups: RBMI [4]
RBMI SRAGE_P t_SRAGE_P t_RBMI perc
<fct> <dbl> <int> <int> <dbl>
1 Under-weight 18 30 57 0.526
2 Under-weight 50 13 57 0.228
3 Under-weight 84 14 57 0.246
4 Healthy-weight 18 254 807 0.315
5 Healthy-weight 50 347 807 0.430
6 Healthy-weight 84 206 807 0.255
7 Over-weight 18 80 502 0.159
8 Over-weight 50 301 502 0.600
9 Over-weight 84 121 502 0.241
10 Obese 18 52 287 0.181
11 Obese 50 196 287 0.683
12 Obese 84 39 287 0.136
Vemos ahora sí que la categoría Under-weight
se distribuye más del 50% entre los menores de 18, es decir, 30 casos sobre un total de 57, esto es lo que muestra ..density..
. Sin embargo, esos 30 es una proporción mucho más pequeña sobre todos los casos de los adultos de 18 años, que es lo que muestra ..count../sum(..count..)
.
Algo que me faltó aclarar
El porcentaje mostrado en los datos anteriores, dan una idea de como funcionaría ..density..
, pero no son los porcentajes finales que se usa para cada área de cada barra, estos luego deben ser escalados según su tamaño en relación al total. La demostración viendo los datos es un poco más compleja y larga:
new.adult %>%
group_by(RBMI) %>%
summarize(t_RBMI = n()) %>%
ungroup() -> totales_categorias
new.adult %>%
group_by(SRAGE_P) %>%
summarize(t_SRAGE_P = n()) %>%
ungroup() -> totales_edades
new.adult %>%
group_by(RBMI, SRAGE_P) %>%
summarize(c_SRAGE_P = n()) %>%
left_join(totales_categorias, by = "RBMI") %>%
left_join(totales_edades, by = "SRAGE_P") %>%
mutate(perc1=c_SRAGE_P/t_RBMI) %>%
mutate(perc2=c_SRAGE_P/t_SRAGE_P) %>%
arrange(SRAGE_P, RBMI) %>%
ungroup() -> final
final %>%
left_join(final %>%
group_by(SRAGE_P) %>%
summarize(t_perc1 = sum(perc1)),
by = "SRAGE_P") %>%
mutate(perc1=perc1/t_perc1) %>%
select(RBMI, SRAGE_P, perc1, perc2)
Y ahora sí, perc1
y perc2
representan en porcentaje, el tamaño de cada area (fill
) de cada una de las barras, el primero corresponde a ..density..
y el segundo a ..count../sum(..count..)
# A tibble: 12 x 4
RBMI SRAGE_P perc1 perc2
<fct> <dbl> <dbl> <dbl>
1 Under-weight 18 0.445 0.0721
2 Healthy-weight 18 0.266 0.611
3 Over-weight 18 0.135 0.192
4 Obese 18 0.153 0.125
5 Under-weight 50 0.118 0.0152
6 Healthy-weight 50 0.222 0.405
7 Over-weight 50 0.309 0.351
8 Obese 50 0.352 0.229
9 Under-weight 84 0.280 0.0368
10 Healthy-weight 84 0.291 0.542
11 Over-weight 84 0.275 0.318
12 Obese 84 0.155 0.103