-
Notifications
You must be signed in to change notification settings - Fork 9
/
Copy pathcreate_knitr_table.R
176 lines (147 loc) · 6.05 KB
/
create_knitr_table.R
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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
#' @title Create an output-independent, well formatted kable table
#'
#' @param data_table data.frame, tibble, named matrix or a knitr_kable object.
#' @param caption A table caption, defaults to empty \code{NA}.
#' @param digits Number of digits to display in the case of numeric variables.
#' @param col.names The col.names parameter of the kable table, if \code{NULL},
#' filled with the names of the \code{data_table}.
#' @param width_unit Defaults to \code{"cm"}.
#' @param col_width Defaults to \code{NULL}. In this case all col_align parameters
#' will be \code{"c"} for centered.
#' @param col_align Defaults to \code{NULL}. In this case \code{'l'} for the
#' first column and \code{'r'} for the rest of the columns,
#' i.e.\code{"l", "c", ..., "c"}
#' @param border_right_cols, Defaults to \code{NULL}.
#' In this case \code{TRUE} for the first column and \code{FALSE}
#' for the rest of the columns, i.e.\code{T, F, ..., F}
#' @param bold_cols Defaults to \code{NULL}. In this case none of the
#' the columns are bold, i.e. identical to \code{F, F, ..., F}.
#' @param bootstrap_options Defaults to \code{c("striped", "hover", "condensed")} and
#' only used for \code{output_format = "html"}.
#' @param latex_options Defaults to \code{NULL)}.
#' @param output_format Defaults to \code{'html'}. Alternatives are \code{'latex'}.
#' \code{'image'}, recommended for Word files, is removed because it depends
#' on magick which is not available on all R platforms.
#' @param keep_pdf Defaults to \code{FALSE} and only used if \code{output_format = 'image'}.
#' @param latex_header_includes Currently defaults to \code{c(
#' "\\usepackage[magyar]{babel}",
#' "\\usepackage[utf8]{inputenc}")}
#' It can be any valid latex option setting, but if packages are used, the
#' packages must be installed on your Latex engine.
#' @importFrom knitr kable is_latex_output is_html_output
#' @importFrom kableExtra kable_styling column_spec
#' @keywords internal
#' @examples
#' foo = data.frame (
#' observation = c("indicator1", "indicator2", "indicator3"),
#' indicator_1 = c(100,105,95),
#' indicator_2 = c(102,104,76)
#' )
#'
create_knitr_table <- function (
data_table,
digits = NULL,
caption = NA,
col.names = NULL,
col_width= NULL,
width_unit = "cm",
col_align =NULL,
border_right_cols = NULL,
bold_cols = NULL,
bootstrap_options = c("striped", "hover", "condensed"),
latex_options = NULL,
output_format = NULL,
keep_pdf = FALSE,
latex_header_includes = c(
"\\usepackage[magyar]{babel}",
"\\usepackage[utf8]{inputenc}")
) {
if ( is.null(ncol(data_table))) {
stop ( "Empty data table inputed.")
}
if( is_latex_output() ) {
output_format <- "latex"
} else if ( is_html_output()) {
output_format <- "html"
}
if ( is.null(output_format)) {
output_format <- 'image'
}
if (! output_format %in% c("latex", 'html') ) {
output_format <- 'image'
}
if ( ! "knitr_kable" %in% class(data_table) ) {
#If columns are not named, col heads are names of data.frame
if ( is.null(col.names)) {
col.names <- names(data_table)
}
#Create default column alignment settings if necessary
if ( is.null(col_align)) {
col_align <- c('l', rep('c', (ncol(data_table)-1)))
}
#Create default column alignment settings if necessary
if ( is.null(border_right_cols) ) {
border_right_cols <- c(TRUE, rep(FALSE, ncol(data_table)-1))
}
#Create default column alignment settings if necessary
if ( is.null(bold_cols) ) {
bold_cols <- rep(FALSE, ncol(data_table))
}
if ( is.null(col_width)){
col_width <- c(2, 18/(ncol(data_table)-1))
}
#Create default digit settings----
if ( is.null(digits)) {
digits <- getOption("digits")
} else if ( digits < 0 ) { digits <- getOption("digits") }
col_width <- paste0(col_width, width_unit)
if ( output_format == "image" ) {
table_format <- 'latex'
} else if ( output_format %in% c("latex", "html") ) {
table_format <- output_format
} else {
table_format <- "html"
}
#Create the basic table
knitr_table <- knitr::kable(
data_table,
digits = digits,
format = table_format,
format.args = (list(big.mark = " ", decimal.mark = ",")),
caption = caption,
booktabs = TRUE,
col.names = col.names,
align= col_align
)
}
## bootstrap_options for html tables and latex_options for latex
if ( table_format == "html") {
if ( is.null(bootstrap_options)) {
if (table_format == "html")
bootstrap_options <- c("striped", "hover", "condensed")
}
knitr_table <- kableExtra::kable_styling(
kable_input = knitr_table,
bootstrap_options = bootstrap_options)
}
if ( table_format %in% c("latex", "image") ) {
if ( is.null(latex_options) ) {
if ( table_format == "latex") latex_options <- c("scale_down", "striped") #, "HOLD_position"
if ( table_format == "image") latex_options <- c("scale_down", "striped") #"HOLD_position"
}
knitr_table <- kableExtra::kable_styling(kable_input = knitr_table,
latex_options = latex_options)
}
### Add formatting elements from vectors col by col
i <- 1
while (i <= ncol(data_table)) {
knitr_table <- kableExtra::column_spec(kable_input = knitr_table,
column = i,
width = col_width[i],
bold = bold_cols[i],
border_right = border_right_cols[i]
)
i <- i + 1
} #end of while loop
knitr_table
} #end of function