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

标签： rshinydt

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