加载包和数据集

library(tidyverse)
## -- Attaching packages --------
## √ ggplot2 3.3.0     √ purrr   0.3.3
## √ tibble  2.1.3     √ dplyr   0.8.5
## √ tidyr   1.0.2     √ stringr 1.4.0
## √ readr   1.3.1     √ forcats 0.5.0
## -- Conflicts -----------------
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(ggrepel)
library(ggridges)
library(lubridate)
## 
## Attaching package: 'lubridate'
## The following object is masked from 'package:base':
## 
##     date
library(modelr)
library(patchwork)
data("mtcars")

概要

两个重要函数:

  • geom_text_repel()
  • geom_label_repel()
mtcars %>% 
  rownames_to_column("car") %>% 
  filter(wt > 2.75,wt < 3.45)->data

data
##                  car  mpg cyl  disp  hp drat    wt  qsec vs am gear carb
## 1      Mazda RX4 Wag 21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
## 2     Hornet 4 Drive 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
## 3  Hornet Sportabout 18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
## 4          Merc 240D 24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
## 5           Merc 230 22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
## 6           Merc 280 19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4
## 7          Merc 280C 17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4
## 8        AMC Javelin 15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2
## 9     Ford Pantera L 15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
## 10      Ferrari Dino 19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
## 11        Volvo 142E 21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2
data %>% 
  ggplot(aes(wt,mpg)) +
  geom_point(col = "red") +
  geom_text_repel(aes(label = car)) +
  labs(title = "geom_text_repel()") ->p1

data %>% 
  ggplot(aes(wt,mpg)) +
  geom_point(col = "red") +
  geom_text(aes(label = car)) +
  labs(title = "geom_text()") ->p2

p1 + theme(plot.title = element_text(family = "Times New Roman", hjust = 0.5),
           text = element_text("Times New Roman")) +
  p2 + theme(plot.title = element_text(family = "Times New Roman", hjust = 0.5),
             text = element_text("Times New Roman"))

(p1 + theme(plot.title = element_text(family = "Times New Roman",hjust = 0.5),
           text = element_text("Times New Roman")))/
 ( p2 + theme(plot.title = element_text(family = "Times New Roman",hjust = 0.5),
             text = element_text("Times New Roman")))

数据点分散

mtcars %>% 
  rownames_to_column("car")->data1

data1 %>% 
  ggplot(aes(wt, mpg)) +
  geom_point(col = "red",size = 2) +
  geom_text_repel(aes(label = car)) +
  theme(text = element_text(family = "Times New Roman"))

point.padding

data1 %>% 
  ggplot(aes(wt, mpg)) +
  geom_point(col = "red",size = 2) +
  geom_text_repel(aes(label = car),point.padding = NA) +
  theme(text = element_text(family = "Times New Roman"))

将标签限制在特定区域内

data %>% 
  ggplot(aes(wt,mpg)) +
  geom_point(aes(col = factor(cyl)),size = 2) +
  geom_vline(xintercept = 3,linetype = 3,size = 1.5) +
  geom_label_repel(aes(label = car,col = factor(cyl)),
                   arrow = arrow(length = unit(0.03, "npc"), type = "closed", ends = "first"),
                   force = 10,
                   xlim = 3) +
  scale_color_discrete(name = "cyl") +
  ggthemes::theme_economist() +
  theme(text = element_text(family = "Times New Roman"))->p1
p1

突出一些点

mtcars %>% 
  rownames_to_column("car") %>% 
  ggplot(aes(mpg,disp)) +
  geom_point(aes(col = factor(cyl)),size = 2) +
  geom_label_repel(data = mtcars %>% 
                     rownames_to_column("car") %>% 
                     filter(cyl == 6 ),
                   aes(label = car)) +
  ggthemes::theme_economist_white() +
  theme(text = element_text(family = "Times New Roman")) +
  scale_color_discrete(name = "cyl")->p2
p2

p1 + p2

p1/p2