Связь между блестящими модулями - PullRequest
Новая
       67

Связь между блестящими модулями

2 голосов
/ 07 апреля 2020

Я создал приложение (сжатый пример для иллюстрации) на блестящем, содержащее модуль, связь с которым не работает должным образом.

Пользовательский интерфейс должен создать некоторые данные (DataPack) (list с таким два элемента) нажатием кнопки «Загрузить». Затем данные должны наноситься на график через модуль, тогда как диапазон оси x графика каждого модуля должен контролироваться с помощью sliderInput пользовательского интерфейса.

Даже если созданные данные построены правильно (при первом запуске только) вот конкретные проблемы, с которыми я сталкиваюсь:

  • Я предполагаю, что предупреждение restarting interrupted promise evaluation создается, когда DataPack еще не создано или не передано модулю. Поэтому я понимаю предупреждение, когда Datapack еще не создан, но не после первого нажатия кнопки «Загрузить». Есть ли способ избежать этого? Откуда происходит это поведение?
  • После создания некоторых данных (DataPack) нажатием кнопки «Загрузить» ползунок корректно обновляется, отражая (общую) длину созданных данных (n) ). Однако начальный набор значений (value = c(0, 150)) передается на график модулей, тогда как обновленное значение (или любая другая позиция ползунка после) путем создания данных (т.е. фактической длины) после нажатия кнопки «Загрузить» - не. Почему?
  • Приложение останавливается после первого запуска, после чего повторное нажатие кнопки «Загрузить» больше невозможно. Почему?

Спасибо тебе! 

library(shiny)
library(TTR)

# module interface
Module_ui <- function(id) {

  ns <- NS(id)
  plotOutput(ns("Plot"))

}

# module server
Module_Server <- function(input, output, session,
                          DataPack, DataSetName, xlim) {

  output$Plot <- renderPlot({
    message(paste("Plot", DataSetName))
    plot(DataPack[[DataSetName]],
         xlim = c(xlim[1], xlim[2])) })

}



# app ui
ui <- fluidPage(

  fluidRow(
    column(
      6, fluidRow(h4("Data Generation")),
      fluidRow(actionButton("InputButton_GetData", "Load", width = "100%"))),

    column(
      6, fluidRow(h4("Update Plot")),
      sliderInput(
        "SliderInput_xAxis",
        label = NULL,
        min = 0,
        max = 150,
        value = c(0, 150),
        animate = TRUE))),

  Module_ui("Plot_1"),

  Module_ui("Plot_2")

)

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

  DataPack <- eventReactive(
    input$InputButton_GetData, {

      message("Creating DataPack")

      n <- round(runif(1, min = 100, max = 500))

      message(n)

      DataPack <- NULL
      DataPack$one <- rnorm(n)
      DataPack$two <- rnorm(n)^2

      updateSliderInput(
        session = session,
        inputId = "SliderInput_xAxis",
        value   = c(1, n),
        min     = 1,
        max     = n)

      return(DataPack)

    })

  callModule(Module_Server, "Plot_1",
             DataPack     = DataPack(),
             DataSetName  = "one",
             xlim         = input$SliderInput_xAxis)

  callModule(Module_Server, "Plot_2",
             DataPack     = DataPack(),
             DataSetName  = "two",
             xlim         = input$SliderInput_xAxis)

}



shinyApp(ui, server)

Ответы [ 2 ]

1 голос
/ 07 апреля 2020

Я не уверен, что приложение должно делать, но я думаю, что вы должны передать реактивный проводник DataPack на сервер модуля, а не возвращаемое им значение: 

Module_Server <- function(input, output, session,
                          DataPack, DataSetName, xlim) {

  output$Plot <- renderPlot({
    message(paste("Plot", DataSetName))
    plot(DataPack()[[DataSetName]], # note the parentheses
         xlim = c(xlim[1], xlim[2])) })

}

  callModule(Module_Server, "Plot_1",
             DataPack     = DataPack, # no parentheses
             DataSetName  = "one",
             xlim         = input$SliderInput_xAxis)

  callModule(Module_Server, "Plot_2",
             DataPack     = DataPack, # no parentheses
             DataSetName  = "two",
             xlim         = input$SliderInput_xAxis)
1 голос
/ 07 апреля 2020

Предпочитают передавать реактивы непосредственно функциям модуля.

Обратите внимание на удаленные скобки и входные данные, заключенные в реактивы в callModule(DataPack = DataPack, ....), и соответственно DataPack() вместо DataPack в теле функции модуля. 

library(shiny)
library(TTR)

# module interface
Module_ui <- function(id) {

  ns <- NS(id)
  plotOutput(ns("Plot"))

}

# module server
Module_Server <- function(input, output, session,
                          DataPack, DataSetName, xlim) {

  output$Plot <- renderPlot({
    message(paste("Plot", DataSetName))
    plot(DataPack()[[DataSetName]],
         xlim = c(xlim()[1], xlim()[2])) })

}



# app ui
ui <- fluidPage(

  fluidRow(
    column(
      6, fluidRow(h4("Data Generation")),
      fluidRow(actionButton("InputButton_GetData", "Load", width = "100%"))),

    column(
      6, fluidRow(h4("Update Plot")),
      sliderInput(
        "SliderInput_xAxis",
        label = NULL,
        min = 0,
        max = 150,
        value = c(0, 150),
        animate = TRUE))),

  Module_ui("Plot_1"),

  Module_ui("Plot_2")

)

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

  DataPack <- eventReactive(
    input$InputButton_GetData, {

      message("Creating DataPack")

      n <- round(runif(1, min = 100, max = 500))

      message(n)

      DataPack <- NULL
      DataPack$one <- rnorm(n)
      DataPack$two <- rnorm(n)^2

      updateSliderInput(
        session = session,
        inputId = "SliderInput_xAxis",
        value   = c(1, n),
        min     = 1,
        max     = n)

      return(DataPack)

    })

  SliderInput_xAxis_rx <- reactive(input$SliderInput_xAxis)

  callModule(Module_Server, "Plot_1",
             DataPack     = DataPack,
             DataSetName  = "one",
             xlim         = SliderInput_xAxis_rx)

  callModule(Module_Server, "Plot_2",
             DataPack     = DataPack,
             DataSetName  = "two",
             xlim         = SliderInput_xAxis_rx)

}



shinyApp(ui, server)
...