rhandsontable中单元格背景的动态着色

Dynamic coloring of cell background in rhandsontable

我的问题比the question here高级一点。假设我想将以下游戏开发为 Shiny 应用程序。

我有 3 x 3 数据框,其中包含随机排列的从 1 到 9 的数字。

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

当 Shiny 应用程序加载时,用户会看到一个空的 3 x 3 rhandsontable 以及一个提交按钮。游戏的objective是成功找到号码"hidden behind each cell".

我试图实现的是在单击“提交”按钮时根据用户输入对单元格进行动态颜色编码(红色 = 错误,绿色 = 正确,浅灰色 = 空)。尽管我不知道如何在 Javascript 中编写代码,但 this tutorial on the rhandsontable package 提供了代码示例,这些示例相对容易理解和调整。我分 3 个步骤进行:

  1. 识别空单元格

  2. 识别具有正确用户输入的单元格

  3. 识别用户输入错误的单元格

这些步骤中的每一步都会生成一个包含索引(即行号和列号)的 R 对象。我不知道如何将此信息传递给 hot_cols() 函数(更具体地说,传递给接受 Javascript 代码的 renderer 参数)。非常感谢您的帮助。

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)

也许我在偷工减料,但这可能会有所帮助。假设玩家将向所有单元格输入 1,因此他至少猜对了一个单元格。您想将该单元格涂成绿色。这就是你所做的。将两个参数传递给 rhandsontable 函数 rows_correctcols_correct 索引(-1 因为 javascript 的索引从 0 开始)。

然后在渲染器中,如果单元格对应于单元格正确索引,则逐个单元格地显示绿色背景。

希望这对您有所帮助

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)