Почему блестящее приложение добавляет ложный виджет на график Plotly с помощью функции подсветки и selectize = TRUE? - PullRequest
2 голосов
/ 08 марта 2020

Я создал график с помощью ggplotly для отображения результатов, которых 10 участников достигли в трех тестах. На графике показаны как точечная диаграмма (отдельные участники), так и сводная статистика (коробочная диаграмма), сгруппированные по экспериментам. Я добавил функцию выделения, в которой для selectize установлено значение TRUE, чтобы пользователь мог искать конкретного участника в поле filter_select и выделять результаты участника на графике.

Когда я запускаю код без «блеска», я получаю Ожидается, что это график с окном filter_select над ним для поиска участников. Но когда я рендерил график Plotly в блестящем приложении, я получаю дополнительный виджет, который, кажется, ничего не делает, но действительно запутывает макет (запустите приведенный ниже код Shiny App, чтобы увидеть эффект).

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)

Я бы хотел удалить этот поддельный виджет из plotlyOutput; Я просмотрел многочисленные вопросы и ответы по блестящему сюжету topi c, но ни у одного из них не было ничего похожего на проблему, с которой я столкнулся. Интересно, кто-нибудь там сталкивался с этой проблемой и нашел решение. Буду очень признателен за любую помощь в этом.

1 Ответ

2 голосов
/ 08 марта 2020

Похоже, ошибка. Вы можете скрыть этот виджет следующим образом:

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

РЕДАКТИРОВАТЬ

Вот лучшее решение:

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