R Shiny/RHandsontable：尝试实时读取和更新同一个 RHandsontable

Question

I'm trying to create an RShiny page to help with some fuzzy matches, and allow the user to confirm the matches are correct. The table being displayed has a few columns, most important of which are the names from list A, potential matching names from list B, and a True/False column at the end. Ideally, when a match is confirmed as correct I would like the table to update - not just to mark the row as a correct match, but to look for other rows which contain potential matches for that item and remove them (or, in this case, reduce their height to 0.5). I'm hoping it will look like the options collapse to only show the matching one when the matching one is selected, and, in case of user error, if the selected row is unmatched, the rest of the rows appear.

I currently have it working (in one form or another) aside from the conditional formatting. The script is below.

Any ideas or help would be much appreciated!

library(tidyverse)
library(rhandsontable)
library(shiny)


test_DF <- data.frame("ID" = 1:10, 
                      "list A Code" = c("1001", "1001", "1003", "1003", "1003", "1006", "1006", "1007", "1008", "1010"), 
                      "List A Item" = c("Olive Oil", "Olive Oil", "Tomato Sauce", "Tomato Sauce", "Tomato Sauce", "Dried Pasta", "Dried Pasta", "Oregano", "Pesto", "Garlic Bulb"), 
                      "List B Code" = c("2001", "2002", "2003", "2004", "2005", "2006", "2007", "2008", "2009", "2010"),
                      "List B Item" = c("Olive Oil", "Olives", "Tomato", "Tomato Sauce", "Pasta Sauce", "Dried Pasta", "Fresh Pasta", "Oregano", "Pesto", "Garlic Bulb"),
                      "Correct Match" = FALSE)


ui<-(fluidPage(
  fluidRow(
    titlePanel(
      h1("food item potential matches", align = "center")),
    sidebarPanel(
      actionButton("saveBtn", "All matches identified")),
    mainPanel(
      rHandsontableOutput("table", height = "500px"),
      br()
      
      
    )
  )
))
server<-(function(input,output,session){
  
  # returns rhandsontable type object - editable excel type grid data
  output$table <- renderRHandsontable({
    output <- rhandsontable(test_DF) %>%
      hot_col(1:5, readOnly = TRUE) #Outputs the table, and makes it so that only the True/False column is editable

    
    matched_codes <- output$table[,2][output$table[,6] == TRUE] #Creates a list of list A codes that have been successfully matched
    
    incorrect_match_rows <- output$table[,1][output$table$list.A.Code %in% matched_codes & output$table$Correct.Match == FALSE]
    
    if(length(matched_codes>0)) {
      print("matches made") #This is just me trying to test if it gets this far
      for (incorrect_row in incorrect_match_rows) {
        output <- output %>% hot_rows(incorrect_row, rowHeights=0.5) #making the rows to be removed 0.5 in height
      }
    }
    output
    #https://stackoverflow.com/questions/62816744/rhandsontable-using-a-dropdown-to-hide-columns
    
  })
  
  # on click of button the file will be saved to the working directory
  observeEvent(input$saveBtn, {
    write.csv(isolate(hot_to_r(input$table)), file = "Fuzzy_matches.csv", row.names = FALSE)
    print("requirements met")
    stopApp()
  })
  # hot_to_r() converts the rhandsontable object to r data object
})

shinyApp(ui, server)

Answer 1

OK, I believe I have found a way to solve this now. The full functionality isn't quite what I'd like (ie I still haven't found a way to collapse the row heights - instead I've put incorrect matches to the bottom of the list, marked them red, and made the only editable column uneditable).

I hope this helps anyone looking for something similar!

library(tidyverse)
library(rhandsontable)
library(shiny)


test_DF <- data.frame("ID" = 1:10, 
                      "Pseudo_ID" = 1:10,
                      "list A Code" = c("1001", "1001", "1003", "1003", "1003", "1006", "1006", "1007", "1008", "1010"), 
                      "List A Item" = c("Olive Oil", "Olive Oil", "Tomato Sauce", "Tomato Sauce", "Tomato Sauce", "Dried Pasta", "Dried Pasta", "Oregano", "Pesto", "Garlic Bulb"), 
                      "List B Code" = c("2001", "2002", "2003", "2004", "2005", "2006", "2007", "2008", "2009", "2010"),
                      "List B Item" = c("Olive Oil", "Olives", "Tomato", "Tomato Sauce", "Pasta Sauce", "Dried Pasta", "Fresh Pasta", "Oregano", "Pesto", "Garlic Bulb"),
                      "Correct Match" = FALSE)


ui<-(fluidPage(
  fluidRow(
    titlePanel(
      h1("food item potential matches", align = "center")),
    sidebarPanel(
      actionButton("saveBtn", "All matches identified")),
    mainPanel(
      rHandsontableOutput("table", height = "500px"),
      br()
      
      
    )
  )
))
server<-(function(input,output,session){
  
  values <- reactiveValues(data = test_DF)
  observeEvent(input$table,{
    values$data<-as.data.frame(hot_to_r(input$table))
    
    matched_codes <- values$data[,3][values$data[,7] == TRUE] #Creates a list of list A codes that have been successfully matched
    print(matched_codes)
    incorrect_match_rows <- values$data[,1][values$data$list.A.Code %in% matched_codes & values$data$Correct.Match == FALSE]
    print(incorrect_match_rows)
    print(length(incorrect_match_rows)>0)
    print("matches made") #This is just me trying to test if it gets this far
    values$data$Pseudo_ID <- values$data$ID
    values$data$Pseudo_ID[which(values$data$ID %in% incorrect_match_rows)]<-NA
    values$data<-values$data[order(values$data$Pseudo_ID, na.last=TRUE),]
    print(values$data)
    
    output$table <- renderRHandsontable({
      rhandsontable(values$data)%>%
        hot_col(1:6, readOnly = TRUE) %>% #Outputs the table, and makes it so that only the True/False column is editable
        hot_col(1:2, width = 0.5) %>%
        hot_col(1:6, renderer = "
           function (instance, td, row, col, prop, value, cellProperties) {
             Handsontable.renderers.TextRenderer.apply(this, arguments);
             var ID = instance.getData()[row][0]
             var pseudoID = instance.getData()[row][1]
             if (ID !== pseudoID) {
              td.style.background = 'pink';
              cellProperties.rowheight = '1';
             }
           }") %>%
        hot_col(7, renderer = "
           function (instance, td, row, col, prop, value, cellProperties) {
             Handsontable.renderers.CheckboxRenderer.apply(this, arguments);
             var ID = instance.getData()[row][0]
             var pseudoID = instance.getData()[row][1]
             if (ID !== pseudoID) {
              td.style.background = 'pink';
              cellProperties.rowheight = '1';
              cellProperties.readOnly = true;
             }
           }")
      
    })
  })
  output$table <- renderRHandsontable({
    rhandsontable(values$data)%>%
      hot_col(1:6, readOnly = TRUE) %>% #Outputs the table, and makes it so that only the True/False column is editable
      hot_col(1:2, width = 0.5)
  })
  
  observeEvent(input$saveBtn, {
    write.csv(isolate(hot_to_r(input$table)), file = "Fuzzy_matches.csv", row.names = FALSE)
    print("requirements met")
    stopApp()
  })
})

shinyApp(ui, server)