R/diseases.R

In askv4694/ewasvisual: Epigenominal disease studies visualization

#' Leave only one arrow between same nodes
#'
#' @param df A dataframe from makeConnections function
#' @param minLength A number that defines the minimum count value. 0 by default
#' @return A modified dataframe
#' @examples
#' df <- hideArrows(df)
#' df <- hideArrows(df, 15)
#' @export
hideArrows <- function(df, minLength = 0){
  for(i in 1:nrow(df)){
    row <- df[i,]
    check <- which(((df$from == row$to) & (df$to == row$from)) |
                     ((df$count < minLength) & (df$from != 1)))
    if ((length(check) > 0 & df$arrows[i] != "")){
      df[check,"arrows"] <- ""
      df[check,"to"] <- 0
    }
  }
  return(df)
}

#' Make nodes for visNetwork
#'
#' @param df A dataframe from function makeConnections
#' @return A new dataframe of nodes that will be used in visNetwork
#' @example
#' nodes <- makeNodes(df)
#' @export
makeNodes <- function(df){
  df <- df[union(df$from[df$to > 0],df$to),]
  nodes <- data.frame(id = df$id,
                      group = df$trait,
                      label = df$count,
                      value = df$count,
                      shape = df$shape,
                      title = apply(df, 1, function(x)
                        paste(x["Study.id"],"<br>","PMID:",x["PMID"],
                              "<br>",x["trait"], sep = "\n")),
                      color = df$color
                      )
  if("group" %in% colnames(df)){
    nodes$group = df$group
  }
  return(nodes)
}

#' Make edges for visNetwork
#'
#' @param df A dataframe from function makeConnections()
#' @param len A number that defines the minimum length for each edge
#' @return A new dataframe with edges for visNetwork
#' @example
#' edges <- makeEdges(df, 100)
#' @export
makeEdges <- function(df, len){
  edges <- data.frame(from = df$from,
                      to = df$to,
                      value = df$coef,
                      color = df$edgeCol,
                      title = df$coef
                      )
  if(len > 0){
    edges$length = len
  }
  return(edges)
}

#' Get visNetwork plot
#'
#' @param data A dataframe that was generated by makeConnections
#' @param edgeLen A number that defines minimum edge length.
#' 100 by default
#' @param path A path to a folder where the graph should be saved.
#' 0 by default that indicates it wil not be saved. Must have .html extension
#' @return A visNetwork graph
#' @examples
#' network <- getVisNetwork(data)
#' network <- getVisNetwork(data, 'C:/../home/test.html')
#' @export
getVisNetwork <- function(data, edgeLen = 100, path = 0){
  if(nrow(data) == 0){
    print("There are no networks to show.")
  }
  if(!requireNamespace("magrittr", quietly = TRUE)){
    print("Package 'magrittr' is required.")
    return()
  }

  if(!requireNamespace("visNetwork", quietly = TRUE)){
    print("Package 'visNetwork' is required.")
    return()
  }
  data$arrows <- "to"
  data <- hideArrows(data, edgeLen)
  nodes <- makeNodes(data)
  edges <- makeEdges(data, edgeLen)

  `%>%` <- magrittr::`%>%`
  v <-visNetwork::visNetwork(nodes, edges, width = "100%" , height = 700) %>%
    visNetwork::visNodes(scaling = list(label = list(enabled = T))) %>%
    visNetwork::visClusteringOutliers(1)

  if("group" %in% colnames(data)){
    ledges <- data.frame(color = unique(data$color),
                         label = unique(data$group),
                         shape = "circle")
   v <- v %>% visNetwork::visLegend(useGroups = F, addEdges = ledges)
  }


  if(typeof(path) == "character"){
    visNetwork::visSave(v, path,
            selfcontained = TRUE, background = "white")
  }
  return(v)
}

#' Generate infromation from connection data
#'
#' @param data A dataframe that was generated by makeConnections
#' @param study A single name or an array of study names that will be included
#' @return Returns a dataframe with id, connecting from id, id's study name,
#' id's trait, connecting to id, id's study name, trait and overlap count
#' between them - matching cg positions count
#' @example
#' df <- getSimilarTraits(data2, study = c("ES00034, "ES00035))
#' @export
getSimilarTraits <- function(data,study = 0){
  tdata <- data
  if (typeof(study) == "character"){
    id <- data$id[data$Study.id %in% study][1]
    tdata <- data[(data$from %in% id) |
                ((data$from == 1) & (data$to %in% id)),]
  }
  dat <- data.frame("id" = numeric(), "f.id" = numeric(),
                   "fStudy.id" = character(), "f.trait" = character(),
                   "t.id" = numeric(), "tStudy.id" = character(),
                   "t.trait" = character(), "coef" = numeric(),
                   "count" = numeric(), "PMID" = character(),
                   "Ancestry" = character(),
                   stringsAsFactors = FALSE)
  for(i in 1:nrow(tdata)){
    tid <- tdata$to[i]
    dat[i,] <- c(tdata$id[i], tdata$from[i], tdata$Study.id[i],
                 tdata$trait[i], tdata$to[i], data$Study.id[tid],
                 data$trait[tid], tdata$coef[i], tdata$count[i],
                 tdata$PMID[i], tdata$Ancestry[i])
  }
  return(dat)
}

#######################
########################
#########################

#' A dataframe for stacked histogram
#'
#' @param data A data matrix with no modifications
#' @param positions An array of cg positions in new study
#' @param traits An array of trait names that was to be compared to.
#' By default set to 0 - compare to all
#' @param anno Annotation file for sorting probes by chromosomes and positions.
#' 0 by default - not used
#' @return A dataframe for visNetwork graph
#' @examples
#' df <- dfForHistogram(data, positions)
#' #' df <- dfForHistogram(data, positions, "Smoking", anno)
#' @export
dfForHistogram <- function(data, positions = 0, traits = 0, anno = 0){

  traitst <- traits
  traits <- unique(data$Trait)
  if (typeof(traitst) == "character"){
    traits <- unique(traitst)
    data <- data[data$Trait %in% traits,]
  }
  posd <- unique(positions)
  pos <- unique(data$Probe.id)
  if (typeof(posd) == "character"){
    data <- data[data$Probe.id %in% posd,]
    pos <- unique(positions)
  }
  flag <- FALSE
  if(typeof(anno) == "list"){
    anno <- anno[,c("Probe.id", "Chr", "Pos")]
    anno <- anno[anno$Probe.id %in% pos,]
    flag <- TRUE
  }

  df <- data.frame("Probe.id" = character(), "Trait" = character(),
             "count" = numeric(), "chr" = numeric(), "pos" = numeric(),
             stringsAsFactors = FALSE)
  id <- 1
  for(i in 1:length(pos)){
    for(j in 1:length(traits)){
      count <- length(data$Probe.id[data$Probe.id == pos[i] &
                                    data$Trait == traits[j]])
      if(count > 0){
        df[id,1] <- pos[i]
        df[id,2] <- traits[j]
        df[id,3] <- count
        df[id,4] <- ifelse(flag,
                           anno$Chr[anno$Probe.id == pos[i]], NA)
        df[id,5] <- ifelse(flag,
                           anno$Pos[anno$Probe.id == pos[i]], NA)
        id <- id +1
      }
    }
  }
  if(flag){
    df<- df[order(df$chr, df$pos),]
  }
  return(df)
}

#' A stacked histogram
#'
#' @param df A dataframe from function dfForHistrogram
#' @param minCount A number that will limit position count in traits for show
#' @param path A path to save file to. 0 by default
#' @return A highcharter stacked histogram
#' @examples
#' hist <- stackedHistogram(df)
#' hist <- stackedHistogram(df, 0, path = 'C:/.../histogram.html')
#' @export
stackedHistogram <- function(df, minCount = 1, path = 0){

  if(!requireNamespace("magrittr", quietly = TRUE)){
    print("Package 'magrittr' is required.")
    return()
  }
  if(!requireNamespace("highcharter", quietly = TRUE)){
    print("Package 'highcharter' is required.")
    return()
  }
  if(!requireNamespace("htmlwidgets", quietly = TRUE)){
    print("Package 'htmlwidgets' is required.")
    return()
  }
  if("chr" %in% colnames(df)){
    df <- df[order(df$chr, df$pos),]
  }

  `%>%` <- magrittr::`%>%`

  hc <- df[df$count > minCount,] %>%
    highcharter::hchart(
      'column',  highcharter::hcaes(x = "Probe.id", y = 'count', group = 'Trait'),
      stacking = "normal",
    ) %>%
    highcharter::hc_xAxis(title = list(text = 'CG positions'))

  if(typeof(path) == "character"){
    htmlwidgets::saveWidget(hc, path)
  }
  return(hc)
}


#' Print basic instructions how to
#'
#' @example
#' instruction()
#' @export
instructions <- function(){
  print('HOW TO USE')
  print('---------------')
  print('data <- readRDS("mockdata/wholeMatrix.rds")')
  print('Preferably save cg positions in an array')
  print('Specific studies can be chosen too')

  print('traits <- traitTable(data)')

  print('data1 <- processData(data)')

  print("By default the next function will use 15th study from matrix
        generated by processData")
  print('data2 <- makeConnections(data1, name = "studyName",
        type = "", traitMatrix = traits)')

  print("-------------------------------------------")
  print("Please be aware that this part is optional")
  print("If there is a need for colors and a legend then please provide
        a dataframe with studynames and trait group like this:")
  print('group <- readRDS("mockdata/groups.rds")')
  print("#Please be noted that these groups are provided for data stored in mockdata file")

  print("colors <- rainbow(21) ##21 is a number which defines how
        many colors will be there")
  print("colors <- colors[c(-1)] ##First must not be red because
        it's your study color by default")
  print("data2 <- groupColors(data2, group, colors)")
  print("-------------------------------------------")

  print("Possibility to check connections in terminal window")
  print('similar <- getSimilarTraits(data2)')

  print('network <- getVisNetwork(data2, edgeLen = 400)')
  print("Larger networks are easier to understand if nodes are not as close - provide edgeLen")


  print("The other graph which allows to check position overlaps")
  print("positions <- names(which(data1[,19] == TRUE))")
  print('df <- dfForHistogram(data, positions)')
  print('hist <- stackedHistogram(df, 0)')

}