highcharter包:R+HighCharts(一)

highcharter包:R+HighCharts(一)

非常炫酷且强大的一个R包,花了两天的时间学习。不过里面还是有些例子无法正确的加载,只能暂时跳过了。

入门

使用hchart函数

1
2
3
library(highcharter)
data(diamonds, mpg, package = "ggplot2")
hchart(mpg, "scatter", hcaes(x = "displ", y = "hwy", group = "class"))

使用highcharts API

1
2
3
4
5
6
7
8
highchart() %>% 
hc_chart(type = "column") %>%
hc_title(text = "A Highcharter chart") %>%
hc_xAxis(categories = 2012:2016) %>%
hc_add_series(
data = c(3900, 4200, 5700, 8500, 11900),
name = "Download"
)

hchart()函数可以根绝传入的对象绘制不同类型的图表:

1
2
3
hchart(diamonds$cut,
colorByPoint = T,
name = "Cut")

1
2
hchart(diamonds$price, color = "#31CF65", name = "Price") %>% 
hc_title(text = "You can room me!")

还可以传入forecast类:

1
2
3
library(forecast)
airforcast <- forecast(auto.arima(AirPassengers), level = 95)
hchart(airforcast)

HighStock

1
2
3
4
5
6
library(quantmod)
x <- getSymbols("GOOG", auto.assign = F)
y <- getSymbols("AMZN", auto.assign = F)
highchart(type = 'stock') %>%
hc_add_series(x) %>%
hc_add_series(y, type = 'ohlc')

HighMaps

1
2
3
4
5
6
7
8
9
10
11
12
13
data("unemployment")
hcmap("countries/us/us-all-all",
data = unemployment,
name = "Unemployment",
value = "value",
joinBy = c("hc-key", "code"),
borderColor = "transparent") %>%
hc_colorAxis(dataClasses = color_classes(c(seq(0, 10, by = 2), 50))) %>%
hc_legend(layout = "vertical",
align = "right",
floating = T,
valueDecimals = 0,
valueSuffix = "%")

案例

星球大战

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
library(tidyverse)
library(rwars)
swmovies <- get_all_films()
swdata <- map_df(
swmovies$results,
function(x){
data_frame(
movie = x$title,
species = length(x$species),
planets = length(x$planets),
characters = length(x$characters),
vehicles = length(x$vehicles),
release = x$release_date
)
}) %>%
gather(key, number, -movie, -release) %>%
arrange(release)

hchart(swdata, "line",
hcaes(x = "movie", y = "number",
group = "key"),
color = c("#e5b13a", "#4bd5ee", "#4AA942", "#FAFAFA")) %>%
hc_title(
text = "Diversity in <span style=\"color:#e5b13a\">START WARS</span> movies",
useHTML = T
) %>%
hc_tooltip(table = T, sort = T) %>%
hc_credits(
enabled = T,
text = "Source: SWAPI via rwars package",
href = "https://swapi.io/"
) %>%
hc_add_theme(
hc_theme_flatdark(
chart = list(
backgroundColor = "transparent",
divBackgroundImage = "http://www.wired.com/images_blogs/underwire/2013/02/xwing-bg.gif"
)
)
)

赫罗图

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
data(stars)
colors <- c("#FB1108","#FD150B","#FA7806","#FBE426","#FCFB8F",
"#F3F5E7", "#C7E4EA","#ABD6E6","#9AD2E1")
stars$color <- colorize(log(stars$temp), colors)
x <- c("Luminosity", "Temperature", "Distance")
y <- sprintf("{point.%s:.2f}", c("lum", "temp", "distance"))
tltip <- tooltip_table(x, y)
hchart(stars, "scatter",
hcaes("temp", "lum", size = "radiussun",
color = "color")) %>%
hc_chart(backgroundColor = "black") %>%
hc_xAxis(type = "logarithmic", reversed = T) %>%
hc_yAxis(type = "logarithmic", gridLineWidth = 0) %>%
hc_title(text = "Our nearest Stars") %>%
hc_subtitle(text = "In a Hertzsprung-Russell diagram") %>%
hc_tooltip(useHTML = T, headerFormat = "", pointFormat = tltip) %>%
hc_size(height = 600)

全球气温

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
data("globaltemp")
x <- c("Min", "Median", "Max")
y <- sprintf("{point.%s}", c("lower", "median", "upper"))
tltip <- tooltip_table(x, y)
hchart(globaltemp, type = "columnrange",
hcaes(x = "date", low = "lower", high = "upper", color = "median")) %>%
hc_yAxis(tickPositions = c(-2, 0, 1.5, 2),
gridLineColor = "#B71C1C",
labels = list(format = "{value} C", useHTML = T)) %>%
hc_tooltip(
useHTML = T,
headerFormat = as.character(tags$small("{point.x: %Y %m}")),
pointFormat = tltip
) %>%
hc_add_theme(hc_theme_db())

天气雷达图

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
data("weather")
x <- c("Min", "Mean", "Max")
y <- sprintf("{point.%s}", c("min_temperature", "mean_temperature", "max_temperature"))
tltip <- tooltip_table(x, y)
hchart(weather, type = "columnrange",
hcaes(x = "date", low = "min_temperaturec",
high = "max_temperaturec",
color = "mean_temperaturec")) %>%
hc_chart(polar = T) %>%
hc_yAxis(max = 30, min = -10, labels = list(format = "{value} C"), showFirstLabel = F) %>%
hc_xAxis(
title = list(text = ""), gridLineWidth = 0.5,
labels = list(format = "{value: %b}")) %>%
hc_tooltip(useHTML = T, pointFormat = tltip,
headerFormat = as.character(tags$small("{point.x:%d %B, %Y}")))

疫苗的作用

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
data("vaccines")
library(viridis)
fntltp <- JS("function(){
return this.point.x + ' ' + this.series.yAxis.categories[this.point.y] + ':<br>' +
Highcharts.numberFormat(this.point.value, 2);
}")

plotline <- list(
color = "#fde725", value = 1963, width = 2,
zIndex = 5,
label = list(
text = "Vaccine Intoduced", verticalAlign = "top",
style = list(color = "#606060"), textAlign = "left",
rotation = 0, y = -5
)
)

hchart(vaccines, "heatmap",
hcaes(x = "year", y = "state",
value = "count")) %>%
hc_colorAxis(stops = color_stops(10, rev(inferno(10))), type = "logarithmic") %>%
hc_yAxis(reversed = T, offset = -20,
tickLength = 0, gridLineWidth = 0,
minorGridLineWidth = 0,
labels = list(style = list(fontSize = "8px"))) %>%
hc_tooltip(formatter = fntltp) %>%
hc_xAxis(plotLines = list(plotline)) %>%
hc_title(text = "Infections Diseases and Vacines") %>%
hc_legend(layout = "vertical", verticalAlign = "top", align = "right", valueDecimals = 0) %>%
hc_size(height = 800)

Highcharter API

1
2
3
4
5
6
7
data("citytemp")
hc <- highchart() %>%
hc_xAxis(categroies = citytemp$month) %>%
hc_add_series(name = "东京", data = citytemp$tokyo) %>%
hc_add_series(name = "伦敦", data = citytemp$london) %>%
hc_add_series(name = "其它城市", data = (citytemp$tokyo + citytemp$london)) %>%
print()

1
2
3
4
5
6
7
8
9
10
hc %>% 
hc_chart(borderColor = "#EBBA95",
borderRadius = 10,
borderWidth = 2,
backgroundColor = list(
linearGradient = c(0, 0, 500, 500),
stops = list(
list(0, 'rgb(255, 255, 255)'),
list(1, 'rgb(200, 200, 255)')
)))

1
2
3
4
5
6
hc <- hc %>% 
hc_chart(type = "column",
options3d = list(enabled = T,
beta = 15,
alpha = 15)) %>%
print()

移除3D效果:

1
2
hc <- hc_chart(hc, type = 'line', 
options3d = list(enabled = F))

hc_colors

使用hc_colors可以重新定义自己的调色板:

1
2
3
4
5
library(viridisLite)
cols <- viridis(3)
cols <- substr(cols, 0, 7)
hc %>%
hc_colors(colors = cols)

hc_xAxis和hc_yAxis:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
hc %>% 
hc_xAxis(title = list(text = "Month in x Axis"),
opposite = T,
plotLines = list(
list(label = list(text = "This is a plotLine"),
color = "#FF0000",
width = 2,
value = 5.5)
)) %>%
hc_yAxis(title = list(
text = "Temperature in y Axis"
),
opposite = T,
minorTickInterval = "auto",
minorGridLineDashStyle = "LongDashPlot",
showFirstLabel = F,
showLastLabel = F,
plotBands = list(
list(from = 25, to = JS("Infinity"),
color = "rgb(100, 0, 0, 0.1)",
label = list(list(text = "This is a plotBand")))
))

hc_add_series & hc_rm_series

1
2
3
4
5
hc <- highchart() %>% 
hc_xAxis(categories = citytemp$month) %>%
hc_add_series(name = "东京", data = citytemp$tokyo) %>%
hc_add_series(name = "纽约", data = citytemp$new_york) %>%
print()

1
2
3
hc %>% 
hc_rm_series(name = "纽约") %>%
hc_add_series(name = "伦敦", data = citytemp$london, type = "area")

hc_title, hc_subtitle, hc_credits, hc_legend, hc_tooltip, hc_exporting

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
hc %>% 
hc_title(text = "This is a title with <i>margin</i> and <b>Strong or bold text</b>",
margin = 20, align = "left",
style = list(color = "#90ed7d",
useHTML = TRUE)) %>%
hc_subtitle(text = "And this is a subtitle with more information",
align = "left",
style = list(color = "#2b908f",
fontWeight = "bold")) %>%
hc_credits(enabled = T,
text = "https://www.czxa.top",
href = "https://www.czxa.top") %>%
hc_legend(align = "left",
verticalAlign = "top",
layout = "vertical",
x = 0, y = 100) %>%
hc_tooltip(crosshairs = T, backgroundColor = "#FCFFC5", shared = T, borderWidth = 5) %>%
hc_exporting(enabled = T)

hchart函数

数据框

1
2
3
4
data("diamonds", economics_long, mpg, package = "ggplot2")
library(dplyr)
hchart(mpg, "scatter",
hcaes(x = "displ", y = "hwy", group = "class"))

1
2
3
4
5
6
mpgman2 <- mpg %>% count(class, year) %>% 
glimpse()

hchart(mpgman2, "column",
hcaes(x = "class", y = "n",
group = "year"))

1
2
3
4
5
6
7
8
9
mpgman3 <- mpg %>% 
group_by(manufacturer) %>%
summarise(n = n(), unique = length(unique(model))) %>%
arrange(-n, -unique) %>%
glimpse()

mpgman3 %>%
hchart("treemap",
hcaes(x = "manufacturer", value = "n", color = "unique"))

1
2
3
4
5
6
economics_long2 <- economics_long %>% 
filter(variable %in% c("pop", "uempmed", "unemploy")) %>%
print()

hchart(economics_long2, "line",
hcaes(x = "date", y = "value01", group = "variable"))

连续型数值变量

1
hchart(diamonds$price)

密度

1
2
hchart(density(diamonds$price), type = "area", 
color = "#B71C1C", name = "Price")

因子变量

1
hchart(diamonds$cut, type = "column")

时间序列

1
LakeHuron %>% hchart(name = "LakeHuron")

时间序列的季节性分解

1
2
x <- stl(log(AirPassengers), "per")
hchart(x)

预测

1
2
3
4
library(forecast)
# ets:指数平滑状态空间模型
x <- forecast(ets(USAccDeaths), h = 48, level = 95)
hchart(x)

xts

1
2
3
library(quantmod)
x <- getSymbols("USD/CNY", src = "oanda", auto.assign = F)
hchart(x)

xts ohlc

1
2
x <- getSymbols("000001.SS", auto.assign = F)
hchart(x)

自协方差和自相关图

1
2
x <- acf(diff(AirPassengers), plot = F)
hchart(x)

多个时间序列

1
2
cbind(mdeaths, fdeaths) %>% 
hchart()

生存模型

1
2
3
4
5
library(survival)
data("lung")
lung <- mutate(lung, sex = ifelse(sex == 1, "Male", "Female"))
fit <- survfit(Surv(time, status) ~ sex, data = lung)
hchart(fit, ranges = T)

主成分分析

1
hchart(princomp(USArrests, cor = T))

矩阵可视化

1
2
3
4
data("volcano")
hchart(volcano) %>%
# 改变默认配色
hc_colorAxis(stops = color_stops(colors = viridis::inferno(10)))

1
2
3
4
# 距离矩阵
mtcars[1:20,] %>%
dist() %>%
hchart()

1
2
# 相关系数矩阵
hchart(cor(mtcars))

shortcuts

一些从R对象中添加数据的快捷方式。

箱线图

1
2
3
library(highcharter)
hcboxplot(x = diamonds$x, var = diamonds$color,
name = "Length", color = "#2980b9")

1
2
3
4
hcboxplot(x = diamonds$x, var = diamonds$color,
var2 = diamonds$cut,
outliers = F) %>%
hc_chart(type = "column")

平行坐标图

这个图CRAN上下载的包可以画,github上下载的包不能正确绘制。

1
2
3
4
require(viridisLite)
n <- 15
hcparcords(head(mtcars, n),
color = hex_to_rgba(magma(n), 0.5))

树图

1
2
3
4
5
6
7
8
9
10
11
12
library(treemap)
library(viridisLite)
data("GNI2014")

tm <- treemap(GNI2014,
index = c("continent",
"iso3"),
vSize = "population",
vColor = "GNI",
type = "value",
palette = viridis(6))
hctreemap(tm) # deprecated

1
2
3
hctreemap2(GNI2014, group_vars = "country",
size_var = "population",
color_var = "GNI")

主题

1
2
3
4
5
6
# 默认主题
hc <- highcharts_demo() %>%
print()

# ggplot2主题
hc %>% hc_add_theme(hc_theme_ggplot2())

538主题

1
2
hc %>% 
hc_add_theme(hc_theme_538())

Economist主题

1
2
hc %>% 
hc_add_theme(hc_theme_economist())

Financial Times主题

1
2
hc %>% 
hc_add_theme(hc_theme_ft())

Dotabuff主题

1
2
hc %>% 
hc_add_theme(hc_theme_db())

Flat主题

1
2
hc %>% 
hc_add_theme(hc_theme_flat())

1
2
hc %>% 
hc_add_theme(hc_theme_flatdark())

simple主题

1
2
hc %>% 
hc_add_theme(hc_theme_smpl())

elementary主题

1
2
hc %>% 
hc_add_theme(hc_theme_elementary())

Google主题

1
2
hc %>% 
hc_add_theme(hc_theme_google())

FireFox主题

1
2
hc %>% 
hc_add_theme(hc_theme_ffx())

Monokai主题

1
2
hc %>% 
hc_add_theme(hc_theme_monokai())

Tufte主题

1
2
hc %>% 
hc_add_theme(hc_theme_tufte())

1
2
3
4
5
6
7
8
9
10
11
dta <- dplyr::tibble(
x = rnorm(15),
y = 1.5 * x + rnorm(15)
) %>% print()

highchart() %>%
hc_chart(type = "scatter") %>%
hc_add_series(
data = list_parse(dta)
) %>%
hc_add_theme(hc_theme_tufte())

1
2
3
4
5
6
values <- 1 + abs(rnorm(12))
highchart() %>%
hc_chart(type = "column") %>%
hc_add_series(data = values) %>%
hc_xAxis(categories = month.abb) %>%
hc_add_theme(hc_theme_tufte2())

sparkline主题

1
2
3
library(tidyverse)
hc %>%
hc_add_theme(hc_theme_sparkline())

grid light主题

1
2
hc %>% 
hc_add_theme(hc_theme_gridlight())

sand signika主题

1
2
hc %>% 
hc_add_theme(hc_theme_sandsignika())

dark unica主题

1
2
hc %>% 
hc_add_theme(hc_theme_darkunica())

chalk主题

1
2
hc %>% 
hc_add_theme(hc_theme_chalk())

Hand drawn主题

1
2
hc %>% 
hc_add_theme(hc_theme_handdrawn())

null主题

1
hc %>% hc_add_theme(hc_theme_null())

自定义主题

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
thm <- hc_theme(
colors = c('red', 'green', 'blue'),
chart = list(
backgroundColor = NULL,
divBackgroundImage = "http://media3.giphy.com/media/FzxkWdiYp5YFW/giphy.gif"
),
title = list(
style = list(
color = "#333333",
fontFamliy = "Lato"
)
),
substitute = list(
style = list(
color = "#666666",
fontFamily = "Shadows Into Light"
)
),
legend = list(
itemStyle = list(
fontFamily = 'Tangerine',
color = 'black'
),
itemHoverStyle = list(
color = 'gray'
)
)
)

hc %>%
hc_add_theme(thm)

合并主题

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
thm <- hc_theme_merge(
hc_theme_darkunica(),
hc_theme(
chart = list(
backgroundColor = "transparent",
divBackgroundImage = "http://www.czxa.top/photowall/xiaoxiao/DSC03616.JPG"
),
title = list(
style = list(
color = "white",
fontFamily = "HannotateSC-W7"
)
)
)
)

hc %>% hc_add_theme(thm)

shiny使用

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
library(shiny)
library(highcharter)
data("citytemp")
ui <- fluidPage(
h1("Highcharter示例"),
fluidRow(
column(width = 4, class = "panel",
selectInput(
inputId = "type",
label = "图表类型",
width = "100%",
choices = c("line", "column",
"bar", "spline")
),
selectInput(
inputId = "stacked",
label = "堆叠方式",
width = "100%",
choices = c(
F, "normal", "percent"
)
),
selectInput(
inputId = "theme",
label = "主题",
width = "100%",
choices = c(
F, "fivethirtyeight", "economist",
"darkunica", "gridlight",
"sandsignika", "null",
"handdrawn", "chalk"
)
)),
column(width = 8,
highchartOutput(
"hcontainer",
height = "500px"))
)
)

server <- function(input, output){
output$hcontainer <- renderHighchart({
hc <- highcharts_demo() %>%
hc_rm_series("Berlin") %>%
hc_chart(type = input$type)
if(input$stacked != F){
hc <- hc %>%
hc_plotOptions(
series = list(
stacking = input$stacked
)
)
}

if(input$theme != F){
theme <- switch(
input$theme,
null = hc_theme_null(),
darkunica = hc_theme_darkunica(),
gridlight = hc_theme_gridlight(),
sandsignika = hc_theme_sandsignika(),
fivethirtyeight = hc_theme_538(),
economist = hc_theme_economist(),
chalk = hc_theme_chalk(),
handdrawn = hc_theme_handdrawn()
)
hc <- hc %>% hc_add_theme(theme)
}
hc
})
}

shinyApp(ui = ui, server = server)

# R

评论

程振兴

程振兴 @czxa.top
截止今天,我已经在本博客上写了604.4k个字了!

Your browser is out-of-date!

Update your browser to view this website correctly. Update my browser now

×