rhandsontable formatting renderer

Published by onesixx on

https://jrowen.github.io/rhandsontable/#formatting

https://stackoverflow.com/questions/44813590/rhandsontable-conditional-formatting-how-to-highlight-rows-based-on-specific-at

https://cran.r-project.org/web/packages/shinyjs/vignettes/shinyjs-extend.html

http://onesixx.com/ggplot-ggplot_build/

groupOfColor <- ggplot_build(p)$data[[1]][, 1] %>% unique

http://onesixx.com/rhandsontable-2/

### DATA ----
MAT = matrix(runif(9, -1, 1), nrow = 3, dimnames = list(LETTERS[1:3], LETTERS[1:3]))
diag(MAT) = 1
MAT[upper.tri(MAT)] = MAT[lower.tri(MAT)]
DF <- data.frame(MAT)

### Color ----
groupOfColor <- c("#F8766D", "#00BA38", "#619CFF")

### Make Javascript ----
jsColor_Header <- "function(instance, td, row, col, prop, value, cellProperties){
                     Handsontable.renderers.NumericRenderer.apply(this, arguments);
                       if(col==0){ "

# temp <- NULL
# for (i in seq_along(groupOfColor)-1){
#   temp[i] <- str_c( " if(row==",i,") { td.style.background = '", groupOfColor[i], "';} ","\n" )
# }
# jsColor_Main <- str_c(temp,collapse = " ")

# jsColor_Main <- str_c(unlist(lapply(0:(length(groupOfColor)-1), 
#                                     function(x)str_c( " if(row==",x,") { td.style.background = '", groupOfColor[x+1], "';} ","\n" ))), collapse=" ")

jsColor_Main <- sapply(0:(length(groupOfColor)-1),
                      function(x) str_c("if(row==",x,") {td.style.background='", groupOfColor[x+1], "';}","\n")) %>% str_c(collapse=" ")
jsColor_Footer <- "}}"

jsColor <- str_c(jsColor_Header, jsColor_Main, jsColor_Footer)

# jsColor <-  "
#   shinyjs.backgroundCol = function(instance, td, row, col, prop, value, cellProperties){
#     Handsontable.renderers.NumericRenderer.apply(this, arguments);
#       if(col==0){
#         if(row==0){td.style.background='#F8766D';}
#         if(row==1){td.style.background='#00BA38';}
#         if(row==2){td.style.background='#619CFF';}
#       }
#   }"

# TABLE ----
rhandsontable(DF, readOnly = TRUE, width = 750, height = 300) %>%
  hot_cols(renderer = jsColor)

shiny

library(shiny)
library(rhandsontable)

### Make Javascript ----
jsColor_Header <- "function(instance, td, row, col, prop, value, cellProperties){
                     Handsontable.renderers.NumericRenderer.apply(this, arguments);
                      if(col==0){ "
jsColor_Main <- sapply(0:(length(groupOfColor)-1),
                       function(x) str_c("if(row==",x,") {td.style.background='", groupOfColor[x+1], "';}","\n")) %>% str_c(collapse=" ")
jsColor_Footer <- "}}"
jsColor <- str_c(jsColor_Header, jsColor_Main, jsColor_Footer)


ui <- fluidPage(
  rHandsontableOutput("table")
)

server <- function(input,output,session)({
  ### DATA ----
  MAT = matrix(runif(9, -1, 1), nrow = 3, dimnames = list(LETTERS[1:3], LETTERS[1:3]))
  diag(MAT) = 1
  MAT[upper.tri(MAT)] = MAT[lower.tri(MAT)]
  DF <- data.frame(MAT)
  
  ### Color ----
  groupOfColor <- c("#F8766D", "#00BA38", "#619CFF")
  
  output$table <- renderRHandsontable({
    # TABLE ----
    rhandsontable(DF, readOnly = TRUE, width = 750, height = 300) %>%
      hot_cols(renderer = jsColor)
  })
  
}) 

shinyApp(ui,server)

 

 

 

 

 

Categories: R-Shiny

onesixx

Blog Owner

Subscribe
Notify of
guest

0 Comments
Inline Feedbacks
View all comments
0
Would love your thoughts, please comment.x
()
x