R语言~为ggplot对象添加间隔性阴影多边形

使用绘制多个分组的箱线图,有时为了提高可读性,会间隔性添加阴影多边形。本以为是很简单的事情,geom_rect或者annotate(geom =='rect')就能解决。不曾想,却费了好一番功夫。

具体需求如下

  1. facet 分页显示微生物和植物多样性
  2. categorical variables 多个环境变量
  3. fill 每个分类变量包括两个植被类型

先放图


lmers.jpg

加载工具包

library(reshape2)
library(dplyr)
library(phyloseq)
library(lmerTest)
library(lme4)

加载并整理数据

load('../01_filter_and_rarefy_Bacteria/.RData')
remove(physeq)
sample_variables(rarefy)
rarefy = subset_samples(rarefy, NP<100&EC<2000&CN<150& (!Sequencing_ID_16s_18s%in% c('M24','M12','M30')))
map = data.frame(sample_data(rarefy))
map = mutate(map,Latitude = abs(Latitude),  group = case_when(Vegetation == 'Forest'~ 'Forest', TRUE ~ 'NonForest'))
map$group = as.factor(map$group)

创建对象存储变量组合

envs = c('Latitude', "Elevation", "Slope", # geologic 
         "MAT", "AI", # climate
         "Plant_cover",  # plant
         "pH", "EC", "Clay_silt", 'WHC','TP') # soil 

funs = c("BG","PHOS","NAG","Rb","PO4","NO3", "NH4", 'NPP', 'ORC')

计算微生物物种多样性obseved richness

richness = estimate_richness(rarefy, measures="Observed")
rownames(richness) == map$Global_Atlas_Order
map$Bacteria_richness = richness$Observed
map$Global_Atlas_Order = NULL

混合效应模型

# 对所有数值变量进行标准化
forest_scale = mutate_if(forest, is.numeric, scale)
nonforest_scale = mutate_if(nonforest, is.numeric, scale)

formular1 =as.formula(
  paste("Bacteria_richness~", 
        paste(c(envs, '(1|CLIMA2)','(1|LandUse)'), collapse="+")))
formular2 =as.formula(
  paste("Plant_richness~", 
        paste(c(envs, '(1|CLIMA2)','(1|LandUse)'), collapse="+")))

lmer_forest1 <- lmer(formular1, data = forest_scale)
lmer_forest2 <- lmer(formular2, data = forest_scale)
lmer_nonforest1 <- lmer(formular1, data = nonforest_scale)
lmer_nonforest2 <- lmer(formular2, data = nonforest_scale)

#效应及显著性检验
# anova(lmer_forest1,type="I")
# summary(lmer_forest1)
# vif(lmer_forest1)
# rsquared(lmer2)

#置换检验
lmer_forest_boot1 <- bootMer(lmer_forest1,fixef,nsim = 1000,parallel = "snow")
lmer_forest_boot2 <- bootMer(lmer_forest2,fixef,nsim = 1000,parallel = "snow")
lmer_nonforest_boot1 <- bootMer(lmer_nonforest1,fixef,nsim = 1000,parallel = "snow")
lmer_nonforest_boot2 <- bootMer(lmer_nonforest2,fixef,nsim = 1000,parallel = "snow")

#汇总结果
lmer_boot_stats = rbind(data.frame(lmer_forest_boot1$t,group = 'Forest',diversity = 'Bacteria'),
                         data.frame(lmer_nonforest_boot1$t,group = 'NonForest',diversity = 'Bacteria'),
                         data.frame(lmer_forest_boot2$t,group = 'Forest',diversity = 'Plant'),
                         data.frame(lmer_nonforest_boot2$t,group = 'NonForest', diversity = 'Plant'))

lmer_boot_stats$X.Intercept. = NULL

#格式转换变为长列表形式
lmer_boot_stats_mlt = melt(lmer_boot_stats,variable.name = 'factors', value.name = 'estimates')
#根据环境变量的影响大小进行排序
t = aggregate(estimates~group*diversity*factors, lmer_boot_stats_mlt, median) %>% arrange(group,diversity, desc(estimates))
lmer_boot_stats_mlt$factors = factor(lmer_boot_stats_mlt$factors, levels = t$factors[1:11])

关键在这里,为阴影变量建立数据对象

odds <- seq(1, 12, 2)
rect1 = lmer_boot_stats_mlt[odds,]
rect2 = mutate(rect1, diversity = 'Plant')

成图

lmer_plot = ggplot()+ 
  facet_grid(.~diversity,scales = 'free') +
  geom_rect(data = rect1,
            ymin = odds - 0.5,
            ymax = odds + 0.5,
            xmin = -Inf, xmax = +Inf,
            fill = 'grey', alpha = 0.5, inherit.aes = F) +
  geom_rect(data = rect2,
            ymin = odds - 0.5,
            ymax = odds + 0.5,
            xmin = -Inf, xmax = +Inf,
            fill = 'grey', alpha = 0.5, inherit.aes = F) +
  
  geom_vline(xintercept = 0,lty = 2, color = 'black') +

  geom_boxplot(data = lmer_boot_stats_mlt, aes(estimates, factors, fill = group)) +
  scale_fill_brewer(palette = 'Set2') +
  theme_classic() +
  labs(x = 'standardized effects on diversity', y = NULL, fill = NULL) +
  theme(axis.title = element_text(color = 'black'),
        axis.text = element_text(color = 'black'),
        axis.line = element_line(color = 'black'),
        axis.ticks = element_line(color = 'black'),
        legend.position = c(0.5,0.95),
        legend.background = element_blank(),
        strip.placement = 'outside',
        strip.background = element_blank(),
        panel.grid = element_blank(), 
        panel.spacing.x = unit(2,'lines'))
最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
禁止转载,如需转载请通过简信或评论联系作者。
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 214,658评论 6 496
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 91,482评论 3 389
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 160,213评论 0 350
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 57,395评论 1 288
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 66,487评论 6 386
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 50,523评论 1 293
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 39,525评论 3 414
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 38,300评论 0 270
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 44,753评论 1 307
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 37,048评论 2 330
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 39,223评论 1 343
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 34,905评论 5 338
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 40,541评论 3 322
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 31,168评论 0 21
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 32,417评论 1 268
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 47,094评论 2 365
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 44,088评论 2 352

推荐阅读更多精彩内容