DRAGULAR_DRAG/app.R

In MayaGans/dragulaR: Drag and Drop Elements in 'Shiny' using 'Dragula Javascript Library'

library(shiny)
library(shinyjs)
library(dragulaR)

# in this case, since we are hard-coding two values, we can see that they are already unique.
test <- c("ONE", "TWO", "THREE")

aggBlocks <- function(data, name)
{
  div(style = "
      text-align: center;
      font-size: 12px;
      background-color: #A9A9A9;
      border-radius: 10px;
      color: black;
      margin-bottom: 5px;
      min-width: 100px;
      min-height:50px;
      ",
      drag = name,
      id = name,
      if (name == "ONE") {
        # It is debatable whether or not the select id really must be different from the ID of the container div.
        # Just to be pedantic, I am making the two different by appending '_select' to the name and using that as the
        # id of the select input.
        # paste(name, "select", sep = "_")
        selectInput(name, "ONE", choices = c("group_1", "group_2", "group_3"), selectize = FALSE)
      } else if (name == "TWO") {
        selectInput(name, "TWO", choices = c("A", "B", "C"), selectize = FALSE)
      } else {
        name
      }
  )
}


library(shiny)

ui <- fluidPage(
  useShinyjs(),
  extendShinyjs(script = "/Users/mayagans/Downloads/dynamic_dragulaR_MGComments_DKMreply/dragHelper.js"),
  sidebarPanel(

    fluidRow(style = "margin: 15px;",
             column(6,
                    h3("Drag:"),
                    div( style="border: solid 2px black;",
                         div(id = "Available", style = "min-height: 600px;",
                             lapply(test, aggBlocks, data = test))
                    )
             ),
             column(6,
                    h3("Drop:"),
                    div( style="border: solid 2px black;",
                         div(id = "Model", style = "min-height: 600px;")
                    )
             )
    ),
    dragulaOutput("dragula")

  ),


  mainPanel(
   tableOutput('debug')
  )
)

server <- function(input, output, session) {
  output$dragula <- renderDragula({
    dragula(c("Available", "Model"), copyOnly = 'Available', removeOnSpill = TRUE)
  })

  observeEvent(input$dragula$Model, {
    # All the hard work is done in JavaScript
    # This first argument specifies the name of the Dragula drop element, in this case Model,
    # the second argument specifies the name of the Shiny input that will react to value changes
    # of any dropped select elements
    js$refreshDragulaR("Model", "groups")
    # input$groups will contain a named list of select values,
    # input$groups_change will contain the ID of
    # the select input that was changed.
  })

  #output$print <- renderText({
  #  state <- dragulaValue(input$dragula$Model)
  #  sprintf('Select Values: %s\nModel:\n %s', paste(input$groups, collapse=", "), paste(state, collapse=","));
  #})

  output$debug <- renderTable({
    df_1 <- data.frame(stack(input$groups) %>% select(ind, values))
    df_2 <- data.frame(ind = unlist(dragulaValue(input$dragula$Model)))
    df_2$value <- NA
    i1 <- grep('^THREE', df_2$ind, invert = TRUE)
    df_2$value[i1] <- as.character(df_1$value)
    df_2
  })

}

shinyApp(ui = ui, server = server)