# expect_silent()
test_that("registerMap", {
# similar in ec.examples, with USA map
gjson <- jsonlite::parse_json('{"type":"FeatureCollection", "properties":{"id":"all3"},
"features":[
{"type":"Feature", "geometry":{"type":"MultiPolygon", "coordinates":[[[[2.330466,48.862223],[2.330305,48.861636],[2.329572,48.861581],[2.329466,48.861531],[2.329413,48.861528],[2.328796,48.861475],[2.328545,48.861396],[2.328466,48.861404],[2.328361,48.86137]]]]},
"properties":{"lat":48.859475,"lon":2.329466,"name":"bic1","range":500, "id":"0.5 min", "ppfill": "#00FF0077"} },
{"type":"Feature", "geometry":{"type":"MultiPolygon", "coordinates":[[[[2.333466,48.866204],[2.333061,48.86588],[2.332897,48.865906],[2.332466,48.865801],[2.332165,48.865776],[2.331811,48.865475],[2.331621,48.86532],[2.331466,48.865265],[2.331274,48.865283]]]]},
"properties":{"lat":48.859475,"lon":2.329466,"name":"bic2","range":1000, "id":"1 min"} },
{"type":"Feature", "geometry":{"type":"MultiPolygon", "coordinates":[[[[2.335466,48.869736],[2.335037,48.870046],[2.334836,48.870105],[2.334466,48.870265],[2.334289,48.870298],[2.333577,48.870364],[2.333466,48.870381],[2.333364,48.870373],[2.332485,48.870456]]]]},
"properties": {"lat":48.859475,"lon":2.329466,"name":"bic3","range":1500, "id":"1.5 min"} }
]}')
ext <- function(dd) { unlist(unname(sapply(gjson$features, \(f) {f$properties[dd]}))) }
#vals <- ext('range')
dparis <- data.frame(name= ext('name'), value= ext('range'))
p <- ec.init(preset= FALSE,
geo= list(map= 'paris', roam= TRUE),
series =list(list(
type= 'map', geoIndex=1,
data= ec.data(dparis, 'names')
)),
visualMap= list(type='continuous', calculable=TRUE,
inRange= list(color = rainbow(8)) )
#,min= min(vals), max= max(vals))
)
p$x$registerMap <- list(list(mapName= 'paris', geoJSON= gjson))
p
expect_equal(length(p$x$registerMap[[1]]$geoJSON), 3)
expect_equal(p$x$opts$geo$map, 'paris')
expect_equal(p$x$opts$series[[1]]$data[[2]]$value, 1000)
})
test_that("tl.series, timeline options, groupBy", { # also in test-presets
p <- Orange |> dplyr::group_by(age) |> ec.init(
timeline= list(autoPlay=TRUE),
series.param= list(type='bar', encode=list(x='Tree', y='circumference'))
) |> ec.upd({
options <- lapply(seq_along(options),
\(i) {
options[[i]]$title$text <- paste('age',timeline$data[[i]],'days');
options[[i]] })
})
expect_equal(p$x$opts$options[[5]]$title$text, "age 1231 days")
expect_equal(p$x$opts$options[[5]]$series[[1]]$datasetIndex, 5)
expect_equal(p$x$opts$options[[7]]$series[[1]]$encode$x, "Tree")
expect_equal(p$x$opts$timeline$data[[5]], "1231")
expect_true(p$x$opts$dataset[[5]]$transform$config['='] == 1004)
set.seed(2022)
dat <- data.frame(
x1 = rep(2020:2023, each = 4),
x2 = rep(c("A", "A", "B", "B"), 4),
x3 = runif(16), x4 = runif(16), x5 = abs(runif(16))
)
p <- dat |> group_by(x1) |> ec.init(
tl.series= list(encode= list(x= 'x3', y= 'x5'), groupBy='x2',
symbolSize= ec.clmn(4, scale=30)),
legend= list(s=T)
)
expect_equal(p$x$opts$options[[4]]$series[[2]]$name, 'B')
expect_true(p$x$opts$dataset[[9]]$transform$config$and[[2]]$dimension=='x2')
})
test_that("leaflet with ec.clmn and timeline", {
tmp <- quakes |> dplyr::relocate('long') |> # set order to lon,lat
dplyr::mutate(size= exp(mag)/20) |> head(100) # add accented size
p <- tmp |> ec.init(load= 'leaflet',
tooltip = list(formatter=ec.clmn('magnitude %@', 'mag')),
series.param= list(
symbolSize = ec.clmn(6, scale=2)
)
# timeline= list(autoPlay=TRUE, controlStyle= list(borderColor='brown')),
)
expect_equal(p$x$opts$leaflet$zoom, 6)
expect_s3_class(p$x$opts$tooltip$formatter, 'JS_EVAL')
p <- tmp |> group_by(stations) |> ec.init(load='leaflet',
tooltip = list(formatter=ec.clmn('magnitude %@', 'mag')),
leaflet= list(center= c(179.462,-20), zoom= 2,
tiles= list(
list(
label= 'Stamen',
urlTemplate= 'https://stamen-tiles-{s}.a.ssl.fastly.net/terrain/{z}/{x}/{y}{r}.{ext}',
options= list(attribution= 'Map tiles by Stamen Design, CC BY 3.0',
subdomains= 'abcd', maxZoom= 18, ext= 'png')
)
)
),
timeline= list(autoPlay=TRUE, controlStyle= list(borderColor='brown')),
options= list(legend= list(show=T)),
tl.series= list(
type='scatter', name='quake',
symbolSize = ec.clmn(6, scale=2),
encode= list(lng='long', lat='lat', tooltip=c(4,5))
),
visualMap= list(
show= FALSE, top= 'top', dimension=4,
calculable= TRUE, inRange= list(color= c('blue','red'))
)
)
expect_equal(p$x$opts$leaflet$zoom, 2)
expect_s3_class(p$x$opts$tooltip$formatter, 'JS_EVAL')
#expect_equal(p$dependencies[[9]]$name, 'echarts-leaflet') # loads slow?
#expect_equal(p$x$opts$options[[10]]$title$text, '19')
expect_equal(p$x$opts$options[[10]]$series[[1]]$name, 'quake')
expect_true (p$x$opts$options[[10]]$legend$show)
expect_equal(p$x$opts$options[[41]]$series[[1]]$coordinateSystem, 'leaflet')
expect_equal(p$x$opts$timeline$data[[10]], '19')
expect_equal(p$x$opts$dataset[[2]]$transform$config$`=`, 10)
})
test_that("ec.upd(), echarts.registerTransform and ecStat", {
dset <- data.frame(x=1:10, y=sample(1:100,10))
p <- dset |> ec.init(js= 'echarts.registerTransform(ecStat.transform.regression)'
) |> ec.upd({
dataset[[2]] <- list(transform = list(type='ecStat:regression'))
series[[2]] <- list(
type='line', itemStyle=list(color='red'), datasetIndex=1)
})
expect_equal(p$x$jcode, 'echarts.registerTransform(ecStat.transform.regression)')
expect_equal(p$x$opts$dataset[[2]]$transform$type, "ecStat:regression")
})
test_that("ec.data treeTK", {
df <- as.data.frame(Titanic) |>
group_by(Survived,Age,Sex,Class) |>
summarise(value= sum(Freq), .groups= 'drop') |>
rowwise() |>
mutate(pathString= paste('Survive', Survived, Age, Sex, Class, sep='/'),
itemStyle= case_when(Survived=='Yes' ~ "color='green'", TRUE ~ "color='pink'")) |>
select(pathString, value, itemStyle)
dat <- ec.data(df, format='treeTK')
dat[[1]] <- within(dat[[1]], { itemStyle <- list(color= 'white'); pct <- 0 })
p <- ec.init(preset= FALSE,
title= list(text= 'Titanic: Survival by Class'),
tooltip= list(formatter= ec.clmn('%@%','pct')),
series= list(list(
type= 'sunburst', radius= c(0, '90%'), label= list(rotate=0),
# type= 'tree', symbolSize= ec.clmn(scale=0.08),
# type= 'treemap', upperLabel= list(show=TRUE, height=30), itemStyle= list(borderColor= '#999'), #leafDepth=4,
data= dat,
emphasis= list(focus='none')
))
)
expect_equal(p$x$opts$series[[1]]$data[[1]]$value, 2201)
expect_equal(length(p$x$opts$series[[1]]$data[[1]]$children), 2)
expect_equal(p$x$opts$series[[1]]$data[[1]]$children[[2]]$pct, 32.3)
})
test_that("load 3D surface", {
#if (interactive()) { # first time will load echarts-gl.js in source folder 'js'
data <- list()
for(y in 1:dim(volcano)[2]) for(x in 1:dim(volcano)[1])
data <- append(data, list(c(x, y, volcano[x,y])))
p <- ec.init(load= '3D', series= list(list(type= 'surface', data= data)) )
expect_equal(length(p$x$opts$series[[1]]$data), 5307)
})
test_that("3D globe", {
p <- ec.init(load='3D',
globe= list(viewControl= list(autoRotate= FALSE)),
series= list(
list(type= 'scatter3D',
data= list(c(32,-117,11), c(2,44,22)) ,
symbolSize= 40, itemStyle= list(color= 'red')
))
)
expect_equal(p$x$opts$series[[1]]$coordinateSystem, 'globe')
})
test_that("calendar", {
df <- data.frame(d= seq(as.Date("2023-01-01"), by="day", length.out=360), v=runif(360,1,100))
p <- df |> ec.init(
visualMap= list(show= FALSE, min= 0, max= 100),
calendar = list(range= c('2023-01','2023-04')),
series = list(list(type = 'scatter'))
)
expect_equal(p$x$opts$series[[1]]$coordinateSystem, "calendar")
})
test_that("ec.plugjs", {
p <- ec.init() |> ec.plugjs(
'https://raw.githubusercontent.com/apache/echarts/master/test/data/map/js/china-contour.js')
expect_equal(p$dependencies[[1]]$name, "china-contour.js")
})
test_that("Shiny commands", {
# coveralls.io and codecov cannot run tests on Shiny code, here is a workaround
# ui <- fluidPage(column(width= 12, ecs.output('sash')), actionButton('adds', 'Upd') )
# tmp <- ui[[4]][[1]]$children[[1]]$children[[1]][[1]]$attribs
# expect_equal(tmp$id, 'sash')
# expect_match(tmp$class, '^echarty ')
tmp <- attributes(ecs.output('sash'))
p <- sapply(tmp$html_dependencies, c)
expect_equal(unlist(p[1,]), c("htmlwidgets","echarty","echarty-binding"))
tmp <- ecs.render({ p <- cars |> ec.init() })
expect_match(as.character(attributes(tmp)$cacheHint$origUserFunc$body[2]), "p <- ec\\.init\\(cars\\)")
p <- ecs.proxy('sash')
expect_equal(p$id, 'sash')
expect_equal(attributes(p)$class, 'ecsProxy')
# works in interactive only (+Shiny session), else "attempt to apply non-function"
#sendCustomMessage <- \(name,plist) {a <- 1}
p$session <- NULL # disable p$session$sendCustomMessage
p$x$opts$test <- 'sankey'
tmp <- ecs.exec(p)
expect_equal(tmp$x$opts$test, 'sankey')
})
test_that(".merlis", {
aa = list(list(type= "map", geoIndex= 0))
p <- echarty:::.merlis(aa, list(val= 13))
expect_equal(p[[1]]$val, 13)
p <- echarty:::.merlis(aa[[1]], list(val= 13))
expect_equal(p$val, 13)
aa = list(x= list(type= "1st.is.named.list"), geoIndex= 0)
p <- echarty:::.merlis(aa, list(val= 13))
expect_equal(p$val, 13)
})
test_that('autoset axis type', {
df <- data.frame(
time = seq(from = as.POSIXct("2021-01-01 08:00:00"), to = as.POSIXct("2021-01-01 09:10:00"), by = "1 min"),
y = rnorm(71, mean = 100)
)
p <- df |> ec.init(yAxis= list(scale=T))
expect_equal(p$x$opts$xAxis$type, 'time')
expect_equal(p$x$opts$yAxis$type, 'value')
})
test_that('stops are working in echarty.R', {
df <- data.frame(x = 1:10, y = seq(1, 20, by=2))
expect_error(ec.init(0)) # df
expect_error(ec.init(cars, tl.series= list(d=1))) # groups
expect_silent(ec.init(mtcars |> group_by(gear), tl.series= list(type='map'))) # no name/value, can use encode
expect_silent(ec.init(df |> group_by(y), series.param= list(type='bar')))
expect_silent(ec.init(df |> group_by(y), series.param= list(type='bar'),
timeline= list(s=T)))
# expect_error(cars |> group_by(speed) |> ec.init()) # 3 cols min
# expect_error(ec.init(data.frame(name='n',value=1) |> group_by(name),
# tl.series= list(type='bar'))) # 3 cols min
# expect_silent(ec.init(data.frame(name='n',value=1) |> group_by(name),
# tl.series= list(type='map'))) # 2 cols exception for map
expect_error(ec.init(mtcars |> group_by(gear), tl.series= list(encode= list(x=1, y=2),groupBy='zzz'))) # groupBy
expect_error(ecr.band(cars))
tmp <- cars; tmp <- tmp |> rename(lower=speed, upper=dist)
expect_error(ecr.band(tmp, lower='lower', upper='upper')) # no first col
tmp <- ToothGrowth; tmp <- tmp |> rename(lower=len, upper=supp) #dose=numeric
expect_error(ecr.band(tmp, lower='lower', upper='upper', test='num')) # numeric
expect_error(ecr.ebars())
expect_error(ecr.ebars(1))
expect_error(ecr.ebars(ec.init(), 1))
expect_error(ecr.ebars(ec.init(), cars))
expect_silent(ecr.ebars(ec.init(load='custom'), cars, encode=list(x=1,y=c(2,3,4))))
expect_silent(ec.init(load='lottie'))
expect_silent(ec.init(load='ecStat'))
#expect_silent(ec.init(load='liquid')) # Debian throws warnings in CRAN check
#expect_silent(ec.init(load='gmodular'))
#expect_silent(ec.init(load='wordcloud'))
})