3

我正在使用包vioplot。我想问一下，我怎样才能创建不同颜色的小提琴图。

这是我的可重现示例：

# Violin Plots library(vioplot) 
x1 <- mtcars$mpg[mtcars$cyl==4] 
x2 <- mtcars$mpg[mtcars$cyl==6] 
x3 <- mtcars$mpg[mtcars$cyl==8] 
vioplot(x1, x2, x3, 
names=c("4 cyl", "6 cyl", "8 cyl"), col="gold") 
title("Violin Plots of Miles Per Gallon")

谢谢你。

4

4 回答 4

14

不可能有多种颜色。但是破解函数vioplot并编辑源代码并不难。您应该遵循以下步骤来完成此操作：

  1. 复制初始函数：

     my.vioplot <- vioplot()

  2. 编辑此功能：

     edit(my.vioplot)

  3. 搜索单词“polygon”并将 col 替换为 col[i]

  4. 对于您提供单一颜色的情况，请在功能开始时进行测试。并添加这一行：

     if(length(col)==1) col <- rep(col,n)

例如使用您的数据：

vioplot(x1, x2, x3, names=c("4 cyl", "6 cyl", "8 cyl"), col="gold") 
title("Violin Plots of Miles Per Gallon") 

my.vioplot(x1, x2, x3, names=c("4 cyl", "6 cyl", "8 cyl"), col=c("gold","red","blue")) 
title("Violin Plots of Miles Per Gallon multi colors")

在此处输入图像描述

于 2013-02-20T09:28:29.210 回答
6

为了扩展 agstudy 的答案并纠正一件事，这里是完整的新 vioplot 脚本。

在你的脚本中使用 source("vioplot.R") 而不是 library(vioplot) 来使用这个多色版本。这将重复任何颜色，直到达到相同数量的数据集。

library(sm)
vioplot <- function(x,...,range=1.5,h=NULL,ylim=NULL,names=NULL, horizontal=FALSE,
  col="magenta", border="black", lty=1, lwd=1, rectCol="black", colMed="white", pchMed=19, at, add=FALSE, wex=1,
  drawRect=TRUE)
{
    # process multiple datas
    datas <- list(x,...)
    n <- length(datas)

    if(missing(at)) at <- 1:n

    # pass 1
    #
    # - calculate base range
    # - estimate density
    #

    # setup parameters for density estimation
    upper  <- vector(mode="numeric",length=n)
    lower  <- vector(mode="numeric",length=n)
    q1     <- vector(mode="numeric",length=n)
    q3     <- vector(mode="numeric",length=n)
    med    <- vector(mode="numeric",length=n)
    base   <- vector(mode="list",length=n)
    height <- vector(mode="list",length=n)
    baserange <- c(Inf,-Inf)

    # global args for sm.density function-call
    args <- list(display="none")

    if (!(is.null(h)))
        args <- c(args, h=h)

    for(i in 1:n) {
        data<-datas[[i]]

        # calculate plot parameters
        #   1- and 3-quantile, median, IQR, upper- and lower-adjacent
        data.min <- min(data)
        data.max <- max(data)
        q1[i]<-quantile(data,0.25)
        q3[i]<-quantile(data,0.75)
        med[i]<-median(data)
        iqd <- q3[i]-q1[i]
        upper[i] <- min( q3[i] + range*iqd, data.max )
        lower[i] <- max( q1[i] - range*iqd, data.min )

        #   strategy:
        #       xmin = min(lower, data.min))
        #       ymax = max(upper, data.max))
        #

        est.xlim <- c( min(lower[i], data.min), max(upper[i], data.max) )

        # estimate density curve
        smout <- do.call("sm.density", c( list(data, xlim=est.xlim), args ) )

        # calculate stretch factor
        #
        #  the plots density heights is defined in range 0.0 ... 0.5
        #  we scale maximum estimated point to 0.4 per data
        #
        hscale <- 0.4/max(smout$estimate) * wex

        # add density curve x,y pair to lists
        base[[i]]   <- smout$eval.points
        height[[i]] <- smout$estimate * hscale

        # calculate min,max base ranges
        t <- range(base[[i]])
        baserange[1] <- min(baserange[1],t[1])
        baserange[2] <- max(baserange[2],t[2])

    }

    # pass 2
    #
    # - plot graphics

    # setup parameters for plot
    if(!add){
      xlim <- if(n==1)
               at + c(-.5, .5)
              else
               range(at) + min(diff(at))/2 * c(-1,1)

      if (is.null(ylim)) {
         ylim <- baserange
      }
    }
    if (is.null(names)) {
        label <- 1:n
    } else {
        label <- names
    }

    boxwidth <- 0.05 * wex

    # setup plot
    if(!add)
      plot.new()
    if(!horizontal) {
      if(!add){
        plot.window(xlim = xlim, ylim = ylim)
        axis(2)
        axis(1,at = at, label=label )
      }

      box()
      for(i in 1:n) {
          # plot left/right density curve
          polygon( c(at[i]-height[[i]], rev(at[i]+height[[i]])),
                   c(base[[i]], rev(base[[i]])),
                   col = col[i %% length(col) + 1], border=border, lty=lty, lwd=lwd)

          if(drawRect){
            # plot IQR
            lines( at[c( i, i)], c(lower[i], upper[i]) ,lwd=lwd, lty=lty)

            # plot 50% KI box
            rect( at[i]-boxwidth/2, q1[i], at[i]+boxwidth/2, q3[i], col=rectCol)

            # plot median point
            points( at[i], med[i], pch=pchMed, col=colMed )
         }
      }

    }
    else {
      if(!add){
        plot.window(xlim = ylim, ylim = xlim)
        axis(1)
        axis(2,at = at, label=label )
      }

      box()
      for(i in 1:n) {
          # plot left/right density curve
          polygon( c(base[[i]], rev(base[[i]])),
                   c(at[i]-height[[i]], rev(at[i]+height[[i]])),
                   col = col[i %% length(col) + 1], border=border, lty=lty, lwd=lwd)

          if(drawRect){
            # plot IQR
            lines( c(lower[i], upper[i]), at[c(i,i)] ,lwd=lwd, lty=lty)

            # plot 50% KI box
            rect( q1[i], at[i]-boxwidth/2, q3[i], at[i]+boxwidth/2,  col=rectCol)

            # plot median point
            points( med[i], at[i], pch=pchMed, col=colMed )
          }
      }
    }
    invisible (list( upper=upper, lower=lower, median=med, q1=q1, q3=q3))
}
于 2014-11-18T15:09:39.617 回答
4

不要忘记geom_violin在ggplot2包裹里。在文档中有如何更改填充颜色的示例：http ://docs.ggplot2.org/0.9.3/geom_violin.html

于 2013-02-20T18:19:53.150 回答
4

1×1 绘制向量似乎比修改函数更容易：

require(vioplot)
yalist = list( rnorm(100), rnorm(100, sd = 1),rnorm(100, sd = 2) )
plot(0,0,type="n",xlim=c(0.5,3.5), ylim=c(-10,10),  xaxt = 'n', xlab ="", ylab = "Pc [%]",  main ="Skanderbeg")
for (i in 1:3) { vioplot(na.omit(yalist[[i]]), at = i, add = T, col = c(1:3)[i]) }
axis(side=1,at=1:3,labels=3:1)
于 2015-10-01T10:55:28.433 回答