I am producing a Shiny interactive document. I wish to give the user the option of displaying a map conditional on checkbox status, and that map has some reactive content. I am able to achieve this, but not without the space that the map occupies remaining when it is not displayed. I believe this is also true of a plot instead of a map.
Is it possible to have the map's absence leave no gap?
---
title: "Conditional Map"
runtime: shiny
output: html_document
---
```{r setup, include=FALSE, results='hide'}
knitr::opts_chunk$set(echo = FALSE)
library(leaflet)
library(shiny)
```
The map should be present based upon the condition of the checkbox:
```{r}
# coordinates for markers:
Coords = list("London"=c(0,51), "New York" = c(-74,40))
selectInput(inputId = "Loc",label = "Select location", choices = names(Coords))
checkboxInput(inputId = "ShowMap", label="Show map?", value=TRUE)
leafletOutput("Map")
output$Map = renderLeaflet({if(input$ShowMap) leaflet() %>% addTiles %>%
setView(-45,45,zoom=2) %>%
addMarkers(lng=Coords[[input$Loc]][1],lat=Coords[[input$Loc]][2])})
```
## The Next Bit
Some additional content here which should appear directly below the previous content, whether that is the map or the checkbox.
Use conditional panel like so:
conditionalPanel(condition = "input.ShowMap == true",
leafletOutput("Map"))
Related
I'm using checkbox filters from crosstalk to filter entries in a table made with reactable.
I need a simple way to get the checkboxes to show the number of corresponding entries next to them.
Here's a minimal example of a table with checkbox filters:
Example.Rmd
---
title: "Filtering with crosstalk"
---
```{r}
library(reactable)
library(crosstalk)
data <- SharedData$new(iris)
filter_checkbox("species", "Species", data, ~Species)
reactable(data)
```
It spits out this:
I need the checkboxes to show the number of corresponding entries next to them, like this:
What is the simplest way to do this?
You can create the desired category label as a column to the dataset itself, then pass the data to SharedData$new() and create filter_checkbox based on that newly created column. Then hide this newly created column in reactable using colDef(show = FALSE).
---
title: "Filtering with crosstalk"
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message=FALSE)
```
```{r}
# preparing the label into the data itself
library(dplyr)
iris_df <- iris %>%
group_by(Species) %>%
mutate(
Species_label = paste0(Species, " (",n(), ")")
) %>% ungroup()
```
```{r}
library(reactable)
library(crosstalk)
data <- SharedData$new(iris_df)
filter_checkbox("species", "Species", data, ~Species_label)
reactable(data,
columns = list(
Species_label = colDef(show = FALSE)
))
```
I'm new to R/Shiny and I'm trying to build a dashboard that needs to render specific RMD scripts depending on which 'indicator' radio button is selected.
The aim is to have a fluidpage where an indicator is selected using radio buttons, which renders the associated chart.rmd to present the chart. I can render a specific chart.rmd manually but I encounter an issue when trying to get it reactive to the 'indicator' selection.
I have an excel lookup that contains a list of indicators and the names of the RMD files I want to render when the indicator is selected.
I'm using a reactive element that uses the indicator input to filter the lookup file and print out the name of the RMD I want to render.
Below is my code for the main dashboard RMD and the chart RMDs.
Main Dashboard RMD
---
output:
html_document:
runtime: shiny
---
```{r mainlibrary, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
# Load packages
library(shinythemes)
library(shinyWidgets)
library(shiny)
library(shinydashboard)
library(readxl)
library(dplyr)
library(shinyjs)
library(knitr)
library(withr)
library(rmarkdown)
# Function to render in RMD scripts
render_child <- function(path) {
withr::local_options(list(htmltools.preserve.raw = FALSE))
markdown(knitr::knit_child(path, quiet = TRUE,envir = knit_global()))
}
```
```{r data, include=FALSE}
# Read in chart lookup table
lookup <- read_xlsx("Lookup.xlsx")
```
```{r code, echo=FALSE}
Chart_output <- reactive({
req(input$Indicator_choice)
Chart_output <-lookup %>%
filter(Indicator == input$Indicator_choice)
Chart_output <- as.character(Chart_output[2])
#renderUI(Chart_output)
})
Chart_output
```
```{r Page, echo=FALSE}
fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons(
inputId = "Indicator_choice",
label = "Select indicator",
choices = unique(lookup$Indicator),
selected = "One"
)
),
mainPanel(
HTML(render_child({Chart_output()}))
#renderText({Chart_output()}),
)
)
# End of fluidpage
)
```
Chart 1 RMD
---
title: "Chart 1"
output:
html_document:
runtime: shiny
---
```{r chart1_test, echo=FALSE}
print("Chart 1 RMD")
```
Chart 2 RMD
---
title: "Chart 2"
output:
html_document:
runtime: shiny
---
```{r chart2_test, echo=FALSE}
print("Chart 2 RMD")
```
Chart 3 RMD
---
title: "Chart 3"
output:
html_document:
runtime: shiny
---
```{r chart3_test, echo=FALSE}
print("Chart 3 RMD")
```
When I try running the dashboard I get this error:
*Error: Operation not allowed without an active reactive context.
You tried to do something that can only be done from within a reactive consumer.
The closest I’ve got is printing out the name of the RMD I want to render using a reactive element, but I am unable to use that in the main panel of the fluidpage to render the RMD.
I've managed to get the dashboard working by using a different method that renders each chart into its own object. I can then use render UI to load specific chart RMDs depending on what indicator is selected. Although this method works, I'm concerned the loading time will be too long as the final dashboard will contain 30 chart RMDs that will need to be read in at the beginning of the script.
Working Main Dashboard RMD
---
output: html_document
runtime: shiny
---
```{r mainlibrary, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
# Load packages
library(shinythemes)
library(shinyWidgets)
library(shiny)
library(shinydashboard)
library(readxl)
library(dplyr)
library(shinyjs)
library(knitr)
library(withr)
# Function to render in RMD scripts
render_child <- function(path) {
withr::local_options(list(htmltools.preserve.raw = FALSE))
markdown(knitr::knit_child(path, quiet = TRUE,envir = knit_global()))
}
```
```{r, echo = FALSE}
# Store the rendered files as
Chart_1 <- HTML(render_child("Chart_Rmd_1.Rmd"))
Chart_2 <- HTML(render_child("Chart_Rmd_2.Rmd"))
Chart_3 <- HTML(render_child("Chart_Rmd_3.Rmd"))
fluidPage(
radioButtons(
inputId = "Indicator_choice",
label = "Select indicator",
# choices = unique(lookup$Indicator),
choices = c("One", "Two", "Three"),
selected = "One"
),
uiOutput("test_output")
)
output$test_output <- renderUI({
req(input$Indicator_choice)
switch(input$Indicator_choice,
"One" = Chart_1,
"Two" = Chart_2,
"Three" = Chart_3)
})
```
Ideally, I would to use the first method but I'm not sure how to solve the issue or know if it's even possible. Any advice would be appreciated.
i am new to R and recently started working on a Shiny App. While I've managed to fix most of the problems in the project, I've been struggling with a menu issue for a while. Specifically, over the two inputs that I want to use I want to plot an image that depends on the first input (selectInput). I do this through a renderImage function, but the problem is that when plotting these images a space is generated that I cannot eliminate. I have tried using renderPlot and renderText, but the problem is not solved or they do not give the desired results. Is there a way to eliminate or reduce this space? I am attaching a simplified version of my code and an image of the problem.
---
title: "TEST"
output:
flexdashboard::flex_dashboard:
orientation: rows
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r paquetes, include=FALSE}
{
library(data.table)
library(dplyr)
library(plyr)
library(highcharter)
library(flextable)
library(officer)
library(readxl)
library(gridExtra)
library(plotly)
library(ggrepel)
library(kableExtra)
library(knitr)
library(scales)
library(flexdashboard)
}
```
Sidebar {.sidebar data-width=300}
=====================================
<center>
```{r echo = FALSE}
renderImage({
filename <- paste0("images/",input$countryInput,".png")
list(src = filename, height = 100)
})
```
</center>
```{r input01, echo=FALSE}
selectInput("countryInput", "REGIÓN",
choices = c("NACIONAL","XV ARICA Y PARINACOTA","I TARAPACÁ","II ANTOFAGASTA",
"III ATACAMA","IV COQUIMBO","V VALPARAÍSO","XIII METROPOLITANA",
"VI O´HIGGINS","VII MAULE","XVI ÑUBLE","VIII BÍO BÍO",
"IX ARAUCANÍA","XIV LOS RÍOS","X LOS LAGOS","XI AYSÉN","XII MAGALLANES"))
```
```{r input02, echo=FALSE}
dateRangeInput("dateInput", "TRIMESTRES",
language = "es",
format = "yyyy/mm/dd",
min = as.Date("2018-01-01"),
max = as.Date("2020-07-01"),
start = as.Date("2019-07-01"),
end = as.Date("2020-07-01"),
separator = "hasta")
```
Página
====================================
Row
-----------------------------
###
Problem photo
This is my first post on the forum, so any help is appreciated and I apologize in case I forgot to add information.
Use imageOutput to control the height of the div containing the image:
output[["image"]] <- renderImage({
filename <- paste0("images/",input$countryInput,".png")
list(src = filename, height = 100)
})
imageOutput("image", height = "100px")
I am trying to mimic or figure out how a similar function as leafletProxy works in mapview package inside a Shiny app (flexdashboard). The idea is that I have a parameterized database query that fetches a sf dataset (~4200 polygons) based on user inputs and then plots in mapview. However, it appears that everytime this is done the entire map is redrawn?
Below is a reproducible example using the default franconia dataset and a shiny input to control the line opacity. I also include my code (commented out) to show an example of how it will be used as intended (i.e. to dynamically redraw a polygon layer based on a database fetch)
Is there a way in shiny to draw a "base" map of all the background maps stylings once and then only redraw the new polygon data as they are retrieved?
Thanks!
---
title: "MRE"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(mapview)
library(shiny)
library(leaflet)
#library(RSQLite)
#library(sf)
```
Sidebar {.sidebar}
-----------------------------------------------------------------------
```{r}
# This is shiny input that will trigger entire map redraw
sliderInput("gridlines", "Grid Line Opacity", 0, 1, 0, step = 0.1, ticks = FALSE)
```
```{r}
### THIS IS MY ACTUAL CODE...For reference
# sp_grid <- reactive({
# db <- "../data/modeldata.db"
# con <- dbConnect(SQLite(), db )
#
# # set the sql based on user input
# sql <- 'SELECT id, Time,Cell_I, Cell_J, Cell_K, Cell_Botdepth_M, Zmax, Salinity, WKT_GEOMETRY
# FROM vwGridTK
# WHERE Time = :time
# AND Cell_K = :layer'
#
# df.grid <- dbGetQuery(con, sql, params = list(time = 0,
# layer = 1))
# dbDisconnect(con)
#
# st_as_sf(df.grid, wkt = "WKT_GEOMETRY") %>% st_set_crs(4326)
#
# })
```
Column {data-width=500}
-----------------------------------------------------------------------
### Reproducible Example
NOTE the shiny input to control opacity
```{r}
renderLeaflet({
m <- mapview(franconia, zcol = "district", alpha = input$gridlines)
m#map
})
```
Column {data-width=500}
-----------------------------------------------------------------------
### My Example
```{r}
# renderLeaflet({
# m <- mapview(sp_grid(), zcol = "Salinity",
# legend = TRUE, alpha = input$gridlines)
#
# m#map
#
# })
```
I am trying to select items in Shiny's select input by using entered search keyword and pressing Enter to select all matching items for keyword.
The observe function in the snippet works if I provide an item like ALL that is already present in the list but I want it to work for any typed keyword. e.g. App and hit Enter to select all matching items.
It will be interesting to see if there are other custom options that can be coded using jquery or something else to capture the typed input and capture filtered items. Or may be some regex instead of the "ALL" that I used in the if condition.
---
title: "search and select multiple items by pressing Enter"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
```
Column {.sidebar data-width=300}
-----------------------------------------------------------------------
```{r}
#####################
### Reactive Parameters
Parameters <- reactive({
c("ALL","Apple","App","Application","Approximate","Appointment","Ap_titude","Apricot","B","Ball","Bat","Battery")
})
output$params = renderUI({
selectInput(
'params',
'Parameters',
choices = Parameters(),
multiple = TRUE,
selectize = TRUE
)
})
observe({
if("ALL" %in% input$params){
param_selection <- setdiff(Parameters(), "ALL")
} else {
param_selection <- input$params
}
updateSelectInput(session, "params", selected = as.character(unlist(param_selection)))
})
uiOutput("params")
```
Column
-----------------------------------------------------------------------
### Summary
```{r}
```
I found help for selectize.js . It was hyperlinked on selectize page of Shiny.
I ended up using the create function to get it to work. Had to use callback instead of return. The selection based on search string was showing undefined, I could not get it to show correct selection. But since I had the observe function through which I was going to updateSelectInput, I did not worry about that.
Here's a sample code that I put together.
---
title: "search and select multiple items by pressing Enter"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(dplyr)
```
Column {.sidebar data-width=300}
-----------------------------------------------------------------------
```{r echo=FALSE}
#####################
### Reactive Parameters
Parameters <- reactive({
c("ALL","Apple","App","Application","Approximate","Appointment","Ap_titude","Apricot","B","Ball","Bat","Battery")
})
output$params = renderUI({
selectizeInput(
'params',
'Parameters',
selected = NULL,
choices = Parameters(),
multiple = TRUE,
options = list(
delimiter= ',',
persist= FALSE,
create = I("function(input, callback) {
callback({
'value': input,
'text': input
});
}")
)
)
})
observe({
dt <- as.character(unlist(Parameters()))
if(is.null(input$params)){
return()
} else{
if("ALL" %in% input$params){
param_selection <- setdiff(dt, "ALL")
} else {
param_selection <- dt[grep(paste(input$params, collapse = "|"), dt)]
}
}
updateSelectInput(session, "params", selected = as.character(unlist(param_selection)))
})
uiOutput("params")
```
Column
-----------------------------------------------------------------------
### Summary
```{r}
```
And this is the output:
Search string- "App", add it
The moment you click, "Add App", observe function triggers and updates the selection to all the values that match the keyword.
Hope this helps someone else that faces the same issue like I did.