如何创建不同颜色的小提琴剧情？

Question

我正在使用包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") 

谢谢。

Answer 1

不可能有很多颜色。但是，破解功能vioplot并编辑源代码并不困难。下面的步骤，您应该遵循做到这一点：

1. 复制的初始功能：

   my.vioplot <- vioplot() 
   

2. 编辑这样的功能：

   edit(my.vioplot) 
   

3. 搜索词 “多边形” 和和替换col by col [i]

4. 在beginni中做一个测试对于您给出单一颜色的情况，可以使用ng函数。并加入这一行：使用你的数据

   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") 

Answer 2

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

Answer 3

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

在脚本中使用源代码（“vioplot.R”）而不是库（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)) 
} 

Answer 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)