R/Script_ISNs_library.R

In FedericoMelograna/ISN: ISN modeling

# Pipeline on the server


# Libraries and functions -------------------------------------------------
library(WGCNA)
library(dplyr)
library("lionessR")
library("SummarizedExperiment")
library(data.table)

# Main function implemented
Lioness_computer = function (x, f = netFun) 
{
  print(f)
  is.se <- inherits(x, "SummarizedExperiment")
  is.matrix <- is.matrix(x)
  if (!is.function(f)) {
    stop("please use a function")
  }
  if (is.matrix(x)) {
    print("take numeric matrix as input, ignore parameter for assay")
  }
  if (is.se) {
    colData <- SummarizedExperiment::colData(x)
    x <- SummarizedExperiment::assay(x)
  }
  if (!is.matrix(x)) {
    print("please use a numeric matrix as input")
  }
  if (is.null(colnames(x))) {
    colnames(x) = seq_len(ncol(x))
  }
  nrsamples <- ncol(x)
  samples <- colnames(x)
  net <- f(t(x))   # net <-(abs(bicor(t(x))))^2	 
  # print(net[1:5,1:5])
  agg <- c(net)
  lionessOutput <- matrix(NA, nrow(net) * ncol(net), nrsamples + 
                            2)
  colnames(lionessOutput) <- c("reg", "tar", samples)
  lionessOutput[, 1] <- rep(row.names(net), ncol(net))
  lionessOutput[, 2] <- rep(colnames(net), each = nrow(net))
  lionessOutput <- as.data.frame(lionessOutput, stringsAsFactors = FALSE)
  print("CHECKPOINT 1")
  lionessOutput_recons <- matrix(NA, nrow(net) * ncol(net), nrsamples + 
                                   2)
  colnames(lionessOutput_recons) <- c("reg", "tar", samples)
  lionessOutput_recons[, 1] <- rep(row.names(net), ncol(net))
  lionessOutput_recons[, 2] <- rep(colnames(net), each = nrow(net))
  lionessOutput_recons <- as.data.frame(lionessOutput_recons, stringsAsFactors = FALSE)

  print("CHECKPOINT 2")
  
  for (i in seq_len(nrsamples)) {
    
    ss <- c(f(t(x[,-i])) ) #     ss <- c(cor(t(x[,-i]) ) ) #     # ss <- c((abs(bicor(t(x[, -i]))))^2 )    
    print("CHECKPOINT 3") #
    lionessOutput[, i + 2] <- nrsamples * (agg -ss) + ss
    lionessOutput_recons[, i + 2] <- ss
  }
  edges <- paste(lionessOutput[, 1], lionessOutput[, 2], sep = "_")
  nodes <- colnames(x)
  rowData <- S4Vectors::DataFrame(row.names = edges, reg = lionessOutput[, 
                                                                         1], tar = lionessOutput[, 2])
  if (!is.se) {
    colData <- S4Vectors::DataFrame(row.names = nodes, sample = nodes)
  }
  print("CHECKPOINT 4")
  
  se <- SummarizedExperiment::SummarizedExperiment(assays = list(lioness = as.matrix(lionessOutput[, 3:ncol(lionessOutput)]),
                                                                 perturbed = as.matrix(lionessOutput_recons[, 3:ncol(lionessOutput_recons)])),
                                                   colData = colData, rowData = rowData)
  return(se)
}


# Function examples -------------------------------------------------------


wgcna_bicor_function = function(x, esp)
{
  function(x)
  {
    abs(bicor(x)) ^ esp
  }
}  

cor_function = function(x)
{
  cor(x)
}  


# Eliminate repeated row -- slow passage ----------------------------------

eliminate_repeated_row = function(names_r_net){
  
  length(names_r_net)
  to_eliminate_r = c()
  for (i in 1:(length(names_r_net)-1))
  {
    elemento = names_r_net[i]
    fin = unlist(strsplit(elemento,"_"))
    fin2 = paste0(fin[2],sep = "_", fin[1])
    value = match(fin2,names_r_net, nomatch = 0)
    if (value > i)
    {
      to_eliminate_r= append(to_eliminate_r, value)
    }
    if (i %% 100 == 0){ print(i)}
  }
  return(to_eliminate_r)
}