Представьте, что у нас есть такие данные:

    dat <- structure(list(variable = c("a1", "a1", "a1", "a1", "a1", "a1", 
"a2", "a2", "a2", "a2", "a2", "a2", "a3", "a3", "a3", "a3", "a3", 
"a3", "a4", "a4", "a4", "a4", "a4", "a4"), value = c(9.17804065427195, 
-0.477515191225569, 0.189943035684685, -6.06095979017212, -10.4173631972868, 
-6.119330192816, -14.3820530117637, 13.9823789620469, 15.6437973890843, 
0.754856919261315, -0.887052526388938, 7.4096244573169, 0.61043977214679, 
28.4639357142541, 15.4511442682744, 15.8118136384483, 6.65940292893, 
0.467862281678766, 482.791905769932, 493.606761379037, 491.254828253119, 
504.323684433231, 499.323576709646, 492.625278087471)), .Names = c("variable", 
"value"), row.names = c(NA, -24L), class = "data.frame")

Я хочу построить график value против value для каждого variable, так что у меня есть 6 панелей в следующем формате, где буквы обозначают, где будут оси, и а {{X3 }} показывает, где находится панель.

a2   p
a3   p  p
a4   p  p  p  
    a1  a2 a3   

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

par(.....)
plot(a1 ~ a2, data=longdat)
plot(a1 ~ a3, data=longdat)
plot(a1 ~ a4, data=longdat)
......

Если это все, что я могу сделать, возможно, есть быстрый способ? Предпочтительно я хотел бы знать, есть ли способ сделать это уже, например, facet_wrap или facet_grid в ggplot2

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

enter image description here

Решетка может делать что-то подобное, но не то, что я хочу ..

xyplot(value~value|variable, 
       data = a, 
       scales=list(alternating=FALSE,relation="same"), 
       layout=c(2,2))

С переупорядочиванием данных я мог бы выполнить эту работу, но когда вы меняете relation на "free", чтобы получить разные масштабы по оси для каждой переменной, он затем разбивает панели на отдельные панели.

4
user1322296 9 Мар 2015 в 16:46

3 ответа

Лучший ответ

Изменить: использование GGally (v1.0.1)

Проще использовать функцию ggpairs() из пакета GGally. Позвольте ggpairs() нарисовать и расположить диаграммы рассеяния, а затем удалить ненужные элементы из полученной диаграммы. Во-первых, приведите данные в их широком формате.

# Packages
library(GGally)
library(ggplot2)
library(tidyr)

# Data
dat <- structure(list(variable = c("a1", "a1", "a1", "a1", "a1", "a1", 
"a2", "a2", "a2", "a2", "a2", "a2", "a3", "a3", "a3", "a3", "a3", 
"a3", "a4", "a4", "a4", "a4", "a4", "a4"), 
value = c(9.17804065427195, 
-0.477515191225569, 0.189943035684685, -6.06095979017212, -10.4173631972868, 
-6.119330192816, -14.3820530117637, 13.9823789620469, 15.6437973890843, 
0.754856919261315, -0.887052526388938, 7.4096244573169, 0.61043977214679, 
28.4639357142541, 15.4511442682744, 15.8118136384483, 6.65940292893, 
0.467862281678766, 482.791905769932, 493.606761379037, 491.254828253119, 
504.323684433231, 499.323576709646, 492.625278087471)), .Names = c("variable", 
"value"), row.names = c(NA, -24L), class = "data.frame")

# Get the data in its wide format
dat$id <- sequence(rle(as.character(dat$variable))$lengths)
dat2 = spread(data = dat, key = variable, value = value)


# Base plot 
gg = ggpairs(dat2, 
    columns = 2:5,
    lower = list(continuous = "points"),
    diag = list(continuous = "blankDiag"),
    upper = list(continuous = "blank"))

Использование кода из здесь для обрезки неоткрытых элементов

# Trim off the diagonal spaces
n <- gg$nrow 
gg$nrow <- gg$ncol <- n-1   
v <- 1:n^2
gg$plots <- gg$plots[v > n & v%%n != 0]

# Trim off the last x axis label
# and the first y axis label
gg$xAxisLabels <- gg$xAxisLabels[-n]
gg$yAxisLabels <- gg$yAxisLabels[-1]

# Draw the plot
gg = gg + 
     theme_bw() + 
     theme(panel.grid = element_blank())
gg

enter image description here

Исходный

Функция pairs() приближает вас, но если вы хотите только шесть панелей, как показано в вашей матрице макета, вам, возможно, придется построить их вручную. Вы можете построить диаграмму, используя grid или ggplot и gtable. Вот версия ggplot / gtable.

Скрипт работает с вашим файлом данных dat (т. Е. С длинной формой). Он создает список из шести диаграмм рассеяния ggplot. Графики ggplots преобразуются в grobs, и извлекаются соответствующие оси - те, которые станут левой и нижней осями на новом графике. Макет gtable создается, и к нему добавляются гроши диаграммы рассеяния (только панели графика). Макет модифицируется для размещения осей, затем макет снова изменяется, чтобы принимать переменные метки. Наконец, нужно немного прибраться.

dat <- structure(list(variable = c("a1", "a1", "a1", "a1", "a1", "a1", 
"a2", "a2", "a2", "a2", "a2", "a2", "a3", "a3", "a3", "a3", "a3", 
"a3", "a4", "a4", "a4", "a4", "a4", "a4"), 
value = c(9.17804065427195, 
-0.477515191225569, 0.189943035684685, -6.06095979017212, -10.4173631972868, 
-6.119330192816, -14.3820530117637, 13.9823789620469, 15.6437973890843, 
0.754856919261315, -0.887052526388938, 7.4096244573169, 0.61043977214679, 
28.4639357142541, 15.4511442682744, 15.8118136384483, 6.65940292893, 
0.467862281678766, 482.791905769932, 493.606761379037, 491.254828253119, 
504.323684433231, 499.323576709646, 492.625278087471)), .Names = c("variable", 
"value"), row.names = c(NA, -24L), class = "data.frame")

# Load packages
library("ggplot2")
library("plyr")
library("gtable")
library(grid)

# Number of items and item labels
item = unique(dat$variable)
n = length(item)

## List of scatterplots
scatter <- list()

for (i in 1:(n-1)) {
   for (j in (i+1):n) {

# Data frame 
df.point <- na.omit(data.frame(cbind(x = dat[dat$variable == item[i], 2], y = dat[dat$variable == item[j], 2])))

# Plot
p <- ggplot(df.point, aes(x, y)) +
   geom_point(size = 1) +
   theme_bw() + 
   theme(panel.grid = element_blank(),
          axis.text = element_text(size = 6))

name <- paste0("Item", i, j)
scatter[[name]] <- p
} }

# Convert ggplots to grobs
scatterGrob <- llply(scatter, ggplotGrob)

# Extract the axes as grobs
# x axis
xaxes = subset(scatterGrob, grepl(paste0("^Item.", n), names(scatterGrob))) 
xaxes = llply(xaxes, gtable_filter, "axis-b")

# y axis
yaxes = subset(scatterGrob, grepl("^Item1.*", names(scatterGrob))) 
yaxes = llply(yaxes, gtable_filter, "axis-l")

# Tick marks and tick mark labels are easier to position if they are separated. 
labelsb = list(); ticksb = list(); labelsl = list(); ticksl = list()
for(i in 1:(n-1)) {
  x = xaxes[[i]][[1]][[1]]$children[[2]]
  labelsb[[i]] = x$grobs[[2]]
  ticksb[[i]] = x$grobs[[1]]

  y = yaxes[[i]][[1]][[1]]$children[[2]]
  labelsl[[i]] = y$grobs[[1]]
  ticksl[[i]] = y$grobs[[2]]
} 

## Extract the plot panels
scatterGrob <- llply(scatterGrob, gtable_filter, "panel")

## Set up initial gtable layout
gt <- gtable(unit(rep(1, n-1), "null"), unit(rep(1, n-1), "null"))

# Add scatterplots in the lower half of the matrix
 k <- 1
 for (i in 1:(n-1)) {
    for (j in i:(n-1)) {
 gt <- gtable_add_grob(gt, scatterGrob[[k]], t=j, l=i)
 k <- k+1
 } }

# Add rows and columns for axes
gt <- gtable_add_cols(gt, unit(0.25, "lines"), 0)
gt <- gtable_add_cols(gt, unit(1, "lines"), 0)
gt <- gtable_add_rows(gt, unit(0.25, "lines"), 2*(n-1))
gt <- gtable_add_rows(gt, unit(0.5, "lines"), 2*(n-1))

for (i in 1:(n-1)) {
  gt <- gtable_add_grob(gt, ticksb[[i]], t=(n-1)+1, l=i+2)
  gt <- gtable_add_grob(gt, labelsb[[i]], t=(n-1)+2, l=i+2)
  gt <- gtable_add_grob(gt, ticksl[[i]], t=i, l=2)
  gt <- gtable_add_grob(gt, labelsl[[i]], t=i, l=1)
}

# Add rows and columns for variable names
gt <- gtable_add_cols(gt, unit(1, "lines"), 0)
gt <- gtable_add_rows(gt, unit(1, "lines"), n+1)
for(i in 1:(n-1))  gt <- gtable_add_grob(gt, 
           textGrob(item[i], gp = gpar(fontsize = 8)), t=n+2, l=i+3)
for(i in 2:n)  gt <- gtable_add_grob(gt, 
           textGrob(item[i], rot = 90, gp = gpar(fontsize = 8)), t=i-1, l=1)

# Add small gaps between the panels
for(i in (n-1):2) {
  gt <- gtable_add_cols(gt, unit(0.4, "lines"), i+2)
  gt <- gtable_add_rows(gt, unit(0.4, "lines"), i-1)
}

# Add margins to the whole plot
for(i in c(2*(n-1)+2, 0)) {
    gt <- gtable_add_cols(gt, unit(.75, "lines"), i)
    gt <- gtable_add_rows(gt, unit(.75, "lines"), i)
}

# Turn clipping off
gt$layout$clip = "off"

# Draw it
grid.newpage()
grid.draw(gt)

enter image description here

3
Community 23 Май 2017 в 11:44

Надеюсь, это то, что вам нужно.

X наносится на график против x для каждого z. Переменная после "|" - кондиционирующая переменная. Это используется для достижения результатов, аналогичных facet_grid (). Макет обычно выбирается решеткой в ​​зависимости от размера вашего участка или окна графика. Вы можете заставить макет 2x2, как показано ниже, который, кажется, автоматически помещает пустое пространство вверху справа.

library("lattice")
dat <- data.frame(x=rnorm(15),z=rep(letters[1:3],each=5))
xyplot(x~x|z, data = dat, scales=list(alternating=FALSE), layout=c(2,2))
0
Konn 9 Мар 2015 в 19:32

Из того, что я прочитал по вашему вопросу, все, что вам нужно, это график, который показывает диаграммы рассеяния для каждой пары переменных. Быстро преобразовав данные из длинного в широкий формат с помощью dcast() из пакета reshape2, это легко сделать с помощью pairs() в базовой графике. Следующее:

library(reshape2)

# assign some id variables to assist the conversion and cast
dat$id <- sequence(rle(as.character(dat$variable))$lengths)
dat2 <- dcast(dat, id ~ variable, value.var='value')

# plot
pairs(dat2[2:5], upper.panel=NULL)

Это оставляет нам сюжет, который, я думаю, вам нужен.

enter image description here

Оттуда, если вы хотите добавить значения R-квадрата, гистограммы и т. Д. На диагональные или верхние графики, нужный вам код можно найти здесь: Как изменить этот график матрицы корреляции?

Например:

panel.hist <- function(x, ...)
{
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(usr[1:2], 0, 1.5) )
  h <- hist(x, plot = FALSE)
  breaks <- h$breaks; nB <- length(breaks)
  y <- h$counts; y <- y/max(y)
  rect(breaks[-nB], 0, breaks[-1], y, col="cyan", ...)
}

pairs(dat2[2:5], upper.panel=NULL, diag.panel=panel.hist)

enter image description here

Надеюсь, это поможет.

2
Community 23 Май 2017 в 12:32