Таблица данных Formatstyle R

Question

У меня есть таблица данных, в которой я хотел бы отформатировать столбец New_Membership.То, что я делаю сейчас, - это определить разницу между столбцами Modified и Current и использовать цветную полосу стиля.Я хотел знать, могу ли я добавить стрелки вверх или вниз на основе разницы между двумя столбцами.Или, если я могу стилизовать столбец, чтобы красный или зеленый на основе разницы в значениях, если он положительный или отрицательный.

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

Answer 1

Может быть что-то вроде этого:

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