Hao Zhu | 86a4dd0 | 2020-08-23 22:58:45 -0400 | [diff] [blame] | 1 | #' Convert selected RStudio markdown table to kable code |
| 2 | #' |
| 3 | #' @description RStudio 1.4 comes with a very nice live markdown table editor |
| 4 | #' (see https://bookdown.org/yihui/rmarkdown-cookbook/rstudio-visual.html for |
| 5 | #' details). For those who need to further customize those markdown tables, you |
| 6 | #' can use this function/addin to convert the markdown table to necessary R |
| 7 | #' code to render that table using `kableExtra`. |
| 8 | #' |
| 9 | #' @export |
| 10 | md_table_to_kable <- function() { |
| 11 | current_selection <- rstudioapi::getSourceEditorContext() |
| 12 | x <- current_selection$selection[[1]]$text |
| 13 | if (x == "") { |
| 14 | stop("You have not yet selected any markdown table text!") |
| 15 | } |
| 16 | x <- trimws(x) |
| 17 | x_lines <- stringr::str_split(x, '\n')[[1]] |
| 18 | if (!stringr::str_detect(x_lines[2], '^\\|[\\-\\:]')) { |
| 19 | stop("Unexpected form of markdown table. This function only works for ", |
| 20 | "regular markdown tables. Compact mode is not supported.") |
| 21 | } |
| 22 | |
| 23 | # Get caption if available |
| 24 | if (stringr::str_detect(x_lines[length(x_lines)], '^: ')) { |
| 25 | caption <- sub('^: ', '', x_lines[length(x_lines)]) |
| 26 | x_lines <- x_lines[-c(length(x_lines) - 1, length(x_lines))] |
| 27 | } else { |
| 28 | caption <- NULL |
| 29 | } |
| 30 | n_row <- length(x_lines) - 2 |
| 31 | |
| 32 | # get content matrix |
| 33 | col_length <- stringr::str_split(x_lines[2], "\\|")[[1]] |
| 34 | col_length <- col_length[-c(1, length(col_length))] |
| 35 | n_col <- length(col_length) |
| 36 | col_length <- nchar(col_length) |
| 37 | col_offset <- cumsum(col_length + 1) + 1 |
| 38 | col_offset <- c(1, col_offset[-n_col]) |
| 39 | start_pos <- col_offset + 2 |
| 40 | end_pos <- col_length + col_offset - 1 |
| 41 | content_matrix <- matrix( |
| 42 | unlist(lapply(x_lines, substring, start_pos, end_pos)), |
| 43 | ncol = n_col, byrow = TRUE |
| 44 | ) |
| 45 | |
| 46 | # Get alignment |
| 47 | alignment <- vapply(content_matrix[2, ], function(x) { |
| 48 | if (stringr::str_sub(x, -1, -1) == ":") { |
| 49 | if (stringr::str_sub(x, 1, 1) == ":") { |
| 50 | return('c') |
| 51 | } else { |
| 52 | return('r') |
| 53 | } |
| 54 | } else { |
| 55 | return('l') |
| 56 | } |
| 57 | }, 'character', USE.NAMES = FALSE) |
| 58 | |
| 59 | content_matrix <- trimws(content_matrix) |
| 60 | col_names <- content_matrix[1, ] |
| 61 | |
| 62 | content_matrix <- content_matrix[-c(1, 2), ] |
| 63 | content_matrix <- sim_double_escape(content_matrix) |
| 64 | |
| 65 | str_parts <- c( |
| 66 | '```{r}\n', |
| 67 | 'data.frame(\n' |
| 68 | ) |
| 69 | |
| 70 | if (n_col > 1) { |
| 71 | for (i in seq(n_col - 1)) { |
| 72 | str_parts[i + 2] <- paste0( |
| 73 | ' `Col', i, '` = ', vector_str(content_matrix[, i]), ', \n' |
| 74 | ) |
| 75 | } |
| 76 | } |
| 77 | str_parts[n_col + 2] <- paste0( |
| 78 | ' `Col', n_col, '` = ', vector_str(content_matrix[, n_col]), '\n' |
| 79 | ) |
| 80 | str_parts[n_col + 3] <- paste0( |
| 81 | ') %>%\n kableExtra::kbl(\n escape = F, \n col.names = ', |
| 82 | if (all(col_names == "")) 'NULL' else vector_str(col_names), |
| 83 | ', \n align = ', vector_str(alignment), ', \n caption = ', |
| 84 | if (is.null(caption)) 'NULL' else paste0('"', caption, '"'), |
| 85 | ',\n booktable = T\n ) %>%\n kableExtra::kable_styling()\n```' |
| 86 | ) |
| 87 | out <- paste(str_parts, collapse = "") |
| 88 | |
| 89 | rstudioapi::insertText(location = current_selection$selection[[1]]$range, |
| 90 | text = out, |
| 91 | id = current_selection$id) |
| 92 | |
| 93 | return(out) |
| 94 | } |
| 95 | |
| 96 | vector_str <- function(v) { |
| 97 | return(paste0('c(', paste0('"', v, '"', collapse = ", "), ')')) |
| 98 | } |