Highlighting table Cells based on headers mentioned in one column data - r

Question

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))
}
)