r-调用了无闪亮应用程序关闭后的所有selectizeInput()值

Question

我正在尝试创建一个闪亮的应用程序，以探索具有4个变量/列(a，b，c，d(和10,000行的数据框架。在一个输入字段中，用户必须选择4个变量/列中的2个。一旦他们这样做，则在右侧显示一个散点图。散点图是一个图对象，其六角形binning总结了两个用户选择的变量/列之间的10,000行的值。

此时，用户可以选择" GO！"按钮，该按钮会导致与这两个变量/列的第一行相对应的橙色点，将其叠加到绘图对象上。用户可以顺序选择" GO！"然后将对应于第二，第三，第四等对应的橙色点将叠加到情节对象上。行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)

Answer 1

正如@hubertl所述，最好避免嵌套反应性功能。如果您更改它，您的应用程序可能会更流畅。

关于您的第一个问题，req和validate可能是最好的选择。这些功能检查用户输入是否有效并处理无效的输入。

遵循这些SUGETIONS，我已经对您的代码进行了一些调整，但是您仍然可以更改它。如果您仔细观察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)