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

Question

我的问题比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 以及一个提交按钮。游戏的目标是成功找到“隐藏在每个单元格后面”的数字。

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

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)

Answer 1

也许我在偷工减料，但这可能会有所帮助。假设玩家将向所有单元格输入 1，因此他猜测至少有一个单元格是正确的。您想将该单元格着色为绿色。这就是你所做的。将两个参数传递给 rhandsontable 函数 rows_correct 和 cols_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)