i am trying to use shiny dashboard with leaflet package. I tried using "SelectInput" function in the dashboard to create reactive map based on the input selected(geoArea).However, i am not able to make the leaflet and the SelectInput connect with each other.
I also wanted to distinguish two groups in my dataset and plot it in leaflet/shiny (column name "up.and.down" has positive and negative values).In Base R i could do it using filter option from the tidyverse package and give distinct colour to each but however i am not sure how this works in Shinydashboard. Any help in regards will be much appreciated.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(leaflet)
library(tidyverse)
datafile<- read.csv("/Users/prabeshkc/Desktop/stackoverflow data.csv")
`ui<- dashboardPage(
skin = "blue",
dashboardHeader(title = "Cluster Map"),
dashboardSidebar(
selectInput("Area",label = "Geo Area",
choices = datafile$geoArea)
),
dashboardBody(
fluidRow(box(width = 12,leafletOutput(outputId = "mymap")))
))`
`server <- function(input, output) {
data_input<-reactive({
datafile %>%
leaflet() %>%
addTiles() %>%
addMarkers(lng = datafile$lng,lat = datafile$lat)
})
data_input_ordered<-reactive({
data_input()[order(match(data_input)$geoArea)]
})`
`labels<- reactive({
paste("<p>", datafile$goals,"</p>"),
paste("<p>", datafile$achieved,"</p>")
})`
`output$mymap<- renderLeaflet(
datafile %>%
leaflet() %>%
addTiles() %>%
addCircleMarkers(lng = datafile$lng,lat = datafile$lat)
)
}
shinyApp(ui = ui, server = server)`
Try this one:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(leaflet)
library(tidyverse)
datafile<-read.csv("/Users/prabeshkc/Desktop/stackoverflow data.csv") %>%
mutate(color=ifelse(up.and.down<0,"red","blue"))
ui<- dashboardPage(
skin = "blue",
dashboardHeader(title = "Cluster Map"),
dashboardSidebar(
selectInput("Area",label = "Geo Area",
choices = datafile$geoArea)
),
dashboardBody(
fluidRow(box(width = 12,leafletOutput(outputId = "mymap")))
))
server <- function(input, output) {
output$mymap<- renderLeaflet({
validate(need(datafile,"Add file"))
validate(need(input$Area,"Select Area"))
datafile %>%
filter(geoArea %in% input$Area) %>%
leaflet() %>%
addTiles() %>%
addCircleMarkers(lng = ~lng,lat = ~lat,color=~color,
popup = ~paste(paste0("Goals - ",goals),paste0("Achieved - ",achieved), sep="<br>"))
})
}
shinyApp(ui = ui, server = server)
Related
I'm currently using addSearchOSM() from the leaflet.extras package to search addresses:
How can I change the colour of the circle marker? Will accept CSS solutions as well - I attempted to manually update the .leaflet-interactive{} css, but that changes all interactive elements, including polygons.
Reproducible example here:
library(shiny)
library(leaflet)
library(tidyverse)
library(leaflet.extras)
ui <- fluidPage(
fluidRow(
column(
width = 12,
leafletOutput("map")
)
)
)
server <- function(input, output) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(
lng = -73.9888,
lat = 40.72905,
zoom = 12
) %>%
addSearchOSM()
})
}
# Run the application
shinyApp(ui = ui, server = server)
I'm attempting to add markers to a map, however for some reason the marker icon no longer renders:
Here's a reproducible example shiny app:
library(shiny)
library(tidyverse)
library(leaflet)
ui <- fluidPage(
# Application title
titlePanel("Leaflet example"),
leafletOutput("example")
)
server <- function(input, output) {
output$example <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$Esri.WorldGrayCanvas) %>%
setView(lng = -71.0589, lat = 42.3601, zoom = 15) %>%
addMarkers(
lng = -71.0589,
lat = 42.3601
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I can't find any documentation on how to add a tooltip with addPulseMarkers above the Layer Control (using leaflet.extras). See below for an example of what I'd aiming to do.
library(shiny)
library(leaflet)
library(leaflet.extras)
ui <- fluidPage(
leafletOutput("map")
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet(quakes) %>%
addPulseMarkers(lng = ~long, lat = ~lat,
icon = makePulseIcon(color = "blue", heartbeat = 2),
group = "I want a tooltip on hover above this that says, 'Nice'") %>%
addLayersControl(
overlayGroups = c("I want a tooltip on hover above this that says, 'Nice'"),
options = layersControlOptions(collapsed = FALSE)
)
})
}
shinyApp(ui, server)
Do you mean like this?
library(shiny)
library(leaflet)
library(leaflet.extras)
ui <- fluidPage(
leafletOutput("map")
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet(quakes) %>%
addPulseMarkers(lng = ~long, lat = ~lat,
icon = makePulseIcon(color = "blue", heartbeat = 2),
group = "I want a tooltip on hover above this that says, 'Nice'") %>%
addLayersControl(
overlayGroups = c("I want a tooltip on hover above this that says, 'Nice'"),
options = layersControlOptions(collapsed = FALSE)
) %>%
htmlwidgets::onRender("
function() {
$('.leaflet-control-layers-overlays').prepend('<label style=\"text-align:center\">Nice</label>');
}
")
})
}
shinyApp(ui, server)
It borrows from: Add title to layers control box in Leaflet using R
I created a shiny app with leaflet and it works pretty well.
library(shiny)
library(shinythemes)
library(leaflet)
ui2 <- fluidPage(theme = shinytheme("united"), tabsetPanel(
tabPanel(
titlePanel("titel"),
mainPanel(
leafletOutput(outputId = "mymap")),
sidebarPanel(
fluidRow(
dateRangeInput("a", h4("date"),language = "en",separator = " to "),
selectInput("select", h4("location"),
c(data8$city)),
submitButton("search"))
))
)
)
server <- function(input, output) {
popupa <- paste(titel)
output$mymap <- renderLeaflet({
leaflet(data8) %>%
addTiles() %>%
addMarkers(lng = ~lng, lat = ~lat, popup = popupa)
})
}
shinyApp(ui2, server)
But at the moment I am trying to add a dateRangeInput to filter(date_start) on my shown locations. But I don't know how to connect my dateRangeInput and the selectInput to my leaflet-function in the server-part. Furthermore, below the map there should be a table with the filtered locations from the map - is this possible at all?
My used dataframe looks like following:
title=c("Event1","Event2")
lng=c(23.3, 23.3)
lat=c(30, 40)
city=c("Berlin", "Hamburg" )
zip=c(39282, 27373)
date_start=c("2018-05-28","2018-05-28")
date_end=c("2018-06-27","2018-08-03")
data8 <- data.frame(title, lng, lat, city, zip, date_start, date_end)
Does anyone know how to get this done? Thanks for every help!
regards
You could try this:
ui2 <- fluidPage(theme = shinytheme("united"), tabsetPanel(
tabPanel(
titlePanel("titel"),
mainPanel(
leafletOutput(outputId = "mymap"),
dataTableOutput("mytable")),
sidebarPanel(
fluidRow(
dateRangeInput("a", h4("date"),language = "en",separator = " to "),
selectInput("selectLoc", h4("location"),
as.character(data8$city)),
submitButton("search"))
))
)
)
server <- function(input, output) {
popupa <- paste("titel")
datatoPlot <- reactive({
date_start <- as.character(input$a[1])
date_end <- as.character(input$a[2])
data8$date_start <- as.Date(data8$date_start, format = "%Y-%m-%d")
data8 <- data8[as.Date(data8$date_start) >= date_start & as.Date(data8$date_start) <= date_end, ]
data8 <- data8 %>% dplyr::filter(city == input$selectLoc)
})
output$mymap <- renderLeaflet({
leaflet(datatoPlot()) %>%
addTiles() %>%
addMarkers(lng = ~lng, lat = ~lat, popup = popupa)
})
output$mytable <- renderDataTable(datatoPlot())
}
shinyApp(ui2, server)
I am sort of struggling to display clusters of positions on a tabPanel map, when on another tabPanel, a heatmap is active.
The weird thing is that when I remove the second tabPanel (heatmap) in the ui.R, then the clusters are shown ok on the first tabPanel.
If I keep the heatmap tabPanel in the ui.R and remove "clusterOptions = markerClusterOptions()" in the server.R then the positions are displayed on the first tabPanel and heat map is OK.
Here is my code so you can easily reproduce the problem :
global.R
library(shiny)
library(shinydashboard)
library(leaflet)
library(dplyr)
library(plyr)
library(rCharts)
Lat <- c(48.89612,48.87366,48.88739,48.88558,48.87561)
Long <- c(2.383857,2.383921,2.387161,2.386701,2.387337)
data_test <- data.frame(Lat,Long)
data_test <- ddply(data_test, .(Lat, Long), summarise, count = length(Lat))
server.R
library(rCharts)
library(shiny)
library(shinydashboard)
library(leaflet)
library(dplyr)
library(plyr)
shinyServer(function (input, output){
output$map1 <- renderLeaflet({
leaflet() %>% setView(lng = 2.3488000, lat = 48.8534100, zoom = 12) %>%
addProviderTiles('CartoDB.Positron') %>%
addTiles() %>%
addCircleMarkers(lng = data_test$Long, lat = data_test$Lat,color=
'red',
clusterOptions = markerClusterOptions())
})
output$baseMap <- renderMap({
map2 = Leaflet$new()
map2$setView(c(48.85341,2.34880,13))
map2$addParams(height = 590, width = 880, zoom = 12)
map2$set(dcom = "baseMap")
return(map2)
})
output$heatMap <- renderUI({
j <- paste0("[",data_test[,"Lat"], ",", data_test[,"Long"],
",",data_test[,"count"], "]", collapse=",")
j <- paste0("[",j,"]")
tags$body(tags$script(HTML(sprintf("
var addressPoints = %s
if (typeof heat === typeof undefined) {
heat = L.heatLayer(addressPoints, {radius:
50,blur: 20,maxZoom: 5,max: 6.0,
gradient: {0.0: 'green',0.5: 'yellow',1.0:
'red' }}),
heat.addTo(map)}
else {heat.setLatLngs(addressPoints)}", j
))))
})
})
ui.R
library(rCharts)
library(shiny)
library(shinydashboard)
library(leaflet)
library(dplyr)
library(plyr)
header <- dashboardHeader(
title = "Test Paris", titleWidth = 450
)
body <- dashboardBody(
fluidRow(
column(width = 12,
tabBox(width = 12,
id = "CartePrincipale",
tabPanel("Map of Accidents",leafletOutput("map1", height="590px")),
tabPanel("HeatMap of Accidents",
showOutput("baseMap", "Leaflet"),
tags$style(' .leaflet {height: "590px";}'),
tags$head(tags$script(src="http://leaflet.github.io/Leaflet.heat/dist/leaflet-heat.js")),
uiOutput("heatMap"))
)))
)
dashboardPage(
header,
dashboardSidebar(disable = TRUE),
body)
Is there a conflict somewhere with rCharts?
Many thanks for your assistance !
Well, I finally came across the answer, thanks to a few posts and replies from Ramnath to other people issues in the website.
In the ui.r, for the second tabPanel, the trick was just to replace
showOutput("baseMap", "Leaflet")
by :
htmlOutput("baseMap")
Clusters are now displayed Ok on the first tabPanel !