Customizing dragulaR [Shiny] to pre-populate using dropdown

Hi! I'm creating an app using dragulaR where I'd like the user to be able to select from a drop down and a draggable element will move from the drag area alphaBlocks into the drop area alphaOutput . I did not create this widget so I was hoping to use a combination of renderUI and onRender to move the "block" div but this may not be the best approach?

Desired Result [Pictured]:

Rather than dragging, user selects B from the dropdown and the B block is placed within alphaOutput

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

blocks <- c("Block A", "Block B", "Block C")

Blocks <- function(data, name)
{
  div(style = "
      text-align: center;
      font-size: 12px;
      background-color: #A9A9A9;
      border-radius: 10px;
      min-width: 80px;
      color: black;",
      drag = name,
      div(class = "active-title", name),
      id = gsub("[[:space:]]", "", name))
}

ui <- fluidPage(

  sidebarPanel(width = 8,

               fluidRow(style = "margin: 15px;  height: 600px;",

                        fluidRow(
                          h3("Common Block Combos:"),
                          column(12,
                                 selectInput("RECIPE", "",
                                             c("A" = "A",
                                               "B" = "B",
                                               "None" = "none"),
                                             selected = "none")
                          )
                        ),

                        fluidRow(
                          h3("Drag and Drop:"),


                          column(6,
                                 fluidRow(
                                   column(3,
                                          h5("Alpha Blocks:"),
                                          div(id = "alphaBlocks", style = "min-height: 600px;",
                                              lapply(blocks, Blocks, data = blocks))
                                   ),
                                   column(6,
                                          div(id = "alphaOutput",
                                              style = "min-height: 300px;
                                              margin-top: 0.5em; margin-left:-1em;
                                              border-style: dotted;
                                              border-color: #A9A9A9;
                                              border-width: 2px;")
                                          )
                                          )

                                 )


                                   )

                                          ),

               uiOutput("ui_alpha_dragular")

                          ),
  mainPanel(width = 2, 
            verbatimTextOutput("alpha")))

server <- function(input, output) {


  # setting the initial value of each dragula drop area
  output$alpha_dragular <- renderDragula({
    dragula(c("alphaBlocks", "alphaOutput"))
  })

  # -------------------------------------------------------
  # Change output area based on RECIPE dropdown
  # -------------------------------------------------------

  output$ui_alpha_dragular <- renderUI({
    switch(
      input$RECIPE,
      A = dragulaOutput("alpha_dragular") %>%
        onRender("function (el, x) {
                 $(\"#Block1\").appendTo(\"#alphaOutput\"); }"), # add parameters for A block
      B = dragulaOutput("alpha_dragular"), # add parameters for B block (same as A)
      dragulaOutput("alpha_dragular")
    )
  })

  # -------------------------------------------------------
  # Text output for testing
  # -------------------------------------------------------

  output$alpha <- renderPrint({
    dragulaValue(input$alpha_dragular)
  })


}

shinyApp(ui = ui, server = server)

Is there a recommended workflow for achieving this? How would I customize the renderDragula function to accept the additional argument for the desired RECIPE block?

Any help/advice appreciated!

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