如何使用R-ggplot在同一图表中的两个Y轴上绘制条形和一条线？

时间：2014-03-27 23:53:29

标签： r plot ggplot2

如何在一个折线图下面绘制分组条？

该图可以将分类实验（例如准确度）的性能显示为线（比标准更粗）。使用左Y尺度，0 < Accuracy < 1之间的变化，以下文字：“这是准确性”。

然后，特征的数量（例如，用于文本分类）可以用条形表示。正确的Y尺度，0 < NOoFeatures < max(featuresX)之间的变化，文本：“特征数量”。 X-scale，text“每个实验的使用特征”。

实际上有四类文字特征可以表示堆叠（很好）或分组（首选）条形。如果现在所有都将以灰度色调显示，那将是完美的;）

## 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提供（下面）一个非常相似的例子，但我不能适应我的问题（使用条形图）。 

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)

这里问题结束了 - 这是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),
                        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")

2 个答案:

答案 0 :(得分：4)

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

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)

答案 1 :(得分：1)

发布数据样本的Thx！我认为这就是你想要的。 CAVEAT ：我鼓励你并排编辑并重叠这些情节，因为在双轴图上，我坚定地在Few [PDF]阵营中。有一个原因 ggplot2让它很难做到这一点。为此，如果您愿意使用基本图形，那么它非常简单。

# make a data frame for convenience 

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

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

# 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]))))

# 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="", 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)

plot

您可以根据需要调整或添加注释/边距/颜色。我已经做了足够的伤害： - ）

相关问题
最新问题