R/df_manip.R

In vwrobel/dataexpr: All Dataexp tools for R

#' @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)
}