My data consists of columns like lon , lat, region, flat-type and year. I have used leaflet and shiny to create a map with cluster markers.
I included 2 selectInput boxes - one for year and one for the flat-type. Using the reactive function, it keeps giving me this error whenever I run the shiny app.
Error: Don't know how to get location data from object of class
reactiveExpr,reactive
Here's my code
library(shiny)
library(leaflet)
library(dplyr)
ui <- fluidPage(
titlePanel("Transactions for Resale Flats"),
h3("Model A Flats: 3-Room, 4-Room, 5-Room"),
sidebarLayout(position = 'right',
sidebarPanel(
selectInput("year","Year", choices = c("2007","2008",
"2009","2010","2011",
"2012","2013","2014",
"2015","2016","2017"), selected="2007"),
selectInput("type","Flat-Type",choices = c("3 ROOM",'4 ROOM',"5 ROOM"),selected = "3-Room"),
width = 2),
mainPanel(leafletOutput("mymap",height = 650,width=605)))
)
server <- function(input,output, session){
headlinedata<-reactive({
headlinedata%>%
filter(year %in% input$year & flat_type %in% input$type)
})
output$mymap <- renderLeaflet({
leaflet(data=headlinedata) %>%
addTiles() %>%
addMarkers(clusterOptions = markerClusterOptions(),
label = paste(headlinedata$address,',',headlinedata$town))
})
observe(leafletProxy('mymap', data=headlinedata()))%>%
clearMarkers()%>%
addMarkers(clusterOptions = markerClusterOptions(),
label = paste(headlinedata$address,',',headlinedata$town))
}
shinyApp(ui = ui, server = server)
Also this code
observe(leafletProxy('mymap', data=headlinedata()))%>%
clearMarkers()%>%
addMarkers(clusterOptions = markerClusterOptions(),
label = paste(headlinedata$address,',',headlinedata$town))
Whenever I include this, the app will run for a second and then close immediately. This code is supposed to update the map markers whenever the input changes.
Thanks.
First, you need to refer to reactive variables as the variable name followed by (). In output$mymap, you refer to headlinedata, which is the data frame to be filtered, when it should be headlinedata(), which is the reactive variable that's already been filtered. To disambiguate the two, I changed the name of the reactive variable to df. Then, when that reactive variable is needed in code downstream, I refer to it as df().
Second, since df() is a reactive variable and we've set up the leaflet to depend upon it, whenever the reactive variable changes, the map will also change. This means we don't need the observe(leafletProxy ... code.
Here's a reproducible example you can copy and paste.
library(shiny)
library(leaflet)
library(dplyr)
set.seed(1)
headlinedata <- data.frame(year = rep(2007:2017, 10),
flat_type = sample(c("3 ROOM",'4 ROOM',"5 ROOM"),
110, replace=T),
lat = sample(1:50, 110, replace=T),
lng = sample(1:50, 110, replace=T),
address = "address",
town = "town")
ui <- fluidPage(
titlePanel("Transactions for Resale Flats"),
h3("Model A Flats: 3-Room, 4-Room, 5-Room"),
sidebarLayout(position = 'right',
sidebarPanel(
selectInput("year","Year", choices = c("2007","2008",
"2009","2010","2011",
"2012","2013","2014",
"2015","2016","2017"), selected="2007"),
selectInput("type","Flat-Type",choices = c("3 ROOM",'4 ROOM',"5 ROOM"),selected = "3-Room"),
width = 2),
mainPanel(leafletOutput("mymap",height = 650,width=605)))
)
server <- function(input,output, session){
df<-reactive({
headlinedata%>%
dplyr::filter(year %in% input$year & flat_type %in% input$type)
})
output$mymap <- renderLeaflet({
leaflet(data=df()) %>%
addTiles() %>%
addMarkers(clusterOptions = markerClusterOptions(),
label = paste(df()$address,',',df()$town))
})
}
shinyApp(ui = ui, server = server)
Related
I am having two columns in my data frame, one is "all_pass" which contains numeric values and other is "st_name" which contains string values name of states
The requirement of the plot is , when user give input of the state it will show the plot of that particular state which contains all_pass numbers
Following is the code in which I am trying to plot, where the user will input the name of the state and as per the input of the state name, the graph will plot as per the all_pass as per the related pass scores to that particular state. Kindly help in the following code, will be of great help.
Code is as mentioned below :
library(ggplot2)
library(plotly)
library(dplyr)
library(shiny)
ui <- basicPage(
h1("Total bills passed by state delegation , 110th Congress"),
selectizeInput(inputId = "bins",label = "Choose State",
choices = list("AK","AL","AR","AS","AZ","CA","CO","CT","DC","DE","FL","GA","GU","HI","IA","ID","IL","IN","KS","KY","LA","MA","MD","ME","MI","MN","MO","MS","MT","NC","NE","ND","NH","NJ","NM","NV","NY","OH","OK","OR","PA","PR","RI","SC","SD","TN","TX","UT","VA") ,multiple = TRUE ,plotOutput("plot"))
)
server <- function(input, output) {
data <- reactive({
require(input$bins)
df <- df7 %>% filter(st_name %in% input$bins)
})
output$plot <- renderPlot({
ggplot(df(), aes(y= all_pass,x=st_name ))+geom_bar(stat = "sum")
})
}
shinyApp(ui = ui, server = server)
in the UI definition you have plotOutput("plot") as an argument to selectizeInput() instead of basicPage(). Reformatting your code (Ctrl+Shift+A) would have made that more visible.
You can simplify the server code, as the renderPlot() already creates a reactive dependence on input$bins.
You can use the object datasets::state.abb to get a vector of US state abbreviations. This is loaded automatically in every R session.
Please see some working code below. I am using some mock data for df as you did not provide any data in your question.
library(ggplot2)
library(plotly)
library(dplyr)
library(shiny)
ui <- basicPage(
h1("Total bills passed by state delegation, 110th Congress"),
selectizeInput(inputId = "bins",
label = "Choose State",
choices = state.abb,
multiple = TRUE),
plotOutput("plot")
)
server <- function(input, output) {
df <-
tibble(all_pass = sample(1:500, 350),
st_name = rep(state.abb, 7))
output$plot <- renderPlot({
req(input$bins)
df |>
filter(st_name %in% input$bins) |>
ggplot(aes(y = all_pass,x=st_name )) +
geom_bar(stat = "sum")
})
}
shinyApp(ui = ui, server = server)
The minimal example below renders a leaflet map with 3 markets, and a DT table with 3 records. When a market on the map is selected, so to is the matching record on the table. However, what I cannot do, is to also have the reverse of that, where a clicked row on the table also shows the related popup on the map.
I have been unable to find an example R shiny leaflet app that does something similar.
CODE tweaked to reflect initial comments
library(shiny)
library(leaflet)
library(DT)
library(tidyverse)
# Define UI for application that draws a histogram
ui <- fluidPage(
leafletOutput("opsMap"),
DT::dataTableOutput('ranksDT')
)
# Define server logic required to draw a histogram
server <- function(input, output) {
lats <- c(21.608889,21.693056, 24.04)
longs <- c(-74.650833, -73.095,-74.341944)
popups <- c('a','b','c')
layerids <- c('a','b','c')
iconNames <- c('cog','cog','cog')
iconColors <- c('red','red','red')
sampleData <- tibble(lats,longs, popups,layerids,iconNames,iconColors)
score <- c(7,3,9)
locationRanks <- tibble(popups, score)
output$opsMap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addAwesomeMarkers(lat = sampleData$lats,
lng = sampleData$longs,
popup = sampleData$popups,
layerId = sampleData$layerids,
icon = makeAwesomeIcon(icon=sampleData$iconNames,
markerColor=sampleData$iconColors))
})
output$ranksDT <- DT::renderDataTable({
d1 <- datatable(locationRanks,
selection = 'single',
rownames=FALSE,
options = list(dom = 'tpi',
pageLength =5,
paging=FALSE,
searching=FALSE
)
)
d1
})
# create a reactive value that will store the click position
mapClick <- reactiveValues(clickedMarker=NULL)
mapClick <- reactiveValues(clickedGroup=NULL)
# create a reactive for the DT table
locationClick <-reactiveValues(clickedRow = NULL)
# observe click events
observe({
mapClick$clickedMarker <- paste(input$opsMap_marker_click$id)
mapClick$clickedGroup <- paste(input$opsMap_marker_click$group)
locationClick$clickedRow <- input$ranksDT_rows_selected
})
# define a proxy variable for the plant rank table
proxy1 = dataTableProxy('ranksDT')
# when map is clicked, make the same table row selection - need row number
observeEvent(input$opsMap_marker_click$id, {
a <- which(locationRanks[1] == input$opsMap_marker_click$id)
proxy1 %>% selectRows(a)
})
proxy2 = leafletProxy('opsMap', session = shiny::getDefaultReactiveDomain())
# if table is clicked, select the same market from the map
observeEvent(locationClick$clickedRow, {
a <- as.character(locationRanks[locationClick$clickedRow,1])
cat(file=stderr(),"clicked row", locationClick$clickedRow, a,'\n')
#proxy2 %>% opsMap_marker_click$id <- a
})
}
# Run the application
shinyApp(ui = ui, server = server)
A solution could be to use input$map01_marker_click$id together with dataTableProxy(), selectRows() and selectPage() if you want to highlight rows in the datatable.
In order to highlight markers, i think you could either use some javascript to simulate a click on the marker. But i would also go for the easier way to adding a highlighted marker and removing it afterwards.
Basically your question was partly answered in this question: Shiny - how to highlight an object on a leaflet map when selecting a record in a datatable? and the remaining part was in one of the answers. -> credits to them.
As the code was quity lengthy, i made the effort to reduce it towards a minimal reproducible example.
Minimal reproducible example:
library(shiny)
library(leaflet)
library(DT)
qDat <- quakes[1:10, ]
qDat$id <- seq.int(nrow(qDat))
ui <- fluidPage(
mainPanel(
leafletOutput('map01'),
dataTableOutput('table01')
)
)
server <- function(input,output){
output$table01 <- renderDataTable({
DT::datatable(qDat, selection = "single", options = list(stateSave = TRUE))
})
# to keep track of previously selected row
prev_row <- reactiveVal()
# new icon style
highlight_icon = makeAwesomeIcon(icon = 'flag', markerColor = 'green', iconColor = 'white')
observeEvent(input$table01_rows_selected, {
row_selected = qDat[input$table01_rows_selected, ]
proxy <- leafletProxy('map01')
proxy %>%
addAwesomeMarkers(popup = as.character(row_selected$mag),
layerId = as.character(row_selected$id),
lng = row_selected$long,
lat = row_selected$lat,
icon = highlight_icon)
# Reset previously selected marker
if(!is.null(prev_row())){
proxy %>%
addMarkers(popup = as.character(prev_row()$mag),
layerId = as.character(prev_row()$id),
lng = prev_row()$long,
lat = prev_row()$lat)
}
# set new value to reactiveVal
prev_row(row_selected)
})
output$map01 <- renderLeaflet({
leaflet(data = qDat) %>%
addTiles() %>%
addMarkers(popup = ~as.character(mag), layerId = as.character(qDat$id))
})
observeEvent(input$map01_marker_click, {
clickId <- input$map01_marker_click$id
dataTableProxy("table01") %>%
selectRows(which(qDat$id == clickId)) %>%
selectPage(which(input$table01_rows_all == clickId) %/% input$table01_state$length + 1)
})
}
shinyApp(ui = ui, server = server)
This is not a solution, just some things that I found out about the code when looking at it.
The ID plantRanks only appears once in your code.
That is in input$plantRanksDT_rows_selected. Such things are easy to find and easy to fix. The correct id should be the output id of the datatable, so ranksDT. Once you replace that, you will see a second issue
proxy2 %>% opsMap_marker_click$id <- a makes no sense.
input$opsMap_marker_click$id exists but can obviously not be written. I don't exactly know how leaflet proxys work, but
leaflet::addMarkers()
looks promising. Good luck!
I'm developing a leaflet map in R shiny. In this app I want the focus of the map to be changed whenever the lng and lat value in setView() is changed. The lng and lat values are based on what country I select from a drop down box. Previously I use static value for lng and lat in an ifelse() function and the app works. But now the problem is when I want to make things more generic: the lng and lat will be the mean of the longitude and latitude from a subset of the data with the chosen country, the app doesn't show map anymore (from my point of view the calculation seems right)
Below is the simplified and workable R script:
global.R:
library(devtools)
library(leaflet)
library(htmlwidgets)
library(shiny)
library(shinydashboard)
library(sp)
library(rworldmap)
library(RCurl)
library(ggmap)
df <- read.csv(url("https://docs.google.com/spreadsheets/d/1rrEJiuxr4nafTqUQBlPpUdGwvGeGtBJExlPJdday2uw/pub?output=csv"),
header = T,
stringsAsFactors = F)
df$Time <- as.Date(df$Time, "%d/%m/%Y")
ui.R
header <- dashboardHeader(
title = 'Shiny Memery'
)
body <- dashboardBody(
fluidRow(
tabBox(
tabPanel("My Map", leafletOutput("mymap",height = 550)),
width = 700
))
)
dashboardPage(
header,
dashboardSidebar(
sliderInput('Timeline Value','Time line',min = min(df$Time),
max = max(df$Time),
value = c(min(df$Time), min(df$Time)+10)),
selectInput("select_country", label = "Select Country",
choices = NULL,
selected = NULL)
),
body
)
server.R
shinyServer(function(input, output, session) {
dfs <- reactive({
tmp <- subset(df, df$Time <= input$`Timeline Value`[2] & df$Time >= input$`Timeline Value`[1])
tmp
})
part_choices <- reactive({
as.list(c("All", unique(as.character(dfs()$Country))))
})
observe({
updateSelectInput(session, "select_country", choices=part_choices())
})
output$mymap <- renderLeaflet({
lng <- ifelse(input$select_country == "All", mean(dfs()$lon),
mean(subset(dfs(), Country %in% input$select_country)$lon)
)
lat <- ifelse(input$select_country == "All", mean(dfs()$lat),
mean(subset(dfs(), Country %in% input$select_country)$lat)
)
m <- leaflet(dfs()) %>%
addTiles(
) %>%
setView(lng, lat, zoom = 5) %>%
addMarkers(~lon, ~lat,
clusterOptions = markerClusterOptions())
})
})
You will see in the server.R part I use ifelse() to change the lng and lat value that later can be used in setView() function. After I changed the else argument into a calculation the app doesn't work anymore.
Really appreciate if someone can tell me where I was wrong.
Thanks in advance.
In your ui.R, try changing your country input to
selectInput("select_country", label = "Select Country",
choices = "All",
selected = "All")
My guess is that the ifelses do not return a number, given that input$select_country is initialized at NULL, which (for reasons that are unclear to me) causes both renderLeaflet and updateSelectInput not to run, preventing the country selector from being updated.
I am new to writing shiny apps and new to using the leaflet package. I am trying to create a shiny app which will get user inputs and plot a choropleth map based on the aggregated values of the selected user variable.
My sample dataset has the following variables: statename latitude longitude countyname medianage asianpopulation otherpopulation
My app would ask the user to select from either username or countyname. Based on this selection, internally I group my dataset using statename or countyname.
Then the user selects either one or many from the variables: medianage asianpopulation otherpopulation.
Based on this, I want to plot the choropleth map on the sum of the values of these variables and show a table below with these values.
I am not able to use the addPolygons method to plot the map. Do I need to use a shape file for this? Where am I going wrong in this code?
library(dplyr)
library(shiny)
library(readr)
library(leaflet)
library(lazyeval)
library(rgdal)
setwd("E:/Data")
ui <- fluidPage(
titlePanel("Filters"),
sidebarLayout(
sidebarPanel(
radioButtons("level", "Select the Level", choices = c("State", "County"),selected = "State" ,inline = TRUE),
selectInput("variable", "Variable Name", choices = NULL, multiple = FALSE, selectize = TRUE, selected = "medianage")
),
mainPanel(
leafletOutput("map"),
dataTableOutput("heatmapdata")
)
)
)
server <- function(input, output, session) {
read_csv(file="Sample.csv") %>%
select(statename, latitude, longitude, countyname, medianage, asianpopulation, otherpopulation) -> heatmapData -> hd
variable = c()
group = c()
heatmapData <- data.frame(heatmapData)
hd <- heatmapData
heatmapdata_1 <- select(heatmapData, -c(latitude, longitude))
heatmapdata_2 <- select(heatmapdata_1, -c(statename, countyname))
updateSelectInput(session, "variable", choices = sort(unique(colnames(heatmapData))), selected = "medianage")
heatmapdata_2 <- heatmapdata_1
datasetLevel.group <- function(df, grp.var) {
df %>% group_by_(grp.var) %>%
summarise_each(funs(sum)) -> df
df
}
datasetLevel <- reactive({
heatmapdata_2 <- heatmapdata_1
inputvariable <- c("medianage")
if (input$level == "State") {
inputlevel = c("statename")
heatmapdata_2 <- select(heatmapdata_2, -c(countyname))
}
if (input$level == "County") {
inputlevel = c("countyname")
heatmapdata_2 <- select(heatmapdata_2, -c(statename))
}
sm <- datasetLevel.group(heatmapdata_2, inputlevel)
group <- inputlevel
variable <- inputvariable
l_hd <- list(sm, inputlevel, input$variable)
l_hd
})
output$map <- renderLeaflet(
{
leaflet() %>% addTiles(options=tileOptions(minZoom = 3, maxZoom = 10)) %>%
setView(lng = -98.35, lat = 39.5, zoom = 4) %>%
setMaxBounds( -180, 5, -52, 73)
}
)
output$heatmapdata <- renderDataTable(
select_(datasetLevel()[[1]], datasetLevel()[[2]], datasetLevel()[[3]]),
options = list(pageLength=5,
scrollX=TRUE,
lengthMenu = c(5, 10, 25, 100),
searching=FALSE)
)
observe({
pal <- colorQuantile("YlOrRd", NULL, n = 20)
leafletProxy("map", data = datasetLevel()[[1]]) %>%
clearMarkers() %>%
clearMarkerClusters() #%>%
# addPolygons(data = datasetLevel()[[1]],
# fillColor = ~pal(variable),
# fillOpacity = 0.8,
# color = "#BDBDC3",
# weight = 1)
})
}
shinyApp(ui = ui, server = server)
I have commented out the addPolygons code as I get an error with that. I have been breaking my head to get the maps color coded based on the aggregated values of the selected variable.
The data file can be found at: https://drive.google.com/file/d/0B4PQcgewfQ3-MF9lNjU4clpUcUk/view?usp=sharing
Any help on this will be really helpful. Thanks.
I'm wondering how I can change Shiny and Leaflet to plot points according to the change in input without redrawing the whole map.
The code i'm using is:
library(leaflet)
library(shiny)
library(dplyr)
library(readr)
ui <- fluidPage(
titlePanel("Melbourne Urban Tree Visualisation"),
leafletOutput("treedat"),
uiOutput("precinct")
#Giving an input name and listing out types to choose in the Shiny app
)
server <- function(input, output){
#td <- read.csv("treedata.csv", header = TRUE)
#pal <- colorNumeric(
#palette = "RdYlGn",
#domain = td$LifeExpectencyValue
#)
output$precinct <- renderUI({
choices <- as.character(unique(td$Precinct))
choices <- c('All', choices)
selectInput(inputId = "precinct", label = "Precinct", choices = choices, selected = "CBD")
})
output$treedat <- renderLeaflet({
#if(is.null(td)) return()
## get the choice from teh drop-down box
PRECINCT = input$precinct
## supbset the data based on the choice
if(PRECINCT != 'All'){
td2 <- td[td$Precinct == PRECINCT, ]
}else{
td2 <- td
}
## plot the subsetted ata
td2 <- leafletProxy(td2) %>% addTiles(
urlTemplate = 'http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png',
attribution='Map tiles by Stamen Design, CC BY 3.0 — Map data © OpenStreetMap') %>%
addCircleMarkers(radius= 5,
fillOpacity = 0.5,
stroke = FALSE,
color=~pal(LifeExpectencyValue),
popup=paste("<b>", td$CommonName,"</b>", "<br>",
"<b>","Years Left:", "</b>", td$LifeExpectency, "<br>",
"<b>","Genus:","</b>", td$Genus)) %>% addLegend(pal = pal,
values = ~LifeExpectencyValue,
opacity = 1,
title = "Life Expectency")
return(td2)
})
}
shinyApp(ui = ui, server = server)
The dataset used for the code is available at this link - Melbourne Urban Forest Data
There are a lot of points so I wouldn't want to re-draw each time the input is changed. The input is based on the "Precinct" column in the dataset. Any help here is deeply appreciated.
Okay, there you go: leafletProxy is used to add layers to an existing leaflet map. The usage ist just like normal leaflet additions, but you don't need the rendering part, since the map is already rendered in your document.
The first and easiest part is to render the leaflet map on a basic level, that is tiles, legend, static drawings, everything that you want to do just once. This is your starting point. From there on, altering the map is only done by direct commands instead of re-renderings.
This map can now be accessed via its shiny output id. In out case, we had leafletOutput("treedat"), so if we want to address this map, we use leafletProxy("treedat"). We use the same syntax as in regular leaflet modifications. E.g. leafletProxy("treedat") %>% addMarkers(lat = 1, lng = 1) adds a marker to the existing map without re-rendering it.
Thus, every modification to the map can / has to happen from inside some observe statement and not from inside the renderLeaflet. Note that every command is an addition to the original map, which is why I had to use clearMarkers in the example below.
Code:
library(leaflet)
library(shiny)
library(dplyr)
library(readr)
ui <- fluidPage(
titlePanel("Melbourne Urban Tree Visualisation"),
leafletOutput("treedat"),
uiOutput("precinct")
#Giving an input name and listing out types to choose in the Shiny app
)
server <- function(input, output){
td <- data.frame(
LifeExpectencyValue = sample(20:100, 10),
Precinct = c(rep("CBD", 3), rep("ABC", 4), rep("XYZ", 3)),
CommonName = sapply(1:10, function(x){paste(sample(LETTERS, 10, replace = TRUE), collapse = "")}),
Genus = rep(c("m","f"), each = 5),
lat = seq(5, 50, 5),
lng = seq(2, 65, 7)
)
pal <- colorNumeric(palette = "RdYlGn", domain = td$LifeExpectencyValue)
output$precinct <- renderUI({
choices <- as.character(unique(td$Precinct))
choices <- c('All', choices)
selectInput(inputId = "precinct", label = "Precinct", choices = choices, selected = "CBD")
})
output$treedat <- renderLeaflet({
leaflet() %>%
addTiles(
urlTemplate = 'http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png',
attribution='Map tiles by Stamen Design, CC BY 3.0 — Map data © OpenStreetMap'
) %>%
addLegend(pal = pal, values = td$LifeExpectencyValue, opacity = 1, title = "Life Expectency")
})
observeEvent(input$precinct, {
#if(is.null(td)) return()
## get the choice from teh drop-down box
PRECINCT = input$precinct
## supbset the data based on the choice
if(PRECINCT != 'All'){
td2 <- td[td$Precinct == PRECINCT, ]
}else{
td2 <- td
}
## plot the subsetted ata
leafletProxy("treedat") %>%
clearMarkers() %>%
addCircleMarkers(lat = td2$lat, lng = td2$lng,
radius= 5, fillOpacity = 0.5, stroke = FALSE, color=pal(td2$LifeExpectencyValue),
popup = paste("<b>", td2$CommonName,"</b>", "<br>",
"<b>","Years Left:", "</b>", td2$LifeExpectency, "<br>",
"<b>","Genus:","</b>", td2$Genus))
})
}
shinyApp(ui = ui, server = server)