Как визуализировать разницу между функциями распределения вероятности?

Question

Я пытаюсь представить себе разницу между двумя гистограмм функций распределения, таких как разница в следующих двух кривых:

Когда разница большая, можно просто построить два кривых друг на друга и заполните разницу, как указано выше, хотя, когда разница становится очень малой, это громоздко. Другой способ построения этого замышляет само различие следующим образом:

Однако, это, кажется, очень трудно читать все видя такой график в первый раз, так что мне было интересно: есть ли иначе вы можете визуализировать разницу между двумя функциями распределения?

Answer 1

Я подумал, что, возможно, это может быть вариант просто объединить ваши два предложения, расширяя различия, чтобы сделать их видимыми.

Ниже приведена попытка сделать это с помощью ggplot2. На самом деле, это было немного больше, чтобы сделать это, чем я изначально думал, и я определенно не на сто процентов доволен результатом; но, возможно, это помогает. Комментарии и улучшения очень приветствуются.

library(ggplot2) 
library(dplyr) 

## function that replicates default ggplot2 colors 
## taken from [1] 
gg_color_hue <- function(n) { 
    hues = seq(15, 375, length=n+1) 
    hcl(h=hues, l=65, c=100)[1:n] 
} 

## Set up sample data 
set.seed(1) 
n <- 2000 
x1 <- rlnorm(n, 0, 1) 
x2 <- rlnorm(n, 0, 1.1) 
df <- bind_rows(data.frame(sample=1, x=x1), data.frame(sample=2, x=x2)) %>% 
    mutate(sample = as.factor(sample)) 

## Calculate density estimates 
g1 <- ggplot(df, aes(x=x, group=sample, colour=sample)) + 
    geom_density(data = df) + xlim(0, 10) 
gg1 <- ggplot_build(g1) 

## Use these estimates (available at the same x coordinates!) for 
## calculating the differences. 
## Inspired by [2] 
x <- gg1$data[[1]]$x[gg1$data[[1]]$group == 1] 
y1 <- gg1$data[[1]]$y[gg1$data[[1]]$group == 1] 
y2 <- gg1$data[[1]]$y[gg1$data[[1]]$group == 2] 
df2 <- data.frame(x = x, ymin = pmin(y1, y2), ymax = pmax(y1, y2), 
        side=(y1<y2), ydiff = y2-y1) 
g2 <- ggplot(df2) + 
    geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax, fill = side, alpha = 0.5)) + 
    geom_line(aes(x = x, y = 5 * abs(ydiff), colour = side)) + 
    geom_area(aes(x = x, y = 5 * abs(ydiff), fill = side, alpha = 0.4)) 
g3 <- g2 + 
    geom_density(data = df, size = 1, aes(x = x, group = sample, colour = sample)) + 
    xlim(0, 10) + 
    guides(alpha = FALSE, colour = FALSE) + 
    ylab("Curves: density\n Shaded area: 5 * difference of densities") + 
    scale_fill_manual(name = "samples", labels = 1:2, values = gg_color_hue(2)) + 
    scale_colour_manual(limits = list(1, 2, FALSE, TRUE), values = rep(gg_color_hue(2), 2)) 

print(g3) 

Источники: SO answer 1, SO answer 2

---

Как было предложено @Gregor в комментариях, вот версия, которая делает два отдельных участка ниже Афоризм, но разделяя масштабирование по оси же х , По крайней мере, легенды, очевидно, должны быть исправлены.

library(ggplot2) 
library(dplyr) 
library(grid) 

## function that replicates default ggplot2 colors 
## taken from [1] 
gg_color_hue <- function(n) { 
    hues = seq(15, 375, length=n+1) 
    hcl(h=hues, l=65, c=100)[1:n] 
} 

## Set up sample data 
set.seed(1) 
n <- 2000 
x1 <- rlnorm(n, 0, 1) 
x2 <- rlnorm(n, 0, 1.1) 
df <- bind_rows(data.frame(sample=1, x=x1), data.frame(sample=2, x=x2)) %>% 
    mutate(sample = as.factor(sample)) 

## Calculate density estimates 
g1 <- ggplot(df, aes(x=x, group=sample, colour=sample)) + 
    geom_density(data = df) + xlim(0, 10) 
gg1 <- ggplot_build(g1) 

## Use these estimates (available at the same x coordinates!) for 
## calculating the differences. 
## Inspired by [2] 
x <- gg1$data[[1]]$x[gg1$data[[1]]$group == 1] 
y1 <- gg1$data[[1]]$y[gg1$data[[1]]$group == 1] 
y2 <- gg1$data[[1]]$y[gg1$data[[1]]$group == 2] 
df2 <- data.frame(x = x, ymin = pmin(y1, y2), ymax = pmax(y1, y2), 
        side=(y1<y2), ydiff = y2-y1) 
g2 <- ggplot(df2) + 
    geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax, fill = side, alpha = 0.5)) + 
    geom_density(data = df, size = 1, aes(x = x, group = sample, colour = sample)) + 
    xlim(0, 10) + 
    guides(alpha = FALSE, fill = FALSE) 
g3 <- ggplot(df2) + 
    geom_line(aes(x = x, y = abs(ydiff), colour = side)) + 
    geom_area(aes(x = x, y = abs(ydiff), fill = side, alpha = 0.4)) + 
    guides(alpha = FALSE, fill = FALSE) 
## See [3] 
grid.draw(rbind(ggplotGrob(g2), ggplotGrob(g3), size="last")) 

... или с abs(ydiff) заменены ydiff в строительстве второго участка:

Источник: SO answer 3