在 Shiny 中更改 rpivotTable 的颜色

Question

我正在拼命尝试更改 rpivotTable 包的默认颜色。我还在包创建者的 github 上发布了一个问题，但还没有人回答，所以如果有人知道如何解决这个问题，我将不胜感激。

我的主要问题是更改变量选项下方矩形中的蓝色：Example

通过我在互联网上找到的这个功能，我设法改变了整个背景，但不是我想要的特定的东西（目前仅在 Shiny 之外）：

style_widget <- function(hw=NULL, style="", addl_selector="") {
  stopifnot(!is.null(hw), inherits(hw, "htmlwidget"))

  # use current id of htmlwidget if already specified
  elementId <- hw$elementId
  if(is.null(elementId)) {
    # borrow htmlwidgets unique id creator
    elementId <- sprintf(
      'htmlwidget-%s',
      htmlwidgets:::createWidgetId()
    )
    hw$elementId <- elementId
  }

  htmlwidgets::prependContent(
    hw,
    htmltools::tags$style(
      sprintf(
        "#%s %s {%s}",
        elementId,
        addl_selector,
        style
      )
    )
  )
}
pivot_graph<-rpivotTable(mtcars)
browsable(
  tagList(
    style_widget(hw=pivot_graph, "background-color: rgb(245, 245, 245);", "table td")
  )
)

但是，当我尝试做 Shiny 时，我不知道该放什么以及如何做（或者即使使用此功能完全有可能）。任何帮助表示赞赏。到目前为止我的闪亮代码：

library(shiny)
library(rpivotTable)
library(rvest)
ui <- fluidPage(
  titlePanel("Cars"),
  sidebarLayout(
    sidebarPanel(
      fileInput('file1', 'Choose CSV File',
                accept=c('text/csv','text/comma-separated-values,text/plain','.csv')),
      actionButton("save1","Save Table 1")
      # actionButton("save2","Save Table 2")
    ),
    mainPanel(
      tabsetPanel(
        tabPanel("Pivot Table 1",
                 rpivotTableOutput("table")),
        tabPanel("Pivot Table 2",
                 rpivotTableOutput("table2"))
      )
    )
  )



)


server <- function(input, output,session)
{

  session$onSessionEnded(stopApp)

  observe({
    file1 = input$file1
    if (is.null(file1)) {
      return(NULL)
    }
    st_data <<- read.csv(file1$datapath)



    output$table <- renderRpivotTable({
      rpivotTable(mtcars,
                  rendererName="Table",
                  onRefresh = htmlwidgets::JS("function(config) {Shiny.onInputChange('myData', 
                                              document.getElementById('table').innerHTML); }")
      )
    })


    output$table2 <- renderRpivotTable({
      rpivotTable(mtcars,aggregatorName="Average",   
                  rendererName="Table",
                  onRefresh = htmlwidgets::JS("function(config) {Shiny.onInputChange('myData', 
                                                  document.getElementById('table').innerHTML); }")
      )
    })

    summarydf <- eventReactive(input$myData,{
      input$myData %>%
        read_html %>%
        html_table(fill = TRUE) %>%
        .[[2]]
    })

    observeEvent(input$save1, {
      if(nrow(summarydf() )<1) return()
      write.csv(summarydf(), file="./cars1.csv")
    })

    # summarydf1 <- eventReactive(input$myData1,{
    #   input$myData1 %>%
    #     read_html %>%
    #     html_table(fill = TRUE) %>%
    #     .[[4]]
    # })
    # 
    # observeEvent(input$save2, {
    #   if(nrow(summarydf1() )<1) return()
    #   write.csv(summarydf1(), file="./cars2.csv")
    # })
    })
}

shinyApp(ui = ui, server = server)

Answer 1

以下代码会将浅蓝色变为非常深的蓝色。

您可以以类似的方式更改任何 pivot.min.css 代码：唯一的挑战是确定哪个是正确的元素！

要更改颜色，请搜索 JavaScript 颜色映射并将 #000080 更改为您需要的任何颜色。

library(shiny)

df <- iris

ui <- fluidPage(
            tags$style(type="text/css",".pvtRows, .pvtCols { background: #000080 none repeat scroll 0 0; }" ),

                        fluidRow(
                            column(width=10, rpivotTableOutput("pivot"))
                            )
                        )

server <- function(input, output, session) {

output$pivot<-renderRpivotTable({

            rpivotTable(df,
                rendererName="Heatmap",
                cols=c("Species"),
                rows=c("Petal.Width"),
                aggregatorName="Count"
                )


        })

}

shinyApp(ui = ui, server = server)

如果这能满足您的要求，请告诉我。