I can't get a leaflet map to render in my shiny app, although the code works by itself outside of shiny. I do not get any errors so I am stuck, any help is appreciated.
Sample Data:
cleanbuffalo <- data.frame(name = c("queen","toni","pepper"),
longitude = c(31.8,32,33),
latitude = c(-24,-25,-26))
Shiny UI:
vars <- c(
"Pepper" = "pepper",
"Queen" = "queen",
"Toni" = "toni"
)
shinyUI(navbarPage("Buffalo Migration", id ="nav",
tabPanel("Interactive Map",
div(class="outer",
leafletOutput("map", width = "100%", height = "100%"),
#Panel Selection
absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
width = 330, height = "auto",
h2("Buffalo Migration"),
#Buffalo Group selection
checkboxGroupInput(
"checkGroup", label = h3("Select Buffalo to Follow"),
choices = vars,
selected = 1)
)
)
)
)
)
Shiny Server:
library(shiny)
library(dplyr)
library(leaflet)
library(scales)
library(lattice)
shinyServer(function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>% addTiles() %>% setView(lng = 31.88, lat = -25.02, zoom=1)
})
It doesn't work because of the height parameter in leafletOutput. Strangely, if you specify it in % the map doesn't show up, but if you use "px" (or a number which will be coerced to a string and have "px" appended) it does work fine.
leafletOutput("map", width = "75%", height = "500px") yields:
I don't know why this happens but if you wanted to specify the height of the leafletOutput in % you could wrap it into a div and give it the appropriate height.
By default the width is set to 100% and the height to 400px. So, you don't have to specify these parameters - I would do it only if I wanted to change the size of the output.
leafletOutput(outputId, width = "100%", height = 400)
Related
Problem: I want to add a second picture to the top right corner in the header. Currently, I am able to place one in the top left corner but not in the top right.
Any suggestions how to do that?
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
header = dashboardHeader( titleWidth = NULL,
title = tags$b("Testapp",
tags$a(href = 'https://www.google.com/',
tags$img(src = 'mick.png', height = 50, width = 50, align = "left"))
),
## QUESTION: how can I add the picture to the top right corner
tags$head(tags$img(src = 'mick.png', height = 50, width = 50, align = "right"))
),
dashboardSidebar(),
dashboardBody()
)
server <- function(input, output) { }
shinyApp(ui, server)
Shinydashboard expects a li element with class dropdown. If we give it that (replace tags$head(...) with the below):
tags$li(tags$img(src = 'mick.png', height = 50, width = 50, align = "right"), class = "dropdown")
it works.
I'm building an interactive map with Shiny and I'm currently trying to hide my UI elements in a dropdownButton from the shinyWidgets pkg.
My problem is that so far I can either have the dropdownButton working and having to remove the width = "100%", height = "100%" from my leafletOutput
OR
having my map as I want it and the dropdownButton being invisible.
Is there a way of having both? Thanks!
Here's a reprex:
library(shiny)
library(leaflet)
library(RColorBrewer)
library(shinyWidgets)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
dropdownButton(sliderInput("range", "Magnitudes", min(quakes$mag), max(quakes$mag),
value = range(quakes$mag), step = 0.1
),
selectInput("colors", "Color Scheme",
rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
),
checkboxInput("legend", "Show legend", TRUE)
)
)
server <- function(input, output, session) {
# Reactive expression for the data subsetted to what the user selected
filteredData <- reactive({
quakes[quakes$mag >= input$range[1] & quakes$mag <= input$range[2],]
})
# This reactive expression represents the palette function,
# which changes as the user makes selections in UI.
colorpal <- reactive({
colorNumeric(input$colors, quakes$mag)
})
output$map <- renderLeaflet({
# Use leaflet() here, and only include aspects of the map that
# won't need to change dynamically (at least, not unless the
# entire map is being torn down and recreated).
leaflet(quakes) %>% addTiles() %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))
})
# Incremental changes to the map (in this case, replacing the
# circles when a new color is chosen) should be performed in
# an observer. Each independent set of things that can change
# should be managed in its own observer.
observe({
pal <- colorpal()
leafletProxy("map", data = filteredData()) %>%
clearShapes() %>%
addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag)
)
})
# Use a separate observer to recreate the legend as needed.
observe({
proxy <- leafletProxy("map", data = quakes)
# Remove any existing legend, and only if the legend is
# enabled, create a new one.
proxy %>% clearControls()
if (input$legend) {
pal <- colorpal()
proxy %>% addLegend(position = "bottomright",
pal = pal, values = ~mag
)
}
})
}
shinyApp(ui, server)
Instead of setting html width and height, you can put the map in a full page container like this :
ui <- bootstrapPage(
tags$style(type = "text/css", ".map-container {position:absolute; top:0; bottom:0; right:0; left:0;}"),
tags$style(type = "text/css", "#dropdown {margin-top: 80px; margin-left: 10px;}"),
tags$div(
class = "map-container",
leafletOutput("map", width = "100%", height = "100%")
),
dropdownButton(
inputId = "dropdown",
icon = icon("gears"),
circle = FALSE,
sliderInput("range", "Magnitudes", min(quakes$mag), max(quakes$mag),
value = range(quakes$mag), step = 0.1
),
selectInput("colors", "Color Scheme",
rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
),
checkboxInput("legend", "Show legend", TRUE)
)
)
I'm trying to make a render a text output with an automatic scrollbar that is activated when the text becomes too wide or long. For the moment I achieved the scrollbar on the x-axis with container=pre as an argument in the Textoutput in the UI.
What I would want is that the output in the text output limits itself to 4 or 5 rows and then to have a scrollbar in order to see the remaining rows.
I looked at all the posts that I could find for the topic (that's why I implemented the container=pre) but I couldn't find a way to solve the y-axis scrollbar. I understand that it has something to do with overflow y: "auto" in the tags' settings but I can't make it work out, maybe I'm placing it wrong.
Thank you.
Here's an example:
# Shiny example
library(shinydashboard)
library(shiny)
library(stringi)
library(shinyWidgets)
# Data
# Some random letters
names<- stringi::stri_rand_strings(100,20)
# Some random numbers
numbers<- runif(100,0,100000)
# a df
df<- as.data.frame(cbind(names, numbers))
shinyApp(
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
absolutePanel(id="panel", fixed = FALSE,
draggable = F, top = 80, left = "auto", right = 60, bottom = "auto",
width = 290, height = 370,
box( title = "Box example",
status = "warning", width = 230, solidHeader = T,
pickerInput(
inputId = "select_nb_names",
choices = names,
multiple = TRUE,
selected = NULL,
width = 190,inline = FALSE),
# the textoutput that only has an x-axis scrollbar
textOutput("TextThatIWantToHaveAScroll",container = pre ))))),
server <- function(input, output, session) {
output$TextThatIWantToHaveAScroll<- renderText(
paste0( input$select_nb_names," : ",df$numbers[df$names%in%input$select_nb_names],"\n"))
}
# Run the application
)
You can add a scrolls using CSS. In shiny, use the tags$style tag to define the css properties and wrap in a tags$head tag. You can either target element using the ID of the output element (i.e.,#TextThatIWantToHaveAScroll), the shiny class for text outputs (i.e., shiny-text-output), or the tag name (i.e., pre). If you have more than one element that should receive the same treatment, then using .shiny-text-output is a better option.
To create a scroll for the desired element (as in the example; using ID), set the height and width properties first, and then use the overflow: scroll. For example:
#TextThatIWantToHaveAScroll {
width: 100%;
height: 60px;
overflow: scroll;
}
Adjust the height and width as needed. There are other scroll options available. See Mozilla's CSS guide on the overflow property. Here's the full example:
# Shiny example
library(shinydashboard)
library(shiny)
library(stringi)
library(shinyWidgets)
# Data
# Some random letters
names<- stringi::stri_rand_strings(100,20)
# Some random numbers
numbers<- runif(100,0,100000)
# a df
df<- as.data.frame(cbind(names, numbers))
shinyApp(
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$head(
tags$style(
"#TextThatIWantToHaveAScroll {
width: 100%;
height: 60px;
overflow: scroll;
}"
),
),
absolutePanel(id="panel", fixed = FALSE,
draggable = F, top = 80, left = "auto", right = 60, bottom = "auto",
width = 290, height = 370,
box( title = "Box example",
status = "warning", width = 230, solidHeader = T,
pickerInput(
inputId = "select_nb_names",
choices = names,
multiple = TRUE,
selected = NULL,
width = 190,inline = FALSE),
# the textoutput that only has an x-axis scrollbar
textOutput("TextThatIWantToHaveAScroll",container = pre))))),
server <- function(input, output, session) {
output$TextThatIWantToHaveAScroll<- renderText(
paste0( input$select_nb_names," : ",df$numbers[df$names%in%input$select_nb_names],"\n"))
}
# Run the application
)
I am trying to make a textAreaInput box in shiny that spans 100% of my webpage and resizes when the browser is min/maximised. I can make a simple textInput with this behavior by supplying the argument width = 100%. Supplying the same argument to textAreaInput does not produce the same behavior even though width has the same description on the textInput and textAreaInput man pages. Is this desired behavour or a bug?
A minimal working example -
library(shiny)
shinyApp(
#UI
ui = fluidPage(
fluidRow(
column(12,
textAreaInput("big_box", "Big box", value = "", width = '100%', rows = 5, resize = "both")
)
),
fluidRow(
column(12,
textInput("long_box", "Long box", value = "", width = '100%')
)
)
),
#Server
server = function(input, output) {
}
)
Example output -
Cheers
A simpler workaround is to set the height and width parameters to the parent element, using shiny::tagAppendAttributes function.
For example:
textAreaInput("big_box", "Big box", value = "", rows = 5, resize = "both") %>%
shiny::tagAppendAttributes(style = 'width: 100%;')
Or you could just override the css by using a header tag within your ui function e.g:
tags$style(HTML("
.shiny-input-container:not(.shiny-input-container-inline) {
width: 100%;
}"))
textAreaInput was recently added to Shiny in version 14, it seems that it is a bug cause by the class shiny-input-container. In shiny.css we can find:
/* Limit the width of inputs in the general case. */
.shiny-input-container:not(.shiny-input-container-inline) {
width: 300px;
max-width: 100%;
}
The simplest workaround is to create a new function based on the original without the class shiny-input-container. Below is the new function.
library(shiny)
#based on Shiny textAreaInput
textAreaInput2 <- function (inputId, label, value = "", width = NULL, height = NULL,
cols = NULL, rows = NULL, placeholder = NULL, resize = NULL)
{
value <- restoreInput(id = inputId, default = value)
if (!is.null(resize)) {
resize <- match.arg(resize, c("both", "none", "vertical",
"horizontal"))
}
style <- paste("max-width: 100%;", if (!is.null(width))
paste0("width: ", validateCssUnit(width), ";"), if (!is.null(height))
paste0("height: ", validateCssUnit(height), ";"), if (!is.null(resize))
paste0("resize: ", resize, ";"))
if (length(style) == 0)
style <- NULL
div(class = "form-group",
tags$label(label, `for` = inputId), tags$textarea(id = inputId,
class = "form-control", placeholder = placeholder, style = style,
rows = rows, cols = cols, value))
}
shinyApp(
#UI
ui = fluidPage(
fluidRow(
column(12,
textAreaInput2("big_box2", "Big box", value = "", width = '100%', rows = 5, resize = "both")
)
),
fluidRow(
column(12,
textInput("long_box", "Long box", value = "", width = '100%')
)
)
),
#Server
server = function(input, output) {
}
)
I am trying to change the base layer in my Shiny App in a programatic way.
Since I don't want to use the LayerControl of 'Leaflet' and rather want to have all the controls in one panel. I decided to use shinyjs and go with the toggleState for a button to switch forth and back between two base layers.
At the moment I am in the phase to figure out the principles of changing the base layer, and since there can be only one base layer visible it seem like I have to remove the tiles of the initially loaded base layer.
Doing so I can change the base layer at display, but at the same time the base layer is changed I am loosing the overlay. How can I avoid that?
When using the button again I can see in the flicker that the overlay is still there, but not on top of the base layer anymore.
Here an example:
library(shiny)
library(leaflet)
library(shinydashboard)
# Definition of Sidebar elements
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Maps", tabName = "maps", icon = icon("globe"),
menuSubItem(
HTML(paste("Diffuse kilder NH", tags$sub("3"), sep = "")),
tabName = "map_dif_nh3", icon = icon("map-o"), selected = TRUE
)
)
)
)
# Definition of body elements
body <- dashboardBody(
tabItems(
tabItem(tabName = "map_dif_nh3",
box(
width = 12,
div(style = "height: calc(100vh - 80px);",
leafletOutput(
"m_dif_nh3", width = "100%", height = "100%"
),
absolutePanel(id = "nh3_panel", class = "panel panel-default",
fixed = TRUE, style = "opacity: 0.87",
top = 80, left = "auto", right = 50, bottom = "auto",
width = 285, height = "auto",
fluidRow(
column(width = 10, offset = 1,
actionButton(inputId = 'btn_bgr_nh3', label = "", icon = icon("globe", class = "fa-lg"))
)
)
)
)
)
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Mixed layout"),
sidebar,
body
)
server <- function(input, output) {
init_lat <- 56.085935208960585
init_lon <- 10.29481415546154
init_zoom <- 7
output$m_dif_nh3 <- renderLeaflet({
leaflet(height = "100%") %>%
addProviderTiles("Stamen.Toner", layerId = 'mb_osm', group = "base") %>%
setView(init_lon, init_lat, init_zoom) %>%
addWMSTiles(
"http://gis.au.dk/geoserver_test/PRTR/gwc/service/wms",
layers = "PRTR:prtr_nh3_2014",
layerId = "nh3_2014",
group = "overlay",
options = WMSTileOptions(format = "image/png",
transparent = TRUE, opacity = 0.8
)
)
})
observeEvent(
input$btn_bgr_nh3, {
leafletProxy("m_dif_nh3") %>%
addProviderTiles("Esri.WorldImagery", layerId = 'mb_pic', group = 'base')
leafletProxy("m_dif_nh3") %>%
removeTiles(layerId = 'mb_osm')
}
)
}
shinyApp(ui, server)
I think what you can do is reset the value of ID the action button to 0 after clicking the button. Therefore, every time you toggle the ID value will be replaced by 0. It worked for me. Hope it work for you as well.
In Leaflet JS (I don't know about R), if myTileLayer is already part of your base layers, then myTileLayer.addTo(map) does the switching job. It doesn't add on top; and you don't need to remove the current layer. The overlay remains unaffected.
Ref: https://stackoverflow.com/a/33762133/4355695