#' @export
rep.row <- function(x, n) {
df <- data.frame(matrix(rep(x, each = n), nrow = n))
names(df) <- names(x)
df
}
#' @export
rep.col <- function(x, n) {
df <- data.frame(matrix(rep(x, each = n), ncol = n, byrow = TRUE))
names(df) <- names(x)
df
}
#' @export
prefix_columns <- function(df, prefix, ignore_first = 1) {
names(df) <-
paste0(c(rep("", ignore_first), rep(prefix, ncol(df) - ignore_first)), names(df))
df
}
#' @export
suffix_columns <- function(df, suffix, ignore_first = 1) {
names(df) <-
paste0(names(df), c(rep("", ignore_first), rep(suffix, ncol(df) - ignore_first)))
df
}
#' @export
df_to_xts <- function(df, date_col="date", format="%Y-%m-%d %H:%M:%S"){
if (!is.POSIXct(df[[date_col]])){
df[,date_col] <- as.POSIXct(df[,date_col], tz=Sys.getenv("TZ"), format = format)
}
ts <- xts(df %>% dplyr::select_(paste0("-",date_col)), order.by=df[[date_col]])
ts
}
#' @export
xts_to_df<- function(xts){
df <- data.frame(date=index(xts), coredata(xts))
df
}
#' @export
format_data_table <- function(df, var_def, scrollY='400px'){
res_fdf <- format_df(df, var_def)
fdf <- res_fdf$df
num_cols <- res_fdf$num_cols
int_cols <- res_fdf$int_cols
pct_cols <- res_fdf$pct_cols
new_cols_digit <- res_fdf$new_cols_digit
new_cols_unit <- res_fdf$new_cols_unit
digits_cat <- res_fdf$digits_cat
dt <-
DT::datatable(
fdf,
selection = "single",
extensions = c('Scroller', 'FixedColumns'),
rownames = FALSE,
options = list(
pageLength = 50,
deferRender = TRUE,
lengthChange = FALSE,
stateSave = TRUE,
autoWidth = TRUE,
language = list(url = '//cdn.datatables.net/plug-ins/1.10.11/i18n/French.json'),
searching = TRUE,
scroller = TRUE,
scrollX = TRUE,
scrollY = scrollY,
class = 'cell-border stripe',
fixedColumns = list(leftColumns = 1, heightMatch = 'none')
)
) %>%
formatCurrency(
columns = int_cols,
currency = '',
mark = " ",
interval = 3,
digits = 0
)
for (cat in digits_cat) {
digits_cols <- num_cols[num_cols %in% which(new_cols_digit == cat)]
dt <- dt %>%
formatRound(columns = digits_cols,
mark = " ",
digits = cat)
}
dt <- dt %>% formatPercentage(
columns = pct_cols
)
dt
}
#' @export
format_df <- function(df, var_def){
old_cols <- colnames(df)
new_cols <- old_cols
match2 <- match(old_cols,var_def$name)
match1 <- !is.na(match2)
match2 <- match2[match1]
match3 <- match2 %>% sort()
new_cols[match1] <- paste0(as.character(var_def$display_name[match3]),
ifelse(var_def$unit[match3]=="", "", " ("),
as.character(var_def$unit[match3]),
ifelse(var_def$unit[match3]=="", "", ")"))
df[, rank(match2)] <- df[, rank(match3)]
colnames(df) <- new_cols
new_cols_digit <- rep(NULL, length(new_cols))
new_cols_digit[match1] <- var_def$digit[match3]
new_cols_unit <- rep(NULL, length(new_cols))
new_cols_unit[match1] <- var_def$unit[match3] %>% as.character()
not_num_cols <- which(!as.vector(sapply(df, is.numeric)))
num_cols <- which(as.vector(sapply(df, is.numeric)))
int_cols <- num_cols[num_cols %in% which(new_cols_digit==0)]
pct_cols <- num_cols[num_cols %in% which(new_cols_unit=="%")]
digits_cat <- unique(new_cols_digit)
digits_cat <- digits_cat[digits_cat>0]
list(df = df,
not_num_cols = not_num_cols,
num_cols = num_cols,
int_cols = int_cols,
pct_cols = pct_cols,
new_cols_digit = new_cols_digit,
new_cols_unit = new_cols_unit,
digits_cat = digits_cat)
}
#' @export
get_cols <- function(df, split = "[.]") {
cols <- colnames(df)
cols_split <- strsplit(cols, split)
cols_res <- do.call(rbind, cols_split)
return(cols_res)
}
#' @export
sel_cols <- function(df, indexes, split = "[.]") {
cols_res <- get_cols(df)
is_col_sel <- rep(T, nrow(cols_res))
for (i in 1:length(indexes)) {
index <- indexes[i]
if (index == "")
next()
is_col_sel <- is_col_sel & (cols_res[, i] == index)
}
return(is_col_sel)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.