如何在同一图表的两个Y轴上绘制一条线和一条线,使用R-ggplot? [英] How to plot bars and one line on two Y-axes in the same chart, with R-ggplot?

查看:182
本文介绍了如何在同一图表的两个Y轴上绘制一条线和一条线,使用R-ggplot?的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

如何在一条线图下方绘制分组条形图?



该图可以显示分类实验的性能(例如精确度) )。使用左侧的Y尺度, 0<准确度< 1 ,并附以下文字:这是准确性。

然后可以用条来表示特征的数量(例如用于文本分类)。正确的Y尺度, 0 < NOoFeatures< max(featuresX),文本:特征数量。 X-scale,text每个实验使用的功能。

实际上有四类文本特征可以表示堆叠(很好)或分组首选)酒吧。如果现在所有都以灰阶色调显示,那就完美了;)

  ##模拟数据:
performanceExps <-c(0.4,0.5,0.65,0.9)#准确性
FeaturesExp1 <-c(featuresA = 1000,featuresB = 0,featuresC = 0,featuresD = 0)#使用的特征实验1 $ (特征A = 1000,特征B = 5000,特征C = 0,特征D = 0)#使用特征实验2
FeaturesExp3 <-c(特征A = 1000,特征B = 5000,特征C = 10000,featuresD = 0)#使用的功能实验3
FeaturesExp4 <-c(featuresA = 1000,featuresB = 5000,featuresC = 10000,featuresD = 20000)#使用功能实验4

Kohske 优惠(下面)一个非常相似的例子,但我不能适应我的问题(使用酒吧)。

 库(ggplot2)
库(gtable)
库(网格)

grid.newpage()

#两个地块
p1 < - ggplot(mtcars,aes(mpg,disp))+ geom_line(color =blue)+ theme_bw()
p2 < - ggplot(mtcars,aes(mpg,drat))+ geom_line(color =red)+ theme_bw()%+替换%
theme(panel.background = element_rect(fill = NA))

#提取gtable
g1< - ggplot_gtable(ggplot_build(p1))
g2< - ggplot_gtable(ggplot_build(p2))

#与第一个图的第二个图的面板重叠
pp< -c(子集(g1 $布局,名称==面板,se = t:r))
g< - gtable_add_grob(g1,g2 $ grobs [[which(g2 $ layout $ name ==panel)]],pp $ t,
pp $ l,pp $ b,pp $ l)

#axis tweaks
ia< - which(g2 $ layout $ name ==axis-l)
ga < - g2 $ grobs [[ia]]
斧< -ga $ children [[2]]
ax $ widths< - rev(ax $ widths)
ax $ grobs< - rev(ax $ grobs)
ax $ grobs [[1]] $ x< - ax $ grobs [[1]] $ x - u nit(1,npc)+ unit(0.15,cm)
g <-gtable_add_cols(g,g2 $ widths [g2 $ layout [ia,] $ l],length(g $ widths) - 1)
g < - gtable_add_grob(g,ax,pp $ t,length(g $ widths)-1,pp $ b)

grid.draw(g)

问题结束 - 这是hrbmstr的代码(谢谢!)

  featPerf < -  data.frame(expS = c(1,2,3,4 ),
Experiment1 = c(1000,0,0,0),
Experiment2 = c(1000,5000,0,0),
Experiment3 = c(1000,5000,10000, 0),
Experiment4 = c(1000,5000,10000,20000),
准确率= c(0.4,0.5,0.65,0.9))

#轴;根据需要进行调整
par(mar = c(5,12,6,7)+0.4)

#首先绘制条形图,并且没有注释并指定y
# barplot(as.matrix(featPerf [,2:5]),axes = FALSE,xlab =,ylab =,ylim = c(0,max(colSums(featPerf [2:5]))))
barplot(as.matrix(featPerf [,2:5]),axes = FALSE,xlab =,ylab =,旁边= TRUE)

#使边界框或不......你的情节可能没有意义)
#box()

#现在让左轴
轴(2,ylim = c(0, max(colSums(featPerf [2:5]))),col =black,las = 1)

#开始新的绘图
par(new = TRUE)

#绘制线条;根据需要调整lwd
plot(x = 1:4,y = featPerf [,6],xlab =Experiments,ylab =,axes = FALSE,type =l,ylim = c(0 ,1),lwd = 5)

#注释第二轴
轴(4,ylim = c(0,1),col =black,col.axis =black ,las = 1)
#axis(4,ylim = c(0,1),col =black,col.axis =black,las = 1,labels =Accuracy,at = .5,side = 3)

#title(Creative Axes示例,xlab =X values,ylab =Y = X)
mtext(Accuracy ,side = 4,line = 3,cex.lab = 1,las = 2,col =black)
mtext(要素数量,side = 2,line = 3,cex.lab = 1,las = 2,col =black)


解决方案

通过调整Kohske的例子来解决问题。这与hrbrmstr解决方案的结果类似 - 完全同意重新思考剧情。

 库(ggplot2)
库(gtable)
库(reshape2)

#Data
featPerf < - data.frame(exp = c(1,2,3,4),
A = c(1000,1000,1000 ,1000美元),
B = c(0,5000,5000,5000),
C = c(1000,5000,10000,0),
D = c(1000,5000,5000) 10000,20000),
准确率= c(0.4,0.5,0.65,0.9))

#Barplot ------------------ ------------------------------
#重塑barplot的数据
df.m< - 熔化(featPerf [-6])

#barplot的标签
df.m $ barlab< - factor(paste(Experiment,df.m $ exp))

p1 < - ggplot(df.m,aes(x = barlab,y = value,fill = variable))+
geom_bar(stat =identity,position =dodge)+
scale_fill_grey(start = .1,end = .7)+
xlab(Experiments)+
ylab(Number of Labels)+
theme(legend.position = top)
g1 < - ggplotGrob(p1)

#Lineplot --------------------------------- ---------------
p2 < - ggplot(featPerf,aes(x = exp,y = precision,group = 1))+ geom_line(size = 2)+
scale_y_continuous(limits = c(0,1))+
ylab(Accuracy)+
主题(panel.background = element_rect(fill = NA),
面板。 grid.major = element_blank(),
panel.grid.minor = element_blank())
g2 < - ggplotGrob(p2)



pp < - c(子集(g1 $ layout,name ==panel,se = t:r))
g < - gtable_add_grob(g1,g2 $ grobs [[which(g2 $布局$ name ==panel)]],pp $ t,
pp $ l,pp $ b,pp $ l)


#添加第二个坐标轴
ia< - 其中(g2 $ layout $ name ==axis-l)
ga< - g2 $ grobs [[ia]]
ax< - ga $ children [[2]]
ax $ widths< - rev(ax $ widths)
ax $ grobs< - rev(ax $ grobs)
ax $ grobs [[1]] $ x <-ax $ grobs [[1]] $ x - 单位(1,npc)+单位(0.15,cm)
g < - gtable_add_cols(g,g2 $ widths [g2 $ layout [ia,] $ l],长度(g $ widths)-1)
g < gtable_add_grob(g,ax,pp $ t,length(g $ widths) - 1,pp $ b)


#添加第二个y轴标题
ia< - (g2 $ layout $ name ==ylab)
ax< - g2 $ grobs [[ia]]
#str(ax)#您可以更改这些特征(大小,颜色等等) -
#在
ax $ rot < - 270
g < - gtable_add_cols(g,g2 $ widths [g2 $ layout [ia,] $ l],长度(g $宽度) - 1)
g < - gtable_add_grob(g,ax,pp $ t,length(g $ widths) - 1,pp $ b)

grid.draw(g)


How is it possible to plot grouped bars below one line graph?

The figure could show the performance of classification experiments (e.g. Accuracy) as line (thicker then standard). Using the left Y-scale, variation between 0 < Accuracy < 1, with following text: "This is accuracy".

Then the the number of features (e.g. for text classification), may be expressed by bars. Right Y-scale, variation between 0 < NOoFeatures < max(featuresX), text: "No. of features". X-scale, text "The used features for each experiment".

There are actually four categories of text features which could be represented stacked (would be nice) or grouped (preferred) bars. If now all would be displayed in gray-scale tones, would be perfect ;)

## Mock-up data:
performanceExps <- c(0.4, 0.5, 0.65, 0.9) # Accuracy
FeaturesExp1 <- c(featuresA=1000, featuresB=0, featuresC=0, featuresD=0) # Used features Experiment 1
FeaturesExp2 <- c(featuresA=1000, featuresB=5000, featuresC=0, featuresD=0) # Used features Experiment 2
FeaturesExp3 <- c(featuresA=1000, featuresB=5000, featuresC=10000, featuresD=0) # Used features Experiment 3
FeaturesExp4 <- c(featuresA=1000, featuresB=5000, featuresC=10000, featuresD=20000) # Used features Experiment 4

Kohske offers (below) one example which is pretty similar, but I cannot adapt it to my problem (use bars).

library(ggplot2)
library(gtable)
library(grid)

grid.newpage()

# two plots
p1 <- ggplot(mtcars, aes(mpg, disp)) + geom_line(colour = "blue") + theme_bw()
p2 <- ggplot(mtcars, aes(mpg, drat)) + geom_line(colour = "red") + theme_bw() %+replace% 
  theme(panel.background = element_rect(fill = NA))

# extract gtable
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))

# overlap the panel of 2nd plot on that of 1st plot
pp <- c(subset(g1$layout, name == "panel", se = t:r))
g <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], pp$t, 
                     pp$l, pp$b, pp$l)

# axis tweaks
ia <- which(g2$layout$name == "axis-l")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)
ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)

grid.draw(g)

Here the question ends -- This is the code of hrbmstr (thank you!)

featPerf <- data.frame( expS=c("1", "2", "3", "4"),
                        Experiment1=c(1000, 0, 0, 0),
                        Experiment2=c(1000, 5000, 0, 0),
                        Experiment3=c(1000, 5000, 10000, 0),
                        Experiment4=c(1000, 5000, 10000,20000),
                        accuracy=c(0.4, 0.5, 0.65, 0.9) )

# make room for both axes ; adjust as necessary
par(mar=c(5, 12, 6, 7) + 0.4) 

# plot the bars first with no annotations and specify limits for y
#barplot(as.matrix(featPerf[,2:5]), axes=FALSE, xlab="", ylab="", ylim=c(0, max(colSums(featPerf[2:5]))))
barplot(as.matrix(featPerf[,2:5]), axes=FALSE, xlab="", ylab="", beside=TRUE)

# make the bounding box (or not...it might not make sense for your plot)
#box()

# now make the left axis
axis(2, ylim=c(0, max(colSums(featPerf[2:5]))), col="black", las=1)

# start a new plot
par(new=TRUE)

# plot the line; adjust lwd as necessary
plot(x=1:4, y=featPerf[,6], xlab="Experiments", ylab="", axes=FALSE, type="l", ylim=c(0,1), lwd=5)

# annotate the second axis
axis(4, ylim=c(0,1), col="black", col.axis="black", las=1)
#axis(4, ylim=c(0,1), col="black", col.axis="black", las=1, labels="Accuracy", at = .5, side=3)

#title("An Example of Creative Axes", xlab="X values", ylab="Y=X")
mtext("Accuracy", side=4, line=3, cex.lab=1,las=2, col="black")
mtext("No. of features    ", side=2, line=3, cex.lab=1,las=2, col="black")

解决方案

Solution by tweaking Kohske's example. This is results in similar plot to hrbrmstr's solution - completely agree over rethinking the plot.

library(ggplot2)
library(gtable)
library(reshape2)

# Data
featPerf <- data.frame( exp=c("1", "2", "3", "4"),
                    A=c(1000, 1000, 1000, 1000),
                    B=c(0, 5000, 5000, 5000),
                    C=c(1000, 5000, 10000, 0),
                    D=c(1000, 5000, 10000 ,20000),
                    accuracy=c(0.4, 0.5, 0.65, 0.9) )

# Barplot ------------------------------------------------
# Reshape data for barplot
df.m <- melt(featPerf[-6])

# Labels for barplot
df.m$barlab <- factor(paste("Experiment", df.m$exp) )

p1 <- ggplot(df.m , aes(x=barlab, y=value, fill=variable)) + 
           geom_bar( stat="identity", position="dodge") +
           scale_fill_grey(start =.1, end = .7 ) +
           xlab("Experiments") + 
           ylab("Number of Labels") + 
           theme(legend.position="top")
g1 <- ggplotGrob(p1)

# Lineplot ------------------------------------------------
p2 <- ggplot(featPerf , aes(x=exp, y=accuracy, group=1)) + geom_line(size=2)  + 
            scale_y_continuous(limits=c(0,1)) + 
            ylab("Accuracy") +
            theme(panel.background = element_rect(fill = NA),
                  panel.grid.major = element_blank(), 
                  panel.grid.minor = element_blank())
g2 <- ggplotGrob(p2)


# Add plots together
pp <- c(subset(g1$layout, name == "panel", se = t:r))
g <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], pp$t, 
                 pp$l, pp$b, pp$l)


# Add second axis for accuracy
ia <- which(g2$layout$name == "axis-l")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)
ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)


# Add second y-axis title 
ia <- which(g2$layout$name == "ylab")
ax <- g2$grobs[[ia]]
# str(ax) # you can change features (size, colour etc for these - 
# change rotation below 
ax$rot <- 270
g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)

grid.draw(g)

这篇关于如何在同一图表的两个Y轴上绘制一条线和一条线,使用R-ggplot?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆