视频教程：R语言recharts包绘制交互式图形
2018-02-09
刘永鑫
宏基因组
你见过随月份变化的温度拆线图
你还见过可以鼠标点选显示详细信息、开关分组的散点图
互联网中铺天盖地的词云
线图、柱状图、堆叠图任意切换，不再为选择类型纠结
甚至是随心所欲的力导向布局图
今天不是带你来看图，而是带你画图的。只安成功安装recharts包，半小时带实现以上全部图型。
相关内容太多，文字传达不便，故录了一个小视频，帮助大家理解和实操。
Recharts包简介、安装和使用视频教程
文字代码看不清，快访问 https://v.qq.com/x/page/m0546uuyeib.html 在线观看1080p高清，更可后台回复"recharts"获得高清视频下载链接，本地播放效果更佳。
R—交互式图表recharts包
recharts 是从Yihui Xie fork而来。它基于百度Echarts2的最后一个稳定发布版(v2.2.7)开发。本文档始终反映recharts最新的特性(Github)。基于Echarts3的recharts2包仍在开发中。
recharts是一个用于可视化的R加载包，它提供了一套面向JavaScript库ECharts2的接口。此包的目的是让R用户即便不精通HTML或JavaScript，也能用很少的代码做出Echarts交互图——当然，懂一点JavaScript的话会更如虎添翼。下面这个散点图展示了本包的基本语法：
Website: http://madlogos.github.io/recharts
原始代码
可以访问官网教程更详细，也可以按下文我节选的部分操作，配合视频教程，学习和理解。
请将本文的代码，用Rstudio保存为recharts.r的文件中。
手动设置工作目录：Session - Set Work Directory - To Source File Location
# 1. 依赖关系检查、安装和加载
# 1.1 安装CRAN来源常用包
# 我要北京使用清华镜像下载超快，比官方快100倍，下载几乎不用等待，大家下载有问题可以更新自己较快的国内镜像，如中科大、英荔教育、兰大、同济，详见https://cran.r-project.org/mirrors.html
site="https://mirrors.tuna.tsinghua.edu.cn/CRAN"
# 参数解析、数据变换、绘图和开发包安装、安装依赖、ggplot主题
package_list <- c("optparse","reshape2","ggplot2","devtools","bindrcpp",
"ggthemes")
for(p in package_list){
if(!suppressWarnings(suppressMessages(require(p, character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)))){
install.packages(p, repos=site)
suppressWarnings(suppressMessages(library(p, character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)))
}
}
# 1.2 安装bioconductor常用包
# 参数解析、数据变换、绘图和开发包安装
package_list <- c("digest")
for(p in package_list){
if(!suppressWarnings(suppressMessages(require(p, character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)))){
source("https://bioconductor.org/biocLite.R")
biocLite(p)
suppressWarnings(suppressMessages(library(p, character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)))
}
}
# 1.3 安装Github常用包
# 参数解析、数据变换、绘图和开发包安装
package_list <- c("kassambara/ggpubr","madlogos/recharts")
for(p in package_list){
q=unlist(strsplit(p,split = "/"))[2]
if(!suppressWarnings(suppressMessages(require(q, character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)))){
install_github(p)
suppressWarnings(suppressMessages(library(q, character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)))
}
}
# 2. 开始画图
# 2.1 散点图/气泡图
# 测试数据iris来自MASS
library(MASS)
# 查看测试数据，不同鸢尾个体花萼片和花瓣长度
head(iris)
# 绘制花萼宽为X轴，花辨宽为Y轴散点图
echartr(iris, x=Sepal.Width, y=Petal.Width)
# 图片为交互相图像，鼠标悬停有参考线和坐标，点可选并显示数值，
# 可切换为数据视图和局部缩放，可另存为png和html交互图
# 多个维度：series控制分组形状和着色
echartr(iris, x=Sepal.Width, y=Petal.Width, series=Species)
# 图中分组可以按图例开关，同时作标轴跟随移动
# 气泡图：weight控制气泡大小为花瓣长，type选择图表类型scatter/point/bubble类型
echartr(iris, Sepal.Width, Petal.Width, series = Species,
weight=Petal.Length, type='bubble')
# 散点图：点着连续数值对应颜色
# 将数据点按花瓣大小着色，类似热图
echartr(iris, Sepal.Width, Petal.Width, weight=Petal.Length) %>%
setDataRange(calculable=TRUE, splitNumber=0, labels=c('Big','Small'),
color=c('red', 'yellow', 'green'), valueRange=c(0, 2.5))
# 2.2 折线图
# 先改造下内置数据集：
aq <- airquality
head(aq)
aq$Date <- as.Date(paste('1973', aq$Month, aq$Day, sep='-'))
aq$Day <- as.character(aq$Day)
aq$Month <- factor(aq$Month, labels=c("May", "Jun", "Jul", "Aug", "Sep"))
head(aq)
# 绘制时间-温度变化折线图，设置标题和符号类型为空
echartr(aq, Date, Temp, type='line') %>%
setTitle('NY Temperature May - Sep 1973') %>% setSymbols('none')
# 设置按月分组，符号为空心圆
echartr(aq, Day, Temp, Month, type='line') %>%
setTitle('NY Temperature May - Sep 1973, by Month') %>%
setSymbols('emptycircle')
# 记得可以点选图例开关分组哟
# 带有时间轴，时间为月，可播放的小动图，是不是B格满满：
echartr(aq, Day, Temp, t=Month, type='line') %>%
setTitle('NY Temperature May - Sep 1973, by Month') %>%
setSymbols('emptycircle')
# 堆叠面积图：type属性控制面积，subtype控制堆叠stack
echartr(aq, Day, Temp, Month, type='area', subtype='stack') %>%
setTitle('NY Temperature May - Sep 1973, by Month') %>%
setSymbols('emptycircle')
# 2.3 饼图
# 基于泰坦尼克数据，重构内置数据集
# 显示数据结构，包括孩子、成人的生或死共4个表，包括1/2/3等舱和船员中性别分布
str(Titanic)
# 表格按行求和，再进行转换长表达
titanic <- data.table::melt(apply(Titanic, c(1,4), sum))
# 修改列名
names(titanic) <- c('Class', 'Survived', 'Count')
# knitr格式化表达
knitr::kable(titanic)
# 画饼图，按舱级别class分组显示数值和比例
echartr(titanic, Class, Count, type='pie') %>%
setTitle('Titanic: N by Cabin Class')
# 右上角按扭可以切换为漏斗图
# 多个饼图：按Class分面，每面中显示存活率
echartr(titanic, Survived, Count, facet=Class, type='pie') %>%
setTitle('Titanic: Survival Outcome by Cabin Class')
# 环图，中空饼图：按Class分面，每面中显示存活率
echartr(titanic, Survived, Count, facet=Class, type='ring') %>%
setTitle('Titanic: Survival Outcome by Cabin Class')
# 信息图样环图：总和为100%，突出组间比较
ds <- data.frame(q=c('68% feel good', '29% feel bad', '3% have no feelings'),
a=c(68, 29, 3))
g <- echartr(ds, q, a, type='ring', subtype='info') %>%
setTheme('macarons', width=800, height=600) %>%
setTitle('How do you feel?','ring_info',
pos=c('center','center', 'horizontal'))
g
# 南丁格尔玫瑰图：中空饼图，高度和比例正相关
echartr(titanic, Class, Count, facet=Survived, type='rose', subtype='radius') %>%
setTitle('Titanic: Survival Outcome by Cabin Class')
# 2.4 雷达图
# 筛选内置数据mtcars的某些行和列，重构内置数据集
cars = mtcars[c('Merc 450SE','Merc 450SL','Merc 450SLC'),
c('mpg','disp','hp','qsec','wt','drat')]
cars$model <- rownames(cars)
cars <- data.table::melt(cars, id.vars='model')
names(cars) <- c('model', 'indicator', 'Parameter')
knitr::kable(cars)
# 单个雷达图：展示不同车的性能指标
echartr(cars, indicator, Parameter, model, type='radar', sub='fill') %>%
setTitle('Merc 450SE vs 450SL vs 450SLC')
# 多个雷达图：按车型分面，每图展示车性能类型对应的数值
echartr(cars, indicator, Parameter, facet=model, type='radar') %>%
setTitle('Merc 450SE vs 450SL vs 450SLC')
# 2.5 仪表盘图gauge plot
# 构造一个数据集：
data = data.frame(x=rep(c('KR/min', 'Kph'), 2), y=c(3.3, 56, 9.5, 88),
z=c(rep('t1', 2), rep('t2', 2)))
# 表格展示数据
knitr::kable(data)
# 显示表中第一个值
echartr(data, x, y, type='gauge')
# 多个dashboard：按类型分类，可以显示两种速度类型
echartr(data, x, y, facet=x, type='gauge')
# 带时间轴：按时间轴动图
echartr(data, x, y, facet=x, t=z, type='gauge')
# 2.6 柱状混合图
# 数据筛选和变换
d <- data.table::dcast(mtcars, carb+gear~., mean, value.var='mpg')
names(d)[3] <- 'mean.mpg'
d$carb <- as.character(d$carb)
head(d)
# 绘图，按gear分组，三组分别为柱状图和线图
echartr(d, carb, "mean.mpg", gear, type=c('vbar', 'vbar', 'line')) %>%
setSymbols('emptycircle')
# 可以按右上角点选切换线图、柱状图、堆叠柱状图
# 3 修改图的细节
# 3.1 简单的两组散点图示例
g = echartr(mtcars, wt, mpg, factor(am, labels=c('Automatic', 'Manual')))
g
# 3.2 可以调用低级函数setSeries来修改第二组，点大小为8，并旋转30度
g %>% setSeries(series=2, symbolSize=8, symbolRotate=30)
# 3.3 给两个数据系列分别添加各自的均数标注线
g %>% addMarkLine(data=data.frame(type='average', name1='Avg'))
# 3.4 标注点markPoint
# 给第一个数据系列(‘Automatic’)标出最大值的点。
g %>% addMarkPoint(series=1, data=data.frame(type='max', name='Max'))
# 3.5 添加标题(红色)和副标题(超级链接到 https://stat.ethz.ch/R-manual/R-devel/library/datasets/html/mtcars.html)。
link <- 'https://stat.ethz.ch/R-manual/R-devel/library/datasets/html/mtcars.html'
g %>% setTitle('wt vs mpg', paste0('[Motor Trend](', link, ')'),
textStyle=list(color='red'))
# 3.6 修改图例(青柠色/绿黄色)，初始化时只选中第一系列(‘Automatic’)，可以手动选择
g %>% setLegend(selected='Automatic', textStyle=list(color='lime'))
# 3.7 修改工具箱显示语言为英文，并置于交互图右上角，垂直显示。
g %>% setToolbox(lang='en', pos=2)
# 3.8 添加缩放漫游控件(初始时不显示).
g %>% setDataZoom()
# 3.9 调整坐标轴，使x-和y-坐标交叉于零点。
g %>% setXAxis(min=0) %>% setYAxis(min=0)
# 主题Theme: 使用’dark’主题。可以选择的自带主题包括“macarons”, “infographic”, “blue”, “dark”, “gray”, “green”, “helianthus”, “macarons2”, “mint”, “red”, “roma”, “sakura”, “shine”, 和 “vintage”。
# 拖曳重算(Calculable)是Echarts特有的交互方式。在某些图(如饼图)中，效果比较好。
g %>% setTheme('dark', calculable=TRUE)
# 图标Symbols:把第1系列(‘Automatic’)的图标改为’heart’，第2系列(‘Manual’)的图标改为’star6’。
g %>% setSymbols(c('heart', 'star6'))
# 合起来Altogether: 你可以把上述步骤用%>%合起来。如果你对JavaScript很熟悉，你可以把JavaScript片段包在JS()函数中，以获得更好的效果。
g %>% setSeries(series=2, symbolSize=8, symbolRotate=30) %>%
addMarkLine(data=data.frame(type='average', name1='Avg')) %>%
addMarkPoint(series=1, data=data.frame(type='max', name='Max')) %>%
setTitle('wt vs mpg', paste0('[Motor Trend](', link, ')'),
textStyle=list(color='red')) %>%
setLegend(selected='Automatic', textStyle=list(color='lime')) %>%
setToolbox(lang='en', pos=2) %>% setDataZoom() %>%
setTheme('dark', calculable=TRUE) %>% setSymbols(c('heart', 'star6'))
# 4. 高B格类图
# 4.1 和弦图Chord Chart
mat <- as.data.frame(rbind(
c(11975, 5871, 8916, 2868),
c( 1951, 10048, 2060, 6171),
c( 8010, 16145, 8090, 8045),
c( 1013, 990, 940, 6907)
))
names(mat) <- c("group1", "group2", "group3", "group4")
mat$name <- names(mat)
echartr(mat, x=name, y=c(group1, group2, group3, group4), type="chord",
subtype='ribbon + asc + descsub + hidelab + scaletext') %>%
setTitle("测试数据", subtitle="From d3.js", pos=5)
# 4.2 力导向布局图Force Chart
# 准备数据
grpmtx <- matrix(c(11975, 5871, 8916, 2868, 1951, 10048, 2060, 6171, 8010, 16145,
8090, 8045, 1013, 990, 940, 6907), byrow=TRUE, nrow=4)
grpmtx <- as.data.frame(grpmtx)
names(grpmtx) <- paste0('Group', 1:4)
grpmtx$Name <- paste0('Group', 1:4)
knitr::kable(grpmtx, align=c('lllll'))
# 点和边设置
nodes <- cbind(yuNetwork$nodes[,1], NA, yuNetwork$nodes[,2:3],
stringsAsFactors=FALSE)
names(nodes) <- names(yuNetwork$links)
yu <- rbind(yuNetwork$links, nodes, stringsAsFactors=FALSE)
# 曲线连接
echartr(yu, c(source, target), weight, relation, type='force') %>%
setTitle("Yu Family of Shaoxing") %>% setTheme(palette=c(
'tan3','green3','green2','lawngreen','olivedrab1'))
# 4.3 词云
# 获取实时百度热词，不同时间画的都不同
getBaiduHot <- function(url, top=30, HTMLencoding=NULL){
baiduhot <- paste0(readLines(url), collapse="")
charset <- gsub('^.+charset=([[:alnum:]-]+?)[^[:alnum:]-].+$', "\\1",
baiduhot)
if (is.null(HTMLencoding)) if (!is.null(charset)) HTMLencoding <- charset
baiduhot <- stringr::str_conv(baiduhot, HTMLencoding)
hotword <- gsub(".+?<a class=\"list-title\"[^>]+?>([^<>]+?)</a>.+?<span class=\"icon-(rise|fair|fall)\">(\\d+?)</span>.+?","\\1\t\\3\t\\2\t", baiduhot)
hotword <- enc2native(gsub("^(.+?)\t{4,}.+$","\\1", hotword))
hotword <- t(matrix(unlist(strsplit(hotword,"\t")), nrow=3))
hotword <- as.data.frame(hotword, stringsAsFactors=FALSE)
names(hotword) <- c("Keyword", "Freq", "Trend")
hotword$Freq <- as.numeric(hotword$Freq)
hotword <- hotword[order(hotword$Freq, decreasing=TRUE),]
return(hotword[1:top,])
}
hotword <- getBaiduHot("http://top.baidu.com/buzz?b=1", HTMLencoding='GBK')
knitr::kable(hotword)
# 词云展示
echartr(hotword, Keyword, Freq, type='wordCloud') %>%
setTitle('Baidu Hot Word Top30 (realtime)', as.character(Sys.time()))
# 按数据系列着色Color by Series
echartr(hotword, Keyword, Freq, Trend, type='wordCloud') %>%
setTitle('Baidu Hot Word Top30 (realtime)', as.character(Sys.time()))
# 带时间轴With Timeline
# 获取今日和七日两个榜单的网页并转为数据框，合并。
hotword$t <- 'Realtime'
hotword1 <- getBaiduHot("http://top.baidu.com/buzz?b=341&fr=topbuzz_b1",
HTMLencoding = 'GBK')
hotword1$t <- 'Today'
hotword2 <- getBaiduHot("http://top.baidu.com/buzz?b=42&c=513&fr=topbuzz_b341",
HTMLencoding = 'GBK')
hotword2$t <- '7-days'
hotword <- do.call('rbind', list(hotword, hotword1, hotword2))
hotword$t <- factor(hotword$t, levels=c('Realtime', 'Today', '7-days'))
# 然后作图。
g <- echartr(hotword, Keyword, Freq, t=t, type='wordCloud') %>%
setTitle('Baidu Hot Word Top30')
g
# 5. System information
sessionInfo()看一下我的环境，安装成功才是作图的前提。
我在WIndows10和Ubuntu 16.04上都安装成功，但都安装多次，最多要反复打开关闭十几次，才完成全部依赖关系安装。
报错了，直接关闭打开重装，很多错误还真不是你的原因。
R version 3.4.1 (2017-06-30)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 16.04.3 LTS
Matrix products: default
BLAS: /usr/lib/openblas-base/libblas.so.3
LAPACK: /usr/lib/libopenblasp-r0.2.18.so
locale:
[1] LC_CTYPE=zh_CN.utf-8 LC_NUMERIC=C LC_TIME=en_US.UTF-8
[4] LC_COLLATE=en_US.UTF-8 LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
[7] LC_PAPER=en_US.UTF-8 LC_NAME=C LC_ADDRESS=C
[10] LC_TELEPHONE=C LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] recharts_0.2-1 ggpubr_0.1.6.999 magrittr_1.5 digest_0.6.15 ggthemes_3.4.0 bindrcpp_0.2
[7] devtools_1.13.4 ggplot2_2.2.1 reshape2_1.4.3 optparse_1.4.4
loaded via a namespace (and not attached):
[1] Rcpp_0.12.15 highr_0.6 pillar_1.1.0 compiler_3.4.1 RColorBrewer_1.1-2
[6] plyr_1.8.4 bindr_0.1 tools_3.4.1 jsonlite_1.5 memoise_1.1.0
[11] tibble_1.4.2 gtable_0.2.0 pkgconfig_2.0.1 rlang_0.1.6 curl_3.1
[16] yaml_2.1.16 withr_2.1.1 stringr_1.2.0 dplyr_0.7.4 knitr_1.19
[21] htmlwidgets_1.0 grid_3.4.1 getopt_1.20.1 glue_1.2.0 data.table_1.10.4-3
[26] R6_2.2.2 scales_0.5.0 htmltools_0.3.6 assertthat_0.2.0 colorspace_1.3-2
[31] stringi_1.1.6 lazyeval_0.2.1 munsell_0.4.3主要参考信息
recharts中文帮助文档 Chinese manual: http://madlogos.github.io/recharts/index_cn.html
R语言数据可视化—-交互式图表recharts包 http://mp.weixin.qq.com/s/YqK5QvoGGtRxorWbV21D7g
猜你喜欢
写在后面
为鼓励读者交流、快速解决科研困难，我们建立了“宏基因组”专业讨论群，目前己有国内外100+ PI，1000+ 一线科研人员加入。参与讨论，获得专业解答，欢迎分享此文至朋友圈，并扫码加主编好友带你入群，务必备注“姓名-单位-研究方向-职称/年级”。技术问题寻求帮助，首先阅读《如何优雅的提问》学习解决问题思路，仍末解决群内讨论，问题不私聊，帮助同行。
学习16S扩增子、宏基因组科研思路和分析实战，关注“宏基因组”
点击阅读原文，跳转最新文章目录阅读
