inst/apps/example07-input-options/app.R

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

library(shiny)
library(dragulaR)

# creating a vector of blocks - note the two ANOVA blocks
# we can use make.unique to create an index for each block and it's dropdown menu
test <- make.unique(c("ONE", "TWO"))

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") {
        selectInput(name, "Dropdown", choices = c("group_1", "group_2", "group_3"), selectize = FALSE)
      } else {
        name
      }
  )
}


library(shiny)

ui <- fluidPage(

  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(
    h1("Debug"),
    tableOutput('debug'))
)


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

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

  d <-  reactive({
    req(length(input$dragula$Model) > 0)
    # could give them all unique ids but I don't know how
    # I'd use these unique id's as the dropdown ids instead of name?
    dat <- data.frame(id = make.unique(unlist(input$dragula$Model)))
    dat$dropdown <- ifelse(grepl('ONE', dat$id), input$ONE, "")
    dat
  })

  output$debug <- renderTable({
    d()
  })


}

shinyApp(ui = ui, server = server)


##############
##############