2014-03-27 317 views
1

如何在單線圖下面繪製分組條形圖?如何在同一圖表的兩個Y軸上繪製一條直線和一條直線,用R-ggplot?

該圖可以顯示分類實驗(例如,準確性)作爲線(較厚則標準)的性能。使用左邊的Y尺度,0 < Accuracy < 1之間的變化,並附以下文字:「這是準確性」。

然後可以用條來表示特徵的數量(例如用於文本分類)。正確的Y尺度,0 < NOoFeatures < max(featuresX)之間的變化,文本:「功能號碼」。 X-scale,文字「每個實驗使用的功能」。

實際上有四種類型的文本特徵可以表示堆疊(很好)或分組(優選)。如果現在一切都會在灰階色調顯示,將是完美的;)

## 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") 
+0

什麼是您的數據,至少是您想要它的樣子的模型,除了粘貼RPubs樣本之外,您還嘗試了什麼? – hrbrmstr

+0

@hrbrmstr謝謝:)我添加了模擬數據到上面的描述。 – alex

回答

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

它的工作:)太棒了!謝謝。你很棒。然而,是否可以在'ggplot p1'之後設置灰度'+ scale_fill_grey(start = .1,end = .7)'(作品),添加比例'xLabels < - c(「Experiment1」,「Experiment2」,「Experiment3 「,」Experiment4「)'(不工作),'xName =」Experiments「(不工作),'yLeftName =」標籤數量'','yRightName' =「精度」'(不工作)。 – alex

+0

該圖顯示了我在實驗中使用的不同(附加)特徵的準確性的影響。如果你想看到完美的非ggplot(除了缺少的圖例),請使用我的問題下面的代碼。謝謝:) – alex

+0

@alex;更新 - 還有一些東西需要調整 - 玩得開心。 – user20650

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

您可以調整或添加註解/利潤率/顏色,因爲你需要。我已經做了足夠的損害,它的方式:-)

+0

謝謝,非常好!是否可以使列分組。此外,我在我的問題下面添加了您的改編代碼,以顯示我如何設想堆疊列。我經常沒有我想要的那麼精確(對不起!)。謝謝你的pacience': - |' – alex

+0

你好,謝謝!我達到了變化(見上面的評論)。請檢查並添加我的問題下方的代碼以回答最初的問題(堆疊,分組)。由於我很新,如果你可以節省一點時間,我會很感激,如果你改變了代碼,以避免與ylab文本的列縮放崩潰,並在y-skales之間添加一個基本的圖例,線和酒吧(這在技術上是可能的),沒有邊界。十分感謝。我星期一提交論文,需要數小時才能找到答案。 – alex

+0

觀察到另一個問題。如果在右側添加'labels =「Accuraces」',我會遇到一個有線錯誤''labels'被提供,而不是'at''謝謝。 – alex

相關問題