Соберите все пользовательские данные в приложении Shiny

Есть ли способ показать значение из textInput() в другом месте в интерфейсе без необходимости проходить server.R с чем-то очень многословным, как следующее?

ui.R

library(shiny)
shinyUI(
  fluidPage(
  textInput('text_in', label = 'Write text here'),

  # elsewhere in the UI...

  textOutput('text_out')
))

server.R

library(shiny)
shinyServer(function(input, output) {
  output$text_out = renderText(input$text_in)
})

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

Я видел, что вы можете ссылаться на элементы ввода, не проходя через сервер при использовании выражения JavaScript в conditionalPanel() но я не уверен, как реализовать это за пределами этого конкретного экземпляра.

4 ответа

Для доступа ко всем входам, вы можете использовать reactiveValuesToList на стороне сервера. Вы можете получить доступ к входным значениям через события Javascript, как показано ниже (я взял пример из @Pork Chop):

library(shiny)

ui <- basicPage(

  fluidRow(
    column(
      width = 6,
      textInput('a', 'Text A',"a1"),
      textInput('b', 'Text B',"b1"),
      textInput('c', 'Text A',"c1"),
      textInput('d', 'Text B',"d1"),
      textInput('e', 'Text A',"e1"),
      textInput('f', 'Text B',"f1")
    ),
    column(
      width = 6,
      tags$p("Text A :", tags$span(id = "valueA", "")),
      tags$script(
        "$(document).on('shiny:inputchanged', function(event) {
          if (event.name === 'a') {
            $('#valueA').text(event.value);
          }
        });
        "
      ),
      tableOutput('show_inputs')
    )
  )
)

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

  AllInputs <- reactive({
    x <- reactiveValuesToList(input)
    data.frame(
      names = names(x),
      values = unlist(x, use.names = FALSE)
    )
  })

  output$show_inputs <- renderTable({
    AllInputs()
  })
})
shinyApp(ui = ui, server = server)

Поскольку ваша общая цель - собрать все пользовательские данные и затем скомпилировать их в таблицу, я покажу вам, как этого добиться, на примере ниже. Как вы можете видеть все input переменные могут быть доступны по именам из server, Я держал их в реактиве на тот случай, если вам это понадобится для дальнейшего анализа или для некоторых renderUI функциональность.

#rm(list=ls())
library(shiny)

ui <- basicPage(
  textInput('a', 'Text A',"a1"),
  textInput('b', 'Text B',"b1"),
  textInput('c', 'Text A',"c1"),
  textInput('d', 'Text B',"d1"),
  textInput('e', 'Text A',"e1"),
  textInput('f', 'Text B',"f1"),
  tableOutput('show_inputs')
)
server <- shinyServer(function(input, output, session){

  AllInputs <- reactive({
    myvalues <- NULL
    for(i in 1:length(names(input))){
      myvalues <- as.data.frame(rbind(myvalues,(cbind(names(input)[i],input[[names(input)[i]]]))))
    }
    names(myvalues) <- c("User Input","Last Value")
    myvalues
  })

  output$show_inputs <- renderTable({
    AllInputs()
  })
})
shinyApp(ui = ui, server = server)

введите описание изображения здесь

Если все входы Shiny имеют разную длину и вышеуказанное не работает (например, если у вас есть комбинация переключателей, группы флажков, textInput и т. Д.), Это будет работать и может создать таблицу variable:value что вы можете разобрать позже:

AllInputs <- reactive({
  myvalues <- NULL
  newvalues <- NULL
  for(i in 1:length(names(input))){
    newvalues <- paste(names(input)[i], input[[names(input)[i]]], sep=":")
    myvalues <- append(myvalues, newvalues)
  }
  myvalues
})

output$show_inputs <- renderTable({
  AllInputs()
})

Заимствование из обоих Pork Chop и mysteRious, вот решение, которое работает для нескольких типов ввода текста и чисел в блестящем.

      library(shiny)

AdvRchp3 <- "While you’ve probably already used many (if not all) 
of the different types of vectors, you may not have thought 
deeply about how they’re interrelated. In this chapter, 
I won’t cover individual vectors types in too much detail, 
but I will show you how all the types fit together as a whole. 
If you need more details, you can find them in R’s documentation."

ui <- fluidPage(
  fluidRow(
    h4("Text Inputs"),
    textInput("text_input", "Input some Text", value = "some text"),
    passwordInput("password_input", "Input a Password", value = "1234"),
    textAreaInput("text_area_input", "Input lots of Text", rows = 3, value = AdvRchp3)
  ),
  fluidRow(
    h4("Numeric Inputs"),
    numericInput("numeric_input", "Number 1", value = 1, min = 0, max = 100),
    sliderInput("slider_input_single", "Number 50", value = 50, min = 0, max = 100),
    sliderInput("slider_input_ranges", "Range 10 to 20", value = c(10, 20), min = 0, max = 100)
  ),
  fluidRow(
    tableOutput("show_inputs")
  )
)  

server <- function(input, output, session) {
  all_inputs <- reactive({
    input_df <- NULL
    df_row <- NULL
    for(i in 1:length(names(input))){
      df_row <- as.data.frame(cbind(names(input)[i], input[[names(input)[i]]]))
      input_df <- as.data.frame(dplyr::bind_rows(input_df, df_row))
    }
    names(input_df) <- c("input_id", "input_val")
    input_df
  })
  
  output$show_inputs <- renderTable({
    all_inputs()
  })
}

shinyApp(ui, server)

извещение:rbind сейчас dplyr::bind_rows, но plyr::rbind.fill тоже будет работать.

Другие вопросы по тегам