应用程序

Question

应用程序

启动时，将生成一个3 x 3表，其值从1到9以随机顺序排列。应用程序用户可以看到的是空白的3 x 3 rhandsontable，他/她将用它来猜测生成的值在哪里。当用户单击“提交”按钮时，包含正确值的单元格将变为绿色，而所有其他单元格将保持不变。

我的问题

当用户单击按钮时，用户猜对的单元格不会变为绿色。换句话说，即使我以前可以使用条件格式（在我不使用闪亮模块的情况下，也处于应用程序的第一个版本中），条件格式仍然无法工作。

我做了什么

完整的项目位于以下Github存储库中，潜在用户可能希望克隆而不是复制并粘贴以下代码：https://github.com/gueyenono/number_game

我的项目文件夹有4个文件。前两个文件是通常的ui.R和server.R，它们实际上称为闪亮的模块（即hot_module_ui()和hot_module()）。这些模块包含在global.R文件中。最后一个文件update_hot.R包含模块中使用的函数。

ui.R

此文件加载所需的程序包，为应用程序提供标题并调用hot_module_ui()。该模块仅显示一个空白的3 x 3 rhandsontable和一个actionButton()。

library(shiny)
library(rhandsontable)
source("R/update_hot.R")

ui <- fluidPage(

  titlePanel("The number game"),

  mainPanel(
    hot_module_ui("table1")
  )
)

server.R

此文件称为hot_module()，其中包含条件格式的代码。

server <- function(input, output, session) {
  callModule(module = hot_module, id = "table1")
}

update_hot.R

这是调用“提交”按钮时调用的函数。该函数有两个参数：

hot：应用程序中的动手操作
x：启动时生成的值

此函数的作用（文件的完整代码在本节的结尾）：

获取用户输入

user_input <- hot_to_r(hot)

比较用户输入（user_input和真实值（x），并存储用户猜对的单元格的行和列索引

i <- which(user_input == x, arr.ind = TRUE)

  row_correct <- i[, 1] - 1
  col_correct <- i[, 2] - 1

使用行和列索引更新当前的可动手对象，并使用renderer函数的hot_cols()参数使对应单元格的背景变为绿色。请注意，我使用hot_table()函数来更新现有的rhandsontable对象。

hot %>%
    hot_table(contextMenu = FALSE, row_correct = row_correct, col_correct = col_correct) %>%
    hot_cols(renderer = "function(instance, td, row, col, prop, value, cellProperties){
          Handsontable.renderers.TextRenderer.apply(this, arguments);

          if(instance.params){

            // Correct cell values
            row_correct = instance.params.row_correct
            row_correct = row_correct instanceof Array ? row_correct : [row_correct]
            col_correct = instance.params.col_correct
            col_correct = col_correct instanceof Array ? col_correct : [col_correct]


            for(i = 0; i < col_correct.length; i++){ 
              if (col_correct[i] == col && row_correct[i] == row) {
                  td.style.background = 'green';
              } 
            }

          return td;
        }")

这是update_hot.R

的完整代码

update_hot <- function(hot, x){

  # Get user inputs (when the submit button is clicked)
  user_input <- hot_to_r(hot)

  # Get indices of correct user inputs
  i <- which(user_input == x, arr.ind = TRUE)

  row_correct <- i[, 1] - 1
  col_correct <- i[, 2] - 1

  # Update the hot object with row_index and col_index for user in the renderer
  hot %>%
    hot_table(contextMenu = FALSE, row_correct = row_correct, col_correct = col_correct) %>%
    hot_cols(renderer = "function(instance, td, row, col, prop, value, cellProperties){
          Handsontable.renderers.TextRenderer.apply(this, arguments);

          if(instance.params){

            // Correct cell values
            row_correct = instance.params.row_correct
            row_correct = row_correct instanceof Array ? row_correct : [row_correct]
            col_correct = instance.params.col_correct
            col_correct = col_correct instanceof Array ? col_correct : [col_correct]


            for(i = 0; i < col_correct.length; i++){ 
              if (col_correct[i] == col && row_correct[i] == row) {
                  td.style.background = 'green';
              } 
            }

          return td;
        }")
}

global.R

这是文件，其中包含闪亮的模块。 UI模块（hot_module_ui()）具有： -rHandsontableOutput -actionButton -我添加了tableOutput，以查看生成的值在哪里（用于测试代码）

服务器模块（hot_module()）调用update_hot()函数，并在用户单击“提交”按钮时尝试更新应用程序中的表。我试图通过使用observeEvent和反应值react$hot_display来实现这一点。启动时，react$hot_display包含一个NA的3 x 3数据帧。单击该按钮后，将使用新版本的动手操作表对其进行更新（包含用户输入和条件格式）。这是global.R的完整代码：

hot_module_ui <- function(id){

  ns <- NS(id)

  tagList(
    rHandsontableOutput(outputId = ns("grid")),
    br(),
    actionButton(inputId = ns("submit"), label = "Submit"),
    br(),
    tableOutput(outputId = ns("df"))
  )

}


hot_module <- function(input, output, session){

  values <- as.data.frame(matrix(sample(9), nrow = 3))

  react <- reactiveValues()

  observe({
    na_df <- values
    na_df[] <- as.integer(NA)
    react$hot_display <-  rhandsontable(na_df, rowHeaders = NULL, colHeaders = NULL)
  })

  observeEvent(input$submit, {
    react$hot_display <- update_hot(hot = input$grid, x = values)
  })

  output$grid <- renderRHandsontable({
    react$hot_display
  })

  output$df <- renderTable({
    values
  })
}

如开头所述，单击“提交”按钮时条件格式不起作用，我不确定为什么。再一次，您可以访问以下Github存储库中的完整代码：

https://github.com/gueyenono/number_game

Answer 1

我终于找到了解决我问题的方法。我学到的最大的经验之一是hot_to_r()函数在自定义函数中不起作用。必须在闪亮应用程序的服务器功能中使用它。这意味着将rhandsontable对象传递给自定义函数并从该函数中检索数据可能不是一个好主意（这是我的故事）。

我不确定任何人都会感兴趣，但是这是我的代码，可以按预期工作：

ui.R

library(rhandsontable)
library(shiny)
source("R/update_hot.R")

shinyUI(fluidPage(

    # Application title
    titlePanel("The Number Game"),

    module_ui(id = "tab")
))

server.R

library(shiny)

shinyServer(function(input, output, session) {

    callModule(module = module_server, id = "tab")

})

global.R

module_ui <- function(id){

  ns <- NS(id)

  tagList(
    rHandsontableOutput(outputId = ns("hot")),
    actionButton(inputId = ns("submit"), label = "OK"),
    actionButton(inputId = ns("reset"), label = "Reset")
  )
}


module_server <- function(input, output, session){

  clicked <- reactiveValues(submit = FALSE, reset = FALSE)

  initial_hot <- rhandsontable(as.data.frame(matrix(NA_integer_, nrow = 3, ncol = 3)))
  correct_values <- as.data.frame(matrix(1:9, nrow = 3, byrow = TRUE))

  observeEvent(input$submit, {
    clicked$submit <- TRUE
    clicked$reset <- FALSE
  })

  updated_hot <- eventReactive(input$submit, {
    input_values <- hot_to_r(input$hot)
    update_hot(input_values = input_values, correct_values = correct_values)
  })


  observeEvent(input$reset, {
    clicked$reset <- TRUE
    clicked$submit <- FALSE
  })

  reset_hot <- eventReactive(input$reset, {
    initial_hot
  })


  output$hot <- renderRHandsontable({

    if(!clicked$submit & !clicked$reset){
      out <- initial_hot
    } else if(clicked$submit & !clicked$reset){
      out <- updated_hot()
    } else if(clicked$reset & !clicked$submit){
      out <- reset_hot()
    }

    out
  })
}

R / update_hot.R

update_hot <- function(input_values, correct_values){

  equal_ids <- which(input_values == correct_values, arr.ind = TRUE)
  unequal_ids <- which(input_values != correct_values, arr.ind = TRUE)

  rhandsontable(input_values) %>%
    hot_table(row_correct = as.vector(equal_ids[, 1]) - 1,
              col_correct = as.vector(equal_ids[, 2]) - 1,
              row_incorrect = as.vector(unequal_ids[, 1]) - 1,
              col_incorrect = as.vector(unequal_ids[, 2]) - 1) %>%

    hot_cols(renderer = "function(instance, td, row, col, prop, value, cellProperties){
          Handsontable.renderers.TextRenderer.apply(this, arguments);

          if(instance.params){

            // Correct cell values
            row_correct = instance.params.row_correct
            row_correct = row_correct instanceof Array ? row_correct : [row_correct]
            col_correct = instance.params.col_correct
            col_correct = col_correct instanceof Array ? col_correct : [col_correct]

            // Incorrect cell values
            row_incorrect = instance.params.row_incorrect
            row_incorrect = row_incorrect instanceof Array ? row_incorrect : [row_incorrect]
            col_incorrect = instance.params.col_incorrect
            col_incorrect = col_incorrect instanceof Array ? col_incorrect : [col_incorrect]


            for(i = 0; i < col_correct.length; i++){ 
              if (col_correct[i] == col && row_correct[i] == row) {
                  td.style.background = 'green';
              } 
            }

            for(i = 0; i < col_incorrect.length; i++){ 
              if (col_incorrect[i] == col && row_incorrect[i] == row) {
                  td.style.background = 'red';
              } 
            }
          }
          return td;
        }")
}

在闪亮的模块中使用rhandsontable

应用程序

我的问题

我做了什么

ui.R

server.R

update_hot.R

global.R

1 个答案:

ui.R

server.R

global.R

R / update_hot.R