library(dplyr)
test_that("ecr.ebars", {
# dset + groups
tmp <- iris |> group_by(Species) |>
ec.init(load= 'custom', ctype='bar', legend=list(show=T), yAxis=list(type='category'))
p <- tmp |> ecr.ebars(encode= list(x=c('Sepal.Width', 'Petal.Length', 'Petal.Width'), y='Sepal.Length'))
expect_equal(p$x$opts$series[[6]]$name, 'virginica')
expect_equal(p$x$opts$xAxis$name, 'Sepal.Length') # horiz.bars
p <- tmp |> ecr.ebars(encode= list(x=c(2,3,4), y=1)) # numeric encode
expect_equal(p$x$opts$series[[4]]$z, 3)
expect_match(p$x$opts$series[[4]]$tooltip$formatter, 'range', fixed=TRUE)
# dset + groups
df <- mtcars |> group_by(cyl,gear) |> summarise(yy= round(mean(mpg),2)) |>
mutate(low= round(yy-cyl*runif(1),2), high= round(yy+cyl*runif(1),2))
p <- ec.init(df, load='custom', ctype='bar', tooltip= list(s=T), xAxis=list(type='category')) |>
ecr.ebars(encode= list(y=c(3,4,5), x=2))
expect_equal(p$x$opts$series[[6]]$name, '8')
expect_match(p$x$opts$series[[6]]$tooltip$formatter, 'range', fixed=TRUE)
expect_equal(length(p$x$opts$series), 6)
expect_equal(p$x$opts$series[[4]]$type, 'custom')
expect_true(p$x$opts$series[[4]]$renderItem == 'riErrBars')
expect_s3_class(p$x$opts$series[[4]]$renderItem, 'JS_EVAL')
expect_equal(p$x$opts$xAxis$type, 'category')
# test for auto xAxis= list(type='category')
p <- Orange |> arrange(Tree) |> mutate( #Tree= paste0('D',Tree), # char
up= circumference+runif(5)*6,
lo= circumference-runif(5)*6 ) |> group_by(age) |>
ec.init(load='custom', ctype='bar', legend= list(show=T),
series.param= list(encode= list(x='Tree', y='circumference'))
) |> ecr.ebars(encode= list(x=1, y=c(3,4,5)))
expect_equal(p$x$opts$xAxis$type, 'category')
# data + name + char.encode
p <- ec.init(load= 'custom', legend= list(show=T), tooltip= list(show=T),
xAxis=list(type='category'),
series= list(list(type='bar', name= 'data',
encode= list(x='gear',y='yy'),
dimensions= c('cyl','gear','yy','low','high'),
data= ec.data(df |> filter(cyl==4))
))) |>
ecr.ebars(encode= list(x='gear', y=c('yy','low','high')), hwidth=12, name='err',
itemStyle= list(borderWidth= 2.5, color= "red")
)
expect_equal(p$x$opts$series[[2]]$encode$y, c(2,3,4))
expect_equal(p$x$opts$series[[2]]$itemStyle$borderDashOffset, 12)
# grouped + non-categorical
tmp <- round(rnorm(24, sin(1:24/2)*10, .5))
df <- data.frame(x = 1:24, val = tmp,
lower = round(rnorm(24, tmp -10, .5)),
upper = round(rnorm(24, tmp + 5, .8)),
cat= rep(c('A','B'),24) ) |> group_by(cat)
p <- ec.init(df, load='custom') |> ecr.ebars(encode= list(x=1, y=c(2,3,4)))
expect_equal(p$x$opts$series[[3]]$encode$y, c(1,2,3))
# make horizontal
p <- ec.init(df, load='custom', series.param= list(encode= list(y=1, x=2))) |>
ecr.ebars(encode= list(y=1, x=c(2,3,4))) #|> ec.inspect()
expect_equal(p$x$opts$series[[1]]$encode$y, 0)
expect_equal(p$x$opts$series[[3]]$encode$x, c(1,2,3))
# manual series + data
sers = list(
list(name= 's1',type= 'bar', data= list(5, 20, 36)),
list(name= 's2',type= 'bar', data= list(4, 2, 40)),
list(name= 's3',type= 'bar', data= list(15, 10, 36)),
list(name= 's2',type= 'custom', z=11, renderItem= htmlwidgets::JS('riErrBars'),
itemStyle= list(color= 'brown', borderDashOffset=8 ), # 8= halfWidth
encode= list(x=1,y=c(2,3,4)),
data= list(list('Mon',5,4,7), list('Tue',10, 9, 11))
)
)
p <- ec.init(load='custom', yAxis= list(show=T),
xAxis= list(data= list('Mon','Tue','Wed')),
series= sers
)
expect_equal(p$x$opts$series[[4]]$encode$y, c(1,2,3))
expect_s3_class(p$x$opts$series[[4]]$renderItem, 'JS_EVAL')
})
test_that("ecr.ebars riErrBarSimple", {
set.seed(222)
df <- data.frame(category= paste0('category', seq(1,50,1)),
avg= round(runif(50) * 1000, 2)) |>
mutate(lo= round(avg - runif(50) * 200), hi= round(avg + runif(50) * 180))
p <- df |> ec.init(load='custom',
xAxis= list(data= df$category),
tooltip= list(trigger= "axis", axisPointer= list(type= "shadow")),
legend= list(show=TRUE),
dataZoom= list(list(type= "slider", start= 50, end= 70),
list(type= "inside", start= 50, end= 70))
) |> ec.upd({
series <- append(series, list(
list(
type= "custom", name= "error",
itemStyle = list(borderWidth= 1.5, color= 'brown'),
# encode() does not work ?!
# get data from dataset$source in format 'x,lo,hi'
data= ec.data(as.data.frame(do.call(rbind, dataset[[1]]$source[-1]))[,c(1,3,4)]),
renderItem = htmlwidgets::JS("riErrBarSimple")
) ))
})
expect_equal(p$x$opts$series[[2]]$type, 'custom')
expect_true( p$x$opts$series[[2]]$name == "error")
expect_s3_class(p$x$opts$series[[2]]$renderItem, 'JS_EVAL')
expect_equal(length(p$x$opts$series[[2]]$data), 50)
})
test_that("ecr.band", {
df <- Orange |> mutate(Tree=as.numeric(Tree)) |> relocate(Tree, .after= last_col())
band <- ecr.band(df |> filter(Tree==4) |> inner_join(df |> filter(Tree=='1'), by='age'),
'circumference.y',
'circumference.x',
type= 'polygon', name= 'poly1')
p <- ec.init(load='custom',
legend= list(s=T), tooltip= list(trigger='axis'),
dataZoom= list(type='inside', filterMode='none'),
series= list( band[[1]],
list(type='line', data=ec.data(df |> filter(Tree==5)),
color='orange', name='line1', clip=F)
)
)
expect_equal(length(p$x$opts$series), 2)
expect_equal(p$x$opts$series[[1]]$type, 'custom')
expect_equal(p$x$opts$series[[1]]$name, 'poly1')
expect_true( p$x$opts$series[[1]]$renderItem == "riPolygon")
expect_s3_class(p$x$opts$series[[1]]$renderItem, 'JS_EVAL')
})
test_that("ecr.band tooltips", {
df <- airquality |> mutate(lwr= round(Temp-Wind*2),
upr= round(Temp+Wind*2),
x= paste0(Month,'-',Day) ) |>
relocate(x,Temp)
bands <- ecr.band(df, 'lwr', 'upr', type='stack',
name='Band', areaStyle= list(opacity=0.4))
p <- df |> ec.init(load='custom',
legend= list(show= TRUE),
xAxis= list(type='category', boundaryGap=FALSE),
series= list(
list(type='line', color='blue', name='line'),
bands[[1]], bands[[2]]
),
tooltip= list( trigger= 'axis',
formatter= ec.clmn(
'high %@
line %@
low %@',
3.3, 1.2, 2.2)
) # 3.3= upper_serie_index +.+ index_of_column_inside
)
expect_equal(p$x$opts$series[[2]]$stack, 'Band')
expect_match(p$x$opts$tooltip$formatter, 'ss=[2.3,0.2,1.2]', fixed=TRUE)
})
test_that("leaflet with geoJson", {
myGeojson= gsub('\n', '', '{
"type": "FeatureCollection",
"features": [
{
"type": "Feature",
"properties": {
"color": "purple"
},
"geometry": {
"type": "MultiPolygon",
"coordinates": [
[
[-110.81391, 31.931967 ],
[-111.8391, 31.931931 ],
[-111.838888, 32.931931 ],
[-110.813849, 32.9319 ]
],
[
[-110.81391, 33.93196 ],
[-111.8391, 33.93193 ],
[-111.83888, 34.93193 ],
[-110.81384, 34.9319 ]
]
]
}
},
{
"type": "Feature",
"properties": {
"color": "green"
},
"geometry": {
"type": "LineString",
"coordinates":
[
[-115.81391, 31.93196 ],
[-116.8391, 31.93193 ],
[-116.83888, 32.93193 ],
[-115.81384, 32.9319 ]
]
}
},
{
"type": "Feature",
"properties": {
"color": "black"
},
"geometry": {
"type": "MultiLineString",
"coordinates": [
[ [-115.8139, 34.93196 ],
[-116.8391, 34.93193 ],
[-116.8388, 35.93193 ],
[-115.8138, 35.9319 ] ],
[ [-117.8138, 34.9319 ],
[-117.8139, 32.93186 ],
[-118.8139, 32.93196 ] ]
]
}
},
{
"type": "Feature",
"geometry": {
"type": "Point",
"coordinates": [-116, 33.66]
},
"properties": {
"color": "green"
}
},
{
"type": "Feature",
"geometry": {
"type": "MultiPoint",
"coordinates": [ [-119.0, 35.99], [-120.0, 36.66] ]
},
"properties": {
"color": "blue"
}
}
]}')
p <- ec.init(load= c('leaflet','custom'),
leaflet= list(center= c(-116.35, 35.5), zoom= 5, roam= T),
series= list(
ec.util(cmd= 'geojson',
geojson= jsonlite::fromJSON(myGeojson),
itemStyle= list(opacity= 0.5),
ppfill= NULL ) # =no polygon fill
)
)
expect_equal(p$x$opts$leaflet$zoom, 5)
expect_equal(p$x$opts$series[[1]]$type, 'custom')
expect_s3_class(p$x$opts$series[[1]]$renderItem, 'JS_EVAL')
expect_match(p$x$opts$series[[1]]$renderItem,"ecf.geofill=null", fixed=T)
expect_equal(length(p$x$opts$series[[1]]$data), 5)
expect_equal(p$x$opts$series[[1]]$data[[5]][[1]], 5)
# tmp <- jsonlite::fromJSON('https://echarts.apache.org/examples/data/asset/geo/USA.json')
# p <- ec.init(load= c('leaflet', 'custom'),
# leaflet= list(
# center= c(-111, 35.5), zoom= 4, roam= T),
# tooltip= list(show=T),
# series= list(
# ec.util(cmd= 'geojson', geojson= tmp, colorBy= 'data', nid='name',
# itemStyle= list(opacity= 0.5) )
# )
# )
# p
})