Let user edit data table variable names in R Shiny

Question

I am building an R Shiny app where the user selects columns in a data table, and the app then returns a list of the selected variables. I want the user to be able to change the names of the variables/columns in the app.

I used DT to make this interactive table. I got the code for changing the column headers from an answer by Stéphane Laurent on this post.

While both the column selection and editable column names work fine in the DT table, the problem is that changing the variable names only edits the displayed table, and the original data frame still retains its original column names. I am hoping that when users edit the variable names in the app, it changes the variable names in the actual data frame. How do I achieve this?

I was thinking about using observeEvent() to change the column names every time the user changes the column names, but since the method given by Stéphane Laurent uses JS, I'm not really sure how to do that.

(screenshot of the app here; I have changed the column names of 2 selected columns, but the original dataframe has not been updated.)

library(shiny)
library(DT)

getlist <- function(df, colnums){
  data <- df
  if(length(colnums)==1){
    column_names <- colnames(data)[colnums]
  } else{
    selected_data <- data[,colnums]
    column_names <- colnames(selected_data)
  }
  return(column_names)
}

callback <- c(
  "table.on('dblclick.dt', 'thead th', function(e) {",
  "  var $th = $(this);",
  "  var index = $th.index();",
  "  var colname = $th.text(), newcolname = colname;",
  "  var $input = $('<input type=\"text\">')",
  "  $input.val(colname);",
  "  $th.empty().append($input);",
  "  $input.on('change', function(){",
  "    newcolname = $input.val();",
  "    if(newcolname != colname){",
  "      $(table.column(index).header()).text(newcolname);",
  "    }",
  "    $input.remove();",
  "  }).on('blur', function(){",
  "    $(table.column(index).header()).text(newcolname);",
  "    $input.remove();",
  "  });",
  "});"
)


ui <- fluidPage(
  
  DTOutput("table"),
  textOutput('preview'),
  tableOutput('table2')
  
)

server <- function(input, output){
  
  data <- reactiveVal(iris)

  output[["table"]] <- renderDT({
    datatable(data(), selection = list(target = 'column'), options= list(ordering = FALSE, pageLength = 25), callback = JS(callback))
  })  
  
  #selected columns of the tables
  vlist <- reactive(c(getlist(data(),input$table_columns_selected)))
  
  #display list of selected variables
  output$preview <- renderText(paste(c('Selected variables :', vlist()), collapse=' '))
  
  output$table2 <- renderTable({data()})
  
}

shinyApp(ui, server)

Answer 1

You can use Shiny.setInputValue() to send messages from JS to shiny and generate an input value. I use this to send the old and new column name from the JS function to the input$change_colname. Then you can use observeEvent to update your data. In your case, I would use different objects that are used to render table and table2, because right now table gets rerendered after a column name change as the underlying data() is updated:

library(shiny)
library(DT)

getlist <- function(df, colnums){
  data <- df
  if(length(colnums)==1){
    column_names <- colnames(data)[colnums]
  } else{
    selected_data <- data[,colnums]
    column_names <- colnames(selected_data)
  }
  return(column_names)
}

callback <- c(
  "table.on('dblclick.dt', 'thead th', function(e) {",
  "  var $th = $(this);",
  "  var index = $th.index();",
  "  var colname = $th.text(), newcolname = colname;",
  "  var $input = $('<input type=\"text\">')",
  "  $input.val(colname);",
  "  $th.empty().append($input);",
  "  $input.on('change', function(){",
  "    newcolname = $input.val();",
  "    if(newcolname != colname){",
  "      $(table.column(index).header()).text(newcolname);",
  "      Shiny.setInputValue('change_colname', [colname, newcolname]);",
  "    }",
  "    $input.remove();",
  "  }).on('blur', function(){",
  "    $(table.column(index).header()).text(newcolname);",
  "    $input.remove();",
  "  });",
  "});"
)


ui <- fluidPage(
  
  DTOutput("table"),
  textOutput('preview'),
  tableOutput('table2')
  
)

server <- function(input, output){
  
  data <- reactiveVal(iris)
  vlist <- reactiveVal()
  
  output[["table"]] <- renderDT({
    datatable(data(), selection = list(target = 'column'), options= list(ordering = FALSE, pageLength = 25), callback = JS(callback))
  })  
  
  #selected columns of the tables
  observeEvent(input$table_columns_selected, {
    vlist(getlist(data(),input$table_columns_selected))
  })
  
  # update column names
  observeEvent(input$change_colname, {
    old_colnames <- vlist()
    old_colnames[old_colnames == input$change_colname[1]] <- input$change_colname[2]
    vlist(old_colnames)
    
    # update the data
    old_data <- data()
    colnames(old_data)[colnames(old_data) == input$change_colname[1]] <-
      input$change_colname[2]
    data(old_data)
  })
  
  #display list of selected variables
  output$preview <- renderText(paste(c('Selected variables :', vlist()), collapse=' '))
  
  output$table2 <- renderTable({data()})
  
  output$changed_var <- renderPrint({input$change_colname})
  
}

shinyApp(ui, server)