2

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?

mat
  • 2,412
  • 5
  • 31
  • 69
  • The control table with its circular reference is quite annoying. Are you open for alternative solutions regarding the column sorting? – ismirsehregal Apr 13 '23 at 16:18
  • @ismirsehregal Yes I am open to alternatives, although I really liked the `rhandsontable` approach because it seemed to allow to carry out both actions (editing and sorting) with a single input. I also looked into `shinyjqui::orderInput()` to sort columns, which works great. I wish we could edit columns' names directly by for instance double clicking these daraggable inputs. – mat Apr 14 '23 at 07:01

1 Answers1

2

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.

ismirsehregal
  • 30,045
  • 5
  • 31
  • 78
  • I created another post with a question related to your answer, maybe you want to have a look at it: https://stackoverflow.com/questions/76123945/renaming-and-sorting-columns-of-a-dataset-using-the-sortable-package-in-shiny – mat Apr 28 '23 at 15:49