通过下拉列表选择绘图图表

Question

我在 R 中编写了一个循环来生成 10 个图：

library(plotly)

for (i in 1:10)

{

d_i = data.frame(x = rnorm(100,100,100), y = rnorm(100,100,100))

title_i = paste0("title_",i)

p_i = plot_ly(data = d_i, x = ~x, y = ~y) %>% layout(title = title_i)

htmlwidgets::saveWidget(as_widget(p_i), paste0("plot_",i, ".html"))

}

我有这段代码（输入菜单内容不会溢出 flexdashboard 中的行框），它在 R 中创建了仪表板：

---
title: "Test Dashboard"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: fill
runtime: shiny
---

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

Column {data-width=100}
-----------------------------------------------------------------------

### Window 1

```{r}
selectInput("project", label = NULL, choices = c("A","B","C","D"))
```


Column {data-width=400}
-----------------------------------------------------------------------

### Chart B

```{r}
renderPlot({
  plot(rnorm(1000), type = "l", main = paste("Project:",input$project, " Data:", input$data))
})
```

我想调整此代码，以便下拉菜单允许用户加载先前创建的正在搜索的图形/html 文件（例如，来自“我的文档”）。例如，如果用户搜索“plot_7”，则显示plot_7。

我尝试了以下代码：

---
title: "Test Dashboard"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: fill
runtime: shiny
---

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

Column {data-width=100}
-----------------------------------------------------------------------

### Window 1

```{r}
plots = rep("plot", 10)
i = seq(1:100)
choice = paste0(plots, "_",i)
selectInput("project", label = NULL, choices = choice)
```


Column {data-width=400}
-----------------------------------------------------------------------

### Chart B

```{r}
renderPlot({
<object class="one" type="text/html" data="plot_i.html"></object>
})
```

但这会返回以下错误：

Error: <text<:2:1 unexpected '<' 
1: renderPlot({
2:<
 ^

有人可以告诉我如何解决这个问题吗？是否可以在没有光泽的情况下做到这一点？（即仅在 Flexdashboard 中）

谢谢你！

Answer 1

这回答了您的下一个问题：

只是一个问题：在您提供的第一个答案中，您可以“输入”您想查看的情节。在第二个答案中，您只能“滚动”。有没有办法添加“输入”您想查看第二个答案的绘图？

简短回答：是的

...以及如何做到这一点？

我实际上尝试以一种讽刺的方式使用 selectize.js，但它没有成功...考虑了暴力...但它是一个无生命的对象...所以...是的，默认情况下我输了

这使用了 JS 库/包（无论他们对该语言的称呼是什么）select2。

flexdashboard超级有趣！它真的不希望我用 JS 添加这个库（那太容易了，你知道吗？所以这只小狗必须添加到 YAML 中。

使这项工作有效的 YAML。

---
title: "Test Dashboard"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: fill
    extra_dependencies: !expr list(htmltools::htmlDependency('select2.min.js', '1.0', src = list(href = 'https://cdn.jsdelivr.net/npm/select2@4.1.0-rc.0/dist'), script='js/select2.min.js', all_files = FALSE, style = 'css/select2.min.css'))
---

默认情况下，它看起来像这样。

我想你的下一个问题会是关于外表……所以我就提前了。

据我了解，（我是 select2 的新手），当扩大搜索框时，您必须移动下拉箭头，它占据了此 CSS 中的前 3 个条目。

接下来的两个用于当您将鼠标悬停在下拉列表中时突出显示。默认情况下，之前的选择突出显示为灰色，当前悬停的选择突出显示为浅蓝色。我添加了这些，以便您可以根据需要更改颜色。CSS 中的最后一个调用是设置字体系列。我在 Plotly 中选择了默认系列（因此它们匹配）。

```{css}

.select2-container--default .select2-selection--single{ 
  min-height: 40px;
  padding: 6px 6px;
  width: 175px;
  position: relative;
}
.select2-container--default .select2-selection--single .select2-selection__arrow {
  right: 0px;
  width: 20px;
  min-height: 34px;   /* parent min-height, minus top padding 40 - 6 */
  position: absolute;
}
.select2-dropdown { /* the chunk requires 'important' */
  width: 175px !important; /* so they're the same width */
  top: 50%;
  padding: 6px; 12px;
}
.select2-container--default .select2-results__option--highlighted[aria-selected] {
  background-color: #F5F0E3;
  color: black;    /* in dropdown, item hovered on bg and text */
}                  /* default is background-color: #5897fb; default blue  */
.select2-container--default .select2-results__option--selected {
  background-color: #fbfaf5;
  color: black;    /* in dropdown, PREVIOUS selection bg and text  */
}                  /* default background-color: #ddd; yucky grey */
option {
  font-family: verdana;       /*  to match plotly  */
}

```

创建绘图列表、下拉列表以及在 R 代码中渲染绘图没有改变。

JS 没有太大变化。

/* doesn't catch that the first plot is default; set manually */
setTimeout(function(){
  $('select').select2();                /* connect to the select2 library */
  plt = document.querySelectorAll('div.plotly.html-widget');
  for(i = 0; i < plt.length; i++) {
    if(i === 0) {
      plt[i].style.display = 'block';
    } else {
      plt[i].style.display = 'none';
    }
  }
}, 200) /* run once; allow for loading*/

/* goes with the dropdown; this shows/hides plots based on dropdown */
function getPlot(opt) {
  plt = document.querySelectorAll('div.plotly.html-widget');
  for(i = 0; i < plt.length; i++) {      /* switched to plt from opt here */
    opti = opt.options[i];
    if(opti.selected) {
      plt[i].style.display = 'block';
    } else {
      plt[i].style.display = 'none'
    }
  }
}

这一切都给了你这个。

所有代码一并。

---
title: "Test Dashboard"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: fill
    extra_dependencies: !expr list(htmltools::htmlDependency('select2.min.js', '1.0', src = list(href = 'https://cdn.jsdelivr.net/npm/select2@4.1.0-rc.0/dist'), script='js/select2.min.js', all_files = FALSE, style = 'css/select2.min.css'))
---

```{r setup, include=FALSE}

library(flexdashboard)
library(plotly)
library(tidyverse)
library(htmltools)
library(shinyRPG)   #  devtools::install_github("RinteRface/shinyRPG")

plts <- vector(mode = "list")   # store plot list

for (i in 1:10) {
  d_i = data.frame(x = rnorm(100,100,100), y = rnorm(100,100,100))
  title_i = paste0("title_",i)

  plts[[i]] <- plot_ly( # make a list of objects; no .html
    data = d_i, x = ~x, y = ~y, height = 400, 
    mode = "markers", type = "scatter") %>%
    layout(title = title_i)
  }

```


```{css}

.select2-container--default .select2-selection--single{ /* outer container of dropdown */
  min-height: 40px;
  padding: 6px 6px;
  width: 175px;
  position: relative;
}
.select2-container--default .select2-selection--single .select2-selection__arrow {
  right: 0px;
  width: 20px;
  min-height: 34px;   /* parent min-height, minus top padding 40 - 6 */
  position: absolute;
}
.select2-dropdown { /* the chunk requires 'important' */
  width: 175px !important; /* so they're the same width */
  top: 50%;
  padding: 6px; 12px;
}
.select2-container--default .select2-results__option--highlighted[aria-selected] {
  background-color: #F5F0E3;
  color: black;    /* in dropdown, item hovered on bg and text */
}                  /* default is background-color: #5897fb; default blue  */
.select2-container--default .select2-results__option--selected {
  background-color: #fbfaf5;
  color: black;    /* in dropdown, PREVIOUS selection bg and text  */
}                  /* default background-color: #ddd; yucky grey */
option {
  font-family: verdana;       /*  to match plotly  */
}

```


Column {data-width=100}
-----------------------------------------------------------------------

### Window 1 {data-height=500}

```{r makeGoodChoices}

opts <- choice <-  paste0("plot_", 1:100) # this line replaces last 3 lines
namedChoices = setNames(opts, choice)

newInput <- rpgSelect(         # <----- I'm new; the dropdown
  "selectBox",
  NULL,
  namedChoices,
  multiple = F)

newInput$children[[2]]$attribs$onchange <- "getPlot(this)"

newInput  # add dropdown to webpage

```

<!--- make space between dropdown and plot --->
<div id="plots" style="margin-top:3rem; margin-bottom:3rem;">

```{r dynoPlots,results='asis'}

tagList(plts) # print every plot (so they're all in the HTML)

```

</div>

```{r giveItUp,results='asis',engine='js'}

/* doesn't catch that the first plot is default, set manually */
setTimeout(function(){
  $('select').select2();                /* connect to the select2 library */
  plt = document.querySelectorAll('div.plotly.html-widget');
  for(i = 0; i < plt.length; i++) {
    if(i === 0) {
      plt[i].style.display = 'block';
    } else {
      plt[i].style.display = 'none';
    }
  }
}, 200) /* run once; allow for loading*/

/* goes with the dropdown; this shows/hides plots based on dropdown */
function getPlot(opt) {
  plt = document.querySelectorAll('div.plotly.html-widget');
  for(i = 0; i < plt.length; i++) {     /* switched to plt from opt here */
    opti = opt.options[i];
    if(opti.selected) {
      plt[i].style.display = 'block';
    } else {
      plt[i].style.display = 'none'
    }
  }
}

```