R | ECharts | boxplot + scatter overlay with vertical layout

pumpkins.boxplot.R

#' inspired by https://juliasilge.com/blog/giant-pumpkins/
#' advantage over ggplot is interactivity - zoom brush and tooltips
#' horizontal layout code at https://helgasoft.github.io/echarty/gallery.html#boxplot

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 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=paste(nrow(pumpkins),'records for 2013-2021')) 
)
p$yAxis <- list(name='weigth (lbs)', min=0, 
	nameLocation='center', nameGap=38)
p$xAxis <- list(
	list(type= 'category', axisLabel= list(rotate=45)),
	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)
	xx <- jitter(xx, amount=0.2)
	i <<- i + 1
	data <- list()
	for(j in 1:length(xx)) data <- append(data, list(list(yy[j], xx[j])))
	list(name='data', type= 'scatter', data=data, xAxisIndex=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=htmlwidgets::JS("function(c) { return (c.value[1].toFixed()+' lbs');}"))
p$toolbox <- list(left='right', feature=list(dataZoom=list(show=TRUE)))
ec.snip(p)

The original horizontal layout is rewritten here as vertical. Also an answer to @varunrd.