Creating a responsive HTML table in R can be achieved by using the 'DT

Below is the structured dataframe I am working with in R:

Dataframe-

seq      count  percentage   Marking     count     Percentage     batch_no   count    Percentage
FRD      1      12.50%       S1          2         25.00%         6          1        12.50%
FHL      1      12.50%       S2          1         12.50%         7          2        25.00%
ABC      2      25.00%       S3          1         12.50%         8          2        25.00%
DEF      1      12.50%       Hold        2         25.00%         9          1        12.50%
XYZ      1      12.50%       NA          1         12.50%         NA         1        12.50%
ZZZ      1      12.50%       (Blank)     1         12.50%         (Blank)    1        12.50%
FRD      1      12.50%         -         -           -             -         -           -
NA       1      12.50%         -         -           -             -         -           -
(Blank)  0      0.00%          -         -           -             -         -           -
Total    8      112.50%        -         8         100.00%         -         8         100.00%

The number of columns in the dataframe is fixed, but the number of rows can vary depending on certain conditions. The table might have anywhere from 4 to 15 rows.

I want to customize the table by setting the header color to light green with bold font, and the last row should be yellow with bold font. Additionally, I want to highlight rows where the Percentage of 'Hold' in 'Marking' and the Percentage of '8' in 'batch_no' are greater than 25%, by marking them as dark red with bold white font.

If possible, I would like to add the suffix '(In Progress)' for 'S3' and '9', respectively, where the font size of '(In Progress)' will be two sizes smaller than the variable name.

The '(In Progress)' text should appear in yellow font with bold styling.

Here is the code snippet I am using:

library(tableHTML)
library(dplyr)

add_font <- function(x) {
  x <- gsub('\\(', '\\(<font size="-1">', x)
  x <- gsub('\\)', '</font>\\)', x)
  return(prettyNum(x, big.mark = ','))
}


    Html_Table<-Dataframe %>% 
      mutate(`Marking` = add_font(`Marking`),
             `batch_no` = add_font(`batch_no`)) %>% 
      tableHTML(rownames = FALSE, 
                escape = FALSE,
                widths = rep(100, 12),
                caption = "Dataframe: Test",
                theme='scientific') %>% 
      add_css_caption(css = list(c("font-weight", "border","font-size"),
                                 c("bold", "1px solid black","16px"))) %>
      add_css_row(css = list(c("background-color"), c("lightblue")), rows = 0:1)%>
      add_css_caption(css = list(c("background-color"), c("lightblue"))) %>
      add_css_row(css = list('background-color', '#f2f2f2'),
                  rows = odd(1:10)) %>
      add_css_row(css = list('background-color', '#e6f0ff'),
                  rows = even(1:10)) %>
      add_css_row(css = list(c("background-color","font-weight"), c("yellow", "bold")), 
                   rows = even(2:3)) %>
      add_css_row(css = list(c("font-style","font-size"), c("italic","12px")), 
                   rows = 4:8)
cssrdataframehtml-tablekableextra

Answer №1

You can leverage the same technique used with add_font to achieve your desired outcome with tableHTML.

library(tableHTML)
library(dplyr)
Data <- read.table(text='seq      count  percentage   Marking     count     percentage     batch_no   count    percentage
FRD      1      12.50%       S1          2         25.00%         6          1        12.50%
FHL      1      12.50%       S2          1         12.50%         7          2        25.00%
ABC      2      25.00%       S3          1         12.50%         8          2        25.00%
DEF      1      12.50%       Hold        2         25.00%         9          1        12.50%
XYZ      1      12.50%       NA          1         12.50%         NA         1        12.50%
ZZZ      1      12.50%       (Blank)     1         12.50%         (Blank)    1        12.50%
FRD      1      12.50%         -         -           -             -         -           -
NA       1      12.50%         -         -           -             -         -           -
(Blank)  0      0.00%          -         -           -             -         -           -
Total    8      112.50%        -         8         100.00%         -         8         100.00%',
                        header = TRUE, stringsAsFactors = FALSE) %>% as_tibble()
names_orig <- Data %>% names()

# define font enhancement function
add_font <- function(x) {
  x <- gsub('\\(', '\\(<font size="-1">', x)
  x <- gsub('\\)', '</font>\\)', x)
  return(x)
}

# define style addition function
add_style <- function(x, style){
  x <- paste0('<div ', style, '>', x, '</div>')
  return(x)
}

# define in progress function
add_in_progress <- function(x){
  x <- paste0(x, '<font size="1" color="red">', '(In Progress)', '</font>')
  return(x)
}

# specify condition for styling
style <- 'style="background-color:darkred;font-weight:bold;color:white;"'
condition_1 <- Data$Marking=='Hold' & Data$percentage_num > 10
condition_2 <- Data$batch_no==8 & Data$percentage.2_num > 10

Html_Table <-
  Data %>%
  mutate(`Marking` = add_font(`Marking`),
         `batch_no` = add_font(`batch_no`)) %>%
  # apply specified style based on conditions
  mutate(percentage = ifelse(condition_1,
                             add_style(percentage, style),
                             percentage),
         percentage.1 = ifelse(condition_2,
                               add_style(percentage.1, style),
                               percentage.1)) %>%
  # add in progress indicator
  mutate(Marking = ifelse(Marking=='S3', 
                          add_in_progress(Marking), 
                          Marking))  %>%
  mutate(batch_no = ifelse(batch_no=='9', 
                         add_in_progress(batch_no), 
                           batch_no)) %> 
  # select columns to display
  select(names_orig) %>  
  # convert to table using tableHTML
  tableHTML(rownames = FALSE, 
            escape = FALSE,
            widths = rep(100, 9),
            replace_NA = '',
            headers = names_orig %>% gsub('.[1-9]', '', .),
            caption = "Dataframe: Test", 
            border = 0) %>%
  # style header
  add_css_header(css = list(c('background-color', 'border-top', 'border-bottom'), 
                            c('lightgreen', '3px solid black', '3px solid black')), 
                 headers = 1:ncol(Data)) %> 
  # style last row
  add_css_row(css = list(c('background-color', 'font-weight'), 
                         c('yellow', 'bold')), 
              rows = nrow(Data)+1)

Html_Table

Answer №2

While I may not have completely grasped all of your requirements, I have crafted a solution using the flextable package.

library(officer)
library(flextable)
library(magrittr)
dat <- tibble::tribble(
    ~seq, ~count1, ~percentage1,  ~Marking, ~count2, ~percentage2, ~batch_no, ~count3, ~percentage3,
    "FRD", 1, "12.50%", "S1", "2", "25.00%", "6", "1", "12.50%",
    "FHL", 1, "12.50%", "S2", "1", "12.50%", "7", "2", "25.00%",
    "ABC", 2, "25.00%", "S3", "1", "12.50%", "8", "2", "45.00%",
    "DEF", 1, "12.50%", "Hold", "2", "45.00%", "9", "1", "12.50%",
    "XYZ", 1, "12.50%", "NA", "1", "12.50%", "NA", "1", "12.50%",
    "ZZZ", 1, "12.50%", "(Blank)", "1", "12.50%", "(Blank)", "1", "12.50%",
    "FRD", 1, "12.50%", NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_,
    "NA",  1, "12.50%", NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_,
    "(Blank)", 0, "0.00%", NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character.,
    "Total", 8, "112.50%", NA_character_, "8", "100.00%", NA_character_, "8", "100.00%"
  )
dat$percentage1 <- gsub("%", "", dat$percentage1) %>% as.double()
dat$percentage2 <- gsub("%", "", dat$percentage2) %>% as.double()
dat$percentage3 <- gsub("%", "", dat$percentage3) %>% as.double()


# Setting table header color to light green with bold font 
# and last row of the table to orange with bold font.
flextable(dat) %>% 
  fontsize(size = 11, part = "all") %>% 
  bold(part = "header") %>% 
  color(color = "#90EE90", part = "header") %>% 
  color(color = "orange", i = ~ seq %in% "Total") %>% 
  bold(i = ~ seq %in% "Total") %>% 
#' Additionally, if Percentage of Hold in marking and Percentage of 8 in batch_no is greater than 25%, highlight it with dark red and white bold font.
  color(i = ~ percentage1 > 10 & Marking %in% "Hold", 
        j = c("count1", "percentage1", "Marking"),
        color = "red", part = "body") %>% 
  color(i = ~ percentage2 > 10 & batch_no %in% "8", 
        j = c("count2", "percentage2", "batch_no"),
        color = "red", part = "body") %>% 
  bold(i = ~ percentage1 > 10 & Marking %in% "Hold", 
       j = c("count1", "percentage1", "Marking"),) %>% 
  bold(i = ~ percentage2 > 10 & batch_no %in% "8",
       j = c("count2", "percentage2", "batch_no")) %>% 

#' If possible, the suffix in S3 should be displayed as S3 (In Progress) and 9 as `9 (In Progress), where the font size of (In Progress) will be 2 points less than the variable name.
#' The added text (In Progress) should appear in orange font with bold styling.
  compose(i = ~ Marking %in% "S3", j = "Marking", 
          value = as_paragraph(
            "S3 ", 
            as_chunk("(In Progress)", 
                     props = fp_text(color = "orange", bold = TRUE, font.size = 5.5))
            )
  ) %>% 
  autofit()

Answer №3

A different approach is presented here using the kableExtra package instead of htmlTable...

library(tidyverse)
library(knitr)
library(kableExtra)

MyDataFrame<-
   tribble(
       ~seq, ~count1, ~percentage1,  ~Marking, ~count2, ~Percentage2, ~batch_no, ~count3, ~Percentage3,
      "FRD",       1,     "12.50%",      "S1",     "2",     "25.00%",       "6",     "1",     "12.50%",
      "FHL",       1,     "12.50%",      "S2",     "1",     "12.50%",       "7",     "2",     "25.00%",
      "ABC",       2,     "25.00%",      "S3",     "1",     "12.50%",       "8",     "2",     "45.00%",
      "DEF",       1,     "12.50%",    "Hold",     "2",     "45.00%",       "9",     "1",     "12.50%",
      "XYZ",       1,     "12.50%",      "NA",     "1",     "12.50%",      "NA",     "1",     "12.50%",
      "ZZZ",       1,     "12.50%", "(Blank)",     "1",     "12.50%", "(Blank)",     "1",     "12.50%",
      "FRD",       1,     "12.50%",       "-",     "-",          "-",       "-",     "-",          "-",
       "NA",       1,     "12.50%",       "-",     "-",          "-",       "-",     "-",          "-",
  "(Blank)",       0,      "0.00%",       "-",     "-",          "-",       "-",     "-",          "-",
    "Total",       8,    "112.50%",       "-",     "8",    "100.00%",       "-",     "8",    "100.00%"
          )

test1 <- expression(Marking == "Hold" & as.numeric(str_remove(Percentage2, "%")) > 25.00)
test2 <- expression(batch_no == "8" & as.numeric(str_remove(Percentage3, "%")) > 25.00)

MyDataFrame  %>%
  mutate(Percentage2 = cell_spec(Percentage2,
                                 "html",
                                 background = ifelse(eval(test1), "red", ""),
                                 color = ifelse(eval(test1), "white", "black")),
         Percentage3 = cell_spec(Percentage3,
                                 "html",
                                 background = ifelse(eval(test2), "red", ""),
                                 color = ifelse(eval(test2), "white", "black")))  %>%
         kable(format = "html", escape = FALSE)  %>%
         kable_styling(bootstrap_options = "striped", full_width = FALSE)  %>%
         row_spec(0, bold = TRUE, background = "lightgreen") %>%
         row_spec(10, bold = TRUE, background = "yellow")  %>%
         save_kable(file = "temptable.html")

browseURL("temptable.html")

Answer №4

Struggling to apply conditional cell styling based on another column in tableHtml? Here's a workaround using the gt package.

Here are some things to keep in mind:

  • gt doesn't come with JavaScript Bootstrap code like kableExtra, but the CSS is still included in the HTML file.
  • If I missed your request regarding the prefix, please let me know.
  • I approached the conditions individually instead of combining them.
  • Aggregating missing values as NA can simplify handling percent signs and other complexities while testing the conditions in gt rather than treating them as text.

This code is fairly flexible and can be easily customized to better fit your specific requirements:

library(tibble)
library(gt)
library(stringr)
library(dplyr)


# Data with requested scenarios:
Dataframe <-
  tribble(
    ~seq,      ~count1, ~percentage1, ~Marking,  ~count2, ~Percentage2, ~batch_no, ~count3, ~Percentage3,
    "FRD",     1,       "12.50%",     "S1",      "2",     "25.00%",     "6",       "1",     "12.50%",
    "FHL",     1,       "12.50%",     "S2",      "1",     "12.50%",     "7",       "2",     "25.00%",
    "ABC",     2,       "25.00%",     "S3",      "1",     "12.50%",     "8",       "2",     "45.00%",
    "ABC",     2,       "25.00%",     "S3",      "1",     "12.50%",     "9",       "2",     "17.00%",
    "DEF",     1,       "12.50%",     "Hold",    "2",     "45.00%",     "9",       "1",     "12.50%",
    "XYZ",     1,       "12.50%",     "NA",      "1",     "12.50%",     "NA",      "1",     "12.50%",
    "ZZZ",     1,       "12.50%",     "(Blank)", "1",     "12.50%",     "(Blank)", "1",     "12.50%",
    "FRD",     1,       "12.50%",     "-",       "-",     "-",          "-",       "-",     "-",
    "NA",      1,       "12.50%",     "-",       "-",     "-",          "-",       "-",     "-",
    "(Blank)", 0,       "0.00%",      "-",       "-",     "-",          "-",       "-",     "-",
    "Total",   8,       "112.50%",    "-",       "8",     "100.00%",    "-",       "8",     "100.00%"
  )


test1 <- expression(Marking == "Hold" & as.numeric(str_remove(Percentage2, "%")) > 25.00)
test2 <- expression(batch_no == "8" & as.numeric(str_remove(Percentage3, "%")) > 25.00)
test3 <- expression(Marking == "S3" & batch_no == "9")


newtab <-
  Dataframe  %>%
  mutate(Marking = ifelse(eval(test3), paste0(Marking, " (In progress)"), Marking))  %>
  gt() %>
  #
  tab_style(style = list(cell_fill(color = "lightgreen"),
                        cell_text(weight = "bold")),
            locations = cells_column_labels(columns = 1:9)) %>
  #
  tab_style(style = list(cell_fill(color = "yellow"),
                        cell_text(weight = "bold")),
            locations = cells_body(columns = 1:9, rows = nrow(Dataframe)) %>
  #
  tab_style(style = list(cell_fill(color = "red"),
                        cell_text(color = "white", weight = "bold")),
            locations = cells_body(columns = c("Marking", "Percentage2"),
                                  rows = eval(test1))) %>
  #
  tab_style(style = list(cell_fill(color = "red"),
                        cell_text(color = "white", weight = "bold")),
            locations = cells_body(columns = c("batch_no", "Percentage3"),
                                  rows = eval(test2))) %>
  #
  tab_style(style = list(cell_text(size = px(2))),
            locations = cells_body(columns = c("Marking"),
                                   rows = str_detect(string = Marking, pattern = "progress")))

gtsave(newtab, file = "gttable.html")

Similar questions

If you have not found the answer to your question or you are interested in this topic, then look at other similar questions below or use the search

The callback function fails to execute the click event following the .load() method

Hey there, I've hit a roadblock and could really use some help figuring out where I went wrong. Let me break down my script for you. On page1.html, I have a div that gets replaced by another div from page2.html using jQuery's .load() method. Here ...

javascriptjqueryhtmlcssajax

Bootstrap3 and jQuery are attempting to achieve vertical alignment

I am trying to vertically align Bootstrap col-md* columns. I have two blocks, one with text and one with an image, and I want them to be equal in height with the text block vertically centered. My current solution is not working correctly. Can someone plea ...

jqueryhtmlcsstwitter-bootstrap

Background image for input button in Internet Explorer 6

Can you create a custom background image for the input type="button" in Internet Explorer 6? ...

htmlcssinternet-explorercross-browser

Incorporating Image Caching Optimizations in CSS

My current dilemma I currently implement Cache Busting for my CSS files like this: echo "&lt;link href='stylesheet.css?" . filemtime('stylesheet.css') . "' />" My objective Now I want to achieve a similar approach for th ...

phpcsscache-controlfilemtime

Ways to conceal the contents of a page behind a transparent background div while scrolling

I created a Plunkr with the following markup: <body> <div class="container-fluid"> <div class="row"> <div class="col-sm-12"> <nav class="navbar navbar-fixed-top"> <div class="container-fluid"& ...

htmlcsstwitter-bootstrap

Using jQuery to vertically center a div

When a vertical menu on my website is clicked, it pops out from the left side of the screen. The content inside is vertically centered using CSS transformations. While expanding to show sub-items, everything remains centered. However, there's an issue ...

javascriptjqueryhtmlcsscenter

Discover the intersection of columns within a dataframe

I am working with a dataframe that has thousands of columns, each containing values that co-occur only with certain other columns. For instance : A | B | C Null |"val" |"other" "random"|"rand"| Null In this scenario, I want to generate an out ...

pythonpandasdataframe

What is the best way to incorporate web components into a React Js project?

I am currently unfamiliar with web components. My main goal is to integrate Google Material Components into my React.js project. Google Material Web Component can be found here: https://github.com/material-components/material-components-web Is there a ...

htmlreactjscssmaterial-ui

Is there a way to ensure that the table headers are printed on every page when using Google Chrome

When printing documents in Chrome browser, the table header (thead) does not appear on every page. I want to ensure that the table header is displayed on each printed page, just like it is done with IE and Firefox. However, Chrome does not support this fea ...

javascriptjqueryhtmlcssgoogle-chrome

Creating a hover effect for displaying image masks

My website features a profile page displaying the user's photo. I am attempting to create a functionality where when the user hovers over their photo, a transparent mask with text appears allowing them to update their profile picture via a modal. How ...

javascriptjquerycss

Are we utilizing this JavaScript function properly for recycling it?

Two functions have been implemented successfully. One function adds the autoplay attribute to a video DOM element if the user is at a specific section on the page. The other function smoothly slides in elements with a transition effect. The only limitatio ...

javascriptjqueryhtmlcss

The browser is only showing particular changes made to the CSS file

I'm currently working on a web project and have the following CSS and HTML code: style.css: body { background-color: red; font-size: 14px; font-family: Roboto,arial,sans-serif color: gray; } img { height: 92px; width: 272px; ...

htmlcsscaching

jQuery's slide toggle function is limited to toggling the visibility of just one section at

Welcome to my first post! As a newbie in web development, I have just started my first project. While I feel comfortable with HTML and CSS, jQuery is proving to be a bit challenging for me. In the head section of my intranet page, I have the following cod ...

jqueryhtmlcssslidetoggle

Creating custom styles using Material-UI's makeStyles function with both before and after

Currently, I'm tasked with a project that involves utilizing the CSS code below. .hexagon, .hexagon::before, .hexagon::after { width: 67px; height: 116px; border-radius: 18%/5%; } I am wondering if there is a method to apply the specified style ...

cssreactjsmaterial-uijssmakestyles

The error message received states: "materialize-css Uncaught TypeError: Vel is not defined as

My current setup involves webpack as the bundler/loader, and I've successfully loaded materialize css (js/css). However, when attempting to use the toast feature, an error is thrown: Uncaught TypeError: Vel is not a function The library is being inc ...

javascriptcssnpmwebpackmaterialize

CSS with three columns: the middle column has a fixed size, while the right and left columns

I am attempting to create a 3 column layout with specific requirements: The middle column is fixed at a width of 660px The left and right columns should each take up half of the remaining space, but have a minimum width of 120px The middle div need ...

htmlcss

How to make a letter stretch all the way down the paper?

As I'm creating a table of contents for my website, I was inspired by an interesting design idea that I came across: I am particularly drawn to how the T extends down and each section is numbered with the title wrapped around it. How can I achieve th ...

htmlcss

Combining CSS and JS files for accordion list - experiencing issues when used separately

Recently, I've been trying to create an accordion list and stumbled upon some code (HTML, CSS, and JS) on www.w3schools.com. When I have the code all in one document and run it as a single .html file, everything works perfectly. However, when I split ...

cssjavascripthtml

Is your Bootstrap input displaying the has-error class with a glyphicon, but the alignment is not vertically centered?

What is the reason for the misalignment of glyphicon-warning-sign form-control-feedback vertically in the code below after applying font-size: 20px; to the label? <div class="container"> <div class="content align-left contact"> ...

javascriptjqueryhtmlcsstwitter-bootstrap

Encountering a problem with Selenium when dealing with tabular data displayed in a DIV format on a website, where each row is encapsulated within its own DIV element

While creating Selenium automation tests for a website with multiple rows contained within a main DIV element, each row represented by a separate DIV. For example, if there are 5 dynamically generated rows, the HTML code structure would look like this: < ...

javascriptjavahtmlcssselenium