'Is there a way to achieve the behaviour of Appsilon's shiny.router for Rmd documents? (selectInput rendering dynamic pages within a Rmd doc)

I have a shiny app in which you select one of 100 options from a couple of select inputs to show one of 100 Rmds/html pages. Once you have chosen an option, an Rmd is rendered and displayed in the app but it is slow to render each time. Once that Rmd is loaded, you can choose another option to see a different Rmd

Since Rmd are more responsive than shiny apps, is there a way for me to recreate the same functionality (Choose an option, that links you to the correct Rmd, but you are still able to select a different option and go to that option's Rmd) but completely contained within an Rmd or family of Rmds?

Thank you



Solution 1:[1]

Does it help?

---
title: Test
output: 
  flexdashboard::flex_dashboard:
    vertical_layout: scroll
runtime: shiny_prerendered
---

# Page 0


```{r context='render'}
npages <- 3
links <- paste0("#section-page-", 1:npages)
names(links) <- paste0("Page ", 1:npages)
onChange <- '
function(value){
  const a = document.createElement("a");
  document.body.append(a);
  a.href = value;
  a.click();
  a.remove();
}
'
selectizeInput(
  "sel",
  "Select a page",
  choices = as.list(links),
  options = list(
    onChange = I(onChange)
  )
)
```

```{r echo=FALSE}
backlink <- function(){
  tags$a("Back to selection", href = "#section-page-0")
}
```


# Page 1

blablabla...

```{r context="render"}
backlink()
```


# Page 2

Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.

```{r context="render"}
backlink()
```


# Page 3

```{r context='render'}
uiOutput("contentBox", inline = TRUE)
```

```{r context='server'}
content <- reactive({
  x <- rnorm(1)
  tags$span(x, id = 'myspan')
})
output$contentBox <- renderUI({
  content()
})
```

```{r context="render"}
backlink()
```

enter image description here


EDIT

Here is the same flex dashboard but this one does not use Shiny (except the Shiny widgets, but no Shiny server). It uses the JavaScript library select2 because I like it (I find the native dropdown lists are not pretty).

---
title: "Navigating without Shiny"
output: 
  flexdashboard::flex_dashboard:
    vertical_layout: scroll
    pandoc_args:
      header-includes: select2_css.html
      include-after: select2_js.html
---

```{js}
$(document).ready(function() {
  $("#sel").select2({
    width: "resolve"
  });
  $("#sel").on("select2:select", function(e){
    const a = document.createElement("a");
    document.body.append(a);
    a.href = e.params.data.id;
    a.click();
    a.remove();
  });
});
```


```{r setup, include=FALSE}
library(flexdashboard)
library(htmltools)
```

# Page 0

```{r results='asis'}
npages <- 3
links <- paste0("#page-", 1:npages)
names(links) <- paste0("Page ", 1:npages)
shiny::selectInput(
  "sel",
  "Select a page",
  choices = as.list(links),
  selectize = FALSE,
  width = "20%"
)
```

```{r echo=FALSE}
backlink <- function(){
  tags$a("Back to selection", href = "#section-page-0")
}
```


# Page 1

blablabla...

```{r results='asis'}
backlink()
```


# Page 2

Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.

```{r results='asis'}
backlink()
```


# Page 3

```{r results='asis'}
backlink()
```

File select2_css.html:

<link rel="stylesheet" href="select2.min.css"></link>

File select2_js.html:

<script src="select2.min.js"></script>

Of course I downloaded the two select2.min files.

Edit by OP:

I was unable to get the selectInput to render in a static Rmd so I used crosstalk to the same effect

```{r}
sd <- SharedData$new(data.frame(n = names(links), l = links), group = 'grp', key = unname(links))
crosstalk::filter_select(id = 'selles',
                         label = 'select a page',
                         sharedData = sd,
                         group = ~names(links),
                         allLevels = F,
                         multiple = F)
```

```{js}

var ct_filter = new crosstalk.FilterHandle('grp');
// Get notified when this group's filter changes
ct_filter.on("change", function(e) {
// e.value gives the filter
const a = document.createElement("a");
document.body.append(a);
a.href = e.value;
a.click();
a.remove();
});
```

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 michael