r有光泽:突出一些细胞

时间:2014-09-16 05:19:23

标签: r ggplot2 shiny

在闪亮的情况下,我使用plotOutput输出一个表,我想根据一些标准突出显示它的一些单元格。 是否有任何闪亮的功能可以实现这一目标?

提前谢谢!

======================

除了突出显示之外,我还想在表格的左侧添加单选按钮,这样我就可以知道用户选择了哪些行。现在我使用renderDataTable来做这件事,但它似乎没有突出显示功能。 可能吗?

1 个答案:

答案 0 :(得分:7)

您好一个没有ggplot2但包含ReporteRs的解决方案,请参阅下面的应用程序,例如,主要功能是FlexTable

编辑:是的,您可以将闪亮的小部件放入HTML表格,这里有一个checkboxInput用于选择行的示例:

library(ReporteRs)
library(shiny)
mtcars = mtcars[1:6, ]
runApp(list(
  ui = pageWithSidebar(
    headerPanel = headerPanel("FlexTable"),
    sidebarPanel = sidebarPanel(
      selectInput(inputId = "colCol", label = "Col to color", choices = c("None",     colnames(mtcars)), selected = "None"),
      selectizeInput(inputId = "rowCol", label = "Row to color", choices = rownames(mtcars), multiple = TRUE,
                     options = list(placeholder = 'None', onInitialize = I('function() { this.setValue(""); }')))
    ),
    mainPanel = mainPanel(
      uiOutput(outputId = "tableau"),
      br(),
      verbatimTextOutput(outputId = "row_select"),
      uiOutput(outputId = "car_selected")
)
  ),

  server = function(input, output, session) {

    output$tableau <- renderUI({ 

  # here we add check box into the table: it create 6 new input widgets
  mtcars$choice = unlist(lapply(1:nrow(mtcars),
                                FUN = function(x) { paste(capture.output(checkboxInput(inputId = paste0("row", x),
                                                                                       label = paste("Row", x),
                                                                                       value = TRUE)), collapse = " ") }))

  tabl = FlexTable( mtcars,
                    # tune the header and the cells
                    header.cell.props = cellProperties( background.color = "#003366", padding = 5 ),
                    body.cell.props = cellProperties( padding = 5 ),
                    header.text.props = textBold( color = "white" ),
                    add.rownames = TRUE )

  tabl = setZebraStyle( tabl, odd = "#DDDDDD", even = "#FFFFFF" )

  # set a column's color
  if (input$colCol != "None") {
    tabl = setColumnsColors( tabl, j=which(names(mtcars) %in% input$colCol ), colors = "orange" )
  }

  # set a row's color
  if (!is.null(input$rowCol)) {
    tabl = setRowsColors( tabl, i=which(rownames(mtcars) %in% input$rowCol ), colors = "#3ADF00" )
  }

  return(HTML(as.html(tabl)))

})

output$row_select <- renderPrint({
  # you can use the input created into the table like others
  c("row1" = input$row1, "row2" = input$row2, "row3" = input$row3, "row4" = input$row4, "row5" = input$row5, "row6" = input$row6)
})

output$car_selected <- renderUI({
  # if you have more than 6 rows it could be convenient
  selected = eval(parse(text = paste("c(", paste(paste0("input$row", 1:6), collapse =", "), ")")))
  HTML(paste0("You have selected the following cars : ", paste(rownames(mtcars)[selected], collapse = ", ")))
    })
  }
))

这样渲染(带复选框):

enter image description here