css 选择背景颜色到DT表值(自由选择,不带任何条件)在R中闪亮

djmepvbi  于 2023-06-25  发布在  其他
关注(0)|答案(1)|浏览(145)

我是新来的。我试图找到是否有一个功能,以[创建一个选择的背景颜色“添加或更改背景颜色的细胞”在DT表。我没有特别的标准来给予背景颜色。我希望Randon颜色来选择或改变背景颜色。我有下面的代码。我在哪里可以实现这一点,请让我知道。先谢谢你。

library(shiny)
library(DT)
library(htmltools)

dat <- mtcars

sketch <- tags$table(
  tags$thead(
    tags$tr(
      tags$th(),
      lapply(names(dat), tags$th)
    ),
    tags$tr(
      tags$th(id = "th0"),
      tags$th(id = "th1"),
      tags$th(id = "th2"),
      tags$th(id = "th3"),
      tags$th(id = "th4"),
      tags$th(id = "th5"),
      tags$th(id = "th6"),
      tags$th(id = "th7"),
      tags$th(id = "th8"),
      tags$th(id = "th9"),
      tags$th(id = "th10"),
      tags$th(id = "th11")
    )
  )
)

js <- c(
  "function(){", 
  "  this.api().columns().every(function(i){",
  "    var column = this;",
  "    var select = $('<select multiple=\"multiple\"><option value=\"\"></option></select>')",
  "      .appendTo( $('#th'+i).empty() )", 
  "      .on('change', function(){",
  "        var vals = $('option:selected', this).map(function(index,element){",
  "          return $.fn.dataTable.util.escapeRegex($(element).val());",
  "        }).toArray().join('|');",
  "        column.search(vals.length > 0 ? '^('+vals+')$' : '', true, false).draw();",
  "      });",
  "    var data = column.data();",
  "    if(i == 0){",
  "      data.each(function(d, j){",
  "        select.append('<option value=\"'+d+'\">'+d+'</option>');",
  "      });",
  "    }else{",
  "      data.unique().sort().each(function(d, j){",
  "        select.append('<option value=\"'+d+'\">'+d+'</option>');",
  "      });",
  "    }",
  "    select.select2({width: '120%', closeOnSelect: false});",
  "  });",
  "}")

ui <- fluidPage(
  tags$head(
    tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/css/select2.min.css"),
    tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/js/select2.min.js")
  ),
  br(),
  DTOutput("dtable")
)

server <- function(input, output, session) {
 
  
  output[["dtable"]] <- renderDT({
   
    datatable(
      dat, container=sketch, editable = "cell", class = 'cell-border stripe', extensions = 'Buttons',
      options = list(dom = 'Bfrtip', buttons = list('copy', 'pdf', 'csv', 'excel', 'print'),
        orderCellsTop = TRUE,
        initComplete = JS(js),
        columnDefs = list(
          list(targets = "_all", className = "dt-center")
        )
      )
  )
    
    
    
  }, server = FALSE)
}

shinyApp(ui, server)

颜色选择示例:

m4pnthwp

m4pnthwp1#

有个办法

library(shiny)
library(DT)
library(colourpicker)

CSS <- function(tableid, color) {
  sprintf("#%s tr {background-color: %s;}", tableid, color)
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      colourInput(
        "color", 
        "Choose background color"
      )
    ),
    mainPanel(
      uiOutput("css"),
      DTOutput("dtable")
    )
  )
)

server <- function(input, output, session) {
  
  output[["css"]] <- renderUI({
    tags$style(HTML(CSS("dtable", input[["color"]])))
  })
  
  output[["dtable"]] <- renderDT({
    datatable(iris)
  })
}

shinyApp(ui, server)

编辑:单个单元格的颜色

library(shiny)
library(DT)
library(colourpicker)

CSS <- function(tableid, color, i, j) {
  sprintf(
    "#%s tr:nth-child(%d) td:nth-child(%d) {background-color: %s;}", 
    tableid, i, j, color
  )
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      numericInput("row", "Choose row", value = 1, min = 1),
      numericInput("col", "Choose column", value = 1, min = 1),
      colourInput(
        "color", 
        "Choose background color"
      )
    ),
    mainPanel(
      uiOutput("css"),
      DTOutput("dtable")
    )
  )
)

server <- function(input, output, session) {
  
  output[["css"]] <- renderUI({
    tags$style(HTML(
      CSS("dtable", input[["color"]], input[["row"]], input[["col"]])
    ))
  })
  
  output[["dtable"]] <- renderDT({
    datatable(iris)
  })
}

shinyApp(ui, server)

相关问题