R/utils.R

In askhari139/Teams: Perform teams related analysis

RemoveAllFiles <- function() {
    filz <- list.files(".")
    sapply(filz, file.remove)
}

DirectoryNav <- function(d) {
    if (!dir.exists(d))
        dir.create(d)
    setwd(d)
}

bmodelFreqFileReader <- function(topoFile, flagFilter = T) {
    df <-
        read_csv(str_replace(topoFile, ".topo", "_finFlagFreq.csv"), lazy = F)
    if (flagFilter)
        df <- df %>% filter(flag == 1)
    return(df)
}

skewness <- function(x, finite = TRUE) {
    n = length(x)
    S = (1 / n) * sum((x - mean(x)) ^ 3) / (((1 / n) * sum((x - mean(
        x
    )) ^ 2)) ^ 1.5)
    if (finite == FALSE) {
        S = S
    } else{
        S = S * (sqrt(n * (n - 1))) / (n - 2)
    }
    return(S)
}

kurtosis <- function(x, finite) {
    n = length(x)
    K = (1 / n) * sum((x - mean(x)) ^ 4) / (((1 / n) * sum((x - mean(
        x
    )) ^ 2)) ^ 2) - 3
    if (finite == FALSE) {
        K = K
    }
    else{
        K = ((n - 1) * ((n + 1) * K - 3 * (n - 1)) / ((n - 2) * (n - 3))) + 3
    }
    return(K)
}

bimodality_coefficient <- function(x, finite = TRUE, ...) {
    if (finite == TRUE) {
        G = skewness(x, finite)
        sample.excess.kurtosis = kurtosis(x, finite)
        K = sample.excess.kurtosis
        n = length(x)
        B = ((G ^ 2) + 1) / (K + ((3 * ((
            n - 1
        ) ^ 2)) / ((n - 2) * (n - 3))))
    }
    else{
        G = skewness(x, FALSE)
        K = kurtosis(x, FALSE)
        B = ((G ^ 2) + 1) / (K)
    }
    return(B)
}

bimodality_coefficient <- function(vec)
{
    vec <- na.omit(vec)
    s <- sd(vec)
    m <- mean(vec)
    n <- length(vec)
    sk <- sum((vec - mean(vec)) ^ 3) / ((length(vec) - 1) * sd(vec) ^ 3)
    ku <- sum((vec - mean(vec)) ^ 4) / ((length(vec) - 1) * sd(vec) ^ 4) - 3
    (sk ^ 2 + 1) / (ku + 3 * ((n - 1) ^ 2) / ((n - 2) * (n - 3)))
}

cfgAnalysis <- function(net)
{
    cfgFile <- paste0(net, ".cfg")
    cfgDat <- readLines(cfgFile)
    numEdges <- cfgDat[30] %>% str_extract("\\d+") %>% as.integer
    numNodes <- cfgDat[31] %>% str_extract("\\d+") %>% as.integer
    nodes <- cfgDat[32:(31 + numNodes)] %>% str_remove("^\\d+?\t") %>%
        str_trim %>% str_replace_all(regex("\\W+"), "")
    topoDat <-
        cfgDat[(32 + numNodes):length(cfgDat)] %>% str_split("\t") %>%
        reduce(rbind.data.frame) %>% set_names(c("ID", "S", "Tar", "Type")) %>%
        mutate(
            Type = ifelse(Type == "2",-1, 1),
            S = as.integer(S),
            Tar = as.integer(Tar)
        )
    if (!file.exists(paste0(net, ".topo")))
    {
        topoDf <-
            topoDat %>% select(-ID) %>% mutate(S = nodes[S], Tar = nodes[Tar]) %>%
            set_names(c("Source", "Target", "Type")) %>%
            mutate(Type = ifelse(Type == -1, 2, 1))
        write_delim(topoDf,
                    paste0(net, ".topo"),
                    delim = " ",
                    quote = "none")
    }

    return(list(nodes, topoDat))
}

frustCalcRAC <- function(state, topoDat)
{
    sum(state[topoDat$S] * state[topoDat$Tar] == topoDat$Type) / nrow(topoDat)
}
frustCalcRAC <- frustCalcRAC %>% cmpfun


discretize <- function(net)
{
    setwd(paste0(RACIPE_WT, "/", net))
    ls <- cfgAnalysis(net)
    nodes <- ls[[1]]
    topoDat <- ls[[2]]
    solutionDf <-
        paste0(net, "_solution.dat") %>% read_delim(delim = "\t") %>%
        set_names(c("ParIndex", "nStates", "Count", nodes)) %>%
        mutate(Count = Count / max(Count)) %>%
        select(all_of(nodes), Count)
    dots <- lapply(nodes, as.symbol)
    states <- solutionDf %>% select(-Count) %>% sapply(function(x) {
        y <- (x - mean(x)) / sd(x)
        ifelse(y > 0, 1,-1)
    }) %>% data.frame %>% set_names(nodes) %>% mutate(Count = solutionDf$Count) %>%
        group_by(across(nodes)) %>% summarise(Frequency = sum(Count))
    states$Frequency <- states$Frequency / sum(states$Frequency)
    states$Frustration <- states %>% select(all_of(nodes)) %>%
        apply(1, function(x) {
            frustCalcRAC(x, topoDat)
        })
    statesDf <- states %>%
        unite(State, all_of(nodes), sep = "") %>%
        mutate(State = paste0("'", State %>% str_replace_all("-1", "0"), "'"))
    write_csv(statesDf, paste0(net, "_discreteStates.csv"), quote = "none")
    print(net)
}

SecondarySignals <- function(topoDf, sig) {
    targets <- topoDf %>% filter(Source == sig) %>%
        select(Target) %>% unlist
    secSigs <- c()

}

getEMSONodes <- function(topoFile)
{
    wd <- getwd()
    ls <- TopoToIntMat(topoFile)
    intMat <- ls[[1]]
    nodes <- ls[[2]]
    colnames(intMat) <- rownames(intMat) <- nodes
    signal <- which(apply(intMat, 2, function(x) {
        all(x == 0)
    }))
    output <- which(apply(intMat, 1, function(x) {
        all(x == 0)
    }))
    secondary_signal <- which(apply(intMat, 2, function(x) {
        if (length(signal) != 0)
            all(x[-signal] == 0)
        else
            F
    }))
    secondary_output <- which(apply(intMat, 1, function(x) {
        if (length(output) != 0)
            all(x[-output] == 0)
        else
            F
    }))
    ls <-
        readLines(str_replace(topoFile, ".topo", ".teams")) %>% str_split(",")
    names(ls[[1]]) <- paste0("E", 1:length(ls[[1]]))
    names(ls[[2]]) <- paste0("M", 1:length(ls[[2]]))
    groups <- ls %>% unlist
    sigs <- unique(nodes[c(signal, secondary_signal)])
    names(sigs) <- paste0("S", 1:length(sigs))
    outs <- unique(nodes[c(output, secondary_output)])
    if (length(outs) > 0)
        names(outs) <- paste0("O", 1:length(outs))
    nodes <- unique(c(groups, sigs, outs))
    nodesInGroups <- which(nodes %in% groups)
    dummy <- sapply(1:length(nodes), function(x) {
        n <- nodes[x]
        if (n %in% groups)
            names(nodes)[x] <<- names(groups[groups == nodes[x]])
        if (n %in% sigs)
            names(nodes)[x] <<- names(sigs[sigs == nodes[x]])
        if (n %in% outs)
            names(nodes)[x] <<- names(outs[outs == nodes[x]])
    })

    setwd(wd)
    return(nodes)
}

correlGrob <-
    function(df,
             x,
             y,
             xPos = NULL,
             yPos = NULL,
             method = "spearman")
    {
        corr <- cor.test(df[[x]], df[[y]], method = method)
        pVal <- ifelse(corr$p.value < 0.05, "*", "")
        xPos <- ifelse(!is.null(xPos), xPos, 0.5)
        yPos <- ifelse(!is.null(yPos), yPos, 0.9)
        grob <-
            grobTree(textGrob(
                paste0("\u03c1 : ", round(corr$estimate, 2), pVal),
                x = xPos,
                y = yPos,
                hjust = 0,
                gp = gpar(
                    col = "black",
                    fontsize = 18,
                    fontface = "bold"
                )
            ))
        return(grob)
    }



multiFactorCorrelation <-
    function(df,
             x,
             y,
             z,
             label = T,
             method = "spearman")
    {
        facts <- unique(df[[x]])
        df[[y]] <- as.numeric(df[[y]])
        df[[z]] <- as.numeric(df[[z]])
        s <- sapply(facts, function(f) {
            d <- df[df[[x]] == f,] %>% select(all_of(c(z, y)))
            d <- cor.test(d[[y]], d[[z]], method = method)
            if (label)
                paste0("\u03c1: ",
                       round(d$estimate, 2),
                       ifelse(d$p.value < 0.05, "*", ""))
            else
                c(d$estimate, d$p.value)
        })
        if (label)
        {
            names(s) <- facts
        }
        else
        {
            s <-
                s %>% t %>% data.frame %>% set_names(c("Correlation", "pValue")) %>%
                mutate(Factors = facts)
        }
        s

    }


mergeNets <- function(nets, nam) {
    setwd(topoFileFolder)
    df <- lapply(nets, function(net) {
        read.delim(paste0(net, ".topo"), sep = "") %>%
            mutate(Source = tolower(Source),
                   Target = tolower(Target))
    }) %>% reduce(rbind.data.frame) %>% distinct
    write_delim(df,
                paste0(nam, ".topo"),
                delim = " ",
                quote = "none")
}