• 主页
  • 课程

    关于课程

    • 课程归档
    • 成为一名讲师
    • 讲师信息
    同等学历教学

    同等学历教学

    免费
    阅读更多
  • 特色
    • 展示
    • 关于我们
    • 问答
  • 事件
  • 个性化
  • 博客
  • 联系
  • 站点资源
    有任何问题吗?
    (00) 123 456 789
    weinfoadmin@weinformatics.cn
    注册登录
    恒诺新知
    • 主页
    • 课程

      关于课程

      • 课程归档
      • 成为一名讲师
      • 讲师信息
      同等学历教学

      同等学历教学

      免费
      阅读更多
    • 特色
      • 展示
      • 关于我们
      • 问答
    • 事件
    • 个性化
    • 博客
    • 联系
    • 站点资源

      未分类

      • 首页
      • 博客
      • 未分类
      • R-ggimage:ggplot2中愉快地使用图片

      R-ggimage:ggplot2中愉快地使用图片

      • 发布者 weinfoauthor
      • 分类 未分类
      • 日期 2019年10月21日
      • 评论 0评论

      导言

      本文介绍了ggimage包,允许在ggplot2作图时嵌入图片,并支持aes映射,可以把离散型变量映射到不同图片。目前有几个包可以使用图片嵌入做图,但都是针对特定的场景,这里使用ggimage来展示在这些特定领域里的应用,ggimage的设计是通用的,并不被特定场景所限定,文末又介绍了用R图标来画出R、用饼图来画气泡图等实例。

      图上嵌图片

      R 基础图形库(base graphics)可以在做图的时候嵌入图片,使用的是graphics::rasterImage:

      imgurl <- "http://phylopic.org/assets/images/submissions/295cd9f7-eef2-441e-ba7e-40c772ca7611.256.png"
      library(EBImage)
      x <- readImage(imgurl)
      plot(1, type = "n", xlab = "", ylab = "", xlim = c(0, 8), ylim = c(0, 8))
      rasterImage(x, 2, 2, 6, 4)
      

      R绘图嵌入图片演示

      如果我们搜索”ggplot2 image”,会找到类似于下面这样的帖子/博文:

      • r – Inserting an image to ggplot2 – Stack Overflow
      • Add a background png image to ggplot2 | R-bloggers

      也就是说通过程序员秘笈,搜索,我们用ggplot2同样也可以做到。

      这里我们需要用到annotation_custom(rasterGrob)来把图片加到ggplot2图形中,这和基础图形库是一模一样的。

      library(grid)
      library(ggplot2)
      
      p <- ggplot(d = data.frame(x = c(0, 8), y = c(0, 8)), aes(x, y)) + geom_blank()
      p + annotation_custom(rasterGrob(x), 2, 6, 2, 4)
      

      如果要使用图片来打点画一个散点图,我们就需要for循环,对每一个点进行操作,这显然是底层的操作,而ggplot2是一个高抽象的画图系统,我们希望能够使用ggplot2的语法。

      ggimage就是来实现这样一个功能,它只是一个简单的包,允许我们在ggplot2中把离散性变量映射到不同的图片来画图。

      推特截屏:把图片当字体一样使用

      实现这个功能的想法已经酝酿很久了,在ggtree的开发中,我实现了phylopic函数来使用Phylopic数据库的图片注释进化树,也实现了subview函数在图上嵌入小图。用图片来注释进化树在进化分析上还是很常见的,特别是在一些分类学的研究中,需要把一些分类学特征在进化树上展示出来,而像我们做病毒,也经常会把一些图片放在进化树上来展示病毒的宿主信息。

      ggtree和可视化有关的函数分两类,一类是加注释的图层,另一类是可视化操作树(比如像旋转、合并分支)。操作树的都是普通函数,而加注释的都是geom图层,除了subview和phylopic,这种所谓逼死处女座的存在,我早就想改成了geom_subview和geom_phylopic了(已实现),这也是为什么我要写ggimage的原因了。

      安装

      ggimage依赖于EBImage来读图片,这是个Bioconductor包,所以我们需要额外的动作来安装它,用setRepositories把Bioconductor软件仓库加进来,这样install.packages也可以搜索到它的包。

      setRepositories(ind = 1:2)
      install.packages("ggimage")
      

      实例分析

      据我所知目前支持使用图片的R包有CatterPlots, rphylopic, emoGG, ggflags这几个,都是为特定的目的而实现的,都有其特定的应用场景,而ggimage是的 geom_image是通用的,通过对它进行简单的包装,同样可以实现这些特殊场景的应用图层。

      CatterPlots这个包只可以应用于基础图形库(base graphics)中,通过预设的几个猫图(R对象,随包载入)来画散点图。最近RevolutionAnalytics 有博文介绍。ggplot2没有相应画猫的包。我们可以使用ggimage来画,而且不用限制于CatterPlots预设的几个图形。

      library(ggplot2)
      library(ggimage)
      
      mytheme <- theme_minimal() +
          theme(axis.title = element_blank())
      theme_set(mytheme)
      
      x <- seq(-2 * pi, 2 * pi, length.out = 30)
      d <- data.frame(x = x, y = sin(x))
      
      img <- "http://www.belleamibengals.com/bengal_cat_2.png"
      ggplot(d, aes(x, y)) + geom_image(image = img, size = .1)
      

      ggimage画猫散点图演示

      CatterPlots实现的方式就是上面谈到的rasterImage内部使用了循环。rphylopic同时支持基础图形库(base graphics)和ggplot2,也是一样的实现方式,不过rphylopic内部没有使用循环,一次只能加一个图,它使用的图来自于phylopic数据库。

      我们用ggimage同样可以使用phylopic图片:

      ggplot(d, aes(x, y)) + geom_phylopic(image = "500bd7c6-71c1-4b86-8e54-55f72ad1beca", size = .1)
      

      ggimage使用phylopic图片演示

      图中是翼足目动物。

      emoGG是专门来画emoji的,如果要画emoji的话,我推荐我写的emojifont包,在轩哥的showtext基础上,把emoji当做普通字体一样操作,更方便。

      emoGG这个包提供了geom_emoji图层,虽然一次可以画出散点,但因为不支持aes映射,而ggimage所提供的geom_emoji则支持映射,下面的例子中我们做了一个简单的回归分析,如果残差<0.5用笑脸表示,>0.5则用哭脸来表示。

      set.seed(123)
      iris2 <- iris[sample(1:nrow(iris), 30), ]
      model <- lm(Petal.Length ~ Sepal.Length, data = iris2)
      iris2$fitted <- predict(model)
      
      p <- ggplot(iris2, aes(x = Sepal.Length, y = Petal.Length)) +
        geom_linerange(aes(ymin = fitted, ymax = Petal.Length),
                       colour = "purple") +
        geom_abline(intercept = model$coefficients[1],
                    slope = model$coefficients[2])
      
      p + ggimage::geom_emoji(aes(image = ifelse(abs(Petal.Length-fitted) > 0.5, '1f622', '1f600')))
      

      ggimage画emoji演示

      如果要用emoGG来做的话,则需要自己切数据分两次来进行:

      p + emoGG::geom_emoji(data = subset(iris2, (Petal.Length-fitted) < 0.5), emoji = "1f600") +
          emoGG::geom_emoji(data = subset(iris2, (Petal.Length-fitted) > 0.5), emoji = "1f622")
      

      这里我们只分两类(残差是否大于0.5),所以需要加两次,试想我们的分类变量有多种可能的取值,则我们需要分多次切数据加图层,CatterPlots、rphylopic和emoGG都有这个问题,这也是aes映射之于ggplot2的重要和强大之处,它让我们可以在更高的抽像水平思考,

      ggflags是支持aes映射的,只不过它只能用来画国旗而已。同样ggimage也提供 了相应的geom_flag来使用国旗用于做图。

      library(rvest)
      library(dplyr)
      
      url <- "http://www.nbcolympics.com/medals"
      
      medals <- read_html(url) %>%
          html_nodes("table") %>%
          html_table() %>% .[[1]]
      
      library(countrycode)
      library(tidyr)
      
      medals <- medals %>%
          mutate(code = countrycode(Country, "country.name", "iso2c")) %>%
          gather(medal, count, Gold:Bronze) %>%
          filter(Total >= 10)
      
      head(medals)
      
      CountryTotalcodemedalcount
      Russia33RUGold13
      United States28USGold9
      Norway26NOGold11
      Canada25CAGold10
      Netherlands24NLGold8
      Germany19DEGold8

      首先我们从网站上爬回来2016年各个国家的奥林匹克奖牌数,画出柱状图,并在xlab国家名边上用ggimage画上国旗:

      p <- ggplot(medals, aes(Country, count)) + geom_col(aes(fill = medal), width = .8)
      
      p + geom_flag(y = -2, aes(image = code)) +
          coord_flip() + expand_limits(y = -2)  +
          scale_fill_manual(values = c("Gold" = "gold", "Bronze" = "#cd7f32", "Silver" = "#C0C0C0"))
      

      ggimage画国旗演示

      ggimage

      前面我们介绍了ggimage在一些场景的应用实例,虽然有专门的包针对这些应用场景,但ggimage在这些领域中的表现要比大多数的包要好(支持aes映射)。但ggimage的使用并不限于这些(geom_phylopic,geom_emoji和geom_flag只是通用图层geom_image的简单封装),这里将展示一些有趣的例子。

      用R图标来画R形状

      x <- c(2, 2, 2, 2, 2, 3, 3, 3.5, 3.5, 4)
      y <- c(2, 3, 4, 5, 6, 4, 6, 3, 5, 2)
      d <- data.frame(x = x, y = y)
      
      img <- system.file("img", "Rlogo.png", package = "png")
      ggplot(d, aes(x, y)) + geom_image(image = img, size = .1) +
        xlim(0, 6) + ylim(0, 7)
      

      用R图标画R形状演示

      嵌套式绘图

      这里我要展示的是非常有名的气泡图(Bubble Plot),但气泡不是圆圈,而是使用 ggplot2画的饼图,我先把饼图保存起来,再用ggimage拿来画,饼图的大小 与人口总数正相关。这个例子可以应用到很多场景中去,比如一个时间序列的曲线,你要用统计图在某些时间点上展示相关的信息,比如你要在地图上加某些地方的相关统计信息(如果要在地图上画饼图,可以使用我写的scatterpie包)。

      crime <- read.csv("http://datasets.flowingdata.com/crimeRatesByState2005.tsv",
                        header = TRUE, sep = "\t", stringsAsFactors = F)
      
      statemurderForcible_rateRobberyaggravated_assultburglarylarceny_theftmotor_vehicle_theftpopulation
      Alabama8.234.3141.4247.8953.82650.0288.34627851
      Alaska4.881.180.9465.1622.52599.1391.0686293
      Arizona7.533.8144.4327.4948.42965.2924.46500180
      Arkansas6.742.991.1386.81084.62711.2262.12855390
      California6.926.0176.1317.3693.31916.5712.836756666
      Colorado3.743.484.6264.7744.82735.2559.54861515
      library(gtable)
      
      plot_pie <- function(i) {
          df <- gather(crime[i, ], type, value, murder:motor_vehicle_theft)
          ggplot(df, aes(x = 1, value, fill = type)) +
              geom_col() + coord_polar(theta = 'y') +
              ggtitle(crime[i, "state"]) +
              theme_void() + theme_transparent() +
              theme(legend.position = "none",
                    plot.title = element_text(size = rel(6), hjust = 0.5))
      }
      
      pies <- sapply(1:nrow(crime), function(i) {
          outfile <- paste0("crime_", i, ".png")
          plot_pie(i) + ggsave(outfile, bg = "transparent")
          outfile
      })
      
      radius <- sqrt(crime$population / pi)
      crime$radius <- 0.2 * radius/max(radius)
      crime$pie <- pies
      
      leg1 <- gtable_filter(
          ggplot_gtable(
              ggplot_build(plot_pie(1) + theme(legend.position = "right"))
          ), "guide-box")
      
      ggplot(crime, aes(murder, Robbery)) +
        geom_image(aes(image = pie, size = I(radius))) +
        geom_subview(leg1, x = 8.8, y = 50)
      

      嵌套式绘图演示:用饼图来画气泡图

      我们还可以每次只画一个州的数据,制作成动图。

      plot_crime <- function(i) {
          o <- paste0(i, ".png")
          ggplot(crime, aes(murder, Robbery)) + geom_blank() +
              geom_image(data = crime[i, ], aes(image = pie, size = I(radius))) +
              geom_subview(p, leg1, x = 8.8, y = 50) + ggsave(o)
          o
      }
      
      library(magick)
      library(purrr)
      order(crime$murder, decreasing = F) %>%
          map(plot_crime) %>%
          map(image_read) %>%
          image_join() %>%
          image_animate(fps = 2) %>%
          image_write("crime.gif")
      

      嵌套式绘图演示,动图版本

      geom_subview可以图上嵌图,并不需要保存为图片,但对于ggplot2来讲,保存图片也是有好处的,因为ggplot2画图,点线是在数据空间上,随着我们保存图片的大小是按比例缩小或放大的,但文字是在像素空间上,和画图空间并不相关。所以当我们嵌图时缩小了画图窗口之后,字体会显得格外大,微调起来也比较繁琐,这时候保存为合适尺寸的图片,再用geom_image来加上去,显然就轻松得多。

      其它来自R社区的例子

      SAS博客对M&M巧克力的颜色分布做了分析,通过模拟估计不同颜色的置信区间。这个分析被翻译成R,并产生下图:

      M&M例子展示

      其中垂直片段|是真实值,水平片段当然就是置信空间了,而估计值用了ggimage来画不同颜色的巧克力。

      另一个例子是迪斯尼电影主人公名字的流行程度:

      迪斯尼例子展示

      最近我还添加了geom_pokemon图层,让大家可以用pokemon来画图,比如:

      pokemon例子展示

      ggimage是通用的包,所以可以被应用于不同的领域/场景中,起码可以让我们画出更好玩的图出来,后续我有时间的话,会写一个draw_key_image的函数,实现使用图片来当legend key的功能。

      最后祝大家玩得开心!不要把图画得太有魔性哦:)

      推特截屏

      感谢大为和太云的校稿,特别是大为提出很多修改意见以及给出了用R画R的例子。

      参考资料

      • https://stackoverflow.com/questions/9917049/inserting-an-image-to-ggplot2
      • https://www.r-bloggers.com/add-a-background-png-image-to-ggplot2/
      • https://github.com/GuangchuangYu/ggimage
      • https://github.com/Gibbsdavidl/CatterPlots
      • https://github.com/sckott/rphylopic
      • https://github.com/baptiste/ggflags
      • http://blog.revolutionanalytics.com/2017/02/catterplots-plots-with-cats.html
      • http://blogs.sas.com/content/iml/2017/02/20/proportion-of-colors-mandms.html
      • http://rpubs.com/hrbrmstr/mms
      • https://rpubs.com/bhaskarvk/disney
      • https://cran.r-project.org/package=scatterpie

      请关注“恒诺新知”微信公众号,感谢“R语言“,”数据那些事儿“,”老俊俊的生信笔记“,”冷🈚️思“,“珞珈R”,“生信星球”的支持!

      • 分享:
      weinfoauthor
      weinfoauthor

      1233

      上一篇文章

      R-Genomic coordination的富集性分析
      2019年10月21日

      下一篇文章

      R饼图版气泡图
      2019年10月21日

      你可能也喜欢

      2-1675088548
      lncRNA和miRNA生信分析系列讲座免费视频课和课件资源包,干货满满
      30 1月, 2023
      9-1675131201
      如何快速批量修改 Git 提交记录中的用户信息
      26 1月, 2023
      8-1678501786
      肿瘤细胞通过改变CD8+ T细胞中的丙酮酸利用和琥珀酸信号来调控抗肿瘤免疫应答。
      7 12月, 2022

      留言 取消回复

      要发表评论,您必须先登录。

      搜索

      分类

      • R语言
      • TCGA数据挖掘
      • 单细胞RNA-seq测序
      • 在线会议直播预告与回放
      • 数据分析那些事儿分类
      • 未分类
      • 生信星球
      • 老俊俊的生信笔记

      投稿培训

      免费

      alphafold2培训

      免费

      群晖配置培训

      免费

      最新博文

      Nature | 单细胞技术揭示衰老细胞与肌肉再生
      301月2023
      lncRNA和miRNA生信分析系列讲座免费视频课和课件资源包,干货满满
      301月2023
      如何快速批量修改 Git 提交记录中的用户信息
      261月2023
      logo-eduma-the-best-lms-wordpress-theme

      (00) 123 456 789

      weinfoadmin@weinformatics.cn

      恒诺新知

      • 关于我们
      • 博客
      • 联系
      • 成为一名讲师

      链接

      • 课程
      • 事件
      • 展示
      • 问答

      支持

      • 文档
      • 论坛
      • 语言包
      • 发行状态

      推荐

      • iHub汉语代码托管
      • iLAB耗材管理
      • WooCommerce
      • 丁香园论坛

      weinformatics 即 恒诺新知。ICP备案号:粤ICP备19129767号

      • 关于我们
      • 博客
      • 联系
      • 成为一名讲师

      要成为一名讲师吗?

      加入数以千计的演讲者获得100%课时费!

      现在开始

      用你的站点账户登录

      忘记密码?

      还不是会员? 现在注册

      注册新帐户

      已经拥有注册账户? 现在登录

      close
      会员购买 你还没有登录,请先登录
      • ¥99 VIP-1个月
      • ¥199 VIP-半年
      • ¥299 VIP-1年
      在线支付 激活码

      立即支付
      支付宝
      微信支付
      请使用 支付宝 或 微信 扫码支付
      登录
      注册|忘记密码?