Trying to use input text to subset sortable input

[swartzel.ja]

Hello,

I'm attempting to do something special with bucket_list() from sortable. I'd like to be able to input a text to subset the list of values to drag from.

I have a large list of variables in my main application, and need to make the list shorter at times, but also provide the option to see all the variables when needed. In my example code, I have set the default subsetting text to the letter "c", and then only variables that have the letter "c" in them are available to choose from. This works fine, except that when I change the text input for subsetting, the whole bucket list resets, and I have lost what I have already chosen. I've tried saving off the chosen values to a reactive value, but without any luck. Any help or ideas are appreciated!

R_code <-

library(shiny)
library(sortable)


ui <- fluidPage(
    tags$head(
        tags$style(HTML(".bucket-list-container {min-height: 350px;}"))
    ),
    fluidRow(
        column(
            width = 12,
            #choose list of variable names to send to bucket list
            radioButtons(inputId="variableList",
                         label="Choose your variable list",
                         choices = c("names(mtcars)"="names(mtcars)","state.name"="state.name")),
            #input text to subset variable names
            uiOutput("subsetVarListTextInput"),
            #bucket list
            uiOutput("dragAndDropList")
        )
    ),
    fluidRow(
        column(
            width = 12,
            tags$b("Result"),
            column(
                width = 12,
                
                tags$p("input$rank_list_1"),
                verbatimTextOutput("results_1"),
                
                tags$p("input$rank_list_2"),
                verbatimTextOutput("results_2"),
                
                tags$p("input$rank_list_3"),
                verbatimTextOutput("results_3"),
                
                tags$p("input$bucket_list_group"),
                verbatimTextOutput("results_4")
            )
        )
    )
)

server <- function(input,output) {
    
    #initialize reactive values
    values<-reactiveValues()
    
    #free text input to subset varialbe list
    output$subsetVarListTextInput<- renderUI({
    
    return(textInput(inputId="subsetChooseListText",
              label="Input text to subset list of states to choose from",
              value="c"))
    })
    
    
    
    #drag and drop input
    output$dragAndDropList <- renderUI({
     
    #assign variable list              
    ifelse(input$variableList=="state.name",values$varList<-state.name,values$varList<-names(mtcars))
    
    #subset variable list by input text    
    subsetChooseList<-values$varList[grepl(x=values$varList,pattern=input$subsetChooseListText,ignore.case = TRUE)]
    
    #bucket list to be output
    return(bucket_list(
        header = "Drag the items in any desired bucket",
        group_name = "bucket_list_group",
        orientation = "horizontal",
        add_rank_list(
            text = "Drag from here",
            labels = subsetChooseList,
            input_id = "rank_list_1"
        ),
        add_rank_list(
            text = "to here",
            labels = NULL,
            input_id = "rank_list_2"
        ),
        add_rank_list(
            text = "and also here",
            labels = NULL,
            input_id = "rank_list_3"
        )
    )
    )    
    })
    
    #visual output for debugging
    output$results_1 <-
        renderPrint(
            input$rank_list_1 # This matches the input_id of the first rank list
        )
    
    output$results_2 <-
        renderPrint(
            input$rank_list_2 # This matches the input_id of the second rank list
        )
    
    output$results_3 <-
        renderPrint(
            input$rank_list_3 # Matches the group_name of the bucket list
        )
    
    output$results_4 <-
        renderPrint(
            input$bucket_list_group # Matches the group_name of the bucket list
        )
    
}


shinyApp(ui, server)

[barret]

This is a good example use case that we missed.

To achieve "independently working" sortable items, we need to move them out of a single renderUI statement.

To link the independent rank_lists, we can use sortable_options(group = "GROUP") in the rank_list definitions. (We can think of bucket lists as rank lists that share the same group value.). See https://rstudio.github.io/sortable/reference/sortable_options.html for more details.

I've updated the code to add the grouped rank_lists above the broken bucket_list. The extra div containers were needed to make the grouped rank_lists appear like a bucket_list.

(I turned the reactiveValues into a set of reactives. Personal preference.)

library(shiny)
library(sortable)


ui <- fluidPage(
    tags$head(
      tags$style(HTML(".bucket-list-container {min-height: 350px;}"))
    ),
    fluidRow(
        column(
            width = 12,
            #choose list of variable names to send to bucket list
            radioButtons(inputId="variableList",
                         label="Choose your variable list",
                         choices = c("names(mtcars)"="names(mtcars)","state.name"="state.name")),
            #input text to subset variable names
            textInput(
              inputId = "subsetChooseListText",
              label = "Input text to subset list of states to choose from",
              value = "c"
            ),
            div(
              # class value is current default class value for container
              class = "bucket-list-container default-sortable",
              "Drag the items in any desired bucket",
              div(
              # class value is current default class value for list
                class = "default-sortable bucket-list bucket-list-horizontal",
                # need to make sure the outer div size is respected
                # use the current default flex value
                uiOutput("selection_list", style="flex:1 0 200px;"),
                rank_list(
                  text = "to here",
                  labels = list(),
                  input_id = "rank_list_2",
                  options = sortable_options(group = "mygroup")
                ),
                rank_list(
                  text = "and also here",
                  labels = list(),
                  input_id = "rank_list_3",
                  options = sortable_options(group = "mygroup")
                )
              )
            ),
            uiOutput("dragAndDropList")
        )
    ),
    fluidRow(
        column(
            width = 12,
            tags$b("Result"),
            column(
                width = 12,

                tags$p("input$rank_list_1"),
                verbatimTextOutput("results_1"),

                tags$p("input$rank_list_2"),
                verbatimTextOutput("results_2"),

                tags$p("input$rank_list_3"),
                verbatimTextOutput("results_3")

            )
        )
    )
)

server <- function(input,output) {

    #initialize reactive values
    varList <- reactive({
      req(input$variableList)
      if (input$variableList == "state.name") {
        state.name
      } else {
        names(mtcars)
      }
    })

    subsetChooseList <- reactive({
      items <- varList()
      pattern <- input$subsetChooseListText
      if (nchar(pattern) < 1) {
        return(items)
      }
      items[
        grepl(
          x = items,
          pattern = input$subsetChooseListText,
          ignore.case = TRUE
        )
      ]
    })

    output$selection_list <- renderUI({
      labels <- subsetChooseList()

      # remove already chosen items
      labels <- labels[!(
        labels %in% input$rank_list_2 |
        labels %in% input$rank_list_3
      )]
      rank_list(
        text = "Drag from here",
        labels = labels,
        input_id = "rank_list_1",
        options = sortable_options(group = "mygroup")
      )
    })

    #visual output for debugging
    output$results_1 <- renderPrint(input$rank_list_1)
    output$results_2 <- renderPrint(input$rank_list_2)
    output$results_3 <- renderPrint(input$rank_list_3)

    #drag and drop input
    output$dragAndDropList <- renderUI({

      #bucket list to be output
      return(bucket_list(
          header = "Broken - Drag the items in any desired bucket",
          group_name = "bucket_list_group",
          orientation = "horizontal",
          add_rank_list(
              text = "Drag from here",
              labels = subsetChooseList(),
              input_id = "rank_list_11"
          ),
          add_rank_list(
              text = "to here",
              labels = NULL,
              input_id = "rank_list_22"
          ),
          add_rank_list(
              text = "and also here",
              labels = NULL,
              input_id = "rank_list_33"
          )
      )
      )
    })
}


shinyApp(ui, server)

[swartzel.ja]

Thank you very much! This is very helpful. Let me try to incorporate this into my main app, and I'll let you know how it goes.