Действие триггера в R shiny с общими c блестящими виджетами без указания его полного inputID - PullRequest
0 голосов
/ 14 июля 2020

Я создаю на стороне сервера некоторые виджеты numericInput, используя функцию insertUI, называя каждый из этих объектов, например, «num_input_x», где x изменяется от 1 до любого другого (общее число может увеличиваться или уменьшаться в зависимости от некоторых условий, установленных пользователем во время session).

Теперь я хотел бы, чтобы каждый из этих динамически создаваемых numericInput запускал одно и то же действие. Имя inputID, которое наблюдается и запускает это действие.

Чтобы упростить, мне понадобится что-то вроде этого, что работает:

observeEvent(input[["num_input_*"]], {#action here})

или это:

observeEvent(lapply(listX,function(n) input[[paste0("num_input_",n)]]), {#action here})

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

Morevoer, это должно быть возможно запускать действие несколько раз, а не только один раз.

Большое спасибо за помощь заранее

1 Ответ

0 голосов
/ 15 июля 2020

Если вы хотите, чтобы каждый ввод numeri c реагировал отдельно, вы можете поменять местами lappy и observeEvent.

library(shiny)

make_num_input <- function(id) {
  numericInput(paste0("num_inp_", id), "number", 0, 0, 10)
}


ui <- fluidPage(
  lapply(as.character(1:3), make_num_input)
)

server <- function(input, output, session) {
  lapply(as.character(1:3), function(id) {
    name <- paste0("num_inp_", id)
    observeEvent(input[[name]], {
      msg <- sprintf("%s is now %d\n", id, input[[name]])
      cat(msg)  
    })    
  })
}

shinyApp(ui=ui, server=server)

Более современный подход к этому типу реализации будет быть использовать блестящую модульную структуру ( Официальная страница ).

library(shiny)

make_num_input <- function(id) {
  ns <- NS(id)
  numericInput(ns("num_inp"), "number", 0, 0, 10)
}

module <- function(id) {
  moduleServer(id, function(input, output, session) {
    observeEvent(input$num_inp, {
      msg <- sprintf("%s is now %d\n", id, input$num_inp)
      cat(msg)  
    })
  })
}

ui <- fluidPage(
    lapply(as.character(1:3), make_num_input)
)

server <- function(input, output, session) {
  lapply(as.character(1:3), module)  
}

shinyApp(ui=ui, server=server)
...