동적으로 생성 된 Shiny 모듈의 반환 된 값에 액세스
간단한 양식을 반환하는 모듈 (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
다음은 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
이런 걸 원하시는 것 같아요
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
했으므로이를 반복하고 반응 값을 얻은 다음 모든 테이블을 함께 바인딩합니다.