Как нанести столбцы и одну линию на две оси Y на одном графике с помощью R-ggplot?

Как можно построить сгруппированные бары под одним линейным графиком?

На рисунке можно показать результаты экспериментов по классификации (например, точность) в виде линии (более толстой, чем стандартная). Используя левую шкалу Y, изменение между 0 < Accuracy < 1со следующим текстом: "Это точность".

Тогда количество признаков (например, для классификации текста) может быть выражено столбцами. Правая шкала Y, разница между 0 < NOoFeatures < max(featuresX)Текст: "Количество функций". X-шкала, текст "Используемые функции для каждого эксперимента".

На самом деле есть четыре категории текстовых объектов, которые могут быть представлены сгруппированными (было бы неплохо) или сгруппированными (предпочтительными) столбцами. Если бы сейчас все отображалось в оттенках серого, было бы идеально;)

## 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 ответа

Решение

Решение путем настройки примера 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)
Источник

Спасибо за размещение образца данных! Я думаю, что это то, что вы хотите. ПРЕДУПРЕЖДЕНИЕ. Я призываю вас выполнять параллельное наложение графиков, поскольку я твердо нахожусь в лагере " Немного [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)

сюжет

Вы можете настроить или добавить аннотации / поля / цвета, как вам нужно. Я сделал достаточно повреждений, как это:-)

Источник
Другие вопросы по тегам