add strikeout and underline to spec functions
diff --git a/R/cell_spec.R b/R/cell_spec.R
index bc7af1e..154d5f0 100644
--- a/R/cell_spec.R
+++ b/R/cell_spec.R
@@ -8,6 +8,10 @@
#' @param bold T/F for font bold.
#' @param italic T/F for font italic.
#' @param monospace T/F for font monospaced (verbatim)
+#' @param underline A T/F value to control whether the text of the selected row
+#' need to be underlined
+#' @param strikeout A T/F value to control whether the text of the selected row
+#' need to be stricked out.
#' @param color A character string for text color. Here please pay
#' attention to the differences in color codes between HTML and LaTeX.
#' @param background A character string for background color. Here please
@@ -44,6 +48,7 @@
#' @export
cell_spec <- function(x, format,
bold = FALSE, italic = FALSE, monospace = FALSE,
+ underline = FALSE, strikeout = FALSE,
color = NULL, background = NULL,
align = NULL, font_size = NULL, angle = NULL,
tooltip = NULL, popover = NULL, link = NULL,
@@ -61,19 +66,19 @@
}
if (tolower(format) == "html") {
- return(cell_spec_html(x, bold, italic, monospace,
+ return(cell_spec_html(x, bold, italic, monospace, underline, strikeout,
color, background, align, font_size, angle,
tooltip, popover, link, extra_css,
escape, background_as_tile))
}
if (tolower(format) == "latex") {
- return(cell_spec_latex(x, bold, italic, monospace,
+ return(cell_spec_latex(x, bold, italic, monospace, underline, strikeout,
color, background, align, font_size, angle, escape,
latex_background_in_cell))
}
}
-cell_spec_html <- function(x, bold, italic, monospace,
+cell_spec_html <- function(x, bold, italic, monospace, underline, strikeout,
color, background, align, font_size, angle,
tooltip, popover, link, extra_css,
escape, background_as_tile) {
@@ -83,6 +88,10 @@
cell_style <- paste(cell_style, ifelse(italic, "font-style: italic;", ""))
cell_style <- paste(cell_style,
ifelse(monospace, "font-family: monospace;", ""))
+ cell_style <- paste(cell_style,
+ ifelse(underline, "text-decoration: underline;", ""))
+ cell_style <- paste(cell_style,
+ ifelse(strikeout, "text-decoration: line-through;", ""))
if (!is.null(color)) {
cell_style <- paste0(cell_style, "color: ", html_color(color), ";")
}
@@ -148,13 +157,15 @@
return(x)
}
-cell_spec_latex <- function(x, bold, italic, monospace,
+cell_spec_latex <- function(x, bold, italic, monospace, underline, strikeout,
color, background, align, font_size, angle, escape,
latex_background_in_cell) {
if (escape) x <- escape_latex(x)
- if (bold) x <- paste0("\\bfseries{", x, "}")
- if (italic) x <- paste0("\\em{", x, "}")
- if (monospace) x <- paste0("\\ttfamily{", x, "}")
+ x <- sprintf(ifelse(bold, "\\textbf{%s}", "%s"), x)
+ x <- sprintf(ifelse(italic, "\\em{%s}", "%s"), x)
+ x <- sprintf(ifelse(monospace, "\\ttfamily{%s}", "%s"), x)
+ x <- sprintf(ifelse(underline, "\\underline{%s}", "%s"), x)
+ x <- sprintf(ifelse(strikeout, "\\sout{%s}", "%s"), x)
if (!is.null(color)) {
color <- latex_color(color)
x <- paste0("\\textcolor", color, "{", x, "}")
diff --git a/R/column_spec.R b/R/column_spec.R
index 0c351a3..f747dd2 100644
--- a/R/column_spec.R
+++ b/R/column_spec.R
@@ -13,6 +13,10 @@
#' 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 underline A T/F value to control whether the text of the selected row
+#' need to be underlined
+#' @param strikeout A T/F value to control whether the text of the selected row
+#' need to be stricked out.
#' @param color A character string for column text color. Here please pay
#' attention to the differences in color codes between HTML and LaTeX.
#' @param background A character string for column background color. Here please
@@ -32,7 +36,8 @@
#' @export
column_spec <- function(kable_input, column,
width = NULL, bold = FALSE, italic = FALSE,
- monospace = FALSE, color = NULL, background = NULL,
+ monospace = FALSE, underline = FALSE, strikeout = FALSE,
+ color = NULL, background = NULL,
border_left = FALSE, border_right = FALSE,
extra_css = NULL) {
if (!is.numeric(column)) {
@@ -46,12 +51,14 @@
if (kable_format == "html") {
return(column_spec_html(kable_input, column, width,
bold, italic, monospace,
+ underline, strikeout,
color, background,
border_left, border_right, extra_css))
}
if (kable_format == "latex") {
return(column_spec_latex(kable_input, column, width,
bold, italic, monospace,
+ underline, strikeout,
color, background,
border_left, border_right))
}
@@ -59,6 +66,7 @@
column_spec_html <- function(kable_input, column, width,
bold, italic, monospace,
+ underline, strikeout,
color, background,
border_left, border_right, extra_css) {
kable_attrs <- attributes(kable_input)
@@ -104,6 +112,14 @@
xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
"font-family: monospace;")
}
+ if (underline) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ "text-decoration: underline;")
+ }
+ if (strikeout) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ "text-decoration: line-through;")
+ }
if (!is.null(color)) {
xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
"color: ", color, ";")
@@ -137,6 +153,7 @@
column_spec_latex <- function(kable_input, column, width,
bold, italic, monospace,
+ underline, strikeout,
color, background,
border_left, border_right) {
table_info <- magic_mirror(kable_input)
@@ -151,7 +168,7 @@
table_info$align_vector_origin[column],
function(x) {
latex_column_align_builder(
- x, width, bold, italic, monospace,
+ x, width, bold, italic, monospace, underline, strikeout,
color, background, border_left, border_right)
}
))
@@ -175,6 +192,7 @@
}
latex_column_align_builder <- function(x, width, bold, italic, monospace,
+ underline, strikeout,
color, background,
border_left, border_right) {
extra_align <- ""
@@ -194,8 +212,9 @@
background <- paste0("\\\\columncolor", latex_color(background))
}
- latex_array_options <- c("\\\\bfseries", "\\\\em", "\\\\ttfamily")[
- c(bold, italic, monospace)]
+ latex_array_options <- c("\\\\bfseries", "\\\\em", "\\\\ttfamily",
+ "\\\\underline", "\\\\sout")[
+ c(bold, italic, monospace, underline, strikeout)]
latex_array_options <- c(latex_array_options, extra_align,
color, background)
latex_array_options <- paste0(
diff --git a/R/row_spec.R b/R/row_spec.R
index 88bf499..5a3c617 100644
--- a/R/row_spec.R
+++ b/R/row_spec.R
@@ -10,8 +10,12 @@
#' need to be bolded.
#' @param italic A T/F value to control whether the text of the selected row
#' need to be emphasized.
-#' @param monospace A T/F value to control whether the text of the selected column
+#' @param monospace A T/F value to control whether the text of the selected row
#' need to be monospaced (verbatim)
+#' @param underline A T/F value to control whether the text of the selected row
+#' need to be underlined
+#' @param strikeout A T/F value to control whether the text of the selected row
+#' need to be stricked out.
#' @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
@@ -32,6 +36,7 @@
#' @export
row_spec <- function(kable_input, row,
bold = FALSE, italic = FALSE, monospace = FALSE,
+ underline = FALSE, strikeout = FALSE,
color = NULL, background = NULL, align = NULL,
font_size = NULL, angle = NULL, extra_css = NULL) {
if (!is.numeric(row)) {
@@ -44,16 +49,19 @@
}
if (kable_format == "html") {
return(row_spec_html(kable_input, row, bold, italic, monospace,
+ underline, strikeout,
color, background, align, font_size, angle,
extra_css))
}
if (kable_format == "latex") {
return(row_spec_latex(kable_input, row, bold, italic, monospace,
+ underline, strikeout,
color, background, align, font_size, angle))
}
}
row_spec_html <- function(kable_input, row, bold, italic, monospace,
+ underline, strikeout,
color, background, align, font_size, angle,
extra_css) {
kable_attrs <- attributes(kable_input)
@@ -70,7 +78,8 @@
original_header_row <- xml_child(kable_thead, length(xml_children(kable_thead)))
for (theader_i in 1:length(xml_children(original_header_row))) {
target_header_cell <- xml_child(original_header_row, theader_i)
- xml_cell_style(target_header_cell, bold, italic, monospace, color, background,
+ xml_cell_style(target_header_cell, bold, italic, monospace,
+ underline, strikeout, color, background,
align, font_size, angle, extra_css)
}
row <- row[row != 0]
@@ -89,7 +98,8 @@
target_row <- xml_child(kable_tbody, j)
for (i in 1:length(xml_children(target_row))) {
target_cell <- xml_child(target_row, i)
- xml_cell_style(target_cell, bold, italic, monospace, color, background,
+ xml_cell_style(target_cell, bold, italic, monospace,
+ underline, strikeout, color, background,
align, font_size, angle, extra_css)
}
}
@@ -101,7 +111,8 @@
return(out)
}
-xml_cell_style <- function(x, bold, italic, monospace, color, background,
+xml_cell_style <- function(x, bold, italic, monospace,
+ underline, strikeout, color, background,
align, font_size, angle, extra_css) {
if (bold) {
xml_attr(x, "style") <- paste0(xml_attr(x, "style"),
@@ -115,6 +126,14 @@
xml_attr(x, "style") <- paste0(xml_attr(x, "style"),
"font-family: monospace;")
}
+ if (underline) {
+ xml_attr(x, "style") <- paste0(xml_attr(x, "style"),
+ "text-decoration: underline;")
+ }
+ if (strikeout) {
+ xml_attr(x, "style") <- paste0(xml_attr(x, "style"),
+ "text-decoration: line-through;")
+ }
if (!is.null(color)) {
xml_attr(x, "style") <- paste0(xml_attr(x, "style"),
"color: ", color, ";")
@@ -148,6 +167,7 @@
}
row_spec_latex <- function(kable_input, row, bold, italic, monospace,
+ underline, strikeout,
color, background, align, font_size, angle) {
table_info <- magic_mirror(kable_input)
out <- enc2utf8(as.character(kable_input))
@@ -162,6 +182,7 @@
for (i in row) {
target_row <- table_info$contents[i]
new_row <- latex_new_row_builder(target_row, bold, italic, monospace,
+ underline, strikeout,
color, background, align, font_size, angle)
out <- sub(target_row, new_row, out, perl = T)
}
@@ -172,11 +193,12 @@
}
latex_new_row_builder <- function(target_row, bold, italic, monospace,
+ underline, strikeout,
color, background, align, font_size, angle) {
new_row <- latex_row_cells(target_row)
if (bold) {
new_row <- lapply(new_row, function(x) {
- paste0("\\\\bfseries{", x, "}")
+ paste0("\\\\textbf{", x, "}")
})
}
if (italic) {
@@ -189,7 +211,16 @@
paste0("\\\\ttfamily{", x, "}")
})
}
-
+ if (underline) {
+ new_row <- lapply(new_row, function(x) {
+ paste0("\\\\underline{", x, "}")
+ })
+ }
+ if (strikeout) {
+ new_row <- lapply(new_row, function(x) {
+ paste0("\\\\sout{", x, "}")
+ })
+ }
if (!is.null(color)) {
new_row <- lapply(new_row, function(x) {
paste0("\\\\textcolor", latex_color(color), "{", x, "}")
diff --git a/R/zzz.R b/R/zzz.R
index 226ece6..74e9464 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -12,5 +12,6 @@
usepackage_latex("pdflscape")
usepackage_latex("tabu")
usepackage_latex("threeparttable")
+ usepackage_latex("ulem", "normalem")
}
}
diff --git a/docs/awesome_table_in_html.html b/docs/awesome_table_in_html.html
index 3931fb2..1fc1d9b 100644
--- a/docs/awesome_table_in_html.html
+++ b/docs/awesome_table_in_html.html
@@ -3551,7 +3551,7 @@
2
</td>
<td style="text-align:center;">
-1
+0
</td>
</tr>
<tr>
@@ -3567,7 +3567,7 @@
4
</td>
<td style="text-align:center;">
-1
+0
</td>
</tr>
<tr>
@@ -3583,7 +3583,7 @@
6
</td>
<td style="text-align:center;">
-0
+1
</td>
</tr>
<tr>
@@ -3610,7 +3610,7 @@
9
</td>
<td style="text-align:center;">
-0
+1
</td>
</tr>
<tr>
@@ -3667,7 +3667,7 @@
15
</td>
<td style="text-align:center;">
-1
+0
</td>
</tr>
</tbody>
diff --git a/docs/awesome_table_in_pdf.Rmd b/docs/awesome_table_in_pdf.Rmd
index 580495b..acd8a75 100644
--- a/docs/awesome_table_in_pdf.Rmd
+++ b/docs/awesome_table_in_pdf.Rmd
@@ -18,6 +18,7 @@
- \usepackage{pdflscape}
- \usepackage{tabu}
- \usepackage{threeparttable}
+ - \usepackage[normalem]{ulem}
vignette: >
%\VignetteIndexEntry{Create Awesome PDF Table with knitr::kable and kableExtra}
%\VignetteEngine{knitr::rmarkdown}
@@ -82,6 +83,7 @@
- \usepackage{pdflscape}
- \usepackage{tabu}
- \usepackage{threeparttable}
+ - \usepackage[normalem]{ulem}
```
## Plain LaTeX
@@ -199,6 +201,7 @@
kable(dt, format = "latex", booktabs = T) %>%
kable_styling("striped", full_width = F) %>%
column_spec(7, border_left = T, bold = T) %>%
+ row_spec(1, strikeout = T) %>%
row_spec(3:5, bold = T, color = "white", background = "black")
```
diff --git a/docs/awesome_table_in_pdf.pdf b/docs/awesome_table_in_pdf.pdf
index 93ea77f..3f5fb7a 100644
--- a/docs/awesome_table_in_pdf.pdf
+++ b/docs/awesome_table_in_pdf.pdf
Binary files differ