【R語(yǔ)言】--- 云雨圖

基本簡(jiǎn)介

云雨圖(Raincloud plots)其實(shí)是可以看成核密度估計(jì)曲線圖、箱形圖和抖動(dòng)散點(diǎn)圖的組合圖,清晰羹膳、完整、美觀地展示了所有數(shù)據(jù)信息根竿。本質(zhì)上是一個(gè)混合圖陵像,可同時(shí)將原始數(shù)據(jù)、數(shù)據(jù)分布和關(guān)鍵匯總統(tǒng)計(jì)表現(xiàn)出來(lái)寇壳,由對(duì)分的小提琴圖(Violin plot)醒颖、箱線圖(boxplot)和作為某種散點(diǎn)的原始數(shù)據(jù)組成。具體可以使用gglayer包的geom_flat_violin()函數(shù)繪制壳炎,由于該包貌似還沒(méi)有更新泞歉,因此使用網(wǎng)頁(yè)(https://gist.githubusercontent.com/benmarwick/2a1bb0133ff568cbe28d/raw/fb53bd97121f7f9ce947837ef1a4c65a73bffb3f/geom_flat_violin.R)的函數(shù)功能進(jìn)行繪制。

示例代碼

#清空數(shù)據(jù)
rm(list=ls())
#加載所需要的函數(shù)
source("E:/所有R語(yǔ)言/geom_flat_violin.R")
#或者直接在R中運(yùn)行此函數(shù)
'
# somewhat hackish solution to:
# https://twitter.com/EamonCaddigan/status/646759751242620928
# based mostly on copy/pasting from ggplot2 geom_violin source:
# https://github.com/hadley/ggplot2/blob/master/R/geom-violin.r
library(ggplot2)
library(dplyr)

"%||%" <- function(a, b) {
  if (!is.null(a)) a else b
}

geom_flat_violin <- function(mapping = NULL, data = NULL, stat = "ydensity",
                             position = "dodge", trim = TRUE, scale = "area",
                             show.legend = NA, inherit.aes = TRUE, ...) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomFlatViolin,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      trim = trim,
      scale = scale,
      ...
    )
  )
}

#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
GeomFlatViolin <-
  ggproto("GeomFlatViolin", Geom,
          setup_data = function(data, params) {
            data$width <- data$width %||%
              params$width %||% (resolution(data$x, FALSE) * 0.9)
            
            # ymin, ymax, xmin, and xmax define the bounding rectangle for each group
            data %>%
              group_by(group) %>%
              mutate(ymin = min(y),
                     ymax = max(y),
                     xmin = x,
                     xmax = x + width / 2)
            
          },
          
          draw_group = function(data, panel_scales, coord) {
            # Find the points for the line to go all the way around
            data <- transform(data, xminv = x,
                              xmaxv = x + violinwidth * (xmax - x))
            
            # Make sure it's sorted properly to draw the outline
            newdata <- rbind(plyr::arrange(transform(data, x = xminv), y),
                             plyr::arrange(transform(data, x = xmaxv), -y))
            
            # Close the polygon: set first and last point the same
            # Needed for coord_polar and such
            newdata <- rbind(newdata, newdata[1,])
            
            ggplot2:::ggname("geom_flat_violin", GeomPolygon$draw_panel(newdata, panel_scales, coord))
          },
          
          draw_key = draw_key_polygon,
          
          default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = 0.5,
                            alpha = NA, linetype = "solid"),
          
          required_aes = c("x", "y")
  )
'

使用iris數(shù)據(jù)集

iris
#作圖
ggplot(iris, aes(x=Species, y=Sepal.Width)) +
  geom_flat_violin(aes(fill=Species),position=position_nudge(x=.25),color="black") +
  geom_jitter(aes(color=Species), width=0.1) +
  geom_boxplot(width=.1,position=position_nudge(x=0.25),fill="white",size=0.5) +
  theme_bw()
#或者x和y轉(zhuǎn)置
ggplot(iris, aes(x=Species, y=Sepal.Width)) +
  geom_flat_violin(aes(fill=Species),position=position_nudge(x=.25),color="black") +
  geom_jitter(aes(color=Species), width=0.1) +
  geom_boxplot(width=.1,position=position_nudge(x=0.25),fill="white",size=0.5) +
  coord_flip() +
  theme_bw()
#調(diào)整細(xì)節(jié)
a<- ggplot(iris, aes(x=Species, y=Sepal.Width)) +
  geom_flat_violin(aes(fill=Species),position=position_nudge(x=.25),color="black") +
  geom_jitter(aes(color=Species), width=0.1) +
  geom_boxplot(width=.1,position=position_nudge(x=0.25),fill="white",size=0.5) +
  theme_few()+
  ylab("Sepal width")+xlab("Species")+
  theme(legend.text=element_text(size=12))+
  theme(title=element_text(size=14))+
  theme(axis.text.x = element_text(size = 13, color = "black"))+
  theme(axis.text.y = element_text(size = 13, color = "black"))+
  theme(legend.position="none")+
  theme(axis.ticks.length=unit(0.2,"cm"))


b<- ggplot(iris, aes(x=Species, y=Sepal.Width)) +
  geom_flat_violin(aes(fill=Species),position=position_nudge(x=.25),color="black") +
  geom_jitter(aes(color=Species), width=0.1) +
  geom_boxplot(width=.1,position=position_nudge(x=0.25),fill="white",size=0.5) +
  coord_flip() +
  theme_few()+
  ylab("Sepal width")+xlab("Species")+
  theme(legend.text=element_text(size=12))+
  theme(title=element_text(size=14))+
  theme(axis.text.x = element_text(size = 13, color = "black"))+
  theme(axis.text.y = element_text(size = 13, color = "black"))+
  theme(legend.position="none")+
  theme(axis.ticks.length=unit(0.2,"cm"))
#組合圖
cowplot::plot_grid(a,b,
                   align="vh")

參考文獻(xiàn)

[1] https://wellcomeopenresearch.org/articles/4-63/v2#ref-9

最后編輯于
?著作權(quán)歸作者所有,轉(zhuǎn)載或內(nèi)容合作請(qǐng)聯(lián)系作者
  • 序言:七十年代末匿辩,一起剝皮案震驚了整個(gè)濱河市腰耙,隨后出現(xiàn)的幾起案子,更是在濱河造成了極大的恐慌铲球,老刑警劉巖沟优,帶你破解...
    沈念sama閱讀 206,126評(píng)論 6 481
  • 序言:濱河連續(xù)發(fā)生了三起死亡事件,死亡現(xiàn)場(chǎng)離奇詭異睬辐,居然都是意外死亡,警方通過(guò)查閱死者的電腦和手機(jī)宾肺,發(fā)現(xiàn)死者居然都...
    沈念sama閱讀 88,254評(píng)論 2 382
  • 文/潘曉璐 我一進(jìn)店門溯饵,熙熙樓的掌柜王于貴愁眉苦臉地迎上來(lái),“玉大人锨用,你說(shuō)我怎么就攤上這事丰刊。” “怎么了增拥?”我有些...
    開封第一講書人閱讀 152,445評(píng)論 0 341
  • 文/不壞的土叔 我叫張陵啄巧,是天一觀的道長(zhǎng)寻歧。 經(jīng)常有香客問(wèn)我,道長(zhǎng)秩仆,這世上最難降的妖魔是什么码泛? 我笑而不...
    開封第一講書人閱讀 55,185評(píng)論 1 278
  • 正文 為了忘掉前任,我火速辦了婚禮澄耍,結(jié)果婚禮上噪珊,老公的妹妹穿的比我還像新娘。我一直安慰自己齐莲,他們只是感情好痢站,可當(dāng)我...
    茶點(diǎn)故事閱讀 64,178評(píng)論 5 371
  • 文/花漫 我一把揭開白布。 她就那樣靜靜地躺著选酗,像睡著了一般阵难。 火紅的嫁衣襯著肌膚如雪。 梳的紋絲不亂的頭發(fā)上芒填,一...
    開封第一講書人閱讀 48,970評(píng)論 1 284
  • 那天呜叫,我揣著相機(jī)與錄音,去河邊找鬼氢烘。 笑死怀偷,一個(gè)胖子當(dāng)著我的面吹牛,可吹牛的內(nèi)容都是我干的播玖。 我是一名探鬼主播椎工,決...
    沈念sama閱讀 38,276評(píng)論 3 399
  • 文/蒼蘭香墨 我猛地睜開眼,長(zhǎng)吁一口氣:“原來(lái)是場(chǎng)噩夢(mèng)啊……” “哼蜀踏!你這毒婦竟也來(lái)了维蒙?” 一聲冷哼從身側(cè)響起,我...
    開封第一講書人閱讀 36,927評(píng)論 0 259
  • 序言:老撾萬(wàn)榮一對(duì)情侶失蹤果覆,失蹤者是張志新(化名)和其女友劉穎颅痊,沒(méi)想到半個(gè)月后,有當(dāng)?shù)厝嗽跇淞掷锇l(fā)現(xiàn)了一具尸體局待,經(jīng)...
    沈念sama閱讀 43,400評(píng)論 1 300
  • 正文 獨(dú)居荒郊野嶺守林人離奇死亡斑响,尸身上長(zhǎng)有42處帶血的膿包…… 初始之章·張勛 以下內(nèi)容為張勛視角 年9月15日...
    茶點(diǎn)故事閱讀 35,883評(píng)論 2 323
  • 正文 我和宋清朗相戀三年,在試婚紗的時(shí)候發(fā)現(xiàn)自己被綠了。 大學(xué)時(shí)的朋友給我發(fā)了我未婚夫和他白月光在一起吃飯的照片。...
    茶點(diǎn)故事閱讀 37,997評(píng)論 1 333
  • 序言:一個(gè)原本活蹦亂跳的男人離奇死亡束世,死狀恐怖,靈堂內(nèi)的尸體忽然破棺而出营罢,到底是詐尸還是另有隱情,我是刑警寧澤饼齿,帶...
    沈念sama閱讀 33,646評(píng)論 4 322
  • 正文 年R本政府宣布饲漾,位于F島的核電站蝙搔,受9級(jí)特大地震影響,放射性物質(zhì)發(fā)生泄漏考传。R本人自食惡果不足惜吃型,卻給世界環(huán)境...
    茶點(diǎn)故事閱讀 39,213評(píng)論 3 307
  • 文/蒙蒙 一、第九天 我趴在偏房一處隱蔽的房頂上張望伙菊。 院中可真熱鬧败玉,春花似錦、人聲如沸镜硕。這莊子的主人今日做“春日...
    開封第一講書人閱讀 30,204評(píng)論 0 19
  • 文/蒼蘭香墨 我抬頭看了看天上的太陽(yáng)兴枯。三九已至血淌,卻和暖如春,著一層夾襖步出監(jiān)牢的瞬間财剖,已是汗流浹背悠夯。 一陣腳步聲響...
    開封第一講書人閱讀 31,423評(píng)論 1 260
  • 我被黑心中介騙來(lái)泰國(guó)打工, 沒(méi)想到剛下飛機(jī)就差點(diǎn)兒被人妖公主榨干…… 1. 我叫王不留躺坟,地道東北人沦补。 一個(gè)月前我還...
    沈念sama閱讀 45,423評(píng)論 2 352
  • 正文 我出身青樓,卻偏偏與公主長(zhǎng)得像咪橙,于是被迫代替她去往敵國(guó)和親夕膀。 傳聞我的和親對(duì)象是個(gè)殘疾皇子,可洞房花燭夜當(dāng)晚...
    茶點(diǎn)故事閱讀 42,722評(píng)論 2 345

推薦閱讀更多精彩內(nèi)容