分裂小提琴情节，顶部有点以指示信息

Question

这是来自here的后续帖子 和here

我已成功实施了分裂小提琴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))

这导致：

我个人更喜欢带有线段的情节：

typedef long long ll;
ll MOD=1e9+7;
#define S 200
ll C[S+2][S+2],pows[S+2][S+2],sel[S+2][S+2];
ll sel_(int n,int c)
{
    ll ans=0; int cur=-1;
    for(int i=c;i>=1;i--)
    {
        cur*=-1;
        ans+=cur*pows[i][n]%MOD*C[c][i]%MOD;
        ans%=MOD;
    }
    return ans;
}
int main()
{
    for(int i=0;i<=S;i++)
    {
        C[i][0]=1; pows[i][0]=1;
        for(int j=1;j<=i;j++)
        C[i][j]=(C[i-1][j-1]+C[i-1][j])%MOD;
        for(int j=1;j<=S;j++)
        pows[i][j]=pows[i][j-1]*i%MOD;
    }
    sel[0][0]=1;
    for(int i=1;i<=S;i++)
    {
        for(int j=1;j<=i;j++) sel[i][j]=sel_(i,j);
    }
    //the answers are stored in sel
}