I am using R 3.2.3 through RStudio Version 0.99.491, on Windows 10 64bit... I am creating a leaflet shiny app, using graduated circlemarkers. I want to display different months to show the change in data using selectInput(), but i don't know how to connect it to the 'radius =' argument of addCirclemarker() to make it dynamic. I know I'm just making it up with the 'radius =' argument of addCirclemarker() but I can't tell if I have selectInput() wrong too. here's the data I'm using. The result shows no error message and the map worked when the radius argument was given a single column assignment, ie a static map.
ui.r:
library(shiny)
library(leaflet)
shinyUI(fluidPage(
titlePanel("CAT Rider Count Map"),
sidebarLayout(
sidebarPanel(
selectInput("var", label = "1. Select the Month",
choices = c("April" = 3, "May" = 4, "June" = 5),
selected = 4)),
mainPanel(leafletOutput('crossact.map')
))))
server.r
library(shiny)
library(googlesheets)
library(leaflet)
gs_auth()
ttt <- gs_auth()
saveRDS(ttt, "ttt.rds")
gs_auth(token = ttt)
gs_auth(token = "ttt.rds")
crossact <- gs_title("crossact")
crossact <- crossact%>% gs_read_csv()
shinyServer(
function(input, output, session){
colm <- reactive({
as.numeric(input$var)
})
output$crossact.map <- renderLeaflet({
##################################################################
#RADIUS SECTION
##################################################################
crossact.map <- leaflet(crossact) %>%
addTiles('http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png')
crossact.map%>% setView(-71.43381, 42.48649, zoom = 17)
crossact.map %>% ***addCircleMarkers(~lng, ~lat, popup=~crossact$name, weight =1,
radius=~(crossact[,colm()]),
color="#ffa500", stroke = TRUE, fillOpacity = 0.6)
})
})
thanks!
For the solution to my specific problem, I used code from the superzip app, for anyone making leaflet shiny apps with markers, this seems to have it all.
http://shiny.rstudio.com/gallery/superzip-example.html (hit the Get Code button and it will send you to Github)
Correct me if I'm wrong, but, sizeBy <- input$size pull the values from the choice argument, and is the bridge to the selectInput() function. radius <- crossact[[sizeBy]] assigns the overlapping strings from the data.frame object to the selectInput() variable sizeBy by making the variable radius. For this to work, the map function must have an observer({}) wrapper to have it update itself when the selection changes.
ui.r
library(shiny)
library(leaflet)
#this is the assignment of columns to the choices argument in selectinput()
vars <- c(
"April" = "April",
"May" = "May",
"June" = "June")
shinyUI(fluidPage(
h5("Integrating Leaflet With Shiny"),
titlePanel("CAT Rider Count Map"),
sidebarLayout(
sidebarPanel(
selectInput("size", "Size", vars, selected = "April")),
mainPanel(leafletOutput('crossact.map')
))))
Server.r
library(shiny)
library(googlesheets)
library(leaflet)
#google authorization, token storage, file acquisition and assignment
gs_auth()
ttt <- gs_auth()
saveRDS(ttt, "ttt.rds")
gs_auth(token = ttt)
gs_auth(token = "ttt.rds")
crossact <- gs_title("crossact")
crossact <- crossact%>% gs_read_csv()
shinyServer(
function(input, output, session){
####observer is used to maintain the circle size.
observe({
#####this connects selectInput and assigns the radius value
sizeBy <- input$size
radius <- crossact[[sizeBy]]
output$crossact.map <- renderLeaflet({
crossact.map <- leaflet(crossact) %>%
addTiles('http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png')
crossact.map%>% setView(-71.43381, 42.48649, zoom = 17)
crossact.map %>% addCircleMarkers(~lng, ~lat, popup=~crossact$name, weight = 1,radius = radius,
color="#ffa500", stroke = TRUE, fillOpacity = 0.6)
})
})
})
Related
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)
It's been a while since i'm having this problem. My current shiny app is not able to communicate with the user selection. It is supposed to show a colour fill variation across different region when a user makes a selection. However, it seems like the map is not showing it. My best guess is that it is not reading the 'pal' function correctly, and not able to capture the selection that the user input.
any kind of help would be great.
library(datasets)
library(dplyr)
library(ggplot2)
library(gridExtra)
library(leaflet)
library(leaflet.extras)
library(Matrix)
library(readxl)
library(rgdal)
library(shiny)
library(stringr)
library(tidyverse)
library(tidyr)
library(RColorBrewer)
cf <- read.csv("datafile.csv")
sgmap55 <-readOGR("shapefile.kml")
bins <-c(1,50,100,150,200)
pal <- colorBin("Blues", domain = NULL, bins = bins, na.color = "#808080")
#5) setting for the labels.
labels <- sprintf(
"<strong>%s</strong><br/>%g respondents </sup>",
cf$planarea, cf$planarea)%>% lapply(htmltools::HTML)
##Section C: ShinyApp starts here
ui <- fluidPage(
titlePanel("Brand Interaction with Regions"),
sidebarLayout(
sidebarPanel(
radioButtons("brand", "Select First Brand:", choices = colnames(cf[,c(3,4,5,6,7,8,9,10,11,12,13,14)]))),
mainPanel(
leafletOutput("sgmap2")
)
)
)
server <- function(input, output, session) {
output$sgmap2 <- renderLeaflet({
selected_brand <- input$brand
leaflet() %>%
addTiles() %>%
addResetMapButton()%>%
clearMarkers()%>%
addProviderTiles("OpenStreetMap") %>%
setView(103.8198,1.3521,11)%>%
addPolygons(data = sgmap55,
highlight = highlightOptions(
weight = 5,
color = "#666666",
fillOpacity = 0.7,
fillColor = pal(input$selected_brand),
bringToFront = TRUE))
})
}
shinyApp(ui = ui, server = server)
manage to solve it with below code in between the server portion:
req(input$brand)
cpop <- cf[[input$brand]]
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 trying to create an interactive webmap in R to display locations using Shiny and Leaflet
The idea is that the user selects one input and the markers corresponding to that input(lat/long which are to be fetched from data set of the corresponding input) are displayed in a Leaflet map (with zoom in/out function).
Any help/advice would be greatly appreciated!
(sample data file uploaded here):
enter code here
Server.R
library(shiny)
library(rpart.plot)
library(leaflet)
shinyServer(
function(input, output) {
output$dtmplot <- renderPlot({
dtmplot <- rpart.plot(dtm, type=4, extra=101)
})
observe({
output$map <- renderLeaflet( {
for(j in 1:nrow(df))
{
if(df[j, "col1"]==input$input1) {
map <- leaflet() %>%
addTiles() %>%
addMarkers(lng=df[j,"Longitude"], lat=df[j,"Latitude)
}
}
})
})
}
)
enter code here
UI.R
library(shiny)
library(leaflet)
shinyUI(
pageWithSidebar(
headerPanel("Sample project"),
sidebarPanel(
plotOutput("dtmplot"),
selectInput("input1",
label = "label1:",
choices = c(“choice1”,”choice2”),
selected = " choice1"),
sliderInput("slider","Please select slider input", min=1,max=100,value=20,step=10)
),
mainPanel(
leafletOutput("map")
)
))
The basic code to handle custom points in a leaflet map is available below. The code utilises the official example available on the leaflet GitHub and provided end-user with the functionality to display custom location on the map.
app.R
library(shiny)
library(leaflet)
r_colors <- rgb(t(col2rgb(colors()) / 255))
names(r_colors) <- colors()
ui <- fluidPage(
leafletOutput("mymap"),
p(),
h1("Added example to add more points here:"),
p(),
numericInput("long", label = h3("Longitude:"), value = 11.242828),
numericInput("lat", label = h3("Latitude:"), value = 30.51470),
actionButton("recalc", "Show point")
)
server <- function(input, output, session) {
points <- eventReactive(input$recalc, {
cbind(input$long, input$lat)
}, ignoreNULL = FALSE)
output$mymap <- renderLeaflet({
leaflet() %>%
setView(lat = 30, lng = 11, zoom = 4) %>%
addProviderTiles("Stamen.TonerLite",
options = providerTileOptions(noWrap = TRUE)
) %>%
addMarkers(data = points())
})
}
shinyApp(ui, server)
Results
The obtained map looks like that:
Explanation
The mechanics is fairly simple and can be summarised in the following steps:
You need to pas lat and lon to your map to addMarkers. In my example this is done via primitive input files but it can be done in a number of ways.
You have to decide on the logic of dynamically adding markers to your map; in the presented case this is done with use of an actionButton.
Side notes
As at the time of drafting this answer there was no clarity with respect to the actual data that should be represented on the map, I found it more informative to generate the desired functionality following the official example instead of trying to modify the provided code.
The thing worth noting is that the lat/lon values have to be of correct format to appear on the map.
The map setView to make the example more presentable but in an actual solution, default lat/lon values should be generated dynamically.
I was able to create an interactive geoChart using the scripts below though, the problem is that the scale to distinguish map color changes each day. My data set is a year worth of daily stats by every state in US.
For instance, for day 1, the scale takes min and max value of that particular day. But I'm trying to change the scripts so that the scale becomes constant for any given day (and shows min and max of the whole year).
Can anyone please advice how to do this? Thank you!
global.R
library(shiny)
states <- read.csv("queries_geo.csv")
states$StartDate <- as.Date(states$StartDate, "%m/%d/%Y")
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("PlayStation4 Search Volume Trend by States"),
sidebarLayout(
sidebarPanel(
sliderInput("StartDate", "Quarter",
min = min(states$StartDate),
max = max(states$StartDate),
value = min(states$StartDate),
step = 1,
animate = TRUE)),
mainPanel(
htmlOutput ("GeoStates")
))))
server.R
library(shiny)
library(dplyr)
library(googleVis)
shinyServer(function(input,output,session){
querydate <- reactive({
states_new <- states %>%
filter(StartDate == input$StartDate) %>%
select(Geo,Queries) %>%
arrange(Geo)})
output$GeoStates <- renderGvis ({
GeoStates <- gvisGeoChart(querydate(),
"Geo", #locationvar
"Queries", # colorvar
options = list(region = "US",
displayMode = "regions",
resolution = "provinces",
sizeAxis.maxValue = max(states$Queries),
sizeAxis.minValue = min(states$Queries),
width = 600,
height = 400)
)})})
I was able to figure this out. I'm posting my solution so that hopefully it saves someone else time in the future! Thank you for reading my question!
global.R => no change in this part
library(shiny)
states <- read.csv ("queries_geo.csv")
states$StartDate <- as.Date(states$StartDate, "%m/%d/%Y")
ui.R => significant changes happened in this part. Instead of creating a map chart in server.R and htmlOutput in ui.R, this code creates a map in ui.R. This way, the map scale stays constant and the animation works smoothly. server.R just feeds reactive data to the map chart in ui.R.
library(shiny)
library(googleVis)
library(googleCharts)
min_query <- min(states$Queries)
max_query <- max(states$Queries)
shinyUI(fluidPage(
# This line loads the Google Charts JS library
googleChartsInit(),
# https://developers.google.com/chart/interactive/docs/gallery/geochart
googleGeoChart("GeoStates",
width = 1000,
height = 600,
options = list(
fontSize = 13,
region = "US",
displayMode = "regions",
resolution = "provinces",
colorAxis = list(
maxValue = round(max_query, -3),
minValue = round(min_query, -1)
))),
fluidRow(
shiny::column(4, offset = 4,
sliderInput("StartDate",
"StartDate",
min = min(states$StartDate),
max = max(states$StartDate),
value = min(states$StartDate),
step = 60,
animate = TRUE)
))))
server.R
library(shiny)
library(dplyr)
library(googleVis)
shinyServer(function(input,output,session){
querydate <- reactive({
states_new <- states %>%
filter(StartDate == input$StartDate) %>%
select(Geo,Queries) %>%
arrange(Geo)
})
output$GeoStates <- reactive({
list(
data = googleDataTable(querydate())
)})})