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:
Identify empty cells
Identify cells with correct user inputs
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)
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
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)