Flexdashboard: set anchors for ### headings (level3) - r

In flexdashbard, we can create different headings:
Heading level 1: they are pages
Heading level 2: we specify Row or Column
Heading level 3: tabs
Now for anchors, it seems that we can only set them for heading level 1. As we can see it in this article.
My question is, it is possible to create anchors for tabs (so heading level 3)?
I tried to find a solution. For example, with the following code:
Page 4
=====================================
## Row {.tabset}
### tab 1 {#test1}
### tab 2 {#test2}
The anchor is automatically created for "Page 4" which is #page-4. For "tab 1", I tried to add {#test1}, but it doesn't work.
EDIT: solution with javascript
Another solution that would work for me is to use javascript, to go the the next tab.
First we can add a javascript
<script type="text/javascript">
$('.btnNext').click(function(){
$('.nav-tabs > .active').next('li').find('a').trigger('click');
});
$('.btnPrevious').click(function(){
$('.nav-tabs > .active').prev('li').find('a').trigger('click');
});
</script>
Then, we can create buttons to navigate
<a class="btn btn-primary btnNext">Next</a>
<a class="btn btn-primary btnPrevious">Previous</a>
But I testd in R Markdown, it doesn't work.

update
I now figured out a way to go from #page-4 #test1 to #page-5 #test4 by clicking a link. I use a bit of javascript to read the URLs parameters. This allows us to define links like a(href="?page5&tab=4"). The javascript will get the parameters, in our case page as 5 and tab as 4 and then execute two clicks, one to get to #page-5 and another one to get the tab 4 called #test4. There are probably better options which allow you to set the active page tab and tabset tab, but I didn't get them working with {flexdashboard}. Anyway, I hope the approach below solves your problem.
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
library(htmltools)
```
```{js}
document.addEventListener("DOMContentLoaded", function(){
var url_string = window.location.href;
var url = new URL(url_string);
var page = url.searchParams.get('page');
var pageid = '#page-'.concat(url.searchParams.get('page'));
var tab = 'tab'.concat(url.searchParams.get('tab'));
var tabid = '#test'.concat(url.searchParams.get('tab'));
$('a[href="'+ pageid +'"]').click();
$('a[href="'+ tabid +'"]').click();
});
```
Page 4
=====================================
## Row {.tabset}
### tab 1 {#test1}
```{r}
tags$a(href = "?page=5&tab=4",
shiny::actionButton("btn1",
"go to page-5 tab4"
))
```
### tab 2 {#test2}
```{r}
tags$a(href = "#test1",
shiny::actionButton("btn4",
"go to tab1"
))
```
Page 5
=====================================
## Row {.tabset}
### tab 3 {#test3}
```{r}
tags$a(href = "#test4",
shiny::actionButton("btn5",
"go to tab4"
))
```
### tab 4 {#test4}
```{r}
tags$a(href = "?page=4&tab=2",
shiny::actionButton("btn6",
"go to page-4 tab2"
))
```
old answer
In my case your header level 3 anchors ({#test1} etc.) are working even when not using runtime: shiny. You can change the tabs via action buttons, but only if you are on the same page. For example you can from tab1 to tab2 on page 4 but you cannot go from tab1 on page 4 to tab4 on page 5. But changing from page 4 to page 5 is again possible.
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
library(htmltools)
```
Page 4
=====================================
## Row {.tabset}
### tab 1 {#test1}
```{r}
tags$a(href = "#test2",
shiny::actionButton("btn1",
"go to tab2"
))
tags$a(href = "#test1",
shiny::actionButton("btn2",
"go to tab3 (not working)"
))
tags$a(href = "#page-5",
shiny::actionButton("btn3",
"go to page5 (working)"
))
```
### tab 2 {#test2}
```{r}
tags$a(href = "#test1",
shiny::actionButton("btn4",
"go to tab1"
))
```
Page 5
=====================================
## Row {.tabset}
### tab 3 {#test3}
```{r}
tags$a(href = "#test4",
shiny::actionButton("btn5",
"go to tab4"
))
```
### tab 4 {#test4}
```{r}
tags$a(href = "#test3",
shiny::actionButton("btn6",
"go to tab3"
))
```

Related

How to render specific RMD files that's reactive to radio button selection?

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.

shiny - what page is the user looking at?

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
=====================================

Modal popup for valueBox with shinyjs and flexdashboard

I'm trying to trigger a popup message for a valueBox in flexdashboard using shinyjs. There's a similar question here but it doesn't work with flexdashboard.
The flexdashboard is created using an RMarkdown file.
---
title: "Test valuebox"
output:
flexdashboard::flex_dashboard:
orientation: rows
runtime: shiny
---
```{r}
library(flexdashboard)
library(shiny)
library(shinyjs)
useShinyjs(rmd = TRUE)
onclick('valbox', showModal(modalDialog(
title = "message",
"This is an important message!"
)))
```
Inputs {.sidebar}
-------------------------------------
```{r ui}
sliderInput('valsel', 'Select number:', min = 0, max = 10, value = 5)
```
Column
-------------------------------------
###
```{r}
output$valbox <- renderValueBox(flexdashboard::valueBox(input$valsel, "selected"))
valueBoxOutput('valbox')
```
I've inspected the HTML created by the app and the id for the value box is indeed 'valbox'. I tried creating a unique id with tags, but that didn't work either.

Change second tabset on click in flexdashboard

I'm working on a self-contained flexdashboard project and I'm wondering if it's possible when a user clicks to a new tab in one tabset, it changes to a new tab on a second tabset as well.
So for example, when you click on "Chart B1" below, I would also like to change view to "Chart B2" in the second column. And clicking on "Chart A2" would change back to "Chart A1", etc. etc.
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
```
Column {.tabset}
-----------------------------------------------------------------------
### Chart A1
### Chart B1
Column {.tabset}
-----------------------------------------------------------------------
### Chart A2
### Chart B2
Note, this was first posted on RStudio Community, but did not receive any responses.
This can be implemented with JavaScript. Luckily, Knitr supports embedded Javascript. I am an R programmer foremost, so this may not necessarily be the most concise implementation, but it does achieve the correct effect.
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
```
Column {.tabset}
-----------------------------------------------------------------------
### Chart A1
Chart A1 is Great
### Chart B1
Chart B1 is Great
Column {.tabset}
-----------------------------------------------------------------------
### Chart A2
Chart A2 is Great
### Chart B2
Chart B2 is Great
```{js}
// Once the Document Has Fully Loaded
document.addEventListener("DOMContentLoaded", function(){
// Select The Tabs
window.a1Tab = document.querySelector("#column > ul > li:nth-child(1)");
window.b1Tab = document.querySelector("#column > ul > li:nth-child(2)");
window.a2Tab = document.querySelector("#column-1 > ul > li:nth-child(1)");
window.b2Tab = document.querySelector("#column-1 > ul > li:nth-child(2)");
// Select the Panel Content
window.a1Panel = document.getElementById('chart-a1');
window.b1Panel = document.getElementById('chart-b1');
window.a2Panel = document.getElementById('chart-a2');
window.b2Panel = document.getElementById('chart-b2');
// If We Click on B1, Open B2, Close A2
b1Tab.addEventListener('click', function(){
a2Tab.classList.remove('active');
a2Tab.children[0].setAttribute('aria-expanded', true);
a2Panel.classList.remove('active');
b2Tab.classList.add('active');
b2Tab.children[0].setAttribute('aria-expanded', true);
b2Panel.classList.add('active');
}, false);
// If We Click on B2, Open B1, Close A1
b2Tab.addEventListener('click', function(){
a1Tab.classList.remove('active');
a1Tab.children[0].setAttribute('aria-expanded', true);
a1Panel.classList.remove('active');
b1Tab.classList.add('active');
b1Tab.children[0].setAttribute('aria-expanded', true);
b1Panel.classList.add('active');
}, false);
// If We Click on A1, Open A2, Close B2
a1Tab.addEventListener('click', function(){
b2Tab.classList.remove('active');
b2Tab.children[0].setAttribute('aria-expanded', true);
b2Panel.classList.remove('active');
a2Tab.classList.add('active');
a2Tab.children[0].setAttribute('aria-expanded', true);
a2Panel.classList.add('active');
}, false);
// If We Click on A2, Open A1, Close B1
a2Tab.addEventListener('click', function(){
b1Tab.classList.remove('active');
b1Tab.children[0].setAttribute('aria-expanded', true);
b1Panel.classList.remove('active');
a1Tab.classList.add('active');
a1Tab.children[0].setAttribute('aria-expanded', true);
a1Panel.classList.add('active');
}, false);
});
```
Edit: For an unlimited number of tabs, assuming that you will always have the same number of tabs in the first and second column. Same disclaimer, this is not necessarily the most concise implementation, but achieves the desired effect.
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
```
Column {.tabset}
-----------------------------------------------------------------------
### Chart A1
Chart A1 is Great
### Chart B1
Chart B1 is Great
### Chart C1
Chart C1 is Great
### Chart D1
Chart D1 is Great
Column {.tabset}
-----------------------------------------------------------------------
### Chart A2
Chart A2 is Great
### Chart B2
Chart B2 is Great
### Chart C2
Chart C2 is Great
### Chart D2
Chart D2 is Great
```{js}
// Once the Document Has Fully Loaded
document.addEventListener("DOMContentLoaded", function(){
// Select The Tabs
window.col1Tabs = document.querySelector("#column > ul");
window.col2Tabs = document.querySelector("#column-1 > ul");
// Select the Panel Content
window.col1Panels = document.querySelector("#column > div");
window.col2Panels = document.querySelector("#column-1 > div");
// Function to Make Tabs Active
window.handleTab = function(tabIndex){
for(i=0;i<col1Tabs.childElementCount;i++){
col1Tabs.children[i].classList.remove('active');
col2Tabs.children[i].classList.remove('active');
col1Panels.children[i].classList.remove('active');
col2Panels.children[i].classList.remove('active');
}
col1Tabs.children[tabIndex].classList.add('active');
col2Tabs.children[tabIndex].classList.add('active');
col1Panels.children[tabIndex].classList.add('active');
col2Panels.children[tabIndex].classList.add('active');
}
// For All Tabs, Add Event Listener
for(i=0;i<col1Tabs.childElementCount;i++){
col1Tabs.children[i].setAttribute('onclick', 'handleTab(' + i + ');');
col2Tabs.children[i].setAttribute('onclick', 'handleTab(' + i + ');');
}
});
```
Edit: For anyone who may find this question later, a JQuery implementation with more flexibility was added to the Github Issue.
Just to add another answer using JQuery and boostrap tabset JS function.
It is more concise than other answer but works the same with any number of tabs (but the same number) in your two column format.
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
```
```{js}
document.addEventListener("DOMContentLoaded", function(){
$('a[data-toggle="tab"]').on('click', function(e){
// find the tab index that is click
child = e.target.parentNode;
tabnum = Array.from(child.parentNode.children).indexOf(child);
// find in which column we are
column = $(e.target).closest("div[id]");
// show the same tab in the other column
columnid = column.attr("id");
if (columnid == "column") {
columnto = "column-1";
} else {
columnto = "column";
}
$("div[id="+columnto+"] li:eq("+tabnum+") a").tab('show');
})
});
```
Column {.tabset}
-----------------------------------------------------------------------
### Chart A1
This is a text
### Chart B1
```{r}
plot(iris)
```
Column {.tabset}
-----------------------------------------------------------------------
### Chart A2
```{r}
plot(mtcars)
```
### Chart B2
This is another text

How to fix download button sidebar issue in flexdashboard

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)
}
)

Resources