Как обновить показать / скрыть следы графического виджета в R блестящий в ответ на кнопки действий без повторного рендеринга

Question

Я ищу способ связать actionButton клики с legend статусом true/legendonly, который не вызывает повторного rendering объекта plotly, а вместо этого изменяетwidget.Текущее демо-приложение внизу достигает ссылки, но делает это путем полной перерисовки сюжета.

Я стремлюсь связать кнопки, которые показывают, сохранить / отбросить кластер, с визуализацией данных на графике в обоих направлениях таким образом, чтобы график обновлялся, а не отображался .Мое текущее решение вызывает полный рендеринг.

Взаимодействие заключается в том, что т.е. кнопки изменяют легенду / сюжет и кнопки меняют легенду.

Я добавил несколько изображений для объяснения рабочих процессов.

Я построил тестовую версию для большего графика в моем еще большем приложении, где у пользователя есть такой вид:

Здесь пользователь может выбрать, какие кластеры удалить для дальнейшей обработки, с помощью кнопок ввода / вывода.

Благодаря предыдущему вопросу здесь Теперь у меня есть тестовое приложение, в котором: - 1 нажатие на легенду изменяет график, а статус кнопки слева, чтобы пользователь мог использовать графиксделать выбор IN / OUT - 2 Каждый раз, когда график перерисовывается, он теперь также активирует предыдущий статус показа / скрытия каждой трассы.

точка 1 - это рабочий процесс: точка два - просто код графика, использующий эту строку кода перед onRender

  if(values$colors) { for(i in seq_along(p1$x$data)){
  p1$x$data[[i]]$visible <- values$legenditems[[p1$x$data[[i]]$name]]}
}
 p1 %>% onRender(js, data = "tracesPlot1")

в настоящее время также третье взаимодействие, которое вызывает скрытие следов, когда пользователь нажимает кнопку.Этот подход является проблемой здесь.В настоящее время он соответствует оранжевому потоку на диаграмме ниже, но я надеюсь изменить это с помощью решения javascript, которое позволяет избежать повторного рендеринга графика:

ДЕМО ПРИЛОЖЕНИЕ

library(plotly)
library(shiny)
library(htmlwidgets)

js <- c(
  "function(el, x, inputName){",
  "  var id = el.getAttribute('id');",
  "  var d3 = Plotly.d3;",
  "  el.on('plotly_restyle', function(evtData) {",
  "    var out = {};",
  "    d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){",
  "      var trace = d3.select(this)[0][0].__data__[0].trace;",
  "      out[trace.name] = trace.visible;",
  "    });",
  "    Shiny.setInputValue(inputName, out);",
  "  });",
  "}")

YNElement <-    function(idx){sprintf("YesNo_button-%d", idx)}

ui <- fluidPage(
  fluidRow(
    column(2,
           h5("Keep/Drop choices linked to colorscheme 1"),
           uiOutput('YNbuttons')
    ),
    column(8,
           plotlyOutput("plot1")
    ),
    column(2,
           h5('Switch grouping'),
           actionButton(inputId = 'Switch', label = icon('refresh'), style = "color: #f7ad6e;   background-color: white;  border-color: #f7ad6e;
                        height: 40px; width: 40px; border-radius: 6px;  border-width: 2px; text-align: center;  line-height: 50%; padding: 0px; display:block; margin: 2px")
           ), style = "margin-top:150px"
    ),
  verbatimTextOutput("tracesPlot1"),
  verbatimTextOutput("tracesPlot2")

  )

server <- function(input, output, session) {
  values <- reactiveValues(colors = T, NrOfTraces = length(unique(mtcars$cyl)))


  output$plot1 <- renderPlotly({
    print('plotting!')
    if(values$colors) { colors <- c('red', 'blue', 'green') } else {colors <- c('black', 'orange', 'gray')}
    p1 <- plot_ly()
    p1 <-  add_trace(p1, data = mtcars, x = ~disp, y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl), colors = colors)
    p1 <- layout(p1, title = 'mtcars group by cyl with switching colors')
    p1 <- plotly_build(p1)

    if(values$colors) { for(i in seq_along(p1$x$data)){
      p1$x$data[[i]]$visible <- values$legenditems[[p1$x$data[[i]]$name]]}
    }
     p1 %>% onRender(js, data = "tracesPlot1")
  })


  observeEvent(input$Switch, { values$colors <- !values$colors    })

  ##### THIS BLOCK links buttons -> plot, but causes it to render all over again
### this interaction is what I would like to replace by javascript

    observeEvent(values$dYNbs_cyl_el, {
      legenditems <- values$dYNbs_cyl_el
      legenditems[which(legenditems == FALSE)] <- 'legendonly'
      legenditems[which(legenditems == TRUE )] <- 'TRUE'
      names(legenditems) <- sort(unique(mtcars$cyl))
      values$legenditems <- as.list(legenditems)
    })


  observeEvent(values$NrOfTraces, { 
    values$dYNbs_cyl_el <- rep(T,values$NrOfTraces)
    names(values$dYNbs_cyl_el) <- sapply(1:values$NrOfTraces, function(x) {YNElement(x)})
  })

  output$YNbuttons <- renderUI({
    req(values$NrOfTraces)
    lapply(1:values$NrOfTraces, function(el) {
      YNb <- YNElement(el)
      if(values$dYNbs_cyl_el[[YNb]] == T ) {
        div(actionButton(inputId = YNb, label = icon("check"), style = "color: #339FFF;   background-color: white;  border-color: #339FFF;height: 34px; width: 34px; border-radius: 6px;  border-width: 2px; text-align: center;  line-height: 50%; padding: 0px; display:block; margin: 2px"))
      } else {
        div(actionButton(inputId = YNb, label = icon("times"), style = "color: #ff4d4d;   background-color: white;  border-color: #ff4d4d;height: 34px; width: 34px; border-radius: 6px;  border-width: 2px; text-align: center;  line-height: 50%; padding: 0px; display:block; margin: 2px"))
      }
    })
  })  

  flipYNb_FP1 <- function(idx){
    YNb <- YNElement(idx)
    values$dYNbs_cyl_el[[YNb]] <- !values$dYNbs_cyl_el[[YNb]]
  }

  observe({
    lapply(1:values$NrOfTraces, function(ob) {
      YNElement <- YNElement(ob)
      observeEvent(input[[YNElement]], {
        flipYNb_FP1(ob)
      }, ignoreInit = T)
    })
  })

  observeEvent(input$tracesPlot1, {
    listTraces <- input$tracesPlot1
    values$legenditems <- listTraces ## this line would save the legend status even if we remove the observer for the values$dYNbs_cyl_el list
    listTracesTF <- gsub('legendonly', FALSE, listTraces)
    listTracesTF <- as.logical(listTracesTF)
    lapply(1:values$NrOfTraces, function(el) {
      if(el <= length(listTracesTF)) {
        YNb <- YNElement(el)
        if(values$dYNbs_cyl_el[[YNb]] != listTracesTF[el]) {
          values$dYNbs_cyl_el[[YNb]] <- listTracesTF[el]
        }
      }
    })
  })

  output$tracesPlot1 <- renderPrint({ unlist(input$tracesPlot1)  })
  output$tracesPlot2 <- renderPrint({ unlist(values$legenditems)  })


}
shinyApp(ui, server)

ОБНОВЛЕНО Тестовое приложение с попыткой использовать ответ.не работает до сих пор

library(plotly)
library(shiny)
library(htmlwidgets)

# js <- c(
#   "function(el, x, inputName){",
#   "  var id = el.getAttribute('id');",
#   "  var d3 = Plotly.d3;",
#   "  el.on('plotly_restyle', function(evtData) {",
#   "    var out = {};",
#   "    d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){",
#   "      var trace = d3.select(this)[0][0].__data__[0].trace;",
#   "      out[trace.name] = trace.visible;",
#   "    });",
#   "    Shiny.setInputValue(inputName, out);",
#   "  });",
#   "}")


js2 <- c(
"function(el, x, inputName){",
"  var id = el.getAttribute('id');",
"  if(id == inputName){",
"    var data = el.data;",
"    $('[id^=btn]').on('click', function() {",
"      var index = parseInt(this.id.split('-')[1]);",
"       var trace = index -1; ",
"      var v0 = data[trace].visible || true;",
"      var v = v0 == true ? 'legendonly' : true;",
"      Plotly.restyle(el, {visible: v}, [trace]);",
"    });",
"  }",
"}")


YNElement <-    function(idx){sprintf("btn-%d", idx)}

ui <- fluidPage(
  fluidRow(
    column(2,
           h5("Keep/Drop choices linked to colorscheme 1"),
           uiOutput('YNbuttons')
    ),
    column(8,
           plotlyOutput("plot1")
    ),
    column(2,
           h5('Switch grouping'),
           actionButton(inputId = 'Switch', label = icon('refresh'), style = "color: #f7ad6e;   background-color: white;  border-color: #f7ad6e;
                        height: 40px; width: 40px; border-radius: 6px;  border-width: 2px; text-align: center;  line-height: 50%; padding: 0px; display:block; margin: 2px")
           ), style = "margin-top:150px"
    ),
  verbatimTextOutput("tracesPlot1"),
  verbatimTextOutput("tracesPlot2")

  )

server <- function(input, output, session) {
  values <- reactiveValues(colors = T, NrOfTraces = length(unique(mtcars$cyl)))

  output$plot1 <- renderPlotly({
    print('plotting!')

    values$legenditemNames <- sort(unique(mtcars$cyl))

    if(values$colors) { colors <- c('red', 'blue', 'green') } else {colors <- c('black', 'orange', 'gray')}
    p1 <- plot_ly()
    p1 <-  add_trace(p1, data = mtcars, x = ~disp, y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl), colors = colors)
    p1 <- layout(p1, title = 'mtcars group by cyl with switching colors')
    p1 <- plotly_build(p1)

    if(values$colors) { for(i in seq_along(p1$x$data)){
      p1$x$data[[i]]$visible <- values$legenditems[[p1$x$data[[i]]$name]]}
    }
     p1 %>% onRender(js2, data = "tracesPlot1")
  })


  observeEvent(input$Switch, { values$colors <- !values$colors    })

  ##### THIS BLOCK links buttons -> plot, but causes it to render all over again
    # observeEvent(values$dYNbs_cyl_el, {
    #   legenditems <- values$dYNbs_cyl_el
    #   legenditems[which(legenditems == FALSE)] <- 'legendonly'
    #   legenditems[which(legenditems == TRUE )] <- 'TRUE'
    #   names(legenditems) <- values$legenditemNames
    #   values$legenditems <- as.list(legenditems)
    # })


  observeEvent(values$NrOfTraces, { 
    values$dYNbs_cyl_el <- rep(T,values$NrOfTraces)
    names(values$dYNbs_cyl_el) <- sapply(1:values$NrOfTraces, function(x) {YNElement(x)})
  })

  output$YNbuttons <- renderUI({
    req(values$NrOfTraces)
    lapply(1:values$NrOfTraces, function(el) {
      YNb <- YNElement(el)
      if(values$dYNbs_cyl_el[[YNb]] == T ) {
        div(actionButton(inputId = YNb, label = icon("check"), style = "color: #339FFF;   background-color: white;  border-color: #339FFF;height: 34px; width: 34px; border-radius: 6px;  border-width: 2px; text-align: center;  line-height: 50%; padding: 0px; display:block; margin: 2px"))
      } else {
        div(actionButton(inputId = YNb, label = icon("times"), style = "color: #ff4d4d;   background-color: white;  border-color: #ff4d4d;height: 34px; width: 34px; border-radius: 6px;  border-width: 2px; text-align: center;  line-height: 50%; padding: 0px; display:block; margin: 2px"))
      }
    })
  })  

  flipYNb_FP1 <- function(idx){
    YNb <- YNElement(idx)
    values$dYNbs_cyl_el[[YNb]] <- !values$dYNbs_cyl_el[[YNb]]
  }

  observe({
    lapply(1:values$NrOfTraces, function(ob) {
      YNElement <- YNElement(ob)
      observeEvent(input[[YNElement]], {
        flipYNb_FP1(ob)
      }, ignoreInit = T)
    })
  })

  observeEvent(input$tracesPlot1, {
    listTraces <- input$tracesPlot1
    values$legenditems <- listTraces
    listTracesTF <- gsub('legendonly', FALSE, listTraces)
    listTracesTF <- as.logical(listTracesTF)
    lapply(1:values$NrOfTraces, function(el) {
      if(el <= length(listTracesTF)) {
        YNb <- YNElement(el)
        if(values$dYNbs_cyl_el[[YNb]] != listTracesTF[el]) {
          values$dYNbs_cyl_el[[YNb]] <- listTracesTF[el]
        }
      }
    })
  })

  output$tracesPlot1 <- renderPrint({ unlist(input$tracesPlot1)  })
  output$tracesPlot2 <- renderPrint({ unlist(values$legenditems)  })


}
shinyApp(ui, server)

Answer 1

Не могли бы вы попробовать это:

library(plotly)
library(shiny)
library(htmlwidgets)

js <- c(
  "function(el, x){",
  "  var data = el.data;",
  "  $('#btn').on('click', function() {",
  "    var traceName = $('#selector').val();",
  "    $.each(data, function(index,value){",
  "      if(value.name == traceName){",
  "        var v0 = data[index].visible || true;",
  "        var v = v0 == true ? 'legendonly' : true;",
  "        Plotly.restyle(el, {visible: v}, [index]);",
  "      }",
  "    });",
  "  });",
  "}")

ui <- fluidPage(
  plotlyOutput("plot"),
  selectInput("selector", "", choices = c("drat", "wt", "qsec")),
  actionButton("btn", "Show/hide")
)

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

  output$plot <- renderPlotly({
    p <- plot_ly()
    for(name in c("drat", "wt", "qsec"))
    {
      p = add_markers(p, x = as.numeric(mtcars$cyl), y = as.numeric(mtcars[[name]]), name = name)
    }
    p %>% onRender(js)
  })

}

shinyApp(ui, server)

---

В случае, если у вас есть несколько участков:

js <- c(
  "function(el, x, plotid){",
  "  var id = el.getAttribute('id');",
  "  if(id == plotid){",
  "    var data = el.data;",
  "    $('#btn').on('click', function() {",
  "      var traceName = $('#selector').val();",
  "      $.each(data, function(index,value){",
  "        if(value.name == traceName){",
  "          var v0 = data[index].visible || true;",
  "          var v = v0 == true ? 'legendonly' : true;",
  "          Plotly.restyle(el, {visible: v}, [index]);",
  "        }",
  "      });",
  "    });",
  "  }",
  "}")

затем

  output$plot <- renderPlotly({
    p <- plot_ly()
    for(name in c("drat", "wt", "qsec"))
    {
      p = add_markers(p, x = as.numeric(mtcars$cyl), y = as.numeric(mtcars[[name]]), name = name)
    }
    p %>% onRender(js, data = "plot")
  })

---

Если у вас есть несколько кнопок, по одной для каждой трассы:

js <- c(
  "function(el, x, plotid){",
  "  var id = el.getAttribute('id');",
  "  if(id == plotid){",
  "    var data = el.data;",
  "    $('[id^=btn]').on('click', function() {",
  "      var index = parseInt(this.id.split('-')[1]);",
  "      var v0 = data[index].visible || true;",
  "      var v = v0 == true ? 'legendonly' : true;",
  "      Plotly.restyle(el, {visible: v}, [index]);",
  "    });",
  "  }",
  "}")

ui <- fluidPage(
  plotlyOutput("plot"),
  actionButton("btn-0", "drat"),
  actionButton("btn-1", "wt")
)

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

  output$plot <- renderPlotly({
    p <- plot_ly()
    for(name in c("drat", "wt", "qsec"))
    {
      p = add_markers(p, x = as.numeric(mtcars$cyl), y = as.numeric(mtcars[[name]]), name = name)
    }
    p %>% onRender(js, data = "plot")
  })

}

shinyApp(ui, server)

---

Это не работает для вашего примера.Это потому, что кнопки создаются с помощью renderUI, и они еще не существуют, когда график отображается в первый раз.

Единственное решение, которое мне удалось найти, - это следующее.Вместо того, чтобы прикреплять прослушиватели событий onclick к обратному вызову сюжета, я прикрепляю их в атрибуте кнопок onclick:

js <- c(
  "function toggleLegend(id){",
  "  var plot = document.getElementById('plot1');",
  "  var data = plot.data;",
  "  var index = parseInt(id.split('-')[1]) - 1;",
  "  var v0 = data[index].visible || true;",
  "  var v = v0 == true ? 'legendonly' : true;",
  "  Plotly.restyle(plot, {visible: v}, [index]);",
  "}")

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),
  fluidRow(
    ......

  output$YNbuttons <- renderUI({
    req(values$NrOfTraces)
    lapply(1:values$NrOfTraces, function(el) {
      YNb <- YNElement(el)
      if(values$dYNbs_cyl_el[[YNb]] == TRUE) {
        div(actionButton(inputId = YNb, label = icon("check"), 
                         style = "color: #339FFF;   background-color: white;  border-color: #339FFF;height: 34px; width: 34px; border-radius: 6px;  border-width: 2px; text-align: center;  line-height: 50%; padding: 0px; display:block; margin: 2px", 
                         onclick = "toggleLegend(this.id);"))
      } else {
        div(actionButton(inputId = YNb, label = icon("times"), 
                         style = "color: #ff4d4d;   background-color: white;  border-color: #ff4d4d;height: 34px; width: 34px; border-radius: 6px;  border-width: 2px; text-align: center;  line-height: 50%; padding: 0px; display:block; margin: 2px", 
                         onclick = "toggleLegend(this.id);"))
      }
    })
  })  

И без использования onRender.

Но это работает только для одного сюжета.Если вы хотите связать кнопки с несколькими графиками, предполагая, что идентификатор кнопок имеет форму btn-plot2-5, то выполните:

js <- c(
  "function toggleLegend(id){",
  "  var ids = id.split('-');",
  "  var plotid = ids[1];",
  "  var index = parseInt(ids[2])-1;",
  "  var plot = document.getElementById(plotid);",
  "  var data = plot.data;",
  "  var v0 = data[index].visible || true;",
  "  var v = v0 == true ? 'legendonly' : true;",
  "  Plotly.restyle(plot, {visible: v}, [index]);",
  "}")