在 sortable from shiny DT 行选择中添加反应性 rank_list 标签

Add reactive rank_list labels in sortable from shiny DT row selection

我正在尝试创建一个 bucket_list,其中参数 label 根据 DT 中的行选择而变化。

目前的代码如下:

library(shiny)
library(DT)
library(sortable)
library(stringr)

nr <- c("1","2","3")
name <- c("John Doe One","John Doe Two","John Doe Three")


shedule <- data.frame(nr,name)

ui <- navbarPage("Hello world!",
                 tabPanel("Drive-thru",

                          DTOutput('shedule'),  # datatable
                          textOutput("selection"), # print label selection 

                          # bucket list #
                          bucket_list(   
                              header = "Drag and drop seleted rows to the correct location",
                              group_name = "bucket_list_group",
                              orientation = "horizontal",

                              add_rank_list(text = "Driver",
                                            labels = textOutput("selection"), # labels from row selection
                                            input_id = "driver"),
                              add_rank_list(text = "Passenger 1",
                                            labels = NULL,
                                            input_id = "passenger_1"),
                              add_rank_list(text = "Passenger 2",
                                            labels = NULL,
                                            input_id = "passenger_2"),
                              add_rank_list(text = "Passenger 3",
                                            labels = NULL,
                                            input_id = "passenger_3")) 
                 ),
                 inverse = TRUE
                 )

server = function(input, output) {

    # Render DT -------------------------------------------
    output$shedule <- DT::renderDataTable(shedule)


    output$selection  <- renderText({
        s <- input$shedule_rows_selected # Selected rows

        # Create label from selected rows ---------------------
        label =  NULL # Where labels will be stored
        for (i in s)
            label <- c(label, paste(shedule$nr[i], word(shedule$name[i],1,2), sep = " - ")) # Create label with code number and first two names of the person

        label})

}

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

感谢您的帮助!

要使您的遗愿清单动态化,您可以创建一个 reactive 表达式来 create/store 您的标签,因为行被选中。然后,您可以在您的遗愿清单中参考此 reactive。为此,您需要将遗愿清单移至 server,并在 ui.

中包含 htmlOutput

根据所需的行为,您可能希望根据所选行更改 reactive 的工作方式。

library(shiny)
library(DT)
library(sortable)
library(stringr)

nr <- c("1","2","3")
name <- c("John Doe One","John Doe Two","John Doe Three")

shedule <- data.frame(nr,name)

ui <- navbarPage("Hello world!",
                 tabPanel("Drive-thru",
                          DTOutput('shedule'),  # datatable
                          textOutput("selection"), # print label selection 
                          htmlOutput("bucketlist")
                 ),
                 inverse = TRUE
)

server = function(input, output) {

  # Render DT -------------------------------------------
  output$shedule <- DT::renderDataTable(shedule)

  # Render bucket list
  output$bucketlist <- renderUI({
    bucket_list(   
      header = "Drag and drop seleted rows to the correct location",
      group_name = "bucket_list_group",
      orientation = "horizontal",
      add_rank_list(text = "Driver",
                    labels = bucketlistlabels(), # labels from row selection
                    input_id = "driver"),
      add_rank_list(text = "Passenger 1",
                    labels = NULL,
                    input_id = "passenger_1"),
      add_rank_list(text = "Passenger 2",
                    labels = NULL,
                    input_id = "passenger_2"),
      add_rank_list(text = "Passenger 3",
                    labels = NULL,
                    input_id = "passenger_3")) 
  })

  # Reactive expression to create labels from rows selected
  bucketlistlabels <- reactive({
    s <- input$shedule_rows_selected # Selected rows

    # Create label from selected rows ---------------------
    label =  NULL # Where labels will be stored
    for (i in s)
      label <- c(label, paste(shedule$nr[i], word(shedule$name[i],1,2), sep = " - ")) # Create label with code number and first two names of the person

    label
  })

  output$selection  <- renderText({
    bucketlistlabels()
  })

}

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