在调用onRender（）后删除所有selectizeInput（）值而不关闭应用程序

我正在尝试创建一个闪亮的应用程序来探索一个包含4个变量/列（a、B、C、D）和10000行的数据框架。有一个输入字段，用户必须在其中选择4个变量/列中的2个。一旦他们这样做了，然后在右边显示一个散点图。散点图是一个带有六边形组合的绘图对象，汇总了两个用户选择的变量/列之间10000行的值

此时，用户可以选择一个“Go！”按钮，这将导致与这两个变量/列的第一行相对应的橙色点叠加到Plotly对象上。用户可以依次选择“Go！”，然后对应于第二行、第三行、第四行等的橙色点将叠加到Plotly对象上。行ID的名称在散点图矩阵上方输出

在大多数情况下，该应用程序正在运行。我只想改进两件事：

1） 我希望用户能够在输入字段中选择新对。这在很大程度上起作用。但是，有一种特殊情况会导致应用程序突然关闭。它发生在橙色点覆盖到散点图上之后。如果用户随后删除两个输入对，应用程序会突然关闭。我希望用户能够删除两个输入对值，并输入两个新的对值，而不关闭应用程序，即使橙色点已绘制到散点图

2） 我注意到，在绘制橙色圆点之后，行ID的输出有点滞后。我想知道为什么会发生这种情况，因为我在脚本中绘制橙色点之前输出了行ID。我更希望有一个较少的滞后，但我不确定如何处理这一点

任何关于如何解决这两个问题的建议都将不胜感激！我的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)

library（plotly）
图书馆（GGALY）
图书馆（合宾）
库（htmlwidgets）
图书馆（tidyr）
图书馆（闪亮）
图书馆（dplyr）
库（数据表）
图书馆（GG2）
图书馆（tibble）
myPairs正如@HubertL提到的，最好避免嵌套反应函数。如果你改变这一点，你的应用程序可能会运行得更顺畅

关于你的第一个问题，这可能是最好的解决方法。这些函数检查用户输入是否有效，并处理无效输入

我已经根据这些建议对您的代码进行了一些调整，但您仍然可以对其进行更多更改。如果仔细查看
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)

library（plotly）
图书馆（GGALY）
图书馆（合宾）
库（htmlwidgets）
图书馆（tidyr）
图书馆（闪亮）
图书馆（dplyr）
库（数据表）
图书馆（GG2）
图书馆（tibble）
myPairs我认为应该避免嵌套被动函数。并尝试理解定义函数（在代码中的某个地方）和执行函数（在某个时间点）之间的区别。如果要按顺序执行操作，请不要定义两个函数，而是在一个函数中编写顺序。