1+
2+ test_that(" serie from ec.util with cartesian3D"
3+ # usage for LIDAR data
4+ library(sf )
5+ tmp <- st_as_sf(data.frame (x = c(- 70 ,- 70 ,- 70 ), y = c(45 , 46 , 47 ), z = c(1 ,2 ,3 )),
6+ coords = c(' x' ' y' ' z' crs = st_crs(4326 ))
7+ p <- ec.init(load = c(' 3D'
8+ series = ec.util(df = tmp ,
9+ coordinateSystem = ' cartesian3D' type = ' scatter3D'
10+ # ,tooltip= list(formatter= '{b}')
11+ )
12+ expect_equal(p $ x $ opts $ series [[1 ]]$ data [[2 ]][[2 ]], 46 )
13+ expect_type( p $ x $ opts $ xAxis3D [[1 ]],' list'
14+ })
15+
16+ test_that(" shapefiles with multi-polygons"
17+ library(sf )
18+ fname <- system.file(" shape/nc.shp" package = " sf"
19+ nc <- as.data.frame(st_read(fname ))
20+ p <- ec.init(load = c(' leaflet' ' custom' # load custom for polygons
21+ js = ec.util(cmd = ' sf.bbox' bbox = st_bbox(nc $ geometry )),
22+ series = ec.util(cmd = ' sf.series' df = nc , nid = ' NAME' itemStyle = list (opacity = 0.3 )),
23+ tooltip = list (show = TRUE , formatter = ' {a}'
24+ )
25+ expect_true(p $ x $ opts $ leaflet $ roam )
26+ expect_equal(p $ x $ opts $ series [[108 ]]$ name , ' Brunswick'
27+ expect_equal(p $ x $ opts $ series [[108 ]]$ itemStyle $ opacity , 0.3 )
28+ })
29+
30+ test_that(" shapefile from ZIP"
31+ if (interactive()) { # creates a subfolder 'railways'
32+ library(sf )
33+ fname <- ec.util(cmd = ' sf.unzip'
34+ url = ' https://mapcruzin.com/sierra-leone-shapefiles/railways.zip'
35+ nc <- as.data.frame(st_read(fname ))
36+ p <- ec.init(load = ' leaflet'
37+ js = ec.util(cmd = ' sf.bbox' bbox = st_bbox(nc $ geometry )),
38+ series = ec.util(df = nc , nid = ' osm_id' verbose = TRUE ,
39+ lineStyle = list (width = 3 , color = ' red'
40+ tooltip = list (formatter = ' {a}' animation = FALSE ,
41+ leaflet = list (tiles = list (list (
42+ urlTemplate = ' https://stamen-tiles-{s}.a.ssl.fastly.net/terrain/{z}/{x}/{y}{r}.{ext}'
43+ options = list (attribution = ' Map tiles by <a href="http://stamen.com">Stamen Design</a>, <a href="http://creativecommons.org/licenses/by/3.0">CC BY 3.0</a>'
44+ subdomains = ' abcd' maxZoom = 18 , ext = ' png'
45+ )
46+ expect_equal(p $ x $ opts $ leaflet $ tiles [[1 ]]$ options $ subdomains , ' abcd'
47+ expect_equal(p $ x $ opts $ series [[6 ]]$ name , ' 207557821'
48+ expect_equal(p $ x $ opts $ series [[6 ]]$ lineStyle $ color , ' red'
49+
50+ }
51+ else expect_equal(1 ,1 )
52+ })
53+
54+ test_that(" tabset"
55+ p1 <- cars | > ec.init(width = 300 , height = 300 , grid = list (top = 20 ))
56+ p2 <- mtcars | > ec.init(width = 300 , height = 300 )
57+ r <- htmltools :: browsable(
58+ ec.util(cmd = ' tabset' cars = p1 , mtcars = p2 )
59+ )
60+ expect_equal(r [[2 ]]$ children [[5 ]]$ children [[1 ]]$ children [[1 ]][[1 ]]$ x $ opts $ dataset [[1 ]]$ source [[1 ]], c(" speed" " dist"
61+ expect_equal(r [[2 ]]$ children [[5 ]]$ children [[1 ]]$ name , " section"
62+ expect_equal(r [[2 ]]$ children [[2 ]]$ children [[1 ]], " cars"
63+ })
64+
65+ test_that(" tabset with pipe"
66+ library(dplyr )
67+ r <- htmltools :: browsable(
68+ lapply(iris | > group_by(Species ) | > group_split(), function (x ) {
69+ x | > ec.init(ctype = ' scatter' title = list (text = unique(x $ Species )))
70+ }) | > ec.util(cmd = ' tabset'
71+ )
72+ expect_equal(r [[2 ]]$ children [[7 ]]$ children [[2 ]]$ children [[1 ]][[1 ]]$ width , 300 )
73+ expect_equal(r [[2 ]]$ children [[6 ]]$ children [[1 ]], " chart3"
74+ })
75+
76+ test_that(" morph"
77+ mc <- mtcars | > filter(cyl < 8 )
78+ datt <- function (idx ) { return (mc [mc $ cyl == idx ,]$ hp ) }
79+ colors <- c(" blue" " red" " green" " yellow"
80+
81+ oscatter <- list (
82+ xAxis = list (scale = TRUE ),
83+ yAxis = list (scale = TRUE ), color = colors ,
84+ series = list (
85+ list (type = ' scatter' id = 4 , dataGroupId = 4 , data = datt(4 ),
86+ universalTransition = list (enabled = TRUE )),
87+ list (type = ' scatter' id = 6 , dataGroupId = 6 , data = datt(6 ),
88+ universalTransition = list (enabled = TRUE ))
89+ )
90+ )
91+ obar <- list (
92+ title = list (text = ' Average'
93+ xAxis = list (type = ' category' data = list (' cyl4' ' cyl6'
94+ yAxis = list (show = TRUE ), color = colors ,
95+ series = list (list (
96+ type = ' bar' id = ' average' colorBy = ' data'
97+ data = list (
98+ list (value = mean(datt(4 )), groupId = 4 ),
99+ list (value = mean(datt(6 )), groupId = 6 )),
100+ universalTransition = list (enabled = TRUE ,
101+ seriesKey = c(4 , 6 ))
102+ ))
103+ )
104+
105+ auto <- " cnt = 0;
106+ setInterval(() => {
107+ cnt++;
108+ opts= chart.getOption();
109+ optcurr= Object.assign({}, opts.morph[cnt % 2]);
110+ optcurr.morph= opts.morph;
111+ chart.setOption(optcurr, true);
112+ }, 2000);
113+ "
114+ p <- ec.util(cmd = ' morph' oscatter , obar , js = auto )
115+ expect_equal(p $ x $ opts $ morph [[1 ]]$ series [[1 ]]$ type , ' scatter'
116+ expect_equal(p $ x $ opts $ morph [[2 ]]$ series [[1 ]]$ type , ' bar'
117+ expect_true(grepl(' setInterval' p $ x $ jcode , fixed = TRUE ))
118+ p <- ec.util(cmd = ' morph' oscatter , obar )
119+ expect_equal(p $ x $ on [[1 ]]$ event , ' mouseover'
120+ })
121+
122+ test_that(" fullscreen"
123+ tbox <- list (right = ' 20%' feature = ec.util(cmd = ' fullscreen'
124+ # p <- cars |> ec.init(toolbox= tbox)
125+ # expect_match(p$x$opts$toolbox$feature$myecfs$onclick, 'ecfun.fscreen', fixed=TRUE)
126+ p <- crosstalk :: bscols(
127+ cars | > ec.init(toolbox = tbox ),
128+ mtcars | > ec.init(toolbox = tbox ) | >
129+ htmlwidgets :: prependContent(
130+ htmltools :: tags $ style(
131+ " .echarty:fullscreen { background-color: beige; }"
132+ )
133+ )
134+ )
135+ expect_match(p $ children [[1 ]]$ children [[1 ]][[1 ]]$ children [[1 ]]$ x $ opts $ toolbox $ feature $ myecfs $ onclick , ' ecfun.fscreen(tmp.hwid)' fixed = TRUE )
136+ expect_match(p $ children [[1 ]]$ children [[1 ]][[2 ]]$ children [[1 ]]$ prepend [[1 ]]$ children [[1 ]], ' .echarty:fullscreen' fixed = TRUE )
137+ })
138+
139+ test_that(" rescale"
140+ p <- ec.util(cmd = ' rescale' t = c(5 ,25 ), v = 44 : 64 )
141+ expect_equal(p [5 ], 9 )
142+ })
143+
144+ test_that(" level"
145+ tmp <- " id,from,to
146+ 1,2020-03-03,2020-05-03
147+ 2,2020-01-03,2020-03-13
148+ 3,2020-06-03,2020-07-03
149+ "
150+ df <- read.table(text = tmp , header = TRUE , sep = ' ,'
151+ p <- ec.util(cmd = ' level' df = df )
152+ expect_equal(p , c(1 ,2 ,1 ))
153+ })
154+
155+ test_that(" labelsInside"
156+ p <- ec.init(
157+ xAxis = list (data = list (1 ,2 ,3 ,4 ,5 ,6 ,7 )),
158+ yAxis = list (type = ' value'
159+ series = list (
160+ list (name = ' long text, 20 chars' type = ' line'
161+ data = c(110 , 132 , 101 , 134 , 90 , 230 , 210 ),
162+ endLabel = list ( show = TRUE , formatter = ' {a}'
163+ labelLayout = ec.util(cmd = ' labelsInside'
164+ list (name = ' longer text, this is 35 characters' type = ' line'
165+ data = c(210 , 232 , 201 ,234 , 290 , 240 , 230 ),
166+ endLabel = list (show = TRUE , formatter = ' {a}'
167+ labelLayout = ec.util(cmd = ' labelsInside'
168+ )
169+ )
170+ expect_match(p $ x $ opts $ series [[2 ]]$ labelLayout , " get_e_charts(cid)" fixed = TRUE )
171+ })
0 commit comments