R基础画图

柱状图

library(ggplot2)
#install.packages("ggsignif")
library(ggsignif)

ggplot(data=dd,aes(group,gene))+
  stat_summary(geom = "bar",
               fun=mean,
               aes(fill=group))+
  stat_summary(geom="errorbar",
               fun.min = min,
               fun.max = max,
               width=0.2)+
  geom_signif(comparisons = list(c("early","mid"),
                                # c("B","D"),
                                 c("mid","late")),
              test = 't.test',
              y_position = c(10,17,18),
              map_signif_level = T)+
  scale_y_continuous(expand = c(0,0),limits = c(0,5))+
  theme_bw()+
  scale_fill_manual(values = c("steelblue", 
                               "yellowgreen", 
                               "violetred1"))+
  theme(legend.title = element_blank())+
  labs(x="group",
       y="expression",
       title = "LAMA4")+
  theme(panel.grid = element_blank())

1. 山脊图

   
   image.png

#山脊图
##产生数据
set.seed(2019)
dsamp <- diamonds[sample(nrow(diamonds), 1000), ]


ggplot(dsamp,aes(carat,fill = clarity))+
  geom_density(alpha = .5,color = NA)+
  scale_fill_brewer(palette = 'Set2')+
  theme_classic()+
  theme(legend.position = c(.85,.65))


install.packages('ggridges')
library(ggridges)

ggplot(dsamp,aes(x = carat,y = clarity, fill = clarity))+
  geom_density_ridges(alpha = .5)+
  scale_fill_brewer(palette = 'Set3')+
  theme_classic()

2. 折线图+散点

set.seed(2019)
x <- 1:8
dat <- tibble(x = rep(x,2),
              y = 1.2*x+5+rnorm(16,0,2),
              group = rep(c('Group1','Group2'),each = 8))

p1 <- ggplot(dat,aes(x, y, color = group))+
  geom_line(size = .8)+
  scale_color_d3()+
  theme_classic()+
  theme(legend.position = c(.85,.15))

##log转换y
p2 <- ggplot(dat,aes(x, y, color = group))+
  geom_line(size = .8)+
  geom_point(shape = 21,color = 'black',size=3,fill = 'white')+
  scale_color_d3()+
  theme_classic()+
  theme(legend.position = c(.85,.15))

plot_grid(p1,p2,ncol=2,labels = LETTERS[1:2],align = c('v','h'))

3. 配对坡度图

   
   image.png

ggplot(data = data, aes(x = Date, y = Pct, 
                        group = Party,color = Party)) +
  geom_line(size = 2) +
  geom_point(size = 4) +
  annotate('text',x = 2.1,y = c(37.9, 33.3, 27.3, 5, 8.4),
           label = c("Green", "Liberal", "NDP", "Others", "PC"))+
  scale_x_discrete(position = "top") +
  scale_color_brewer(palette = 'Paired')+
  theme_bw() +
  theme(legend.position = 'none') +
  theme(panel.border = element_blank())

4. 散点图加曲线

#平滑曲线
set.seed(2019)
dsamp <- diamonds[sample(nrow(diamonds), 1000), ]

p1 <- ggplot(dsamp,aes(carat, price, fill = cut))+
  geom_point(shape = 21, color = 'black', size = 3)+
  geom_smooth(se = .8)+
  theme(legend.position = c(.1,.8))

##巧用数据叠加
p2 <- ggplot()+
  geom_point(data = dsamp,aes(carat, price, fill = cut),
             shape = 21, color = 'black', size = 3)+
  geom_smooth(data = dsamp,aes(carat, price),se = .8)+
  theme(legend.position = c(.1,.8))

plot_grid(p1,p2,ncol=2,labels = LETTERS[1:2],align = c('v','h'))


#ggplot2内置了很多平滑方法

p <- ggplot(mtcars, aes(x = hp, y = mpg)) + 
  geom_point(size = 3,shape = 21,fill = '#5dc863',color = 'black')

p1 <- p + geom_smooth(method = "lm", formula = y ~ x, size = 1)+
  ggtitle(label = 'liner model')
##x的平方
p2 <- p + geom_smooth(method = "lm", formula = y ~ poly(x, 2), size = 1)+
  ggtitle(label = 'polynomial regression')
##广义加性模型
p3 <- p + geom_smooth(method = "gam", formula = y ~ x, size = 1)+
  ggtitle(label = 'GAM model')

p4 <- p + geom_smooth(method = "gam", formula = y ~ s(x), size = 1)+
  ggtitle(label = 'GAM model with spline')

plot_grid(p1,p2,p3,p4,ncol=2,labels = LETTERS[1:4],align = c('v','h'))

5. 生存曲线

library(survminer)
library(survival)
###按照sex进行分类，拟合分组信息
fit <- survfit(Surv(time, status) ~ sex, data = lung)
p1 <- ggsurvplot(fit, data = lung,
                 legend.title = 'Sex',
                 legend = c(.85,.8))

p2 <- ggsurvplot(
  fit, 
  data = lung, 
  size = 1,                
  palette = c("#E7B800", "#2E9FDF"),
  conf.int = TRUE,          
  pval = TRUE,              
  risk.table = TRUE,        
  risk.table.col = "strata",
  legend.labs = 
    c("Male", "Female"),    
  risk.table.height = 0.25, 
  ggtheme = theme_bw(),
  legend.title = 'Sex',
  legend = c(.85,.8)
)

6. 和弦图

   
   image.png

library(circlize)

set.seed(2019)

numbers <- sample(c(1:1000), 100, replace = T)
data <- matrix( numbers, ncol=5)
rownames(data) <- paste0("Set-", seq(1,20))
colnames(data) <- paste0("Pair-", seq(1,5))

chordDiagram(data, transparency = 0.5)

7. 饼图

   
   image.png

##排序后
injuries2 <- injuries %>% mutate(
  type = factor(type, levels = type[order(counts)])) 
p2 <- ggplot(injuries2,aes('', y = counts, fill = type))+
  geom_bar(width = 1, size = 1, color = 'white',stat = 'identity')+
  coord_polar(theta = 'y')+
  geom_text(aes(label = paste0(round(share,1),'%')),
            position = position_stack(vjust = .5))+
  labs(x = NULL, y = NULL, fill = NULL, 
       title = "Injury proportion in young adults")+
  scale_fill_npg()+
  theme_classic() +
  theme(axis.line = element_blank(),
        axis.text = element_blank(),
        axis.ticks = element_blank(),
        plot.title = element_text(hjust = 0.5, color = "#666666"))+
  guides(fill = guide_legend(reverse = TRUE))

8. 玫瑰图

#画一朵玫瑰
ggplot(injuries,aes(x = type, y = counts, fill = type))+
  geom_bar(width = 1,color = 'black',stat = 'identity')+
  coord_polar(theta = 'x')+
  geom_text(aes(label = paste0(round(share,1),'%'),
                y = counts+2))+
  labs(x = NULL, y = NULL, fill = NULL, 
       title = "Injury proportion in young adults")+
  scale_fill_tron()+
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5, color = "#666666"),
        panel.border = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        legend.position = 'none')

9. 玫瑰图内有分类

#多层玫瑰图
injuries <- tibble(age = rep(c('Young adults',
                               'Middle-aged people',
                               'the elders'),each=5),
                   type = rep(c('Road injury','Self-harm','CVD',
                                'Cancers','Infectious Diseases'),3),
                   counts = c(214,123,69,24,17,
                              129,110,201,101,45,
                              56,32,212,189,78))
injuries <- injuries %>% 
  mutate(age = factor(age, levels = c('Young adults',
                                      'Middle-aged people',
                                      'the elders')))
injuries <- injuries %>%
  mutate(type = factor(type,levels = c('CVD','Road injury','Cancers',
                                       'Self-harm','Infectious Diseases')))
ggplot(injuries,aes(x = type, y = counts, fill = age))+
  geom_bar(width = 1,color = 'black',stat = 'identity',size = .2)+
  coord_polar(theta = 'x')+
  labs(x = NULL, y = NULL, fill = NULL, 
       title = "Injury proportion in young adults")+
  scale_fill_brewer(palette = 'Blues')+
  theme(plot.title = element_text(hjust = 0.5, color = "#666666"),
        panel.border = element_blank(),
        panel.background = element_blank())

10. 柱状图有组成成分

    
    image.png

#条柱的另外两种排列方式
p1 <- ggplot(injuries,aes(type,weight = counts,fill = age))+
  geom_hline(yintercept = seq(100,400,100),color = 'gray')+
  geom_bar(color = 'black',width = .7,position = 'stack')+
  scale_fill_brewer(palette = 'Accent')+
  scale_y_continuous(expand = c(0,0))+
  theme_classic()+
  theme(axis.text.x = element_text(angle = 45,hjust=1))

11. 上下分明的条图

    
    image.png

set.seed(2019)
df <- tibble(diseases = c('Heart attack','Stroke','CHD',
                          'Arrhythmia','Heart failure',
                          'Hepatitis','Malaria','HIV',
                          'TB','Influenza','HCC','CRC',
                          'Lung','Gastric','Breast',
                          'Diabetes','Hypertention',
                          'Mucolipidoses','IBD','Celiac Disease',
                          "Crohn's Disease",'Diarrhea',
                          'Autism','ADHD','Depression','Meningitis',
                          'Migraine','GBM'),
             trends = rnorm(28,0,2))
df <- df %>% mutate(
  diseases = factor(diseases,levels = rev(diseases[order(trends)])))

ggplot(df,aes(diseases,weight = trends))+
  geom_hline(yintercept = seq(-4,3,1),color = 'gray')+
  geom_bar(color = 'black',width = .6,fill = '#5bd1d7',size = .3)+
  scale_y_continuous(limits = c(-5,3.5))+
  theme_classic()+
  ylab('Temporal trends of diseases')+
  theme(axis.text.x = element_text(angle = 45,hjust=1))

12. 好看的箱子图

ggbetweenstats(
  data = iris,
  plot.type = 'box',
  x = Species,
  y = Sepal.Length,
  mean.plotting = F,
  messages = T,
  type = 'p',
  palette = 'Set1') + 
  scale_y_continuous(breaks = seq(3, 8, by = 1))+
  theme_classic()+
  theme(legend.position = c(.13,.8))

带组间比较

#添加统计信息标识符
ggbetweenstats(
  data = iris,
  plot.type = 'box',
  x = Species,
  y = Sepal.Length,
  pairwise.comparisons = T,
  mean.plotting = F,
  messages = T,
  type = 'p',
  palette = 'Set1') + 
  scale_y_continuous(breaks = seq(3, 8, by = 1))+
  theme_classic()+
  theme(legend.position = c(.11,.8))

13. seqlogo