Mel
Mel

Reputation: 11

How to change plots with Plotly button?

I am trying to create an interactive graph where you can toggle between 4 different bar charts. I have this code that successfully makes 1 bar chart with a button with 4 options, however it is only showing parts of the first plot on each toggle page, not the different plots. Any ideas on how to fix this?

barp <- ggplot(data = dat, aes(x = AnnualIncome_Label, fill = interest_Label)) +
  geom_bar(position = "fill") +
  xlab("Annual Income") +
  ylab("Proportion") +
  ggtitle("Proportional Interest in Clinical Trials by Income") +
  labs(fill = "Clinical Trial Interest Level") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_fill_manual(values = c("khaki2", "lemonchiffon1", "#DADAEB", "#9E9AC8", "#6A51A3"))

# Stacked bar chart for "Education" and "Interest_Label"
plot2 <- ggplot(data = dat, aes(x = Ed_Label, fill = interest_Label)) +
  geom_bar(position = "fill") +
  xlab("Education Level") +
  ylab("Proportion") +
  ggtitle("Proportional Interest in Clinical Trials by Education Level") +
  labs(fill = "Clinical Trial Interest Level") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_fill_manual(values = c("khaki2", "lemonchiffon1", "#DADAEB", "#9E9AC8", "#6A51A3"))

# Stacked bar chart for "EnglishProf_Label" and "Interest_Label"
plot3 <- ggplot(data = dat, aes(x = EnglishProf_Label, fill = interest_Label)) +
  geom_bar(position = "fill") +
  xlab("English Proficiency Label") +
  ylab("Proportion") +
  ggtitle("Proportional Interest in Clinical Trials by English Proficiency") +
  labs(fill = "Clinical Trial Interest Level") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_fill_manual(values = c("khaki2", "lemonchiffon1", "#DADAEB", "#9E9AC8", "#6A51A3"))

# Stacked bar chart for "HelpMedLit_Label" and "Interest_Label"
plot4 <- ggplot(data = dat, aes(x = HelpMedLit_Label, fill = interest_Label)) +
  geom_bar(position = "fill") +
  xlab("Help with Medical Literacy Label") +
  ylab("Proportion") +
  ggtitle("Proportional Interest in Clinical Trials by Help Understanding Medical Literature") +
  labs(fill = "Clinical Trial Interest Level") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1), 
    legend.position = "none") +
  guides(fill = FALSE) +
  scale_fill_manual(values = c("khaki2", "lemonchiffon1", "#DADAEB", "#9E9AC8", "#6A51A3"))

plotly_plot1 <- ggplotly(plot1)
plotly_plot2 <- ggplotly(plot2)
plotly_plot3 <- ggplotly(plot3)
plotly_plot4 <- ggplotly(plot4)


plotly_plots <- list(plotly_plot1, plotly_plot2, plotly_plot3, plotly_plot4)


# Create buttons for dropdown menu
buttons <- list(
  list(method = "restyle",
       args = list("visible", list(TRUE, FALSE, FALSE, FALSE)),
       label = "Plot 1"),
  list(method = "restyle",
       args = list("visible", list(FALSE, TRUE, FALSE, FALSE)),
       label = "Plot 2"),
  list(method = "restyle",
       args = list("visible", list(FALSE, FALSE, TRUE, FALSE)),
       label = "Plot 3"),
  list(method = "restyle",
       args = list("visible", list(FALSE, FALSE, FALSE, TRUE)),
       label = "Plot 4")
)
initial_fig <- plotly_plots[[1]]

initial_fig <- initial_fig %>%layout(
  title = "Dropdown Menu - Plot Selection",
  updatemenus = list(
    list(
      buttons = buttons
    )
  )
)
initial_fig

I want the button or the drop-down menu to change between plotly_plots <- list(plotly_plot1, plotly_plot2, plotly_plot3, plotly_plot4)

right now it it looks like its just breaking up plotly_plot1 into 4.

Upvotes: 1

Views: 85

Answers (1)

Kat
Kat

Reputation: 18754

When you use buttons, restyle only affects the trace, not the layout. Additionally, visibility is per trace, generally this equates to per color in a discretely colored plot.

BTW: It looks like you're new to SO; welcome to the community! If you want great answers quickly, it's best to make your question reproducible. This includes sample data like the output from dput() or reprex::reprex(). Check it out: making R reproducible questions.

See if this method meets your expectations.

Since your question isn't reproducible, I used the base R data mtcars. And I made two arbitrary bar plots with ggplot2 to demo with.

library(tidyverse)
library(plotly)
library(htmltools)

# prep data
mtc <- mtcars %>% mutate(cyl = as.factor(cyl), across(vs:carb, as.factor))

# plots used to demo
(p1 <- ggplot(mtc, aes(cyl, fill = gear)) + geom_bar(position = "fill"))
(p2 <- ggplot(mtc, aes(cyl, fill = carb)) + geom_bar(position = "fill"))

This next bit combines the function htmltools::browsable, a Javascript function to stack the plots on top of each other, a Javascript function to interpret the dropdown menu, the dropdown menu, and the two plots.

When you see tags$option(value = "B", "B") this is setting the name you see in the dropdown menu. It does not matter what you name this, whether it's A, B, or hippopotamus the first name (A here) will connect the first plot listed in the next div( (the last line of code - ggplotly(p1) here). Each option must have a unique value, though.

You'll see these labels and the plots in the last three lines of this code. For example, in your question, you labeled your first button "Plot 1", to use that label in the dropdown using this code, you would change tags$option(value = "A", selected = NA, "A") to tags$option(value = "A", selected = NA, "Plot 1")

If you have 4 plots, you need 4 tags$option with value and label specified. Only the first option will include selected = NA.

browsable(
  tagList(
    tags$head(
      tags$script(HTML(
        "setTimeout(function(){                         /* stack plots */
            $('[id^=\"htmlwidget-\"]').css({top: '20vh',  /* add button space */
                                            position:'absolute',
                                            'z-index': -10});
            $('[id^=\"htmlwidget-\"]').first().css({'z-index': 1000});
          }, 100)")),
      tags$script(HTML(
        "function getOps(sel) {                         /* activate dropdown */
            graphy = document.querySelectorAll('[id^=\"htmlwidget-\"]');
            $('[id^=\"htmlwidget-\"]').css({'z-index': -10});
            for(i = 0; i < sel.length; i++) {
              opt = sel.options[i];
              if ( opt.selected ) {
                console.log(opt);
                graphy[i].style.zIndex = '1000';
              } else {
                graphy[1].style.zIndex = '-10';
              }
            }
          }"))),
    div(div(tags$label(id = "sb-lab", "for" = "sb", "Plots:"),  # dropdown menu
            tags$select(class = "dropdown form-control", id = "sb", 
                        onchange = "getOps(this)",              # call the JS function
                        tags$option(value = "A", selected = NA, "A",),
                        tags$option(value = "B", "B"))),
        div(ggplotly(p1), ggplotly(p2)))
  ))

enter image description here

If you can imagine it, you can customize it. However, I don't know exactly what you're looking for, just let me know in comments.

Upvotes: 2

Related Questions