R Shiny - Попытка l oop с реактивным и ActionButton - PullRequest
Новая
       9

R Shiny - Попытка l oop с реактивным и ActionButton

1 голос
/ 16 апреля 2020

У меня есть 10 кнопок действий в моем блестящем приложении. Я пытаюсь создать все oop, но у меня проблемы с реактивными значениями. Как я могу решить это?

Вот мой код для кнопки 1: 

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

  value1 <- reactiveVal(0) 

   observeEvent(input$minus1, {newValue1 <- value1() - 1) 
    value1(newValue1)})

   observeEvent(input$plus1, {newValue1 <- (value1() + 1) 
    value1(newValue1)})

 output$value1 <- renderUI(actionBttn("result1", label = value1()))

  }

Я пробовал это, но, похоже, не работает: 

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

  for (i in 1:10)
  {
  paste0("value", i) <- reactiveVal(0) 

   observeEvent(input$paste0("minus",i), {paste0("newValue", i) <- (paste0("value", i,"()") - 1)
    paste0("value", i)(paste0("newValue", i))})

   observeEvent(input$paste0("plus",i), {newValue1 <- (paste0("value", i,"()") + 1) 
    paste0("value", i)(paste0("newValue", i))})

 output$paste0("value", i) <- renderUI(actionBttn(paste0("result", i), label = paste0("value", i,"()")))
  }

  }

1 Ответ

1 голос
/ 16 апреля 2020

В прошлом я работал над аналогичной демонстрацией, основанной на:

https://community.rstudio.com/t/one-observer-to-handle-any-number-of-buttons-in-shiny/6569/2

Это составляет 10 плюс и 10 минус кнопок, и каждая кнопка будет увеличить или уменьшить reactiveValues. Я надеюсь, что это может быть полезно. 

library(shiny)
library(dplyr)

ui <- fluidPage(
  fluidRow(uiOutput("show_table"))
)

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

  Data <- reactiveValues(
    Info = rep(0, 10)
  )

  observe({
    input_btn_p <- paste0("btn_p_", 1:10)
    lapply(input_btn_p, function(x){
       observeEvent(input[[x]], {
         i <- as.numeric(sub("btn_p_", "", x))
         Data$Info[i] <- Data$Info[i] + 1
       })
     })

    input_btn_m <- paste0("btn_m_", 1:10)
    lapply(input_btn_m, function(x){
      observeEvent(input[[x]], {
        i <- as.numeric(sub("btn_m_", "", x))
        Data$Info[i] <- Data$Info[i] - 1
      })
    })
  })

  display_table <- reactive({
    data.frame(value = Data$Info) %>%
      mutate(button1 = vapply(row_number(),
                             function(i){
                               actionButton(inputId = paste0("btn_p_", i), label = "Plus") %>% 
                                 as.character()
                             },
                             character(1)),
             button2 = vapply(row_number(),
                              function(i){
                                actionButton(inputId = paste0("btn_m_", i), label = "Minus") %>% 
                                  as.character()
                              },
                              character(1)))
  })

  output$show_table <- renderUI({
    display_table() %>% 
      select(value, button1, button2) %>% 
      knitr::kable(format = "html", escape = FALSE) %>% 
      HTML()
  })

}

shinyApp(ui, server)
...