I have added a download button to my flexdashboard in the sidebar panel, but it appears in the main panel when I knit the .RMD. Can you please guide me as to how I can fix it?
Here's a minimal example of what I'm trying to accomplish
---
title: "Download Button in Wrong Panel"
output:
flexdashboard::flex_dashboard:
vertical_layout: scroll
runtime: shiny
---
```{r setup, include=FALSE}
## Setting up required libraries
library(flexdashboard)
library(dplyr)
library(shiny)
library(knitr)
dataset <- read.csv(somefile)
```
Inputs {.sidebar}
-----------------------------------------------------------------------
### Input Filters
```{r input}
## Metric 1
selectInput('metric',
'Choose Metric',
names(dataset %>% select(-default_column)),
selected = "default_metric")
## Download Button
downloadButton('downloadData','Download Result Set')
```
Outputs
-----------------------------------------------------------------------
### List of Customers
```{r output}
subset_dataset <- reactive({
dataset[,c("default_column",input$metric)]
})
renderTable({
subset_dataset()
},
include.rownames = FALSE)
downloadHandler(filename = function() {
paste('resultset-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
write.csv(subset_dataset(), file, row.names = FALSE)
}
)
```
A screenshot of the dashboard is as follows
Thanks!
Never mind, I fixed it and it was rather silly of me to have not tried it before posting the question, but if someone ever faces a similar problem, the solution is here.
The download handler function must simply be placed in the sidebar panel as well and that does it.
Inputs {.sidebar}
-----------------------------------------------------------------------
### Input Filters
```{r input}
## Metric 1
selectInput('metric',
'Choose Metric',
names(dataset %>% select(-default_column)),
selected = "default_metric")
## Download Button
downloadButton('downloadData','Download Result Set')
downloadHandler(filename = function() {
paste('resultset-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
write.csv(subset_dataset(), file, row.names = FALSE)
}
)
Related
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.
How can I determine if the user is looking at a particular page in a flexdashboard? I have a global sidebar panel of filters that applies to all pages except one of the filters in the sidebar doesn't apply to one of the pages. In this example, let's say I don't want the selectInput() to be displayed on Page 3.
---
title: "Which Page?"
runtime: shiny
output: flexdashboard::flex_dashboard
---
Sidebar {.sidebar data-width=400}
=====================================
```{r}
textInput("text", NULL)
selectInput("select", NULL, LETTERS[1:5])
```
Page 1
=====================================
Page 2
=====================================
Page 3
=====================================
I was hoping to use session$clientData$url_hash but this is static and based on the page the user initially opened. You can put this in the sidebar section to see how it (doesn't) change. Other ideas I've found are to use window.location or is.visible in js but not sure how to integrate.
print_info <- function(x) {
allvalues <-
lapply(
X = sort(names(x)),
FUN = function(name) {
item <- x[[name]]
paste(name, item, sep = " = ")
}
)
paste(allvalues, collapse = "\n")
}
output$client_data <- renderText(print_info(session$clientData))
verbatimTextOutput("client_data")
Solution 1 : "pure Shiny"
You can take advantage of the fact that renderXXX() is only calculated on active page. For example here we can use renderUI() on each page to update a reactive value tab with the current page number. That value is then used in the side bar to check if the selectInput will be displayed with the renderUI :
---
title: "Which Page?"
runtime: shiny
output: flexdashboard::flex_dashboard
---
Sidebar {.sidebar data-width=400}
=====================================
```{r}
textInput("text", NULL)
tab <- reactiveVal(1)
renderUI({
if(tab()!=3)
selectInput("select", NULL, LETTERS[1:5])
})
```
Page 1
=====================================
```{r}
renderUI({tab();tab(1);NULL})
```
Page 2
=====================================
```{r}
renderUI({tab();tab(2);NULL})
```
Page 3
=====================================
```{r}
renderUI({tab();tab(3);NULL})
```
Solution 2 : with JavaScript
You can also use a JS event
(note the use of is.null() as event is not triggered on page 1 initial display):
---
title: "Which Page?"
runtime: shiny
output: flexdashboard::flex_dashboard
---
<script>
$("body").on("shown.bs.tab", "a[data-toggle='tab']", function(e) {
Shiny.setInputValue("active_tab", $(e.target).parent().index() + 1);
})
</script>
Sidebar {.sidebar data-width=400}
=====================================
```{r}
textInput("text", NULL)
renderUI({
if(is.null(input$active_tab) || input$active_tab!=3)
selectInput("select", NULL, LETTERS[1:5])
})
```
Page 1
=====================================
Page 2
=====================================
Page 3
=====================================
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")
Using the fileInput widget I set the path to a file in my R-markdown document.
The path is leading to a large file. Content of this file is required at several sections in the document. So far I load the file at each section where it is required. As it takes some time for the file to load, changing the file results in quite some loading time. I would prefer to load the file only once after the path is changed.
The following minimal example shows my current implementation where the file is loaded at each section it is used.
---
output: html_document
runtime: shiny
---
library(kableExtra)
knitr::opts_chunk$set(echo = TRUE)
fileInput("file", label = h3("File input"))
renderUI({
loaded_file <-read.csv(input$file$datapath, sep = ";", header = T)
paste(loaded_file[1,2])
})
renderUI({
loaded_file <-read.csv(input$file$datapath, sep = ";", header = T )
HTML(kable(loaded_file))
})
If you load the file into a data frame as a separate reactive expression, and then reference that expression in all the relevant UIs, I believe that will accomplish what you need. Here's a small example:
---
output: html_document
runtime: shiny
---
```{r load_file}
library(kableExtra)
library(dplyr)
knitr::opts_chunk$set(echo = TRUE)
fileInput("file", label = h3("File input"))
loaded_file_test = reactive({
if(is.element("datapath", names(input$file))) {
print("loading file now...")
read.csv(input$file$datapath, sep = ",", header = T)
}
})
```
```{r first_ui}
renderUI({
HTML(kable(loaded_file_test() %>% head(10)))
})
```
```{r second_ui}
renderUI({
HTML(kable(loaded_file_test() %>% head(10)) %>% kable_styling())
})
```
When I run the document, "loading file now..." is printed just once. I interpret that to mean the file is getting loaded only once (although I'm happy to be corrected by users with a better handle on reactivity in Shiny).
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.