Как построить скрипичный ящик (в R)?

Ответ 1

Make.Funny.Plot делает более или менее то, что я думаю, что он должен делать. Чтобы адаптироваться в соответствии с вашими потребностями и может быть оптимизирован немного, но это должно быть приятным началом.

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)

EDIT: исправлено так, что оно всегда работает.

Ответ 2

Недавно я наткнулся на упаковку с пчелиным теплом, которая имеет некоторое сходство.

Пчелиный рой одномерный график рассеяния, как "стрипчарт", но с плотно упакованным, непересекающиеся точки.

Вот пример:

  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 на www.cbs.dtu.dk)}

Ответ 3

Я придумал код, похожий на Joris, но я думаю, что это больше, чем сюжетный сюжет; здесь я имею в виду, что они имеют значение в каждой серии, это абсолютное значение расстояния до среднего значения в бункере, а значение x больше о том, является ли значение более низким или более высоким, чем среднее.
Пример кода (иногда срабатывает предупреждения, но работает):

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

Попробуйте vioplot пакет:

library(vioplot)
vioplot(rnorm(100))

(с ужасным цветом по умолчанию; -)

Существует также wvioplot() в пакете wvioplot для взвешенного скрипичного сюжета и beanplot, который объединяет графики скрипки и ковра. Они также доступны через пакет lattice, см. ?panel.violin.

Ответ 5

Так как это еще не упоминалось, есть также ggbeeswarm как относительно новый пакет R на основе ggplot2.

Что добавляет другую геометрию к ggplot, которая будет использоваться вместо geom_jitter или тому подобное.

В частности, geom_quasirandom (см. второй пример ниже) дает действительно хорошие результаты, и я фактически адаптировал его как график по умолчанию.

Примечательно также, что пакет vipor (VIolin POints в R), который производит графики, используя стандартную графику R, и на самом деле также используемый ggbeeswarm за кулисами.

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