Select 带有闪亮小部件的数据表的特定行

Question

我有下面的 shiny 应用程序，用户在其中单击一行并在其旁边获取其索引。是否可以 select 带有 pickerInput() 的 selected 行，其中包括除 selected 之外的所有行名称，并且当通过选择激活时，它将显示对应行并将其索引显示为文本。

library(shiny)
library(DT)
library(shinyWidgets)

shinyApp(
  ui = fluidPage(
    title = 'Select Table Rows',
    
    h1('A Server-side Table'),
    
    fluidRow(
      column(9, DT::dataTableOutput('x3')),
      column(3, verbatimTextOutput('x4')),
      uiOutput("dfatt")
    )
    
  ),
  server = function(input, output, session) {

    # server-side processing
    mtcars2 = mtcars[, 1:8]
    output$x3 = DT::renderDataTable({datatable(selection = list(target = "row", mode = "single"),mtcars )})
    
    # print the selected indices
    output$x4 = renderPrint({
      s = input$x3_rows_selected
      if (length(s)) {
        cat('These rows were selected:\n\n')
        cat(s, sep = ', ')
      }
    })
    output$dfatt<-renderUI({
      if(is.null(input$x3_rows_selected)){
        pickerInput(
          inputId = "Id008",
          label = "Different attribute", 
          choices = c(unique(as.character(rownames(mtcars)))),
          multiple = F,
          selected = "Badge danger"
          
        )
      }
      else{
        cell <- input$x3_rows_selected
        pickerInput(
          inputId = "Id008",
          label = "Different attribute", 
          choices = c(unique(as.character(rownames(mtcars))))[-cell],
          multiple = F,
          selected = "Badge danger"
          
        )
      }
      
    })
})

Answer 1

library(shiny)
library(DT)
library(shinyWidgets)

dat <- mtcars[1:6,]

callback <- JS(
  "Shiny.addCustomMessageHandler(",
  "  'selectRow',",
  "  function(index) {",
  "    table.row(index - 1).select();",
  "  }",
  ");"
)

ui <- fluidPage(
  br(),
  DTOutput("dtable"),
  br(),
  fluidRow(
    column(
      4,
      pickerInput(
        "rowname",
        label = "Choose a row",
        choices = setNames(1:nrow(dat), rownames(dat))
      ) 
    ),
    column(
      3,
      textOutput("selectedRow")
    )
  )
)

server <- function(input, output, session) {
  
  output[["dtable"]] <- renderDT({
    datatable(
      dat, 
      extensions = "Select",
      selection = "none",
      callback = callback,
      options = list(
        columnDefs = list(
          list(className = "dt-center", targets = "_all")
        ),
        select = list(style = "single")
      )
    )
  }, server = FALSE)
  
  output[["selectedRow"]] <- renderText({
    i <- input[["dtable_rows_selected"]]
    paste0(
      "Selected row: ", 
      ifelse(is.null(i), "none", i)
    )
  })
  
  observeEvent(input[["rowname"]], {
    session$sendCustomMessage("selectRow", input[["rowname"]])
  })
  
}


shinyApp(ui, server)

Select 带有闪亮小部件的数据表的特定行

Select specific row of a datatable with a shiny widget

r

shiny

dt