Question 239518 in CSS Question posted in
Some basic documentation can be found here.

Css – RenderTable with each row filled by a percentage like a horizontal bar chart

I am trying to achieve something like this:

enter image description here

I was wondering if this is something that can be achieved with renderTable and some CSS/HTML, but I wasn’t able to come anywhere close to achieving this. Here’s a reprex:

ui.R:

library(shiny)
library(DT)
ui <- fluidPage(
  fluidRow(
   column(6, 
    tableOutput("horizontalBarTable"))))

server.R:

server <- function(input, output) {
    data <- data.frame(
    Category = c("Category A", "Category B", "Category C"),
    Percentage = c(30, 50, 70)
  )
  
  output$horizontalBarTable <- renderTable({
    data
  }, sanitize.text.function = function(x) x, include.rownames = FALSE) }
Tags:

2

Answers


  1. 0

    DT package might help you with this.
    Here is a solution :

    library(shiny)
library(DT)


ui <- fluidPage(
  fluidRow(
    column(6, 
           DTOutput("horizontalBarTable"))))



server <- function(input, output) {
  data <- data.frame(
    Category = c("Category A", "Category B", "Category C"),
    Percentage = c(30, 50, 70)
  )
  
  output$horizontalBarTable <- renderDT({
    datatable(data,rownames = FALSE, options = list(dom = 't')) %>% 
      formatStyle(
        'Category',
        valueColumns = 'Percentage',
        background = styleColorBar(c(0,100), 'steelblue', angle = 270),
        backgroundSize = '100% 90%',
        backgroundRepeat = 'no-repeat',
        backgroundPosition = 'center'
      )
  })
}


shinyApp(ui = ui, server = server)
    Login or Signup to reply.
  2. 0

    Here is an adaptation of the app of the link given in a comment:

    enter image description here

    library(shiny)
library(DT)

# Prepare the Sample data
test_data <-
  data.frame(
    Rank = c("1", "2", "3"),
    Domain = c("children", "adults", "income"),
    Category = I(list(
      list(text = "Category A", x = 30),
      list(text = "Category B", x = 50),
      list(text = "Category C", x = 70)
    ))
  )

# Define the Shiny UI and Custom CSS Elements
ui <- fluidPage(
  tags$head(tags$style(HTML(
    "
      .bar-chart-bar {
          background-color: #e8e8e8;
          display: block;
          position:relative;
          width: 100%;
          height: 20px;
      }
      .bar {
          background-color: red;
          float: left;
          height: 20px;
      }
    "
  ))), 
  DTOutput("test_table")
)

js <- '
function(data, type, row, meta) {
  let txt = data.text;
  let percent = data.x;
  return $("<div></div>", {
    class: "bar-chart-bar"
  })
    .append(
      $("<div></div>", {
        class: "bar",
        text: txt
      }).css({
        width: (percent) + "%"
      })
    )
    .prop("outerHTML");
}
'

# Rendering the DataTable in Shiny Server
server <- function(input, output, session) {
  output$test_table <- renderDT({
    dt <- datatable(
      test_data,
      rownames = FALSE,
      options = list(
        columnDefs = list(
          list(
            targets = 2,
            render = JS(js)
          )
        )
      )
    )
  })
}

# Run the App
shinyApp(ui, server)
    Login or Signup to reply.
Please signup or login to give your own answer.

Back To Top
Search