Formatstyle R数据表

时间:2019-03-06 17:48:54

标签: r shiny dt

我有一个数据表,我想在其中格式化New_Membership列。我现在要做的方法是确定ModifiedCurrent列之间的差异,并使用样式颜色栏。我想知道是否可以根据两列之间的差异添加向上或向下箭头。或者,如果我可以根据正或负值之间的差异将列设置为红色或绿色。

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

2 个答案:

答案 0 :(得分: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'
)

enter image description here

答案 1 :(得分:1)

我知道这个问题有点老了,但这是另一个类似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。现在您的输出将如下所示:

Result