添加可从闪亮的DT行选择中排序的反应性等级列表标签

Question

我试图创建一个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)

谢谢您的帮助！

Answer 1

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)