I have a simple shiny-app with just a dropdown listing districts of Afghanistan and a leaflet map of the same.
The shape file can be accessed at this link - using AFG_adm2.shp from http://www.gadm.org/download
here's the app code:
library(shiny)
library(leaflet)
library(rgdal)
library(sp)
afg <- readOGR(dsn = "data", layer ="AFG_adm2", verbose = FALSE, stringsAsFactors = FALSE)
ui <- fluidPage(
titlePanel("Test App"),
selectInput("yours", choices = c("",afg$NAME_2), label = "Select Country:"),
leafletOutput("mymap")
)
server <- function(input, output){
output$mymap <- renderLeaflet({
leaflet(afg) %>% addTiles() %>%
addPolylines(stroke=TRUE, color = "#00000", weight = 1)
})
proxy <- leafletProxy("mymap")
observe({
if(input$yours!=""){
#get the selected polygon and extract the label point
selected_polygon <- subset(afg,afg$NAME_2==input$yours)
polygon_labelPt <- selected_polygon#polygons[[1]]#labpt
#remove any previously highlighted polygon
proxy %>% removeShape("highlighted_polygon")
#center the view on the polygon
proxy %>% setView(lng=polygon_labelPt[1],lat=polygon_labelPt[2],zoom=7)
#add a slightly thicker red polygon on top of the selected one
proxy %>% addPolylines(stroke=TRUE, weight = 2,color="red",data=selected_polygon,layerId="highlighted_polygon")
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
I want a infoBox or valueBox like widget from shinyDashboard to display some data(like district population) below the map based on user selection. How can I do this?
You can mimic the shinydashboard::infoBox with your own function:
create function
myInfoBox <- function(title, value)
{
div(
div(class='myinfobox-title', title),
div(class='myinfobox-value', value)
)
}
use uiOutput() whenever you want to place it e.g. uiOutput('idOfInfoBox')
in server part use e.g. output$idOfInfoBox <- renderUI(myInfoBox(title, value)
add .css file in www/ directory and add some properties for classes myinfobox-title and myinfobox-value
I hope this helps.
You need to change the structure of the program and need to add dashboard page in UI.
Here are some reference just have a look. you will get to know!!!
https://rstudio.github.io/shinydashboard/structure.html
https://rdrr.io/cran/shinydashboard/man/valueBox.html
Related
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
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.
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 have a bunch of points on a map with some associated data.
First, I want to filter those points by their attributes. That works fine, but recently when I run the app and fiddle with the filters, eventually it stops removing the previously filtered points and just loads the newly filtered points on top. This has been happening after about 10 adjustments to the filter. It is as if the clearMarkers() function stops working. The filtered data will also show up in a reactive data.table (that part works fine, didn't include it in the example).
Second, I want to click on points to select them. Data from the selected points will go in to some graphs later. I can definitely select one point, but I am having trouble keeping a reactive variable of all clicked points. Also, a selected point should become unselected if clicked again. The selected points will be highlighted on the map (by adding bigger brighter markers on them), and in the reactive data.table, and the selection should update following clicks in the map and clicks in the table. But that is a few steps down the line.
Here is some sample code, which does not work.
library(sp)
library(leaflet)
library(shiny)
data <- data.frame(x = c(10,20,30,10,40), y = c(20,20,10,30,30), z = c(1,2,3,4,5))
points <- SpatialPointsDataFrame(data[,1:2],data[3])
server <- function(input, output, session) {
filtered <- reactive({
z.in <- input$z
points[points#data$z > z.in,]
})
selected <- reactiveValues()
output$map <- renderLeaflet({leaflet()})
observe({ # This observer works, but it seems to stop working about about 10 tries
leafletProxy("map") %>%
clearMarkers() %>%
addCircleMarkers(data = filtered())
})
observe({ # This observer does not work, and the app won't run unless you comment it out
clicked <- unlist(input$map_marker_click[3:4])
if (is.na(clicked)) {selected <- clicked}
else if (clicked %in% selected) {selected <- selected[-clicked]}
else {selected <- append(selected, clicked)}
})
}
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10,left = 10,
sliderInput("z", "z",0,6,0)
))
shinyApp(ui = ui, server = server)
The crosstalk package addresses this.
https://rstudio.github.io/crosstalk/