Блог

Главная - Вопросы по программированию - Фиксация вытянутых фигур рядом друг с другом в R

Фиксация вытянутых фигур рядом друг с другом в R

#r #ggplot2

#r #ggplot2

Вопрос:

Я пытаюсь воспроизвести тему этого графика с помощью ggplot, я искал в Интернете статьи и вопросы, чтобы показать мне, как присвоить этим графикам правильный размер и положение, а также назначить форму плотной точки, и я нашел несколько статей, в которых обсуждалось изменение положения, я попробовал следующее:

 d1<-read.csv("./data/games.csv")
p.1<-ggplot(d1, aes(x=cream_rating, y=charcoal_rating))   
  # Map winner on color. Add some transparency in case of overplotting
  geom_point(aes(color = winner), alpha = 0.2)  
  # Add the cross: Add geom_pints with one variable fixed on its mean
  geom_point(aes(x = mean(cream_rating), color = winner), alpha = 0.2)  
  geom_point(aes(y = mean(charcoal_rating), color = winner), alpha = 0.2)  
  scale_shape_manual(values=c(16, 17))  
  # "draw"s should be dropped and removed from the title
  scale_color_manual(values = c(cream = "seagreen4", charcoal = "chocolate3", draw = NA))  
  ggtitle("Rating of Cream vs Charcoal")  
  xlab("rating of cream")   ylab("rating of charcoal")   theme_classic()   theme(plot.title = element_text(hjust = 0.5))

Я попробовал следующее, чтобы разместить их вместе:

 require(gridExtra)
plot.1<-p.1
plot.2<-ggExtra::ggMarginal(p.1, type = "histogram")
grid.arrange(plot.1, plot.2, ncol=3)
  
 library(cowplot)

theme_set(theme_cowplot())

plot.1<-p.1
plot.2<-ggExtra::ggMarginal(p.1, type = "histogram")

plot_grid(plot.1, plot.2, labels = "AUTO")
  
 cowplot::plot_grid(plot.1, plot.2, labels = "AUTO")
  
 
library(magrittr)
library(multipanelfigure)
figure1 <- multi_panel_figure(columns = 2, rows = 1, panel_label_type = "none")
# show the layout
figure1

figure1 %<>%
  fill_panel(plot.1, column = 1, row = 1) %<>%
  fill_panel(plot.2, column = 2, row = 1) %<>%
  
figure1

Это моя структура набора данных:

 structure(list(rated = c(FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, 
TRUE, FALSE, TRUE, TRUE), turns = c(13L, 16L, 61L, 61L, 95L, 
5L, 33L, 9L, 66L, 119L), victory_status = structure(c(3L, 4L, 
2L, 2L, 2L, 1L, 4L, 4L, 4L, 2L), .Label = c("draw", "mate", "outoftime", 
"resign"), class = "factor"), winner = structure(c(2L, 1L, 2L, 
2L, 2L, 3L, 2L, 1L, 1L, 2L), .Label = c("charcoal", "cream", 
"draw"), class = "factor"), increment_code = structure(c(3L, 
7L, 7L, 5L, 6L, 1L, 1L, 4L, 2L, 1L), .Label = c("10 0", "15 0", 
"15 2", "15 30", "20 0", "30 3", "5 10"), class = "factor"), 
    cream_rating = c(1500L, 1322L, 1496L, 1439L, 1523L, 1250L, 
    1520L, 1413L, 1439L, 1381L), charcoal_rating = c(1191L, 1261L, 
    1500L, 1454L, 1469L, 1002L, 1423L, 2108L, 1392L, 1209L)), row.names = c(NA, 
10L), class = "data.frame")

Это то, чего я хочу достичь:введите описание изображения здесь

Я попробовал предложение Стефана (которое очень помогло) с некоторыми изменениями:

 d1<-read.csv("./data/games.csv")
ggplot(d1, aes(x=cream_rating, y=charcoal_rating))   
  ##### Map winner on color. Add some transparency in case of overplotting
  geom_point(aes(color = winner), alpha = 0.2)  
  ##### Add the cross: Add geom_pints with one variable fixed on its mean
  geom_point(aes(x = mean(cream_rating), color = winner), alpha = 0.2)  
  geom_point(aes(y = mean(charcoal_rating), color = winner), alpha = 0.2)  
  scale_shape_manual(values=c(16, 17))  
  ##### "draw"s should be dropped and removed from the title
  scale_color_manual(values = c(cream = "seagreen4", charcoal = "chocolate3", draw = NA))  
  ggtitle("Rating of Cream vs Charcoal")  
  xlab("rating of cream")   ylab("rating of charcoal")   theme_bw()   theme(plot.title = element_text(hjust = 0.5))

Я хочу отфильтровать «рисование» из графика, также, когда я меняю точечные фигуры на треугольники и круги, они, похоже, не меняются, кроме того, я получаю эту ошибку:

 Warning message:
“Removed 950 rows containing missing values (geom_point).”
Warning message:
“Removed 950 rows containing missing values (geom_point).”
Warning message:
“Removed 950 rows containing missing values (geom_point).”

Еще одна вещь, которую я заметил, я получаю двойной крест вместо одного!

Это мой вывод: введите описание изображения здесь

Когда я пробую первый блок кода в этом вопросе, я получаю длинные искаженные фигуры, а не квадратные рядом друг с другом.

Ответ №1:

Возможно, это соответствует вашим потребностям. Чтобы склеить три графика вместе, я использую cowplot пакет. Легенда, вероятно, все еще не идеальна.

  1. Чтобы получить только одну легенду, но при этом обеспечить хорошее выравнивание графиков, я сделал легенды для первого и третьего графика «прозрачными» guide_legend для просмотра и theme опций

  2. Чтобы сделать все графики одинакового размера, я добавил прозрачные поля на точечный график

  3. Чтобы исправить положение и сделать графики квадратными, я установил одинаковые ограничения для обеих осей с помощью xlim и ylim и установил соотношение сторон равным 1 с помощью theme() 

 library(ggplot2)
library(dplyr)
library(cowplot)

# Add a second draw to the example data to make the density work
d1 <- d1 %>% 
  add_row(winner = "draw", cream_rating = 1002, charcoal_rating = 1250)

# Get the limits

lims <- c(floor(min(d1$cream_rating, d1$charcoal_rating)), ceiling(max(d1$cream_rating, d1$charcoal_rating)))

p1 <- d1 %>% 
  ggplot(aes(x=cream_rating, y=charcoal_rating, color = winner, shape = winner))   
  geom_point(alpha = 0.2, na.rm = TRUE)  
  scale_color_manual(values = c(cream = "seagreen4", charcoal = "chocolate3", draw = "blue"))  
  scale_shape_manual(values = c(cream = 16, charcoal = 17, draw = 15))  
  xlim(lims)   
  ylim(lims)  
  labs(x = "rating of cream", y = "rating of charcoal")   
  theme_classic()   
  theme(plot.title = element_text(hjust = 0.5), legend.position = "bottom")  
  theme(aspect.ratio = 1)

p1_1 <- p1  
  guides(color = guide_legend(override.aes = list(color = c(NA, NA, NA))))  
  theme(legend.text = element_blank(), legend.title = element_blank())

p1_1 <- ggExtra::ggMarginal(p1_1, type = "histogram",
                    margins = 'both',
                    size = 5,
                    position = "identity",
                    color = NA,
                    fill= NA)

p2 <- ggExtra::ggMarginal(p1, type = "histogram",
                             margins = 'both',
                             size = 5,
                             groupColour = TRUE,
                             groupFill = TRUE,
                             position = "identity"
)

# Make legend transparent
p1 <- p1  
  guides(color = guide_legend(override.aes = list(color = c(NA, NA, NA))))  
  theme(legend.text = element_blank(), legend.title = element_blank())

p3 <- d1 %>% 
  ggplot(aes(x=cream_rating, y=charcoal_rating, color = winner, shape = winner))   
  geom_density_2d(na.rm = TRUE)   
  geom_point(alpha = 0, show.legend = FALSE)  
  scale_color_manual(values = c(cream = "seagreen4", charcoal = "chocolate3", draw = "blue"))  
  xlim(lims)   
  ylim(lims)  
  labs(x = "rating of cream", y = "rating of charcoal")   
  theme_classic()   
  theme(plot.title = element_text(hjust = 0.5), 
        legend.position = "bottom")  
  theme(aspect.ratio = 1)

# Make legend transparent
p3 <- p3  
  guides(color = guide_legend(override.aes = list(color = c(NA, NA, NA))))  
  theme(legend.text = element_blank(), legend.title = element_blank())

p3 <- ggExtra::ggMarginal(p3, d1, type = "density",
                          margins = 'both',
                          size = 5,
                          groupColour = TRUE,
                          groupFill = TRUE,
                          position = "identity"
)

plot_row <- plot_grid(p1_1, p2, p3, nrow = 1)

# now add the title
title <- ggdraw()  
  draw_label(
    "Rating of Cream vs Charcoal",
    fontface = 'bold',
    x = 0,
    hjust = 0
  )

final <- plot_grid(
  title, plot_row,
  ncol = 1,
  # rel_heights values control vertical title margins
  rel_heights = c(0.1, 1)
)

final

Примечание. В зависимости от ширины и высоты вашего устройства печати, исправление соотношения сторон добавляет некоторое пустое пространство сверху и снизу. В зависимости от вашего конечного результата вам, вероятно, придется немного поиграть с шириной и высотой (и масштабом), например, используя

 ggsave("final.png", width = 18, height = 6, units = "cm", scale = 1.5)

дает

введите описание изображения здесь

Комментарии:

1. Это сработало хорошо, но участок вытянут, а не квадраты! , как это исправить, также как я могу добавить обратно «рисовать» к сюжету, я устал удалять фильтр, но он не добавил «рисовать», я хотел повторить его форму и цвет, яне знал, что он включен, пока не увидел надпись внизу, где показано «победитель, уголь, крем, ничья», с розовой формой круга для угля, светло-зеленым треугольником для крема и светло-зеленым квадратом для ничьей.

2. Привет @user432797. Я только что внес правку. Добавление рисунка было простым. Просто удалите фильтр и добавьте некоторые формы и цвета для рисунков. Сложная часть заключалась в том, чтобы сделать графики квадратными. С этой целью я переключился на cowplot. Но вам, вероятно, все равно придется немного поиграть с параметрами, чтобы улучшить окончательный вид.

3. Большое вам спасибо @stefan, я ценю вашу поддержку. Это было полезно, я смог добиться тех же результатов, используя par(mfrow = c(3, 1)) nf <- layout(matrix(c(1,2,3),nrow=1), widths=c(2,2,2), heights=c(2,1,1), TRUE)

4. но ваш код, @stefan, более сложный и чистый, чем моя строка, еще раз большое спасибо за помощь, это было действительно полезно для понимания как синтаксиса, так и потока кода.