Как добавить selectInput в каждую строку таблицы данных в R Shiny, а затем прочитать ее - PullRequest
0 голосов
/ 08 мая 2020

Я хочу создать DT data.table в R Shiny, где каждая строка будет отображать виджет selectInput, что я управлял с помощью следующего кода:

Вот рабочий пример:

app.R

library(data.table)
library(htmltools)
library(shiny)
library(shinydashboard)
library(DT)

dbHeader <- dashboardHeader(title = "")

# Define UI for application that draws a map
ui <- fluidPage(

  dashboardPage(
    title = "Interface",
    dbHeader,
    dashboardSidebar(
      fluidRow(column(12,dateInput("whichDay", label = h4("Date"), language = "fr", value = NULL))),
      fluidRow(column(12,actionButton("submit","Sauver")))
    ),
    dashboardBody(
      dataTableOutput('myTableOutput')
    )
  )
)


# Define server logic required
server <- function(session, input, output) {

  ## Table de répartition
  repTable <<- data.table(Blocs=1:3, Véhicules=1:3 )
  output$myTableOutput <- DT::renderDataTable({repTable},escape=FALSE,options = list(pageLength = 100, info = FALSE, dom="t"))

  observe({
    vehicles <- vector(mode = "character", length = 0)
      for(i in 1:3){
        vehicles[i] <- as.character(selectInput(inputId=paste0("row_select_", i), label=NULL, choices=c("","a","b")))
    }
    ## Add to table
    repTable <<- data.table(Blocs=1:3, Véhicules = vehicles )
    proxy <- dataTableProxy("myTableOutput")
    replaceData(proxy,repTable)
  }
  )



observeEvent(input$submit,{
  ## ???? How to retrieve the values from Véhicules?
})
}

# Run the application 
shinyApp(ui = ui, server = server)

При нажатии кнопки действия «отправить» я хотел бы получить значения, которые пользователь вставил через selectInput таблицы DT. Я просмотрел ввод и само DT, и эти значения нигде не показывают.

1 Ответ

1 голос
/ 09 мая 2020

Вам нужно привязать входы, чтобы их значения были доступны в Shiny.

Это фактически похоже на вопрос, который я задал некоторое время назад. Для получения дополнительной информации, вот ссылка на ответ, который мне дали.

Блестящие виджеты в таблице DT

library(data.table)
library(htmltools)
library(shiny)
library(shinydashboard)
library(DT)

dbHeader <- dashboardHeader(title = "")

# Define UI for application that draws a map
ui <- fluidPage(

  dashboardPage(
    title = "Interface",
    dbHeader,
    dashboardSidebar(
      fluidRow(column(12,dateInput("whichDay", label = h4("Date"), language = "fr", value = NULL))),
      fluidRow(column(12,actionButton("submit","Sauver")))
    ),
    dashboardBody(
      dataTableOutput('myTableOutput')
    )
  )
)


# Define server logic required
server <- function(session, input, output) {

  ## Table de répartition
  repTable <<- data.table(Blocs=1:3, Véhicules=1:3 )
  output$myTableOutput <- DT::renderDataTable({repTable},escape=FALSE,options = list(pageLength = 100, info = FALSE, dom="t",
                                                                                     preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                                                                                     drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')))

  observe({
    vehicles <- vector(mode = "character", length = 0)
    for(i in 1:3){
      vehicles[i] <- as.character(selectInput(inputId=paste0("row_select_", i), label=NULL, choices=c("","a","b")))
    }
    ## Add to table
    repTable <<- data.table(Blocs=1:3, Véhicules = vehicles )
    proxy <- dataTableProxy("myTableOutput")
    replaceData(proxy,repTable)
  }
  )



  observeEvent(input$submit,{
    ## ???? How to retrieve the values from Véhicules?
    for(i in 1:3) {
      print(input[[paste0("row_select_", i)]])
    }
  })
}

# Run the application 
shinyApp(ui = ui, server = server)
...