有没有办法实现 Appsilon 的 shiny.router for Rmd 文档的行为? (selectInput 在 Rmd 文档中呈现动态页面)

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

我有一个闪亮的应用程序,您可以在其中 select 从几个 select 输入中选择 100 个选项之一来显示 100 个 Rmds/html 页面之一。 一旦你选择了一个选项,一个 Rmd 就会被渲染并显示在应用程序中,但每次渲染都很慢。加载该 Rmd 后,您可以选择另一个选项来查看不同的 Rmd

由于 Rmd 比闪亮的应用程序响应更快,我有没有办法重新创建相同的功能(选择一个选项,将您链接到正确的 Rmd,但您仍然可以 select不同的选项并转到该选项的 Rmd) 但完全包含在 Rmd 或 Rmds 系列中?

谢谢

有帮助吗?

---
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()
```


编辑

这是同一个 flex 仪表板,但这个不使用 Shiny(Shiny 小部件除外,但没有 Shiny 服务器)。它使用 JavaScript 库 select2 因为我喜欢它(我发现本机下拉列表不漂亮)。

---
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()
```

文件select2_css.html:

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

文件select2_js.html:

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

当然我下载了两个select2.min文件

OP 编辑​​:

我无法让 selectInput 在静态 Rmd 中呈现,所以我使用串扰来达到同样的效果

```{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();
});
```