英文:
Shiny / DT/ save changes when switching & coloring cells after change
问题
I've translated the code part for you:
基本上，我正在尝试连接这里的 **YBS** 的答案 https://stackoverflow.com/questions/67922144/shiny-app-with-editable-datatable-how-can-i-enable-the-modification-of-the-tabl 和 **Stéphane Laurent** 的答案来自这里 https://stackoverflow.com/questions/66949053/change-backgorund-color-of-cell-of-data-table-while-its-value-is-edited-in-rshin。
在这里，我已经尝试了结合这些代码：
所以我想要的是在左侧的类别之间切换时保留更改（现在可以工作），并且每个更改的单元格都突出显示颜色（现在无法工作）。
```R
library(tidyverse)
library(shiny)
library(DT)
library(shinyjs)
js <- HTML(
"function colorizeCell(i, j){
var selector = '#dtable tr:nth-child(' + i + ') td:nth-child(' + j + ')';
$(selector).css({'background-color': 'yellow'});
}"
)
colorizeCell <- function(i, j){
sprintf("colorizeCell(%d, %d)", i, j)
}
ui<-fluidPage( useShinyjs(),
tags$head(
tags$script(js)
),
sidebarLayout(
sidebarPanel(width = 3,
inputPanel(
selectInput("Species", label = "Choose species",
choices = levels(as.factor(iris$Species)))
)),
mainPanel( tabsetPanel(
tabPanel("Data Table",DTOutput("iris_datatable"),
hr()))
)
)
)
server <- function(input, output, session) {
my_iris <- reactiveValues(df=iris,sub=NULL, sub1=NULL)
observeEvent(input$Species, {
my_iris$sub <- my_iris$df %>% filter(Species==input$Species)
my_iris$sub1 <- my_iris$df %>% filter(Species!=input$Species)
}, ignoreNULL = FALSE)
output$iris_datatable <- renderDT({
n <- length(names(my_iris$sub))
DT::datatable(my_iris$sub,
options = list(pageLength = 10),
selection='none', editable= list(target = 'cell'),
rownames= FALSE)
}, server = FALSE)
#
observeEvent(input$iris_datatable_cell_edit,{
edit <- input$iris_datatable_cell_edit
i <- edit$row
j <- edit$col + 1
v <- edit$value
runjs(colorizeCell(i, j+1))
my_iris$sub[i, j] <<- DT::coerceValue(v, my_iris$sub[i, j])
my_iris$df <<- rbind(my_iris$sub1,my_iris$sub)
})
}
shinyApp(ui, server)
请注意，这只是代码的翻译部分，不包括问题或其他内容。
英文:
basically, I'm trying to connect the answers of YBS here https://stackoverflow.com/questions/67922144/shiny-app-with-editable-datatable-how-can-i-enable-the-modification-of-the-tabl and Stéphane Laurent's from here https://stackoverflow.com/questions/66949053/change-backgorund-color-of-cell-of-data-table-while-its-value-is-edited-in-rshin.
Here I have tried to combine the codes:
so what I want is to keep the changes when I switch between the categories on the left (works now) and that each changed cell is highlighted in color (does not work now).
library(tidyverse)
library(shiny)
library(DT)
library(shinyjs)
js <- HTML(
"function colorizeCell(i, j){
var selector = '#dtable tr:nth-child(' + i + ') td:nth-child(' + j + ')';
$(selector).css({'background-color': 'yellow'});
}"
)
colorizeCell <- function(i, j){
sprintf("colorizeCell(%d, %d)", i, j)
}
ui<-fluidPage( useShinyjs(),
tags$head(
tags$script(js)
),
sidebarLayout(
sidebarPanel(width = 3,
inputPanel(
selectInput("Species", label = "Choose species",
choices = levels(as.factor(iris$Species)))
)),
mainPanel( tabsetPanel(
tabPanel("Data Table",DTOutput("iris_datatable"),
hr()))
)
)
)
server <- function(input, output, session) {
my_iris <- reactiveValues(df=iris,sub=NULL, sub1=NULL)
observeEvent(input$Species, {
my_iris$sub <- my_iris$df %>% filter(Species==input$Species)
my_iris$sub1 <- my_iris$df %>% filter(Species!=input$Species)
}, ignoreNULL = FALSE)
output$iris_datatable <- renderDT({
n <- length(names(my_iris$sub))
DT::datatable(my_iris$sub,
options = list(pageLength = 10),
selection='none', editable= list(target = 'cell'),
rownames= FALSE)
}, server = FALSE)
#
observeEvent(input$iris_datatable_cell_edit,{
edit <- input$iris_datatable_cell_edit
i <- edit$row
j <- edit$col + 1
v <- edit$value
runjs(colorizeCell(i, j+1))
my_iris$sub[i, j] <<- DT::coerceValue(v, my_iris$sub[i, j])
my_iris$df <<- rbind(my_iris$sub1,my_iris$sub)
})
}
shinyApp(ui, server)
</details>
# 答案1
**得分**: 1
在这段JavaScript代码中：
```r
js <- HTML(
"function colorizeCell(i, j){
var selector = '#dtable tr:nth-child(' + i + ') td:nth-child(' + j + ')';
$(selector).css({'background-color': 'yellow'});
}"
)
你可以看到 #dtable。这是具有id dtable的HTML元素的选择器。但是你的数据表的id不是 dtable，而是 iris_datatable。所以你需要进行替换。
英文:
In this JavaScript code:
js <- HTML(
"function colorizeCell(i, j){
var selector = '#dtable tr:nth-child(' + i + ') td:nth-child(' + j + ')';
$(selector).css({'background-color': 'yellow'});
}"
)
you can see #dtable. This is the selector of the HTML element with id dtable. But the id of your datatable is not dtable, it is iris_datatable. So you have to do the replacement.
答案2
得分: 1
这部分内容的中文翻译如下：
这将起作用：删除这两行代码：
my_iris$sub[i, j] <<- DT::coerceValue(v, my_iris$sub[i, j])
my_iris$df <<- rbind(my_iris$sub1,my_iris$sub)
并且调整 runjs：
library(tidyverse)
library(shiny)
library(DT)
library(shinyjs)
js <- HTML(
"function colorizeCell(i, j){
var selector = '#iris_datatable tr:nth-child(' + i + ') td:nth-child(' + j + ')';
$(selector).css({'background-color': 'yellow'});
}"
)
colorizeCell <- function(i, j){
sprintf("colorizeCell(%d, %d)", i, j)
}
ui<-fluidPage( useShinyjs(),
tags$head(
tags$script(js)
),
sidebarLayout(
sidebarPanel(width = 3,
inputPanel(
selectInput("Species", label = "Choose species",
choices = levels(as.factor(iris$Species)))
)),
mainPanel( tabsetPanel(
tabPanel("Data Table",DTOutput("iris_datatable"),
hr()))
)
)
)
server <- function(input, output, session) {
my_iris <- reactiveValues(df=iris,sub=NULL, sub1=NULL)
observeEvent(input$Species, {
my_iris$sub <- my_iris$df %>% filter(Species==input$Species)
my_iris$sub1 <- my_iris$df %>% filter(Species!=input$Species)
}, ignoreNULL = FALSE)
output$iris_datatable <- renderDT({
n <- length(names(my_iris$sub))
DT::datatable(my_iris$sub,
options = list(pageLength = 10),
selection='none', editable= list(target = 'cell'),
rownames= FALSE)
}, server = FALSE)
#
observeEvent(input$iris_datatable_cell_edit,{
edit <- input$iris_datatable_cell_edit
i <- edit$row
j <- edit$col + 1
v <- edit$value
runjs(colorizeCell(i, j))
})
}
shinyApp(ui, server)
英文:
This will work: Remove these two lines:
my_iris$sub[i, j] <<- DT::coerceValue(v, my_iris$sub[i, j])
my_iris$df <<- rbind(my_iris$sub1,my_iris$sub)
and adapt runjs
library(tidyverse)
library(shiny)
library(DT)
library(shinyjs)
js <- HTML(
"function colorizeCell(i, j){
var selector = '#iris_datatable tr:nth-child(' + i + ') td:nth-child(' + j + ')';
$(selector).css({'background-color': 'yellow'});
}"
)
colorizeCell <- function(i, j){
sprintf("colorizeCell(%d, %d)", i, j)
}
ui<-fluidPage( useShinyjs(),
tags$head(
tags$script(js)
),
sidebarLayout(
sidebarPanel(width = 3,
inputPanel(
selectInput("Species", label = "Choose species",
choices = levels(as.factor(iris$Species)))
)),
mainPanel( tabsetPanel(
tabPanel("Data Table",DTOutput("iris_datatable"),
hr()))
)
)
)
server <- function(input, output, session) {
my_iris <- reactiveValues(df=iris,sub=NULL, sub1=NULL)
observeEvent(input$Species, {
my_iris$sub <- my_iris$df %>% filter(Species==input$Species)
my_iris$sub1 <- my_iris$df %>% filter(Species!=input$Species)
}, ignoreNULL = FALSE)
output$iris_datatable <- renderDT({
n <- length(names(my_iris$sub))
DT::datatable(my_iris$sub,
options = list(pageLength = 10),
selection='none', editable= list(target = 'cell'),
rownames= FALSE)
}, server = FALSE)
#
observeEvent(input$iris_datatable_cell_edit,{
edit <- input$iris_datatable_cell_edit
i <- edit$row
j <- edit$col + 1
v <- edit$value
runjs(colorizeCell(i, j))
})
}
shinyApp(ui, server)
答案3
得分: 1
这是使用rowCallback的一种方法。
思路是向数据添加一些0/1列，其中1表示单元格已着色。显然，我们将这些列隐藏在数据表中，但它们确实存在于表格中：rowCallback可以访问它们。然后，每次数据表重绘时触发rowCallback，它通过读取隐藏的0/1列来为单元格分配颜色。每当我们编辑单元格并为其着色时，我们会将1放入相应的隐藏0/1列中。
library(tidyverse)
library(shiny)
library(DT)
library(shinyjs)
js <- HTML(
"function colorizeCell(i, j){
var selector = '#iris_datatable tr:nth-child(' + i + ') td:nth-child(' + j + ')';
$(selector).css({'background-color': 'yellow'});
}"
)
colorizeCell <- function(i, j){
sprintf("colorizeCell(%d, %d)", i, j)
}
rowCallback <- '
function(row, data) {
for(var j = 5; j <= 9; j++) {
var colorized = data[j] == 1;
if(colorized) {
$("td:eq(" + (j-5) + ")", row).css({"background-color": "yellow"});
}
}
}
'
isColorized <- sapply(levels(iris$Species), function(species) {
m <- length(iris$Species[iris$Species == species])
as.data.frame(matrix(0L, nrow = m, ncol = ncol(iris)))
}, simplify = FALSE)
ui<-fluidPage(
useShinyjs(),
tags$head(
tags$script(js)
),
sidebarLayout(
sidebarPanel(
width = 3,
inputPanel(
selectInput("Species", label = "Choose species",
choices = levels(as.factor(iris$Species))
)
)
),
mainPanel(
tabsetPanel(
tabPanel(
"Data Table",
DTOutput("iris_datatable"),
hr()
)
)
)
)
)
server <- function(input, output, session) {
IsColorized <- reactiveVal(isColorized)
dataSubset <- reactiveVal()
observeEvent(input$Species, {
colorized <- IsColorized()[[input$Species]]
tableData <- cbind(iris %>% filter(Species == input$Species), colorized)
dataSubset(tableData)
})
output$iris_datatable <- renderDT({
datatable(
dataSubset(),
options = list(
pageLength = 10,
rowCallback = JS(rowCallback),
columnDefs = list(
list(targets = 5:9, visible = FALSE)
)
),
selection = 'none',
editable = list(target = 'cell'),
rownames= FALSE
)
}, server = FALSE)
observeEvent(input$iris_datatable_cell_edit,{
edit <- input$iris_datatable_cell_edit
i <- edit$row
j <- edit$col + 1
iscolorized <- IsColorized()
iscolorized[[input$Species]][i, j] <- 1L
IsColorized(iscolorized)
runjs(colorizeCell(i, j))
})
}
shinyApp(ui, server)
英文:
Here is a way using a rowCallback.
The idea is to add some 0/1 columns to the data, a 1 indicates that the cell is colorized. Obviously we hide these columns in the datatable, but they are in the table: the rowCallback has access to them. Then the rowCallback, which is triggered each time the datatable is redrawn, assigns the colors to the cells by reading the hidden 0/1 columns. And each time we color a cell when we edit it, we put a 1 in the corresponding hidden 0/1 column.
library(tidyverse)
library(shiny)
library(DT)
library(shinyjs)
js <- HTML(
"function colorizeCell(i, j){
var selector = '#iris_datatable tr:nth-child(' + i + ') td:nth-child(' + j + ')';
$(selector).css({'background-color': 'yellow'});
}"
)
colorizeCell <- function(i, j){
sprintf("colorizeCell(%d, %d)", i, j)
}
rowCallback <- '
function(row, data) {
for(var j = 5; j <= 9; j++) {
var colorized = data[j] == 1;
if(colorized) {
$("td:eq(" + (j-5) + ")", row).css({"background-color": "yellow"});
}
}
}
'
isColorized <- sapply(levels(iris$Species), function(species) {
m <- length(iris$Species[iris$Species == species])
as.data.frame(matrix(0L, nrow = m, ncol = ncol(iris)))
}, simplify = FALSE)
ui<-fluidPage(
useShinyjs(),
tags$head(
tags$script(js)
),
sidebarLayout(
sidebarPanel(
width = 3,
inputPanel(
selectInput("Species", label = "Choose species",
choices = levels(as.factor(iris$Species))
)
)
),
mainPanel(
tabsetPanel(
tabPanel(
"Data Table",
DTOutput("iris_datatable"),
hr()
)
)
)
)
)
server <- function(input, output, session) {
IsColorized <- reactiveVal(isColorized)
dataSubset <- reactiveVal()
observeEvent(input$Species, {
colorized <- IsColorized()[[input$Species]]
tableData <- cbind(iris %>% filter(Species == input$Species), colorized)
dataSubset(tableData)
})
output$iris_datatable <- renderDT({
datatable(
dataSubset(),
options = list(
pageLength = 10,
rowCallback = JS(rowCallback),
columnDefs = list(
list(targets = 5:9, visible = FALSE)
)
),
selection = 'none',
editable = list(target = 'cell'),
rownames= FALSE
)
}, server = FALSE)
observeEvent(input$iris_datatable_cell_edit,{
edit <- input$iris_datatable_cell_edit
i <- edit$row
j <- edit$col + 1
iscolorized <- IsColorized()
iscolorized[[input$Species]][i, j] <- 1L
IsColorized(iscolorized)
runjs(colorizeCell(i, j))
})
}
shinyApp(ui, server)
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论