동적으로 생성 된 Shiny 모듈의 반환 된 값에 액세스

Aug 18 2020

간단한 양식을 반환하는 모듈 (callmodule을 통해)을 동적으로 생성하는 반짝이는 앱을 빌드하려고합니다. 나는 그것에 대해 약간의 안내를 주시면 감사하겠습니다.

첫째, 여러 양식을 사용자에게 가져 오면 (버튼 클릭을 통해) 이전에 렌더링 된 양식의 값이 기본값으로 되돌아갑니다. 값이 사용자 선택에 유지되도록이 동작을 어떻게 중지합니까?

그리고 2, 어떻게 선택 항목의 '모든'값을 tableOutput에 표시 할 수있는 단일 티블에 액세스하고 표시합니까? 나는 observeEvent를 사용하여 아래에 간단한 예제를 모았습니다. 또한 eventReactive로 변형을 시도했지만 callmodule 출력에 액세스 할 수없는 것 같습니다.

미리 Thnx!

library(shiny)
library(stringr)


gen_r_8_formUI <- function(id){
  
  ns <- NS(id)
  
  tagList(fluidRow(column(width = 4, selectInput(ns("slt_forename"), 'forename', choices = unique(c("john", "paul", "george", "ringo")))),
          column(width = 4, selectInput(ns("slt_surname") , 'surname' , choices = unique(c("lennon", "mccartney", "harrison", "starr"))))))
}

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

  select_values <- reactiveValues(forename = NULL, surname = NULL)  
  observeEvent(input$slt_forename,{select_values$forename <- input$slt_forename}) observeEvent(input$slt_surname, {select_values$surname <- input$slt_surname})
  select_values_all <- reactive({tibble(forename  = select_values$forename, surname = select_values$surname)})
  
  return(list(select_values_all = reactive({select_values_all()})))
}


ui <- fluidPage(
  column(width = 2, actionButton("btn_gen_r_8_form", "GEN R 8 a FORM")),
  column(width = 6, uiOutput("all_ui_forms")),
  column(width = 4, tableOutput("all_form_values_table")))

server <- function(input, output) {
  
  rctv_uis                     <- reactiveValues(all_ui          = list())
  gen_forms                    <- reactiveValues(all_form_values = list())
  output$all_ui_forms <- renderUI({tagList(rctv_uis$all_ui)})
  output$all_form_values_table <- renderTable({all_form_values_rctv()}) observeEvent(input$btn_gen_r_8_form, {
    
    x_id  <- paste( "ns_", str_replace_all(paste(Sys.time()), "-| |:", '') , sep = '')
    gen_forms$all_form_values[[x_id]] <- callModule(module = gen_r_8_form, id = x_id) rctv_uis$all_ui[[x_id]] <- gen_r_8_formUI(id = x_id)

  })
  
  
  all_form_values_rctv <- reactive({
    
    # Question - how to make a tibble with all form values?
    
    # tibble(
    #   forenames = 'all gen_forms$all_form_values forenames', # surnames = 'all gen_forms$all_form_values surnames'
    # )
    
  })
}

shinyApp(ui = ui, server = server)

답변

1 starja Aug 18 2020 at 04:37

다음은 insertUI. 기존 UI 요소가 동일하게 유지되고 (이전 모듈을 재설정하지 않음) 새 모듈 만 추가된다는 장점이 있습니다. UI가 추가되는 위치를 확인하려면 함수 tags$div(id = "tag_that_determines_the_position")에서 a 를 정의하십시오 UI. 그런 다음 insertUI이것을 인수로 취하십시오. 또한 몇 가지 사항을 변경했습니다.

  • 모듈 서버 기능에 대한 코드를 단순화했습니다. 기본적으로 reactive
  • 반짝이는 1.5.0에 도입 된 새로운 모듈 인터페이스 사용
  • 조금 더 간단한 반응 형 데이터 구조를 사용합니다 (더 적은 중첩).
library(shiny)
library(stringr)


gen_r_8_formUI <- function(id){
  
  ns <- NS(id)
  
  tagList(fluidRow(column(width = 4, selectInput(ns("slt_forename"), 'forename', choices = unique(c("john", "paul", "george", "ringo")))),
                   column(width = 4, selectInput(ns("slt_surname") , 'surname' , choices = unique(c("lennon", "mccartney", "harrison", "starr"))))))
}

gen_r_8_form <- function(id){
  moduleServer(
    id,
    function(input, output, session) {
      select_values_all <- reactive({tibble(forename  = input$slt_forename,
                                            surname  = input$slt_surname)}) return(list(select_values_all = reactive({select_values_all()}))) } ) } ui <- fluidPage( column(width = 2, actionButton("btn_gen_r_8_form", "GEN R 8 a FORM")), column(width = 6, tags$div(id = "add_UI_here")),
  column(width = 4, tableOutput("all_form_values_table")))

server <- function(input, output) {
  gen_forms                    <- reactiveValues()
  current_id <- 1
  
  observeEvent(input$btn_gen_r_8_form, { x_id <- paste0("module_", current_id) gen_forms[[x_id]] <- gen_r_8_form(id = x_id) insertUI(selector = "#add_UI_here", ui = gen_r_8_formUI(x_id)) current_id <<- current_id + 1 }) all_form_values_rctv <- reactive({ res <- lapply(reactiveValuesToList(gen_forms), function(current_module_output) { current_module_output$select_values_all()
    })
    
    # prevent to show an error message when the first module is added
    if (length(res) != 0 && !is.null(res[[1]]$forename)) { dplyr::bind_rows(res) } else { NULL } }) output$all_form_values_table <- renderTable({
    all_form_values_rctv()
  })
}

shinyApp(ui = ui, server = server)
MrFlick Aug 18 2020 at 03:56

이런 걸 원하시는 것 같아요

  all_form_values_rctv <- reactive({
    dplyr::bind_rows(lapply(gen_forms$all_form_values, function(x) { x$select_values_all()
    }))
  })

모든 모델 반응 요소를 수집 gen_forms$all_form_values했으므로이를 반복하고 반응 값을 얻은 다음 모든 테이블을 함께 바인딩합니다.