Select plotly charts via drop-down list

Question

I wrote a loop that made 10 graphs in R:

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

}

I have this code (Input menu contents do not overflow row box in flexdashboard) that makes a dashboard in 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))
})
```

I would like to adapt this code so that the drop down menu allows the user to load the previously created graph/html file (e.g. from "My Documents") that is being searched for. For example, if the user searches for "plot_7", then plot_7 is displayed.

I tried the following code:

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

But this returns the following error:

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

Can someone please show me how I can fix this? And is it possible to do this WITHOUT shiny? (i.e. only in flexdashboard)

Thank you!

Answer 1

This answers your next question:

Just a question: In the first answer you provided, you were able to "type in" which plot you wanted to see. In the second answer, you can only "scroll". Is there a way to add the "type in" which plot you want to see for the second answer?

Short answer: yes

... and how to do that?

I actually tried to use selectize.js in an ironic full circle of sorts, but it didn't work out...violence was considered...but it's an inanimate object...so...ya, I lost by default

This uses the JS library/package (whatever they call it for that language) select2.

flexdashboard is SUPER FUN! It really didn't want me to add this library with JS (that would have been too easy, ya know? So this puppy had to get added to the YAML.

The YAML to make this work.

---
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/[email protected]/dist'), script='js/select2.min.js', all_files = FALSE, style = 'css/select2.min.css'))
---

By default, it will look like this.

I figured your very next question would be about appearance... so I jumped the gun.

As far as I understand it, (I'm new to select2), when widening the search box, you have to move the dropdown arrow, which accounts for the first 3 of the entries in this CSS.

The next two are for highlighting when you mouse over in the dropdown. By default, the previous selection is highlighted grey, and the currently hovered-over is highlighted light blue. I added these so that you could change the colors if you wanted to. The final call in CSS is setting the font family. I chose the default family in Plotly (so they matched).

```{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  */
}

```

Creating the plot list, the dropdown, and rendering the plots in R code didn't change.

The JS didn't change that much.

/* 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'
    }
  }
}

That all gives you this.

All the code altogether.

---
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/[email protected]/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'
    }
  }
}

```