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)