2

I need help with generating dropdown menu for plots generated in ggplot. (As shown in here: https://plotly.com/r/dropdowns/)

I have generated a number of plots using ggplot as shown below:

da1 <- ggdensity(data=data, x=data$x_1, add = "mean", rug=TRUE, color="Status", palette = c("#00BFC4", "#F8766D"), ylab="Area 1", xlab="") + 
      theme(plot.title = element_text(hjust = 0.5),
            legend.position="none")

da2 <- ggdensity(data=data, x=data$x_2, add = "mean", rug=TRUE, color="Status", palette = c("#00BFC4", "#F8766D"), ylab="Area 2", xlab="") + 
      theme(plot.title = element_text(hjust = 0.5),
            legend.position="none")

a1 <- ggplot(data=data, aes(x=Status, y=data$x_1, fill=Status, label=data$label)) +
      geom_violin() +
      geom_point(alpha=0.6, size=3) +
      stat_compare_means(method="wilcox.test", aes(label = ..p.signif..), size=7, label.x = 1.5, vjust=0.5) +
      theme(text = element_text(colour = "black"),
            axis.title.x = element_text(size=14, face="bold"),
            axis.title.y = element_text(size=14, face="bold"),
            legend.position="none") +
      xlab("") +
      ylab("")

a2 <- ggplot(data=data, aes(x=Status, y=data$x_2, fill=Status, label=data$label)) +
      geom_violin() +
      geom_point(alpha=0.6, size=3) +
      stat_compare_means(method="wilcox.test", aes(label = ..p.signif..), size=7, label.x = 1.5, vjust=0.5) +
      theme(text = element_text(colour = "black"),
            axis.title.x = element_text(size=14, face="bold"),
            axis.title.y = element_text(size=14, face="bold"),
            legend.position="none") +
      xlab("") +
      ylab("")
ga1 <- ggplotly(a1, tooltip=c("label", "y", "x"))
ga2 <- ggplotly(a2, tooltip=c("label", "y", "x"))

I then created subplots for the plots:

fig <- subplot(da1, da2)
fig2 <- subplot(ga1, ga2)

I would like to create a dropdown menu where a choice between Fig and Fig2 is shown and that the plots change when chosen specific option.

I scoured through stackoverflow but I couldn't find anyone doing the dropdown menus with ggplots. The closest answer I found was here Generating Dropdown menu for Plotly charts but the response doesn't make sense in my head. Would anybody be so kind in helping me with this issue - I want to stay using ggplots generated wiht the method I have shown above.

1 Answers1

0

Plotly's dropdown functionality is for within-plot changes. If you want an entire plot to either be visible or not, you have to use alternative options.

This solution uses the libraries htmltools and shinyRPG, (This is not a Shiny app. I'm just using a function from this library.

Your question isn't reproducible, but you asked it a long time ago, so I just used the iris dataset. I'm going to add the graphs I built for this, so you can see it all together, as well.

library(tidyverse)
library(plotly)
library(ggpubr)    # ggdensity
library(htmltools) # browsable, tags
library(shinyRPG) # devtools::install_github("RinteRface/shinyRPG")

# re-creation of your plots (without some of the aesthetics)
data(iris)

da1 <- ggdensity(iris, x = "Sepal.Length", add = "mean",
                 rug = T, color = "Species")

da2 <- ggdensity(iris, x = "Sepal.Width", add = "mean",
                 rug = T, color = "Species")

a1 <- ggplot(iris, aes(x = Species, y = Petal.Length, fill = Species)) +
  geom_violin() + geom_point()

a2 <- ggplot(iris, aes(x = Species, y = Petal.Width, fill = Species)) +
  geom_violin() + geom_point()

ga1 <- ggplotly(a1, tooltip=c("y", "x"))
ga2 <- ggplotly(a2, tooltip=c("y", "x"))

fig <- subplot(da1, da2)
fig2 <- subplot(ga1, ga2)

Now, I'm going to use that shinyRPG library for the function rpgSelect. This function creates the HTML for the dropdown.

tagSel <- rpgSelect(
  "selectBox",
  "Select a Subplot: ",
  c(setNames(1:2, paste0("Subplot ", 1:2))),# left: option values (1, 2)
                                            # right: option labels (Subplot 1, Subplot 2)
  multiple = F)
tagSel$attribs$class <- 'select'       # assign class label to options box
tagSel$children[[2]]$attribs$onchange <- "getOps(this)" # connect dropdown with plots

If you wanted to see what this created, you can just call tagSel.

tagSel
# <div class="select">
#   <label id="selectBox-label" for="selectBox">Select a Subplot: </label>
#   <select id="selectBox" class="rpgui-dropdown" onchange="getOps(this)">
#     <option value="1" selected>Subplot 1</option>
#     <option value="2">Subplot 2</option>
#   </select>
# </div> 

Now using browsable and a few other functions from htmltools, I added the Javascript function that connects the dropdown with the plots, a separate Javascript function that stacks the plots on top of each other, and created a container for the dropdown menu and plots.

I also added styling. Some of this styling (like colors, font sizes, etc.) isn't necessary for this to work. You can add or remove things until it looks like what you are looking for.

browsable(tagList(list(
  tags$head(
    tags$script(HTML("setTimeout(function(){ /* stack subplots */
            $('[id^=\"htmlwidget-\"]').css({top: 50, position:'absolute',
                                            'z-index': -10}); /* bury one */
            $('[id^=\"htmlwidget-\"]').first().css({'z-index': 1000}); /* show one */
            }, 100)")),
    tags$script(HTML("function getOps(sel) { /* activate select */
            graphy = document.querySelectorAll('[id^=\"htmlwidget-\"]');
            $('[id^=\"htmlwidget-\"]').css({'z-index': -10});
            for(i = 0; i < sel.length; i++) { /* only 2 options */
              opt = sel.options[i];
              if ( opt.selected ) {
                console.log(opt);
                graphy[i].style.zIndex = '1000';  /* bury or show it */
              } else {
                graphy[1].style.zIndex = '-10';
              }
            }
          }")),
    tags$style(".select{ 
                 position: relative; border-radius: 5px; 
                 border: 2px solid #003b70;
                 margin: 0 2px; padding: 2px;
                 font-size: 1.1em;
                 text-align: center; line-height: 1.25em;
               }
               #selectBox{
                 background-color: #003b70;
                 text-align: center; color: white; 
                 font-size: .9em; line-height: 1.25em;
               }
               .goLeft{
                position: relative; float: left; width: 100%; }
               .notRight{ float: left; }")),
  div(div(class = "notRight", tagSel),
      div(class = "goLeft",
          fig, fig2))))) # which ever plot is listed first is option 1

enter image description here

enter image description here

enter image description here

Kat
  • 15,669
  • 3
  • 18
  • 51