Customizing shinyjqui package

shiny
1

I've been using the awesome shinyjqui app and want to customize it just a little.

The function order_input allows you to drag a block from the source to the destination multiple times, but doesn't let you delete blocks [by dragging the block back to the source].

The function jqui_sortable creates draggable components that can be dragged both ways, but once the block is removed from the source it isn't cloned and only lives in the destination.

I was hoping to:

  1. Expand on the jqui_sortable function using some of the logic of the order_input function so when a block is dragged, another one is populated in the source area (like the order_input block.
  2. Because the block would be cloned in the source, I would also would like to expand on the code so that dragging the block back from the destination to the source would just delete the block.

Is this possible? I opened an issue here where I think the code might live to make this possible but I'm struggling to implement it. Any help appreciated!!!

library(shiny)
library(shinyjs)

ui <- fluidPage(
  sidebarPanel(
    fluidRow(column(4, h5("Drag Once"),
                    jqui_sortable(div(id = "source", div("Block",
                                                         style="background-color:grey;text-align:center;color:white;box-shadow: 0 0 10px rgba(0, 0, 0, 0.7)"),
                                      style = "border: 1px solid black;padding:10px;min-height:50px;"),
                                  options = list(connectWith = "#dest", helper = "clone"))),
             column(4, h5("Put Here"),
                    jqui_sortable(div(id = "dest", style = "border: 1px solid black;padding:10px;min-height:50px"),
                                  options = list(connectWith = "#source"))),

             # this one I can drag multiple times if we set source = TRUE
             # but you can't drag back to the 'dest'
             # can we use this clone logic in the jqui_sortable code somehow?
             column(4,
                        orderInput('drag_multiple', "Drag Multiple", items = "Block",
                                   as_source = TRUE, connect = 'dest'))
    )
  )
)


server <- function(input, output, session) {
}

shinyApp(ui, server)
2

Hi @MayaGans. You can add a class to the drag_multiple and droppable function to the class to remove the drop back clone.

library(shiny)
library(shinyjs)
library(shinyjqui)

ui <- fluidPage(
    tags$head(
        tags$script(
            "$( function() {
                $( '.drop_back' ).droppable({
                    drop: function(e, ui) {
                        $(ui.helper).remove();
                    }
                })
            });"
        )
    ),
    
    sidebarPanel(
        fluidRow(column(4, h5("Drag Once"),
                        jqui_sortable(div(id = "source", div("Block",
                                                             style="background-color:grey;text-align:center;color:white;box-shadow: 0 0 10px rgba(0, 0, 0, 0.7)"),
                                          style = "border: 1px solid black;padding:10px;min-height:50px;"),
                                      options = list(connectWith = "#dest", helper = "clone"))),
                 column(4, h5("Put Here"),
                        jqui_sortable(div(id = "dest", style = "border: 1px solid black;padding:10px;min-height:50px"),
                                      options = list(connectWith = "#source"))),
                 
                 # this one I can drag multiple times if we set source = TRUE
                 # but you can't drag back to the 'dest'
                 # can we use this clone logic in the jqui_sortable code somehow?
                 column(4,
                        orderInput('drag_multiple', "Drag Multiple", items = "Block",
                                   as_source = TRUE, connect = 'dest', class = "drop_back"))
        )
    )
)


server <- function(input, output, session) {
}

shinyApp(ui, server)
3

OMG Thank you @raytong !!! :grinning:

I built on your code and made the left Block able to clone as well, but the delete functionality when you drag out isn't quite working like the code you wrote for the orderInput, would you mind taking a look?

library(shiny)
library(shinyjs)
library(shinyjqui)

ui <- fluidPage(
  tags$head(
    tags$script(
      "$( function() {
      $( '.drop_back' ).droppable({
      drop: function(e, ui) {
      $(ui.helper).remove();
      }
      })
      });
      
      $( function() {
        $( '.cloned' ).draggable({
        helper: 'clone',
        connectToSortable: '#dest',
        drop: function(e, ui) {
      $(ui.helper).remove();
      }
     })
   });"
)),

sidebarPanel(
  fluidRow(column(4, h5("Drag Once"),
                  jqui_sortable(div(id = "source", div("Block", class="cloned",
                                                       style="background-color:grey;text-align:center;color:white;box-shadow: 0 0 10px rgba(0, 0, 0, 0.7)"),
                                    style = "border: 1px solid black;padding:10px;min-height:50px;"),
                                options = list(connectWith = "#dest"))),
           column(4, h5("Put Here"),
                  jqui_sortable(div(id = "dest", style = "border: 1px solid black;padding:10px;min-height:50px"),
                                options = list(connectWith = "#source")))
  )
)
)


server <- function(input, output, session) {
}

shinyApp(ui, server)

THANK YOU AGAIN!

4

@MayaGans. The drop argument was not for draggable function. Add the droppable function to cloned to remove the clone when dropped.

library(shiny)
library(shinyjs)
library(shinyjqui)

ui <- fluidPage(
    tags$head(
        tags$script(
            "$( function() {
      $( '.drop_back' ).droppable({
      drop: function(e, ui) {
      $(ui.helper).remove();
      }
      })
      });
      
      $( function() {
        $( '.cloned' ).draggable({
        helper: 'clone',
        connectToSortable: '#dest',
        });
        $( '.cloned' ).droppable({
            drop: function(e, ui) {
                $(ui.helper).remove();
            }
        })
   });"
        )),
    
    sidebarPanel(
        fluidRow(column(4, h5("Drag Once"),
                        jqui_sortable(div(id = "source", div("Block", class="cloned",
                                                             style="background-color:grey;text-align:center;color:white;box-shadow: 0 0 10px rgba(0, 0, 0, 0.7)"),
                                          style = "border: 1px solid black;padding:10px;min-height:50px;"),
                                      options = list(connectWith = "#dest"))),
                 column(4, h5("Put Here"),
                        jqui_sortable(div(id = "dest", style = "border: 1px solid black;padding:10px;min-height:50px"),
                                      options = list(connectWith = "#source")))
        )
    )
)


server <- function(input, output, session) {
}

shinyApp(ui, server)
1 Like
5

Thanks so much @raytong I changed the code just a tiny bit because I want to be able to delete the cloned block by dragging it anywhere into the original area, but now I have another question:

I want the draggable element to have a selectInput, but since the selected option is queried using input$id it's only printing the id of the original block in the Drag area - can I use JQuery to find all the select elements in the Put Here area and add their selected option to the dataframe?

I have it working in a fiddle but I'm struggling to adapt it to Shiny: http://jsfiddle.net/MayaGans/dszvynj5/42/

library(shiny)
library(shinyjs)
library(shinyjqui)

BLOCKS <- c("dropdown", "Block")

Blocks <- function(data, name)
{
  div(style = "
      text-align: center;
      font-size: 12px;
      background-color: #A9A9A9;
      border-radius: 10px;
      color: black; margin-bottom: 5px;
      min-width: 80px;
      ",
      drag = name,
      id = name,
      class = "cloned",
      if (name == "dropdown") {
        # how do I abstractly make the ids ttest_1 and ttest_2
        # based on the occurances in the vector?
        selectInput(name, "Dropdown", choices = c("1", "2", "3"), selectize = FALSE)
      } else {
        name
      }
  )
}

ui <- fluidPage(
  tags$head(
    tags$script(
      "$( function() {
      $( '.delete_dropped' ).droppable({
      drop: function(e, ui) {
      $(ui.helper).remove();
      }
      })
      });

      $( function() {
      $( '.cloned' ).draggable({
      helper: 'clone',
      connectToSortable: '#dest',
      drop: function(e, ui) {
      $(ui.helper).remove();
      }
      })
      });"
)),

sidebarPanel(
  fluidRow(column(6, h5("Drag"),
                  jqui_sortable(div(id = "source", class="delete_dropped",
                                    lapply(BLOCKS, Blocks, data = BLOCKS),
                                    style = "border: 1px solid black;padding:10px;min-height:50px;"),
                                options = list(connectWith = "#dest"))),
           column(6, h5("Put Here"),
                  jqui_sortable(div(id = "dest", style = "border: 1px solid black;padding:10px;min-height:50px"),
                                options = list(connectWith = "#source")))
  )),
mainPanel(tableOutput("debug"))
)

server <- function(input, output, session) {

  output$debug <- renderTable({
    # print the block text and make unique
    # maybe I can use these unique names to rename the ids of the selectInputs
    # then I can input[["Dropdown"]], input[["Dropdown.1"]], etc etc to get the selected option?
    t <- data.frame( id = make.unique(unlist(input$dest_order$text)))
    t$input <- ifelse(grepl('^Block', t$id), NA, paste0("input[[", t$id, "]]"))
    t
  })
}

shinyApp(ui, server)

Thoughts? Again, I really can't thank you enough!

6

@MayaGans. You better rewrite the code to define the drag, drop and sort behaviour
with jQuery other than using the shinyjqui package.

7

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.