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

当加载有光泽的应用程序时，会向用户显示3 x 3的空白rhandsontable以及“提交”按钮。游戏的目的是成功找到“隐藏在每个单元格后面”的数字。

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

识别空单元格
使用正确的用户输入标识单元格
识别用户输入错误的单元格

每个步骤都会导致一个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)

Rhansontable中细胞背景的动态着色

1 个答案: