当我们使用替换按钮时，如何在 R闪亮中突出显示单元格？

Question

下面的代码读取 CSV 文件并在主面板中显示数据表。自动检测“要搜索的列”中的字段。我创建了一个名为“Replace”的字段和一个名为“by”的字段，可用于替换列单元格中的某些值。

我想在替换值的地方以任何颜色突出显示该单元格，最好是橙色。

有人可以解释一下我如何在 R闪亮中做到这一点吗？

CSV

ID  Type  Category    values
21  A1     B1          030,066,008,030,066,008
22  C1     D1          020,030,075,080,095,100
23  E1     F1          030,085,095,060,201,030

预期输出：

如果我将“值”列中的 030 更改为 100，我希望该单元格（在“值”列和第 2 行中）被着色。

代码

library(shiny)
library(DT)
library(stringr)
library(dplyr)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose CSV File", accept = ".csv"),
      checkboxInput("header", "Header", TRUE),
      selectInput("col", "Column to search:", NULL),
      textInput("old", "Replace:"),
      textInput("new", "By:"),
      actionButton("replace", "Replace!"),
    ),
    mainPanel(
      DTOutput("table1")
    )
  )
)

server <- function(input, output, session) {
  my_data <- reactiveVal(NULL)
  
  observeEvent(input$file1, {
    file <- input$file1
    ext <- tools::file_ext(file$datapath)
    req(file)
    # validate(need(ext == "csv", "Please upload a csv file"))
    my_data(read.csv2(file$datapath, header = input$header))
    updateSelectInput(session, "col", choices = names(my_data()))
  })
  
  observeEvent(input$replace, {
    req(input$col)
    dat <- req(my_data())
    traf <- if (is.numeric(dat[[input$col]])) as.numeric else identity

    my_data(dat %>%
              mutate(!!rlang::sym(input$col) := 
                       stringr::str_replace_all(!!rlang::sym(input$col),
                               input$old,
                               input$new) %>% 
                       traf()))
  })
  
  output$table1 <- renderDT(
    req(my_data())
  )
}

shinyApp(ui, server)

Answer 1

我想到了一个可能的解决方法，即使用DT::formatStyle()颜色来为每个修改的单元格着色。使用这种方法的一个缺点是导入的 csv 的列数是原来的两倍（因为我需要它们来告诉formatStyle()哪些单元格必须添加颜色）。但是，附加的列可以隐藏，这样它们就不会显示出来，但它们将出现在传递给 的对象中datatable。如果单元格需要在每次编辑后保持彩色，则需要额外的列，如果不是这种情况，则额外一列就足够了。请注意，好消息是R这里仅使用代码。

第一步是创建附加列，因此在将 .csv 文件读入reactive后my_data()：

    #create (n = number of columns) reactive values.
    nms  <- vector('list', ncol(my_data())) %>% set_names(names(my_data()))
    ccol <<- exec("reactiveValues", !!!nms) 
    
    #pre-allocate all the columns that we're going to use.
    my_data(map_dfc(names(ccol), ~transmute(my_data(), 'orange_{.x}' := 0)) %>% {bind_cols(my_data(), .)})

现在，每次在某处修改列时，相应的 Orange_colname 将包含一个布尔值，指示是否发生了修改。

    ccol[[input$col]] <- str_detect(dat[[input$col]], input$old)
    
    my_data(my_data() %>%
              mutate('orange_{input$col}' := ccol[[input$col]]))

最后，我们使用datatable()'soption参数渲染表格以隐藏额外的列，然后使用 for 循环在每列中添加颜色。我需要在这里使用循环，因为应用程序实际上可以导入任何表，只要它是数据框即可。

Dtable <- 
  datatable(my_data(),
            options = list(columnDefs = list(list(visible = FALSE, targets = (ncol(my_data())):((ncol(my_data()) / 2) + 1) )))) 

walk(names(ccol), ~ { Dtable <<- Dtable %>%  formatStyle(..1, str_glue("orange_{.x}"),
                                                         backgroundColor = styleEqual(c(1), c("orange"))) })

Dtable

应用程序：

library(shiny)
library(DT)
library(stringr)
library(tidyverse)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose CSV File", accept = ".csv"),
      checkboxInput("header", "Header", TRUE),
      selectInput("col", "Column to search:", NULL),
      textInput("old", "Replace:"),
      textInput("new", "By:"),
      actionButton("replace", "Replace!"),
    ),
    mainPanel(
      DTOutput("table1")
    )
  )
)

server <- function(input, output, session) {
  my_data <- reactiveVal(NULL)
  last_coloured <- reactiveVal(NULL)

  
  
  
  
  observeEvent(input$file1, {
    file <- input$file1
    ext <- tools::file_ext(file$datapath)
    req(file)
    # validate(need(ext == "csv", "Please upload a csv file"))
    my_data(read_csv(file$datapath))
    updateSelectInput(session, "col", choices = names(my_data()))
    
    #create (n = number of columns) reactive values.
    nms  <- vector('list', ncol(my_data())) %>% set_names(names(my_data()))
    ccol <<- exec("reactiveValues", !!!nms) 
    
    #pre-allocate all the columns that we're going to use.
    my_data(map_dfc(names(ccol), ~transmute(my_data(), 'orange_{.x}' := 0)) %>% {bind_cols(my_data(), .)})
  })
  
  observeEvent(input$replace, {
    req(input$col)
    dat <- req(my_data())
    traf <- if (is.numeric(dat[[input$col]])) as.numeric else identity
    
    my_data(dat %>%
              mutate(!!rlang::sym(input$col) :=
                       stringr::str_replace_all(
                         !!rlang::sym(input$col),
                         input$old,
                         input$new
                       ) %>%
                       traf()))
    
    # also i would like to know which rows are modified
    
    ccol[[input$col]] <- str_detect(dat[[input$col]], input$old)
    
    my_data(my_data() %>%
              mutate('orange_{input$col}' := ccol[[input$col]]))
  })
  
  output$table1 <- renderDT({
    req(my_data())

      Dtable <- 
        datatable(my_data(),
                  options = list(columnDefs = list(list(visible = FALSE, targets = (ncol(my_data())):((ncol(my_data()) / 2) + 1) )))) 
      
      walk(names(ccol), ~ { Dtable <<- Dtable %>%  formatStyle(..1, str_glue("orange_{.x}"),
                                                  backgroundColor = styleEqual(c(1), c("orange"))) })
      
      Dtable
  })
}

shinyApp(ui, server)