CODEWITHSUNDEEP
rshinyplotlyhighlighthtmlwidgets
Iqbal Adjali
Iqbal Adjali

Reputation: 23

Why does shiny App add a spurious widget to a Plotly graph using highlight function and selectize=TRUE?

I produced a graph with ggplotly to display the results that 10 participants achieved in three tests. The graph shows both a scatter plot (individual participants) and summary statistics (boxplot) grouped by experiment. I added a highlight function with selectize set to TRUE, so that the user can search for a particular participant in a filter_select box and highlight the participant's results on the graph.

When I run the code without shiny I get what's expected, that is the graph with a filter_select box above it to search for participants. But when I render the Plotly graph within a shiny app, I get an additional widget that doesn't seem to do anything but does really confuse the layout (run the Shiny App code below to see the effect).

library(shiny)
library(plotly)
library(shinyWidgets)

dataset <- tibble(Name=rep(LETTERS[1:10],3),Result=sample(100,30),
                  Experiment=c(rep("T1",10),rep("T2",10),rep("T3",10)))

ui <- fluidPage(
  fluidRow(
       column(width = 10, offset = 1,
              plotlyOutput("graph")
       )
  )
)

server <- function(input, output, session) {

output$graph <- renderPlotly({

d <- highlight_key(dataset,~Name,group="Select participant")

p <- ggplot(d,aes(Experiment,Result,fill=Experiment,text=paste0("<b>Name: ",
                                          Name,"</b><br />Result: ",Result,"%"))) +
  geom_boxplot()+
  geom_point(size=2,position=position_jitterdodge(dodge.width = 0.4)#,
  )+ggtitle("Results by Experiment (all subjects)")+
  theme(legend.position="none",axis.text.x=element_text(size=15),
                 axis.title.x=element_text(color="red",size=15))

p <- ggplotly(p,tooltip=c("text"))

p <- style(p,hoverlabel=list(bgcolor="white",bordercolor="black",font="Arial"))

highlight(p,on="plotly_click",off="plotly_doubleclick",selectize=TRUE,color="green")
})
}

shinyApp(ui, server)

I'd like to get this spurious widget removed from the plotlyOutput; I have looked through numerous questions and answers on the shiny-plotly-highlight topic but none had anything similar to the problem I am having. I wonder whether anyone out there has come up against this issue and found a solution. I'd really appreciate any help with this.

Upvotes: 2

Views: 353

Answers (2)

Andrew Foudree
Andrew Foudree

Reputation: 26

@StéphaneLaurent @IqbalAdijali Thanks so much! You are the best! I was looking all over for a solution for this. You have inspired me to learn java script after this moment.

I will add for others wanting to implement the JS code above - I pasted it into the UI in a tabPanel exactly like this (do not forget to change the plot name! "graph", or "plot_15" in this case, to your plots name):

tags$head(tags$script(HTML(
'
$(document).on("shiny:value", function(e){
if(e.name === "plot_15"){
setTimeout(function(){
$("#plot_15").prev().children()[1].style.display = "none";
}, 0);
}
});
'
))

Also, you may need to add a comma or parenthesis to separate expressions or close statements respectively.

Upvotes: 1

St&#233;phane Laurent
St&#233;phane Laurent

Reputation: 84649

Looks like a bug. You can hide this widget like this:

ui <- fluidPage(
  fluidRow(
    column(width = 10, offset = 1,
           plotlyOutput("graph")
    )
  ),
  tags$script(
    "setTimeout(function(){$('#graph').prev().children()[1].style.display = 'none';}, 500);"
  )
)

EDIT

Here is a better solution:

js <- '
$(document).on("shiny:value", function(e){
  if(e.name === "graph"){
    setTimeout(function(){
      $("#graph").prev().children()[1].style.display = "none";
    }, 0);
  }
});
'

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),
  fluidRow(
    column(width = 10, offset = 1,
           plotlyOutput("graph")
    )
  )
)

Upvotes: 2

Related Questions