Доверительные интервалы для нормального соответствия в ggplot, кумулятивная вероятность

Question

Редактировать: извините, я новичок в сообществе. Я пытаюсь сделать это более понятным с примерами данных и кода.

Вот данные (вывод dput):

structure(list(`Sample Name` = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 
11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22), Type = c("A", 
"A", "A", "A", "B", "B", "B", "B", "A", "A", "A", "A", "A", "A", 
"A", "B", "B", "B", "B", "B", "B", "B"), Size = c(1, 1, 1, 1, 
1, 1, 1, 1, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3), Height = c(270, 
280, 290, 295, 292, 285, 305, 330, 125, 130, 140, 142, 123, 117, 
140, 135, 132, 145, 160, 170, 136, 154)), row.names = c(NA, -22L
), class = c("tbl_df", "tbl", "data.frame"))

Теперь я использовал фильтр для классификации данных. Я не уверен, что это разумный способ сделать это, но пока работает. Во-первых, две категории с двумя размерами 1 и 3, затем каждый размер делится на два типа: A и B. Итак, в конце мы имеем 4 вида данных.

SizeOne <- filter (Alldata, Size== "1")
SizeThree <- filter (Alldata, Size== "3")

SizeonA <- filter (SizeOne, Type=="A")
SizeoneB <- filter (SizeOne, Type=="B")
SizeThreeA <- filter (SizeThree, Type=="A")
SizeThreeB <- filter (SizeThree, Type=="B")

Теперь это код для построения кумулятивной вероятности 4 различных категорий. Затем я использовал stat_function, чтобы добавить подгон Гауссова распределения для каждого кумулятивного графика.

p2 = ggplot() + 
  stat_ecdf(data = SizeOne,aes(x= Height, color=SizeOne$Type),geom = "point", size = 1.2, linetype= "twodash", pad= FALSE)+  
  stat_ecdf(data = SizeThree,aes(x= Height, color=SizeThree$Type),geom = "point", size = 1 , pad= FALSE)+  
    scale_color_manual(values = c("#e73a00", "#002ee7"))+
    labs(title= "Cumulative probability", y = "Cumulative Probability", x= "Height") +



  stat_function(data= SizeThreeB, fun = pnorm, color="#e73a00" , args = list(mean=mean(SizeThreeB$Height), sd=sd(SizeThreeB$Height)))+
    stat_function(data= SizeThreeA, fun = pnorm, color="#002ee7" , args = list(mean=mean(SizeThreeA$Height), sd=sd(SizeThreeA$Height)))+
    stat_function(data= SizeoneB, fun = pnorm, color="#e73a00" , args = list(mean=mean(SizeoneB$Height), sd=sd(SizeoneB$Height)))+
      stat_function(data= SizeonA, fun = pnorm, color="#002ee7" , args = list(mean=mean(SizeonA$Height), sd=sd(SizeonA$Height)))



p2

1. Теперь моя проблема заключается в том, как добавить достоверные интервалы 99%, 95% и 90% (полосы) к подгонке Гаусса? (не к эмпирическому кумулятивному).
2. Во-вторых, как я могу добавить бары ошибок в точку кумулятивной вероятности? (до синих и синих точек)

Мой сюжет пока

Answer 1

Я думаю, что может быть безопаснее вычислять pnorm вне ggplot. Для вашего кода вам не нужно фильтровать. Сохраняйте данные как таковые и используйте эстетику и аспекты ggplot для группировки ваших данных.

Вы можете использовать одни и те же группы для вычисления вероятностных распределений, так что вы можете использовать одинаковую эстетику / грани на графиках вероятности.

Отказ от ответственности

Я не статистик. Я просто взял верхний и нижний пределы достоверности для ваших средств и использовал это как среднее значение для нового расчета pnorm ... Это может быть неверно. Я согласен с пользователем @Stephane Laurent, что вы можете получить более правильные ответы о том, как рассчитать доверительные интервалы в CrossValidated.

library(tidyverse)
library(Rmisc)

split_data <- 
  alldata %>% 
  split(., interaction(.$Size, .$Type))

df_pnorm <- map(split_data, function(x){
  range_h <- range(x$Height)
  q <- seq(range_h[1], range_h[2])
  CI <- CI(x$Height)
  sd <- sd(x$Height)
  p_mean <- pnorm(q = q, mean = CI["mean"], sd = sd)
  p_lower <- pnorm(q = q, mean = CI["lower"], sd = sd)
  p_upper <- pnorm(q = q, mean = CI["upper"], sd = sd)
data.frame(Height = q, p_mean, p_lower, p_upper)
})  %>%
  bind_rows(.id = "size.type") %>%
  separate(size.type, c("Size", "Type"))

ggplot(alldata, aes(x = Height, color = Type, group = interaction(Type, Size))) + 
  geom_ribbon(data = df_pnorm, aes(ymin = p_upper, ymax = p_lower), alpha = 0.3)+
  geom_line(data = df_pnorm, aes(y = p_mean)) +
  stat_ecdf( geom = "point", pad= FALSE) +
  facet_grid(~ Size, scales = "free_x")

^{Создано в 2020-04-24 пакетом Представить (v0.3.0)}

данные

alldata <- structure(list(`Sample Name` = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 
                                 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22), Type = c("A", 
                                                                                           "A", "A", "A", "B", "B", "B", "B", "A", "A", "A", "A", "A", "A", 
                                                                                           "A", "B", "B", "B", "B", "B", "B", "B"), Size = c(1, 1, 1, 1, 
                                                                                                                                             1, 1, 1, 1, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3), Height = c(270, 
                                                                                                                                                                                                               280, 290, 295, 292, 285, 305, 330, 125, 130, 140, 142, 123, 117, 
                                                                                                                                                                                                               140, 135, 132, 145, 160, 170, 136, 154)), row.names = c(NA, -22L
                                                                                                                                                                                                               ), class = c("tbl_df", "tbl", "data.frame"))