R: Shadindg под несколько нормалей с ggplot

Question

Я хотел бы построить несколько нормальных распределений и тени площадь под каждый кривой справа от х = 6 и слева от значения симметричного ...

Я ve определил две функции, чтобы сделать это легко.

mifun <- function(x,mm,ss,alt) { 
    y <- alt+dnorm(x, mean = mm, sd = ss) 
    return(y) 
} 

mifun2 <- function(x,mm,ss,alt) { 
    y <- alt+dnorm(x, mean = mm, sd = ss) 
    y[x<6 & (2*mm-x)<6 ] <- NA 
    return(y) 
} 


ggplot(data.frame(x = c(-5, 11)), aes(x)) + 
    stat_function(fun = function(x) mifun(x,0,2,0), geom = "line") + 
    stat_function(fun = function(x) mifun2(x,0,2,0), geom = "area") + 
    stat_function(fun = function(x) mifun(x,2,2,-0.4), geom = "line") + 
    stat_function(fun = function(x) mifun2(x,2,2,-0.4), geom = "area") + 
    stat_function(fun = function(x) mifun(x,4,2,-0.8), geom = "line") + 
    stat_function(fun = function(x) mifun2(x,4,2,-0.8), geom = "area") + 
    stat_function(fun = function(x) mifun(x,6,2,-1.2), geom = "line") + 
    stat_function(fun = function(x) mifun2(x,6,2,-1.2), geom = "area") +theme_bw() 

Это изображение без затенения:

Это изображение с затенением, он не работает, как ожидалось:

Если бы я только построить один нормальный я получаю это

Как вы можете видеть, тень появляется над нормалями, а не внизу.

PD: картинка для Марка Как вы можете видеть, что первые участки выровнены по правому пределу тени, а последние из них выравниваются по левому.

Answer 1

Я думаю, что вышеприведенные комментарии правы: огранка - это путь. К сожалению, facet_wrap (и facet_grid) не очень хорошо сочетаются с stat_function, потому что нет способа передать переменную огранки в stat_function (что я могу найти в любом случае).

Таким образом, вам может понадобиться генерировать кривые плотности и область для заполнения первой. Обратите внимание, что geom_area заполняет промежутки между точками, так что вы должны иметь mifun2 выход 0 вместо NA там, где, как предполагается, нет наполнения:

mifun2 <- function(x,mm,ss,alt) { 
    y <- alt+dnorm(x, mean = mm, sd = ss) 
    y[x<6 & (2*mm-x)<6 ] <- 0 
    return(y) 
} 

Затем генерировать решетчатой ​​data.frame вы хотите. Здесь я использую 4 значения для средств (от вашего вопроса) и 1001 точек в диапазоне вы хотите построить:

normCurves <- 
    data.frame(x = rep(seq(-5, 11, length.out = 1001) 
        , times = 4) 
      , myMean = rep(c(0,2,4,6) 
          , each = 1001)) 

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

normCurves$density <- 
    mifun(normCurves$x, normCurves$myMean, 2, 0) 

normCurves$toHighlight <- 
    mifun2(normCurves$x, normCurves$myMean, 2, 0) 

А затем участок, непосредственно, используя facet_wrap выделить различные средства:

ggplot(normCurves 
     , aes(x)) + 
    geom_line(aes(y = density)) + 
    geom_area(aes(y = toHighlight)) + 
    facet_wrap(~myMean, ncol = 1, labeller = label_both) 

дает:

Этот подход также дает возможность построения все друг на друга с разных цветов:

ggplot(normCurves 
     , aes(x 
      , col = factor(myMean) 
      , fill = factor(myMean) 
      , group = myMean)) + 
    geom_line(aes(y = density)) + 
    geom_area(aes(y = toHighlight) 
      , alpha = 0.2 
      , col = NA 
      , position = "identity") 

дает

Если вы хотите, чтобы подчеркнуть то, что более экстремальные, чем 6 в другом направлении (ПОЧЕМУ?), Вам просто нужно изменить mifun2 определение:

mifun2 <- function(x,mm,ss,alt) { 
    y <- alt+dnorm(x, mean = mm, sd = ss) 

    # Make changes for small means 
    y[mm <= 6 & x<6 & (2*mm-x)<6 ] <- 0 

    # Make changes for large means 
    y[mm > 6 & x>6 & (2*mm-x)>6 ] <- 0 

    return(y) 
} 

Затем добавьте Addtional средства:

normCurves <- 
    data.frame(x = rep(seq(-6, 18, length.out = 1001) 
        , times = 7) 
      , myMean = rep(seq(0, 12, 2) 
          , each = 1001)) 

Теперь, если вы повторно запустить тот же код, построения графиков, как указано выше, вы получите:

вы теперь также упомянуть, где вы хотите анимировать, который является относительно простым:

toAnimate <- 
    ggplot(normCurves 
     , aes(x 
       , group = myMean 
       , frame = myMean)) + 
    geom_line(aes(y = density)) + 
    geom_area(aes(y = toHighlight) 
      , position = "identity") + 
    ggtitle("Mean = ") 

gganimate::gg_animate(toAnimate) 

дает