Search code examples
jqueryrshinyshinydashboardshinyjs

Moveable multiple Items in R Shiny boxes - something similar to attached screenshot


I am trying to build a shiny application where I am trying to build a functionality similar to below screenshot:-

enter image description here

I have build something similar using Shinyjqui/sortable but I want to allow multi select prior to moving the items. Please let me know if anyone has built/worked on something similar?

Below is an example that I have created using "shinyjqui" package:-

library(shiny)
library(shinyjqui)
attach(mtcars)


ui <- fluidPage(
  fluidRow(
    column(
      width = 12,
      uiOutput("OrderInputRender")
      )
    )
  )

server<- function(input,output){
  output$OrderInputRender <- renderUI({
    fluidRow(
      column(width = 6,
             orderInput(
               "All_Columns",
               width = "100%",
               label = "Available columns",
               items = colnames(mtcars),
               style="margin:5px 0 0 0%; overflow: auto; background-color:#DCDCDC; border: 0px solid; padding: 10px; padding: 10px; height:360px;",
               connect = c("Segment_Column","Channel_Column")##which dropboxes can interact
             )## close of order input
      ),
      column(width = 6,
             orderInput(
               "Channel_Column",
               width = "100%",
               label = "Selected Columns",
               items = NULL,
               style="margin:5px 0 0 0%; overflow: auto; background-color:#DCDCDC; border: 0px solid; padding: 10px; padding: 10px; height:360px;",
               connect = c("All_Columns","Segment_Column")##which dropboxes can interact
             )## close of order input
      )
    )
  })
}

shinyApp(ui, server)

Solution

  • This is just a proof of concept using DT package. Multiple items can be selected from either side and moved over to the other.

    I do not intend to spend time on making this pretty but it should be possible using DT options and css. Lastly, it can be easily reused by packaging in a module.

    ui -

    library(shiny)
    library(DT)
    
    ui <- fluidPage(
      br(),
      splitLayout(cellWidths = c("45%", "10%", "45%"),
        DTOutput("pool"),
        list(
          br(),br(),br(),br(),br(),br(),br(),
          actionButton("add", label = NULL, icon("arrow-right")),
          br(),br(),
          actionButton("remove", label = NULL, icon("arrow-left"))
        ),
        DTOutput("selected")
      )
    )
    

    server -

    server <- function(input, output, session) {
      mem <- reactiveValues(
        pool = data.frame(LETTERS[1:10]), selected = data.frame()
      )
    
      observeEvent(input$add, {
        req(input$pool_rows_selected)
        mem$selected <- rbind(isolate(mem$selected), mem$pool[input$pool_rows_selected, , drop = F])
        mem$pool <- isolate(mem$pool[-input$pool_rows_selected, , drop = F])
      })
    
      observeEvent(input$remove, {
        req(input$selected_rows_selected)
        mem$pool <- rbind(isolate(mem$pool), mem$selected[input$selected_rows_selected, , drop = F])
        mem$selected <- isolate(mem$selected[-input$selected_rows_selected, , drop = F])
      })
    
      output$pool <- renderDT({
        mem$pool
      })
    
      output$selected <- renderDT({
        mem$selected
      })
    }
    
    shinyApp(ui, server)
    

    App Snapshot -

    enter image description here