Я пытаюсь установить галочки в барах, чтобы создать график штрихов (горизонтальный или вертикальный), чтобы дать представление, как масштаб.
Небольшой пример:
myd <- data.frame (names = c("A", "B", "C", "D"), height = c(2.1, 3.5, 3.5,1.5))
require(ggplot2)
c <- ggplot(myd, aes(factor(names), height, fill = names))
c + geom_bar()
c + geom_bar() + coord_flip()
Есть ли простой способ или пакет, который может это сделать?
Довольно долгое решение с использованием библиотеки ggplot2.
Сначала изменил ваш кадр данных - повторяется каждый элемент names и height в зависимости от времени 0.2 в высоте бара.
myd <- data.frame (names = c(rep("A",floor(2.1/0.2)), rep("B",floor(3.5/0.2)), rep("C",floor(3.5/0.2)), rep("D",floor(1.5/0.2))),
height = c(rep(2.1,floor(2.1/0.2)), rep(3.5,floor(3.5/0.2)), rep(3.5,floor(3.5/0.2)), rep(1.5,floor(1.5/0.2))))
ystart и yend представляют собой координаты малых тиков, рассчитанные как последовательность на 0,2 для каждого бара. xstart - x координаты малых тиков. Здесь я предполагаю, что полосы будут шириной 0,5. Если ширина меньше или больше, то координаты должны быть изменены. xend рассчитывается при условии, что тики имеют ширину 0,1 дюйма.
ystart<-c(seq(0.2,2.1,0.2),seq(0.2,3.5,0.2),seq(0.2,3.5,0.2),seq(0.2,1.5,0.2))
yend=ystart
xstart<-c(rep(0.75,floor(2.1/0.2)),rep(1.75,floor(3.5/0.2)),rep(2.75,floor(3.5/0.2)),rep(3.75,floor(1.5/0.2)))
xend<-xstart+0.1
Новые значения добавлены в кадр данных.
myd <-data.frame(myd,ystart,yend,xstart,xend)
p <- ggplot(myd, aes(factor(names), height,fill = names))
p <- p + geom_bar(width=0.5)
#This line adds small ticks (segments) to bars
p <- p + geom_segment(aes(x=xstart,y=ystart,xend=xend,yend=yend))
#This line adds white lines at 1, 2 and 3
p <- p + geom_hline(yintercept=c(1,2,3),color="white",lwd=1.1)
#Next two lines removes legend and makes place for text
p <- p + guides(fill=FALSE)
p <- p + ylim(c(0,4))
#Add numbers over bars
p <- p + annotate("text",x=c(1,2,3,4),y=c(2.4,3.8,3.8,1.8),label=c("2.1","3.5","3.5","1.5"),angle=90,fontface="bold",size=5)
#Adjustment of appearance to remove guidlines and axis ticks
p <- p + theme_bw()
p <- p + theme(axis.title=element_blank(),
axis.text.y=element_blank(),
axis.text.x=element_text(angle=90,face="bold",size=rel(1.5)),
axis.ticks=element_blank(),
panel.border=element_blank(),
panel.grid=element_blank())
print(p)
Произведенная функция ruler.func() - нужен только аргумент - это вектор высот бара. Первая часть функции создает кадр данных, а затем вторая часть делает график.
ruler.func<-function(gg){
seq.list<-list()
for(i in 1:length(gg)){
ystart<-seq(0.2,gg[i],0.2)
yend<-ystart
xstart<-rep(i-0.25,length(ystart))
xend<-xstart+0.1
nam.val<-c(LETTERS[i],rep(NA,length(ystart)-1))
numb.val<-c(gg[i],rep(NA,length(ystart)-1))
seq.list[[i]]<-data.frame(nam.val,numb.val,xstart,xend,ystart,yend)
}
df<-as.data.frame(do.call(rbind, seq.list))
p <- ggplot(df, aes(nam.val))
p <- p + geom_bar(aes(y=numb.val,fill=nam.val),stat="identity",width=0.5,color="black",lwd=1.1)+
scale_x_discrete(limits=LETTERS[1:length(gg)])+
geom_segment(aes(x=xstart,y=ystart,xend=xend,yend=yend))+
geom_hline(yintercept=seq(1,max(gg),1),color="white",lwd=1.1)+
guides(fill=FALSE)+
ylim(c(0,max(gg)+0.5))+
annotate("text",x=seq(1,length(gg),1),y=gg+0.5,label=gg,angle=90,fontface="bold",size=rel(6))+
theme_bw()+
theme(axis.title=element_blank(),
axis.text.y=element_blank(),
axis.text.x=element_text(angle=90,face="bold",size=rel(1.5)),
axis.ticks=element_blank(),
panel.border=element_blank(),
panel.grid=element_blank())
print(p)
}
Пример с цифрами 1.2, 4.6 и 2.8.
ruler.func(c(1.2,4.6,2.8))
Мой подход заключается в настройке гридов сетки с использованием пакета сетки. Это postggplot2 обработка участка. Я использую функции Grid Low-level для настройки, добавив новый рисунок в график ggplot2. Настолько большое преимущество здесь не нужно добавлять данные. Вы можете использовать этот код.
Я думаю, что смесь ggplot2 + обработка сетки является мощным инструментом для настройки графиков.
#get the viewport (here we do the stuff)
library(grid)
library(plyr)
##
grid.edit('geom_rect',gp=gpar(col='black'),grep=T)
## get the panel viewport
vp1 <- grid.get('panel',grep=T)$wrapvp
depth <- downViewport(name=vp1$name)
rects <- grid.get('geom_rect',grep=T)
for(i in 1:4){
## for each axis i create a view port , within it I draw my yaxis
vpaxis <- viewport(x = rects$x[i]+rects$width[i],
y = rects$y[i],
w = 0.005,
h = rects$height[i],
just=c('left','top'),
yscale = c(0,myd$height[i])
)
## I create the axis, you can customize it using the gp parameter
gxa <- yaxisGrob(name='axiss',vp=vpaxis,
at = seq(0,myd$height[i],by=0.5),
gp=gpar(cex=.8))
grid.draw(gxa)
}
## I put a blank background
grid.edit('background.rect',grep=T,gp=gpar(fill=NA))
###
upViewport(depth)
для координатного floop мы используем xaxis, мы меняем цикл for выше на:
for(i in 1:4){
vpaxis <- viewport(x = rects$x[i],
y = rects$y[i],
w = rects$width[i],
h = 0,
just=c('left','top'),
clip=FALSE,
xscale = c(0,myd$height[i]),
)
gxa <- xaxisGrob(name='axiss',vp=vpaxis,
at = seq(0,myd$height[i],by=0.5),
gp=gpar(cex=.8))
grid.draw(gxa)
}
