Стирание всех значений selectizeInput() без закрытия приложения Shiny после вызова onRender()

Question

Я пытаюсь создать приложение Shiny для исследования фрейма данных с 4 переменными / столбцами (A, B, C, D) и 10000 строк. Существует поле ввода, в котором пользователи должны выбрать 2 из 4 переменных / столбцов. Как только они это сделали, справа отображается диаграмма рассеяния. Диаграмма рассеяния представляет собой объект Plotly с шестиугольным биннингом, суммирующим значения 10000 строк между двумя выбранными пользователем переменными / столбцами.

На данный момент пользователь может выбрать "Go!" кнопка, которая вызывает наложение оранжевой точки, соответствующей первому ряду этих 2 переменных / столбцов, на объект Plotly. Пользователь может последовательно выбрать "Go!" и затем оранжевая точка, соответствующая второму, третьему, четвертому и т. д. ряду, будет наложена на объект Plotly. Имя идентификатора строки выводится над матрицей диаграммы рассеяния.

По большей части приложение работает. Есть только две вещи, которые я пытаюсь улучшить:

1) Я бы хотел, чтобы пользователь мог выбирать новые пары в поле ввода. Это работает по большей части. Тем не менее, есть одна конкретная ситуация, когда приложение может внезапно закрыться. Это происходит после того, как оранжевая точка была наложена на диаграмму рассеяния. Если пользователь затем удаляет две пары ввода, приложение внезапно закрывается. Я хотел бы, чтобы пользователь мог стереть оба значения входной пары и ввести два новых значения пары без закрытия приложения даже после того, как оранжевые точки были нанесены на диаграмму рассеяния.

2) Я заметил, что вывод идентификатора строки несколько отстает после построения оранжевой точки. Интересно, почему это происходит, так как я вывожу идентификатор строки перед нанесением оранжевой точки в сценарии. Я бы предпочел, чтобы отставание было меньше, но я не уверен, как к этому приблизиться.

Будем весьма благодарны за любые предложения о том, как решить любую из этих двух проблем! Мой MWE, показывающий эту проблему, ниже.

library(plotly)
library(GGally)
library(hexbin)
library(htmlwidgets)
library(tidyr)
library(shiny)
library(dplyr)
library(data.table)
library(ggplot2)
library(tibble)

myPairs <- c("A", "B", "C", "D")

ui <- shinyUI(fluidPage(
  titlePanel("title panel"),

  sidebarLayout(position = "left",
    sidebarPanel(
      selectizeInput("selPair", "Pairs:", choices = myPairs, multiple = TRUE, options = list(maxItems = 2)),
      actionButton("goButton", "Go!"),
      width = 3
    ),
    mainPanel(
      verbatimTextOutput("info"),
      plotlyOutput("scatMatPlot")
    )
  )
))

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

  # Create data and subsets of data based on user selection of pairs
  dat <- data.frame(ID = paste0("ID", 1:10000), A = rnorm(10000), B = rnorm(10000), C = rnorm(10000), D = rnorm(10000))
  pairNum <- reactive(input$selPair)
  group1 <- reactive(pairNum()[1])
  group2 <- reactive(pairNum()[2])
  sampleIndex <- reactive(which(colnames(dat) %in% c(group1(), group2())))

  # Create data subset based on two letters user chooses
  datSel <- eventReactive(sampleIndex(), {
    datSel <- dat[, c(1, sampleIndex())]
    datSel$ID <- as.character(datSel$ID)
    datSel <- as.data.frame(datSel)
    datSel
  })

  sampleIndex1 <- reactive(which(colnames(datSel()) %in% c(group1())))
  sampleIndex2 <- reactive(which(colnames(datSel()) %in% c(group2())))

  # Create background Plotly graph with hex binning all 100 rows of the two user-selected columns
  ggPS <- eventReactive(datSel(), {
    minVal = min(datSel()[,-1])
    maxVal = max(datSel()[,-1])
    maxRange = c(minVal, maxVal)
    xbins=7
    buffer = (maxRange[2]-maxRange[1])/xbins/2
    x = unlist(datSel()[,(sampleIndex1())])
    y = unlist(datSel()[,(sampleIndex2())])
    h <- hexbin(x=x, y=y, xbins=xbins, shape=1, IDs=TRUE, xbnds=maxRange, ybnds=maxRange)
    hexdf <- data.frame (hcell2xy (h),  hexID = h@cell, counts = h@count)
    attr(hexdf, "cID") <- h@cID
    p <- ggplot(hexdf, aes(x=x, y=y, fill = counts, hexID=hexID)) + geom_hex(stat="identity") + geom_abline(intercept = 0, color = "red", size = 0.25) + coord_cartesian(xlim = c(maxRange[1]-1*buffer, maxRange[2]+buffer), ylim = c(maxRange[1]-1*buffer, maxRange[2]+buffer)) + coord_equal(ratio=1) + labs(x = colnames(datSel()[sampleIndex1()]), y = colnames(datSel()[sampleIndex2()]))
    ggPS <- ggplotly(p)
    ggPS})

  # Output hex bin plot created just above
  output$scatMatPlot <- renderPlotly({
    # Each time user pushes Go! button, the next row of the data frame is selected
    datInput <- eventReactive(input$goButton, {
      g <- datSel()$ID[input$goButton]

      # Output ID of selected row
      output$info <- renderPrint({
        g
      })

      # Get x and y values of seleced row
      currGene <- datSel()[which(datSel()$ID==g),]
      currGene1 <- unname(unlist(currGene[,sampleIndex1()]))
      currGene2 <- unname(unlist(currGene[,sampleIndex2()]))
      c(currGene1, currGene2)
    })

    # Send x and y values of selected row into onRender() function
    observe({
      session$sendCustomMessage(type = "points", datInput())
    })

    # Use onRender() function to draw x and y values of seleced row as orange point
    ggPS() %>% onRender("
      function(el, x, data) {

      noPoint = x.data.length;

      Shiny.addCustomMessageHandler('points', function(drawPoints) {
        if (x.data.length > noPoint){
          Plotly.deleteTraces(el.id, x.data.length-1);
        }

        var Traces = [];
        var trace = {
          x: drawPoints.slice(0, drawPoints.length/2),
          y: drawPoints.slice(drawPoints.length/2, drawPoints.length),
          mode: 'markers',
          marker: {
            color: 'orange',
            size: 7
          },
          hoverinfo: 'none'
        };
        Traces.push(trace);
        Plotly.addTraces(el.id, Traces);
      });}")
    })
})

shinyApp(ui, server)

Answer 1

Как упомянул @HubertL, лучше избегать вложения реактивных функций. Ваше приложение, вероятно, будет работать более плавно, если вы измените это.

О вашей первой проблеме, req а также validate вероятно, лучший путь. Эти функции проверяют правильность введенных пользователем данных и обрабатывают недействительные.

Я немного подкорректировал ваш код, следуя этим предложениям, но вы все равно можете изменить его больше. Если вы посмотрите поближе к ggPS вы можете заметить, что он использует только datSel() так что вы можете превратить его в функцию.

library(plotly)
library(GGally)
library(hexbin)
library(htmlwidgets)
library(tidyr)
library(shiny)
library(dplyr)
library(data.table)
library(ggplot2)
library(tibble)
myPairs <- c("A", "B", "C", "D")

ui <- shinyUI(fluidPage(
  titlePanel("title panel"),
  sidebarLayout(
    position = "left",
    sidebarPanel(
      selectizeInput("selPair", "Pairs:", choices = myPairs, multiple = TRUE,
                     options = list(maxItems = 2)),
      actionButton("goButton", "Go!"),
      width = 3
    ),
    mainPanel(
      verbatimTextOutput("info"),
      plotlyOutput("scatMatPlot")
    )
  )
))

server <- shinyServer(function(input, output, session) {
  # Create data and subsets of data based on user selection of pairs
  dat <- data.frame(
    ID = paste0("ID", 1:10000), A = rnorm(10000),
    B = rnorm(10000), C = rnorm(10000), D = rnorm(10000),
    stringsAsFactors = FALSE
  )

  # Create data subset based on two letters user chooses
  datSel <- eventReactive(input$selPair, {
    validate(need(length(input$selPair) == 2, "Select a pair."))
    dat[c("ID", input$selPair)]
  }, ignoreNULL = FALSE)

  # Create background Plotly graph with hex binning all 100 rows of the two user-selected columns
  ggPS <- eventReactive(datSel(), {
    minVal = min(datSel()[,-1])
    maxVal = max(datSel()[,-1])
    maxRange = c(minVal, maxVal)
    xbins=7
    buffer = (maxRange[2]-maxRange[1])/xbins/2
    x = unlist(datSel()[input$selPair[1]])
    y = unlist(datSel()[input$selPair[2]])
    h <- hexbin(x=x, y=y, xbins=xbins, shape=1, IDs=TRUE,
                xbnds=maxRange, ybnds=maxRange)
    hexdf <- data.frame (hcell2xy (h),  hexID = h@cell, counts = h@count)
    attr(hexdf, "cID") <- h@cID
    p <- ggplot(hexdf, aes(x=x, y=y, fill = counts, hexID=hexID)) +
      geom_hex(stat="identity") + geom_abline(intercept = 0, color = "red", size = 0.25) +
      coord_cartesian(xlim = c(maxRange[1]-1*buffer, maxRange[2]+buffer),
                      ylim = c(maxRange[1]-1*buffer, maxRange[2]+buffer)) +
      coord_equal(ratio = 1) +
      labs(x = input$selPair[1], y = input$selPair[2])
    ggPS <- ggplotly(p)
    ggPS
  })

  # Output ID of selected row
  output$info <- renderPrint({ datSel()$ID[req(input$goButton)] })

  # Output hex bin plot created just above
  output$scatMatPlot <- renderPlotly({
    # Use onRender() function to draw x and y values of seleced row as orange point
    ggPS() %>% onRender("
                        function(el, x, data) {
                        noPoint = x.data.length;
                        Shiny.addCustomMessageHandler('points', function(drawPoints) {
                        if (x.data.length > noPoint){
                        Plotly.deleteTraces(el.id, x.data.length-1);
                        }
                        var Traces = [];
                        var trace = {
                        x: drawPoints.slice(0, drawPoints.length/2),
                        y: drawPoints.slice(drawPoints.length/2, drawPoints.length),
                        mode: 'markers',
                        marker: {
                        color: 'orange',
                        size: 7
                        },
                        hoverinfo: 'none'
                        };
                        Traces.push(trace);
                        Plotly.addTraces(el.id, Traces);
                        });}")
  })

  observe({
    # Get x and y values of seleced row
    currGene <- datSel()[input$goButton, -1]
    # Send x and y values of selected row into onRender() function
    session$sendCustomMessage(type = "points", unname(unlist(currGene)))
  })
})

shinyApp(ui, server)