keep working on style
diff --git a/R/add_header_above.R b/R/add_header_above.R
index d3634fa..4c83a8e 100644
--- a/R/add_header_above.R
+++ b/R/add_header_above.R
@@ -94,7 +94,9 @@
cline_end <- cumsum(header_df$colspan)
cline_start <- c(0, cline_end) + 1
cline_start <- cline_start[-length(cline_start)]
- cline_type <- switch(booktabs + 1, "\\\\cline{", "\\\\cmidrule(l{2pt}r{2pt}){")
+ cline_type <- switch(booktabs + 1,
+ "\\\\cline{",
+ "\\\\cmidrule(l{2pt}r{2pt}){")
cline <- paste0(cline_type, cline_start, "-", cline_end, "}")
cline <- cline[trimws(header_df$header) != ""]
cline <- paste(cline, collapse = " ")
diff --git a/R/kableExtra-package.R b/R/kableExtra-package.R
index cb4d739..11528b5 100644
--- a/R/kableExtra-package.R
+++ b/R/kableExtra-package.R
@@ -1,6 +1,6 @@
#' kableExtra
#'
-#' @importFrom stringr str_count
+#' @importFrom stringr str_count str_split
#' @importFrom xml2 read_xml xml_attr xml_has_attr xml_attr<- read_html
#' xml_child xml_children xml_name xml_add_sibling xml_add_child
#' @importFrom rvest html_table
diff --git a/R/kable_styling.R b/R/kable_styling.R
index 9bde4f0..1d357b2 100644
--- a/R/kable_styling.R
+++ b/R/kable_styling.R
@@ -11,36 +11,38 @@
#' "condensed" and "responsive".
#' @param full_width A `TRUE` or `FALSE` variable controlling whether the HTML
#' table should have 100\% width.
-#' @param float A character string determining whether and how the HTML table
+#' @param position A character string determining whether and how the HTML table
#' should float on the page. Values could be "left", "center", "right"
#' @param font_size A numeric input for table font size
#'
#' @export
kable_styling <- function(kable_input,
bootstrap_options = "basic",
- full_width = T,
- float = c("center", "left", "right"),
- font_size = NULL,
- latex_hold_position = F,
- latex_scale_down = F) {
+ latex_options = "basic",
+ full_width = NULL,
+ position = c("center", "left", "right",
+ "float_left", "float_right"),
+ font_size = NULL) {
kable_format <- attr(kable_input, "format")
if (!kable_format %in% c("html", "latex")) {
stop("Please specify output format in your kable function. Currently ",
"generic markdown table using pandoc is not supported.")
}
if (kable_format == "html") {
+ if (is.null(full_width)) full_width <- T
return(htmlTable_styling(kable_input,
bootstrap_options = bootstrap_options,
full_width = full_width,
- float = float,
+ position = position,
font_size = font_size))
}
if (kable_format == "latex") {
- return(pdfTable_styling(full_width = full_width,
- float = float,
- font_size = font_size,
- latex_hold_position = latex_hold_position,
- latex_scale_down = latex_scale_down))
+ if (is.null(full_width)) full_width <- F
+ return(pdfTable_styling(kable_input,
+ latex_options = latex_options,
+ full_width = full_width,
+ position = position,
+ font_size = font_size))
}
}
@@ -48,8 +50,10 @@
htmlTable_styling <- function(kable_input,
bootstrap_options = "basic",
full_width = T,
- float = c("center", "left", "right"),
+ position = c("center", "left", "right",
+ "float_left", "float_right"),
font_size = NULL) {
+
kable_xml <- read_xml(as.character(kable_input), options = c("COMPACT"))
# Modify class
@@ -86,15 +90,17 @@
kable_xml_style <- c(kable_xml_style, "width: auto !important;")
}
- float <- match.arg(float)
- if (float == "center") {
- kable_xml_style <- c(kable_xml_style,
- "margin-left:auto; margin-right:auto;")
- }
- if (float == "right") {
- kable_xml_style <- c(kable_xml_style,
- "float: right;")
- }
+ position <- match.arg(position)
+ position_style <- switch(
+ position,
+ center = "margin-left: auto; margin-right: auto;",
+ left = "text-align: right;",
+ right = "margin-right: 0; margin-left: auto",
+ float_left = "float: left; margin-right: 10px;",
+ float_right = "float: right; margin-left: 10px;"
+ )
+ kable_xml_style <- c(kable_xml_style, position_style)
+
if (length(kable_xml_style) != 0) {
xml_attr(kable_xml, "style") <- paste(kable_xml_style, collapse = " ")
}
@@ -104,10 +110,67 @@
# LaTeX table style
pdfTable_styling <- function(kable_input,
- full_width = T,
- float = c("center", "left", "right"),
- font_size = NULL,
- latex_hold_position = F,
- latex_scale_down = F) {
+ latex_options = "basic",
+ full_width = F,
+ position = c("center", "left", "right",
+ "float_left", "float_right"),
+ font_size = NULL) {
+ latex_options <- match.arg(
+ latex_options,
+ c("basic", "striped", "hold_position", "scale_down"),
+ several.ok = T
+ )
+
+ out = NULL
+ out <- as.character(kable_input)
+ table_info <- magic_mirror(kable_input)
+ valign <- sub("\\[", "\\\\[", table_info$valign)
+ valign <- sub("\\]", "\\\\]", valign)
+ begin_tabular <- paste0("\\\\begin\\{", table_info$tabular, "\\}", valign)
+ end_tabular <- paste0("\\\\end\\{", table_info$tabular, "\\}")
+
+
+ if ("striped" %in% latex_options) {
+ usepackage_latex("xcolor", "table")
+ out <- paste0(
+ # gray!6 is the same as shadecolor ({RGB}{248, 248, 248}) in pdf_document
+ "\\rowcolors{2}{gray!6}{white}\n",
+ out,
+ "\n\\rowcolors{2}{white}{white}"
+ )
+ }
+
+ # hold_position is only meaningful in a table environment
+ if ("hold_position" %in% latex_options & table_info$table_env) {
+ table_env <- "\\\\begin\\{table\\}"
+ out <- sub("\\\\begin\\{table\\}", "\\\\begin\\{table\\}[!h]", out)
+ }
+
+ if ("scale_down" %in% latex_options | full_width) {
+ out <- sub(begin_tabular,
+ paste0("\\\\resizebox\\{\\\\textwidth\\}\\{\\!\\}\\{",
+ begin_tabular),
+ out)
+ out <- sub(end_tabular, paste0(end_tabular, "\\}"), out)
+ }
+
+ if (full_width) {
+ size_matrix <- sapply(sapply(table_info$contents, str_split, " & "), nchar)
+ col_max_length <- apply(size_matrix, 1, max) + 4
+ col_ratio <- round(col_max_length / sum(col_max_length) * 0.9, 2)
+ col_align <- paste0("p{", col_ratio, "\\\\hsize}")
+ col_align <- paste0("{", paste(col_align, collapse = ""), "}")
+
+ out <- sub(paste0(begin_tabular, "\\{[^\\\\n]*\\}"), begin_tabular, out)
+ out <- sub(begin_tabular, paste0(begin_tabular, col_align), out)
+ }
+
+ position <- match.arg(position)
+ if (position == "right") {
+ warning("Right a")
+ }
+
+ out <- structure(out, format = "latex", class = "knitr_kable")
+ return(out)
}
diff --git a/R/magic_mirror.R b/R/magic_mirror.R
index 6502296..a926b25 100644
--- a/R/magic_mirror.R
+++ b/R/magic_mirror.R
@@ -22,19 +22,23 @@
#' Magic mirror for latex tables --------------
#' @param input The output of kable
magic_mirror_latex <- function(input){
- kable_info <- list(tabular = NULL, booktabs = NULL, align = NULL,
- ncol=NULL, nrow=NULL, colnames = NULL, rownames = NULL,
- caption = NULL, contents = NULL)
+ kable_info <- list(tabular = NULL, booktabs = FALSE, align = NULL,
+ valign = NULL, ncol = NULL, nrow = NULL, colnames = NULL,
+ rownames = NULL, caption = NULL, contents = NULL,
+ centering = FALSE, table_env = FALSE)
# Tabular
kable_info$tabular <- ifelse(
grepl("\\\\begin\\{tabular\\}", input),
"tabular", "longtable"
)
# Booktabs
- kable_info$booktabs <- ifelse(grepl("\\\\toprule", input), TRUE, FALSE)
+ kable_info$booktabs <- grepl("\\\\toprule", input)
# Align
kable_info$align <- gsub("\\|", "", str_match(
input, paste0("\\\\begin\\{", kable_info$tabular,"\\}.*\\{(.*?)\\}"))[2])
+ # valign
+ kable_info$valign <- gsub("\\|", "", str_match(
+ input, paste0("\\\\begin\\{", kable_info$tabular,"\\}(.*)\\{.*?\\}"))[2])
# N of columns
kable_info$ncol <- nchar(kable_info$align)
# Caption
@@ -55,6 +59,11 @@
kable_info$colnames <- str_split(kable_info$contents[1], " \\& ")[[1]]
# Row names
kable_info$rownames <- str_extract(kable_info$contents, "^[^ &]*")
+
+ kable_info$centering <- grepl("\\\\centering", input)
+
+ kable_info$table_env <- (!is.na(kable_info$caption) &
+ kable_info$tabular != "longtable")
return(kable_info)
}
@@ -63,7 +72,7 @@
#' @param input The output of kable
magic_mirror_html <- function(input){
kable_info <- list(table.attr = NULL, align = NULL,
- ncol=NULL, nrow=NULL, colnames = NULL, rownames = NULL,
+ ncol = NULL, nrow = NULL, colnames = NULL, rownames = NULL,
caption = NULL, contents = NULL)
kable_data <- html_table(read_html(input))
# Caption