Skip to content

Instantly share code, notes, and snippets.

@kennedymwavu
Last active July 4, 2022 16:54
Show Gist options
  • Save kennedymwavu/1133c1b5144b01980f4a7f0986d5ec45 to your computer and use it in GitHub Desktop.
Save kennedymwavu/1133c1b5144b01980f4a7f0986d5ec45 to your computer and use it in GitHub Desktop.
Warning: Error in genColHeaders: Change no recognized:afterChange
# How to capture data from rhandsontable after column addition/deletion, since
# rhandsontable::hot_to_r() wouldn't work
# {rhandsontable} version ‘0.3.9’
# R version 4.2.0 (2022-04-22)
library(shiny)
library(rhandsontable)
library(data.table)
library(shinyjs)
# say this is your initial data.frame:
DF <- data.frame(
val = 1:10,
bool = TRUE,
big = LETTERS[1:10],
small = letters[1:10],
dt = seq(from = Sys.Date(), by = "days", length.out = 10),
stringsAsFactors = FALSE
)
ui <- fluidPage(
shinyjs::useShinyjs(),
tags$h3(
"This is my ui"
),
fluidRow(
column(
width = 12,
rHandsontableOutput("thistable")
)
)
)
server <- function(input, output, session) {
output$thistable <- renderRHandsontable({
rhandsontable(
data = DF,
# set `useTypes = FALSE` to enable column addition:
useTypes = FALSE
) |>
# allow col & row editing:
hot_context_menu(
allowColEdit = TRUE, allowRowEdit = TRUE
)
})
# ---modal_newcolname---
# after column addition, this modal let's user add new column name:
modal_newcolname <- function(default_colname) {
# default_colname is a string eg. newcol7 dependent on the tables ncols
modalDialog(
title = "Enter New Column Name:",
easyClose = FALSE,
fluidRow(
column(
width = 12,
align = "center",
textInput(
inputId = "newcolname",
label = NULL,
value = default_colname
)
)
),
footer = actionButton(
inputId = "done", label = "Done"
)
)
}
# disable `input$done` if `input$newcolname` is not given and also avoid
# duplicate colnames:
observe({
shinyjs::toggleState(
id = "done",
condition = {
# newest column name:
newestcolname <- paste0("newcol", length(rv_table$prevcolnames))
# other column names:
othercols <- rv_table$prevcolnames[
rv_table$prevcolnames != newestcolname
]
x <- input$newcolname
# must be truthy:
isTruthy(x) &&
# must not be one of the other colnames:
!(x %in% othercols)
}
)
})
# ---rv_table----
# `reactiveValues()` obj to contain edited rhandsontable:
rv_table <- reactiveValues(
current = NULL,
# set prevcolnames to the names of the initial `DF`:
prevcolnames = colnames(DF)
)
# ----changes----
# On change of `input$thistable`:
observeEvent(input$thistable, {
# get current state of rhandsontable:
current <- input$thistable$data
current_dt <- lapply(current, FUN = function(x) {
lapply(x, FUN = function(y) {
# set NULL values to NA:
y[is.null(y)] <- NA
y
})
}) |>
# bind to a data.table:
data.table::rbindlist(use.names = FALSE)
# capture the event that occurred:
event <- input$thistable$changes$event
# On which index did the event occur:
ind <- input$thistable$changes$ind + 1
# Since rhandsontable uses JS and indexing starts at 0, I add the 1 to get
# normal R indices
# if the event is addition/deletion of columns:
if (event %in% c("afterCreateCol", "afterRemoveCol")) {
# if event is column removal:
if (identical(event, "afterRemoveCol")) {
# reduce prevcolnames by 1:
rv_table$prevcolnames <- rv_table$prevcolnames[-ind]
}else {
# if event is column creation:
if (identical(event, "afterCreateCol")) {
# new column name:
newcolname <- paste0("newcol", ncol(current_dt))
if (ind == 1) {
# if column is added as the first one:
# update prevcolnames:
rv_table$prevcolnames <- c(newcolname, rv_table$prevcolnames)
}else if (ind == ncol(current_dt)) {
# if column is added as the last one:
# update prevcolnames:
rv_table$prevcolnames <- c(rv_table$prevcolnames, newcolname)
}else {
# if column is added in between other columns:
# update prevcolnames:
rv_table$prevcolnames <- append(
x = rv_table$prevcolnames,
values = newcolname,
after = ind - 1
)
}
# Trigger modal popup:
showModal(modal_newcolname(default_colname = newcolname))
}
}
}
# finally set names for current_dt:
setattr(
x = current_dt,
name = "names",
value = rv_table$prevcolnames
)
# save current_dt in rv_table$current:
rv_table$current <- current_dt
print(current_dt)
})
# ---re-render----
# rename the newest column to user's value:
observeEvent(input$done, {
# newest column name:
newestcolname <- paste0("newcol", length(rv_table$prevcolnames))
rv_table$prevcolnames[rv_table$prevcolnames == newestcolname] <-
input$newcolname
removeModal(session = session)
})
# whenever there's an update on `rv_table$prevcolnames`, re-render the
# rhandsontable, but with isolated `rv_table$current` as the data:
observeEvent(rv_table$prevcolnames, {
req(rv_table$current)
names(rv_table$current) <- rv_table$prevcolnames
output$thistable <- renderRHandsontable({
rhandsontable(
data = isolate({ rv_table$current }),
# set `useTypes = FALSE` to enable column addition:
useTypes = FALSE
) |>
# allow col & row editing:
hot_context_menu(
allowColEdit = TRUE, allowRowEdit = TRUE
)
})
})
# ----return----
# now if you want to perform anything on the data after user edits, use this
# reactive:
res <- reactive({
rv_table$current
})
}
shinyApp(ui, server)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment