Post Reply 
 
Thread Rating:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
视频教程:R语言recharts包绘制交互式图形
02-15-2018, 11:06 AM
Post: #1
视频教程:R语言recharts包绘制交互式图形
来源:视频教程:R语言recharts包绘制交互式

视频教程链接:https://pan.baidu.com/s/1mjsKNCs 密码:5wza

R—交互式图表recharts包

recharts 是从Yihui Xie fork而来。它基于百度Echarts2的最后一个稳定发布版(v2.2.7)开发。本文档始终反映recharts最新的特性(Github)。基于Echarts3的recharts2包仍在开发中。

recharts是一个用于可视化的R加载包,它提供了一套面向JavaScript库ECharts2的接口。此包的目的是让R用户即便不精通HTML或JavaScr​ipt,也能用很少的代码做出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/li...https://stat.ethz.ch/R-manual/R-devel/library/datasets/html/m )。

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
Find all posts by this user
Quote this message in a reply
Post Reply 


Forum Jump: