Повторно использовать реактивные элементы, определенные в модулях - PullRequest
0 голосов
/ 20 февраля 2020

Я создаю приложение, в котором пользователь может создавать столько таблиц, сколько он / она хочет, и отображать код, необходимый для преобразования каждой отдельной таблицы, используя shinymeta. Я могу сгенерировать код для каждой из этих таблиц, но у меня возникает проблема, когда я хочу создать полный модал, который показывает каждый код для каждой таблицы.

Чтобы быть более понятным, вот воспроизводимый пример:

library(shiny)
library(dplyr)
library(shinymeta)

module_ui <- function(id){
  ns <- NS(id)

  tagList(
    fluidRow(
      actionButton(ns("show_table"), "Show table"),
      actionButton(ns("show_code"), "Show code"),
      tableOutput(ns("table"))
    )
  )
}

module_server <- function(input, output, session){
  data <- metaReactive2({
    req(input$show_table)

    isolate(metaExpr({
      mtcars 
    }))
  })

  data2 <- metaReactive({
    ..(data()) %>%
      select(mpg)
  })

  output$table <- renderTable({
    data2()
  })

  observeEvent(input$show_code, {
    showModal(modalDialog(
      renderPrint({
        expandChain(data(), data2())
      })
    ))
  })

  return(data())
}

ui <- fluidPage(
  actionButton("launch", "Launch"),
  actionButton("show_full_code", "Show the full code (at least 2 'launch' before)")
)

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

  count <- reactiveValues(value = 0)

  observeEvent(input$launch, {
    count$value <- count$value + 1
    insertUI(selector = "#show_full_code",
             where = "afterEnd",
             ui = module_ui(paste0("x", count$value)))
    callModule(module_server, paste0("x", count$value))
  })

  #### "Merge" the single code modals in one big
  observeEvent(input$show_full_code, {
    showModal(modalDialog(
      renderPrint({
        expandChain(x1_data)
      })
    ))
  })

}

shinyApp(ui, server)

Когда вы нажимаете «Запустить», генерируются две кнопки, и вы можете отобразить таблицу («Показать таблицу») и код для преобразования этой таблицы («Показать код»). Вы можете нажимать «Запуск» бесконечно, и таблица будет называться x1_data, x2_data, et c.

Однако, когда я пытаюсь сгенерировать код, объединяющий каждый отдельный код (нажав «Показать полный код»), x1_data не обнаруживается. Использование x1_data() также не работает. Я не фанат задавать два вопроса в одном посте, но я сделаю это сейчас:

  • Как я могу получить доступ к реактивным элементам, созданным внутри модулей?
  • Как я могу " «объединить каждый отдельный код в большой?»

Также спрашивается на RStudio Community

Редактировать: после комментария я добавляю второе реактивное выражение в моем примере, поэтому я не могу использовать return для них обоих.

1 Ответ

1 голос
/ 21 февраля 2020

Хорошо, я пришел с ответом, в котором модуль возвращает результаты expandChain(), а не пытается снова отобразить их на сервере:

library(shiny)
library(dplyr)
library(shinymeta)

module_ui <- function(id){
  ns <- NS(id)

  tagList(
    fluidRow(
      actionButton(ns("show_table"), "Show table"),
      actionButton(ns("show_code"), "Show code"),
      tableOutput(ns("table"))
    )
  )
}

module_server <- function(input, output, session){
  data <- metaReactive2({
    req(input$show_table)

    isolate(metaExpr({
      mtcars 
    }))
  })

  data2 <- metaReactive({
    ..(data()) %>%
      select(mpg)
  })

  output$table <- renderTable({
    data2()
  })

  observeEvent(input$show_code, {

    showModal(modalDialog(
      renderPrint({
        expandChain(data(), data2())
      })
    ))


  })
  ########################################
  ### create list of reactive objects ####
  ########################################
  return(list(
    expandChain(data(), data2())
  )
  )

}

ui <- fluidPage(
  actionButton("launch", "Launch"),
  actionButton("show_full_code", "Show the full code (at least 2 'launch' before)")
)

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

  count <- reactiveValues(value = 0)


  observeEvent(input$launch, {
    count$value <- count$value + 1
    insertUI(selector = "#show_full_code",
             where = "afterEnd",
             ui = module_ui(paste0("x", count$value)))
     callModule(module_server, paste0("x", count$value))


  })

  #### "Merge" the single code modals in one big list object
  my_data <- reactive({
    req(count$value)

    my_set <- 1:count$value

    ### lapply through the different name spaces so all are captured ###     
    final <- lapply(my_set, function(x){
      temp <- callModule(module_server, paste0("x", x))
      return(temp)
    })

    return(final)
  })


  #### "Merge" the single code modals in one big
  observeEvent(input$show_full_code, {
    showModal(modalDialog(
      renderPrint({

        temp <- sapply(unlist(my_data()), function(x){
          print(x)
        })

      })
    ))
  })

}

shinyApp(ui, server)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...