R Блестящие агрегированные данные из renderUI checkboxGroupInput - PullRequest
Новая
       7

R Блестящие агрегированные данные из renderUI checkboxGroupInput

0 голосов
/ 07 мая 2018

У меня есть четыре checkboxGroupInput() виджета, для простоты A-D. Прямо сейчас все четыре отображаются в пользовательском интерфейсе, но B скрыто с shinyjs::hidden(). На сервере я динамически отображаю B в ответ на выбор в A.

Моя проблема связана с переносом выборок из A и B в один data.frame, а C и D в другой data.frame, когда пользователь нажимает кнопку отправки. Он делает что-то, чего я не понимаю, с выборами из A и B.

Вот мой MWE. 

choices <- letters[1:4]

UI * * +1010 

ui <- fluidPage(
  shinyjs::useShinyjs(),
  textInput("obj", "Object ID", value=""),
  checkboxGroupInput("A", "Atr A", choices, multiple=TRUE),
  shinyjs::hidden(div(id="dB", checkboxGroupInput("B", "Atr B", choice, multiple=TRUE),
  checkboxGroupInput("C", "Atr C", choices, multiple=TRUE),      
  checkboxGroupInput("D", "Atr D", choices, multiple=TRUE),
  actionButton("submit", "Submit", class = "btn-primary"))
  )

Сервер 

server <- function(input, output, session) {
  # Hide/Unhide B
  observeEvent(input$A, ignoreNULL = F,
        {if("a" %in% input$A) {shinyjs::show("dB")
          } else {shinyjs::hide("dB")}
          })

  # Aggregate all form data
  fields <- c("obj","A","B","C","D")
  formData <- reactive({
                       data <- sapply(fields, function(x) input[[x]])
                       data
                     })
  # Save data
  saveData <- function(data) {
    x <- c(data$A, data$B)
    x <- ifelse(is.null(x), NA, x) # fill NAs if no selection made
    x <- data.frame("obj"=rep(data$obj, length(x)), "AB"=x)
    y <- c(data$C, data$D)
    y <- ifelse(is.null(y), NA, y)
    y <- data.frame("obj"=rep(data$obj, length(y)), "CD"=y)
    save(x,y, file="data.RData")
    }

  # Action to take when submit button is pressed
  observeEvent(input$submit, {saveData(formData())}
}

Примечание: если вместо построения data.frames в функции saveData() я просто сохраню агрегированные данные: 

saveData <- function(data){save(data, file="test.RData")}

Я получаю файл RData с четырьмя объектами A-D, которые состоят из векторов символов. Затем я могу построить там data.frames так, как я задумал в функции saveData(), что имеет смысл. Но, если я запускаю приложение с начальной функцией saveData(), data.frames будут другими, x содержит только одну строку, даже если в A и B. есть несколько вариантов выбора.

Я почесал паутину и не могу до конца жизни понять, что происходит.

1 Ответ

0 голосов
/ 07 мая 2018 
choices <- letters[1:4]

ui <- fluidPage(
       shinyjs::useShinyjs(),
       checkboxGroupInput("A", "A Variables:", choices),
       shinyjs::hidden(div(id="dB", checkboxGroupInput("B", "B Varaibles:", choices))),
                  checkboxGroupInput("C", "C Varaibles:", choices)  ,    
                  checkboxGroupInput("D", "D Varaibles:", choices),
                  actionButton("submit", "Submit", class = "btn-primary"),

       textOutput("txt")  #To check the output before it saved

)

server <- function(input, output, session) {
   # Hide/Unhide B
   observeEvent(input$A, ignoreNULL = F,
           {if("a" %in% input$A) {shinyjs::show("dB")
           } else {shinyjs::hide("dB")}
           })

   # Aggregate all form data
    fields <- c("A","B","C","D")
     formData <- reactive({

        data <- sapply(fields, function(x) input[[x]],simplify = F)
        data
})

 output$txt <- renderPrint({ formData() })

# Save data
  saveData <- function(data) {
#x <- cbind(data$A, data$B)
x <- data.frame(A = data$A,B=data$B)
#y <- cbind(data$C, data$D)
y <- data.frame(C=data$C, D=data$D )
save(x,y, file="data.RData")
 }

 # Action to take when submit button is pressed
 observeEvent(input$submit, {saveData(formData())})
}



shinyApp(ui, server)

Вот ваш МЫ после некоторых модификаций. Тем не менее, я не уверен, что вы ожидали в качестве вывода. Я надеюсь, что это помогает.

...