Formatstyle R 数据表答案

【问题标题】：Formatstyle R data tableFormatstyle R 数据表
【发布时间】：2019-07-28 11:37:33
【问题描述】：

我有一个数据表，我想在其中格式化 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")

【问题讨论】：

标签： r shiny dt

【解决方案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'
)

【讨论】：

【解决方案2】：

我知道这个问题有点老了，但这是另一个类似 R 的答案。

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

但是，请记住，这种方法会更改原始数据，这意味着当您添加下载按钮时，其中会显示“是”和“否”，而不是 500 和-1000。现在您的输出将如下所示：

【讨论】：