14  theme()

14.1 自带主题包

library(tidyverse)

── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
✔ ggplot2 3.3.6      ✔ purrr   0.3.5 
✔ tibble  3.1.8      ✔ dplyr   1.0.10
✔ tidyr   1.2.1      ✔ stringr 1.4.1 
✔ readr   2.1.3      ✔ forcats 0.5.2 
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()

library(ggthemr)
library(ggthemes)
library(ggsci)
library(ggpubr)

Attaching package: 'ggpubr'

The following objects are masked from 'package:ggthemr':

    rotate_x_text, rotate_y_text

p<-ggplot(mpg, aes(class,color=drv,fill=drv)) +geom_bar() 
p+theme_grey()

p+theme_bw()

p+theme_linedraw()

p+theme_light()

p+theme_dark()

p+theme_minimal()

p+theme_classic()

14.2 ggthemes

p<-ggplot(mpg, aes(class,color=drv,fill=drv)) +geom_bar() 
p+theme_base()

p+theme_calc()

p+theme_economist()

p+theme_excel()

p+theme_few()

p+theme_fivethirtyeight()

p+theme_gdocs()

p+theme_hc()

p+theme_par()

p+theme_pander()

p+theme_solarized()

p+theme_stata()

p+theme_tufte()

p+theme_wsj()

14.3 ggthemr

remotes::install_github(‘Mikata-Project/ggthemr’)

ggthemr('flat')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('flat dark')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('camouflage')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('chalk')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('copper')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('dust')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('earth')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('fresh')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('grape')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('grass')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('greyscale')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('light')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('lilac')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('pale')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('sea')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('sky')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

ggthemr('solarized')
ggplot(mpg, aes(class,color=drv)) +geom_bar()

ggthemr_reset()

14.4 ggsci

详见：https://nanx.me/ggsci/articles/ggsci.html

data("diamonds")
p1 = ggplot(subset(diamonds, carat >= 2.2),
       aes(x = table, y = price, colour = cut)) +
  geom_point(alpha = 0.7) +
  geom_smooth(method = "loess", alpha = 0.05, size = 1, span = 1) +
  theme_bw()
p1+scale_color_npg()

`geom_smooth()` using formula 'y ~ x'

14.5 元素调整函数

plot <- ggplot(mpg, aes(displ, hwy)) + geom_point()
plot + theme(
  panel.background = element_blank(),
  axis.text = element_text(colour = "red"),
  axis.line = element_line(arrow = arrow()),
  plot.background = element_rect(fill = "white")
)

14.6 主题中其它元素调整

p<-ggplot(mpg,aes(drv, fill = class)) + geom_bar()
p+theme(legend.justification=c("right", "top"))

p+theme(legend.box.background = element_rect(),
        legend.box.margin = margin(6, 6, 6, 6))

p+theme(legend.key = element_rect(fill = "white",colour = "black",
                                  size=0.8,linetype=3))

p+theme(legend.position=c(0.9,0.8))

14.7 ggpubr

http://www.alboukadel.com/

14.7.1 模拟数据

set.seed(1234) 
wdata <- data.frame(
sex = factor(rep(c("F", "M"), each=200)), 
weight = c(rnorm(200, 55), rnorm(200, 58)))

14.7.2 ggdensity

ggdensity(wdata, x = "weight", add = "mean", rug = TRUE, 
          color = "sex", fill = "sex", palette = c("#00AFBB", "#E7B800"))

14.7.3 gghistogram

gghistogram(wdata, x = "weight", add = "mean", rug = TRUE, 
            color = "sex", fill = "sex", palette = c("#00AFBB", "#E7B800"))

Warning: Using `bins = 30` by default. Pick better value with the argument
`bins`.

14.7.4 gghistogram

gghistogram(wdata, x = "weight", add = "mean", rug = TRUE, 
            fill = "sex", palette = c("#00AFBB", "#E7B800"), 
            add_density = TRUE)

Warning: Using `bins = 30` by default. Pick better value with the argument
`bins`.

14.7.5 ggbarplot

ggbarplot(ToothGrowth, x = "dose", y = "len", add = "mean_se", 
          label = TRUE, lab.vjust = -1.9)

ggbarplot(ToothGrowth, x = "dose", y = "len", add = "mean_se",
          error.plot = "upper_errorbar")

ggbarplot(ToothGrowth, x = "dose", y = "len", add = c("mean_se", "dotplot"))

Bin width defaults to 1/30 of the range of the data. Pick better value with `binwidth`.

data("mtcars") 
df2 <- mtcars 
df2$cyl <- factor(df2$cyl) 
df2$name <- rownames(df2)
ggbarplot(df2, x="name", y="mpg", fill = "cyl", 
          color = "white", palette = "jco", sort.val = "desc",
          sort.by.groups=FALSE,x.text.angle=60)

df2$mpg_z <- (df2$mpg-mean(df2$mpg))/sd(df2$mpg)
df2$mpg_grp <- factor(ifelse(df2$mpg_z<0, "low", "high"), levels = c("low", "high"))
ggbarplot(df2, x="name", y="mpg_z", fill = "mpg_grp", 
          color = "white", palette = "jco", sort.val = "asc", 
          sort.by.groups = FALSE, x.text.angle=60, ylab = "MPG z-score", 
          xlab = FALSE, legend.title="MPG Group")

ggbarplot(df2, x="name", y="mpg_z", fill = "mpg_grp", 
          color = "white", palette = "jco", sort.val = "desc", 
          sort.by.groups = FALSE, x.text.angle=90, ylab = "MPG z-score", 
          xlab = FALSE, legend.title="MPG Group", 
          rotate=TRUE, ggtheme = theme_minimal())

14.7.6 ggboxplot

ggboxplot(ToothGrowth, x="dose", y="len", color = "dose", 
          palette = c("#00AFBB", "#E7B800", "#FC4E07"), 
          add = "jitter", shape="dose")

df<-ToothGrowth

ggboxplot(df, x = "dose", y = "len", width = 0.8)

ggboxplot(df, "dose", "len", orientation = "horizontal")

ggboxplot(df, x = "dose", y = "len", notch = TRUE)

ggboxplot(df, x = "dose", y = "len", add = "dotplot")

Bin width defaults to 1/30 of the range of the data. Pick better value with `binwidth`.

my_comparisons <- list( c("0.5", "1"), c("1", "2"), c("0.5", "2") ) 
ggboxplot(ToothGrowth, x = "dose", y = "len", color = "dose")+
  stat_compare_means(comparisons = my_comparisons, 
                     label.y = c(29, 35, 40))+ 
  stat_compare_means(label.y = 45)

Warning in wilcox.test.default(c(4.2, 11.5, 7.3, 5.8, 6.4, 10, 11.2, 11.2, :
cannot compute exact p-value with ties

Warning in wilcox.test.default(c(4.2, 11.5, 7.3, 5.8, 6.4, 10, 11.2, 11.2, :
cannot compute exact p-value with ties

Warning in wilcox.test.default(c(16.5, 16.5, 15.2, 17.3, 22.5, 17.3, 13.6, :
cannot compute exact p-value with ties

14.7.7 ggpie

df <- data.frame(group = c("Male", "Female", "Child"), 
                 value = c(25, 25, 50))
labs <- paste0(df$group, " (", df$value, "%)")
ggpie(df, "value", label = labs, fill = "group", 
      color = "white", palette = c("#00AFBB", "#E7B800", "#FC4E07"))

ggpie(df, "value", label = labs, lab.pos = "in", 
      lab.font = "white", fill = "group", color = "white", 
      palette = c("#00AFBB", "#E7B800", "#FC4E07"))

14.7.8 ggscatter

data("mtcars") 
df <- mtcars; df$cyl <- as.factor(df$cyl)
ggscatter(df, x = "wt", y = "mpg", color = "cyl", 
          add = "reg.line", conf.int = TRUE)+
  stat_cor(aes(color = cyl), label.x = 3)

`geom_smooth()` using formula 'y ~ x'

ggscatter(df, x = "wt", y = "mpg", color = "cyl", shape = "cyl", 
          palette = c("#00AFBB", "#E7B800", "#FC4E07"), 
          ellipse = TRUE, mean.point = TRUE, star.plot = TRUE)

14.7.9 ggpaired

ggpaired(ToothGrowth, x = "supp", y = "len", color = "supp", 
         line.color = "gray", line.size = 0.4)

ggpaired(ToothGrowth, x = "supp", y = "len", color = "supp", 
         line.color = "gray", line.size = 0.4)+ 
  stat_compare_means(paired = TRUE)

14.7.10 ggviolin

ggviolin(ToothGrowth, x="dose", y="len", fill = "dose", 
         palette = c("#00AFBB", "#E7B800", "#FC4E07"), 
         add = "boxplot", add.params = list(fill="white"))+ 
  stat_compare_means(comparisons = my_comparisons, label = "p.signif")+
  stat_compare_means(label.y = 50)

Warning in wilcox.test.default(c(4.2, 11.5, 7.3, 5.8, 6.4, 10, 11.2, 11.2, :
cannot compute exact p-value with ties

Warning in wilcox.test.default(c(4.2, 11.5, 7.3, 5.8, 6.4, 10, 11.2, 11.2, :
cannot compute exact p-value with ties

Warning in wilcox.test.default(c(16.5, 16.5, 15.2, 17.3, 22.5, 17.3, 13.6, :
cannot compute exact p-value with ties

14.7.11 ggdotchart

ggdotchart(df2, x="name", y="mpg", color = "cyl", 
           palette = c("#00AFBB", "#E7B800", "#FC4E07"), 
           sorting = "ascending", add = "segments", ggtheme = theme_pubr())

ggdotchart(df2, x="name", y="mpg", color = "cyl", 
           palette = c("#00AFBB", "#E7B800", "#FC4E07"), 
           sorting = "descending", add = "segments", rotate = TRUE, 
           group = "cyl", dot.size = 6, label = round(df2$mpg), 
           font.label = list(color="white", size=9, vjust=0.5), 
           ggtheme = theme_pubr())

ggdotchart(df2, x = "name", y = "mpg_z",  color = "cyl",     
           palette = c("#00AFBB", "#E7B800", "#FC4E07"), 
           sorting = "descending",  add = "segments", 
           add.params = list(color = "lightgray", size = 2), 
           group = "cyl", dot.size = 6,                                 
           label = round(df2$mpg_z,1),                        
           font.label = list(color = "white", size = 9, 
                             vjust = 0.5),               
           ggtheme = theme_pubr())+
  geom_hline(yintercept = 0, linetype = 2, color = "lightgray")

ggdotchart(df2, x="name", y="mpg", color = "cyl", 
           palette = c("#00AFBB", "#E7B800", "#FC4E07"), 
           sorting = "descending", rotate = TRUE, dot.size = 2, y.text.col=TRUE, 
           ggtheme = theme_pubr())+ 
  theme_cleveland()

Warning: Vectorized input to `element_text()` is not officially supported.
Results may be unexpected or may change in future versions of ggplot2.