CODEWITHSUNDEEP
rshinydt
SNT
SNT

Reputation: 1433

Formatstyle R data table

I have a datatable in which I would like to format the column New_Membership . The way I am doing right now is either to identify the difference between columns Modified and Current and use style color bar. I wanted to know if I can add a up or down arrow based on the difference between the two columns. Or if I can style the column to red or green based on the difference in values if its positive or negative.

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

df <- data.frame(Channel = c("A", "B","C"),
                 Current = c(2000, 3000, 4000),
                 Modified = c(2500, 3500,3000),
                 New_Membership = c(500, 500,-1000),
                 stringsAsFactors = FALSE)


#### Module 1 renders the first table
tableMod <- function(input, output, session, modelRun,modelData,ratesData,budget){

  output$x1 <- DT::renderDataTable({
    isolate(
      datatable(
        modelData , selection = 'none', editable = TRUE
      ) %>% formatStyle(
        'New_Membership',
        background = styleColorBar(( modelData$Modified -modelData$Current), 'lightblue'),
        backgroundSize = '100% 50%',
        backgroundRepeat = 'no-repeat',
        backgroundPosition = 'center'
      )
    )
  })



}
firstTableUI <- function(id) {
  ns <- NS(id)
  dataTableOutput(ns("x1"))
}

ui <- function(request) {
  fluidPage(
    firstTableUI("opfun"),
    numericInput("budget_input", "Total Forecast", value = 2),
    actionButton("opt_run", "Run")  )
}
server <- function(input, output, session) {

  callModule( tableMod,"opfun",
              modelRun = reactive(input$opt_run),
              modelData = df,
              ratesData = rates,
              budget = reactive(input$budget_input))

  observeEvent(input$opt_run, {
    cat('HJE')
  })
}

shinyApp(ui, server, enableBookmarking = "url")

Upvotes: 2

Views: 11005

Answers (2)

Yannik Suhre
Yannik Suhre

Reputation: 734

I know this question is a little bit older, but here is another R-like answer.

df %>%
  mutate("New_Membership" = ifelse(New_Membership==500, "Yes", "No")) %>%
  datatable() %>%
  formatStyle("New_Membership",
              fontWeight = "bold",
              color = styleEqual(c("Yes", "No"), c("green", "red")))

However, bear in mind that this approach changes the original data, meaning that when you add a download button, it'll have "Yes" and "No" in it, instead of 500 and -1000. Now your output will look like:

Result

Upvotes: 1

St&#233;phane Laurent
St&#233;phane Laurent

Reputation: 84699

Maybe something like this:

library(DT)

modelData <- data.frame(Channel = c("A", "B", "C"),
                        Current = c(2000, 3000, 4000),
                        Modified = c(2500, 3500, 3000),
                        New_Membership = c(500, 500, -1000),
                        stringsAsFactors = FALSE)

styleColorBar2 <- function (data, color1, color2) 
{
  M <- max(abs(data), na.rm = TRUE)
  js <- c(
    "value <= 0 ? ",  
    sprintf("'linear-gradient(90deg, transparent ' + (1+value/%f) * 100 + '%%, %s ' + (1+value/%f) * 100 + '%%)'", 
            M, color1, M),
    " : ",
    sprintf("'linear-gradient(90deg, transparent ' + (1-value/%f) * 100 + '%%, %s ' + (1-value/%f) * 100 + '%%)'", 
            M, color2, M) 
  )
  JS(js)
}

datatable(
  modelData , selection = 'none', editable = TRUE
) %>% formatStyle(
  'New_Membership',
  background = styleColorBar2(modelData$New_Membership, "red", "lightblue"),
  backgroundSize = '100% 50%',
  backgroundRepeat = 'no-repeat',
  backgroundPosition = 'center'
)

enter image description here

Upvotes: 1

Related Questions