1 😄加载经常用的R包😄

library(pacman)
# 读数据
p_load(readxl,writexl,data.table,openxlsx,haven,rvest)
# 数据探索
p_load(tidyverse,DT,skimr,DataExplorer,explore,vtable,stringr,kableExtra,lubridate)
# 模型
p_load(grf,glmnet,caret,tidytext,fpp2,forecast,car,tseries,hdm,tidymodels,broom)
# 可视化
p_load(patchwork,ggrepel,ggcorrplot,gghighlight,ggthemes,shiny)
# 其它常用包
p_load(magrittr,listviewer,devtools,here,janitor,reticulate,jsonlite)
p_load(tidyquant)

2 😄Number_format函数😄

ga_claims <- 
  "GAICLAIMS" %>% 
  tq_get(get = "economic.data", 
         from = "1999-01-01") %>% 
  rename(claims = price) 
ga_claims
ga_claims %>%
  mutate(year = year(date),
         month =  month(date, label = T, abbr  = T)) %>% 
  group_by(year,month) %>% 
  filter(n() >= 4) %>% 
  summarise(avg_claims = mean(claims)) %>% 
  mutate(
    avg_claims_labels = scales::number_format(
      accuracy = 1,
      scale = 1 / 1000,
      suffix = "k",
      big.mark = ","
    )(avg_claims)) %>% 
  ggplot(aes(
    x = month,
    y = year,
    fill = avg_claims,
    label = avg_claims_labels
  )) +
  geom_tile(color = "white", size = .8, aes(height = 1)) +
  mytheme
## `summarise()` regrouping output by 'year' (override with `.groups` argument)

3 😄geom_segment绘制箭头图😄

df2 <- expand.grid(
  lineend = c('round', 'butt', 'square'),
  linejoin = c('round', 'mitre', 'bevel'),
  stringsAsFactors = FALSE
)
df2 <- data.frame(df2, y = 1:9)

df2
ggplot(df2, aes(
  x = 1,
  y = y,
  xend = 2,
  yend = y,
  label = paste(lineend, linejoin)
)) +
  geom_segment(
    lineend = df2$lineend,
    linejoin = df2$linejoin,
    size = 3,
    arrow = arrow(length = unit(0.3, "inches"))
  ) +
  geom_text(hjust = 'outside', nudge_x = -0.2,family = "Times New Roman") +
  xlim(0.5, 2) +
  mytheme

4 😄统计变换Stats😄

4.1 💐stat_ecdf💐

df <- data.frame(
  x = c(rnorm(100, 0, 3), rnorm(100, 0, 10)),
  g = gl(2, 100)
)

# Don't go to positive/negative infinity
ggplot(df, aes(x)) + stat_ecdf(geom = "step", pad = FALSE) + mytheme

4.2 💐stat_ellipse💐

ggplot(faithful, aes(waiting, eruptions)) +
  geom_point() +
  stat_ellipse() +
  mytheme

ggplot(faithful, aes(waiting, eruptions, color = eruptions > 3)) +
  geom_point() +
  stat_ellipse() +
  mytheme

ggplot(faithful, aes(waiting, eruptions, color = eruptions > 3)) +
  geom_point() +
  stat_ellipse(type = "norm", linetype = 2) +
  stat_ellipse(type = "t") +
  mytheme

ggplot(faithful, aes(waiting, eruptions, fill = eruptions > 3)) +
  stat_ellipse(geom = "polygon") +
  mytheme

4.3 💐geom_function():如何在一张图上添加分布图💐

data.frame(x = rnorm(10000)) %>% 
  ggplot(aes(x)) +
  geom_density() +
  geom_function(fun = dnorm,col = "red") +
  geom_vline(xintercept = 0,linetype = 2,col = "orange") +
  mytheme

dnorm(0)
## [1] 0.3989423
ggplot() + xlim(-5,5) + geom_function(fun = dnorm) + mytheme

ggplot() + xlim(-5,5) + geom_function(fun = dnorm, args = list(mean = 2,sd = .5)) + mytheme

ggplot() + xlim(-5,5) + stat_function(fun = dnorm,args = list(mean = 2,sd = 0.5),
                                      geom = "point") +
  mytheme

ggplot() + xlim(-5,5) + stat_function(fun = dnorm,args = list(mean = 2,sd = 0.5),
                                      geom = "line") +
  mytheme

ggplot() +
  xlim(-5,5) +
  geom_function(aes(colour = "normal"), fun = dnorm) +
  geom_function(aes(colour = "t, df = 1"), fun = dt, args = list(df = 1)) +
  mytheme

ggplot() + xlim(-5,5) + geom_function(fun = function(x) 0.5*exp(-abs(x))) + mytheme

4.4 💐stat_summary💐

mtcars %>% 
  ggplot(aes(cyl,mpg)) +
  geom_point() -> d
d + mytheme

d + stat_summary(fun.data = "mean_cl_boot",col = "red",size = 2) + mytheme

mtcars %>% 
  ggplot(aes(mpg,cyl)) +
  geom_point() +
  stat_summary(fun.data = "mean_cl_boot",col = "red",size = 2) +
  mytheme
## Warning: Removed 18 rows containing missing values (geom_segment).

d + stat_summary(fun = "median", colour = "red", size = 2, geom = "point") + mytheme

d + stat_summary(fun = "mean",geom = "point",size = 2,col = "red") + mytheme

d + aes(colour = factor(vs)) + stat_summary(fun = mean, geom="line") + mytheme

5 😄Aesthetics😄

p <- ggplot(nlme::Oxboys, aes(Occasion, height,fill = Occasion)) + geom_boxplot()
p + mytheme
p + geom_line(aes(group = Subject), colour = "blue") + mytheme +
  geom_point(col = "orange")

The linetype aesthetic can be specified with either an integer (0-6), a name (0 = blank, 1 = solid, 2 = dashed, 3 = dotted, 4 = dotdash, 5 = longdash, 6 = twodash), a mapping to a discrete variable, or a string of an even number (up to eight) of hexadecimal digits which give the lengths in consecutive positions in the string. See examples for a hex string demonstration.

df2 <- data.frame(x = 1:5 , y = 1:25, z = 1:25)
p <- ggplot(df2, aes(x, y,group = factor(z)))
p + geom_point(aes(shape = z), size = 4) +
  scale_shape_identity() +
  mytheme

6 😄Scales😄

# Show a list of available shapes
df_shapes <- data.frame(shape = 0:24)
ggplot(df_shapes, aes(0, 0, shape = shape)) +
  geom_point(aes(shape = shape), size = 5, fill = 'red') +
  scale_shape_identity() +
  facet_wrap(~shape) +
  guides(x = guide_axis(angle = 90)) +
  mytheme

7 😄Guides: axes and legends😄

df <- expand.grid(X1 = 1:10, X2 = 1:10)
df$value <- df$X1 * df$X2

p1 <- ggplot(df, aes(X1, X2)) + geom_tile(aes(fill = value))
p1 + mytheme

p1 + geom_point(aes(size = value)) + mytheme

# title text styles via element_text
p1 + guides(fill =
  guide_legend(
    title.theme = element_text(
      size = 15,
      face = "italic",
      colour = "red",
      angle = 0
    )
  )
)

8 😄Labels😄

p1 <- ggplot(mtcars, aes(x = mpg, y = wt)) + geom_point()
p1 + mytheme

# You can assign different labellers to variables:
p1 + facet_grid(
  vs + am ~ gear,
  labeller = labeller(vs = label_both, am = label_value)
) + mytheme

# Or whole margins:
p1 + facet_grid(
  vs + am ~ gear,
  labeller = labeller(.rows = label_both, .cols = label_value)
) + mytheme

rainbow2 <- matrix(hcl(seq(0, 360, length.out = 10), 80, 70), nrow = 1)
rainbow2
##      [,1]      [,2]      [,3]      [,4]      [,5]      [,6]      [,7]     
## [1,] "#FE86A1" "#E89A54" "#BAAE00" "#6DBF45" "#00C793" "#00C5D1" "#46B4F9"
##      [,8]      [,9]      [,10]    
## [1,] "#C297FF" "#F682DD" "#FE86A1"
df <- tibble(x = 1:10, y = 1)
df
ggplot(df, aes(x, y)) +
  annotation_raster(rainbow2, -Inf, Inf, -Inf, Inf) +
  geom_point(col = "pink",size = 20) +
  scale_x_continuous(breaks = 1:10) +
  scale_y_continuous(breaks = seq(0.8,1.2,0.2),limits = c(0.8,1.2),
                     expand = c(0,0)) +
  annotate(geom = "text",
           x = 1:10,
           y = 1,
           label = c("会","当","凌","绝","顶","一","览","众" ,"山","小"),
           col = "red",
           size = 5) +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank()) +
  labs(x = NULL,
       y = NULL)

9 😄其他资源😄

  • 笔记
  • OneNote笔记
  • ggplot2官网