0

I am working on below code definition:

  • If first column value is 'Modified' and second column contains column names which's values has been changed
  • based on this the data cell needs to be highlighted

I am referring to the code as reference : formatStyle over multiple columns DT R

Below is the definition of table *

input_data1 <- data.frame(Record_Status = c("Modified","Modified","Modified","Modified","Modified","Modified","Modified","Modified","Modified"),
                         Field_Changed = c("Brand,ratio","cost","Name","ratio,Name","cost","Brand,cost","ratio,cost","cost","Name"),
                         Brand = c(3,6,9,12,15,18,21,24,27),
                         ratio = c (1,2,3,4,5,6,7,8,9),
                         cost = c(3,6,9,12,15,18,21,24,27),
                         Name = c("A","B","C","A","B","C","A","B","C"),
                         stringsAsFactors = FALSE)
hepl_1=tapply(1:ncol( input_data1),function(i)  ifelse(( input_data1[[1]]=="Modified" & 
                                                        str_detect( input_data1[[2]], names( input_data1)[i])),
                                                     "red","white"))
help_3=as.matrix( input_data1[1:ncol( input_data1)])

My datatable definition is as below:

output$mod_table <- DT::renderDataTable({
    DT::datatable(input_data,selection = 'single',
                  escape=F, plugins = "ellipsis",
                  class = 'white-space: nowrap',
                  filter = list(position = 'top', clear = FALSE) , editable = TRUE,
                  extensions =  c('Buttons','AutoFill','FixedHeader', 'KeyTable','ColReorder'),
                  rownames = F, 
                  options = list(
                    keys = TRUE, colReorder = list(realtime = FALSE),
                    fixedHeader = TRUE, autoFill = list(focus = 'click', horizontal = FALSE) , 
                    autoWidth=TRUE, pageLength = 7 ,list(target = 'cell'),
                    lengthMenu = list(c(2, 50, -1), c('2', '50', 'All')),  dom = 'lBfrtip',buttons =                                                                                                                 list(
                      c('colvis','pdf','excel'),
                      list(
                        extend = "collection",
                        text = 'Show All',
                        action = DT::JS("function ( e, dt, node, config ) { dt.page.len(-1);
                                                   dt.ajax.reload();
    }"))))) %>% formatStyle(names(input_data), backgroundColor = styleEqual(help_3, hepl_1))
    
  })

click here for image definition of Hepl1

click here for o/p datatable image - which is not giving me correct highlights

    ### Libraries
library(shiny)
library(dplyr)
library(DT)

### Data
input_data <- data.frame(Record_Status = c("Modified","Modified","Modified","Modified","Modified","Modified","Modified","Modified","Modified"),
                         Field_Changed = c("Brand,ratio","cost","Name","ratio,Name","cost","Brand,cost","ratio,cost","cost","Name"),
                         Brand = c(3,6,9,12,15,18,21,24,27),
                         ratio = c (1,2,3,4,5,6,7,8,9),
                         cost = c(3,6,9,12,15,18,21,24,27),
                         Name = c("A","B","C","A","B","C","A","B","C"),
                         stringsAsFactors = FALSE)

### Module
modFunction <- function(input, output, session, data,reset) {
  
  v <- reactiveValues(data = data)
  
  proxy = dataTableProxy("mod_table")
  
  
  ### Reset Table
  observeEvent(reset(), {
    v$data <- data # your default data
  })
  
  hepl_1=sapply(1:ncol(input_data),function(i)  ifelse(input_data[[1]]=="Modified" & 
                                                         str_detect(input_data[[2]], names(input_data)[i]),
                                                       "yellow","white"))
  help_3=as.matrix(input_data)
  
  #print(isolate(colnames(v$data)))
  output$mod_table <- DT::renderDataTable({
    DT::datatable(input_data,selection = 'single',
                  escape=F, plugins = "ellipsis",
                  class = 'white-space: nowrap',
                  filter = list(position = 'top', clear = FALSE) , editable = TRUE,
                  extensions =  c('Buttons','AutoFill','FixedHeader', 'KeyTable','ColReorder'),
                  rownames = F, 
                  options = list(
                    keys = TRUE, colReorder = list(realtime = FALSE),
                    fixedHeader = TRUE, autoFill = list(focus = 'click', horizontal = FALSE) , 
                    autoWidth=TRUE, pageLength = 7 ,list(target = 'cell'),
                    lengthMenu = list(c(2, 50, -1), c('2', '50', 'All')),  dom = 'lBfrtip',buttons =                                                                                                                 list(
                      c('colvis','pdf','excel'),
                      list(
                        extend = "collection",
                        text = 'Show All',
                        action = DT::JS("function ( e, dt, node, config ) { dt.page.len(-1);
                                                   dt.ajax.reload();
    }"))))) %>% formatStyle(names(input_data), backgroundColor = styleEqual(help_3, hepl_1))
    
  })
}

modFunctionUI <- function(id) {
  ns <- NS(id)
  DT::dataTableOutput(ns("mod_table"))
  
}

### Shiny App
shinyApp(
  ui = basicPage(
    mainPanel(
      
      actionButton("reset", "Reset"),
      tags$hr(),
      modFunctionUI("editable")
    )
  ),
  server = function(input, output) {
    demodata<-input_data
    callModule(modFunction,"editable", demodata,
               reset = reactive(input$reset))
    
  }
)
Nirali
  • 1
  • 2
  • @Batanichek - If you can help me..!! as I am referring your answer for the solution. – Nirali Oct 22 '20 at 07:54
  • Welcome to SO. Please have a look how to ask a [minimal reproducible example](https://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example). In your case, please contain example data (use the output of `dput`) and provide a minimal, runnable shiny app. Thanks – starja Oct 22 '20 at 19:39
  • I have updated it... can someone please give me some solution please – Nirali Dec 04 '20 at 13:41
  • Can you please explain in more detail according to which rule the background colour should change? Thanks! – starja Dec 06 '20 at 20:19
  • let say take 1st row in given table. where record status = Modified" and Fields_Changes = "Bran,Ratio" then in first row Brand with value 3 and Ratio with value 1 must be colored – Nirali Jul 09 '21 at 11:28

0 Answers0