代码之家  ›  专栏  ›  技术社区  ›  Tal Galili

如何绘制小提琴散点箱线图(R)?

  •  10
  • Tal Galili  · 技术社区  · 14 年前

    我只是来看看下面的情节:

    alt text

    想知道在R里怎么做?(或其他软件)

    更新10.03.11 :感谢所有参与回答此问题的人-您给出了精彩的解决方案!我已经将这里介绍的所有解决方案(以及我在网上找到的一些其他解决方案)编译成 a post on my blog .

    5 回复  |  直到 14 年前
        1
  •  9
  •   Joris Meys    14 年前

    搞笑情节或多或少做了我认为应该做的事情。根据自己的需要进行调整,可能会进行一些优化,但这应该是一个很好的开始。

    Make.Funny.Plot <- function(x){
        unique.vals <- length(unique(x))
        N <- length(x)
        N.val <- min(N/20,unique.vals)
    
        if(unique.vals>N.val){
          x <- ave(x,cut(x,N.val),FUN=min)
          x <- signif(x,4)
        }
        # construct the outline of the plot
        outline <- as.vector(table(x))
        outline <- outline/max(outline)
    
        # determine some correction to make the V shape,
        # based on the range
        y.corr <- diff(range(x))*0.05
    
        # Get the unique values
        yval <- sort(unique(x))
    
        plot(c(-1,1),c(min(yval),max(yval)),
            type="n",xaxt="n",xlab="")
    
        for(i in 1:length(yval)){
            n <- sum(x==yval[i])
            x.plot <- seq(-outline[i],outline[i],length=n)
            y.plot <- yval[i]+abs(x.plot)*y.corr
            points(x.plot,y.plot,pch=19,cex=0.5)
        }
    }
    
    N <- 500
    x <- rpois(N,4)+abs(rnorm(N))
    Make.Funny.Plot(x)
    

    编辑:更正,所以它总是工作。

        2
  •  8
  •   Glorfindel Doug L.    6 年前

    我最近碰到 the beeswarm package ,这有一些相似之处。

    一维散点图 非重叠点。

      library(beeswarm)
      beeswarm(time_survival ~ event_survival, data = breast,
        method = 'smile',
        pch = 16, pwcol = as.numeric(ER),
        xlab = '', ylab = 'Follow-up time (months)',
        labels = c('Censored', 'Metastasis'))
      legend('topright', legend = levels(breast$ER),
        title = 'ER', pch = 16, col = 1:2)
    


    (来源: eklund at www.cbs.dtu.dk )

        3
  •  4
  •   mbq    14 年前


    示例代码(有时抛出警告,但有效):

    px<-function(x,N=40,...){
    x<-sort(x);
    
    #Cutting in bins
    cut(x,N)->p;
    
    #Calculate the means over bins
    sapply(levels(p),function(i) mean(x[p==i]))->meansl;
    means<-meansl[p];
    
    #Calculate the mins over bins
    sapply(levels(p),function(i) min(x[p==i]))->minl;
    mins<-minl[p];
    
    #Each dot is one value.
    #X is an order of a value inside bin, moved so that the values lower than bin mean go below 0
    X<-rep(0,length(x));
    for(e in levels(p)) X[p==e]<-(1:sum(p==e))-1-sum((x-means)[p==e]<0);
    #Y is a bin minum + absolute value of a difference between value and its bin mean
    plot(X,mins+abs(x-means),pch=19,cex=0.5,...);
    }
    
        4
  •  2
  •   chl    14 年前

    试试这个 vioplot

    library(vioplot)
    vioplot(rnorm(100))
    

    (使用可怕的默认颜色;-)

    wvioplot 包装,用于加权小提琴图,以及 beanplot lattice 包装,见 ?panel.violin .

        5
  •  2
  •   Sebastian Müller    8 年前

    既然还没有提到这一点,还有 ggbeeswarm 作为一个基于ggplot2的相对较新的R包。

    它将另一个geom添加到ggplot中,以代替geom\u jitter等。

    特别地 几何学

    值得注意的还有包裹 vipor


    set.seed(12345)
    install.packages('ggbeeswarm')
    library(ggplot2)
    library(ggbeeswarm)
    
    ggplot(iris,aes(Species, Sepal.Length)) + geom_beeswarm()
    

    ggplot(iris,aes(Species, Sepal.Length)) + geom_quasirandom()
    

    #compare to jitter
    ggplot(iris,aes(Species, Sepal.Length)) + geom_jitter()