R/main.R

In Solatar/seeqR:

# Install Package: Ctrl + Shift + B

# devtools::document()

#' creates a ranked list from diff.Expression data
#'
#' @param sets boolean, TRUE to get gene sets. In this case main returns a list of gene set lists
#' @param species string, either "human" or "mouse"
#' @return nothing, except if sets=T in which case: a list of gene sets
#' @examples
#' setlist <- main(sets=T)
main <- function(sets=F, species="human"){
  libraries <- c("seeqR",
                 "dplyr","magrittr","tibble","data.table","openxlsx","reshape2",
                 "ggplot2","ggpubr","RColorBrewer","ggbeeswarm",
                 "GO.db","AnnotationDbi","org.Mm.eg.db","org.Hs.eg.db","homologene")
  lapply(libraries, library, character.only=T)
  if(sets){
    kegg <- qusage::read.gmt("/home/nhuber/bioinformatics/gene_sets/c2.cp.kegg.v6.2.entrez.gmt")
    reac <- qusage::read.gmt("/home/nhuber/bioinformatics/gene_sets/c2.cp.reactome.v6.2.entrez.gmt")
    onco <- qusage::read.gmt("/home/nhuber/bioinformatics/gene_sets/c6.all.v6.2.entrez.gmt")
    mll <- qusage::read.gmt("/home/nhuber/bioinformatics/gene_sets/NH_literature_MLLr_allHuman.gmt")
    custom <- qusage::read.gmt("/home/nhuber/bioinformatics/gene_sets/NH_literature_allHuman.gmt")
    if(species %in% "mouse"){
      all <- unlist(list(kegg,reac,onco)) %>% unique() %>% human2mouse()
      kegg <- lapply(kegg, function(x) all$mouseID[all$humanID %in% x])
      reac <- lapply(reac, function(x) all$mouseID[all$humanID %in% x])
      onco <- lapply(onco, function(x) all$mouseID[all$humanID %in% x])
      mll <- lapply(mll, function(x) all$mouseID[all$humanID %in% x])
    }
  }
  if(sets) list(kegg=kegg,reac=reac,onco=onco,mll=mll)
}

seekqpcr <- function(vectorlist){
  maxlength <- max(unlist(lapply(vectorlist, length)), na.rm=T)
  vectorlist <- lapply( vectorlist, function(x) c(x, rep(NA,maxlength-length(x))) )
  vectorlist2 <- do.call(cbind, vectorlist)
  vectorlist2
}

seekstring <- function(vectorX){
  unique(vectorX) %>% as.character() %>% sort() %>% data.frame(a="") %>% tibble::column_to_rownames(".")
}

#' creates a dataframe for a curled brace pointing sideways
#'
#' @param xstart number, most left part of the brace
#' @param xend number, most right part of the brace
#' @param ystart number, top end of the brace
#' @param yend number, bottom end of the brace
#' @param pointing string, either "side" or "updown"
#' @param npoints integer, number of points generated for the brace curves (basically resolution)
#' @return data.frame with x and y columns
#' @examples
#' mybrace <- seekBrace()
#' ggplot() + geom_line(aes(x,y), data=mybrace, orientation="y")
#'
#' mybrace <- seekBrace(xend=5, yend=1, pointing="updown")
#' ggplot() + geom_line(aes(x,y), data=mybrace, orientation="x")
seekBrace <- function(xstart=0, xend=1, ystart=0, yend=5, mid=0.5, pointing="side", npoints=100){
  if(mid<0.25){
    mid <- 0.25
  }else if(mid>0.75){
    mid <- 0.75
  }
  ymiddle <- yend-(yend-ystart)/2*2*mid
  xmiddle <- xend-(xend-xstart)/2*2*mid
  radiusX <- (xend-xstart)/2
  radiusY <- (yend-ystart)/2
  if(pointing %in% "side") radiusY <- radiusY/4
  if(pointing %in% "updown") radiusX <- radiusX/4

  circle <- function(x=0,y=0){
    positions <- seq(0,2*pi, length.out=npoints)
    data.frame(x=x+radiusX*cos(positions),
               y=y+radiusY*sin(positions))
  }

  #the list items were named with a brace pointing to the right or up in mind
  if(pointing %in% "side"){
    rounds <- list(
      upperQuartercircle = circle(xstart, yend-radiusY)[seq(1,npoints/4),],
      upmidQuartercircle = circle(xend, ymiddle+radiusY)[seq(npoints/2, npoints/4*3),],
      lowmidQuartercircle = circle(xend, ymiddle-radiusY)[seq(npoints/4, npoints/2),],
      lowerQuartercircle = circle(xstart, ystart+radiusY)[seq(npoints/4*3, npoints),]
    )
  }else if(pointing %in% "updown"){
    rounds <- list(
      leftQuartercircle = circle(xstart+radiusX, ystart)[seq(npoints/4, npoints/2),],
      leftmidQuartercircle = circle(xmiddle-radiusX, yend)[seq(npoints/4*3, npoints),],
      rightmidQuartercircle = circle(xmiddle+radiusX, yend)[seq(npoints/2, npoints/4*3),],
      rightQuartercircle = circle(xend-radiusX, ystart)[seq(1,npoints/4),]
    )
  }else{
    stop("error: select either ’side’ or ’updown’ for the pointing arguemnt")
  }

  mybrace <- do.call(rbind, rounds)
  mybrace
}