r - 在 R 中有条件地标记具有不同维度字形的散点图

Question

我正在尝试用一些平行线重现散点图，如下所示：

我在 R 中尝试的是：

library(ggplot2)
library(extrafont)
library(dplyr)

df <- data.frame(x = c(1,2,3,4,1,1,4,4)
                 ,y = c(3,4,1,2,1,2,3,4)
                 )

# helper dataframe for axis
df_arrow <- data.frame(x = c(0, 0),
                       y = c(0, 0),
                       xend = c(0, 8),
                       yend = c(8, 0)) 


ggplot(df,aes(x, y)) + 
  geom_point(colour = "blue", size = 5)+
  scale_x_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
  scale_y_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
  coord_fixed(xlim = c(0, 7), ylim = c(0, 7), clip = "off")+
  geom_segment(data = df_arrow, aes(x = x, xend = xend, y = y, yend = yend), size = 0.75, colour = "black",
               arrow = arrow(angle = 20, length = unit(3, "mm"), ends = "last", type = "closed"), linejoin = "mitre") +
  annotate("text", x = c(7.8, 0.3), y = c(0.3, 7.8), label = c("italic(x)", "italic(y)"), parse = TRUE, size = 6)+
  labs(x = NULL,
       y = NULL)+
  theme_bw()+
  theme(panel.grid.major = element_line(colour = "gray80"),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        axis.ticks.length = unit(1, "mm"),
        text = element_text(size = 18))

df %>% 
  dplyr::mutate(z = ifelse(x >= 2.5, "-", "+")) %>%
  ggplot(aes(x, y)) +
  geom_text(size = 12, aes(colour=z, label=z)) +
  scale_x_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
  scale_y_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
  coord_fixed(xlim = c(0, 7), ylim = c(0, 7), clip = "off")+
  geom_segment(data = df_arrow, aes(x = x, xend = xend, y = y, yend = yend), size = 0.75, colour = "black",
               arrow = arrow(angle = 20, length = unit(3, "mm"), ends = "last", type = "closed"), linejoin = "mitre") +
  annotate("text", x = c(7.8, 0.3), y = c(0.3, 7.8), label = c("italic(x)", "italic(y)"), parse = TRUE, size = 6)+
  labs(x = NULL,
       y = NULL)+
  theme_bw()+
  theme(panel.grid.major = element_line(colour = "gray80"),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        axis.ticks.length = unit(1, "mm"),
        text = element_text(size = 18),
        legend.position = "none") +
  scale_shape_manual(values=c(8, 9)) +
  scale_colour_manual(values = c('red', 'blue'))

这给了我：

我不确定如何使用上述设置以及这些倾斜线来更改点的形状。

编辑：

标签： rggplot2

Answer 1

这对我来说似乎是一个xy 问题，但这是生成您尝试复制的绘图的一种方法：

library(tidyverse)

df <- data.frame(x = c(1,2,3,4,1,2,3,4,1,2,3,4),
                 y = c(1,1,1,2,2,2,3,3,3,4,4,4))

df_arrow <- data.frame(x = c(0, 0),
                       y = c(0, 0),
                       xend = c(0, 8),
                       yend = c(8, 0)) 

top_line <- data.frame(x = c(0,1,2,3,4,5,6,7),
                       y = c(1,2,3,4,5,6,7,8))

bottom_line <- data.frame(x = c(1,2,3,4,5,6,7,8),
                          y = c(0,1,2,3,4,5,6,7))


df %>% 
  dplyr::mutate(z = ifelse(x > y + 1, "-",
                           ifelse(x < y - 1, "+", '\u25cf'))) %>%
  ggplot(aes(x, y)) +
  geom_text(size = 12, aes(colour=z, label=z)) +
  geom_line(data = top_line, aes(x=x, y=y)) +
  geom_abline(aes(slope = 1, intercept = 0)) +
  geom_line(data = bottom_line, aes(x=x, y=y)) +
  scale_x_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
  scale_y_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
  coord_fixed(xlim = c(0, 7), ylim = c(0, 7), clip = "off")+
  geom_segment(data = df_arrow, aes(x = x, xend = xend, y = y, yend = yend), size = 0.75, colour = "black",
               arrow = arrow(angle = 20, length = unit(3, "mm"), ends = "last", type = "closed"), linejoin = "mitre") +
  annotate("text", x = c(7.8, 0.3), y = c(0.3, 7.8), label = c("italic(x)", "italic(y)"), parse = TRUE, size = 6)+
  labs(x = NULL,
       y = NULL)+
  theme_bw()+
  theme(panel.grid.major = element_line(colour = "gray80"),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        axis.ticks.length = unit(1, "mm"),
        text = element_text(size = 18),
        legend.position = "none") +
  scale_colour_manual(values = c('red', 'blue', 'black'))

编辑

另一种（类似但更好的）方式：

library(tidyverse)

df <- data.frame(x = c(1,2,3,4,1,2,3,4,1,2,3,4),
                 y = c(1,1,1,2,2,2,3,3,3,4,4,4))

df_arrow <- data.frame(x = c(0, 0),
                       y = c(0, 0),
                       xend = c(0, 8),
                       yend = c(8, 0)) 

top_line <- data.frame(x = c(0,1,2,3,4,5,6,7),
                       y = c(1,2,3,4,5,6,7,8))

bottom_line <- data.frame(x = c(1,2,3,4,5,6,7,8),
                          y = c(0,1,2,3,4,5,6,7))

df %>% 
  dplyr::mutate(z = ifelse(x > y + 1, "a",
                           ifelse(x < y - 1, "b", "c"))) %>%
  ggplot(aes(x = x, y = y)) +
  geom_point(aes(shape = z, color = z), size = 5) +
  geom_line(data = top_line, aes(x = x, y = y)) +
  geom_abline(aes(slope = 1, intercept = 0)) +
  geom_line(data = bottom_line, aes(x = x, y = y)) +
  scale_x_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
  scale_y_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
  coord_fixed(xlim = c(0, 7), ylim = c(0, 7), clip = "off")+
  geom_segment(data = df_arrow, aes(x = x, xend = xend, y = y, yend = yend), size = 0.75, colour = "black",
               arrow = arrow(angle = 20, length = unit(3, "mm"), ends = "last", type = "closed"), linejoin = "mitre") +
  annotate("text", x = c(7.8, 0.3), y = c(0.3, 7.8), label = c("italic(x)", "italic(y)"), parse = TRUE, size = 6)+
  labs(x = NULL,
       y = NULL)+
  theme_bw()+
  theme(panel.grid.major = element_line(colour = "gray80"),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        axis.ticks.length = unit(1, "mm"),
        text = element_text(size = 18),
        legend.position = "none") +
  scale_colour_manual(values = c('red', 'blue', 'black')) +
  scale_shape_manual(breaks = c("a", "b", "c"),
                     values = c("a" = 95, "b" = 3, "c" = 19))