real / RHandsontable :尝试实时读取和更新同一个RHandsontable
real / RHandsontable :尝试实时读取和更新同一个RHandsontable
提问于 2022-02-01 11:28:13
我正在尝试创建一个RShiny页面来帮助处理一些模糊匹配，并允许用户确认匹配是正确的。正在显示的表有几个列，其中最重要的是列表A中的名称、列表B中的潜在匹配名称和末尾的True/False列。理想情况下，当一个匹配被确认为正确时，我希望表更新--不仅仅是将该行标记为正确的匹配，而是查找包含该项潜在匹配的其他行并删除它们(或者，在这种情况下，将它们的高度降为0.5)。我希望选项看起来会像折叠一样，只在匹配的选项被选中时显示匹配的选项，如果用户错误，如果所选的行不匹配，其余的行就会出现。
目前，除了条件格式之外，我还让它(以一种或另一种形式)工作。剧本在下面。
任何想法或帮助都将不胜感激！
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)回答 1
Stack Overflow用户
发布于 2022-02-08 10:00:32
好吧，我想我已经找到解决这个问题的办法了。完整的功能不是我想要的(也就是说，我还没有找到折叠行高的方法--相反，我将不正确的匹配放在列表的底部，标记为红色，并使唯一可编辑的列不可编辑)。
我希望这能帮助任何人寻找类似的东西！
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)页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/70939805
复制相关文章
相似问题
腾讯云开发者
