directlabels: использование разных методов позиционирования для разных панелей на одном графике

Question

У меня есть двухпанельный решетчатый линейный участок. Я хочу использовать directlabels пакет для автоматической маркировки линий на каждом графике. Но я хочу использовать разные методы позиционирования для каждого сюжета. В частности, я хочу использовать first.bumpup метод для первой панели, а last.bumpup метод для второй панели. Вот минимальный пример:

library(directlabels)
library(lattice)
myDF <- data.frame(
  y     = rep(1:4,         2),
  x     = rep(rep(1:2, 2), 2),
  group = rep(c('a', 'b'), each = 2),
  panel = rep(1:2,         each = 4))
myPlot <- xyplot(y ~ x | panel, groups = group, data = myDF, type = 'l')
direct.label(
  p      = myPlot,
  method = 'first.bumpup')

Этот код создает график, на котором метки появляются с левой стороны каждой панели:

Я хочу, чтобы надписи были на левой стороне левой панели (как в этом примере), но на правой стороне правой панели. Какой самый простой способ создать такую ​​фигуру?

Я проверил расширенные примеры в directlabels документации, и они заставляют меня думать, что возможно использовать разные методы для разных панелей, создав собственный метод позиционирования или собственную панель. Но я не совсем понимаю, как это сделать.

Answer 1

Я взял трещину в этом с ggplot2 (только потому что я знаю ggplot2 намного лучше чем я знаю lattice). Дайте мне знать, что вы думаете. Ниже приведены два подхода. Первый на самом деле не использует directlabels, Правило размещения относительно простое, поэтому я просто использовал geom_text для размещения этикетки. Второй метод использует directlabels, но сложнее.

Поместите метки, используя geom_text

library(dplyr)   # For chaining operator (%>%)
library(ggplot2)
library(cowplot) # For cowplot theme

ggplot(myDF, aes(x, y, colour=group)) + 
  geom_line() +
  geom_text(data=myDF %>% group_by(panel) %>%
              filter(ifelse(panel==1, x==min(x), x==max(x))),
            aes(x + 0.07*(panel-mean(panel)), y, label=group)) +
  facet_grid(~panel) +
  scale_x_continuous(breaks=seq(1,2,0.2)) +
  theme_cowplot() +
  guides(colour=FALSE)

В коде выше, внутри geom_text мы держим только самые низкие x значение для первой панели и наибольшее x значение на второй панели, а затем поместите group этикетки на y значения, которые соединяются с x ценности. x + 0.07*(panel-mean(panel)) это просто немного отодвинуть метки от концов линий.

Поместите метки, используя mapply а также directlabels

Вот более сложный метод с использованием directlabels, Мой подход состоял в том, чтобы построить каждый "аспект" отдельно, используя mapplyчтобы я мог использовать другой directlabels метод для каждой панели, но затем выложите два графика вместе, как если бы они были двумя гранями одного общего графика. Если вам нравится результат, может быть, вы можете адаптировать его к lattice подготовьте график, если ни одна из версий ggplot2 не отвечает вашим потребностям.

library(directlabels)
library(ggplot2)
library(gridExtra)
library(cowplot)

pl = mapply(function(pnl, m) {

  # Create plot for each level of panel
  p = ggplot(myDF[myDF$panel==pnl, ], aes(x, y, colour=group)) + 
    geom_line() +
    facet_grid(~panel) +
    scale_x_continuous(breaks=seq(1,2,0.2)) +
    theme_cowplot()

  # # Tweak margins of panel 1
  # if(pnl==1) p = p + theme(plot.margin=unit(rep(0,4),"lines"))

  # Remove y-axis title, labels and ticks for panel 2 and tweak margins
  if(pnl==2) p = p + theme(axis.title.y=element_blank(), 
                           axis.text.y=element_blank(),
                           axis.ticks.y=element_blank())

  # Add directlabels with different method for each panel
  direct.label(p, method=m)
  }, 
  pnl=unique(myDF$panel), m=c("first.bumpup", "last.bumpup"), SIMPLIFY=FALSE)

Поскольку я удалил заголовок оси Y, метки и метки на панели 2, эта панель шире панели 1. plot_grid имеет align аргумент, который позволяет нам выровнять два графика так, чтобы они имели одинаковую ширину, но я не знаю способа избавиться от пространства между графиками. grid.arrange также выложим эти графики, но мы должны отрегулировать ширину вручную (вы можете отрегулировать ширину вручную с помощью plot_grid также).

# Lay out each panel using plot_grid from cowplot package
plot_grid(plotlist=pl, ncol=2, align="v")

# Lay out each panel using grid.arrange from gridExtra package
grid.arrange(grobs=pl, ncol=2, widths=c(10,9))

Answer 2

Вот адаптация второго решения eipi10, которое создает желаемый эффект на графике решетки:

library(directlabels)
library(gridExtra)
library(lattice)

myDF <- data.frame(
  y     = rep(1:4,         2),
  x     = rep(rep(1:2, 2), 2),
  group = rep(c('a', 'b'), each = 2),
  panel = rep(1:2,         each = 4))

plotFunction <- function(panelNumber, labelMethod) {
  myPlot = xyplot(
    y ~ x, 
    groups = group, 
    data   = myDF[myDF$panel==panelNumber, ], 
    type   = 'l')
  direct.label(
    p      = myPlot,
    method = labelMethod)  
} 

panelList = mapply(
  FUN         = plotFunction, 
  panelNumber = unique(myDF$panel), 
  labelMethod = c('first.bumpup', 'last.bumpup'), 
  SIMPLIFY    = FALSE)

grid.arrange(grobs = panelList, ncol = 2)