I have been working on my first little project in R and have run into an issue with a Leaflet map. It will render properly with the data and design I have specified thus far, but once I move the map in browser or the R viewer in RStudio it will no longer react to clicks/drags/etc. and will not react even if it is left alone for several minutes.
I have also had an issue with the zoom functionality, I am not sure if this is due to something that I missed or something to do with the above issue.
Example of the data:
Data_example
# Libraries ---------------------------------------------------------------
library("shiny")
library("tidyverse")
library("leaflet")
library("leaflet.minicharts")
# UI ----------------------------------------------------------------------
ui <- fluidPage(
titlePanel("Wiersma Sale Iceland Trip"),
mainPanel(
leafletOutput(outputId = "Map_1", height = 1080, width = 1920)
)
)
# Server ------------------------------------------------------------------
server <- function(input, output) {
sheets_data <- read.csv("Iceland_Mark2 - Data.csv")
output$Map_1 <- renderLeaflet({
m <- leaflet(data = sheets_data) %>%
addTiles() %>%
addMinicharts(
sheets_data$Long,
sheets_data$Lat,
type = "pie",
popup = popupArgs(
labels = c("A", "B", "C"),
html = paste0(
"<div>",
"<h3>",
sheets_data$Name,
"</h3>",
"Description: ",
sheets_data$Description,
"<br>",
"Media_1: ",
sheets_data$Media_1,
"</div>"
)
)
)
})
}
# Run_App -----------------------------------------------------------------
shinyApp(ui = ui, server = server)
The output:
Output_of_app
It needn't be pretty, nor unique, but it does need to react to zooming and movement and I can't for the life of me figure out why it behaves this way.
I had the same problem suddenly come up after having already produced a number of maps with no issues. So I figured it most likely was to do with the data I was feeding it.
I had one row in my chartdata that had NAs. Deleting this row and remapping fixed the problem.
Related
I am dynamically creating the elements to be inserted into a fluidRow, the problem that I am facing is that all elements are being rendered at once. So, instead of rendering each element when its renderUI function ends, they all keep waiting until the last renderUI finishes. Thus, having lots of elements in my_dataset makes the rendering really slow.
I expected that once the print(str_glue('End: {i}')) was shown, the element would be rendered. However, this was not the case, it kept waiting for all elements (including ones that were not visible on screen).
I tried using the outputOptions(..., suspendWhenHidden = TRUE) but it made no difference (as it was expected since this is the default).
MWE
library(shiny)
library(shinydashboard)
library(dplyr)
library(tidyr)
library(purrr)
library(stringr)
library(shinycssloaders)
qtd <- 500
my_dataset <- data.frame(
stringsAsFactors = F,
Name = rep('Sample', qtd),
Value = runif(qtd)
)
ui <- function() {
fluidPage(
fluidRow(
column(12, textInput(inputId = 'my_text_input', label = NULL, placeholder = 'Search', width = '100%')),
uiOutput('custom_ui')
)
)
}
server <- function(input, output, session) {
output[['custom_ui']] <- renderUI({
filtered_dataset <- my_dataset %>%
filter(grepl(input[['my_text_input']], Name, ignore.case = T)) %>%
arrange(Name)
map(1:nrow(filtered_dataset), function(i) {
item <- filtered_dataset[i,]
custom_id <- str_glue('custom_id_{i}')
output[[custom_id]] <- renderUI({
print(str_glue('Start: {i}'))
print(item)
result <- box(
width = 3,
title = item$Name,
item$Value
)
print(str_glue('End: {i}'))
result
})
column(width = 3, uiOutput(custom_id, style = 'height: 350px;') %>% withSpinner(type = 6))
})
})
}
runApp(shinyApp(ui = ui, server = server), launch.browser = T)
What you are describing is the expected behaviour. The server will not return anything to the UI before all calculations are finished.
I see you are relying a lot on renderUI. This tends to make the Shiny app slow. When the app starts, it must load, realize that it lacks a portion of the UI, ask the server to create the UI - then the server will create the HTML for all of your boxes and send them to the UI before anything is shown. You should try to keep as much as possible of the UI static.
Dependent on what you want to achieve there are probably a lot of different ways of doing it without renderUI.
Under is an example where the HTML for the boxes are created outside of renderUI. This will work, as long as you don't need input controls or outputs in the boxes - because then they need their own ID.
library(shiny)
library(shinydashboard)
library(dplyr)
library(purrr)
qtd <- 500
my_dataset <- data.frame(
stringsAsFactors = FALSE,
Name = rep('Sample', qtd),
Value = runif(qtd)
) %>%
mutate(
x = map2(
Name,
Value,
~column(
width = 3,
box(
width = 3,
title = .x,
.y
)
)
)
)
ui <- function() {
fluidPage(
fluidRow(
column(
12,
textInput(
inputId = 'my_text_input',
label = NULL,
placeholder = 'Search',
width = '100%'
)
),
uiOutput('custom_ui')
)
)
}
server <- function(input, output, session) {
# Only the filtering of the data is done inside `renderUI`
output[['custom_ui']] <- renderUI({
filtered_dataset <-
my_dataset %>%
filter(grepl(input[['my_text_input']], Name, ignore.case = TRUE)) %>%
arrange(Name) %>%
pull(x)
})
}
runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE)
Last I just want to recommend this book by Hadley Wickham. I think reading this (or parts of this) book before working with Shiny will make everything easier for you.
My Shiny application elements are not being rendered once the function is complete. I have a laptop with 2 external monitors. I do Shiny development in the IDE on monitor #1. If I run the app on monitor #1, it takes about 20 seconds to complete rendering when the main calculations (function) have completed. If I run the app on the laptop or monitor #2, it takes about 3 seconds to complete rendering.
However, this is when the app is maximized to full screen. If the app is not maximized, it renders quickly no matter the display (about 3 seconds).
I can only interact with the application on a screen other than the one which displays the IDE, unless it is not maximized. I know this sounds odd but I have tested it many times and it is the only logical solution. Why this is the case I would be interested in finding out.
I have also tried with 'open in browser' enabled, it will render only after about 20 seconds.
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
Here is some reproducible R/Shiny code that I whipped up to illustrate the issue I am having... Basically, if I try to embed a numeric input into a leaflet map, as illustrated below, I am unable to call the value input specified in the numeric input.
After scouring the web, I have a hunch that a JS-based solution is required because of the way shiny and leaflet render maps. I tried creating a UI output, then a render a UI numeric input, attempted various strategies using reactive functions but did not get very far. Any help would be appreciated as I have been banging my head on the wall trying to figure this out.
library(shiny)
library(leaflet)
library(dplyr)
content <- paste(sep = "<br/>",
"<b>Change number below:</b>",
numericInput("numeroUno", label = NULL, value = 1)
)
ui <- fluidPage(
"This is a map",
leafletOutput("myMap"),
numericInput('numeroDos', label = NULL, value = 5),
textOutput("mapPopupLink"))
server <- function(input, output, session) {
output$myMap <- renderLeaflet({
leaflet() %>%
setView(lng = 25.0343, lat = 77.3963, zoom = 5) %>%
addPopups(-122.327298, 47.597131, content, options = popupOptions(closeButton = FALSE)) %>%
addTiles() %>%
addProviderTiles(providers$OpenTopoMap)
})
output$mapPopupLink <- renderText({
paste("The ui-based widget prints: ", input$numeroDos, ". But the server-based widget does not: ", input$numeroUno)
})
}
shinyApp(ui, server)
Please help!
Let me know if you need additional info.
I have a Shiny App that inserts a circle on a map based on the lat lng associated with the zip code input. The map renders when I load it; however, when I attempt to change the value of the zip code via a selectInput object, the map renders a blank window - i.e. the selectedZip variable.
Any help addressing this issue will be appreciated:
library(shiny)
library(leaflet)
# Data
data <- read.csv('VENDOR_PERFORMANCE_EX.csv')
ui <- fluidPage(
titlePanel("VPD"),
sidebarLayout(
sidebarPanel("Inputs"),
mainPanel("Results")),
selectInput("zipInput", "Select Zip Code", data$Zip),
selectInput("vendorInput", "Select Vendor", as.character(data$Vendor)),
leafletOutput("CLEmap", width = "75%", height = 600)
)
server <- function(input, output, session) {
selectedZip <- reactive({
data[data$Zip == input$zipInput, ]
})
output$CLEmap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-81.730844, 41.430102, zoom = 11) %>%
addCircles(data = selectedZip(), lng = ~ Y, lat = ~ X, radius = 1069)
})
}
shinyApp(ui=ui, server = server)
This works, although there is something very strange going on. And although I can't be sure it fixes the same problem you have because I don't have your data, it seems likely.
Once I added data and got something that sounded like your error I hunted around a bit. The only change I made in the end is adding a unique statement to your zipInput instance of selectInput, I was clued by the fact that that selectInput was not initializing correctly, although it was actually working other than the initial value being blank.
I think that the selectInput control was not correctly able to deal with duplicate entries in the choices vector, and was causing the shiny control to behave strange in some way, and thereby corrupting ... something. Not really sure what.
Weird. And not sure of what was really going on. Anyway this works. And if you take out the unique it does not work and gets an error like you describe.
The code:
library(shiny)
library(leaflet)
# Data
#data <- read.csv('VENDOR_PERFORMANCE_EX.csv')
data <- data.frame(Zip=c("44102","44102","44109"),
Vendor=c("Vendor1","Vendor2","vendor3"),
X=c(41.475,41.477,41.467),Y=c(-81.742,-81.748,-81.697))
ui <- fluidPage(
titlePanel("VPD"),
sidebarLayout(
sidebarPanel("Inputs"),
mainPanel("Results")),
selectInput("vendorInput", "Select Vendor", as.character(data$Vendor)),
selectInput("zipInput", "Select Zip Code", unique(as.character(data$Zip)) ),
leafletOutput("CLEmap", width = "75%", height = 600)
)
server <- function(input, output, session) {
selectedZips <- reactive({
data[data$Zip == input$zipInput, ]
})
output$CLEmap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-81.730844, 41.430102, zoom = 11) %>%
addCircles(data=selectedZips(),lng = ~Y, lat = ~X,radius = 300 )
})
}
shinyApp(ui=ui, server = server)
The output:
I've got a pretty cool shiny app going to look at the results of some modeling I'm doing at work. One of the devices I use is a ggvis line chart that sits in a wellPanel. I'd like to deploy the app for viewing online, but I know from looking at the app on normal sized screens (laptops) that the ggvis plot spills over the borders of the wellPanel. For me not a huge deal since I have a huge screen and if I was looking at it on a small screen I know I can just resize the ggvis charts interactively, but I don't want to tell folks to do that. If I re-size the ggvis charts the wellPanel responds so there must be some link between the size of these two objects.
So is there a way to set the default size of a rendered ggvis chart to the default size of the container it's in regardless of the users screen size? I know ggvis is rendered with SVG and so exploring that might be fruitful. I haven't worked directly with SVG or Vega. Example code is below and here is a link to the app hosted on shinyapps. Any thoughts?
note: I posted the code obviously for folks to work with. I guess I just want to be clear that I'm not asking a question about how to get this shiny app to work - It's more how to style it. Of course I welcome other suggestions though. Cheers.
ui.r
library(shiny)
library(ggvis)
shinyUI(navbarPage("Results Viewer", #theme="bootstrap.css",
tabPanel("Summary Results",
fluidRow(
column(2,
wellPanel(
uiOutput("regionO"),
br(),
uiOutput("scenarioO"),
br(),
uiOutput("fuelO"),
uiOutput("tmpO")
)
),
column(5,
wellPanel(style="position: relative;",
h5("Employment",align="center"),
ggvisOutput("plot1")
)
),
column(5,
wellPanel(style="position: relative;",
h5("Gross Regional Product (Million Dollars)",align="center"),
ggvisOutput("plot2")
)
)
)
)
)
)
server.r
librarylibrary(ggvis)
library(dplyr)
shinyServer(function(input, output, session) {
observe({
###### Define Controls #######
output$regionO <- renderUI({ checkboxGroupInput(inputId="regionI", label = h4("Regions"),
choices = list("Western", "Central", "Southern","Northern", "Capital", "Hudson"),
selected="Capital")
})
output$scenarioO <- renderUI({ selectInput(inputId="scenarioI", label = h4("Scenario"),
choices = list("Low Units, Low Tech"="Lo,Lo" ,"Low Units, High Tech"="Lo,Hi","High Units, Low Tech"="Hi,Lo","High Units, High Tech"="Hi,Hi"),
selected="Lo,Lo")
})
output$fuelO <- renderUI({ selectInput(inputId="fuelI", label = h4("Fuel Price"),
choices = list("High Price" = "Hi", "Low Price" = "Lo"),
selected="Lo")
})
output$tmpO <- renderUI({actionButton("resetI", label = "Reset")})
###### Define Data ###########
if(!is.null(input$resetI)){
chooseRJ <- reactive({
chooseD <- expJ %>% filter(Scenario == input$scenarioI, Region %in% input$regionI, Price == input$fuelI)
return(chooseD)
})
sPlot1 <- reactive({
chooseRJ %>% ggvis(~factor(Period),~Total,stroke=~Region) %>% layer_lines(strokeWidth:=2.5) %>%
add_axis("x",title="Analysis Period") %>% add_axis("y",title="Jobs") %>% scale_numeric("y",zero=TRUE)
})
sPlot1 %>% bind_shiny("plot1")
chooseRV <- reactive({
chooseD <- expV %>% filter(Scenario == input$scenarioI, Region %in% input$regionI, Price == input$fuelI)
return(chooseD)
})
sPlot2 <- reactive({
chooseRV %>% ggvis(~factor(Period),~Total,stroke=~Region) %>% layer_lines(strokeWidth:=2.5) %>%
add_axis("x",title="Analysis Period") %>% add_axis("y",title="Gross Regional Product $M") %>% scale_numeric("y",zero=TRUE)
})
sPlot2 %>% bind_shiny("plot2")
} # Test ui controls exist
}) # End Observeer
}) # End Shiny Server
Global.r
##### Play data ####################
options(stringsAsFactors = FALSE)
expJ <- data.frame(Region=rep(c("Western","Central","Southern","Northern","Capital","Hudson"),times=4,each=8),
Scenario=rep(c("Lo,Lo","Lo,Hi","Hi,Lo","Hi,Hi"),each=48),
Price=rep(c("Hi","Lo"),times=24,each=4),
Period=rep(c(1,2,3,4),times=48),
Total=rnorm(192,5,1.5))
expV <- data.frame(Region=rep(c("Western","Central","Southern","Northern","Capital","Hudson"),times=4,each=8),
Scenario=rep(c("Lo,Lo","Lo,Hi","Hi,Lo","Hi,Hi"),each=48),
Price=rep(c("Hi","Lo"),times=24,each=4),
Period=rep(c(1,2,3,4),times=48),
Total=rgamma(192,10,1.78))