shiny / rhandsontable / updating cells

Question

In shiny, I have two tables displayed with rhandsontable, I have already implemented that whenever a cell value is changed the cell gets colored, however when switching between the tables all the changes disappear since naturally the table reloads everytime from the start, is it possible to somehow save the changed cell, so as long as you do not quit the session or do not press "reset" all the changes remain even if you switch between the tables?

(code based on the solution of the following thread: in shiny: rhandsontable / afterChange, change multiple cell backgrounds at once)

library(shiny)
library(rhandsontable)
library(tidyverse)

change_hook <- "function(el,x) {
  hot = this.hot;
  cellchngs = [];
  afterChange = function(changes, source) {
    $.each(changes, function (index, elem) {
      change = elem;                  /* gather the row, col, old, new values */
      if(change[2] !== change[3]) {   /* if old isn't the same as new */
        cellchg = ({rowind: change[0], colind: change[1]});
        cellchngs.push(cellchg);      /* add row and column indicies to array */
      }
    });
    $.each(cellchngs, function(ind, elem) { 
      td = hot.getCell(elem['rowind'], elem['colind']); /* get the html element */
      td.style.background = 'cyan';                     /* set background color */
    });
  }
  hot.addHook('afterChange', afterChange);  /* add event to table */
}"


ui <- div(actionButton(inputId = "reset_button",label = "Reset"), selectInput("data", "Choose data",choices=c("mtcars"=1, "iris"=2), selected=1)
          ,rHandsontableOutput(outputId="mtcars"))


server <- function(input, output, session) {
  
  
  reset <- reactiveVal(0)
  output$mtcars <- renderRHandsontable({
    r = reset()
    myvec <- c("mtcars", "iris")
    mydata <- eval(parse(text=myvec[as.numeric(input$data)]))
    rht = rhandsontable(mydata,reset=r,stretchH="all",height=300)
    reset(0)
    htmlwidgets::onRender(rht,change_hook)
  })
  
  observeEvent(input$reset_button,
               {
                 reset(1)
               })
}

shinyApp(ui, server)

@StéphaneLaurent: the reset button would reset all changes in the tables alltogether. — galaxy--, Jun 05 '23 at 15:32
@StéphaneLaurent: thank you very much for looking into this issue, so do you not think that this is solvable then? — galaxy--, Jun 05 '23 at 19:45
If you have both tables shown at once, you can make this work with just a few changes: 1) Instead of `hot = this.hot;`, use `var hot = el.htmlwidget_data_init_result.hot;`. Prefix `var` to the first occurrence of `cellchngs`, `change`, `cellchg`, and `td`. (For example, instead of `cellchngs = [];`, use `var cellchngs = [];` If this doesn't make sense or needs more clarity, I can add a lot of detail as an answer. This doesn't answer your actual question, though. Another option would be to have both tables "shown" at the same time, but stack them on top of each other. (So you only see one.) — Kat, Jun 07 '23 at 20:16

score 1 · Answer 1 · answered Jun 08 '23 at 05:18

This is a bit ugly (in terms of coding redundancy)...but I'm tired, and it works. At the end of my answer, I've provided all of the code again, all together, for easier copy + paste.

This capitalizes on your browser's session storage. That means that as long as it is one continuous event, the data will save. If you wanted to be able to close the browser or rerun the app and still have the saved changes, you could use local storage instead (sessionStorage versus localStorage).

This will only work with you have the graphs set up right now. If you change your ui to have two separate tables, this won't work. (I can help if you set it up differently, just let me know.)

Changes to the `change_hook`:

wh will capture either mtcars or iris from your selectInput dropdown menu.

cellchngs will capture changes as it did before, but now you'll have one for each table. There are three arrays because it was the simplest way to align the 1... indexing in R and the 0, 1.... indexing in JS. In other words, that first array within cellchngs will remain empty, the next array (index 1 in JS) will capture everything that changes in the selectInput value = 1 -- that's your mtcars table (as you've assigned it).

afterChange didn't change very much from your original question.

added idx to capture the index from your selectInput
modified cellchngs = to cellchngs[idx] =
added sCookie(): function that saves the data in the sessions storage of your browser (see the image after this list of changes)
added global var collection with chgs (this is declared in your ui; more on that when I cover the changes to the ui)
lastly, if(sessionStorage... looks to see if there is data saved in session storage, if there is, this will update the table to reflect the changes made since you started the browser session (regardless of how many times you flip between tables with the dropdown)

Looking at Session Storage: you can see this in your browsers developer tools; tab: Application, left menu: Session Storage -> your IP (see the image below)

change_hook <- "function(el, x) {
  var hot = el.htmlwidget_data_init_result.hot;
  var wh = document.querySelector('#data option').innerHTML;   /* DD table select */
  var cellchngs = [[], [], []];             /* 3 arrays: 0 start index vs 1 start */
  
  afterChange = function(changes, source) {
    var idx = document.querySelector('#data option').value;    /* DD table select */
    $.each(changes, function (index, elem) {
      var change = elem;                       /* gather the row, col, old, new values */
      if(change[2] !== change[3]) {            /* if old isn't the same as new */
        var cellchg = ({rowind: change[0], colind: change[2]});
        cellchngs[idx].push(cellchg);          /* add row and column indicies to array */
        sCookie();                             /* save the updated data to cookie */
      }
    });
    $.each(cellchngs[idx], function(ind, ele) {
      var td = hot.getCell(ele['rowind'], ele['colind']);    /* get the html element */
      td.style.background = 'yellow';                        /* set background color */
    });

    chgs[idx] = chgs[idx].concat(cellchngs[idx]);            /* save list of changes to global var*/
    chgs[idx].filter((v,i,a)=>a.findIndex(v2=>['rowind','colind'].every(k=>v2[k] ===v[k]))===i);  /* remove duplicates */
  }
  hot.addHook('afterChange', afterChange);  /* add event to table */

  if(sessionStorage[wh]) {                  /* if data already stored for current table, retrieve it*/
    hot.loadData(JSON.parse(sessionStorage[wh])); 
    hot.render();
    colr(chgs, hot);                        /* re-highlight changes */
  }
}"

Changes to the `ui`

I've added a tags$script element to your ui, the code you originally had in your ui remains the same.

In this script, you'll find the declaration of the global variable chgs, the function colr: change cell colors outside of the change event, and sCookie: save the data to session storage.

ui <- div(
  tags$script(HTML(
  'setTimeout(function() {  /* ensure table loads before looking for tbl elem */
    chgs = [[], [], []];    /* global variable */
    colr = function(chgs, hot) { /* for outside of change events (update data from stg */
      var idx = document.querySelector("#data option").value;/* DD table select */
      $.each(chgs[idx], function(ind, ele) {
        var td = hot.getCell(ele["rowind"], ele["colind"]);  /* get the html element */
        td.style.background = "yellow";                      /* set background color */
      });
    }
    sCookie = function() {  /* whenever data changes are made, save to local*/
      var el = document.querySelector(".rhandsontable.html-widget"); /* capture table el */
      var hot = el.htmlwidget_data_init_result.hot;                  /* capture instance */
      var wh = document.querySelector("#data option").innerHTML;     /* DD table select */
      sessionStorage[wh] = JSON.stringify(hot.getData());            /* DD table select */
      return
    }
  }, 200)')),
          actionButton(inputId = "reset_button", label = "Reset"), 
          selectInput("data", "Choose data",
                      choices = c("mtcars" = 1, "iris" = 2), selected = 1),
          rHandsontableOutput(outputId = "mtcars"))

All the code altogether

Here's everything again, but all at once. If you have any questions, let me know.

Note that I didn't change anything in your server (it may look different due to spacing, though).

library(shiny)
library(rhandsontable)

change_hook <- "function(el, x) {
  var hot = el.htmlwidget_data_init_result.hot;
  var wh = document.querySelector('#data option').innerHTML;   /* DD table select */
  var cellchngs = [[], [], []];             /* 3 arrays: 0 start index vs 1 start */
  
  afterChange = function(changes, source) {
    var idx = document.querySelector('#data option').value;    /* DD table select */
    $.each(changes, function (index, elem) {
      var change = elem;                       /* gather the row, col, old, new values */
      if(change[2] !== change[3]) {            /* if old isn't the same as new */
        var cellchg = ({rowind: change[0], colind: change[2]});
        cellchngs[idx].push(cellchg);          /* add row and column indicies to array */
        sCookie();                             /* save the updated data to cookie */
      }
    });
    $.each(cellchngs[idx], function(ind, ele) {
      var td = hot.getCell(ele['rowind'], ele['colind']);    /* get the html element */
      td.style.background = 'yellow';                        /* set background color */
    });

    chgs[idx] = chgs[idx].concat(cellchngs[idx]);            /* save list of changes to global var*/
    chgs[idx].filter((v,i,a)=>a.findIndex(v2=>['rowind','colind'].every(k=>v2[k] ===v[k]))===i);  /* remove duplicates */
  }
  hot.addHook('afterChange', afterChange);  /* add event to table */

  if(sessionStorage[wh]) {                  /* if data already stored for current table, retrieve it*/
    hot.loadData(JSON.parse(sessionStorage[wh])); 
    hot.render();
    colr(chgs, hot);                        /* re-highlight changes */
  }
}"

ui <- div(
  tags$script(HTML(
    'setTimeout(function() {  /* ensure table loads before looking for tbl elem */
    chgs = [[], [], []];    /* global variable */
    colr = function(chgs, hot) { /* for outside of change events (update data from stg */
      var idx = document.querySelector("#data option").value;/* DD table select */
      $.each(chgs[idx], function(ind, ele) {
        var td = hot.getCell(ele["rowind"], ele["colind"]);  /* get the html element */
        td.style.background = "yellow";                      /* set background color */
      });
    }
    sCookie = function() {  /* whenever data changes are made, save to local*/
      var el = document.querySelector(".rhandsontable.html-widget"); /* capture table el */
      var hot = el.htmlwidget_data_init_result.hot;                  /* capture instance */
      var wh = document.querySelector("#data option").innerHTML;     /* DD table select */
      sessionStorage[wh] = JSON.stringify(hot.getData());            /* DD table select */
      return
    }
  }, 200)')),
  # tags$style(HTML(".colorMe {background: yellow !important;}")),
  actionButton(inputId = "reset_button", label = "Reset"), 
  selectInput("data", "Choose data",
              choices = c("mtcars" = 1, "iris" = 2), selected = 1),
  rHandsontableOutput(outputId = "mtcars"))

server <- function(input, output, session) { # unchanged from your question
  reset <- reactiveVal(0)
  output$mtcars <- renderRHandsontable({
    r = reset()
    myvec <- c("mtcars", "iris")
    mydata <- eval(parse(text = myvec[as.numeric(input$data)]))
    rht = rhandsontable(mydata, reset = r, stretchH = "all", height = 300)
    reset(0)
    htmlwidgets::onRender(rht, change_hook)
  })
  observeEvent(input$reset_button, {reset(1)})
}

shinyApp(ui, server)

Thank you so much for taking the time and writing such an detailed answer, however unfortunately for me it does not work, neither over Rstudio nor the the browser, when I change a value only a blue outer rectangle appears around the cell and it freezes everything. I tried it on firefox and edge — galaxy--, Jun 11 '23 at 13:21

score 1 · Accepted Answer · answered Jun 10 '23 at 15:43

You can use hidden tabsetPanels to achieve that.

Note that I did not change the change_hook block.

library(shiny)
library(rhandsontable)

change_hook <- "function(el,x) {
  hot = this.hot;
  cellchngs = [];
  afterChange = function(changes, source) {
    $.each(changes, function (index, elem) {
      change = elem;                  /* gather the row, col, old, new values */
      if(change[2] !== change[3]) {   /* if old isn't the same as new */
        cellchg = ({rowind: change[0], colind: change[1]});
        cellchngs.push(cellchg);      /* add row and column indicies to array */
      }
    });
    $.each(cellchngs, function(ind, elem) { 
      td = hot.getCell(elem['rowind'], elem['colind']); /* get the html element */
      td.style.background = 'cyan';                     /* set background color */
    });
  }
  hot.addHook('afterChange', afterChange);  /* add event to table */
}"


ui <- fluidPage(
  actionButton(inputId = "reset_button",label = "Reset"),
  selectInput(
    inputId = "data",
    label = "Choose data",
    choices = c("mtcars", "iris")
  ),
  tabsetPanel(
    id = "tabs",
    type = "hidden",
    tabPanelBody(
      value = "mtcars",
      rHandsontableOutput(outputId = "mtcars")
    ),
    tabPanelBody(
      value = "iris",
      rHandsontableOutput(outputId = "iris")
    )
  )
)


server <- function(input, output, session) {
  reset <- reactiveVal(0)
  output$mtcars <- renderRHandsontable({
    r = reset()
    rht = rhandsontable(
      mtcars,
      reset = r,
      stretchH = "all",
      height = 300
    )
    reset(0)
    htmlwidgets::onRender(rht, change_hook)
  })
  
  output$iris <- renderRHandsontable({
    r = reset()
    rht = rhandsontable(
      iris,
      reset = r,
      stretchH = "all",
      height = 300
    )
    reset(0)
    htmlwidgets::onRender(rht, change_hook)
  })
  
  observeEvent(input$reset_button, {
    reset(1)
  })
  
  # if the selectInput value changes, switch tabs:
  observeEvent(input$data, {
    updateTabsetPanel(
      session = session,
      inputId = "tabs",
      selected = input$data
    )
  })
}

shinyApp(ui, server)

shiny / rhandsontable / updating cells

2 Answers2

Changes to the change_hook:

Changes to the ui

All the code altogether

Changes to the `change_hook`:

Changes to the `ui`