improve color code setting
diff --git a/R/cell_spec.R b/R/cell_spec.R
index aacac76..d83a8b1 100644
--- a/R/cell_spec.R
+++ b/R/cell_spec.R
@@ -23,13 +23,15 @@
#' @param angle 0-360, degree that the text will rotate. Can be a vector.
#' @param hover_message A vector of strings to be displayed as hover message.
#' Of course, this feature is nly available in HTML.
+#' @param background_as_tile T/F value indicating if you want to have round
+#' cornered tile as background.
#'
#' @export
cell_spec <- function(x, format,
bold = F, italic = F, monospace = F,
color = NULL, background = NULL,
align = NULL, font_size = NULL, angle = NULL,
- hover_message = NULL) {
+ hover_message = NULL, background_as_tile = TRUE) {
if (missing(format) || is.null(format)) format = getOption('knitr.table.format')
if (is.null(format)) {
@@ -40,7 +42,7 @@
if (tolower(format) == "html") {
return(cell_spec_html(x, bold, italic, monospace,
color, background, align, font_size, angle,
- hover_message))
+ hover_message, background_as_tile))
}
if (tolower(format) == "latex") {
return(cell_spec_latex(x, bold, italic, monospace,
@@ -50,15 +52,21 @@
cell_spec_html <- function(x, bold, italic, monospace,
color, background, align, font_size, angle,
- hover_message) {
+ hover_message, background_as_tile) {
cell_style <- NULL
if (bold) cell_style <- paste(cell_style,"font-weight: bold;")
if (italic) cell_style <- paste(cell_style, "font-style: italic;")
if (monospace) cell_style <- paste(cell_style, "font-family: monospace;")
- if (!is.null(color)) cell_style <- paste0(cell_style, "color: ", color, ";")
+ if (!is.null(color)) {
+ cell_style <- paste0(cell_style, "color: ", html_color(color), ";")
+ }
if (!is.null(background)) {
- cell_style <- paste0(cell_style, "border-radius: 4px; padding-right: 4px",
- ";padding-left: 4px; background-color: ", background, ";")
+ cell_style <- paste0(
+ cell_style,
+ ifelse(background_as_tile, "border-radius: 4px; ", ""),
+ "padding-right: 4px; padding-left: 4px; ",
+ "background-color: ", html_color(background), ";"
+ )
}
if (!is.null(align)) {
cell_style <- paste0(cell_style, "text-align: ", align, ";")
@@ -71,7 +79,9 @@
"-webkit-transform: rotate(", angle,
"deg); -moz-transform: rotate(", angle,
"deg); -ms-transform: rotate(", angle,
- "deg); -o-transform: rotate(", angle, "deg);")
+ "deg); -o-transform: rotate(", angle,
+ "deg); transform: rotate(", angle,
+ "deg);")
}
if (!is.null(hover_message)) {
@@ -96,7 +106,7 @@
if (!is.null(background)) {
background <- latex_color(background)
x <- paste0("\\cellcolor", background, "{", x, "}")
- }
+ }
if (!is.null(align)) x <- paste0("\\multicolumn{1}{", align, "}{", x, "}")
if (!is.null(angle)) x <- paste0("\\rotatebox{", angle, "}{", x, "}")
return(x)
diff --git a/R/column_spec.R b/R/column_spec.R
index 647f689..a924439 100644
--- a/R/column_spec.R
+++ b/R/column_spec.R
@@ -178,7 +178,7 @@
}
if (!is.null(color)) {
- color <- sprintf("\\\\color{%s}", color)
+ color <- paste0("\\\\color", latex_color(color))
}
if (!is.null(background)) {
diff --git a/R/row_spec.R b/R/row_spec.R
index a6bdb59..ec8a959 100644
--- a/R/row_spec.R
+++ b/R/row_spec.R
@@ -12,8 +12,8 @@
#' need to be emphasized.
#' @param monospace A T/F value to control whether the text of the selected column
#' need to be monospaced (verbatim)
-#' @param color A character string for row text color. Here please pay
-#' attention to the differences in color codes between HTML and LaTeX.
+#' @param color A character string for row text color. For example, "red" or
+#' "#BBBBBB".
#' @param background A character string for row background color. Here please
#' pay attention to the differences in color codes between HTML and LaTeX.
#' @param align A character string for cell alignment. For HTML, possible values could
@@ -132,6 +132,7 @@
"deg); -moz-transform: rotate(", angle,
"deg); -ms-transform: rotate(", angle,
"deg); -o-transform: rotate(", angle,
+ "deg); transform: rotate(", angle,
"deg);")
}
return(x)
@@ -175,7 +176,7 @@
if (!is.null(color)) {
new_row <- lapply(new_row, function(x) {
- paste0("\\\\textcolor{", color, "}{", x, "}")
+ paste0("\\\\textcolor", latex_color(color), "{", x, "}")
})
}
diff --git a/R/spec_tools.R b/R/spec_tools.R
index 7708118..03b2539 100644
--- a/R/spec_tools.R
+++ b/R/spec_tools.R
@@ -6,13 +6,37 @@
#' @export
spec_color <- function(x, alpha = 1, begin = 0, end = 1,
direction = 1, option = "D",
- na_color = "#BBBBBBFF") {
+ na_color = "#BBBBBB") {
x <- round(rescale(x, c(1, 256)))
color_code <- viridisLite::viridis(256, alpha, begin, end, direction, option)[x]
color_code[is.na(color_code)] <- na_color
return(color_code)
}
+html_color_ <- function(color) {
+ if (substr(color, 1, 1) != "#" | nchar(color) != 9) return(color)
+ rgba_code <- col2rgb(color, alpha = TRUE)
+ rgba_code[4] <- round(rgba_code[4] / 255, 2)
+ return(paste0("rgba(", paste(rgba_code, collapse = ", "), ")"))
+}
+
+html_color <- function(colors) {
+ sapply(colors, html_color_)
+}
+
+latex_color_ <- function(color) {
+ if (substr(color, 1, 1) != "#") {
+ return(paste0("{", color, "}"))
+ } else {
+ color <- sub("#", "", color)
+ if (nchar(color) == 8) color <- substr(color, 1, 6)
+ return(paste0("[HTML]{", color, "}"))
+ }
+}
+latex_color <- function(colors) {
+ sapply(colors, latex_color_)
+}
+
#' Generate common font size for continuous values
#'
#' @param x continuous vectors of values
diff --git a/R/util.R b/R/util.R
index f80c89a..27f7d57 100644
--- a/R/util.R
+++ b/R/util.R
@@ -110,13 +110,3 @@
"\\usepackage{threeparttable}"
))
}
-
-latex_color <- function(color) {
- if (substr(color, 1, 1) != "#") {
- return(paste0("{", color, "}"))
- } else {
- color <- sub("#", "", color)
- if (nchar(color) == 8) color <- substr(color, 1, 6)
- return(paste0("[HTML]{", color, "}"))
- }
-}