简体   繁体   中英

How to plot bars and one line on two Y-axes in the same chart, with R-ggplot?

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

The figure could show the performance of classification experiments (eg 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 (eg 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)

Thx for posting a data sample! I think this is what you want. CAVEAT : I encourage you to do side-by-side vs overlay the plots since I'm firmly in the Few [PDF] camp when it comes to dual axes plots. There's a reason ggplot2 makes it wicked hard to do it. To that end, if you are willing to resort to base graphics, it's pretty straightforward.

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

情节

You can adjust or add annotations/margins/colors as you need to. I've done enough damage the way it is :-)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM