R добавление таблицы данных к графику ggplot с использованием viewPorts: масштабирование Grob

Вы можете попробовать новую версию 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)

Вы можете использовать, например, таблицу, созданную ggplot, и объединить их, как в этом a-data-table/" rel="nofollow noreferrer">блог. Я сделал упрощенный и рабочий пример здесь:

Сначала создайте свой сюжет:

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)

Обратите внимание, что требуется еще некоторая настройка, например, положение легенды сюжета и аббревиатуры названий городов в таблице, но результат выглядит красиво:

Применительно к вашему примеру:

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)

ИЗМЕНИТЬ:

похоже на решение Денниса, но с барплотом и с + 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()

ИМХО, это не очень хорошая графика. Во-первых, я не понимаю, зачем вам нужно нулевое начало, когда значения варьируются от 300 до 500, что является замаскированным способом сказать, что мне не нравится метафора гистограммы. Вы также пытаетесь использовать штриховку для представления различий в значениях c, которых всего шесть. Вот то, что я считаю более простым подходом к проблеме. Учитывая ваши данные 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")

В этом коде достаточно подсказок, чтобы вы могли пойти в другом направлении. Я оставлю это на ваше усмотрение.