R Shiny: создайте реактивный объект с входными значениями $ - PullRequest
0 голосов
/ 28 сентября 2018

Я хотел бы создать в Shiny объект reactiveValues, содержимое которого определяется значениями, содержащимися во входных виджетах.Мне удалось это сделать, но моя реализация кажется излишне неуклюжей:

  1. Создание пустого reactiveValues объекта
  2. Мониторинг, когда значение входных виджетов изменяется с observeEvent
  3. Присвойте значения объекту reactiveValues, используя нереактивные значения из виджетов ввода (isolate)

Вот пример:

ui <- fluidPage(
    fluidRow(
        column(2, radioButtons("main", label = "Main dish", choices = list("salad", "pasta"))),
        column(2, radioButtons("desert", label = "Desert", choices = list("fruit", "cake"))),
        column(8, actionButton("extra", "Louder!", style="background-color: #ffdb99"))
    ),
    verbatimTextOutput("myorder")
)

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

    # 1. Create reactiveValues object
    menuR <- reactiveValues()

    # 2. Update values whenever widgets change
    observeEvent(c(input$main, input$desert),
        menuR[["meal"]] <- paste(c(isolate(input$main), isolate(input$desert)), collapse = " & ")
    )

    # 3. Perform operations on object values
    observeEvent(input$extra,
        menuR[["meal"]] <- paste0(toupper(menuR[["meal"]]), "!!!")
    )

    output$myorder <- renderText(menuR[["meal"]])
}

shinyApp(ui, server)

Я бы очень хотел создать объект reactiveValues непосредственно следующим образом (значительно упрощает приведенный выше код):

# Set values upon creation
menuR <- reactiveValues(meal = paste(c(input$main, input$desert), collapse = " & "))

, который не работает, потому что input$main реагирует ...

Я бы предположил, что определение reactiveValues объектов со значениями, полученными из виджетов, было бы обычным делом.

Я что-то упустил?

Спасибо за вашу помощь,

Hugo

Ответы [ 2 ]

0 голосов
/ 01 октября 2018

Я принял предложение Вишеша и заставил его работать.Он не выглядит сильно отличающимся от моего исходного примера, и все же требует повторения нескольких строк кода.Он работает путем перезаписи реактивного объекта каждый раз, когда изменяется один из виджетов.

library(shiny)

ui <- fluidPage(
    fluidRow(
        column(2, radioButtons("main", label = "Main dish", choices = list("salad", "pasta"))),
        column(2, radioButtons("dessert", label = "dessert", choices = list("fruit", "cake"))),
        column(8, actionButton("extra", "Louder!", style="background-color: #ffdb99"))
    ),
    verbatimTextOutput("myorder")
)

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

    menuR <- reactive({
        paste(c(input$main, input$dessert), collapse = " & ")
    })

    # Render text when app loads
    output$myorder <- renderText(menuR())

    # Update reactive object and re-render text (button 'extra')
    observeEvent(
        input$extra,{
            temp <- toupper(paste(c(input$main, input$dessert), collapse = " & "))
            menuR <<- reactive(temp)
            output$myorder <- renderText(menuR())
        }
    )

    # Update reactive object and re-render text (button 'main' or 'dessert')
    observeEvent(c(input$main, input$dessert),{
        menuR <- reactive(paste(c(input$main, input$dessert), collapse = " & "))
        output$myorder <- renderText(menuR())
    })

}

shinyApp(ui, server)
0 голосов
/ 29 сентября 2018

Вы можете сделать это, используя reactive() вместо reactiveValues().menuR является реактивным объектом, который зависит от входных значений main и desert.Вы можете использовать его, вызвав menu() в коде вашего сервера, как только он будет определен.Кроме того, это избавляет вас от использования isolate(), поскольку вы можете установить значение menu в качестве реактивного объекта внутри observeEvent().

library(shiny)

ui <- fluidPage(
  fluidRow(
    column(2, radioButtons("main", label = "Main dish", choices = list("salad", "pasta"))),
    column(2, radioButtons("desert", label = "Desert", choices = list("fruit", "cake"))),
    column(8, actionButton("extra", "Louder!", style="background-color: #ffdb99"))
  ),
  verbatimTextOutput("myorder")
)

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

  menuR <- reactive({
    paste(c(input$main, input$desert), collapse = " & ")
  })

  observeEvent(
    input$extra,
    menuR <- reactive({
      toupper(paste(c(input$main, input$desert), collapse = " & "))
    })
  )

  output$myorder <- renderText(menuR())

}

shinyApp(ui, server)

Редактировать

Я неправильно понял проблему ранее.Вы можете использовать eventReactive(), который контролирует ввод и изменяется при изменении пользовательского ввода.Я также добавил значение по умолчанию, когда пользователь еще не нажал кнопку действия.

library(shiny)

ui <- fluidPage(
  fluidRow(
    column(2, radioButtons("main", label = "Main dish", choices = list("salad", "pasta"))),
    column(2, radioButtons("desert", label = "Desert", choices = list("fruit", "cake"))),
    column(8, actionButton("extra", "Louder!", style="background-color: #ffdb99"))
  ),
  verbatimTextOutput("myorder")
)

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

  # Set a 'default' value for the output
  default.menuR <- reactive({
    paste(c(input$main, input$desert), collapse = " & ")
  })

  menuR <- eventReactive(input$extra, {
    toupper(paste(c(input$main, input$desert), collapse = " & "))
  })

  # Initial state of the button is 0, which displays 'default' value
  output$myorder <- renderText({
    if (input$extra == 0) {
      return(default.menuR())
    }
    menuR()
  })

}

shinyApp(ui, server)

Надеюсь, это поможет!

...