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

https://i.sstatic.net/I1jCP.png

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()

https://i.sstatic.net/kO9Wo.png

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

What is the solution to prevent a CSS flex column from expanding to fill the width in a row with three

I am trying to create a flex row with three columns, but when I only have two columns in the row, the second column gets pushed to the right side. You can see this issue in the image below. https://i.sstatic.net/cVVqB.png In the image, the red lines indi ...

htmlcssbootstrap-4

Is there a way to eliminate the space between the content inside a table cell and its borders?

I am struggling with a table setup that includes three columns and multiple rows. The first column contains an image, causing the cells in that row to resize based on the image size. When text is added to the 2nd and 3rd columns, it automatically centers w ...

htmlcss

Personalized 404 Error Page on Repl.it

Is it possible to create a custom 404-not found page for a website built on Repl.it? I understand that typically you would access the .htaccess file if hosting it yourself, but what is the process when using Repl.it? How can I design my own 404-not found p ...

javascripthtmlcsshttp-status-code-404replit

Conditionals in ng-class Syntax

I'm attempting to apply a class conditionally to an element, but I'm struggling with the correct syntax. I've experimented with the code below, but it's not functioning as expected: ng-class="{foo: bar === "true"}" The value of bar i ...

javascripthtmlcssangularjs

Creating a personalized notification box that is compatible with various screen sizes and web browsers on android devices with the help of

After successfully implementing a custom alert box to hide the header with JavaScript, I encountered an issue when trying to use it on different browsers and Android devices. The alert box appeared misplaced on the page and was too big for certain Android ...

javascriptandroidcsscross-browserhybrid

show items in UL LI elements as "inline" within a bootstrap column

Struggling with organizing UL LI items in a bootstrap setup? Trying to make them align horizontally instead of vertically but can't figure it out. Here's my code: <div class="container-fluid" style="margin-bottom:45px;"> <div cl ...

htmlcssbootstrap-4

Is there a way to prevent ggploty() from including lines connecting map points?

Using the plotly package, I converted my ggmap into HTML. However, upon applying ggplotly(), I noticed unwanted lines appearing between map points. Here is a glimpse of my dataset: df <- data.frame("Name" = c("A", "A", "A", "B","B"), ...

rggplot2r-plotlyggplotly

iOS emphasizes special characters by printing them in bold

Some parts of the website I am managing are showing German umlauts in bold (as seen in the screenshot). The font style being used is font-family: Source Sans Pro, Arial, sans-serif; with font-weight: 300. This font is sourced from Google Fonts. When I cha ...

ioscssfonts

Mastering the CSS Art of Working with Sprite Images and Their Positioning

I am currently working on an educational project as a front-end developer, where I aim to clone the Google homepage. To achieve this, I am utilizing Google's own sprite and here is the image of the sprite that I am using. https://i.stack.imgur.com/YT ...

htmlcsssasssprite

Potential Bug Detected in Internet Explorer on Mouseenter Event

I'm facing a challenge with my HTML/CSS code. I have a carousel that includes two li elements positioned absolutely on each side for navigation but they are not displaying correctly in IE versions 7-9 - they appear behind the main element regardless o ...

jqueryhtmlcssinternet-explorer

The column on the right does not extend all the way to the bottom of the page

Hello, I currently have a website with the following design: I'm looking to extend the right column all the way down to the bottom of the body, even if there's not enough content to push it down. How can I accomplish this using CSS? Here is the ...

csshtml

Steps for changing the direction of a dropdown menu to the left instead of the right

I'm having a bit of an issue with my inbox setup. I have a dropdown for it, but the dropdown is appearing off to the right and since it's at the end of my top navbar, it's not very visible. Here is the CSS code for the inbox: .notification ...

htmlcss

What is causing justifyContent: space-between not to function properly?

I want to display Text1Text2Text3Text4Text5Text6Text7 at the top with text alignment using justifyContent: 'space-between'. However, when I tried to do so, all texts ended up at the top. <div style={{display: 'flex-item', flex: 1, ...

htmlcssflexbox

How to toggle the visibility of a div with multiple checkboxes using the iCheck plugin for jQuery

I customized my checkboxes using the icheck plugin to work with both single and multiple checkboxes, including a "Check all" option. Here is an example of how it looks in HTML: HTML : <div>Using Check all function</div> <div id="action" c ...

javascriptjqueryhtmlcssicheck

Is it possible to trigger a modal to open automatically after a 3-second delay?

code: <script> $(document).ready(function() { setInterval(function() { $('#contact').modal(); }, 3000); }); </script> html code: <a href="#contact"><h4><i class="fa f ...

phphtmlcss

Strange Behavior of Anchor Tags

I've been struggling with my anchor tag not working properly. The desired URL is localhost/VShroff/home/about.php, but it keeps changing to localhost/about.php without redirecting. I've spent a long time trying to figure this out. Here is the HT ...

jqueryhtmlcssanchor

Using JavaScript to add a class when hovering over an element

I am trying to customize the ul inside one of my li elements in the nav by adding a class when hovered. However, I am encountering an issue where the menu disappears when I try to click on it after hovering over it. I want to achieve this functionality usi ...

javascriptcsshtmlsass

Problem of background and shadow blending in CSS

I'm experimenting with creating an element using a radial gradient effect. My initial approach was to use a white circular container and apply a white box shadow. However, I encountered some issues where the color of the shadow did not match the backg ...

firefoxcssshadow

I believe I am attempting to add some space to a row using CSS, or at least that's what I think I'm trying to achieve

Hey there, I need some help with adding an icon "services" section to my website. CSS is not my strongest suit, so I'm reaching out for assistance. My goal is to create blocks for the icons that don't touch the edge of the page and have a margin ...

htmlcss

The mat-select choices are experiencing rendering issues

This is the HTML code I am using to display select locations and a map below it: Here is the HTML code for the above view, <mat-form-field class="locationSelector"> <mat-select placeholder="Choose location" (ngModel)="ServiceLocations"> ...

cssangularangular-materialangular-google-maps