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?
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)
Please check this if you prefer a horizontal layout.