Динамическая окраска клеточного фона в rhandsontable

Question

Мой вопрос немного сложнее, чем вопрос здесь. Давайте предположим, что я хочу разработать следующую игру в виде блестящего приложения.

У меня есть 3 х 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 х 3 rhandsontable а также кнопку Отправить. Цель игры - успешно найти число, "спрятанное за каждой клеткой".

Я пытаюсь добиться динамического цветового кодирования ячеек на основе пользовательских данных при нажатии кнопки "Отправить" (красный = неправильный, зеленый = правильный, светло-серый = пустой). Хотя я не знаю, как кодировать в Javascript, этот учебник по rhandsontable Пакет предоставляет примеры кода, которые относительно просты для понимания и настройки. Я продолжаю в 3 шага:

1. Определить пустые клетки

2. Определите ячейки с правильными пользовательскими данными

3. Определите ячейки с неправильными пользовательскими данными

Каждый из этих шагов приводит к R объект, содержащий индексы (т.е. номер строки и столбца). Я не знаю, как передать эту информацию hot_cols() функция (более конкретно к renderer аргумент, который принимает в коде Javascript). Ваша помощь очень ценится.

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 index (-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)