R/Shiny Javascript passing arguments directly from R

Question

I have a Shiny App with rhandsontable where I want the cell colors to be changed after a value is modified Basically I needed some modification of Kat's solution implemented here in shiny: rhandsontable / afterChange, change multiple cell backgrounds at once.

what I want, are different colors based on the row where the change has occurred. I have implemented an example below where in the first 5 rows the color is blue and pink in the rest, but where I would need help, how can I pass a paramter for the array in javascript dynamically via R? (Because I need different rows everytime and I would like to get the desired row indices from R for example via ?which, then have a vector in R which should ideally automatically be passed to the javascript function below instead of the if (elem['rowind'] in [0,1,2,4]) as it is now)

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 */
if (elem['rowind'] in [0,1,2,4]){
      td.style.background = 'cyan';                     /* set background color */
}
else {
  td.style.background = 'pink';                     /* set background color */
}
    });
  }
  hot.addHook('afterChange', afterChange);  /* add event to table */
}"


ui <- div(actionButton(inputId = "reset_button",label = "Reset")
          ,rHandsontableOutput(outputId="mtcars"))


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)
  })
  
  observeEvent(input$reset_button,
               {
                 reset(1)
               })
}

shinyApp(ui, server)

score 2 · Accepted Answer · answered Jul 31 '23 at 12:17

I would use the data argument of onRender (see ?htmlwidgets::onRender). It allows to use a third argument in the JavaScript function: namely this data argument, a R object, converted to JavaScript.

change_hook <- "function(el, x, v) {
  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 */
      if(v.indexOf(elem['rowind']) > -1) {
        td.style.background = 'cyan';                     /* set background color */
      } else {
        td.style.background = 'pink';                     /* set background color */
      }
    });
  }
  hot.addHook('afterChange', afterChange);  /* add event to table */
}"

and then:

htmlwidgets::onRender(rht, change_hook, c(0, 1, 2, 4))

R/Shiny Javascript passing arguments directly from R

1 Answers1