Search code examples
rshinyhandsontablerhandsontable

Synchronizing column order between two rHandsontable outputs in a Shiny app


I am building a Shiny app that displays two tables side by side: a control table and a preview table. The control table displays the column names of the preview table, and the user can manipulate them by dragging and dropping columns to change their order. The user can also edit the names of the columns in the control table, and the changes are reflected in the preview table. However, I am having trouble synchronizing the columns' order between the control table and the preview table.

Here's the code for my Shiny app:

library(shiny)
library(data.table)
library(htmlwidgets)
library(rhandsontable)

ui <- fluidPage(
  fluidRow(column(width = 6, rHandsontableOutput('control_table')),
           column(width = 6, rHandsontableOutput('preview_table')))
)

server <- function(input, output) {
  # Reactive value
  rv_data <- reactiveVal(data.table(A = 1:3, B = 4:6, C = 7:9))
  
  # Control table
  output$control_table <- renderRHandsontable({
    req(rv_data())
    
    # Get data
    DT <- rv_data()
    
    # Create table
    DTC <- data.table( t( names(DT) ) )
    setnames(DTC, names(DT))
    
    # Display table
    rhandsontable(
      data = DTC,
      readOnly = FALSE,
      contextMenu = FALSE,
      selectionMode = 'none',
      manualColumnMove = TRUE,
      afterColumnMove = JS(
        'function(changes, source) { Shiny.setInputValue("column_order", this.getColHeader()); }'
      )
    )
  })
  
  # Preview table
  output$preview_table <- renderRHandsontable({
    req(rv_data())
    
    # Get data
    DT <- rv_data()
    
    # Display table
    rhandsontable(
      data = DT,
      readOnly = TRUE,
      contextMenu = FALSE,
      selectionMode = 'none'
    )
  })
  
  # Change columns' names
  observeEvent(input$control_table$changes$changes, {
    # Get data
    DT <- rv_data()
    DT_hot <- hot_to_r(input$control_table)
    
    # Set new cols names
    names(DT) <- unlist(DT_hot[1, ])
    
    # Updated reactive value
    rv_data(DT)
  })
  
  # Change columns' order
  observeEvent(input$column_order, {
    # Get data
    DT <- rv_data()
    
    # Set new cols order
    new_col_order <- input$column_order
    DT <- DT[, ..new_col_order]
    
    # Updated reactive value
    rv_data(DT)
  })
}

shinyApp(ui, server)

When I change the order of columns in the control table, the columns in the preview table do not update accordingly. I have tried several approaches, but I cannot get the columns' order to synchronize between the control and preview tables. How can I achieve this synchronization?


Solution

  • Here is an approach using library(sortable):

    library(shiny)
    library(data.table)
    library(htmlwidgets)
    library(rhandsontable)
    library(sortable)
    
    DT <- data.table(A = 1:3, B = 4:6, C = 7:9)
    initial_column_names <- names(DT)
    inputIds <- paste0("textInput", seq_along(initial_column_names))
    labels <- setNames(lapply(seq_along(initial_column_names), function(i){textInput(inputId = inputIds[i], label = "", value = initial_column_names[i], width = NULL, placeholder = NULL)}), inputIds)
    
    column_rank_list <- rank_list(
      text = "Reorder / rename columns",
      labels = labels,
      input_id = "column_rank_list"
    )
    
    ui <- fluidPage(
      fluidRow(column(width = 3, column_rank_list),
               column(width = 9, rHandsontableOutput('preview_table')))
    )
    
    server <- function(input, output, session) {
      rv_data <- reactiveVal(DT)
      
      # Change columns' order
      observeEvent(input$column_rank_list, {
        req(input$column_rank_list)
        tmpDT <- copy(rv_data())
        column_order <- sapply(input$column_rank_list, function(x){input[[x]]})
        setcolorder(tmpDT, column_order)
        rv_data(tmpDT)
      })
      
      # Change column names
      observeEvent(sapply(inputIds, function(x){input[[x]]}), {
        req(input$column_rank_list)
        tmpDT <- copy(rv_data())
        column_order <- sapply(input$column_rank_list, function(x){input[[x]]})
        setnames(tmpDT, column_order)
        rv_data(tmpDT)
      })
      
      # Preview table
      output$preview_table <- renderRHandsontable({
        rhandsontable(
          data = rv_data(),
          readOnly = TRUE,
          contextMenu = FALSE,
          selectionMode = 'none'
        )
      })
    }
    
    shinyApp(ui, server)
    

    result

    Please check this if you prefer a horizontal layout.