Сплит скрипка с точками вверху, чтобы указать информацию

Question

Это продолжение поста здесь и здесь

Я успешно реализовал разделенную скрипку ggplot2 для своих данных (две средние плотности оценки для двух случаев), которые необходимо сравнить. Теперь, так как я хотел бы добавить некоторый доверительный интервал. Я следую за кодом, размещенным в ссылках выше:

РЕДАКТИРОВАТЬ: воспроизводимый пример

tmp <- rnorm(1000,0,1)
tmp.2 <- rnorm(1000,0,1)
x.1 <- density(tmp)
y.1 <- density(tmp.2)  

Здесь я делаю плотности, извлекая пары (x,y). Затем я возвращаю квантили,

# Make densities
densities <- as.data.frame(c(x.1$x,y.1$x))
colnames(densities) <- "loc"
densities$dens <- c(x.1$y,y.1$y)
densities$drop_case <- c(rep("B",512),rep("S",512))
densities$dens <- ifelse(densities$drop_case=="B",densities$dens*-1,densities$dens)
densities$dens <- ifelse(densities$drop_case=="S",densities$dens*1,densities$dens)

conf <- as.data.frame(c(quantile(tmp,c(0.025,0.975))[1],quantile(tmp,c(0.025,0.975))[2],quantile(tmp.2,c(0.025,0.975))[1],quantile(tmp.2,c(0.025,0.975))[2]))
colnames(conf) <- "intervals"
conf$drop_case <- c(rep("B",2),rep("S",2))
conf$length <- rep(1000,4)

Теперь здесь я пытаюсь извлечь значения внутри плотности, как было отмечено в связанных сообщениях

Найти данные точек в плотности

val.tmp <- rep(0,4)
val.tmp.2 <- rep(0,4)
for (i in 1:4) {
x.here <- densities$loc
y.here <- densities$dens
your.number<- conf$intervals[i]
pos.tmp <- which(abs(x.here-your.number)==min(abs(x.here-your.number)))
val.tmp[i] <- x.here[pos.tmp]
val.tmp.2[i] <- y.here[pos.tmp]
}
conf$positions <- val.tmp
conf$length <- val.tmp.2

conf$length <- ifelse(conf$drop_case=="B",conf$length*-1,conf$length)
conf$length <- ifelse(conf$drop_case=="S",conf$length*1,conf$length)

ggplot(densities,aes(dens, loc, fill = factor(drop_case)))+
geom_polygon()+
scale_x_continuous(breaks = 0, name = info$Name)+
ylab('Estimator Density') +
theme(axis.title.x = element_blank())+
geom_point(data = conf, aes(x = positions, y = length, fill = factor(drop_case), group = factor(drop_case))
         ,shape = 21, colour = "black", show.legend = FALSE)

Тогда, к сожалению, я сталкиваюсь со следующим: точки не отображаются на плотностях, а скорее отображаются на плоскости.

Answer 1

В коде куча маленьких ошибок. Во-первых, внутри этого for цикл, вы не можете установить x.here а также y.here ко всем значениям плотности и местоположения, так как это включает в себя обе группы. Во-вторых, поскольку знаки уже изменены densities нет необходимости использовать эти ifelse заявления потом. В-третьих, вам понадобится только верх ifelse во всяком случае, так как нижний абсолютно ничего не делает. Наконец, у вас был x а также y отображения в geom_point неправильный путь вокруг!

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

Ниже полный откорректированный код:

tmp <- rnorm(1000,0,1)
tmp.2 <- rnorm(1000,0,1)
x.1 <- density(tmp)
y.1 <- density(tmp.2)  

# Make densities
densities <- as.data.frame(c(x.1$x,y.1$x))
colnames(densities) <- "loc"
densities$dens <- c(x.1$y,y.1$y)
densities$drop_case <- c(rep("B",512),rep("S",512))
densities$dens <- ifelse(densities$drop_case=="B",densities$dens*-1,densities$dens)

conf <- as.data.frame(c(quantile(tmp,c(0.025,0.975)), quantile(tmp.2,c(0.025,0.975))))
colnames(conf) <- "intervals"
conf$drop_case <- c(rep("B",2),rep("S",2))
conf$length <- rep(1000,4)

val.tmp <- rep(0,4)
val.tmp.2 <- rep(0,4)
for (i in 1:4) {
  x.here <- densities$loc[densities$drop_case == conf$drop_case[i]]
  y.here <- densities$dens[densities$drop_case == conf$drop_case[i]]
  your.number<- conf$intervals[i]
  pos.tmp <- which(abs(x.here-your.number)==min(abs(x.here-your.number)))
  val.tmp[i] <- x.here[pos.tmp]
  val.tmp.2[i] <- y.here[pos.tmp]
}
conf$positions <- val.tmp
conf$length <- val.tmp.2

ggplot(densities, aes(dens, loc, fill = drop_case)) +
  geom_polygon()+
  ylab('Estimator Density') +
  theme(axis.title.x = element_blank())+
  geom_point(data = conf, aes(x = length, y = positions, fill = drop_case),
             shape = 21, colour = "black", show.legend = FALSE)

Это приводит к:

Я бы лично предпочел сюжет с отрезками:

ggplot(densities, aes(dens, loc, fill = factor(drop_case)))+
  geom_polygon()+
  ylab('Estimator Density') +
  theme(axis.title.x = element_blank())+
  geom_segment(data = conf, aes(x = length, xend = 0, y = positions, yend = positions))