R使用視口添加數據表到ggplot圖：縮放Grob

Question

我想添加一個數據表到ggplot中製作的圖表（類似於excel功能但具有更改軸的靈活性）

我已經有幾無二它，並保持擊中縮放等等問題嘗試1）是

library(grid) 
library(gridExtra) 
library(ggplot2) 
xta=data.frame(f=rnorm(37,mean=400,sd=50)) 
xta$n=0 
for(i in 1:37){xta$n[i]<-paste(sample(letters,4),collapse='')} 
xta$c=0 
for(i in 1:37){xta$c[i]<-sample((1:6),1)} 
rect=data.frame(xmi=seq(0.5,36.5,1),xma=seq(1.5,37.5,1),ymi=0,yma=10) 
xta=cbind(xta,rect) 
a = ggplot(data=xta,aes(x=n,y=f,fill=c)) + geom_bar(stat='identity') 
b = ggplot(data=xta,aes(x=n,y=5,label=round(f,1))) + geom_text(size=4) + geom_rect(aes(xmin=xmi,xmax=xma,ymin=ymi,ymax=yma),alpha=0,color='black') 
z = theme(axis.text=element_blank(),panel.background=element_rect(fill='white'),axis.ticks=element_blank(),axis.title=element_blank()) 
b=b+z 
la=grid.layout(nrow=2,ncol=1,heights=c(0.15,2),default.units=c('null','null')) 
grid.show.layout(la) 
grid.newpage() 
pushViewport(viewport(layout=la)) 
print(a,vp=viewport(layout.pos.row=2,layout.pos.col=1)) 
print(b,vp=viewport(layout.pos.row=1,layout.pos.col=1)) 

它生產

第二次嘗試2）是

xta1=data.frame(t(round(xta$f,1))) 
xtb=tableGrob(xta1,show.rownames=F,show.colnames=F,show.vlines=T,gpar.corefill=gpar(fill='white',col='black'),gp=gpar(fontsize=12),vp=viewport(layout.pos.row=1,layout.pos.col=1)) 
grid.newpage() 
la=grid.layout(nrow=2,ncol=1,heights=c(0.15,2),default.units=c('null','null')) 
grid.show.layout(la) 
grid.newpage() 
pushViewport(viewport(layout=la)) 
print(a,vp=viewport(layout.pos.row=2,layout.pos.col=1)) 
grid.draw(xtb) 

它生產

和最後3）

grid.newpage() 
print(a + annotation_custom(grob=xtb,xmin=0,xmax=37,ymin=450,ymax=460)) 

它生產

其中選項2將是最好的，如果我可以將tableGrob縮放到與情節相同的大小，但我不知道該怎麼做。任何關於如何進一步採取的指針？ - 謝謝

Answer 1

您可以嘗試tableGrob的新版本;所產生的gtable寬度/高度可以設置爲特定的大小（這裏等距分佈的NPC單位）

library(ggplot2) 
library(gridExtra) 
library(grid) 
tg <- tableGrob(head(iris), rows=NULL) 
tg$widths <- unit(rep(1/ncol(tg),ncol(tg)),"npc") 
tg$heights <- unit(rep(1/nrow(tg),nrow(tg)),"npc") 

qplot(colnames(iris), geom="bar")+ theme_bw() + 
    scale_x_discrete(expand=c(0,0)) + 
    scale_y_continuous(lim=c(0,2), expand=c(0,0)) + 
    annotation_custom(ymin=1, ymax=2, xmin=-Inf, xmax=Inf, tg) 

Answer 2

您可以使用例如ggplot創建的表格，並將它們結合起來使用，如blog。我在這裏做了簡化和工作示例：

首先出示你的情節：

library(ggplot2) 
library(reshape2) 
library(grid) 

df <- structure(list(City = structure(c(2L, 
    3L, 1L), .Label = c("Minneapolis", "Phoenix", 
    "Raleigh"), class = "factor"), January = c(52.1, 
    40.5, 12.2), February = c(55.1, 42.2, 16.5), 
    March = c(59.7, 49.2, 28.3), April = c(67.7, 
     59.5, 45.1), May = c(76.3, 67.4, 57.1), 
    June = c(84.6, 74.4, 66.9), July = c(91.2, 
     77.5, 71.9), August = c(89.1, 76.5, 
     70.2), September = c(83.8, 70.6, 60), 
    October = c(72.2, 60.2, 50), November = c(59.8, 
     50, 32.4), December = c(52.5, 41.2, 
     18.6)), .Names = c("City", "January", 
    "February", "March", "April", "May", "June", 
    "July", "August", "September", "October", 
    "November", "December"), class = "data.frame", 
    row.names = c(NA, -3L)) 

dfm <- melt(df, variable = "month") 

levels(dfm$month) <- month.abb 
p <- ggplot(dfm, aes(month, value, group = City, 
    colour = City)) 
p1 <- p + geom_line(size = 1) + theme(legend.position = "top") + xlab("") 

下產生ggplot的數據表。使用相同x軸的情節：

none <- element_blank() 
data_table <- ggplot(dfm, aes(x = month, y = factor(City), 
    label = format(value, nsmall = 1), colour = City)) + 
    geom_text(size = 3.5) + 
    scale_y_discrete(labels = abbreviate)+ theme_bw() + 
    theme(panel.grid.major = none, legend.position = "none", 
     panel.border = none, axis.text.x = none, 
     axis.ticks = none) + theme(plot.margin = unit(c(-0.5, 
    1, 0, 0.5), "lines")) + xlab(NULL) + ylab(NULL) 

兩者結合起來使用視：

Layout <- grid.layout(nrow = 2, ncol = 1, heights = unit(c(2, 
    0.25), c("null", "null"))) 
grid.show.layout(Layout) 
vplayout <- function(...) { 
    grid.newpage() 
    pushViewport(viewport(layout = Layout)) 
} 

subplot <- function(x, y) viewport(layout.pos.row = x, 
    layout.pos.col = y) 

mmplot <- function(a, b) { 
    vplayout() 
    print(a, vp = subplot(1, 1)) 
    print(b, vp = subplot(2, 1)) 
} 

mmplot(p1, data_table) 

注意，仍然需要一些調整，如情節的傳奇人物的位置和的abbrevation城市名稱的表格，但結果看起來不錯：

適用於你的例子：

library(grid) 
library(gridExtra) 
library(ggplot2) 
xta=data.frame(f=rnorm(37,mean=400,sd=50)) 
xta$n=0 
for(i in 1:37){xta$n[i]<-paste(sample(letters,4),collapse='')} 
xta$c=0 
for(i in 1:37){xta$c[i]<-sample((1:6),1)} 
rect=data.frame(xmi=seq(0.5,36.5,1),xma=seq(1.5,37.5,1),ymi=0,yma=10) 
xta=cbind(xta,rect) 
a = ggplot(data=xta,aes(x=n,y=f,fill=c)) + geom_bar(stat='identity')+ theme(legend.position = "top")+xlab("") 

none <- element_blank() 
z=ggplot(xta, aes(x = n, y = "fvalues", 
    label = round(f,1)))+ 
    geom_text(size = 3)+ theme_bw() + 
    theme(panel.grid.major = none, legend.position = "none", 
     panel.border = none, axis.text.x = none, 
     axis.ticks = none) + theme(plot.margin = unit(c(-0.5, 
    1, 0, 0.5), "lines")) + xlab(NULL) + ylab(NULL) 

Layout <- grid.layout(nrow = 2, ncol = 1, heights = unit(c(2, 
    0.25), c("null", "null"))) 
grid.show.layout(Layout) 
vplayout <- function(...) { 
    grid.newpage() 
    pushViewport(viewport(layout = Layout)) 
} 

subplot <- function(x, y) viewport(layout.pos.row = x, 
    layout.pos.col = y) 

mmplot <- function(a, b) { 
    vplayout() 
    print(a, vp = subplot(1, 1)) 
    print(b, vp = subplot(2, 1)) 
} 

mmplot(a, z) 

編輯：

類似於丹尼斯自己的解決方案，但不是barplot與+ coord_flip()。您可以刪除後者，如果你不想甩掉它，但它增加了可讀性：

ggplot(xta, aes(x=n,y=f,fill=c)) + 
    geom_bar() + 
    labs(color = "c") + 
    geom_text(aes(y = max(f)+30, label = round(f, 1)), size = 3, color = "black") + coord_flip() 

Answer 3

恕我直言，這不是一個精心設計的圖形。首先，我不明白爲什麼當數值範圍從300到500時，你需要一個零原點，這是一種變相的說法，我不喜歡條形圖隱喻。你也試圖用欄填充來表示c值的差異，其中只有6個值。我相信這是解決問題的一種更簡單的方法。鑑於你的xta數據，

# Convert the categories to a factor 
xta$N <- factor(xta$n, levels = xta$n) 

# Simple approach: 
ggplot(xta, aes(x = f, y = N, color = factor(c))) + 
    geom_point() + 
    labs(color = "c") + 
    geom_text(aes(x = 575, label = round(f, 1)), size = 4, color = "black") 

這對我來說不是一個有趣的圖形。根據問題的上下文，可能會增加一點洞察力的是按遞增順序對響應進行排序，並添加一個尺寸審美以標明c的級別之間的差異。 （您也可以使用沒有顏色的尺寸。）最後，因爲我們將因子水平放置在垂直軸上，以便它們的標籤清晰可見，所以我們還可以通過稍微擴展水平軸來將f值作爲文本插入。

ggplot(xta, aes(x = f, y = reorder(N, f), color = factor(c), size = c)) + 
    geom_point() + 
    labs(color = "c") + 
    geom_text(aes(x = 575, label = round(f, 1)), size = 4, color = "black") 

在這段代碼中有足夠的提示讓你採取不同的方向。我會留給你的。