From f9d7fac902d1dc408780e5911bc8ca2699acbff3 Mon Sep 17 00:00:00 2001 From: mtennekes Date: Tue, 16 Jul 2024 15:03:32 +0200 Subject: [PATCH] shiny working --- R/onLoad.R | 2 +- R/print.R | 2 + R/shiny.R | 6 +-- R/step1_rearrange.R | 1 + R/tmapLeafletInit.R | 7 +-- R/tmapLeafletRun.R | 4 +- R/tmapLeaflet_layers.R | 9 ++-- examples/tmapOutput.R | 50 +--------------------- man/print.tmap.Rd | 6 +++ man/renderTmap.Rd | 97 ++++++++++++++++++++++++++++++++++++++++++ man/tmap_leaflet.Rd | 2 + 11 files changed, 121 insertions(+), 65 deletions(-) create mode 100644 man/renderTmap.Rd diff --git a/R/onLoad.R b/R/onLoad.R index 45fcd818..c9c196fd 100644 --- a/R/onLoad.R +++ b/R/onLoad.R @@ -1,6 +1,6 @@ # envir = environment() .onLoad = function(...) { - options(tmap.style = "white", tmap.mode = "view", tmap.design.mode = FALSE, + options(tmap.style = "white", tmap.mode = "plot", tmap.design.mode = FALSE, tmap.devel.mode = FALSE) assign("tmapOptions", .defaultTmapOptions, envir = .TMAP) diff --git a/R/print.R b/R/print.R index 52cd3446..cac8a43b 100644 --- a/R/print.R +++ b/R/print.R @@ -5,6 +5,8 @@ #' @param show show the map #' @param vp viewport (for `"plot"` mode) #' @param knit A logical, should knit? +#' @param in.shiny A logical, is the map drawn in **shiny**? +#' @param proxy A logical, if `in.shiny`, is \code{\link{tmapProxy}} used? #' @param options A vector of options #' @param ... not used #' @export diff --git a/R/shiny.R b/R/shiny.R index 90954e28..567c9dd5 100644 --- a/R/shiny.R +++ b/R/shiny.R @@ -1,6 +1,6 @@ -#' Wrapper functions for using tmap in shiny +#' Wrapper functions for using **tmap** in **shiny** #' -#' Use \code{tmapOutput} to create a UI element, and \code{renderTmap} to render the tmap map. To update the map (more specifically, to add and remove layers) use \code{tmapProxy}. Adding layers is as usual, removing layers can be done with the function \code{tm_remove_layer}. +#' Use \code{tmapOutput} to create a UI element, and \code{renderTmap} to render the tmap map. To update the map in \code{view} mode, use \code{tmapProxy}. Adding layers is as usual via the map layer functions like \code{\link{tm_polygons}}. Removing layers can be done , removing with the function \code{tm_remove_layer}. #' #' Two features from tmap are not (yet) supported in Shiny: small multiples (facets) and colored backgrounds (argument bg.color of \code{\link{tm_layout}}). Workarounds for small multiples: create multiple independent maps or specify as.layers = TRUE in \code{\link{tm_facets}}. #' @@ -13,7 +13,7 @@ #' @param mapId single-element character vector indicating the output ID of the map to modify (if invoked from a Shiny module, the namespace will be added automatically) #' @param session the Shiny session object to which the map belongs; usually the default value will suffice #' @param x the tmap object that specifies the added and removed layers. -#' @param zindex the z index of the pane in which the layer is contained that is going to be removed. It is recommended to specify the zindex for this layer when creating the map (inside \code{renderTmap}). +#' @param zindex the z index of the pane in which the layer is contained that is going to be removed. It is recommended to specify the `zindex` for this layer when creating the map (inside \code{renderTmap}). #' @param execOnResize If `TRUE` (default), when the plot is resized, the map is regenerated. When set to `FALSE` the map is rescaled: the aspect ratio is kept, but the layout will be less desirable. #' @importFrom htmlwidgets shinyWidgetOutput #' @rdname renderTmap diff --git a/R/step1_rearrange.R b/R/step1_rearrange.R index 49500875..d27ab503 100644 --- a/R/step1_rearrange.R +++ b/R/step1_rearrange.R @@ -45,6 +45,7 @@ step1_rearrange = function(tmel) { } } else { .TMAP$start_pane_id = 400 + .TMAP$pane_ids = NULL } # create groups, for each group: tms (tmap shape), tmls (tmap layers), tmf (tmap facets) diff --git a/R/tmapLeafletInit.R b/R/tmapLeafletInit.R index 4531c878..9cf63774 100644 --- a/R/tmapLeafletInit.R +++ b/R/tmapLeafletInit.R @@ -23,11 +23,8 @@ tmapLeafletInit = function(o, return.asp = FALSE, vp, prx, lf = NULL, ...) { leaflet_opts$attributionControl = TRUE - print("init") - - if (!.TMAP$proxy) { - .TMAP_LEAFLET$layerIds = list() + .TMAP_LEAFLET$layerIds = NULL } @@ -55,7 +52,7 @@ tmapLeafletInit = function(o, return.asp = FALSE, vp, prx, lf = NULL, ...) { id = which(Lnames == pane_name(z))[1] if (!is.na(id)) { tp = Ltypes[id] - if (tp %in% c("polygons", "symbols")) { + if (tp %in% c("polygons", "symbols", "text", "lines")) { L2 = c(L2, list(list(name = Lnames[id], type = tp, Lid = Lids[[id]]))) } } diff --git a/R/tmapLeafletRun.R b/R/tmapLeafletRun.R index 7c77a429..e813931b 100644 --- a/R/tmapLeafletRun.R +++ b/R/tmapLeafletRun.R @@ -4,15 +4,13 @@ tmapLeafletRun = function(o, q, show, knit, args) { lfs2 = lapply(lfs, function(lfsi) { x = if (o$nrows == 1 && o$ncols == 1) { lf = lfsi[[1]] - print("run") # proxy remove if (!is.null(.TMAP_LEAFLET$layerIds2)) { L = .TMAP_LEAFLET$layerIds - po(.TMAP_LEAFLET$layerIds2) for (L2 in .TMAP_LEAFLET$layerIds2) { if (L2$type == "raster") { lf = leaflet::removeImage(lf, L2$Lid) - } else if (L2$type %in% c("symbols")) { + } else if (L2$type %in% c("symbols", "text")) { lf = leaflet::removeMarker(lf, L2$Lid) } else { lf = leaflet::removeShape(lf, L2$Lid) diff --git a/R/tmapLeaflet_layers.R b/R/tmapLeaflet_layers.R index 529780ff..c07e2ce7 100644 --- a/R/tmapLeaflet_layers.R +++ b/R/tmapLeaflet_layers.R @@ -1,6 +1,4 @@ submit_labels = function(labels, cls, pane, group) { - print("submit") - layerIds = get("layerIds", envir = .TMAP_LEAFLET) if (length(layerIds)) { @@ -69,7 +67,6 @@ tmapLeafletPolygons = function(shpTM, dt, pdt, popup.format, hdt, idt, gp, bbx, if (is.null(idt)) idt = submit_labels(dt$tmapID__, "polygons", pane, group) - if (o$use.WebGL) { shp2 = sf::st_sf(id = seq_along(shp), geom = shp) shp3 = suppressWarnings(sf::st_cast(shp2, "POLYGON")) @@ -127,15 +124,17 @@ tmapLeafletLines = function(shpTM, dt, pdt, popup.format, hdt, idt, gp, bbx, fac gp = rescale_gp(gp, o$scale_down) opt = leaflet::pathOptions(interactive = TRUE, pane = pane) + if (is.null(idt)) idt = submit_labels(dt$tmapID__, "lines", pane, group) if (o$use.WebGL) { shp2 = sf::st_sf(id = seq_along(shp), geom = shp) shp3 = suppressWarnings(sf::st_cast(shp2, "LINESTRING")) gp3 = lapply(gp, function(gpi) {if (length(gpi) == 1) gpi else gpi[shp3$id]}) lf %>% - leafgl::addGlPolylines(data = shp3, color = gp3$col, opacity = gp3$col_alpha, weight = gp3$lwd, pane = pane, group = group) %>% + leafgl::addGlPolylines(data = shp3, color = gp3$col, opacity = gp3$col_alpha, weight = gp3$lwd, pane = pane, group = group, layerId = idt) %>% assign_lf(facet_row, facet_col, facet_page) } else { + lf %>% leaflet::addPolylines(data = shp, layerId = idt, label = hdt, color = gp$col, opacity = gp$col_alpha, weight = gp$lwd, group = group, options = opt, dashArray = lty2dash(gp$lty), popup = popups) %>% assign_lf(facet_row, facet_col, facet_page) @@ -411,7 +410,7 @@ tmapLeafletText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, lf = lf %>% addLabelOnlyMarkers(lng = coords[i,1], lat = coords[i,2], label=text[i], group=group, - layerId = idt, + layerId = idt[i], labelOptions = labelOptions(noHide = TRUE, textOnly = TRUE, pane = pane, diff --git a/examples/tmapOutput.R b/examples/tmapOutput.R index 93090c4d..fcd13c72 100644 --- a/examples/tmapOutput.R +++ b/examples/tmapOutput.R @@ -27,63 +27,17 @@ if (interactive() && require("shiny")) { ), server <- function(input, output, session) { output$map <- renderTmap({ - tm_shape(World[1:3,], id = "iso_a3") + + tm_shape(World, id = "iso_a3") + tm_polygons(world_vars[1], zindex = 401) }) observe({ var <- input$var tmapProxy("map", session, { tm_remove_layer(401) + - tm_shape(World[1:3,], id = "iso_a3") + + tm_shape(World, id = "iso_a3") + tm_polygons(var, zindex = 401) }) }) },options = list(launch.browser=TRUE) ) - - shinyApp( - ui = fluidPage( - tmapOutput("map", height = "600px"), - selectInput("var", "Variable", world_vars) - ), - server <- function(input, output, session) { - output$map <- renderTmap({ - tm_shape(World[1:3,], id = "iso_a3") + - tm_symbols(fill = world_vars[1], zindex = 401) - }) - observe({ - var <- input$var - tmapProxy("map", session, { - tm_remove_layer(401) + - tm_shape(World[1:3,], id = "iso_a3") + - tm_symbols(fill = var, zindex = 401) - }) - }) - },options = list(launch.browser=TRUE) - ) - - shinyApp( - ui = fluidPage( - tmapOutput("map", height = "600px"), - selectInput("var", "Variable", world_vars) - ), - server <- function(input, output, session) { - output$map <- renderTmap({ - tm_shape(World[1:3,], id = "iso_a3") + - tm_text(world_vars[1], zindex = 401) - }) - observe({ - var <- input$var - tmapProxy("map", session, { - tm_remove_layer(401) + - tm_shape(World[1:3,], id = "iso_a3") + - tm_text(var, zindex = 401) - }) - }) - },options = list(launch.browser=TRUE) - ) - } - - - \ No newline at end of file diff --git a/man/print.tmap.Rd b/man/print.tmap.Rd index 4c40f32f..ea1add56 100644 --- a/man/print.tmap.Rd +++ b/man/print.tmap.Rd @@ -12,6 +12,8 @@ vp = NULL, knit = FALSE, options = NULL, + in.shiny = FALSE, + proxy = FALSE, ... ) @@ -30,6 +32,10 @@ \item{options}{A vector of options} +\item{in.shiny}{A logical, is the map drawn in \strong{shiny}?} + +\item{proxy}{A logical, if \code{in.shiny}, is \code{\link{tmapProxy}} used?} + \item{...}{not used} } \description{ diff --git a/man/renderTmap.Rd b/man/renderTmap.Rd new file mode 100644 index 00000000..0ea962a1 --- /dev/null +++ b/man/renderTmap.Rd @@ -0,0 +1,97 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/shiny.R +\name{renderTmap} +\alias{renderTmap} +\alias{tmapOutput} +\alias{tmapProxy} +\alias{tm_remove_layer} +\title{Wrapper functions for using \strong{tmap} in \strong{shiny}} +\usage{ +renderTmap( + expr, + env = parent.frame(), + quoted = FALSE, + execOnResize = TRUE, + mode = NA +) + +tmapOutput(outputId, width = "100\%", height = 400, mode = NA) + +tmapProxy(mapId, session = shiny::getDefaultReactiveDomain(), x, mode = NA) + +tm_remove_layer(zindex) +} +\arguments{ +\item{expr}{A tmap object. A tmap object is created with \code{\link{qtm}} or by stacking \code{\link{tmap-element}}s.} + +\item{env}{The environment in which to evaluate expr} + +\item{quoted}{Is expr a quoted expression (with quote())? This is useful if you want to save an expression in a variable} + +\item{execOnResize}{If \code{TRUE} (default), when the plot is resized, the map is regenerated. When set to \code{FALSE} the map is rescaled: the aspect ratio is kept, but the layout will be less desirable.} + +\item{mode}{tmap mode, see \code{\link[=tmap_mode]{tmap_mode()}} If not defined, the current mode is used} + +\item{outputId}{Output variable to read from} + +\item{width, height}{the width and height of the map} + +\item{mapId}{single-element character vector indicating the output ID of the map to modify (if invoked from a Shiny module, the namespace will be added automatically)} + +\item{session}{the Shiny session object to which the map belongs; usually the default value will suffice} + +\item{x}{the tmap object that specifies the added and removed layers.} + +\item{zindex}{the z index of the pane in which the layer is contained that is going to be removed. It is recommended to specify the \code{zindex} for this layer when creating the map (inside \code{renderTmap}).} +} +\description{ +Use \code{tmapOutput} to create a UI element, and \code{renderTmap} to render the tmap map. To update the map in \code{view} mode, use \code{tmapProxy}. Adding layers is as usual via the map layer functions like \code{\link{tm_polygons}}. Removing layers can be done , removing with the function \code{tm_remove_layer}. +} +\details{ +Two features from tmap are not (yet) supported in Shiny: small multiples (facets) and colored backgrounds (argument bg.color of \code{\link{tm_layout}}). Workarounds for small multiples: create multiple independent maps or specify as.layers = TRUE in \code{\link{tm_facets}}. +} +\examples{ +if (interactive() && require("shiny")) { + + data(World) + world_vars <- setdiff(names(World), c("iso_a3", "name", "sovereignt", "geometry")) + + tmap_mode("plot") + + shinyApp( + ui = fluidPage( + tmapOutput("map", height = "600px"), + selectInput("var", "Variable", world_vars) + ), + server <- function(input, output, session) { + output$map <- renderTmap({ + tm_shape(World) + + tm_polygons(input$var, zindex = 401) + }) + } + ) + + tmap_mode("view") + + shinyApp( + ui = fluidPage( + tmapOutput("map", height = "600px"), + selectInput("var", "Variable", world_vars) + ), + server <- function(input, output, session) { + output$map <- renderTmap({ + tm_shape(World, id = "iso_a3") + + tm_polygons(world_vars[1], zindex = 401) + }) + observe({ + var <- input$var + tmapProxy("map", session, { + tm_remove_layer(401) + + tm_shape(World, id = "iso_a3") + + tm_polygons(var, zindex = 401) + }) + }) + },options = list(launch.browser=TRUE) + ) +} +} diff --git a/man/tmap_leaflet.Rd b/man/tmap_leaflet.Rd index 93924697..5afa2384 100644 --- a/man/tmap_leaflet.Rd +++ b/man/tmap_leaflet.Rd @@ -20,6 +20,8 @@ tmap_grid(x, show = FALSE, ...) \item{\code{return.asp}}{should the aspect ratio be returned?} \item{\code{vp}}{viewport (for \code{"plot"} mode)} \item{\code{knit}}{A logical, should knit?} + \item{\code{in.shiny}}{A logical, is the map drawn in \strong{shiny}?} + \item{\code{proxy}}{A logical, if \code{in.shiny}, is \code{\link{tmapProxy}} used?} \item{\code{options}}{A vector of options} }} }