Home > Mobile >  How to add an accumulating rank order number to a reactive data frame (or list) in r shiny?
How to add an accumulating rank order number to a reactive data frame (or list) in r shiny?

Time:06-02

The below reproducible code works fine for dragging elements from one panel to another, and in the "Drag to" panel automatically, using HTML/CSS, rank order numbering each element dragged in.

I'm trying to now channel these dragged elements into a data frame (list) for further to-be-built manipulation. Hence the rendered Table1 in the below code.

I'm trying to mimic (or better yet copy over) in the output data frame the rank order numbering generated in the "Drag to" panel via HTML. In the below code you can see my failed attempt in the server section where I define the reactive object dragToLabels and in the for-loop try to count the number of elements.

The image at the bottom better explains.

How would I add (or copy over) rank order numbering to that output data frame too?

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('
      #dragTo {list-style-type: none;  counter-reset: css-counter 0;}
      #dragTo > div {counter-increment: css-counter 1;}
      #dragTo > 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 = "dragFrom",
          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 = "dragTo"
        )
      )
    )
  ),
  sortable_js(
    "dragFrom",
    options = sortable_options(
      group = list(
        pull = "clone",
        name = "group1",
        put = FALSE
      )
    )
  ),
  sortable_js(
    "dragTo",
    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) {
  
  dragToLabels <- reactive({
    s <- input$selected 
      label =  NULL 
      for (i in s)
        label <- c(label, paste(length(input$selected), i, sep = " . "))
      label
  })
  
  output$table1 <- renderTable({dragToLabels()})
  
}

shinyApp(ui, server)

Illustration:

enter image description here

CodePudding user response:

We can simply use paste0 and create a data.frame from the result:

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('
      #dragTo {list-style-type: none;  counter-reset: css-counter 0;}
      #dragTo > div {counter-increment: css-counter 1;}
      #dragTo > 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 = "dragFrom",
          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 = "dragTo"
        )
      )
    )
  ),
  sortable_js(
    "dragFrom",
    options = sortable_options(
      group = list(
        pull = "clone",
        name = "group1",
        put = FALSE
      )
    )
  ),
  sortable_js(
    "dragTo",
    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) {
  dragToLabels <- reactive({
    data.frame(data = paste0(seq_along(input$selected), ". ", input$selected))
  })
  
  output$table1 <- renderTable({dragToLabels()})
}

shinyApp(ui, server)

result

As an alternative you could use DT::datatable and DT::renderDT() which displays rownumbers by default:

library(DT)
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('
      #dragTo {list-style-type: none;  counter-reset: css-counter 0;}
      #dragTo > div {counter-increment: css-counter 1;}
      #dragTo > 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 = "dragFrom",
          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 = "dragTo"
        )
      )
    )
  ),
  sortable_js(
    "dragFrom",
    options = sortable_options(
      group = list(
        pull = "clone",
        name = "group1",
        put = FALSE
      )
    )
  ),
  sortable_js(
    "dragTo",
    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:"))),
  fluidRow(column(3, DTOutput("table1")))
)

server <- function(input, output) {
  dragToLabels <- reactive({
    data.frame(data = input$selected)
  })
  output$table1 <- renderDT({dragToLabels()})
}

shinyApp(ui, server)

alternative

  • Related