Skip to content

Commit c06f599

Browse files
dcooleydcooley
committed
close #275 
1 parent 5308359 commit c06f599

15 files changed

+105
-50
lines changed

‎R/colours.R

+7
Original file line numberDiff line numberDiff line change
@@ -3,3 +3,10 @@ isHexColour <- function(cols){
33
hexPattern <- "^#(?:[0-9a-fA-F]{3}){1,2}$|^#(?:[0-9a-fA-F]{4}){1,2}$"
44
all(grepl(hexPattern, cols))
55
}
6+
7+
appendAlpha <- function( col ) {
8+
if( isHexColour( col ) ) {
9+
col <- unname( vapply(col, function(x) ifelse(nchar(x==4), paste0(x,"F") , paste0(x,"FF")),"" ) )
10+
}
11+
return( col )
12+
}

‎R/map_layer_column.R

+11-3
Original file line numberDiff line numberDiff line change
@@ -113,15 +113,23 @@ add_column <- function(
113113
brush_radius = NULL
114114
) {
115115

116+
## using binary data requires hex-colorus to include teh alpha
117+
if( !is.null( fill_colour ) ) {
118+
fill_colour <- appendAlpha( fill_colour )
119+
}
120+
if( !is.null( stroke_colour ) ) {
121+
stroke_colour <- appendAlpha( stroke_colour )
122+
}
123+
116124
l <- list()
117125
l[["polyline"]] <- force( polyline )
118126
l[["lon"]] <- force( lon )
119127
l[["lat"]] <- force( lat )
120-
l[["fill_colour"]] <- force( fill_colour )
128+
l[["fill_colour"]] <- fill_colour
121129
l[["fill_opacity"]] <- resolve_opacity( fill_opacity )
122-
l[["stroke_colour"]] <- force( stroke_colour )
130+
l[["stroke_colour"]] <- if(!is.null( stroke_colour ) ) { stroke_colour } else { fill_colour }
123131
l[["stroke_width"]] <- force( stroke_width )
124-
l[["stroke_opacity"]] <- resolve_opacity( stroke_opacity )
132+
l[["stroke_opacity"]] <- if(!is.null( stroke_opacity ) ) { resolve_opacity( stroke_opacity ) } else { resolve_opacity( fill_opacity ) }
125133
l[["elevation"]] <- force( elevation )
126134
l[["tooltip"]] <- force( tooltip )
127135
l[["id"]] <- force( id )

‎R/map_layer_pointcloud.R

+5-2
Original file line numberDiff line numberDiff line change
@@ -108,6 +108,11 @@ add_pointcloud <- function(
108108
brush_radius = NULL
109109
) {
110110

111+
## using binary data requires hex-colorus to include teh alpha
112+
if( !is.null( fill_colour ) ) {
113+
fill_colour <- appendAlpha( fill_colour )
114+
}
115+
111116
l <- list()
112117
l[["lon"]] <- force( lon )
113118
l[["lat"]] <- force( lat )
@@ -187,8 +192,6 @@ add_pointcloud <- function(
187192
shape[["legend"]] <- resolve_legend_format( shape[["legend"]], legend_format )
188193
}
189194

190-
# print( shape )
191-
192195
invoke_method(
193196
map, jsfunc, map_type( map ), shape[["data"]], nrow(data), radius, layer_id, light_settings,
194197
auto_highlight, highlight_colour, shape[["legend"]], bbox, update_view, focus_layer,

‎R/map_layer_scatterplot.R

+9-5
Original file line numberDiff line numberDiff line change
@@ -146,6 +146,13 @@ add_scatterplot <- function(
146146
brush_radius = NULL
147147
) {
148148

149+
## using binary data requires hex-colorus to include teh alpha
150+
if( !is.null( fill_colour ) ) {
151+
fill_colour <- appendAlpha( fill_colour )
152+
}
153+
if( !is.null( stroke_colour ) ) {
154+
stroke_colour <- appendAlpha( stroke_colour )
155+
}
149156

150157
l <- list()
151158
l[["lon"]] <- force(lon)
@@ -154,8 +161,8 @@ add_scatterplot <- function(
154161
l[["radius"]] <- force(radius)
155162
l[["fill_colour"]] <- force(fill_colour)
156163
l[["fill_opacity"]] <- resolve_opacity(fill_opacity)
157-
l[["stroke_colour"]] <- force( stroke_colour )
158-
l[["stroke_opacity"]] <- resolve_opacity( stroke_opacity )
164+
l[["stroke_colour"]] <- if(!is.null( stroke_colour ) ) { force(stroke_colour) } else { force( fill_colour ) }
165+
l[["stroke_opacity"]] <- if(!is.null( stroke_opacity ) ) { resolve_opacity( stroke_opacity ) } else { resolve_opacity( fill_opacity ) }
159166
l[["stroke_width"]] <- force( stroke_width )
160167
l[["tooltip"]] <- force(tooltip)
161168
l[["id"]] <- force(id)
@@ -217,9 +224,6 @@ add_scatterplot <- function(
217224
shape[["legend"]] <- resolve_legend_format( shape[["legend"]], legend_format )
218225
}
219226

220-
221-
# return( shape )
222-
223227
invoke_method(
224228
map, jsfunc, map_type( map ), shape[["data"]], nrow(data) , layer_id, auto_highlight, highlight_colour,
225229
shape[["legend"]], bbox, update_view, focus_layer, js_transitions,

‎R/map_layer_trips.R

+5-5
Original file line numberDiff line numberDiff line change
@@ -39,11 +39,11 @@ mapdeckTripsDependency <- function() {
3939
#' , zoom = 10
4040
#' , style = mapdeck_style("dark")
4141
#' ) %>%
42-
#' add_trips(
43-
#' data = sf
44-
#' , animation_speed = 2000
45-
#' , trail_length = 1000
46-
#' , stroke_colour = "#FFFFFF"
42+
#' add_trips(
43+
#' data = sf
44+
#' , animation_speed = 2000
45+
#' , trail_length = 1000
46+
#' , stroke_colour = "#FFFFFF"
4747
#' )
4848
#'
4949
#' }

‎inst/htmlwidgets/lib/column/column.js

+3-3
Original file line numberDiff line numberDiff line change
@@ -7,12 +7,12 @@ function add_column_geo_columnar( map_id, map_type, column_data, data_count, lay
77
extensions.push( new deck.BrushingExtension() );
88
}
99

10-
console.log( column_data );
10+
//console.log( column_data );
1111

1212
const binaryLocation = new Float32Array(column_data.geometry);
1313
//const binaryRadius = new Float32Array(column_data.radius);
14-
const binaryFillColour = new Float32Array(column_data.fill_colour);
15-
const binaryLineColour = new Float32Array(column_data.stroke_colour);
14+
const binaryFillColour = new Uint8Array(column_data.fill_colour);
15+
const binaryLineColour = new Uint8Array(column_data.stroke_colour);
1616
const binaryLineWidth = new Float32Array(column_data.stroke_width);
1717
const binaryElevation = new Float32Array(column_data.elevation);
1818

‎inst/htmlwidgets/lib/grid/grid.js

+2-2
Original file line numberDiff line numberDiff line change
@@ -62,8 +62,8 @@ function add_grid_geo_columnar( map_id, map_type, grid_data, data_count, layer_i
6262

6363
function add_grid_geo( map_id, map_type, grid_data, layer_id, cell_size, extruded, elevation_scale, colour_range, auto_highlight, highlight_colour, bbox, update_view, focus_layer, js_transition, use_weight, use_colour, elevation_function, colour_function, legend, brush_radius ) {
6464

65-
console.log( grid_data );
66-
console.log( highlight_colour );
65+
//console.log( grid_data );
66+
//console.log( highlight_colour );
6767

6868
var extensions = [];
6969

‎inst/htmlwidgets/lib/map/legend.js

+2-2
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ function md_colour_domain( x, colour_range, map_id, map_type, layer_id, legend,
77
//console.log( x );
88
var cd = md_make_legend_range(x[0], x[1], colour_range.length, legend.digits );
99

10-
console.log( cd );
10+
//console.log( cd );
1111

1212
var ledge = {
1313
fill_colour: {
@@ -114,7 +114,7 @@ function md_add_legend_gradient(map_id, map_type, layer_id, legendValues, format
114114
window[map_id + 'legend' + layer_id + legendValues.colourType].setAttribute('style', legendValues.css);
115115
}
116116

117-
console.log( legendValues.colour );
117+
//console.log( legendValues.colour );
118118

119119
if( format === "hex") {
120120
for (i = 0; i < legendValues.colour.length; i++) {

‎inst/htmlwidgets/lib/mesh/mesh.js

+2-2
Original file line numberDiff line numberDiff line change
@@ -13,8 +13,8 @@ function add_mesh( map_id, map_type, polygon_data, layer_id, light_settings, aut
1313
for (const object of data) {
1414
const polygon = getPolygon(object);
1515
16-
console.log( "const polygon " );
17-
console.log( polygon );
16+
//console.log( "const polygon " );
17+
//console.log( polygon );
1818
1919
// iterate through vertices
2020
polygon.forEach(ring => {

‎inst/htmlwidgets/lib/pointcloud/pointcloud.js

+2-2
Original file line numberDiff line numberDiff line change
@@ -7,11 +7,11 @@ function add_pointcloud_geo_columnar( map_id, map_type, pointcloud_data, data_co
77
extensions.push( new deck.BrushingExtension() );
88
}
99

10-
console.log( pointcloud_data );
10+
//console.log( pointcloud_data );
1111

1212
const binaryLocation = new Float32Array(pointcloud_data.geometry);
1313
const binaryRadius = new Float32Array(pointcloud_data.radius);
14-
const binaryFillColour = new Float32Array(pointcloud_data.fill_colour);
14+
const binaryFillColour = new Uint8Array(pointcloud_data.fill_colour);
1515

1616
const pointcloudLayer = new deck.PointCloudLayer({
1717
map_id: map_id,

‎inst/htmlwidgets/lib/scatterplot/scatterplot.js

+4-2
Original file line numberDiff line numberDiff line change
@@ -6,10 +6,12 @@ function add_scatterplot_geo_columnar( map_id, map_type, scatter_data, data_coun
66
extensions.push( new deck.BrushingExtension() );
77
}
88

9+
console.log( scatter_data );
10+
911
const binaryLocation = new Float32Array(scatter_data.geometry);
1012
const binaryRadius = new Float32Array(scatter_data.radius);
11-
const binaryFillColour = new Float32Array(scatter_data.fill_colour);
12-
const binaryLineColour = new Float32Array(scatter_data.stroke_colour);
13+
const binaryFillColour = new Uint8Array(scatter_data.fill_colour);
14+
const binaryLineColour = new Uint8Array(scatter_data.stroke_colour);
1315
const binaryLineWidth = new Float32Array(scatter_data.stroke_width);
1416

1517
const scatterLayer = new deck.ScatterplotLayer({

‎inst/htmlwidgets/mapdeck_location.js

+2-2
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ function md_change_location( map_id, map_type, location, zoom, pitch, bearing, d
88
window[map_id + 'map'].setZoom( zoom );
99
} else {
1010

11-
console.log( window[ map_id + 'map' ].viewState );
11+
//console.log( window[ map_id + 'map' ].viewState );
1212

1313
if ( window[ map_id + 'map'].viewState["default-view"] !== undefined ) {
1414
currentLon = location === null ? window[ map_id + 'map'].viewState["default-view"].longitude : location[0];
@@ -24,7 +24,7 @@ function md_change_location( map_id, map_type, location, zoom, pitch, bearing, d
2424
currentZoom = zoom === null ? window[ map_id + 'map'].viewState.zoom : zoom;
2525
}
2626

27-
console.log( currentLon );
27+
//console.log( currentLon );
2828

2929
window[map_id + 'map'].setProps({
3030
initialViewState: {

‎man/add_trips.Rd

+5-5
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/test-layer_pointcloud.R

+29-9
Original file line numberDiff line numberDiff line change
@@ -4,9 +4,19 @@ test_that("add_pointcloud accepts multiple objects", {
44

55
library(sfheaders)
66

7-
geo <- '{"elevation":12345.0,"fill_colour":[0.266667,0.003922,0.329412,1.0],"lon":69.11,"lat":34.28,"geometry":[69.11,34.28,12345.0]}'
7+
geo <- '{"elevation":12345.0,"fill_colour":[68.0,1.0,84.0,255.0],"lon":69.11,"lat":34.28,"geometry":[69.11,34.28,12345.0]}'
88
poly <- '[{\"elevation\":123.0,\"fill_colour\":\"#440154FF\",\"polyline\":\"_ifpEo`ydL\"}]'
99

10+
check <- function( geo, res ) {
11+
geo <- jsonify::from_json( geo )
12+
res <- jsonify::from_json( res$x$calls[[1]]$args[[2]] )
13+
expect_equal(geo[["lon"]], res[["lon"]])
14+
expect_equal(geo[["lat"]], res[["lat"]])
15+
expect_equal(geo[["fill_colour"]], res[["fill_colour"]])
16+
expect_equal(geo[["stroke_colour"]], res[["stroke_colour"]])
17+
expect_equal(geo[["stroke_width"]], res[["stroke_width"]])
18+
}
19+
1020
## sf
1121
set_token("abc")
1222
m <- mapdeck()
@@ -15,32 +25,32 @@ test_that("add_pointcloud accepts multiple objects", {
1525
df$elev <- 12345
1626
sf <- sfheaders::sf_point( df[1, ], x = "lon", y = "lat", z = "elev" )
1727
p <- add_pointcloud(map = m, data = sf)
18-
expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), geo )
28+
check( geo, p )
1929

2030
## sfencoded
2131
enc <- googlePolylines::encode( sf )
2232
enc$z <- 123
2333
p <- add_pointcloud( map = m, data = enc, elevation = "z" )
24-
expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), poly )
34+
check( poly, p )
2535

2636
## sfencodedLite
2737
enc <- googlePolylines::encode( sf, strip = T )
2838
enc$z <- 123
2939
p <- add_pointcloud( map = m, data = enc, elevation = "z" )
30-
expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), poly )
40+
check( poly, p )
3141

3242
## data.frame with polyline
3343
df <- as.data.frame( enc )
3444
df$geometry <- unlist( df$geometry )
3545
p <- add_pointcloud( map = m, data = df, elevation = "z", polyline = "geometry")
36-
expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), poly )
46+
check( poly, p )
3747

3848
## data.frame
3949
df <- capitals[1, ]
4050
df$z <- 12345
41-
geo <- '{"elevation":12345.0,"fill_colour":[0.266667,0.003922,0.329412,1.0],"lon":69.11,"lat":34.28,"geometry":[69.11,34.28,12345.0]}'
51+
geo <- '{"elevation":12345.0,"fill_colour":[68.0,1.0,84.0,255.0],"lon":69.11,"lat":34.28,"geometry":[69.11,34.28,12345.0]}'
4252
p <- add_pointcloud( map = m, data = df, lon = "lon", lat = "lat", elevation = "z" )
43-
expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), geo )
53+
check( geo, p )
4454

4555
})
4656

@@ -50,12 +60,22 @@ test_that("pointcloud reads elevation from sf Z attribute", {
5060
sf <- geojsonsf::geojson_sf( geo )
5161
# mapdeck:::resolve_data( sf, list(), "POINT" )
5262

63+
check <- function( geo, res ) {
64+
geo <- jsonify::from_json( geo )
65+
res <- jsonify::from_json( res )
66+
expect_equal(geo[["lon"]], res[["lon"]])
67+
expect_equal(geo[["lat"]], res[["lat"]])
68+
expect_equal(geo[["fill_colour"]], res[["fill_colour"]])
69+
expect_equal(geo[["stroke_colour"]], res[["stroke_colour"]])
70+
expect_equal(geo[["stroke_width"]], res[["stroke_width"]])
71+
}
72+
5373
l <- list()
5474
l[["palette"]] <- "viridis"
5575
l[["legend"]] <- FALSE
5676
l[["geometry"]] <- "geometry"
5777
geometry_column <- list( geometry = c("lon","lat","elevation") )
5878
shape <- mapdeck:::rcpp_point_sf_columnar( sf, l, geometry_column, digits = 6, "pointcloud" )
59-
js <- '{"elevation":[1.0,2.0],"fill_colour":[0.266667,0.003922,0.329412,1.0,0.266667,0.003922,0.329412,1.0],"lat":[0.0,0.0],"lon":[0.0,0.0],"geometry":[0.0,0.0,1.0,0.0,0.0,2.0]}'
60-
expect_equal(as.character( shape$data ), js)
79+
js <- '{"elevation":[1.0,2.0],"fill_colour":[68.0,1.0,84.0,255.0,68.0,1.0,84.0,255.0],"lat":[0.0,0.0],"lon":[0.0,0.0],"geometry":[0.0,0.0,1.0,0.0,0.0,2.0]}'
80+
check( js, shape$data )
6181
})

‎tests/testthat/test-layer_scatterplot.R

+17-6
Original file line numberDiff line numberDiff line change
@@ -4,36 +4,47 @@ test_that("add_scatterplot accepts multiple objects", {
44

55
library(sfheaders)
66

7-
geo <- '{"fill_colour":[0.266667,0.003922,0.329412,1.0],"stroke_colour":[0.266667,0.003922,0.329412,1.0],"stroke_width":0.0,"radius":1,"lon":69.11,"lat":34.28,"geometry":[69.11,34.28]}'
7+
geo <- '{"fill_colour":[68.0,1.0,84.0,255.0],"stroke_colour":[68.0,1.0,84.0,255.0],"stroke_width":0.0,"radius":1,"lon":69.11,"lat":34.28,"geometry":[69.11,34.28]}'
88
poly <- '[{"fill_colour":"#440154FF","stroke_colour":"#440154FF","stroke_width":0.0,"radius":1,"polyline":"_ifpEo`ydL"}]'
99

10+
11+
check <- function( geo, res ) {
12+
geo <- jsonify::from_json( geo )
13+
res <- jsonify::from_json( res$x$calls[[1]]$args[[2]] )
14+
expect_equal(geo[["lon"]], res[["lon"]])
15+
expect_equal(geo[["lat"]], res[["lat"]])
16+
expect_equal(geo[["fill_colour"]], res[["fill_colour"]])
17+
expect_equal(geo[["stroke_colour"]], res[["stroke_colour"]])
18+
expect_equal(geo[["stroke_width"]], res[["stroke_width"]])
19+
}
20+
1021
## sf
1122
set_token("abc")
1223
m <- mapdeck()
1324

1425
sf <- sfheaders::sf_point( capitals[1, ], x = "lon", y = "lat" )
1526
p <- add_scatterplot(map = m, data = sf)
16-
expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), geo )
27+
check( geo, p )
1728

1829
## sfencoded
1930
enc <- googlePolylines::encode( sf )
2031
p <- add_scatterplot( map = m, data = enc )
21-
expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), poly )
32+
check( poly, p )
2233

2334
## sfencodedLite
2435
enc <- googlePolylines::encode( sf, strip = T )
2536
p <- add_scatterplot( map = m, data = enc )
26-
expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), poly )
37+
check( poly, p )
2738

2839
## data.frame with polyline
2940
df <- as.data.frame( enc )
3041
df$geometry <- unlist( df$geometry )
3142

3243
p <- add_scatterplot( map = m, data = df, polyline = "geometry" )
33-
expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), poly )
44+
check( poly, p )
3445

3546
## data.frame
3647
p <- add_scatterplot( map = m, data = capitals[1, ], lon = "lon", lat = "lat" )
37-
expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), geo )
48+
check( geo, p )
3849

3950
})

0 commit comments

Comments
 (0)