简单介绍gghighlight
LJJ
2020/4/17
开始
library(tidyverse)## -- Attaching packages ----------------- tidyverse 1.3.0 --## √ 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 -------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(ggrepel)
library(gghighlight)
library(ggthemes)
library(DT)set.seed(12)
map(LETTERS,function(x){
tibble(idx = 1:400,
value = cumsum(runif(400,-1,1)),
type = x,
flag = sample(c(TRUE,TRUE),size = 400,replace = TRUE))->df
return(df)
}) %>%
bind_rows()->data
data %>% datatable()data %>%
ggplot(aes(idx,value)) +
geom_point(aes(col = type),size = 1,alpha = 0.5) +
geom_line(aes(col = type),size = 1,alpha = 0.5) +
theme(text = element_text(family = "Times New Roman"))
data_filter_upper20 <- data %>%
group_by(type) %>%
filter(max(value) > 20) %>%
ungroup() # 选择最大值大于20的type
data_filter_upper20 %>% datatable()data_filter_upper20 %>%
ggplot() +
geom_line(aes(idx,value,col = type)) +
theme(text = element_text(family = "Times New Roman"))
gghighlight()
data %>%
ggplot(aes(idx,value,col = type)) +
geom_line() +
gghighlight(value %>% max() > 20) +
theme(text = element_text(family = "Times New Roman"))## label_key: type
data %>%
ggplot(aes(idx,value,col = type)) +
geom_point(size = 1) +
geom_line(size = 1) +
gghighlight(max(value) > 19) +
ggthemes::theme_economist_white() +
theme(text = element_text(family = "Times New Roman"))## label_key: type
data %>%
ggplot(aes(idx,value,col = type)) +
geom_point(size = 1) +
geom_line(size = 1) +
facet_wrap(~type) +
gghighlight(max(value) > 19) +
ggthemes::theme_economist_white() +
theme(text = element_text(family = "Times New Roman"))## label_key: type
Geoms
柱状图
iris %>%
ggplot(aes(Sepal.Length,fill = Species)) +
geom_histogram() +
scale_x_continuous(expand = c(0,0),breaks = seq(4,8,0.5)) +
theme(text = element_text(family = "Times New Roman")) ->p
p## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
p + facet_wrap(~Species) + gghighlight()## label_key: Species## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
散点图
data %>%
sample_n(30) %>%
ggplot(aes(idx,value)) +
geom_point(col = "red") +
gghighlight(value > 0) +
theme(text = element_text(family = "Times New Roman"))
data %>%
sample_n(30) %>%
ggplot(aes(idx,value)) +
geom_point(col = "red") +
gghighlight(value > 0,label_key = type) +
theme(text = element_text(family = "Times New Roman"))
ggplot(data, aes(idx, value, colour = type)) +
geom_line() +
gghighlight(max(value), max_highlight = 5L) +
theme(text = element_text(family = "Times New Roman"))## label_key: type
label
ggplot(data) +
geom_line(aes(idx, value, colour = type)) +
gghighlight(max(value) > 20, use_direct_label = TRUE) +
theme(text = element_text(family = "Times New Roman"))## label_key: type
ggplot(data) +
geom_line(aes(idx, value, colour = type)) +
gghighlight(max(value) > 20, use_direct_label = FALSE) +
theme(text = element_text(family = "Times New Roman"))
ggplot(data) +
geom_line(aes(idx, value, colour = type)) +
gghighlight(max(value) > 20, label_params = list(size = 10)) +
theme(text = element_text(family = "Times New Roman"))## label_key: type
p <- ggplot(data %>%
sample_n(30),
aes(idx, value)) +
geom_point(size = 1,col = "red") +
gghighlight(value > 0, use_direct_label = FALSE) +
theme(text = element_text(family = "Times New Roman"))
p
p$data # 只有20个点，说明gghighlight会过滤掉不适合的数据## # A tibble: 12 x 4
## idx value type flag
## <int> <dbl> <chr> <lgl>
## 1 127 8.14 F TRUE
## 2 132 0.168 B TRUE
## 3 159 1.13 W TRUE
## 4 212 16.6 F TRUE
## 5 209 0.262 O TRUE
## 6 393 2.46 V TRUE
## 7 75 2.09 W TRUE
## 8 104 2.86 Z TRUE
## 9 209 3.34 C TRUE
## 10 253 9.01 I TRUE
## 11 187 8.28 S TRUE
## 12 312 6.70 S TRUEp +
geom_label_repel(
aes(label = type),
hjust = 1,
vjust = 1,
fill = "purple",
colour = "white",
alpha = 0.5
)
Options
data %>%
ggplot() +
geom_line(aes(idx,value,col = type)) +
gghighlight(max(value) > 19) +
theme(text = element_text(family = "Times New Roman"))## label_key: type
如果要更改未突出显示的图层的样式，请使用未突出显示的参数。
data %>%
ggplot() +
geom_line(aes(idx, value, col = type),size = 2) + # 绘制一个线图
gghighlight(max(value) > 19,
unhighlighted_params = list(size = 1,
col = alpha("pink", 0.4))) + # 高亮条件
theme(text = element_text(family = "Times New Roman"))## label_key: type
keep_scales
mtcars %>% datatable()p <- ggplot(mtcars,
aes(wt, mpg, colour = factor(cyl))) +
geom_point() +
scale_color_discrete(name = "cyl") +
theme(text = element_text(family = "Times New Roman"))
p
p + gghighlight(cyl == 6) # 颜色变了## Warning: Tried to calculate with group_by(), but the calculation failed.
## Falling back to ungrouped filter operation...
p + gghighlight(cyl == 6, keep_scales = TRUE) + ggtitle("keep_scales = TRUE")## Warning: Tried to calculate with group_by(), but the calculation failed.
## Falling back to ungrouped filter operation...
calculate_per_facet
d <- data.frame(
idx = c(1, 2, 3, 4, 1, 2, 3, 4),
value = c(10, 11, 12, 13, 4, 8, 16, 32),
cat1 = rep(c("a", "b"), each = 4),
cat2 = rep(rep(c("1-2", "3-4"), each = 2), 2),
stringsAsFactors = FALSE
)
d## idx value cat1 cat2
## 1 1 10 a 1-2
## 2 2 11 a 1-2
## 3 3 12 a 3-4
## 4 4 13 a 3-4
## 5 1 4 b 1-2
## 6 2 8 b 1-2
## 7 3 16 b 3-4
## 8 4 32 b 3-4d %>%
ggplot(aes(idx,value,col = cat1)) +
geom_line() +
geom_point() +
facet_wrap(~cat2)->p
p +
theme(text = element_text(family = "Times New Roman"))
p +
gghighlight(max(value) > 10)## label_key: cat1
p +
gghighlight(max(value) > 10, calculate_per_facet = TRUE) +
ggtitle("calculate_per_facet = TRUE")## label_key: cat1
如果要分别突出显示每个构面，请将calculate_per_facet设置为TRUE。请注意，gghighlight()影响gghighlight()之前的绘图。如果您在添加gghighlight()之后添加facet_*()，则此选项无效。