Search code examples
rreporthtmlwidgetsformattable

Equal column widths on R formattable

I am using the formattable package to make some reports directly from R and I need the columns using the normalize_bar "style" have the same width, so that can compare value between columns.

The following example shows two columns that have very similar values (minimum and maximum values are equal) but have a different width, losing the graphic detail of the bar ("Test.number.1.score" and "test2_score").

library(formattable)

df <- data.frame(
  id = 1:10,
  name = c("Bob", "Ashley", "James", "David", "Jenny", 
           "Hans", "Leo", "John", "Emily", "Lee"), 
  age = c(28, 27, 30, 28, 29, 29, 27, 27, 31, 30),
  grade = c("C", "A", "A", "C", "B", "B", "B", "A", "C", "C"),
  Test.number.1.score = c(8.9, 9.5, 9.6, 8.9, 9.1, 9.3, 9.3, 9.9, 8.5, 8.6),
  test2_score = c(9.1, 9.1, 9.2, 9.1, 8.9, 8.5, 9.9, 9.3, 9.1, 8.6),
  final_score = c(9, 9.3, 9.4, 9, 9, 8.9, 9.25, 9.6, 8.8, 8.7),
  registered = c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE),
  stringsAsFactors = FALSE)

formattable(df, list(
  age = color_tile("white", "orange"),
  grade = formatter("span", style = x ~ ifelse(x == "A", 
                                               style(color = "green", font.weight = "bold"), NA)),
  area(col = c(Test.number.1.score, test2_score)) ~ normalize_bar("pink", 0.2),
  final_score = formatter("span",
                          style = x ~ style(color = ifelse(rank(-x) <= 3, "green", "gray")),
                          x ~ sprintf("%.2f (rank: %02d)", x, rank(-x))),
  registered = formatter("span",
                         style = x ~ style(color = ifelse(x, "green", "red")),
                         x ~ icontext(ifelse(x, "ok", "remove"), ifelse(x, "Yes", "No")))
))

Thanks in advance.

Solution

  • Directly using the formatter solves this problem. You want the same width for both the columns.

    When I looked at the code of color_bar function I found that their is a width attribute for the width of colored portion. Basically I am modifying that property to get the desired result.

    first set a width say 150 px

    fixedWidth = 150

    and change your formattable function call to

    formattable(df, list(
    age = color_tile("white", "orange"),
    grade = formatter("span", style = x ~ ifelse(x == "A", 
                                                 style(color = "green", font.weight = "bold"), NA)),
    test2_score = formatter(.tag = "span", style = function(x) style(display = "inline-block", 
                                                                     direction = "rtl", `border-radius` = "4px", `padding-right` = "2px", 
                                                                     `background-color` = csscolor("pink"), width = paste(fixedWidth*proportion(x),"px",sep="") )),
    Test.number.1.score = formatter(.tag = "span", style = function(x) style(display = "inline-block", 
                                                                             direction = "rtl", `border-radius` = "4px", `padding-right` = "2px", 
                                                                             `background-color` = csscolor("pink"), width = paste(fixedWidth*proportion(x),"px",sep="") )),


    final_score = formatter("span",
                            style = x ~ style(color = ifelse(rank(-x) <= 3, "green", "gray")),
                            x ~ sprintf("%.2f (rank: %02d)", x, rank(-x))),
    registered = formatter("span",
                           style = x ~ style(color = ifelse(x, "green", "red")),
                           x ~ icontext(ifelse(x, "ok", "remove"), ifelse(x, "Yes", "No")))
))

    Note the width = paste(fixedWidth*proportion(x),"px",sep="") for changing to fixed width and csscolor("pink") to change the color to pink inside formatter.

    The desired output looks like below The Final Report

    UPDATE

    Or more cleanly you can create your own color_bar function namely my_color_bar by changing its width argument as below

    my_color_bar <- function (color = "lightgray", fixedWidth=150,...) 
{
        formatter("span", style = function(x) style(display = "inline-block", 
                                                direction = "rtl", `border-radius` = "4px", `padding-right` = "2px", 
                                                `background-color` = csscolor(color), width = paste(fixedWidth*proportion(x),"px",sep=""), 
                                                ...))
}

    And use it in your formattable function call as

    formattable(df, list(
    age = color_tile("white", "orange"),
    grade = formatter("span", style = x ~ ifelse(x == "A", 
                                                 style(color = "green", font.weight = "bold"), NA)),
    test2_score = my_color_bar(color="pink",width = 100),
    Test.number.1.score = my_color_bar(color="pink",width=100),


    final_score = formatter("span",
                            style = x ~ style(color = ifelse(rank(-x) <= 3, "green", "gray")),
                            x ~ sprintf("%.2f (rank: %02d)", x, rank(-x))),
    registered = formatter("span",
                           style = x ~ style(color = ifelse(x, "green", "red")),
                           x ~ icontext(ifelse(x, "ok", "remove"), ifelse(x, "Yes", "No")))
))