echarty
Minimal R/Shiny Interface to ECharts.js
Gallery
Some interesting charts along with their code. Several have Live Demos hosted on RPubs. The echarty package has two dozen more examples - in RStudio type ?ec.examples to see them in panel Help.
Simple bar
demo for presets
🔻View code
library(echarty); library(dplyr)
library(lubridate)
df <- data.frame(date=as.character(as.Date('2019-12-31') %m+% months(1:13)),
num=runif(13))
# with presets and df chained
p <- df |> ec.init(ctype='bar') |> ec.theme('dark')
p
# without presets all options are explicitly assigned
p <- ec.init(preset= FALSE) |> ec.theme('dark')
p$x$opts <- list(
yAxis= list(show= TRUE),
xAxis= list(type= 'category',
axisLabel= list(interval= 0, rotate= 45)
#, axisTick= list(alignWithLabel= TRUE)
),
series= list(list(
type= 'bar', data= ec.data(df, 'values', FALSE)))
)
p
Data models
how to store data in echarty -
Live Demo with code
Horizontal bars
🔻 View code
library(echarty); library(dplyr)
df <- Orange |> mutate(Tree= as.character(Tree)) |>
arrange(Tree) |> group_by(Tree) |> group_split()
p <- ec.init(preset=FALSE) |> ec.theme('dark')
p$x$opts <- list(
series= lapply(df, function(t) {
list(type= 'bar', name= unique(t$Tree), data= t$circumference) }),
legend= list(show=TRUE),
xAxis= list(name= 'tree circumference in mm', nameLocation= 'center', nameGap= 22),
yAxis= list(data= unique(Orange$age), name= 'age in days'),
tooltip= list(formatter= 'circumference={c} mm')
)
l <- length(p$x$opts$series)
p$x$opts$series[[l]]$name <- paste(p$x$opts$series[[l]]$name, ' trees')
p
Easy as pie
🔻 View code
isl <- data.frame(name= names(islands), value= islands) |> filter(value>60) |> arrange(value)
library(echarty)
p <- ec.init()
p$x$opts <- list(
title= list(text= "Landmasses over 60,000 mi\u00B2", left= 'center'),
tooltip= list(trigger= 'item'),
series= list(type= 'pie', data= ec.data(isl, 'names')),
backgroundColor= '#191919')
p
Parallel chart
🔻 View code
library(echarty)
p <- iris |> group_by(Species) |>
ec.init(ctype='parallel') |> ec.theme('dark-mushroom')
p$x$opts$series <- lapply(p$x$opts$series, function(s) {
s$smooth=TRUE; s$lineStyle=list(width=3); s }) # update preset series
p$x$opts$color <- rainbow(10)
p
Custom chart
🔻 View code
# source https://echarts.apache.org/examples/en/editor.html?c=custom-profit
# GUI translated with demo(js2r) with rdata and ritem added
library(echarty); library(dplyr)
data <- list(c(10, 16, 3, "A"), c(16, 18, 15, "B"), c(18, 26, 12, "C"), c(26, 32, 22, "D"), c(32, 56, 7, "E"), c(56, 62, 17, "F"))
colorList <- c("#4f81bd", "#c0504d", "#9bbb59", "#604a7b", "#948a54", "#e46c0b")
rdata <- 1:6 %>% purrr::map(function(x) {
list(value= data[[x]],
itemStyle= list(color=colorList[x])) })
ritem <- "function renderItem(params, api) {
var yValue= api.value(2);
var start= api.coord([api.value(0), yValue]);
var size= api.size([api.value(1) - api.value(0), yValue]);
var style= api.style();
return {
type: 'rect',
shape: {
x: start[0],
y: start[1],
width: size[0],
height: size[1]
},
style: style
};
}"
p <- ec.init() |> ec.theme('dark-mushroom') # only 2 commands used
p$x$opts <- list(
title= list(text= "Profit", left= "center"),
tooltip= list(zz= ""),
xAxis= list(scale= TRUE), yAxis= list(zz= ""),
series= list(list(type= "custom",
renderItem= htmlwidgets::JS(ritem),
label= list(show= TRUE, position= "top"),
dimensions= list("from", "to", "profit"),
encode= list(x= list(0, 1), y= 2,
tooltip= list(0, 1, 2), itemName= 3),
data= rdata ))
)
p
Error Bars
🔻 View code
# example by https://github.com/kuzmenkov111
library(echarty)
library(data.table)
library(binom); library(dplyr)
# function for percent and CI calculation
myfun_binom <- function(n,all){
round((binom::binom.confint(n, all, methods= "wilson", conf.level=0.95)[,c(4:6)])*100,2)
}
# --- 1. data prep
stackbar <- data.table(Year= c(2010, 2010, 2010, 2011, 2011, 2011, 2012, 2012, 2012, 2013,2013, 2013),
Category= c("A", "B", "C", "A", "B", "C", "A", "B", "C", "A", "B", "C"),
n= c(10, 20, 30, 30, 20, 10, 11,12,13, 15, 15, 15))
# calculate percent and 95% CI
stackbar <- stackbar[,`:=`(all=sum(n)), by= c("Year")][,c("perc","low","up") := myfun_binom(n,all)]
stackbar <- stackbar |> mutate(xlbl=paste0(Year,' (N=',all,')'))
stackbar <- stackbar |> relocate(xlbl,perc) # move in front as natural X & Y columns
stackbar <- stackbar |> group_by(Category) # both ec.init & ecr.ebars need grouped data
# --- 2. plot
q <- stackbar |> ec.init(ctype='bar', load='custom') |>
ec.theme('dark-mushroom') |>
ecr.ebars(stackbar[,c('xlbl','low','up','Category')], # only columns for x,low,high,category
hwidth= 9) # (optional) half-width of err.bar in pixels
# --- 3. customization
groupColors <- c("#387e78","#eeb422","#d9534f")
q$x$opts$series <- lapply(q$x$opts$series, function(s, i) {
if (s$type=='bar') {
s$emphasis <- list(focus= 'series')
s$color <- groupColors[parent.frame()$i[]] # iteration hack, for fun only
}
else if (s$type=='custom')
s$color <- 'cyan'
s
})
q # customized
Triple gauge with animation
🔻 View code
jcode <- "setInterval(function () {
opts.series[0].data[0].value= (Math.random() * 100).toFixed(2) - 0;
opts.series[0].data[1].value= (Math.random() * 100).toFixed(2) - 0;
opts.series[0].data[2].value= (Math.random() * 100).toFixed(2) - 0;
chart.setOption(opts, true);
}, 2000);"
library(echarty)
p <- ec.init(js=jcode) |> ec.theme('dark')
p$x$opts <- list(series= list(
list(type= "gauge",
anchor= list(show= TRUE, showAbove= TRUE,
size= 18, itemStyle= list(color= "#FAC858")),
pointer= list(icon= "path://M2.9,0.7L2.9,0.7c1.4,0,2.6,1.2,2.6,2.6v115c0,1.4-1.2,2.6-2.6,2.6l0,0c-1.4,0-2.6-1.2-2.6-2.6V3.3C0.3,1.9,1.4,0.7,2.9,0.7z",
width= 8, length= "80%", offsetCenter= list(0, "8%")),
progress= list(show= TRUE,
overlap= TRUE, roundCap= TRUE), axisLine= list(roundCap= TRUE),
data= list(
list(value= 20, name= "One", title= list(offsetCenter= list("-40%", "80%")), detail= list(offsetCenter= list("-40%","95%"))),
list(value= 40, name= "Two", title= list(offsetCenter= list("0%", "80%")), detail= list(offsetCenter= list("0%", "95%"))),
list(value= 60, name= "Three", title= list(offsetCenter= list("40%", "80%")), detail= list(offsetCenter= list("40%","95%")))),
title= list(fontSize= 14), detail= list(width= 40, height= 14, fontSize= 14, color= "#fff", backgroundColor= "auto", borderRadius= 3, formatter= "{value}%"))))
p
Crosstalk in 3D
🔻 View code
# echarty can highlight 3D points selected by external controls
library(crosstalk); library(DT); library(d3scatter);
library(htmltools); library(dplyr); library(tibble)
sdf <- mtcars |> rownames_to_column(var='name') |> relocate(mpg,wt,hp)
sdf <- SharedData$new(sdf)
library(echarty)
p3 <- sdf |> ec.init(load='3D',
title= list(text="3D brush listener")) |>
ec.theme('dark-mushroom')
p3$x$opts$series[[1]] <- list(
type='scatter3D', symbolSize=11,
itemStyle=list(color= htmlwidgets::JS("function(params){
let cyl=params.value[4]; return (cyl==4 ? 'RoyalBlue' : cyl==6 ? 'OrangeRed':'green');}") ),
emphasis= list(focus='self', blurScope='series', itemStyle=list(color='red'))
)
bscols( list(
d3scatter(sdf, ~mpg, ~wt, ~factor(cyl), width="100%", height=300),br(),
datatable(sdf, extensions="Scroller", style="bootstrap", class="compact", width="100%",
options=list(deferRender=TRUE, scrollY=300, scroller=TRUE))
), p3
)
Crosstalk 2D
play with the Live Demo with code
scatterGL
plugin 3D, test with 5,000 points
🔻 View code
# example works also with slower type='scatter', with ec.data(dat, format='values')
# ------ 1) prepare data
library(tibble)
dim <- 2500 # sample data half-quantity, could be much more
slip <- if (dim %% 2) 0.1 else -0.1
setData <- function(offset) {
t <- tibble(x= runif(dim, max=10),
y= offset + sin(x) - x * slip * runif(dim))
round(t,3)
}
# two sets, same data shifted vertically
dat <- rbind(setData(0), setData(1))
# ------ 2) show data
library(echarty)
p <- ec.init(load='3D') |> ec.theme('dark-mushroom')
p$x$opts <- list(
title= list(text=paste('scatterGL -',nrow(dat),'points + zoom')),
xAxis= list(show=TRUE),
yAxis= list(show=TRUE),
series= list(type= 'scatterGL', data= ec.data(dat, 'dataset', FALSE),
symbolSize=3, large=TRUE,
itemStyle=list(opacity=0.4, color='cyan')
),
dataZoom= list(type='inside',start=50)
)
p
scatter3D
plugin 3D, test with 36,000 points
🔻 View code
library(onion); library(echarty)
data(bunny)
tmp <- as.data.frame(bunny)
p <- tmp |> ec.init(load='3D') |> ec.theme('dark-mushroom')
p$x$opts$series[[1]] <- list(type='scatter3D', symbolSize=2)
p$x$opts$visualMap <- list(
inRange=list(color= rainbow(10)), calculable=TRUE,
min=min(tmp$y), max=max(tmp$y), dimension=1)
p
Bathymetry in 3D
up to 200,000 surface points. Good performance test for CPU/GPU.
🔻 Shiny app - Live Demo
Multiple 3D examples based on ocean floor measurements in different locations across the planet.
The app requires shiny and several other libraries with their dependencies - source code.
Run the demo with command:
shiny::runGist('https://gist.github.com/helgasoft/121d7d3ff7d292990c3e05cfc1cbf24b')
Timeline in 3D
demographic data evolution in the last 200 years
🔻 View code
# see also original 2D: https://helgasoft.github.io/echarty/uc5.html
library(dplyr)
# data download and preparation
tmp <- jsonlite::fromJSON('https://echarts.apache.org/examples/data/asset/data/life-expectancy.json')
tmp$series[,,2] <- round(as.numeric(tmp$series[,,2]), 1) # life exp rounded
tmp$series[,,3] <- round(as.numeric(tmp$series[,,3])/1000000, 2) # pop in Millions
df <- as.data.frame(tmp$series[1,,])
for(i in 2:nrow(tmp$series)) {
df <- rbind(df, as.data.frame(tmp$series[i,,]))
} # convert array to data.frame
colnames(df) <- c('Income','Life','Population','Country','Year')
tt <- df$Country; df <- df[,-4]; df[] <- lapply(df, as.numeric); df$Country<-tt
df$SymSize <- (sqrt(df$Population / 5e2) + 0.1) *80
df <- df |> relocate(Year, .after= last_col())
# set colors for countries
colors <- rep(c('#8b0069','#75c165', '#ce5c5c', '#fbc357', '#8fbf8f', '#659d84',
'#fb8e6a', '#c77288', '#786090', '#91c4c5', '#6890ba'), 2)
i <- 0
pieces <- lapply(unique(df$Country), function(x) {
i <<- i+1; list(value= x, color= colors[i])
})
# remotes::install_github("helgasoft/echarty") # needs v.1.4.4+
library(echarty)
p <- df |> group_by(Year) |> ec.init(
load= '3D',
tl.series= list(
type= 'scatter3D', coordinateSystem= 'cartesian3D',
itemStyle= list(opacity= 0.8),
encode= list(x= 'Income', y= 'Life', z= 'Year'),
symbolSize= ec.clmn(5), # 5 is SymSize
tooltip= list( backgroundColor= 'transparent',
formatter= ec.clmn('<b>%@</b><br>life exp: <b>%@</b><br>income: <b>$%@</b><br>populat: <b>%@M</b>',4,2,1,3)
)
)) |>
ec.theme('dark-mushroom') |> ec.snip()
p$title= list(list(left=5, top='top', textStyle=list(fontSize=50, color='#11111166')),
list(text= "Life expectancy and GDP by year", top= 10,
left= "center", textStyle= list(fontWeight= "normal", fontSize= 20)) )
p$timeline <- append(p$timeline, list(
orient= "vertical",
autoPlay= TRUE, playInterval= 500, left= NULL, right= 0, top= 20, bottom= 20,
width= 55, height= NULL, symbol= "none", checkpointStyle= list(borderWidth= 2)
))
p$grid3D= list(axisLabel= list(textStyle= list(color='#ddd')))
p$xAxis3D= list(name= 'Income', min= 15, axisLabel= list(formatter= "${value}"),
nameTextStyle= list(color= '#ddd'), nameGap= 25)
p$yAxis3D= list(name= 'Life Expectancy', min= 15,
nameTextStyle= list(color= '#ddd'))
p$zAxis3D= list(name= 'Year', min= 1790, max=2022,
nameTextStyle= list(color= '#ddd'), nameGap= 25,
# minInterval= 1 does not work in 3D, use formatter to show integers for Year
axisLabel= list(formatter= htmlwidgets::JS("function(val) {if (val % 1 === 0) return val;}"))
)
p$visualMap= list(show= FALSE, dimension= 'Country', type= 'piecewise', pieces= pieces)
p$tooltip <- list(show= TRUE)
ec.snip(p)
Radar chart customized
🔻 View code
data <- data.frame(
name= c(3,5,7,8,9),
values= c(12,45,23,50,32), max= rep(60, 5)
)
# build a list for rich formatting
rifo <- lapply(data$name, function(x) {
list(height= 30, backgroundColor=list(
image=paste0('https://raw.githubusercontent.com/googlefonts/noto-emoji/main/png/32/emoji_u1f30',x,'.png')))
})
names(rifo) <- data$name
library(echarty)
p <- data |> ec.init(preset= FALSE) |> ec.theme('dark-mushroom')
p$x$opts$radar <- list(
indicator= ec.data(data, 'names'),
name= list(
formatter= htmlwidgets::JS("v => '{'+v+'| }'"),
rich= rifo)
)
p$x$opts$series= list( list(
type= 'radar',
data= list(data$values)
))
p
Simple or grouped boxplots
boxplot calculations in R or ECharts
🔻 View code
library(echarty); library(dplyr)
# 1) boxplot calculation in R ---------------------
p <- ec.init()
p$x$opts$series <- list(
list(type='boxplot', name='mpg', data=list(boxplot.stats(mtcars$mpg)$stats)),
list(type='boxplot', name='hp', data=list(boxplot.stats(mtcars$hp)$stats)),
list(type='boxplot', name='disp',data=list(boxplot.stats(mtcars$disp)$stats))
)
p$x$opts$xAxis <- list(type= 'category')
p$x$opts$legend <- list(show=TRUE)
p
# 2) boxplot calculation in ECharts ---------------------
df <- mtcars[,c(1,3,4)] |> mutate(mpg=mpg*10)
p <- ec.init()
p$x$opts$dataset <- list(
list(source= ec.data(data.frame(t(df)), header=FALSE)),
list(transform= list(type='boxplot')),
list(fromDatasetIndex=1, fromTransformResult= 1))
p$x$opts$series <- list(
list(name= 'boxplot', type= 'boxplot', datasetIndex= 1),
list(name= 'outlier', type= 'scatter', encode= list(x=1, y=0), datasetIndex= 2)
)
p$x$opts$yAxis <- list(type= 'category', boundaryGap=TRUE)
p$x$opts$legend <- list(show=TRUE)
p
# 3) grouped boxplots ---------------------
# remotes::install_github("helgasoft/echarty") # needs new v.1.4.4+
ds <- mtcars |> relocate(am,mpg) |> group_by(cyl) |> ec.data(format='boxplot')
# Below we mutate to create less Y-axis items with more, sufficient data. Otherwise ECharts exits with errors.
# ds <- airquality |> mutate(Day=round(Day/10)) |> relocate(Day,Wind) |> ec.data(format='boxplot')
p <- ec.init()
p$x$opts <- list(
dataset= ds$dataset,
series= ds$series,
yAxis= list(type= 'category'),
xAxis= list(show= TRUE),
legend= list(show= TRUE)
)
p
Boxplot + scatter overlay
a horizontal chart with zoom and tooltips
🔻 View code
Inspired by Julia Silge’s article.
ECharts advantage over ggplot is interactivity - zoom brush and tooltips.
A vertical layout version is also published.
#' inspired by https://juliasilge.com/blog/giant-pumpkins/
#' advantage over ggplot is interactivity - zoom brush and tooltips
#' TODO: totals by country, add year in tooltip
library(tidyverse)
pumpkins_raw <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-10-19/pumpkins.csv")
pumpkins <-
pumpkins_raw |>
separate(id, into= c("year", "type")) |>
mutate(across(c(year, weight_lbs), parse_number)) |>
filter(type == "P") |>
select(country, weight_lbs, year) |>
mutate(country= fct_lump(country, n= 10))
# set columns to: country, 2013, 2014, etc. (country by years)
tmp <- tidyr::pivot_wider(pumpkins, names_from= year, values_from= weight_lbs )
# merge each country's data into one list
rng <- lapply(tmp$country, function(x) unname(unlist(tmp[tmp$country==x, c(-1)])) )
asc.ord <- order(unlist(lapply(rng, median))) # sort order
rnames <- as.character(tmp$country[asc.ord])
tt <- rng[asc.ord]
yax <- paste(rnames, collapse="','") # for Y axis labels
yax <- paste0("function (params) { return ['",yax,"'][params.value]; }")
library(echarty)
p <- ec.init() |> ec.theme('dark-mushroom') |> ec.snip()
p$title <- list(
list(text="Giant Pumpkins", subtext='inspiration',
sublink='https://juliasilge.com/blog/giant-pumpkins/')
,list(text=paste(nrow(pumpkins),'records for 2013-2021'),
textStyle= list(fontSize= 12), left= '50%', top= '90%' )
)
p$xAxis <- list(name='weigth (lbs)', min=0,
nameLocation='center', nameGap=20)
p$yAxis <- list(
list(type= 'category'),
list(type= 'value', max=11, show=FALSE))
p$dataset <- list(
list(source= tt),
list(transform= list(type='boxplot',
config=list(itemNameFormatter= htmlwidgets::JS(yax))
)),
list(fromDatasetIndex= 1, fromTransformResult= 1)
)
p$series <- list( # use ECharts built-in boxplot
list(name= 'boxplot', type= 'boxplot', datasetIndex= 1
,color='LightGrey', itemStyle= list(color='DimGray'),
boxWidth=c(13,50) )
)
i <- 0.5
sers <- lapply(p$dataset[[1]]$source, function(xx) {
yy <- jitter(rep(i, length(xx)), amount=0.2); i <<- i + 1
xx <- jitter(xx, amount=0.2)
data <- list()
for(j in 1:length(xx)) data <- append(data, list(list(xx[j], yy[j])))
list(name='data', type= 'scatter', data=data, yAxisIndex=1,
symbolSize=3, itemStyle=list(opacity=0.3), color=heat.colors(11)[i-0.5],
emphasis= list(itemStyle= list(color= 'chartreuse', borderWidth=4, opacity=1)) )
})
p$series <- append(p$series, sers)
p$legend <- list(show=TRUE)
p$tooltip <- list(show=TRUE,
backgroundColor= 'rgba(30,30,30,0.5)',
textStyle= list(color='#eee'),
formatter=ec.clmn('%@ lbs', 1, scale=0))
p$toolbox <- list(left='right', feature=list(dataZoom=list(show=TRUE)))
ec.snip(p)
Correlation matrix
using heatmap chart
🔻 View code
library(dplyr)
# prepare and calculate data
mtx <- cor(infert %>% dplyr::mutate(education=as.numeric(education)))
order <- corrplot::corrMatOrder(mtx)
mtx <- mtx[order, order]
df <- as.data.frame(as.table(mtx))
for(i in 1:2) df[,i] <- as.character(df[,i])
# ECharts heatmap expects dataset columns in a certain order: relocate
library(echarty)
p <- df |> relocate(Var2) |> ec.init(ctype='heatmap') |> ec.theme('dark')
p$x$opts$title= list(text='Infertility after abortion correlation')
p$x$opts$xAxis$axisLabel <- list(rotate=45)
p$x$opts$visualMap <- list(min=-1, max=1, orient='vertical',left='right'
,calculable=TRUE, inRange=list( color=heat.colors(11)) )
p
Histogram
using bar chart
🔻 View code
library(echarty); library(dplyr)
do.histogram <- function(x, breaks='Sturges') {
# get histogram data from input 'x'
histo <- hist(x, plot=FALSE, breaks)
tmp <- data.frame(x=histo$mids, y=histo$counts)
tmp
}
p <- do.histogram(rnorm(44)) |> ec.init(ctype='bar') |> ec.theme('dark')
p
# with normal distribution line added
hh <- do.histogram(rnorm(44))
p <- hh |> ec.init(ctype='bar') |> ec.theme('dark')
nrm <- dnorm(hh$x, mean=mean(hh$x), sd=sd(hh$x)) # normal distribution
p$x$opts$xAxis <- list(list(show=TRUE), list(data=c(1:length(nrm))))
p$x$opts$yAxis <- list(list(show=TRUE), list(show=TRUE))
p$x$opts$series <- append(p$x$opts$series,
list(list(type='line', data=nrm, xAxisIndex=1, yAxisIndex=1, color='yellow')))
p
# same with timeline
hh <- data.frame()
for(i in 1:5) {
tmp <- do.histogram(rnorm(44)) |> mutate(time=rep(i,n()))
hh <- rbind(hh, tmp)
}
p <- hh |> group_by(time) |>
ec.init(tl.series=list(type='bar', encode=list(x='x',y='y'))) |>
ec.theme('dark')
p
Modularity plugin
DOW companies - size by market cap
🔻 View code
# click and drag items to see auto-rearrange effect
library(dplyr)
tmp <- jsonlite::fromJSON('https://quote.cnbc.com/quote-html-webservice/quote.htm?noform=1&partnerId=2&fund=1&exthrs=0&output=json&symbolType=issue&symbols=55991|44503|36276|56858|70258|1607179|84090|142105|145043|148633|151846|167459|174239|178782|174614|197606|202757|205141|205778|212856|228324|260531|277095|81364|283359|10808544|283581|286571|89999|522511530&requestMethod=extended')
df <- tmp$ExtendedQuoteResult$ExtendedQuote$QuickQuote
wt <- data.frame(tic=df$symbol, name=df$altName, bn=NA, size=NA,
mcap= df$FundamentalData$mktcapView,
rev= df$FundamentalData$revenuettm)
wt$bn <- round(as.numeric(gsub('M','',wt$mcap, fixed=TRUE))/1000,1) # mkt.cap
bnMax <- max(wt$bn)
wt$size <- 30 + wt$bn/bnMax * 140 # size 30 to 140 px depending on mkt.cap
library(echarty)
p <- ec.init(load='gmodular');
p$x$opts <- list(
title=list(text='DOW 2021',x='center',y='bottom',
backgroundColor='rgba(0,0,0,0)',borderColor='#ccc',
borderWidth=0,padding=5,itemGap=10,
textStyle=list(fontSize=18,fontWeight='bolder',color='#eee'),subtextStyle=list(color='#aaa')),
backgroundColor='#000',
animationDurationUpdate= "function(idx) list(return idx * 100; )",
animationEasingUpdate= 'bounceIn',
series= list(list(
type='graph', layout='force',
force=list(repulsion=250,edgeLength=10),
modularity= list(resolution=7, sort=TRUE),
roam=TRUE, label=list(show=TRUE),
data= lapply(ec.data(wt, 'names'), function(x)
list(name= x$tic, lname=x$name, value=x$bn,
symbolSize=x$size, draggable=TRUE
)) )),
tooltip= list(formatter= ec.clmn('<b>%@</b><br>%@ bn','lname','value'))
)
p
Graph
Circular layout diagram for ‘Les Miserables’ characters
🔻 View code
# https://echarts.apache.org/examples/en/editor.html?c=graph-circular-layout
library(echarty); library(dplyr)
les <- jsonlite::fromJSON('https://echarts.apache.org/examples/data/asset/data/les-miserables.json')
les$categories$name <- as.character(1:9)
p <- ec.init(preset=FALSE, title=list(text='Les Miserables',top='bottom',left='right'))
p$x$opts$series <- list(list(
type='graph', layout='circular',
circular= list(rotateLabel=TRUE),
nodes= ec.data(les$nodes, 'names'),
links= ec.data(les$links, 'names'),
categories= ec.data(les$categories, 'names'),
roam= TRUE, label=list(position='right', formatter='{b}'),
lineStyle= list(color='source', curveness=0.3)
))
p$x$opts$series[[1]]$nodes <- lapply(p$x$opts$series[[1]]$nodes, function(n) {
n$label <- list(show=n$symbolSize > 30); n }) # labels for most important
p$x$opts$legend <- list(data=c(les$categories$name), textStyle=list(color='#ccc'))
p$x$opts$tooltip <- list(show=TRUE)
p$x$opts$backgroundColor <- '#191919'
p
ecStat
Statistical tools plugin in echarty Live Demo with code
Morphing charts
Animated transitions between charts
Live Demo with code
Custom SVG map
with mouse events Live Demo
🔻 View code
#' JS source https://echarts.apache.org/examples/en/editor.html?c=geo-organ
#' p$x$opts from original 'options' translated with demo(js2r)
#' p$x$on handlers added manually
#' demo @ https://rpubs.com/echarty/svg
library(echarty); library(dplyr)
url <- 'https://echarts.apache.org/examples/data/asset/geo/Veins_Medical_Diagram_clip_art.svg'
svg <- url |> readLines(encoding='UTF-8') |> paste0(collapse="")
p <- ec.init(preset=FALSE) |> ec.theme('dark-mushroom')
p$x$registerMap <- list(list(mapName='organs', svg=svg))
p$x$on <- list(list(event='mouseover', query=list(seriesIndex=0),
handler=htmlwidgets::JS("function (event) {
this.dispatchAction({ type: 'highlight', geoIndex: 0, name: event.name }); }") ),
list(event='mouseout', query=list(seriesIndex=0),
handler=htmlwidgets::JS("function (event) {
this.dispatchAction({ type: 'downplay', geoIndex: 0, name: event.name }); }") )
)
p$x$opts <- list(
tooltip= list(zz= ""),
geo= list(left= 10, right= "50%", map= "organs", selectedMode= "multiple",
emphasis= list(focus= "self", itemStyle= list(color= NULL),
label= list(position= "bottom", distance= 0, textBorderColor= "#fff", textBorderWidth= 2)),
blur= list(zz= ""),
select= list(itemStyle= list(color= "#b50205"),
label= list(show= FALSE, textBorderColor= "#fff", textBorderWidth= 2))),
grid= list(left= "60%", top= "20%", bottom= "20%"),
xAxis= list(zz= ""),
yAxis= list(data= list("heart", "large-intestine", "small-intestine", "spleen", "kidney", "lung", "liver")),
series= list(list(type= "bar", emphasis= list(focus= "self"),
data= list(121, 321, 141, 52, 198, 289, 139))))
p
World map plugin
with geo points/lines in a timeline
🔻 View code
# inspired by data from https://github.com/etiennebacher
library(dplyr)
flights <- read.csv('https://raw.githubusercontent.com/plotly/datasets/master/2011_february_aa_flight_paths.csv')
# set first two columns to longitude/latitude as default for ECharts
df <- head(flights) |> relocate(start_lon,start_lat,end_lon) |>
group_by(airport1) |> group_split()
# timeline options are individual charts
options <- lapply(df, function(y) {
series <- list(
list(type='scatter', coordinateSystem='geo',
data= ec.data(y, 'values'), symbolSize= 8),
list(type='lines', coordinateSystem='geo',
data= lapply(ec.data(y, 'names'), function(x)
list(coords= list(c(x$start_lon, x$start_lat),
c(x$end_lon, x$end_lat)))
),
lineStyle= list(curveness=0.3, width=2, color='red') )
)
list(title=list(text=unique(y$airport1), top=30),
backgroundColor= '#191919',
geo= list(map="world", roam=TRUE, center=c(-97.0372, 32.89595), zoom=4),
series= series)
})
library(echarty)
p <- ec.init(preset=FALSE, load='world')
# timeline labels need to match option titles
p$x$opts$timeline <- list(data=unlist(lapply(options,
function(x) x$title$text)), axisType='category')
p$x$opts$options <- options
p
Leaflet maps
and switching chart selection without Shiny
Live Demo with code
World map
with live data, color coding filter, pan/zoom
Live Demo
3D Globe
Interactive 3D application with ECharts 3D Globe
Live Demo
🔻 Features
- real-time satellite data filtered by altitude
- charts: scatter3D for satellite location, bar3D for beams and lines3D for tracks
- controls: hover icons, timeline play/stop, animations toggle, zoom/rotate globe
- published as live demo
Quantiles
Overlay data and quantiles, then identify each with tooltips
🔻 View code
# data and inspiration from https://ptarroso.github.io/quantileplot/
set.seed(555)
counts <- 1:25
n <- 50 # original is 250
x <- rep(counts, each=n)
y <- rep(NA, length(x))
for (i in counts) {
mean.val <- log(i)+1
sdev.val <- runif(1, 0.2, 0.8)
y[x==i] <- round(rnorm(n, mean.val, sdev.val), 3)
}
q <- seq(0, 1, 0.025)
mat <- matrix(NA, length(q), length(counts))
for (i in 1:length(counts)) {
val <- counts[i]
mat[,i] <- quantile(y[x==val], probs=q)
}
mx <- as.integer(length(q)/2)
colors <- hcl.colors(mx, palette= 'sunset', alpha= 0.9)
dxy <- data.frame(x=x, y=y)
library(echarty)
p <- dxy |> ec.init(load='custom', preset=FALSE) |> ec.theme('dark') |> ec.snip()
p$xAxis <- p$yAxis <- list(show=TRUE)
p$tooltip <- list(formatter= '{a}', backgroundColor= '#55555599',
textStyle= list(color='#eee'))
p$title <- list(text= 'Data + Quantiles + Tooltips + Zoom', subtext= 'inspiration article',
sublink= 'https://ptarroso.github.io/quantileplot/')
# p$dataZoom <- list(type='inside', start=1)
p$toolbox=list(feature= list(dataZoom=list(show=TRUE), saveAsImage=list(show=TRUE)))
for (i in 1:mx) {
tmp <- data.frame(x= counts, hi= mat[i,], low= mat[length(q)+1-i,])
p$series <- append(p$series,
ecr.band(tmp, 'low', 'hi', name=paste0(round((1-q[i]*2)*100),'%'), color=colors[i])
)
}
p$series <- append(p$series,
list(list(type='scatter', symbolSize= 3, itemStyle= list(color='cyan'),
tooltip= list(formatter='{c}'))) )
p |> ec.snip()
Dendrogram
Vertical/Radial layouts, symbol size for height, values in tooltips
🔻 View code
# Hierarchical Clustering dendrogram charts
toolbox <- list(
right= '10%', top= 3, backgroundColor= 'beige',
feature= list(mySwitcher= list(
show= TRUE, title= 'switch',
icon= 'image://https://findicons.com/icon/download/direct/465124/toggle/32/png',
onclick= htmlwidgets::JS("function() { toggleOpt(); }"))
))
# JavaScript code for the switch button above
jscode <- "window.toggleOpt= function () {
opt= chart.getOption();
optcurr= opt.o2; // switch options
opt.o2= null;
optcurr.o2= opt;
chart.setOption(optcurr, true);
}"
hc <- hclust(dist(USArrests), "ave")
subt <- paste(as.character(hc$call)[2:3], collapse=' ')
library(echarty) # v.1.4.4+
p <- ec.init(preset=FALSE, js=jscode) |> ec.theme('dark-mushroom')
option1 <- list(
title= list(text= 'Radial Dendrogram', subtext= subt),
tooltip= list(show= TRUE),
toolbox= toolbox,
series= list(list(
type= 'tree', data= ec.data(hc, format='dendrogram'),
roam= TRUE, initialTreeDepth= -1, # initially show all
symbolSize= ec.clmn(-1, scale= 0.33),
# exclude added labels like 'p99', leaving only the originals
label= list(formatter= htmlwidgets::JS(
"function(n) { out= /p\\d+/.test(n.name) ? '' : n.name; return out;}")),
layout= 'radial',
tooltip= list(formatter= "h={c}"),
universalTransition= list(enabled= TRUE, delay= 600) # animation
))
)
option2 <- option1
option2$title <- list(text= 'Orthogonal Dendrogram', subtext= subt)
option2$series[[1]]$layout <- 'orthogonal'
option2$series[[1]]$orient <- 'TB'
option2$series[[1]]$leaves <- list(label= list(
position= 'middle', rotate= 90, verticalAlign= 'top', align= 'right' ))
option2$series[[1]]$label$offset <- c(-12,0)
p$x$opts <- option2
p$x$opts$o2 <- option1
p