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
df |> ec.init(ctype= 'bar') |> ec.theme('dark')
# without presets all options are explicitly assigned
ec.init(preset= FALSE,
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')))
) |> ec.theme('dark')
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()
ec.init(preset= FALSE,
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')
) |> ec.upd({
l <- length(series)
series[[l]]$name <- paste(series[[l]]$name, ' trees')
}) |> ec.theme('dark')
Easy as pie
🔻 View code
library(echarty); library(dplyr)
isl <- data.frame(name= names(islands), value= islands) |> filter(value>60) |> arrange(value)
ec.init(preset= FALSE,
title= list(text= "Landmasses over 60,000 mi\u00B2", left= 'center'),
tooltip= list(show= TRUE),
series= list(list(type= 'pie', data= ec.data(isl, 'names'))),
backgroundColor= '#191919'
)
Parallel chart
🔻 View code
library(echarty); library(dplyr)
iris |> group_by(Species) |>
ec.init(ctype='parallel', color= rainbow(10)) |>
ec.upd({ # update preset series
series <- lapply(series, function(s) {
s$smooth <- TRUE
s$lineStyle <- list(width=3)
s })
}) |> ec.theme('dark-mushroom')
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
};
}"
ec.init(
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 ))
) |> ec.theme('dark-mushroom') # only 2 commands used
Error Bars
🔻 View code
# example by https://github.com/kuzmenkov111
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,')')) |>
relocate(xlbl,perc) |> # move in front as default X & Y columns
group_by(Category) # both ec.init & ecr.ebars need grouped data
groupColors <- c("#387e78","#eeb422","#d9534f")
# --- 2. plot
stackbar |> ec.init(ctype='bar', load='custom') |>
# only columns x,y,low,high,category for ebars
ecr.ebars(stackbar[, c('xlbl','perc','low','up','Category')],
hwidth= 4) |> # (optional) half-width of err.bar in pixels
# --- 3. color customization
ec.theme('dark-mushroom') |>
ec.upd({
series <- lapply(series, function(s, i) {
if (s$type=='bar') {
s$color <- groupColors[parent.frame()$i[]] # iteration hack
}
else if (s$type=='custom')
s$itemStyle$color <- 'cyan'
s
})
})
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
Crosstalk with leaflet
two-way selection between map and chart
🔻 View code
library(crosstalk)
sdf <- quakes[1:33,] |> SharedData$new(group= 'qk')
library(leaflet)
map <- leaflet(sdf) |> addTiles() |> addMarkers()
library(echarty)
p <- sdf |> ec.init(
title= list(text= 'Crosstalk two-way selection'),
toolbox= list(feature= list(brush= list(show=TRUE))),
brush= list(brushLink='all', throttleType='debounce',
brushStyle= list(borderColor= 'red')),
tooltip= list(show=TRUE),
xAxis= list(scale=TRUE, boundaryGap= c('5%', '5%'))
) |>
ec.upd({
series[[1]] <- append(series[[1]], list(
encode= list(x='mag', y='depth', tooltip=list(2,3)),
selectedMode= 'multiple',
emphasis= list(
itemStyle= list(borderColor='yellow', borderWidth=2),
focus= 'self',
blurScope='series'
),
blur= list(itemStyle= list(opacity = 0.4)) # when focus set
))
}) |> ec.theme('dark-mushroom')
library(htmltools)
browsable(tagList(
div(style="float:left;width:50%;", map),
div(style="float:right;width:50%;",p)
))
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)
ec.init(load= '3D', preset= FALSE,
title= list(text=paste('scatterGL -',nrow(dat),'points + zoom')),
xAxis= list(show=TRUE),
yAxis= list(show=TRUE),
series= list(list(type= 'scatterGL', data= ec.data(dat),
symbolSize= 3, large=TRUE,
itemStyle= list(opacity=0.4, color='cyan')
)),
dataZoom= list(type='inside',start=50)
) |> ec.theme('dark-mushroom')
scatter3D
plugin 3D, test with 36,000 points
🔻 View code
library(onion); library(echarty)
data(bunny)
tmp <- as.data.frame(bunny)
tmp |> ec.init(load= '3D',
visualMap= list(
inRange= list(color= rainbow(10)), calculable= TRUE,
min= min(tmp$y), max= max(tmp$y), dimension= 1)) |>
ec.upd({ series[[1]]$symbolSize <- 2 }) |>
ec.theme('dark-mushroom')
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)
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)
)
),
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)) ),
grid3D= list(axisLabel= list(textStyle= list(color='#ddd'))),
xAxis3D= list(name= 'Income', min= 15, axisLabel= list(formatter= "${value}"),
nameTextStyle= list(color= '#ddd'), nameGap= 25),
yAxis3D= list(name= 'Life Expectancy', min= 15,
nameTextStyle= list(color= '#ddd')),
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;}"))
),
visualMap= list(show= FALSE, dimension= 'Country', type= 'piecewise', pieces= pieces),
tooltip= list(show= TRUE)
) |> ec.upd({
timeline <- append(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)
))
}) |>
ec.theme('dark-mushroom')
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)
data |> ec.init(preset= FALSE,
radar= list(
indicator= ec.data(data, 'names'),
name= list(
formatter= htmlwidgets::JS("v => '{'+v+'| }'"),
rich= rifo)
),
series= list(list(
type= 'radar', data= list(data$values)
))
) |> ec.theme('dark-mushroom')
Simple or grouped boxplots
boxplot calculations in R or ECharts
🔻 View code
library(echarty); library(dplyr)
# 1) boxplot calculation in R ---------------------
ec.init(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))
),
xAxis= list(type= 'category'),
legend= list(show=TRUE)
)
# 2) boxplot calculation in ECharts ---------------------
df <- mtcars[,c(1,3,4)] |> mutate(mpg= mpg*10)
ec.init(
dataset= list(
list(source= ec.data(data.frame(t(df)), header=FALSE)),
list(transform= list(type='boxplot')),
list(fromDatasetIndex=1, fromTransformResult= 1)),
series= list(
list(name= 'boxplot', type= 'boxplot', datasetIndex= 1),
list(name= 'outlier', type= 'scatter', encode= list(x=1, y=0), datasetIndex= 2)
),
yAxis= list(type= 'category', boundaryGap=TRUE),
legend= list(show=TRUE)
)
# 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')
ec.init(
dataset= ds$dataset,
series= ds$series,
yAxis= list(type= 'category'),
xAxis= list(show= TRUE),
legend= list(show= TRUE)
)
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)
ec.init(
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%' )
),
xAxis= list(name='weigth (lbs)', min=0,
nameLocation='center', nameGap=20),
yAxis= list(
list(type= 'category'),
list(type= 'value', max=11, show=FALSE)),
dataset= list(
list(source= tt),
list(transform= list(type='boxplot',
config=list(itemNameFormatter= htmlwidgets::JS(yax))
)),
list(fromDatasetIndex= 1, fromTransformResult= 1)
),
series= list( # use ECharts built-in boxplot
list(name= 'boxplot', type= 'boxplot', datasetIndex= 1
,color='LightGrey', itemStyle= list(color='DimGray'),
boxWidth=c(13,50) )
),
legend= list(show=TRUE),
tooltip= list(show=TRUE,
backgroundColor= 'rgba(30,30,30,0.5)',
textStyle= list(color='#eee'),
formatter=ec.clmn('%@ lbs', 1, scale=0)),
toolbox= list(left='right', feature=list(dataZoom=list(show=TRUE)))
) |> ec.upd({
i <- 0.5
sers <- lapply(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)) )
})
series <- append(series, sers)
}) |> ec.theme('dark-mushroom')
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)
df |> relocate(Var2) |> ec.init(ctype='heatmap',
title= list(text='Infertility after abortion correlation'),
xAxis= list(axisLabel= list(rotate=45)),
visualMap= list(min=-1, max=1, orient='vertical',left='right',
calculable=TRUE, inRange=list( color=heat.colors(11)) )
) |> ec.theme('dark')
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
}
do.histogram(rnorm(44)) |> ec.init(ctype='bar') |> ec.theme('dark')
# with normal distribution line added
hh <- do.histogram(rnorm(44))
nrm <- dnorm(hh$x, mean=mean(hh$x), sd=sd(hh$x)) # normal distribution
hh |> ec.init(ctype= 'bar',
xAxis= list(list(show= TRUE), list(data= c(1:length(nrm)))),
yAxis= list(list(show= TRUE), list(show= TRUE))
) |> ec.upd({
series <- append(series,
list(list(type= 'line', data= nrm,
xAxisIndex= 1, yAxisIndex= 1, color= 'yellow')))
}) |> ec.theme('dark')
# 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)
}
hh |> group_by(time) |>
ec.init(tl.series= list(type= 'bar', encode= list(x='x',y='y'))) |>
ec.theme('dark')
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)
ec.init(load='gmodular', preset=FALSE,
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'))
)
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)
ec.init(preset=FALSE,
title=list(text='Les Miserables',top='bottom',left='right'),
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)
)),
legend= list(data=c(les$categories$name), textStyle=list(color='#ccc')),
tooltip= list(show=TRUE),
backgroundColor= '#191919'
) |> ec.upd({ # labels only for most important
series[[1]]$nodes <- lapply(series[[1]]$nodes, function(n) {
n$label <- list(show= n$symbolSize > 30)
n })
})
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,
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)))
) |> 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
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)
ec.init(preset=FALSE, load='world',
# timeline labels need to match option titles
timeline= list(
data= unlist(lapply(options, function(x) x$title$text)),
axisType= 'category'),
options= options
)
Leaflet maps
and switching chart selection without Shiny
Live Demo with code
Leaflet maps with shape files
demo for GIS polylines, points and polygons
🔻 View code
library(echarty) # v.1.4.6+
library(dplyr)
library(sf)
library(spData) # https://jakubnowosad.com/spData/
xy2df <- function(val) {
len2 <- length(unlist(val)) /2
as.array(matrix(unlist(val), len2, 2))
}
# ----- MULTILINESTRING -----
nc <- as.data.frame( st_transform(seine, crs=4326))
# build animation effect series
sd <- list()
for(i in 1:nrow(nc)) {
sd <- append(sd, list(
list(type= 'lines', coordinateSystem= 'leaflet', polyline= TRUE,
name= nc$name[i], lineStyle= list(width=0), color= 'blue',
effect= list(show= TRUE, constantSpeed= 80, trailLength= 0.1, symbolSize= 3),
data= list(list(coords= xy2df(nc$geometry[i]))
))))
}
ec.init(load= c('leaflet'),
js= ec.util(cmd= 'sf.bbox', bbox= st_bbox(nc$geometry)),
series= ec.util(df= nc, nid= 'name', lineStyle= list(width= 4), verbose=TRUE),
tooltip= list(formatter= '{a}'), legend= list(show= TRUE),
color=c('red','purple','green')
) |>
ec.upd({ series <- append(series, sd) })
# ----- MULTIPOINT -----
nc <- as.data.frame(urban_agglomerations) |> filter(year==2020) |>
rename(NAME= urban_agglomeration) |>
select(NAME, country_or_area, population_millions, geometry) |>
rowwise() |> # set population as Z
mutate(geometry= st_sfc(st_point(c(unlist(geometry), population_millions))) )
ec.init(load= c('leaflet'),
js= ec.util(cmd= 'sf.bbox', bbox= st_bbox(nc$geometry)),
series= ec.util(df= nc, name= 'Largest Cities', itemStyle= list(color= 'red')
,symbolSize= ec.clmn(3, scale=0.5) # urban_agglomerations
),
tooltip= list(formatter= '{a}'), legend= list(show= TRUE), animation= FALSE
)
# ----- MULTIPOLYGON -----
nc <- as.data.frame(st_transform(nz, crs=4326)) |> rename(geometry= geom)
attr(nc, 'sf_column') <- 'geometry'
ec.init(load= c('leaflet', 'custom'), # load custom for polygons
js= ec.util(cmd= 'sf.bbox', bbox= st_bbox(nc$geometry)),
series= ec.util(df= nc, nid= 'Name', itemStyle= list(opacity= 0.3)),
tooltip= list(formatter= '{a}'), animation= FALSE
)
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)
series <- list()
for (i in 1:mx) {
tmp <- data.frame(x= counts, hi= mat[i,], low= mat[length(q)+1-i,])
series <- append(series,
ecr.band(tmp, 'low', 'hi', name=paste0(round((1-q[i]*2)*100),'%'), color=colors[i])
)
}
series <- append(series,
list(list(type='scatter', symbolSize= 3, itemStyle= list(color='cyan'),
tooltip= list(formatter='{c}'))) )
library(echarty)
dxy |> ec.init(load='custom', preset=FALSE,
xAxis= list(show=TRUE), yAxis= list(show=TRUE),
tooltip= list(formatter= '{a}', backgroundColor= '#55555599',
textStyle= list(color='#eee')),
title= list(text= 'Data + Quantiles + Tooltips + Zoom', subtext= 'inspiration article',
sublink= 'https://ptarroso.github.io/quantileplot/'),
toolbox= list(feature= list(dataZoom=list(show=TRUE), saveAsImage=list(show=TRUE))),
series= series
) |> ec.theme('dark')
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 <- within(option1, {
title <- list(text= 'Orthogonal Dendrogram', subtext= subt)
series[[1]]$layout <- 'orthogonal'
series[[1]]$orient <- 'TB'
series[[1]]$leaves <- list(label= list(
position= 'middle', rotate= 90, verticalAlign= 'top', align= 'right' ))
series[[1]]$label$offset <- c(-12,0)
})
p$x$opts <- option2
p$x$opts$o2 <- option1
p
Lotties are lotta fun
Add animations to charts
🔻 View code
# data from https://lottiefiles.com
# plugin by https://github.com/pissang/lottie-parser
json <- 'https://helgasoft.github.io/echarty/js/spooky-ghost.json'
cont <- jsonlite::fromJSON(json, simplifyDataFrame=FALSE)
# remotes::install_github('helgasoft/echarty')
library(echarty) # v.1.4.6.04+
iris |> group_by(Species) |> ec.init(
load= 'https://helgasoft.github.io/echarty/js/lottie-parser.js',
graphic= list(elements= list(
list( type= "group",
# lottie params: info + optional scale and loop
info= cont, scale= 250, # loop= FALSE,
left= 'center', top= 'middle' # ,rotation= -20
),
list( type= "image", left= 20, top= 'top',
style= list(
image= 'https://www.r-project.org/logo/Rlogo.png',
width= 150, height= 150, opacity= .4)
)
))
)
Tabset
Multiple charts in their own tabs
🔻 View code
# remotes::install_github('helgasoft/echarty')
library(echarty) # v.1.4.7+
library(dplyr)
htmltools::browsable(
lapply(iris |> group_by(Species) |> group_split(), function(x) {
x |> ec.init(ctype= 'scatter',
yAxis= list(scale=TRUE), title= list(text= unique(x$Species))) |>
ec.theme('dark-mushroom')
}) |>
ec.util(cmd= 'tabset')
)
p1 <- cars |> ec.init(grid= list(top= 20))
p2 <- mtcars |> ec.init()
htmltools::browsable(
ec.util(cmd= 'tabset', cars= p1, mtcars= p2, width= 200, height= 200)
)