Shiny / DT/ 切换并着色单元格后保存更改

huangapple
go评论98阅读模式
英文:

Shiny / DT/ save changes when switching & coloring cells after change

问题

I've translated the code part for you:

  1. 基本上，我正在尝试连接这里的 **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。
  3. 在这里，我已经尝试了结合这些代码：
  4. 所以我想要的是在左侧的类别之间切换时保留更改（现在可以工作），并且每个更改的单元格都突出显示颜色（现在无法工作）。
  6. ```R
  7. library(tidyverse)
  8. library(shiny)
  9. library(DT)
  10. library(shinyjs)
  12. js <- HTML(
  13.   "function colorizeCell(i, j){
  14.     var selector = '#dtable tr:nth-child(' + i + ') td:nth-child(' + j + ')';
  15.     $(selector).css({'background-color': 'yellow'});
  16.   }"
  17. )
  19. colorizeCell <- function(i, j){
  20.   sprintf("colorizeCell(%d, %d)", i, j)
  21. }
  23. ui<-fluidPage(  useShinyjs(),
  24.                 tags$head(
  25.                   tags$script(js)
  26.                 ),
  27.   
  28.                  sidebarLayout(
  29.                    sidebarPanel(width = 3,
  30.                                 inputPanel(
  31.                                   selectInput("Species", label = "Choose species",
  32.                                               choices = levels(as.factor(iris$Species)))
  33.                                 )),
  35.                    mainPanel( tabsetPanel(
  36.                      tabPanel("Data Table",DTOutput("iris_datatable"),
  37.                              hr()))
  38.                  )
  39.                )
  41. )
  44. server <- function(input, output, session) {
  45.   my_iris <- reactiveValues(df=iris,sub=NULL, sub1=NULL)
  47.   observeEvent(input$Species, {
  48.     my_iris$sub <- my_iris$df %>% filter(Species==input$Species)
  49.     my_iris$sub1 <- my_iris$df %>% filter(Species!=input$Species)
  50.   }, ignoreNULL = FALSE)
  51.   
  52.   output$iris_datatable <- renderDT({
  53.     n <- length(names(my_iris$sub))
  54.     DT::datatable(my_iris$sub,
  55.                   options = list(pageLength = 10),
  56.                   selection='none', editable= list(target = 'cell'), 
  57.                   rownames= FALSE)
  58.   }, server = FALSE)
  59.   # 
  60.   observeEvent(input$iris_datatable_cell_edit,{
  61.     edit <- input$iris_datatable_cell_edit
  62.     i <- edit$row
  63.     j <- edit$col + 1
  64.     v <- edit$value
  65.     runjs(colorizeCell(i, j+1))
  66.     my_iris$sub[i, j] <<- DT::coerceValue(v, my_iris$sub[i, j])
  68.     my_iris$df <<- rbind(my_iris$sub1,my_iris$sub)
  69.   })
  70.   
  72.   
  73. }
  74. 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).

  1. library(tidyverse)
  2. library(shiny)
  3. library(DT)
  4. library(shinyjs)
  5. js <- HTML(
  6. "function colorizeCell(i, j){
  7. var selector = '#dtable tr:nth-child(' + i + ') td:nth-child(' + j + ')';
  8. $(selector).css({'background-color': 'yellow'});
  9. }"
  10. )
  11. colorizeCell <- function(i, j){
  12. sprintf("colorizeCell(%d, %d)", i, j)
  13. }
  14. ui<-fluidPage(  useShinyjs(),
  15. tags$head(
  16. tags$script(js)
  17. ),
  18. sidebarLayout(
  19. sidebarPanel(width = 3,
  20. inputPanel(
  21. selectInput("Species", label = "Choose species",
  22. choices = levels(as.factor(iris$Species)))
  23. )),
  24. mainPanel( tabsetPanel(
  25. tabPanel("Data Table",DTOutput("iris_datatable"),
  26. hr()))
  27. )
  28. )
  29. )
  30. server <- function(input, output, session) {
  31. my_iris <- reactiveValues(df=iris,sub=NULL, sub1=NULL)
  32. observeEvent(input$Species, {
  33. my_iris$sub <- my_iris$df %>% filter(Species==input$Species)
  34. my_iris$sub1 <- my_iris$df %>% filter(Species!=input$Species)
  35. }, ignoreNULL = FALSE)
  36. output$iris_datatable <- renderDT({
  37. n <- length(names(my_iris$sub))
  38. DT::datatable(my_iris$sub,
  39. options = list(pageLength = 10),
  40. selection='none', editable= list(target = 'cell'), 
  41. rownames= FALSE)
  42. }, server = FALSE)
  43. # 
  44. observeEvent(input$iris_datatable_cell_edit,{
  45. edit <- input$iris_datatable_cell_edit
  46. i <- edit$row
  47. j <- edit$col + 1
  48. v <- edit$value
  49. runjs(colorizeCell(i, j+1))
  50. my_iris$sub[i, j] <<- DT::coerceValue(v, my_iris$sub[i, j])
  51. my_iris$df <<- rbind(my_iris$sub1,my_iris$sub)
  52. })
  53. }
  54. shinyApp(ui, server)
  55. </details>
  56. # 答案1
  57. **得分**: 1
  58. 在这段JavaScript代码中：
  59. ```r
  60. js &lt;- HTML(
  61. &quot;function colorizeCell(i, j){
  62. var selector = &#39;#dtable tr:nth-child(&#39; + i + &#39;) td:nth-child(&#39; + j + &#39;)&#39;;
  63. $(selector).css({&#39;background-color&#39;: &#39;yellow&#39;});
  64. }&quot;
  65. )

你可以看到 #dtable。这是具有id dtable的HTML元素的选择器。但是你的数据表的id不是 dtable，而是 iris_datatable。所以你需要进行替换。

英文:

In this JavaScript code:

  1. js &lt;- HTML(
  2.   &quot;function colorizeCell(i, j){
  3.     var selector = &#39;#dtable tr:nth-child(&#39; + i + &#39;) td:nth-child(&#39; + j + &#39;)&#39;;
  4.     $(selector).css({&#39;background-color&#39;: &#39;yellow&#39;});
  5.   }&quot;
  6. )

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

这部分内容的中文翻译如下：

这将起作用：删除这两行代码：

  1. my_iris$sub[i, j] &lt;&lt;- DT::coerceValue(v, my_iris$sub[i, j])
  2. my_iris$df &lt;&lt;- rbind(my_iris$sub1,my_iris$sub)

并且调整 runjs：

  1. library(tidyverse)
  2. library(shiny)
  3. library(DT)
  4. library(shinyjs)
  6. js &lt;- HTML(
  7.   &quot;function colorizeCell(i, j){
  8.     var selector = &#39;#iris_datatable tr:nth-child(&#39; + i + &#39;) td:nth-child(&#39; + j + &#39;)&#39;;
  9.     $(selector).css({&#39;background-color&#39;: &#39;yellow&#39;});
  10.   }&quot;
  11. )
  13. colorizeCell &lt;- function(i, j){
  14.   sprintf(&quot;colorizeCell(%d, %d)&quot;, i, j)
  15. }
  17. ui&lt;-fluidPage(  useShinyjs(),
  18.                 tags$head(
  19.                   tags$script(js)
  20.                 ),
  21.                 
  22.                 sidebarLayout(
  23.                   sidebarPanel(width = 3,
  24.                                inputPanel(
  25.                                  selectInput(&quot;Species&quot;, label = &quot;Choose species&quot;,
  26.                                              choices = levels(as.factor(iris$Species)))
  27.                                )),
  28.                   
  29.                   mainPanel( tabsetPanel(
  30.                     tabPanel(&quot;Data Table&quot;,DTOutput(&quot;iris_datatable&quot;),
  31.                              hr()))
  32.                   )
  33.                 )
  34.                 
  35. )
  38. server &lt;- function(input, output, session) {
  39.   my_iris &lt;- reactiveValues(df=iris,sub=NULL, sub1=NULL)
  40.   
  41.   observeEvent(input$Species, {
  42.     my_iris$sub &lt;- my_iris$df %&gt;% filter(Species==input$Species)
  43.     my_iris$sub1 &lt;- my_iris$df %&gt;% filter(Species!=input$Species)
  44.   }, ignoreNULL = FALSE)
  45.   
  46.   output$iris_datatable &lt;- renderDT({
  47.     n &lt;- length(names(my_iris$sub))
  48.     DT::datatable(my_iris$sub,
  49.                   options = list(pageLength = 10),
  50.                   selection=&#39;none&#39;, editable= list(target = &#39;cell&#39;), 
  51.                   rownames= FALSE)
  52.   }, server = FALSE)
  53.   # 
  54.   observeEvent(input$iris_datatable_cell_edit,{
  55.     edit &lt;- input$iris_datatable_cell_edit
  56.     i &lt;- edit$row
  57.     j &lt;- edit$col + 1
  58.     v &lt;- edit$value
  59.     runjs(colorizeCell(i, j))
  60.   })
  61. }
  62. shinyApp(ui, server)

Shiny / DT/ 切换并着色单元格后保存更改

英文:

This will work: Remove these two lines:

my_iris$sub[i, j] &lt;&lt;- DT::coerceValue(v, my_iris$sub[i, j])

my_iris$df &lt;&lt;- rbind(my_iris$sub1,my_iris$sub)

and adapt runjs

  1. library(tidyverse)
  2. library(shiny)
  3. library(DT)
  4. library(shinyjs)
  5. js &lt;- HTML(
  6. &quot;function colorizeCell(i, j){
  7. var selector = &#39;#iris_datatable tr:nth-child(&#39; + i + &#39;) td:nth-child(&#39; + j + &#39;)&#39;;
  8. $(selector).css({&#39;background-color&#39;: &#39;yellow&#39;});
  9. }&quot;
  10. )
  11. colorizeCell &lt;- function(i, j){
  12. sprintf(&quot;colorizeCell(%d, %d)&quot;, i, j)
  13. }
  14. ui&lt;-fluidPage(  useShinyjs(),
  15. tags$head(
  16. tags$script(js)
  17. ),
  18. sidebarLayout(
  19. sidebarPanel(width = 3,
  20. inputPanel(
  21. selectInput(&quot;Species&quot;, label = &quot;Choose species&quot;,
  22. choices = levels(as.factor(iris$Species)))
  23. )),
  24. mainPanel( tabsetPanel(
  25. tabPanel(&quot;Data Table&quot;,DTOutput(&quot;iris_datatable&quot;),
  26. hr()))
  27. )
  28. )
  29. )
  30. server &lt;- function(input, output, session) {
  31. my_iris &lt;- reactiveValues(df=iris,sub=NULL, sub1=NULL)
  32. observeEvent(input$Species, {
  33. my_iris$sub &lt;- my_iris$df %&gt;% filter(Species==input$Species)
  34. my_iris$sub1 &lt;- my_iris$df %&gt;% filter(Species!=input$Species)
  35. }, ignoreNULL = FALSE)
  36. output$iris_datatable &lt;- renderDT({
  37. n &lt;- length(names(my_iris$sub))
  38. DT::datatable(my_iris$sub,
  39. options = list(pageLength = 10),
  40. selection=&#39;none&#39;, editable= list(target = &#39;cell&#39;), 
  41. rownames= FALSE)
  42. }, server = FALSE)
  43. # 
  44. observeEvent(input$iris_datatable_cell_edit,{
  45. edit &lt;- input$iris_datatable_cell_edit
  46. i &lt;- edit$row
  47. j &lt;- edit$col + 1
  48. v &lt;- edit$value
  49. runjs(colorizeCell(i, j))
  50. })
  51. }
  52. shinyApp(ui, server)

Shiny / DT/ 切换并着色单元格后保存更改

答案3

得分: 1

这是使用rowCallback的一种方法。

思路是向数据添加一些0/1列，其中1表示单元格已着色。显然，我们将这些列隐藏在数据表中，但它们确实存在于表格中：rowCallback可以访问它们。然后，每次数据表重绘时触发rowCallback，它通过读取隐藏的0/1列来为单元格分配颜色。每当我们编辑单元格并为其着色时，我们会将1放入相应的隐藏0/1列中。

  1. library(tidyverse)
  2. library(shiny)
  3. library(DT)
  4. library(shinyjs)
  6. js <- HTML(
  7.   "function colorizeCell(i, j){
  8.     var selector = '#iris_datatable tr:nth-child(' + i + ') td:nth-child(' + j + ')';
  9.     $(selector).css({'background-color': 'yellow'});
  10.   }"
  11. )
  13. colorizeCell <- function(i, j){
  14.   sprintf("colorizeCell(%d, %d)", i, j)
  15. }
  17. rowCallback <- '
  18. function(row, data) {
  19.   for(var j = 5; j <= 9; j++) {
  20.     var colorized = data[j] == 1;
  21.     if(colorized) {
  22.       $("td:eq(" + (j-5) + ")", row).css({"background-color": "yellow"});
  23.     }
  24.   }
  25. }
  26. '
  28. isColorized <- sapply(levels(iris$Species), function(species) {
  29.   m <- length(iris$Species[iris$Species == species])
  30.   as.data.frame(matrix(0L, nrow = m, ncol = ncol(iris)))
  31. }, simplify = FALSE)
  33. ui<-fluidPage(
  34.   useShinyjs(),
  35.   tags$head(
  36.     tags$script(js)
  37.   ),
  38.   
  39.   sidebarLayout(
  40.     sidebarPanel(
  41.       width = 3,
  42.       inputPanel(
  43.         selectInput("Species", label = "Choose species",
  44.                     choices = levels(as.factor(iris$Species))
  45.         )
  46.       )
  47.     ),
  48.     
  49.     mainPanel( 
  50.       tabsetPanel(
  51.         tabPanel(
  52.           "Data Table",
  53.           DTOutput("iris_datatable"),
  54.           hr()
  55.         )
  56.       )
  57.     )
  58.   )
  59.   
  60. )
  62. server <- function(input, output, session) {
  63.   
  64.   IsColorized <- reactiveVal(isColorized)
  65.   
  66.   dataSubset <- reactiveVal()
  67.   
  68.   observeEvent(input$Species, {
  69.     colorized <- IsColorized()[[input$Species]]
  70.     tableData <- cbind(iris %>% filter(Species == input$Species), colorized)
  71.     dataSubset(tableData)
  72.   })
  73.   
  74.   output$iris_datatable <- renderDT({
  75.     datatable(
  76.       dataSubset(),
  77.       options = list(
  78.         pageLength = 10,
  79.         rowCallback = JS(rowCallback),
  80.         columnDefs = list(
  81.           list(targets = 5:9, visible = FALSE)
  82.         )
  83.       ),
  84.       selection = 'none', 
  85.       editable = list(target = 'cell'), 
  86.       rownames= FALSE
  87.     )
  88.   }, server = FALSE)
  89.   
  90.   observeEvent(input$iris_datatable_cell_edit,{
  91.     edit <- input$iris_datatable_cell_edit
  92.     i <- edit$row
  93.     j <- edit$col + 1
  94.     iscolorized <- IsColorized()
  95.     iscolorized[[input$Species]][i, j] <- 1L
  96.     IsColorized(iscolorized)
  97.     runjs(colorizeCell(i, j))
  98.   })
  99. }
  101. shinyApp(ui, server)

Shiny / DT/ 切换并着色单元格后保存更改

英文:

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.

  1. library(tidyverse)
  2. library(shiny)
  3. library(DT)
  4. library(shinyjs)
  6. js &lt;- HTML(
  7.   &quot;function colorizeCell(i, j){
  8.     var selector = &#39;#iris_datatable tr:nth-child(&#39; + i + &#39;) td:nth-child(&#39; + j + &#39;)&#39;;
  9.     $(selector).css({&#39;background-color&#39;: &#39;yellow&#39;});
  10.   }&quot;
  11. )
  13. colorizeCell &lt;- function(i, j){
  14.   sprintf(&quot;colorizeCell(%d, %d)&quot;, i, j)
  15. }
  17. rowCallback &lt;- &#39;
  18. function(row, data) {
  19.   for(var j = 5; j &lt;= 9; j++) {
  20.     var colorized = data[j] == 1;
  21.     if(colorized) {
  22.       $(&quot;td:eq(&quot; + (j-5) + &quot;)&quot;, row).css({&quot;background-color&quot;: &quot;yellow&quot;});
  23.     }
  24.   }
  25. }
  26. &#39;
  28. isColorized &lt;- sapply(levels(iris$Species), function(species) {
  29.   m &lt;- length(iris$Species[iris$Species == species])
  30.   as.data.frame(matrix(0L, nrow = m, ncol = ncol(iris)))
  31. }, simplify = FALSE)
  33. ui&lt;-fluidPage(
  34.   useShinyjs(),
  35.   tags$head(
  36.     tags$script(js)
  37.   ),
  38.   
  39.   sidebarLayout(
  40.     sidebarPanel(
  41.       width = 3,
  42.       inputPanel(
  43.         selectInput(&quot;Species&quot;, label = &quot;Choose species&quot;,
  44.                     choices = levels(as.factor(iris$Species))
  45.         )
  46.       )
  47.     ),
  48.     
  49.     mainPanel( 
  50.       tabsetPanel(
  51.         tabPanel(
  52.           &quot;Data Table&quot;,
  53.           DTOutput(&quot;iris_datatable&quot;),
  54.           hr()
  55.         )
  56.       )
  57.     )
  58.   )
  59.   
  60. )
  63. server &lt;- function(input, output, session) {
  64.   
  65.   IsColorized &lt;- reactiveVal(isColorized)
  66.   
  67.   dataSubset &lt;- reactiveVal()
  68.   
  69.   observeEvent(input$Species, {
  70.     colorized &lt;- IsColorized()[[input$Species]]
  71.     tableData &lt;- cbind(iris %&gt;% filter(Species == input$Species), colorized)
  72.     dataSubset(tableData)
  73.   })
  74.   
  75.   output$iris_datatable &lt;- renderDT({
  76.     datatable(
  77.       dataSubset(),
  78.       options = list(
  79.         pageLength = 10,
  80.         rowCallback = JS(rowCallback),
  81.         columnDefs = list(
  82.           list(targets = 5:9, visible = FALSE)
  83.         )
  84.       ),
  85.       selection = &#39;none&#39;, 
  86.       editable = list(target = &#39;cell&#39;), 
  87.       rownames= FALSE
  88.     )
  89.   }, server = FALSE)
  90.   
  91.   observeEvent(input$iris_datatable_cell_edit,{
  92.     edit &lt;- input$iris_datatable_cell_edit
  93.     i &lt;- edit$row
  94.     j &lt;- edit$col + 1
  95.     iscolorized &lt;- IsColorized()
  96.     iscolorized[[input$Species]][i, j] &lt;- 1L
  97.     IsColorized(iscolorized)
  98.     runjs(colorizeCell(i, j))
  99.   })
  100. }
  102. shinyApp(ui, server)

Shiny / DT/ 切换并着色单元格后保存更改

huangapple
  • 本文由 发表于 2023年5月30日 00:13:19
  • 转载请务必保留本文链接：https://go.coder-hub.com/76358835.html
  • dt
  • javascript
  • r
  • shiny
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定