Question

对于我的shiny应用程序，我使用具有不同输入数量的模块。在我的主要应用程序中，我现在想要创建一个交互式绘图。我向click添加了click = "onClick"事件（plotOutput）处理程序。当我点击某个点时，input$onClick会更新，但之后会变为NULL。

您可以在应用程序中进行试用：如果您点击左侧图表中的某个点，则会打印input$onClick的值，但之后会变为NULL。

这必须与模块有关，因为如果你点击右图中的一个点，信息是持久的。

因此，似乎client和server之间存在某种通信，在使用模块时会使input$onclick无效。我能做些什么吗？

代码

library(shiny)
library(plyr)
library(ggplot2)

testUI <- function(id) {
   ns <- NS(id)
   uiOutput(ns("placeholder"))
}

test <- function(input, output, session, n) {
    output$placeholder <- renderUI({
        do.call(tagList, llply(1:n(), function(i)
                   numericInput(session$ns(paste("n", i, sep = ".")), 
                session$ns(paste("n", i, sep = ".")), sample(0:100, 1), 0, 100)))
    })
    getData <- reactive(unlist(reactiveValuesToList(input)[1:n()]))
    list(getData = getData)
}

ui <- fluidPage(
    flowLayout(
        numericInput("n", "Number of Elements", 3, 1, 10),
        testUI("x"),
        testUI("y")),
    flowLayout(
        plotOutput("plot", click = "onClick"),
        plotOutput("plot2", click = "onClick2")),
    verbatimTextOutput("debug")
)

server <- function(input, output, session) {
    getN <- reactive(input$n)
    handler <- list(x = callModule(test, "x", getN),
                    y = callModule(test, "y", getN))
    output$plot <- renderPlot({
        req(handler$x$getData(), handler$y$getData())
        dat <- data.frame(x = handler$x$getData(),
                          y = handler$y$getData())
        qplot(x, y, data = dat)})
    output$plot2 <- renderPlot(qplot(mpg, cyl, data = mtcars))
    output$debug <- renderPrint(list(input$onClick, input$onClick2))
}

runApp(shinyApp(ui, server))

Answer 1

我重新编写了服务器，在试验中跟踪问题。首先，我将强调我怀疑是什么问题，然后我会写一个替代解决方案。

第一：可能出现的问题

我认为output$plot会呈现两次，如果您将print("here")放在output$plot <- renderPlot({})内，您每次点击都会看到它会被执行两次。

可能两次失效。我怀疑问题可能与使用 getData <- reactive(unlist(reactiveValuesToList(input)[1:n()]))有关。因为当我用替代的反应式表达式getData <- reactive(1:n())替换它时，它正常工作。

我认为，当点击情节时：

input更改（因为它包含input$onClick）

getData <- reactive(unlist(reactiveValuesToList(input)[1:n()]))失效
output$plot的绘图对象失效，因为它取决于之前的值。
input读取onClick的当前值NULL

library(shiny)
library(plyr)
library(ggplot2)

testUI <- function(id) {

  ns <- NS(id)

  uiOutput(ns("placeholder"))
}

test <- function(input, output, session, n) {

  output$placeholder <- renderUI({
    do.call(tagList,
            llply(1:n(), function(i)
              numericInput(session$ns(paste("n", i, sep = ".")), 
                           session$ns(paste("n", i, sep = ".")), sample(0:100, 1), 0, 100)))
  })

  getData <- reactive(unlist(reactiveValuesToList(input)[1:n()]))

  ## TEST: this will work ----------
  # getData <- reactive(1:n())  

  list(getData = getData)
}

ui <- fluidPage(
  flowLayout(
    numericInput("n", "Number of Elements", 3, 1, 10),
    testUI("x"),
    testUI("y")),
  flowLayout(
    plotOutput("plot", click = "onClick"),
    plotOutput("plot2", click = "onClick2")),
  verbatimTextOutput("debug")
)

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


  # handler <- list(x = callModule(test, "x", getN),
  #                 y = callModule(test, "y", getN))
  # 
  # output$plot <- renderPlot({
  #   req(handler$x$getData(), handler$y$getData())
  #   dat <- data.frame(x = handler$x$getData(),
  #                     y = handler$y$getData())
  #   qplot(x, y, data = dat)})


  getN <- reactive(input$n)

  ## call modules -------------------
  xx <- callModule(test, "x", getN)
  yy <- callModule(test, "y", getN)

  ## data to be plotted in left plot
  dat <- reactive({
    data.frame(x = xx$getData(),
               y = yy$getData())
  })

  ## left plot ------------------
  output$plot <- renderPlot({
    req(xx$getData(),yy$getData())
    print("here")
    qplot(x, y, data = dat())
  })

  ## right plot ------------------
  output$plot2 <- renderPlot({
    qplot(mpg, cyl, data = mtcars)
  })

  output$debug <- renderPrint(c(input$onClick$x,input$onClick2$y))
  # output$debug <- renderPrint(dat())

}

shinyApp(ui = ui, server = server)

第二：替代解决方案

在这个替代解决方案中：

test将不会返回任何内容
获取x_coord()＆amp;中数字输入字段的坐标y_coord() （可能还有其他方法可以实现此目标）。
形成数据框dat()。
req()条件大致选择，但可以是任何可以达到预期结果的条件。

library(shiny)
library(plyr)
library(ggplot2)

testUI <- function(id) {

  ns <- NS(id)

  uiOutput(ns("placeholder"))
}

test <- function(input, output, session, n) {

  output$placeholder <- renderUI({
    do.call(tagList,
            llply(1:n(), function(i)
              numericInput(session$ns(paste("n", i, sep = ".")), 
                           session$ns(paste("n", i, sep = ".")), sample(0:100, 1), 0, 100)))
  })

}

ui <- fluidPage(
  flowLayout(
    numericInput("n", "Number of Elements", 3, 1, 10),
    testUI("x"),
    testUI("y")),
  verbatimTextOutput("debug"),
  flowLayout(
    plotOutput("plot", click = "onClick"),
    plotOutput("plot2", click = "onClick2"))

)

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

  getN <- reactive(input$n)

   ## call modules -------------------
   callModule(test, "x", getN)
   callModule(test, "y", getN)


   ## get coordinates fromnumeric inputs ----------
   x_coord <- reactive(sapply((1:input$n),function(x) input[[paste0("x-n.",x)]]))
   y_coord <- reactive(sapply((1:input$n),function(x) input[[paste0("y-n.",x)]]))

   ## create data frame
   dat <- reactive({
     req(input[[paste0("y-n.",input$n)]]) # could be changed 
     data.frame(x = x_coord(),
                y = y_coord())
   })

  ## render left plot ------------------
  output$plot <- renderPlot({
    req(input[[paste0("y-n.",input$n)]]) # could be changed 
    qplot(x, y, data = dat())
  })

  ## render right plot ------------------
  output$plot2 <- renderPlot({
    qplot(mpg, cyl, data = mtcars)
  })

  ## cat coordinates of clicked points ---------------
  output$debug <- renderPrint(c(input$onClick$x,input$onClick$y))
}

shinyApp(ui = ui, server = server)

使用模块时，防止plotOutput的click事件重置

1 个答案: