I'm using ShinyWidget's pickerInput feature to allow users to select multiple layers (spatial data) to display in Leaflet. Checking multiple boxes displays the layers as desired, however, I'm unable to hide/deselect the layer after unchecking the box in the input menu.
Key code in my app.R script:
tn_data <- c("Rail"="rail1", "Airports"="airports1", "Ferries"="ferries1")
pickerInput(inputId = "pickv", label = "Transportation", choices = tn_data, multiple = TRUE),
rail_vn <- readOGR(dsn = "./geospatial_files/osm", layer = "gis.osm_railways_free_1")
server <- function(input, output, session) {
observeEvent(input$pickv, {
if (input$pickv == "rail1"){ # this diplays just the rail layer
proxy <- leafletProxy("map")
proxy %>% addPolylines(data=rail_vn, weight = 2, group = "railv", color = "#7f0000")}
else {proxy %>% clearGroup("railv")} # this does not work, unable to deselect/hide layer in Leaeflet
}
)
Previously, when I used checkboxInput I was able to deselect the layer from Leaflet using the clearGroup function, but this does not work using pickerInput.
Any suggestions would be welcome, as I haven't been able to find any similar examples where pickerInput is used with Leaflet.
I believe you should define the proxy outside of the if then, so that is also available on the else.
observeEvent(input$pickv, {
proxy <- leafletProxy("map")
if (input$pickv == "rail1"){ # this diplays just the rail layer
proxy %>% addPolylines(data=rail_vn, weight = 2, group = "railv", color = "#7f0000")}
else {
proxy %>% clearGroup("railv")} # this does not work, unable to deselect/hide layer in Leaeflet
}
Related
I'm a bit new to R Shiny, and I'm trying to make a simple, dynamic web map in which common users can find where to recycle a variety of materials in Eastern Kentucky. In my sidebar panel in the UI, I made a checkboxGroup, so the user can filter through the recycling centers that allows for the recycling of the materials of their choosing (in this case, which centers recycle glass AND/OR aluminum AND/OR plastics). The checkbox shows up when you run the app, but I get a blank dashboard where the map should be. There's something wrong on the Server side of the app, when I try to make a proxy map in the observeEvent() function, but I'm stumped at what I'm doing wrong.
Here's a link to my data, named RE.csv:
https://github.com/mallen011/Leaflet_and_Shiny/blob/master/Shiny%20Leaflet%20Map/csv/RE.csv
Here's the full, original Shiny app code:
https://github.com/mallen011/Leaflet_and_Shiny/blob/master/Shiny%20Leaflet%20Map/app.R
Here's the data, read in R:
RE <- read.csv("C:/Users/username/Desktop/GIS/Shiny Leaflet Map/csv/RE.csv")
RE$y <- as.numeric(RE$y)
RE$x <- as.numeric(RE$x)
RE.SP <- SpatialPointsDataFrame(RE[,c(7,8)], RE[,-c(7,8)])
RE$popup <- paste("<p><h2>", RE$name,"</p></h2>",
"<p>", RE$sector,"</p>",
"<p>", RE$address,"</p>",
"<p>", RE$phone,"</p>")
Here's the UI (dashboardSidebar is where the checkboxGroup input() is located):
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(checkboxGroupInput(inputId = "RE_check",
label = h3("Recycleables"),
choices = list("Glass" = RE$GL, "Aluminum" = RE$AL, "Plastic" = RE$PL),
selected = 0)
),
dashboardBody(
fluidRow(box(width = 12, leafletOutput(outputId = "map"))),
leafletOutput("map")
)
)
And here's the server:
server <- function(session, input, output) {
output$map <- renderLeaflet({
leaflet() %>%
addMarkers(data = RE,
lng = ~x, lat = ~y,
label = l apply(RE$popup, HTML),
group = "recycle") %>%
})
And this is the section I'm having trouble with in the server.r side. I'm unsure what I'm doing wrong, but I know it's something wrong with my observeEvent(). What I'm trying to accomplish is an observe event in which if the user checks glass in the checkbox group, then every recycling center that has the value "yes" for recycling glass will pop up. Just having a brain fart for how to go about getting this result.
observeEvent({
RE_click <- input$map_marker_click
if (is.null(RE_click))
return()
if(input$RE_check == "Glass"){
leafletProxy("map") %>%
clearMarkers() %>%
addMarkers(data = RE_click,
lat = RE$y,
lng = RE$x,
popup = RE$popup)
}
})
}
shinyApp(ui = ui, server = server)
I'm sure the answer to my dilemma is a lot simpler than I'm making it out to be, but I'd appreciate any/all help.
Stay safe out there! Thanks
I'm using the leaftlet.extras R package to add Gps control inside a map.
I'm using the extension addControlGPS inside my code :
... %>%
addControlGPS(options = gpsOptions(position = "topleft", activate = TRUE,
autoCenter = TRUE, maxZoom = 60,
setView = TRUE)) %>%
...
The controller works ok.
I need to extract the Gps coordinates to re-use in my code as arguments for other functions. Is there any way to do that ?
Every time the gps location updates, the coordinates are written to map.id+'_gps_located'. You can find all leaflet.extras bindings in the htmlwidgets/bindings folder in their git.
Working example
library(leaflet)
library(leaflet.extras)
library(shiny)
ui <- fluidPage(
leafletOutput('map')
)
server <- function(input, output, session) {
output$map <- renderLeaflet({ leaflet()%>%addTiles() %>%
addControlGPS(options = gpsOptions(position = "topleft", activate = TRUE,
autoCenter = TRUE, maxZoom = 60,
setView = TRUE))})
observe(
print(input$map_gps_located)
)
}
shinyApp(ui, server)
I've recently had a similar problem with an app I was working on.
You can extract the gps coordinates from a leaflet map by using the _marker_click feature, where is the map label you specify as an output for the leaflet rendering statement.
In my case here's the chunk of code I used to retrieve the coords. In my case the output name of the map object was parksMap therefore the full input to consider in the event observation was parksMap_marker_click. This statement can be saved in a variable (in my case pin), that stores the coordinates data. Finally you need to wrap it all in a reactive expression to be able to save every coordinate when clicking on a point in the leaflet map.
# code to load the park card once the click event on a marker is intercepted
observeEvent(input$parksMap_marker_click, {
pin <- input$parksMap_marker_click
#print(Sys.time()) #uncomment to log coords
#print(pin) #uncomment to log coords
selectedPoint <- reactive(parks[parks$Latitude == pin$lat & parks$Longitude == pin$lng,])
leafletProxy("parksMap", data = selectedPoint()) %>% clearPopups() %>%
addPopups(~Longitude,
~Latitude,
popup = ~park_card(selectedPoint()$ParkName, selectedPoint()$ParkCode, selectedPoint()$State, selectedPoint()$Acres, selectedPoint()$Latitude, selectedPoint()$Longitude)
)
})
The full github repo of the app is available here.
I have a simple shiny-app with just a dropdown listing districts of Afghanistan and a leaflet map of the same.
The shape file can be accessed at this link - using AFG_adm2.shp from http://www.gadm.org/download
here's the app code:
library(shiny)
library(leaflet)
library(rgdal)
library(sp)
afg <- readOGR(dsn = "data", layer ="AFG_adm2", verbose = FALSE, stringsAsFactors = FALSE)
ui <- fluidPage(
titlePanel("Test App"),
selectInput("yours", choices = c("",afg$NAME_2), label = "Select Country:"),
leafletOutput("mymap")
)
server <- function(input, output){
output$mymap <- renderLeaflet({
leaflet(afg) %>% addTiles() %>%
addPolylines(stroke=TRUE, color = "#00000", weight = 1)
})
proxy <- leafletProxy("mymap")
observe({
if(input$yours!=""){
#get the selected polygon and extract the label point
selected_polygon <- subset(afg,afg$NAME_2==input$yours)
polygon_labelPt <- selected_polygon#polygons[[1]]#labpt
#remove any previously highlighted polygon
proxy %>% removeShape("highlighted_polygon")
#center the view on the polygon
proxy %>% setView(lng=polygon_labelPt[1],lat=polygon_labelPt[2],zoom=7)
#add a slightly thicker red polygon on top of the selected one
proxy %>% addPolylines(stroke=TRUE, weight = 2,color="red",data=selected_polygon,layerId="highlighted_polygon")
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
I want a infoBox or valueBox like widget from shinyDashboard to display some data(like district population) below the map based on user selection. How can I do this?
You can mimic the shinydashboard::infoBox with your own function:
create function
myInfoBox <- function(title, value)
{
div(
div(class='myinfobox-title', title),
div(class='myinfobox-value', value)
)
}
use uiOutput() whenever you want to place it e.g. uiOutput('idOfInfoBox')
in server part use e.g. output$idOfInfoBox <- renderUI(myInfoBox(title, value)
add .css file in www/ directory and add some properties for classes myinfobox-title and myinfobox-value
I hope this helps.
You need to change the structure of the program and need to add dashboard page in UI.
Here are some reference just have a look. you will get to know!!!
https://rstudio.github.io/shinydashboard/structure.html
https://rdrr.io/cran/shinydashboard/man/valueBox.html
I have a bunch of points on a map with some associated data.
First, I want to filter those points by their attributes. That works fine, but recently when I run the app and fiddle with the filters, eventually it stops removing the previously filtered points and just loads the newly filtered points on top. This has been happening after about 10 adjustments to the filter. It is as if the clearMarkers() function stops working. The filtered data will also show up in a reactive data.table (that part works fine, didn't include it in the example).
Second, I want to click on points to select them. Data from the selected points will go in to some graphs later. I can definitely select one point, but I am having trouble keeping a reactive variable of all clicked points. Also, a selected point should become unselected if clicked again. The selected points will be highlighted on the map (by adding bigger brighter markers on them), and in the reactive data.table, and the selection should update following clicks in the map and clicks in the table. But that is a few steps down the line.
Here is some sample code, which does not work.
library(sp)
library(leaflet)
library(shiny)
data <- data.frame(x = c(10,20,30,10,40), y = c(20,20,10,30,30), z = c(1,2,3,4,5))
points <- SpatialPointsDataFrame(data[,1:2],data[3])
server <- function(input, output, session) {
filtered <- reactive({
z.in <- input$z
points[points#data$z > z.in,]
})
selected <- reactiveValues()
output$map <- renderLeaflet({leaflet()})
observe({ # This observer works, but it seems to stop working about about 10 tries
leafletProxy("map") %>%
clearMarkers() %>%
addCircleMarkers(data = filtered())
})
observe({ # This observer does not work, and the app won't run unless you comment it out
clicked <- unlist(input$map_marker_click[3:4])
if (is.na(clicked)) {selected <- clicked}
else if (clicked %in% selected) {selected <- selected[-clicked]}
else {selected <- append(selected, clicked)}
})
}
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10,left = 10,
sliderInput("z", "z",0,6,0)
))
shinyApp(ui = ui, server = server)
The crosstalk package addresses this.
https://rstudio.github.io/crosstalk/
PROBLEM SYNOPSIS: I have a shiny app I am building where I am trying to support database calls that drive dynamic lists of choices for selectInputs and where that dynamic input drives what a ggvis plot shows. The dynamic selectInput is not correctly selected and filtering the ggvis plot
QUESTION: How can I support dynamic drop down lists while still ensuring my ggvis plot filters based on the chosen item?
PROBLEM DETAIL:
Within my Server.R file I have a reactive that grabs a slice of data from the database. The get_chunk function is a call to NEO4J that I know works:
shinyServer( function(input, output, session) {
CURRENT_CHUNK <- reactive({
#call NEO4J
chunk <- get_chunk(some_list = input$chunk)
return(chunk)
})
I also have a reactive that simply filters down the data based on the ui choices on the front end. The input$A value is the chosen value from a dynamically built dropdown list. The filter_reactive is below. NOTE: I've separated these two so I don't have to call the database all the time; only when I choose a different CHUNK. The filter reactive looks like the following:
NO_DB_REACTIVE <- reactive({
#react to current_chunk and pull back a chunk.
filter_down <- CURRENT_CHUNK()
#check for nulls
if (!is.null(chunk)) {
if (input$A != "All") {filter_down <- filter_down %>% filter(A == input$A)}
return(filter_down)
}
return(filter_down)
})
The input$A value is generated dynamically as follows within the server.R file:
# reactively /dynamically generated the choices for the channel owners
output$owner_choices <- renderUI({ selectInput("A", "FOR Owner"
, as.list(c("All",unique(CURRENT_CHUNK()[,'owner'] )))
, "All") })
I also have a reactive that generates my GGVIS plot that looks like the following:
#All of the visualizations
MY_VIS <- reactive({
# Lables for axes
yvar_name <- names(display_choices)[display_choices == input$yvar]
xvar_name <- names(cat_choices)[cat_choices == input$xvar]
#retrieving
yvar <- prop("y", as.symbol(input$yvar))
xvar <- prop("x", as.symbol(input$xvar))
CURRENT_CHUNK %>%
ggvis(x = xvar, y = yvar) %>%
layer_bars() %>%
add_axis("x", title = xvar_name, properties = axis_props(labels = list(angle = 45, align = "left", fontSize = 10))) %>%
add_axis("y", title = yvar_name) %>%
set_options(width = 900, height = 300)
})
I tried to slim this down as much as possible. There is some dynamic choosing of axes there but you get the point. Notice I currently call CURRENT CHUNK within the MY_VIS reactive. And the end of the file has these:
output$table <- renderDataTable({ NO_DB_REACTIVE() })
MY_VIS %>% bind_shiny("my_vis")
When I filter items this way I get no errors. My table filters on input$A changes and the vis does not; I want the vis to change based on what input$A is as well.
I originally tried having MY_VIS depend on NO_DB_REACTIVE. This fails as input$A is never generated. I guess because CURRENT_CHUNK never runs as it doesn't have to. Notice the output$owner_choices is generated by reacting to CURRENT_CHUNK() not NO_DB_REACTIVE().
KEY QUESTION: How can I set this up so my input$A value is available when I want to filter my ggvis plot?