1 双y轴

1.1 ggplot

Code
df <- ggplot2::economics
y1 <- df$psavert
y2 <- df$unemploy

target.range <- range(y1)
origin.range <- range(y2)
a <- (target.range[2] - target.range[1]) / (origin.range[2] - origin.range[1])
b <- target.range[1] - a * origin.range[1]

library(data.table)
plot.df <- data.table(
  date=as.POSIXct(df$date),
  psavert=df$psavert,
  unemploy=df$unemploy*a+b) %>% 
  data.table::melt(id="date")
b_date <- as.POSIXct("1967-07-01", tz = "UTC")
e_date <- as.POSIXct("2015-04-01", tz = "UTC")
dat.color <- c("#B03834", "#698DBD")
# 四周边框
dat.bor <- data.table(x1=c(rep(b_date-lubridate::years(1), 2), b_date-lubridate::years(1), e_date+lubridate::years(1)),
                      x2=c(rep(e_date+lubridate::years(1), 2), b_date-lubridate::years(1), e_date+lubridate::years(1)),
                      y1=c(18,0,0,0),
                      y2=c(18,0,18,18))
# 内部网格线
dat.gri <- data.table(x1=c(seq(b_date, e_date, "5 year"), rep(b_date-lubridate::years(1), 8)),
                      x2=c(seq(b_date, e_date, "5 year"), rep(e_date+lubridate::years(1), 8)),
                      y1=c(rep(0,10),  seq(2,16,2)),
                      y2=c(rep(18,10), seq(2,16,2)))
# y轴标签
dat.y1.tex <- data.table(x=rep(b_date-lubridate::years(1), 8), y=seq(2,16,2), lab=seq(2,16,2)) 
y2.lab <- ((seq(2,16,2)-b)/a) %>% round()
dat.y2.tex <- data.table(x=rep(e_date+lubridate::years(1), 8), y=seq(2,16,2), lab=y2.lab) 
# y轴标题
dat.y1.tit <- data.table(x=b_date-lubridate::years(6), y=9, lab="Personal Savings Rate")
dat.y2.tit <- data.table(x=e_date+lubridate::years(7), y=9, lab="# Unemployed (1000's)")

ggplot(plot.df, aes(date, value))+
  geom_line(aes(color=variable),show.legend = F)+
  geom_segment(data=dat.bor, aes(x=x1, xend=x2, y=y1, yend=y2))+ #border
  geom_segment(data=dat.gri, aes(x=x1, xend=x2, y=y1, yend=y2), linewidth=0.2, color="gray", alpha=0.4)+ #grid
  geom_text(data=dat.y1.tex, aes(x,y,label=lab), color=dat.color[1], size=3, hjust=1.2)+
  geom_text(data=dat.y2.tex, aes(x,y,label=lab), color=dat.color[2], size=3, hjust=-0.1)+
  geom_text(data=dat.y1.tit, aes(x,y,label=lab), color=dat.color[1], size=5, vjust=1.5, angle=90)+
  geom_text(data=dat.y2.tit, aes(x,y,label=lab), color=dat.color[2], size=5, vjust=1.5, angle=-90)+
  scale_color_manual(values = dat.color)+
  scale_x_datetime(date_labels = "%Y-%m-%d", breaks = seq(b_date, e_date, by = "5 year"), 
                   limits = c(b_date-lubridate::years(6), e_date+lubridate::years(7)), expand = c(0,0))+
  scale_y_continuous(breaks = seq(2,16,2), limits = c(0,18), expand = c(0,0))+
  labs(x= NULL, y=NULL,title = "Personal Savings Rate vs Unemployed: Plotting in Secondary Y Axis", color=NULL)+
  theme_bw()+
  theme(aspect.ratio = 1/1.8, 
        panel.border = element_blank(),
        axis.text.y = element_blank(),
        axis.text.x = element_text(size=6.2),
        axis.ticks = element_blank(),
        panel.grid = element_blank(), 
        plot.title = element_text(hjust = 0.5))

1.2 cowplot

https://wilkelab.org/cowplot/index.html

Code
library(cowplot)
city_mpg <- mpg %>%
  mutate(class = fct_lump(class, 4, other_level = "other")) %>%
  group_by(class) %>%
  summarize(
    mean_mpg = mean(cty),
    count = n()
  ) %>% mutate(
    class = fct_reorder(class, count)
  )


city_mpg <- city_mpg %>%
  mutate(class = fct_reorder(class, -mean_mpg))

p1 <- ggplot(city_mpg, aes(class, count)) +
  geom_col(fill = "#6297E770") + 
  scale_y_continuous(
    expand = expansion(mult = c(0, 0.05)),
    position = "right"
  ) +
  theme_minimal_hgrid(11, rel_small = 1) +
  theme(
    panel.grid.major = element_line(color = "#6297E770"),
    axis.line.x = element_blank(),
    axis.text.x = element_blank(),
    axis.title.x = element_blank(),
    axis.ticks = element_blank(),
    axis.ticks.length = grid::unit(0, "pt"),
    axis.text.y = element_text(color = "#6297E7"),
    axis.title.y = element_text(color = "#6297E7")
  )
p1

Code
p2 <- ggplot(city_mpg, aes(class, mean_mpg)) + 
  geom_point(size = 3, color = "#D5442D") + 
  scale_y_continuous(limits = c(10, 21)) +
  theme_half_open(11, rel_small = 1) +
  theme(
    axis.ticks.y = element_line(color = "#BB2D05"),
    axis.text.y = element_text(color = "#BB2D05"),
    axis.title.y = element_text(color = "#BB2D05"),
    axis.line.y = element_line(color = "#BB2D05")
  )
p2

Code
aligned_plots <- cowplot::align_plots(p1, p2, align="hv", axis="tblr")
ggdraw(aligned_plots[[1]]) + draw_plot(aligned_plots[[2]])

1.3 ggpubr

Code
library(ggpubr)
set.seed(1234)
wdata = data.frame(
  sex = factor(rep(c("F", "M"), each=200)),
  weight = c(rnorm(200, 55), rnorm(200, 58)))
head(wdata)
#>   sex   weight
#> 1   F 53.79293
#> 2   F 55.27743
#> 3   F 56.08444
#> 4   F 52.65430
#> 5   F 55.42912
#> 6   F 55.50606

gghistogram(
  wdata, x = "weight", 
  add = "mean", rug = TRUE,
  fill = "sex", palette = c("#00AFBB", "#E7B800")
  )
#> Warning: Using `bins = 30` by default. Pick better value with the argument
#> `bins`.

Code
# 1. Create the histogram plot
phist <- gghistogram(
  wdata, x = "weight", 
  add = "mean", rug = TRUE,
  fill = "sex", palette = c("#00AFBB", "#E7B800")
)
#> Warning: Using `bins = 30` by default. Pick better value with the argument
#> `bins`.

# 2. Create the density plot with y-axis on the right
# Remove x axis elements
pdensity <- ggdensity(
  wdata, x = "weight", 
  color= "sex", palette = c("#00AFBB", "#E7B800"),
  alpha = 0
) +
  scale_y_continuous(expand = expansion(mult = c(0, 0.05)), position = "right")  +
  theme_half_open(11, rel_small = 1) +
  rremove("x.axis")+
  rremove("xlab") +
  rremove("x.text") +
  rremove("x.ticks") +
  rremove("legend")

# 3. Align the two plots and then overlay them.
aligned_plots <- cowplot::align_plots(phist, pdensity, align="hv", axis="tblr")
ggdraw(aligned_plots[[1]]) + draw_plot(aligned_plots[[2]])

Code


p1 <- ggplot(mpg, aes(manufacturer, hwy)) + stat_summary(fun.y ="median", geom = "bar") +
  theme_half_open() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust= 1))
#> Warning: The `fun.y` argument of `stat_summary()` is deprecated as of ggplot2 3.3.0.
#> ℹ Please use the `fun` argument instead.

p2 <- ggplot(mpg, aes(manufacturer, displ)) + geom_point(color="red") +
  scale_y_continuous(position = "right") +
  theme_half_open() + theme(axis.text.x = element_blank())

p1+p2

Code
# manually align and plot on top of each other
aligned_plots <- cowplot::align_plots(p1, p2, align="hv", axis="tblr")

# Note: In most cases two y-axes should not be used, but this example
# illustrates how one could accomplish it.
ggdraw(aligned_plots[[1]]) + draw_plot(aligned_plots[[2]])

1.4 annotation_custom(ggplotGrob())

Code
set.seed(1)
df1 <- tibble(
    width = round(rnorm(5,10,15),digits = 0) %>% abs() %>% sort(decreasing = T),
    unit = rep(c("shear_stress"),each=5),
    value = round(runif(5,0.0001,0.1),8) %>% abs() %>% sort()
)
df1
#> # A tibble: 5 × 3
#>   width unit          value
#>   <dbl> <chr>         <dbl>
#> 1    34 shear_stress 0.0177
#> 2    15 shear_stress 0.0207
#> 3    13 shear_stress 0.0385
#> 4     3 shear_stress 0.0687
#> 5     1 shear_stress 0.0770


set.seed(100)
df2 <- tibble(
    width = round(runif(20,0,50),digits = 0) %>% abs() %>% sort(),
    unit = rep(c("velocity"),each=20),
    value = round(runif(20,0.0001,1),8) %>% abs() %>% sort()
)
df2
#> # A tibble: 20 × 3
#>    width unit     value
#>    <dbl> <chr>    <dbl>
#>  1     3 velocity 0.130
#>  2     9 velocity 0.172
#>  3    10 velocity 0.180
#>  4    13 velocity 0.278
#>  5    14 velocity 0.349
#>  6    15 velocity 0.420
#>  7    18 velocity 0.488
#>  8    18 velocity 0.536
#>  9    19 velocity 0.538
#> 10    20 velocity 0.549
#> 11    23 velocity 0.629
#> 12    24 velocity 0.695
#> 13    27 velocity 0.711
#> 14    28 velocity 0.749
#> 15    31 velocity 0.770
#> 16    33 velocity 0.882
#> 17    35 velocity 0.889
#> 18    38 velocity 0.929
#> 19    41 velocity 0.954
#> 20    44 velocity 0.990

1.4.1 左y

Code

left <- ggplot(df1,aes(x=width,value))+
    geom_point(pch=21, size=3, fill="red")+
    geom_line()+
    scale_x_continuous(expand = c(0,0),
                       breaks = c(0,1,2,5,10,20,50),
                       labels = c(0,1,2,5,10,20,50),
                       limits = c(0,50),
                       )+
    scale_y_log10(expand = c(0,0),
                  labels = scales::trans_format("log10",scales::math_format()),
                  breaks = c(0.001,0.01,0.1,1),
                  limits = c(0.001,1)
                  )+
    annotation_logticks(sides = "l")+
    theme_void()+ # 去掉主题
    theme(
        axis.line.y = element_line(colour = "black")
    )+
    ylab("shear stress (Pa)")

left

1.4.2 右y

Code
ggplot(df2,aes(width,value))+
    geom_point(pch=25, size=3, fill="blue")+
    annotation_custom(ggplotGrob(left))+
    scale_y_continuous(
        name = "velocity",
        expand = c(0,0),
        breaks = seq(0,1,0.1),
        limits = c(0,1),
        position = "right",
        sec.axis = sec_axis(
            ~ .,
            name = "shear stress (Pa)",
            breaks = scales::rescale(c(-3, -2, -1, 0), c(0, 1)),
            labels = c(expression("10" ^ "-3", "10" ^
                                      "-2", "10" ^ "-1", 1))
        )
    )+
    scale_x_continuous(expand = c(0,0),
                       breaks = c(0,1,2,5,10,20,50),
                       labels = c(0,1,2,5,10,20,50),
                       limits = c(0,50),
                       )

Back to top