I am creating a shiny application for DBSCAN of data consisting of geographical coordinates and use leaflet for showing these clusters on the map. My code is following.
ui <- fluidPage(
pageWithSidebar(
headerPanel('clustering of Data'),
sidebarPanel(
numericInput('eps', 'Please enter Eps value', 0.05),
numericInput('minpts', 'Please enter MinPts value', 10),
mainPanel(
leafletOutput('plot2')
)
)
)
server <- function(input, output, session) {
# Combine the selected variables into a new data frame
pp <- reactive({
dbscan(select(data, lat, lon), eps = input$eps, MinPts = input$minpts)
})
selectedData <- reactive({
data
})
output$plot2 <- renderLeaflet(
{
leaflet() %>%
addTiles() %>%
setView(lng = -93.232256, lat = 44.973692, zoom = 10) %>%
addMarkers(lat = as.numeric(selectedData()$lat),
lng = as.numeric(selectedData()$lon), color = color
)
}
)
}
shinyApp(ui = ui, server = server)
I guess I can perform the DBSCAN and get clusters, but I am not able to show these clusters with different color on the map using leaflet. Please help
Related
I am trying to create an interactive shiny application that displays a leaflet plot based on a user's date and plot type specification. Ideally, I would like the user to specify whether they would like to view a state-wide or a county-wide plot. Then, based on their answers, I would like them to decide whether to use the regular data or the standardized data. After this, they would hit a submit button and the plot would render. I don't want the plot to render until the user presses the "Submit" action button. This is my idea so far, but it fails whenever I try to implement.
library(ggplot2)
library(shapefiles)
library(sp)
library(CARBayes)
library(leaflet)
library(rgdal)
library(leaflet)
library(shiny)
## County Data
dta <- read.csv()
## County Data (percentage)
perc <-read.csv()
## Date Specification Function
selectdates <- function(data, start, end){
keep <- data[, 1:5]
data <- data[, -c(1:5)]
tmp1 <- as.Date(names(data))
tmp2 <- which(tmp1 >= as.Date(start) & tmp1 <= as.Date(end))
tmp <- data[, tmp2]
Sum <- rowSums(tmp)
tmp <- cbind(keep, Sum)
return(tmp)
}
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Mapping"),
tags$em(""),
tags$hr(),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
dateRangeInput("daterange", "Date Range:",
start = as.character(Sys.Date() - 6),
end = as.character(Sys.Date())),
selectInput("ptChoice", "Type of Plot:", choices = c("", "County-Wise", "State-Wise")),
selectInput("typeChoice", "Data Type:", choices = c("", "Raw", "Percentage")),
actionButton("submitButton", "Submit", class = "btn btn-primary")
),
# Display leaflet plot of cases
mainPanel(
leafletOutput("countyPlot"),
leafletOutput("statePlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
observeEvent(input$ptChoice, {
req(input$ptchoice)
if(input$ptChoice == "County-Wide"){
hide("statePlot")
show("countyPlot")
}
else{
hide("countyPlot")
show("statePlot")
}
})
fdta <- eventReactive(input$typeChoice, {
if (input$typeChoice == "Raw"){
df <- selectdates(data = tmp, start = input$daterange[1], end = input$daterange[2])
row.names(df) <- df$FIPS
}else if (input$typeChoice == "Percentage"){
df <- selectdates(data = perc, start = input$daterange[1], end = input$daterange[2])
}else {return(NULL)}
df
})
observeEvent(input$submitButton, {
output$statePlot <- renderLeaflet({
## INSERT STATE PLOT CODE HERE
})
output$countyPlot <- renderLeaflet({
## Loads SHP and DBF File
shp <- read.shp()
dbf <- read.dbf()
sp <- combine.data.shapefile(data = fdta, shp = shp, dbf = dbf)
proj4string(sp) <- CRS("+proj=longlat +datum=WGS84 +no_defs")
sp <- spTransform(sp, CRS("+proj=longlat +datum=WGS84 +no_defs"))
colours <- colorNumeric(palette = "YlOrRd", domain = sp#data$Sum)
leaflet(sp) %>%
addTiles() %>%
addPolygons(
fillColor = ~ colours(Sum),
weight = 1,
opacity = 0.7,
color = "white",
dashArray = '3',
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE
)
) %>%
addLegend(
pal = colours,
values = sp#data$Sum,
opacity = 1,
title = "Count"
) %>%
addScaleBar(position = "bottomleft")
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
You can put the two plots inside an observeEvent, if you want it only after someone clicks on submit button. To use the appropriate dataframe, create a reactive dataframe and then use it as dfa() to generate the appropriate plot. Try this
server = function(input, output) {
observeEvent(input$ptChoice,{
req(input$ptChoice)
if(input$ptChoice == "County-Wide"){
hide("statePlot")
show("countyPlot")
}else{
hide("countyPlot")
show("statePlot")
}
})
dfa <- eventReactive(input$typechoice, {
if (input$typechoice == "Regular") {
df <- dta
}else if (input$typechoice == "Standardized") {
df <- dta2
}else {return(NULL)}
df
})
observeEvent(input$submitButton,{
output$stateplot <- renderLeaflet({
state <- CODE FOR STATE PLOT
})
output$countyPlot <- renderLeaflet({
county <- CODE FOR COUNTY PLOT
})
})
}
You might want to have your leaflet plot be stored in reactiveValues (rv) - then, you can have one output for your plot, and show what is stored in rv.
To change the plot when the submit button is pressed, be sure to reference the input$submitButton with your observeEvent.
Here is a working example that can be adapted. You could use an additional function to generate the plots based on your input values.
library(ggplot2)
library(leaflet)
library(shiny)
ui = fluidPage(
titlePanel("Leaflet Plot"),
tags$em(""),
tags$hr(),
sidebarLayout(
sidebarPanel(
selectInput("plotChoice", "Type of Plot:", choices = c("", "Boston", "Chicago")),
actionButton("submitButton", "Submit", class = "btn btn-primary")
),
# Display leaflet plot of cases
mainPanel(
leafletOutput("leafletPlot")
)
)
)
server = function(input, output) {
rv <- reactiveValues(plot = NULL)
output$leafletPlot <- renderLeaflet({
rv$plot
})
observeEvent(input$submitButton, {
if (input$plotChoice == "Boston") {
rv$plot <- leaflet() %>% setView(lng = -71.0589, lat = 42.3601, zoom = 12) %>% addTiles()
} else {
rv$plot <- leaflet() %>% setView(lng = -87.6298, lat = 41.8781, zoom = 12) %>% addTiles()
}
})
}
shinyApp(ui = ui, server = server)
I want to display my marker labels based on zoom level.
Based on (https://rstudio.github.io/leaflet/shiny.html) I tried to use "input$MAPID_zoom". In my example, labels stored in location_name should be displayed when zoom level (mapscale) is lower to 6.
What I tried :
library(shiny)
library(leaflet)
# my data
df <- data.frame(
location_name = c('S1', 'S2'),
lng = c(-1.554136, -2.10401),
lat = c(47.218637, 47.218637),
stringsAsFactors = FALSE)
# UI
ui <- shinyUI(fluidPage(
leafletOutput('map')
))
# server
server <- shinyServer(function(input, output, session) {
mapscale <- observe({
input$map_zoom # get zoom level
})
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addMarkers(data=df, lng = ~lng, lat = ~lat,
label =~if(mapscale<6, location_name))
})
})
shinyApp(ui = ui, server = server)
A few remarks on your code if you like.
If you wrap the zoom in a reactive function, reference it like mapscale(). Use the normal if statement in R and the ~ in front of the variable. Then you should be fine.
Reproducible example:
library(shiny)
library(leaflet)
df <- data.frame(
location_name = c('S1', 'S2'),
lng = c(-1.554136, -2.10401),
lat = c(47.218637, 47.218637),
stringsAsFactors = FALSE
)
ui <- shinyUI(
fluidPage(
leafletOutput(outputId = 'map')
)
)
server <- shinyServer(function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles()
})
observeEvent(
eventExpr = input$map_zoom, {
print(input$map_zoom) # Display zoom level in the console
leafletProxy(
mapId = "map",
session = session
) %>%
clearMarkers() %>%
addMarkers(
data = df,
lng = ~lng,
lat = ~lat,
label = if(input$map_zoom < 6) ~location_name
)
}
)
})
shinyApp(
ui = ui,
server = server
)
I am very new to shiny, and I have a question.
I have a simple dataset with observations (Number_Total) of species (Species), in a certain location (X,Y).
I would like to generate a map, that enables you to select the species in a dropdown menu. Shiny then shows you were the species occurs on the map.
I got pretty far (for my experience), but selecting species in the menu does not do anything...
ui <- (fluidPage(titlePanel("Species Checker"),
sidebarLayout(
sidebarPanel(
selectizeInput('species', 'Choose species',
choices = df$Species, multiple = TRUE)
),
mainPanel(
leafletOutput("CountryMap",
width = 1000, height = 500))
)
))
The server side
server <- function(input, output, session){
output$CountryMap <- renderLeaflet({
leaflet() %>% addTiles() %>%
setView(lng = 10, lat = 40, zoom = 5) %>%
addCircles(lng = df$Y, lat = df$X, weight = 10,
radius =sqrt(df$Number_Total)*15000, popup = df$Species)
})
observeEvent(input$species, {
if(input$species != "")
{
leafletProxy("CountryMap") %>% clearShapes()
index = which(df$Species == input$species)
leafletProxy("CountryMap")%>% addCircles(lng = df$X[index],
lat = df$Y[index],
weight = 1,
radius =sqrt(df$Number_Total[index])*30, popup = df$Species[index])
}
})
}
And finally plot it
shinyApp(ui = ui, server = server)
I know my code is probably messy, but again, I blaim my experience =)
I did not manage to get an example dataset in here right away, so here it comes as picture
This is the result of the above code (with slightly different data)
enter image description here
Here's what you need. I think you are skilled enough to understand this but comment if you have any questions.
server <- function(input, output, session) {
# map_data <- reactive({
# req(input$species)
# df[df$Species %in% input$species, ]
# })
output$CountryMap <- renderLeaflet({
leaflet() %>% addTiles() %>%
setView(lng = 10, lat = 40, zoom = 5)
})
map_proxy <- leafletProxy("CountryMap")
observe({
md <- df[df$Species %in% input$species, ]
map_proxy %>%
addCircles(lng = md$Y, lat = md$X, weight = 10,
radius = sqrt(md$Number_Total)*15000, popup = md$Species)
})
}
I have a shiny app, where I want to plot CircleMarkers on a leaflet map. Additionally a marker should be plotted, controlled over an overlayGroup. When the zoom level is greater than 7 the marker should be plotted otherwise not. This is done by sending code to the server and getting the index of the marker. See also here: Show layer in leaflet map in Shiny only when zoom level > 8 with LayersControl?
It works fine, but when I add the addSearchOSM plugin from leaflet.extras the CircleMarkers will not be plotted anymore when the app starts. So the observe statement will not be rendered until I change an input.
This is the code:
library(leaflet)
library(leaflet.extras)
library(shiny)
data <- data.frame(longitude = c(11.43, 11.55), latitude = c(48, 48.5), label = c("a", "b"))
getInputwithJS <- '
Shiny.addCustomMessageHandler("findInput",
function(message) {
var inputs = document.getElementsByTagName("input");
console.log(inputs);
Shiny.onInputChange("marker1", inputs[1].checked);
}
);
'
ui <- fluidPage(
sidebarPanel(
selectInput("label", "label", selected = "a", choices = data$label)
),
mainPanel(
leafletOutput("map", width = "100%", height = "700"),
tags$head(tags$script(HTML(getInputwithJS)))
)
)
server <- function(input, output, session){
# subset data according to label input
data_subset <- reactive({
data[data$label %in% input$label, ]
})
output$map <- renderLeaflet({
leaflet() %>% addTiles() %>% setView(11, 48.5, 7) %>%
addLayersControl(overlayGroups = c("marker1"),
options = layersControlOptions(collapsed = FALSE)) %>%
addSearchOSM()
})
# does not show points when app starts
observe({
leafletProxy("map") %>% clearGroup("points") %>%
addCircleMarkers(data_subset()$longitude, data_subset()$latitude, group = "points")
})
global <- reactiveValues(DOMRdy = FALSE)
autoInvalidate <- reactiveTimer(1000)
observe({
autoInvalidate()
if(global$DOMRdy){
session$sendCustomMessage(type = "findInput", message = "")
}
})
session$onFlushed(function() {
global$DOMRdy <- TRUE
})
# add marker if marker is clicked in layerscontrol and zoom level of map > 7
observe({
if (!is.null(input$marker1)){
if (input$marker1 == TRUE){
if (input$map_zoom > 7) {
leafletProxy("map") %>% addMarkers(lng = 11.2, lat = 48, group = "marker1")
}else{
leafletProxy("map") %>% clearGroup(group = "marker1")
}
}
}
})
}
shinyApp(ui, server)
I am trying to create a shiny app where I can select the value that I want to plot into my map. It might be that this is a very easy task but I am new in Shiny and I can't figure it out.
I don't understand whether I have to use selectInput or if leaflet has a different way to interact with Shiny.
This is my code
library(RColorBrewer)
library(rgdal)
library(shiny)
pal <- colorQuantile("YlGn", NULL, n = 5)
state_popup <- paste0("<strong>State: </strong>",
africa$COUNTRY,
"<br><strong>Resource Revenue(IMF)</strong>",
africa$Africa_r_1)
leaflet_africa <- leaflet(data = africa) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(fillColor = ~pal(Africa_r_1),
fillOpacity = 0.8,
color = "#BDBDC3",
weight = 1,
popup = state_popup)
ui <- fluidPage(
leafletOutput("map1")
)
server <- function(input, output, session) {
output$map1 <- renderLeaflet({
leaflet_africa
})
}
shinyApp(ui = ui, server = server)