Search code examples
javascriptrshinyhandsontablerhandsontable

Dynamic coloring of cell background in rhandsontable


My question is a bit more advanced than the question here. Let's assume that I want to develop the following game as a Shiny app.

I have 3 x 3 data frame containing the numbers from 1 to 9 in a random order.

set.seed(123)
df_correct <- as.data.frame(matrix(sample(9), nrow = 3, ncol = 3))
df_correct

  V1 V2 V3
1  3  6  2
2  7  5  8
3  9  1  4

When the Shiny app loads, the user is presented with an empty 3 x 3 rhandsontable as well as a Submit button. The objective of the game is to successfully find the number "hidden behind each cell".

What I am attempting to achieve is to dynamically color-code the cells based on the user inputs when the Submit button is clicked (red = wrong, green = correct, light grey = empty). Even though I do not know how to code in Javascript, this tutorial on the rhandsontable package provides code samples, which are relatively easy to understand and tweak. I proceed in 3 steps:

  1. Identify empty cells

  2. Identify cells with correct user inputs

  3. Identify cells with wrong user inputs

Each of these steps results in an R object containing indices (i.e. row and column number). I do not know how to pass this information to the hot_cols() function (more specifically to the renderer argument that takes in Javascript code). Your help is very much appreciated.

library(shiny)
library(rhandsontable)
library(magrittr)

ui <- fluidPage(

   titlePanel("Simple game"),

   rHandsontableOutput("table"),

   actionButton("button", "Submit")

)

server <- function(input, output) {

    tables <- reactiveValues(
        df_correct = {
            set.seed(123)
            as.data.frame(matrix(sample(9), nrow = 3, ncol = 3))
        },
        df_user = rhandsontable(
            data = as.data.frame(matrix(NA_integer_, nrow = 3, ncol = 3)
        ))
    )

    output$table <- renderRHandsontable({
        tables$df_user
    })

    observeEvent(input$button, {

        df <- hot_to_r(input$table)

        index_empty <- which(is.na(df), arr.ind = TRUE)
        index_correct <- which(df == tables$df_correct, arr.ind = TRUE)
        index_wrong <- which(df != tables$df_correct, arr.ind = TRUE)

        tables$df_user <- 
            df %>%
            rhandsontable() %>%
            hot_cols(renderer = "")
    })
}

shinyApp(ui = ui, server = server)

Solution

  • Maybe I am cutting some corners but this might help. Lets assume player will input 1 to all the cells, so he guess at least one cell correct. You want to color that cell in green. This what you do. Pass two parameters to rhandsontable function rows_correct and cols_correct index (-1 because javascript have index starting at 0).

    Then in renderer you go cell by cell and color background in green if the cell corresponds to cell correct index.

    Hope this helps

    enter image description here

    library(shiny)
    library(rhandsontable)
    library(magrittr)
    
    ui <- fluidPage(
    
        titlePanel("Simple game"),
    
        rHandsontableOutput("table"),
    
        actionButton("button", "Submit")
    
    )
    
    server <- function(input, output) {
    
        tables <- reactiveValues(
            df_correct = {
                set.seed(123)
                as.data.frame(matrix(sample(9), nrow = 3, ncol = 3))
            },
            df_user = rhandsontable(
                data = as.data.frame(matrix(NA_integer_, nrow = 3, ncol = 3)
                ))
        )
    
        output$table <- renderRHandsontable({
            tables$df_user
        })
    
        observeEvent(input$button, {
    
            df <- hot_to_r(input$table)
    
            index_empty <- which(is.na(df), arr.ind = TRUE)
            index_correct <- which(df == tables$df_correct, arr.ind = TRUE)
            index_wrong <- which(df != tables$df_correct, arr.ind = TRUE)
    
            tables$df_user <- 
                df %>%
                rhandsontable(rows_correct = index_correct[1] - 1, cols_correct = index_correct[2] - 1) %>%
                hot_cols(renderer = "
                    function (instance, td, row, col, prop, value, cellProperties) {
                        Handsontable.renderers.TextRenderer.apply(this, arguments);
                        if (instance.params) {
                            col_to_highlight = instance.params.cols_correct
                            col_to_highlight = col_to_highlight instanceof Array ? col_to_highlight : [col_to_highlight]
    
                            row_to_highlight = instance.params.rows_correct
                            row_to_highlight = row_to_highlight instanceof Array ? row_to_highlight : [row_to_highlight]
    
                            for (i = 0; i < col_to_highlight.length; i++) { 
                                if (col_to_highlight[i] == col && row_to_highlight[i] == row) {
                                    td.style.background = 'green';
                                }
                            }
                        }
                    }")
        })
    }
    
    shinyApp(ui = ui, server = server)