Hao Zhu | 79f1e2a | 2017-06-11 20:55:30 -0400 | [diff] [blame] | 1 | #' Specify the look of the selected row |
| 2 | #' |
| 3 | #' @description This function allows users to select a row and then specify |
| 4 | #' its look. Right now it supports the following two properties: bold text and |
| 5 | #' italic text. |
| 6 | #' |
| 7 | #' @param kable_input Output of `knitr::kable()` with `format` specified |
Hao Zhu | 909ea38 | 2017-06-12 15:43:47 -0400 | [diff] [blame] | 8 | #' @param row A numeric value indicating which row to be selected. You don't |
| 9 | #' need to count in header rows or group labeling rows. |
Hao Zhu | 79f1e2a | 2017-06-11 20:55:30 -0400 | [diff] [blame] | 10 | #' @param bold A T/F value to control whether the text of the selected row |
| 11 | #' need to be bolded. |
| 12 | #' @param italic A T/F value to control whether the text of the selected row |
| 13 | #' need to be emphasized. |
Hao Zhu | 3e53e60 | 2017-07-26 12:40:57 -0400 | [diff] [blame] | 14 | #' @param monospace A T/F value to control whether the text of the selected column |
| 15 | #' need to be monospaced (verbatim) |
Hao Zhu | 79f1e2a | 2017-06-11 20:55:30 -0400 | [diff] [blame] | 16 | #' |
| 17 | #' @examples x <- knitr::kable(head(mtcars), "html") |
| 18 | #' row_spec(x, 1, bold = TRUE, italic = TRUE) |
| 19 | #' |
| 20 | #' @export |
| 21 | row_spec <- function(kable_input, row, |
Hao Zhu | 3e53e60 | 2017-07-26 12:40:57 -0400 | [diff] [blame] | 22 | bold = FALSE, italic = FALSE, monospace = FALSE) { |
Hao Zhu | 79f1e2a | 2017-06-11 20:55:30 -0400 | [diff] [blame] | 23 | if (!is.numeric(row)) { |
| 24 | stop("row must be a numeric value") |
| 25 | } |
| 26 | kable_format <- attr(kable_input, "format") |
| 27 | if (!kable_format %in% c("html", "latex")) { |
| 28 | message("Currently generic markdown table using pandoc is not supported.") |
| 29 | return(kable_input) |
| 30 | } |
| 31 | if (kable_format == "html") { |
Hao Zhu | 3e53e60 | 2017-07-26 12:40:57 -0400 | [diff] [blame] | 32 | return(row_spec_html(kable_input, row, bold, italic, monospace)) |
Hao Zhu | 79f1e2a | 2017-06-11 20:55:30 -0400 | [diff] [blame] | 33 | } |
| 34 | if (kable_format == "latex") { |
Hao Zhu | 3e53e60 | 2017-07-26 12:40:57 -0400 | [diff] [blame] | 35 | return(row_spec_latex(kable_input, row, bold, italic, monospace)) |
Hao Zhu | 79f1e2a | 2017-06-11 20:55:30 -0400 | [diff] [blame] | 36 | } |
| 37 | } |
| 38 | |
Hao Zhu | 3e53e60 | 2017-07-26 12:40:57 -0400 | [diff] [blame] | 39 | row_spec_html <- function(kable_input, row, bold, italic, monospace) { |
Hao Zhu | 79f1e2a | 2017-06-11 20:55:30 -0400 | [diff] [blame] | 40 | kable_attrs <- attributes(kable_input) |
Hao Zhu | 558c72f | 2017-07-24 15:12:00 -0400 | [diff] [blame] | 41 | kable_xml <- read_kable_as_xml(kable_input) |
Hao Zhu | 79f1e2a | 2017-06-11 20:55:30 -0400 | [diff] [blame] | 42 | kable_tbody <- xml_tpart(kable_xml, "tbody") |
| 43 | |
| 44 | group_header_rows <- attr(kable_input, "group_header_rows") |
| 45 | if (!is.null(group_header_rows)) { |
| 46 | row <- positions_corrector(row, group_header_rows, |
| 47 | length(xml_children(kable_tbody))) |
| 48 | } |
| 49 | |
| 50 | target_row <- xml_child(kable_tbody, row) |
| 51 | |
| 52 | for (i in 1:length(xml_children(target_row))) { |
| 53 | target_cell <- xml_child(target_row, i) |
| 54 | if (bold) { |
| 55 | xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"), |
| 56 | "font-weight: bold;") |
| 57 | } |
| 58 | if (italic) { |
| 59 | xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"), |
| 60 | "font-style: italic;") |
| 61 | } |
Hao Zhu | 3e53e60 | 2017-07-26 12:40:57 -0400 | [diff] [blame] | 62 | if (monospace) { |
| 63 | xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"), |
| 64 | "font-family: monospace;") |
| 65 | } |
Hao Zhu | 79f1e2a | 2017-06-11 20:55:30 -0400 | [diff] [blame] | 66 | } |
Hao Zhu | f2dfd14 | 2017-07-24 14:43:28 -0400 | [diff] [blame] | 67 | out <- as_kable_xml(kable_xml) |
Hao Zhu | 79f1e2a | 2017-06-11 20:55:30 -0400 | [diff] [blame] | 68 | attributes(out) <- kable_attrs |
| 69 | return(out) |
| 70 | } |
| 71 | |
Hao Zhu | 3e53e60 | 2017-07-26 12:40:57 -0400 | [diff] [blame] | 72 | row_spec_latex <- function(kable_input, row, bold, italic, monospace) { |
Hao Zhu | 7360428 | 2017-06-11 22:08:48 -0400 | [diff] [blame] | 73 | table_info <- magic_mirror(kable_input) |
| 74 | target_row <- table_info$contents[row + 1] |
| 75 | new_row <- latex_row_cells(target_row) |
| 76 | if (bold) { |
Hao Zhu | 35ecd27 | 2017-06-11 22:50:42 -0400 | [diff] [blame] | 77 | new_row <- lapply(new_row, function(x) { |
| 78 | paste0("\\\\bfseries{", x, "}") |
| 79 | }) |
Hao Zhu | 7360428 | 2017-06-11 22:08:48 -0400 | [diff] [blame] | 80 | } |
| 81 | if (italic) { |
Hao Zhu | 35ecd27 | 2017-06-11 22:50:42 -0400 | [diff] [blame] | 82 | new_row <- lapply(new_row, function(x) { |
| 83 | paste0("\\\\em{", x, "}") |
| 84 | }) |
Hao Zhu | 7360428 | 2017-06-11 22:08:48 -0400 | [diff] [blame] | 85 | } |
Hao Zhu | 3e53e60 | 2017-07-26 12:40:57 -0400 | [diff] [blame] | 86 | if (monospace) { |
| 87 | new_row <- lapply(new_row, function(x) { |
| 88 | paste0("\\\\ttfamily{", x, "}") |
| 89 | }) |
| 90 | } |
Hao Zhu | 35ecd27 | 2017-06-11 22:50:42 -0400 | [diff] [blame] | 91 | new_row <- paste(unlist(new_row), collapse = " & ") |
Hao Zhu | 7360428 | 2017-06-11 22:08:48 -0400 | [diff] [blame] | 92 | |
| 93 | out <- sub(target_row, new_row, as.character(kable_input), perl = T) |
| 94 | out <- structure(out, format = "latex", class = "knitr_kable") |
Hao Zhu | 32f43f7 | 2017-06-20 18:24:54 -0400 | [diff] [blame] | 95 | attr(out, "kable_meta") <- table_info |
Hao Zhu | 7360428 | 2017-06-11 22:08:48 -0400 | [diff] [blame] | 96 | return(out) |
| 97 | } |