kable_units.r 2.17 KB
Newer Older
Grelot Frederic's avatar
Grelot Frederic committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
#' @title Replace kable with some useful
#' 
#' @param x data.frame or path to a file
#' @param read function how to read the file
#' @param align character, 
#' @param linesep integer, position of linesep
#' @param ...  some parameters that will be used by other functions
#'
#' @return A character vector of the table source code. 
#'
#' @export
#'
#' @encoding UTF-8
#' @author This is an adaptation of the function inset of the terra package.
#' 
#' @examples
#' 
#' temp = head(iris)[c(5, 1:4)]
#' temp[["Species"]] = as.character(temp[["Species"]])
#' kable_units(head(temp))
#' temp = rbind(temp, c(Species = "mean", as.list(colMeans(temp[-1]))))
#' kable_units(temp, -1)
#' temp = rbind(temp, c("units", "mm", "mm", "mm", "mm"))
#' kable_units(temp, -1)

kable_units = function(x, linesep, align = NULL, read = NULL, ...) {
    if (!is.data.frame(x) && !is.matrix(x)) {
        if (!is.null(read)) {
            value = read(x, ...)
        } else {
            value = rio::import(x, ...)
        }
    } else {
        value = as.data.frame(x)
    }

    unit = grep("^[uU]nit", value[, 1])

    if (missing(linesep)) {
        linesep = ""
    } else {
        position = if (is.logical(linesep)) which(linesep) else as.integer(linesep)
        linesep = rep("", nrow(value))
        linesep[position[position > 0]] = "\\midrule"
        linesep[nrow(value) - (length(unit) == 1) + position[position < 0]] = "\\midrule"
    }

    if(length(unit) == 1) {
        if (is.null(align)) align = c("l", rep("r", ncol(value) - 1))
        result = knitr::kable(rbind(value[-unit, ], value[unit, ]), align = align,
            booktabs = TRUE, format = "latex", row.names = FALSE, linesep = linesep, ...)
        result = kableExtra::row_spec(result, 0, bold = TRUE, hline_after = FALSE)
        result = kableExtra::row_spec(result, nrow(value) - 1, extra_latex_after = "\\midrule")
        result = kableExtra::row_spec(result, nrow(value), italic = TRUE)
    } else {
        result = knitr::kable(value, align = align,
            booktabs = TRUE, format = "latex", row.names = FALSE, linesep = linesep, ...)
        result = kableExtra::row_spec(result, 0, bold = TRUE, hline_after = FALSE)
    }
    return(result)
}