使用闪亮的小部件选择数据表的特定行 [英] Select specific row of a datatable with a shiny widget

问题描述

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

I have the shiny app below in which the user clicks on a row and gets its index next to it. Is it possible to select the selected row with a pickerInput() which includes all the row names except of the selected one and when activated with a choice it will display the correspondent row and display its index as text.

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"
          
        )
      }
      
    })
})

推荐答案

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)

这篇关于使用闪亮的小部件选择数据表的特定行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！