SymbolixAU / mapdeck
1
#' mapdeck
2
#'
3
#' @import htmlwidgets
4
#'
5
#' @param token Mapbox Acess token. Use \code{set_token()} or \code{Sys.setenv()} to set a global token.
6
#' See Access Tokens section for further details.
7
#' If left empty layers will still be plotted, but without a Mapbox map.
8
#' @param data data to be used in the layer. All coordinates are expected to be
9
#' EPSG:4326 (WGS 84) coordinate system
10
#' @param width the width of the map
11
#' @param height the height of the map
12
#' @param padding the padding of the map
13
#' @param style the style of the map (see \link{mapdeck_style})
14
#' @param pitch the pitch angle of the map
15
#' @param zoom zoom level of the map
16
#' @param bearing bearing of the map between 0 and 360
17
#' @param max_zoom sets the maximum zoom level
18
#' @param min_zoom sets the minimum zoom level
19
#' @param max_pitch sets the maximum pitch
20
#' @param min_pitch sets the minimum pitch
21
#' @param location unnamed vector of lon and lat coordinates (in that order)
22
#' @param show_view_state logical, indicating whether to add the current View State to the map.
23
#' When \code{TRUE}, the following is added as an overlay to the map
24
#' \itemize{
25
#'   \item{width}
26
#'   \item{height}
27
#'   \item{latitude & longitude}
28
#'   \item{zoom}
29
#'   \item{bearing}
30
#'   \item{pitch}
31
#'   \item{altitude}
32
#'   \item{viewBounds}
33
#'   \item{interactionState}
34
#' }
35
#'
36
#' @param repeat_view Logical indicating if the layers should repeat at low zoom levels
37
#'
38
#' @section Access Tokens:
39
#'
40
#' If the \code{token} argument is not used, the map will search for the token, firstly by
41
#' checking if \code{set_token()} was used, then it will search environment variables using
42
#' \code{Sys.getenv()} and the following values, in this order
43
#'
44
#' c("MAPBOX_TOKEN","MAPBOX_KEY","MAPBOX_API_TOKEN", "MAPBOX_API_KEY", "MAPBOX", "MAPDECK")
45
#'
46
#' If multiple tokens are found, the first one is used
47
#'
48
#' @export
49
mapdeck <- function(
50
	data = NULL,
51
	token = get_access_token( api = 'mapbox' ),
52
	width = NULL,
53
	height = NULL,
54
	padding = 0,
55
	style = 'mapbox://styles/mapbox/streets-v9',
56
	pitch = 0,
57
	zoom = 0,
58
	bearing = 0,
59
	max_zoom = 20,
60
	min_zoom = 0,
61
	max_pitch = 60,
62
	min_pitch = 0,
63
	location = c(0, 0),
64
	show_view_state = FALSE,
65
	repeat_view = FALSE
66
	) {
67

68
  # forward options using x
69 1
  x = list(
70 1
    access_token = force( token )
71 1
    , style = force( style )
72 1
    , pitch = force( pitch )
73 1
    , zoom = force( zoom )
74 1
    , location = force( as.numeric( location ) )
75 1
    , bearing = force( bearing )
76 1
    , max_zoom = force( max_zoom )
77 1
    , min_zoom = force( min_zoom )
78 1
    , max_pitch = force( max_pitch )
79 1
    , min_pitch = force( min_pitch )
80 1
    , show_view_state = force( show_view_state )
81 1
    , repeat_view = force( repeat_view )
82
  )
83

84
  # deps <- list(
85
  # 	createHtmlDependency(
86
  # 		name = "map",
87
  # 		version = "1.0.0",
88
  # 		src = system.file("htmlwidgets/lib/map", package = "mapdeck"),
89
  # 		script = c("legend.js", "title.js", "location.js", "coordinates.js", "colours.js")
90
  # 	)
91
  # )
92

93
  # create widget
94 1
  mapdeckmap <- htmlwidgets::createWidget(
95 1
    name = 'mapdeck',
96 1
    x = structure(
97 1
    	x,
98 1
    	mapdeck_data = data
99
    ),
100 1
    width = width,
101 1
    height = height,
102 1
    package = 'mapdeck',
103
    #dependencies = deps,
104 1
    sizingPolicy = htmlwidgets::sizingPolicy(
105 1
    	defaultWidth = '100%',
106 1
    	defaultHeight = 800,
107 1
    	padding = padding,
108 1
    	browser.fill = FALSE
109
    )
110
  )
111

112 1
  mapdeckmap <- add_dependencies( mapdeckmap )
113 1
  mapdeckmap$dependencies <- c(
114 1
  	mapdeckmap$dependencies
115 1
  	, mapboxgl()
116 1
  	, mapdeck_css()
117 1
  	, mapdeck_js()
118 1
  	, htmlwidgets_js()
119
  	#, mapdeckViewStateDependency()
120
  	)
121

122 1
  return(mapdeckmap)
123
}
124

125

126
#' update style
127
#'
128
#' @param map a mapdeck map object
129
#' @param style the style of the map (see \link{mapdeck_style})
130
#'
131
#' @export
132
update_style <- function( map, style ) {
133 0
	invoke_method(
134 0
		map, "md_update_style", style
135
	)
136
}
137

138

139
#' Shiny bindings for mapdeck
140
#'
141
#' Output and render functions for using mapdeck within Shiny
142
#' applications and interactive Rmd documents.
143
#'
144
#' @param outputId output variable to read from
145
#' @param width,height Must be a valid CSS unit (like \code{'100\%'},
146
#'   \code{'400px'}, \code{'auto'}) or a number, which will be coerced to a
147
#'   string and have \code{'px'} appended.
148
#' @param expr An expression that generates a mapdeck
149
#' @param env The environment in which to evaluate \code{expr}.
150
#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
151
#'   is useful if you want to save an expression in a variable.
152
#'
153
#' @name mapdeck-shiny
154
#'
155
#' @export
156
mapdeckOutput <- function(outputId, width = '100%', height = '400px'){
157 0
	htmlwidgets::shinyWidgetOutput(outputId, 'mapdeck', width, height, package = 'mapdeck')
158
}
159

160

161
#' @rdname mapdeck-shiny
162
#' @export
163
renderMapdeck <- function(expr, env = parent.frame(), quoted = FALSE) {
164 0
  if (!quoted) { expr <- substitute(expr) } # force quoted
165 0
  htmlwidgets::shinyRenderWidget(expr, mapdeckOutput, env, quoted = TRUE)
166
}
167

168

169

170
#' Mapdeck update
171
#'
172
#' Update a Mapdeck map in a shiny app. Use this function whenever the map needs
173
#' to respond to reactive content.
174
#'
175
#' @param map_id string containing the output ID of the map in a shiny application.
176
#' @param session the Shiny session object to which the map belongs; usually the
177
#' default value will suffice.
178
#' @param data data to be used in the layer. All coordinates are expected to be
179
#' EPSG:4326 (WGS 84) coordinate system
180
#' @param deferUntilFlush indicates whether actions performed against this
181
#' instance should be carried out right away, or whether they should be held until
182
#' after the next time all of the outputs are updated; defaults to TRUE.
183
#' @param map_type either mapdeck_update or google_map_update
184
#' @export
185
mapdeck_update <- function(
186
	data = NULL,
187
	map_id,
188
	session = shiny::getDefaultReactiveDomain(),
189
	deferUntilFlush = TRUE,
190
	map_type = c("mapdeck_update", "google_map_update")
191
	) {
192

193 0
	map_type <- match.arg( map_type )
194

195 0
	if (is.null(session)) {
196 0
		stop("mapdeck - mapdeck_update must be called from the server function of a Shiny app")
197
	}
198

199 0
	structure(
200 0
		list(
201 0
			session = session,
202 0
			id = map_id,
203 0
			x = structure(
204 0
				list(),
205 0
				mapdeck_data = data
206
			),
207 0
			deferUntilFlush = deferUntilFlush,
208 0
			dependencies = NULL
209
		),
210 0
		class = c(map_type)
211
	)
212
}
213

214

215
#' Mapdeck view
216
#'
217
#' Changes the view of the of the map
218
#'
219
#' @inheritParams mapdeck
220
#' @param map a \code{mapdeck} map object
221
#' @param duration time in milliseconds of the transition
222
#' @param transition type of transition
223
#' @export
224
mapdeck_view <- function(
225
	map,
226
	location = NULL,
227
	zoom = NULL,
228
	pitch = NULL,
229
	bearing = NULL,
230
	duration = NULL,
231
	transition = c("linear", "fly")
232
	) {
233

234 0
	transition <- match.arg(transition)
235 0
	invoke_method(
236 0
		map, 'md_change_location', map_type( map ) , as.numeric( location ), zoom, pitch,
237 0
		bearing, duration, transition
238
		)
239
}
240

241
# Get Map Data
242
#
243
# extracts the data attribute from the map
244
#
245
# @param map a mapdeck map object
246
#
247
get_map_data <- function( map ) {
248 0
	attr( map$x, "mapdeck_data", exact = TRUE )
249
}
250

251
# map_type
252
#
253
# determines the source/type of map
254
map_type <- function( map ) {
255

256 1
	map_type <- attr( map, "class")
257 1
	if( any( c("mapdeck", "mapdeck_update") %in% map_type ) ) return( "mapdeck" )
258

259 0
	if( any( c("google_map", "google_map_update") %in% map_type ) ) return( "google_map" )
260

261 0
	return(NULL)
262
}

Read our documentation on viewing source code .

Loading