# Internal functions not for exporting
#--------- run_cmd: run commands via bash or wsl ---------#
run_cmd <- function(cmd, intern = FALSE) {
if (.Platform$OS.type != "windows") {
system(command = cmd, intern = intern)
} else {
shell(cmd = shQuote(cmd), shell = "bash", intern = intern)
}
}
#--------- check_cmd: check whether a command exists in bash/wsl ---------#
check_cmd <- function(cmd) {
test <- sprintf("type -P %s &>//dev//null && echo 'Found' || echo 'Not Found'", cmd)
run_cmd(test, intern = TRUE)
}
#--------- extract_numbers: extract numbers from a list of strings ---------#
extract_numbers <- function(string) {
x <- unlist(regmatches(string, gregexpr('\\(?[0-9,.]+', string)))
x <- as.numeric(gsub('\\(', '', gsub(',', '', x)))
return(x)
}
#--------- reduce_path: remove file path and extension from file name ---------#
#' @importFrom tools file_path_sans_ext
reduce_path <- function(filename) {
pattern1 <- "\\.(fastq|fq|fasta|fa|sam|bam|bed|bedgraph|bg|bigwig|bw)"
pattern2 <- "\\.(txt|tar|bz2|bz|csv|zip|tsv).*"
pattern3 <- "_fastqc$"
reduced <- tools::file_path_sans_ext(basename(filename))
reduced <- sub(pattern1, "", reduced)
reduced <- sub(pattern2, "", reduced)
(reduced <- sub(pattern3, "", reduced))
}
#--------- move_file: convenience function to move files ---------#
move_file <- function(tomove, to) {
if (length(tomove) > 1) {
lapply(tomove, function(x) {
file.rename(from = x, to = file.path(to, x))
})
} else {
file.rename(from = tomove, to = file.path(to, tomove))
}
}
#--------- remove_file: convenience function to remove a file or directory ---------#
remove_file <- function(file) {
if (file.exists(file)) {
file.remove(file)
} else {
return("file not found")
}
}
#--------- create_dir: convenience function to create a dir ---------#
create_dir <- function(dir, recurs = TRUE) {
if (!dir.exists(dir)) {
dir.create(path = dir, showWarnings = TRUE, recursive = recurs)
return("directory created")
} else {
return("directory already exists")
}
}
#--------- error messages: custom messages ----------#
#' @importFrom crayon red bold yellow underline green italic
give_error <- function(message) {stop(paste0("\n", crayon::red(crayon::bold(message), "\n")))}
give_warning <- function(message) {cat(crayon::yellow(crayon::underline(message)))}
give_note <- function(message) {cat(crayon::green(crayon::italic(message)))}
#-------- create design matrix ----------#
#' @importFrom stats formula
make_design <- function(sample.info) {
batch <- ifelse("batch" %in% colnames(sample.info), TRUE, FALSE)
design <- stats::formula(paste0("~0+", "condition",
ifelse(batch, paste0("+batch"), "")))
design
}
#--------- convert ENSEMBL to SYMBOL --------#
#' @importFrom dplyr select distinct left_join
#' @importFrom magrittr set_colnames
ens2symbol <- function(result, columns.of.interest, colnames, species) {
grch38 <- grcm38 <- symbol <- NULL
if (species == "human") ann <- grch38 %>% dplyr::select(gene = "ensgene", symbol) %>% dplyr::distinct()
if (species == "mouse") ann <- grcm38 %>% dplyr::select(gene = "ensgene", symbol) %>% dplyr::distinct()
output <- cbind(gene = row.names(result), as.data.frame(result), stringsAsFactors = FALSE)[, columns.of.interest] %>%
dplyr::left_join(ann, by = "gene") %>% magrittr::set_colnames(colnames)
output$symbol[which(output$symbol == "")] <- NA
colnames(output) <- colnames
return(output)
}
#--------- convert ENSEMBL to ENTREZ --------#
#' @importFrom dplyr select distinct left_join
#' @importFrom magrittr set_colnames
ens2entrez <- function(result, columns.of.interest, colnames, species) {
grch38 <- grcm38 <- symbol <- NULL
if (species == "human") ann <- grch38 %>% dplyr::select(gene = "ensgene", "entrez") %>% dplyr::distinct()
if (species == "mouse") ann <- grcm38 %>% dplyr::select(gene = "ensgene", "entrez") %>% dplyr::distinct()
output <- cbind(gene = row.names(result), as.data.frame(result), stringsAsFactors = FALSE)[, columns.of.interest] %>%
dplyr::left_join(ann, by = "gene") %>% magrittr::set_colnames(colnames)
output$entrez[which(output$symbol == "")] <- NA
colnames(output) <- colnames
return(output)
}
#--------- common theme for plots -------------#
#' @importFrom ggplot2 theme_bw theme element_text element_line element_blank element_rect unit
theme_publication <- function() {
(ggplot2::theme_bw(base_size = 14) +
ggplot2::theme(
plot.title = ggplot2::element_text(face = "bold",
size = ggplot2::rel(1.2),
hjust = 0.5),
text = ggplot2::element_text(size = 12),
panel.background = ggplot2::element_rect(colour = NA),
plot.background = ggplot2::element_rect(colour = NA),
panel.border = ggplot2::element_rect(colour = NA),
axis.title = ggplot2::element_text(face = "bold",
size = ggplot2::rel(1)),
axis.title.y = ggplot2::element_text(angle = 90,
vjust = 2),
axis.title.x = ggplot2::element_text(vjust = -0.2),
axis.text = ggplot2::element_text(),
axis.line = ggplot2::element_line(colour = "black"),
axis.ticks = ggplot2::element_line(),
panel.grid.major = ggplot2::element_line(colour = "#f0f0f0"),
panel.grid.minor = ggplot2::element_blank(),
legend.key = ggplot2::element_rect(colour = NA),
legend.key.size = ggplot2::unit(0.7, "lines"),
legend.spacing = ggplot2::unit(0, "cm"),
legend.title = ggplot2::element_text(face = "italic"),
plot.margin = ggplot2::unit(c(10, 5, 5, 5), "mm"),
strip.background = ggplot2::element_rect(colour = "#f0f0f0",
fill = "#f0f0f0"),
strip.text = ggplot2::element_text(face = "bold"))
)
}
#----------------- W2U paths: Convert Windows paths to linux for WSL ---------------#
convert_paths <- function(x) {
if (.Platform$OS.type == "windows") {
paths <- lapply(x, function(y) {
cmd <- sprintf("wslpath %s", y)
run_cmd(cmd, intern = TRUE)
}) %>% unlist()
return(paths)
} else {
return(x)
}
}
#----------------- check if a variable is defined in R ---------------#
is.defined <- function(sym) {
sym <- deparse(substitute(sym))
env <- parent.frame()
exists(sym, env)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.