#' transposing fread
#'
#' @param input input data
#' @param remove_null TRUE in default to reduce data
#' @param ss name of spreadsheet software. Error values from the given ss are replaced by NA
#' @param args1 additional arguments given to first fread
#' @param args2 additional arguments given to second fread
#'
#' @importFrom data.table fread
#' @importFrom stringr str_replace_all
#'
#' @export
tfread <- function(input, remove_null = TRUE, ss = c('excel', 'libre'), args1 = list(), args2 = list()) {
#ABOUT ARGUMENTS#################################################
#remove_null = TRUE removes null rows and columns
#ss: spread sheet
#args1: list of arguments to fread input data
#args2: list of arguments to fread the transposed input data
#When there are duplicated arguments in args1 and args2, the prior argument has priority
#i.e., args1 = list(a = 1, a = 2, b = 3) is equivalent to args1 = list(a = 1, b = 3)
#FOR TEST#######################################################
#input = "ND0207.160129.csv"; remove_null = TRUE; ss = c('excel', 'libre'); args1 = list(); args2 = list()
#read table as character matrix##################################
#complete arguments
args1 <- c(args1, input = input, header = FALSE, colClasses = 'character')
#remove duplicated arguments
args1 <- args1[!duplicated(names(args1))]
#1st fread
d <- as.matrix(do.call(data.table::fread, args1))
rm(args1)
#replace error messages to blank#####################################
if(stringr::str_detect(tolower(ss[1]), '^(excel|libre)$')) {
d <- matrix(stringr::str_replace_all(d, '^#.*\\!$', ''), nrow = nrow(d), ncol = ncol(d))
}
#replace \n to space
d <- matrix(stringr::str_replace_all(d, '\n', ' '), nrow = nrow(d), ncol = ncol(d))
#whether to remove rows and cols with no data############################
if(remove_null){
filled <- d != ''
filled[is.na(filled)] <- FALSE
rows <- rowSums(filled) != 0
cols <- colSums(filled) != 0
} else {
rows <- rep(TRUE, nrow(d))
cols <- rep(TRUE, ncol(d))
}
#transpose data########################################################
args2 <- c(input = paste(apply(d[rows, cols], 2, paste, collapse = '\t'), collapse = '\n'), sep = '\t', args2, header = TRUE)
args2 <- args2[!duplicated(names(args2))]
do.call(data.table::fread, args2)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.