在模块中使用rhandsontable 应用程序

启动时，将生成一个3x3表，表中的值按随机顺序从1到9。应用程序用户可以看到的是一个空白的3x3

rhandsontable

，他/她将使用它来猜测生成的值在哪里。当用户单击“提交”按钮时，包含正确值的单元格变为绿色，所有其他单元格保持原样

我的问题 当用户单击按钮时，用户猜对的单元格不会变成绿色。换句话说，即使我以前让它工作过，条件格式也不起作用（那是在应用程序的第一个版本中，当时我没有使用闪亮的模块）

我所做的 完整项目位于以下Github存储库中，潜在用户可能希望克隆该存储库，而不是复制和粘贴以下代码：

我的项目文件夹有4个文件。前两个文件是通常的

ui.R

和

server.R

，它们本质上调用闪亮的模块（即

hot\u module\u ui（）

和

hot\u module（）

）。模块包含在

global.R

文件中。最后一个文件，

update\u hot.R

，包含模块中使用的函数

用户界面 此文件加载所需的软件包，提供应用程序的标题，并调用

hot\u module\u ui（）

。该模块只显示一个空白的3x3

rhandsontable

和一个

actionButton（）

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

• hot

  ：应用程序中的掌上电脑

• x

  ：启动时生成的值

函数就是这样做的（文件的完整代码在本节末尾）：

获取用户输入

使用行和列索引更新当前可手持对象，并使用

hot\u cols（）

函数的

renderer

参数将相应单元格的背景设置为绿色。请注意，我使用

hot_table（）

函数更新现有的

rhandsontable

对象 全球 这是包含闪亮模块的文件。UI模块（

hot\u module\u UI（）

）具有： -一个

rHandsontableOutput

-

action按钮

-我添加了一个

tableOutput

，以查看生成的值在哪里（用于测试代码）

服务器模块（

hot\u module（）

）调用

update\u hot（）

函数，并在用户单击“提交”按钮时尝试更新应用程序中的手持设备。我试图通过使用

observeEvent

和反应值

react$hot\u display

来实现这一点。启动时，

react$hot_display

包含

NA

s的3 x 3数据帧。单击该按钮时，它将更新为新版本的handsontable（包含用户输入和条件格式）。以下是

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
  })
}

---

hot\u module\u ui我终于找到了问题的解决方案。我学到的最大教训之一是
hot\u to\u r（）
函数在自定义函数中不起作用。它必须用于闪亮应用程序的服务器功能。这意味着将
rhandsontable
对象传递给自定义函数并从函数中检索数据可能不是一个好主意（这是我的故事）

我不确定这是否会引起任何人的兴趣，但这是我的代码，它按预期工作：

用户界面
服务器.R
全球
module\u用户界面
server <- function(input, output, session) {
  callModule(module = hot_module, id = "table1")
}

user_input <- hot_to_r(hot)

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

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

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 <- 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;
        }")
}

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
  })
}

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

shinyUI(fluidPage(

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

    module_ui(id = "tab")
))

library(shiny)

shinyServer(function(input, output, session) {

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

})

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
  })
}

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;
        }")
}