In running the below reproducible code, the target output is generated in the right panel by dragging in elements from the left panel. I'm trying to feed those list elements into an R dataframe and show in a rendered table. The image at the bottom better explains. How is this done?

Reproducible code:

library(shiny)
library(sortable)
library(htmlwidgets)

icons <- function(x) {lapply(x,function(x){tags$div(tags$strong(x))})}

ui <- fluidPage(

  tags$head(
    tags$style(HTML('
      #drag_from > div {cursor: move; #fallback
                        cursor: grab; cursor: pointer;
                        }
      #drag_to > div {cursor: move; #fallback
                      cursor: grab; cursor: pointer;
                      }                
      #drag_to {list-style-type: none;  counter-reset: css-counter 0;}
      #drag_to > div {counter-increment: css-counter 1;}
      #drag_to > div:before {content: counter(css-counter) ". ";}
      ')
    )
  ),
  
  div(
    style = "margin-top: 2rem; width: 60%; display: grid; grid-template-columns: 1fr 1fr; gap: 2rem; align-items: start;",

    div(
      div(
        class = "panel panel-default",
        div(class = "panel-heading", "Drag from here"),
        div(
          class = "panel-body",
          id = "drag_from",
          icons(c("A", "B", "C", "D", "E"))
        )
      ),
    ),
    div(
      div(
        class = "panel panel-default",
        div(class = "panel-heading", "Drag to here"),
        div(
          class = "panel-body",
          id = "drag_to"
        )
      )
    )
  ),
  sortable_js(
    "drag_from",
    options = sortable_options(
      group = list(
        pull = "clone",
        name = "group1",
        put = FALSE
      )
    )
  ),
  sortable_js(
    "drag_to",
    options = sortable_options(
      group = list(
        group = "group1",
        put = TRUE,
        pull = TRUE
      )
    )
  ),
  helpText(h5(strong("Output to table:"))),
  tableOutput("table1")
)

server <- function(input, output) {
  output$table1 <- renderTable({input$drag_to})
}

shinyApp(ui, server)

Illustration:

CodePudding user response：

One option to achieve your desired result is to use the sortable_js_capture_input method which

captures the state of a sortable list

and is

used with the onSort option of sortable_js

(See ?sortable_js_capture_input).

library(shiny)
library(sortable)
library(htmlwidgets)

icons <- function(x) {
  lapply(x, function(x) {
    tags$div(tags$strong(x))
  })
}

ui <- fluidPage(
  tags$head(
    tags$style(HTML('
      #drag_from > div {cursor: move; #fallback
                        cursor: grab; cursor: pointer;
                        }
      #drag_to > div {cursor: move; #fallback
                      cursor: grab; cursor: pointer;
                      }
      #drag_to {list-style-type: none;  counter-reset: css-counter 0;}
      #drag_to > div {counter-increment: css-counter 1;}
      #drag_to > div:before {content: counter(css-counter) ". ";}
      '))
  ),
  div(
    style = "margin-top: 2rem; width: 60%; display: grid; grid-template-columns: 1fr 1fr; gap: 2rem; align-items: start;",
    div(
      div(
        class = "panel panel-default",
        div(class = "panel-heading", "Drag from here"),
        div(
          class = "panel-body",
          id = "drag_from",
          icons(c("A", "B", "C", "D", "E"))
        )
      ),
    ),
    div(
      div(
        class = "panel panel-default",
        div(class = "panel-heading", "Drag to here"),
        div(
          class = "panel-body",
          id = "drag_to"
        )
      )
    )
  ),
  sortable_js(
    "drag_from",
    options = sortable_options(
      group = list(
        pull = "clone",
        name = "group1",
        put = FALSE
      )
    )
  ),
  sortable_js(
    "drag_to",
    options = sortable_options(
      group = list(
        group = "group1",
        put = TRUE,
        pull = TRUE
      ),
      onSort = sortable_js_capture_input(input_id = "selected")
    )
  ),
  helpText(h5(strong("Output to table:"))),
  tableOutput("table1")
)

server <- function(input, output) {
  output$table1 <- renderTable({
    input$selected
  })
}

shinyApp(ui, server)