Nothing
# MultiSEp Induced Dependency (CRISPR vs expression) function
mts_InducedDependency <- function(resultList=resultList, exprsMatrix=exprsMatrix, crisprMatrix=crisprMatrix, fcVal=fcVal, pVal=pVal, cores=cores)
{
# Error catching - from input
if(missing(cores))
{
cores <- 1
message("1 core selected")
} else if(cores == 0)
{
stop("cores should be >= 1")
} else {
message(paste(cores, " cores selected", sep=""))
}
if(missing(fcVal))
{
fcVal <- 0.1
message("Fold Change Threshold not entered, using 0.1")
} else {
message(paste("Fold Change Threshold: ", fcVal, sep=""))
}
if(missing(pVal))
{
pVal <- 0.1
message("P-Value Threshold not entered, using 0.1")
} else {
message(paste("P-Value Threshold: ", pVal, sep=""))
}
if(missing(exprsMatrix))
{
stop("No Expression Matrix Provided")
} else {
if (!is.data.frame(exprsMatrix)) {
stop("exprsMatrix must be a data frame")
}
}
if(missing(crisprMatrix))
{
stop("No CRISPR Matrix Provided")
} else {
if (!is.data.frame(crisprMatrix)) {
stop("crisprMatrix must be a data frame")
}
}
if(missing(resultList))
{
stop("No results list provided - please run mts_clusterAvg to generate")
} else {
if (!inherits(resultList, "list")) {
stop("resultList must be a list of data frames")
}
}
# Line up the input matrices
exprsMatrix <- exprsMatrix[,which(colnames(exprsMatrix) %in% colnames(crisprMatrix))]
crisprMatrix <- crisprMatrix[,which(colnames(crisprMatrix) %in% colnames(exprsMatrix))]
# List of lists
list5groupP <- list(data.frame(0))
list4groupP <- list(data.frame(0))
list3groupP <- list(data.frame(0))
list2groupP <- list(data.frame(0))
cow2 <- 0
cow3 <- 0
cow4 <- 0
cow5 <- 0
message(paste("Gene Number: ", length(resultList), sep=""))
for(i in 1:length(resultList))
{
if(length(resultList[[i]]) < 2)
{
message(paste("No data for ", i, sep=""))
}
else
{
res1 <- resultList[[i]][[1]]
res2 <- resultList[[i]][[2]]
if(length(which(res1[,1] == "NaN")) > 0) {
res1 <- res1[-which(res1[,1] == "NaN"),]
} else {
res1 <- res1
}
if(dim(resultList[[i]][[1]])[2] == 5)
{
cl1 <- res2[which(res2[,3] == 1),1]
cl2 <- res2[which(res2[,3] == 2),1]
cl3 <- res2[which(res2[,3] == 3),1]
cl4 <- res2[which(res2[,3] == 4),1]
cl5 <- res2[which(res2[,3] == 5),1]
len1 <- length(as.numeric(exprsMatrix[rownames(res1)[1],cl1]))
len2 <- length(as.numeric(exprsMatrix[rownames(res1)[1],cl2]))
len3 <- length(as.numeric(exprsMatrix[rownames(res1)[1],cl3]))
len4 <- length(as.numeric(exprsMatrix[rownames(res1)[1],cl4]))
len5 <- length(as.numeric(exprsMatrix[rownames(res1)[1],cl5]))
if(len1 > 2 & len2 > 2)
{
pv1 <- unlist(pbmclapply(1:dim(res1)[1], function(x){
return(tryCatch(t.test(as.numeric(crisprMatrix[rownames(res1)[x],cl1]), as.numeric(crisprMatrix[rownames(res1)[x],cl2]))$p.value, error = function(e) NA_real_))
}, mc.cores=cores))
}
else
{
pv1 <- NA
}
if(len2 > 2 & len3 > 2)
{
pv2 <- unlist(pbmclapply(1:dim(res1)[1], function(x){
return(tryCatch(t.test(as.numeric(crisprMatrix[rownames(res1)[x],cl2]), as.numeric(crisprMatrix[rownames(res1)[x],cl3]))$p.value, error = function(e) NA_real_))
}, mc.cores=cores))
}
else
{
pv2 <- NA
}
if(len4 > 2 & len3 > 2)
{
pv3 <- unlist(pbmclapply(1:dim(res1)[1], function(x){
return(tryCatch(t.test(as.numeric(crisprMatrix[rownames(res1)[x],cl3]), as.numeric(crisprMatrix[rownames(res1)[x],cl4]))$p.value, error = function(e) NA_real_))
}, mc.cores=cores))
}
else
{
pv3 <- NA
}
if(len5 > 2 & len4 > 2)
{
pv4 <- unlist(pbmclapply(1:dim(res1)[1], function(x){
return(tryCatch(t.test(as.numeric(crisprMatrix[rownames(res1)[x],cl4]), as.numeric(crisprMatrix[rownames(res1)[x],cl5]))$p.value, error = function(e) NA_real_))
}, mc.cores=cores))
}
else
{
pv4 <- NA
}
fc1 <- res1[,1] - res1[,2]
fc2 <- res1[,2] - res1[,3]
fc3 <- res1[,3] - res1[,4]
fc4 <- res1[,4] - res1[,5]
dfOUT <- as.data.frame(cbind(res1, fc1, fc2, fc3, fc4, pv1, pv2, pv3, pv4, len1, len2, len3, len4, len5), stringsAsFactors=FALSE)
dfOUT$gene1 <- names(resultList)[i]
dfOUT$DEMETER_Gene <- rownames(dfOUT)
cow5 <- cow5 + 1
list5groupP[[cow5]] <- dfOUT
}
else if(dim(resultList[[i]][[1]])[2] == 4)
{
cl1 <- res2[which(res2[,3] == 1),1]
cl2 <- res2[which(res2[,3] == 2),1]
cl3 <- res2[which(res2[,3] == 3),1]
cl4 <- res2[which(res2[,3] == 4),1]
len1 <- length(as.numeric(exprsMatrix[rownames(res1)[1],cl1]))
len2 <- length(as.numeric(exprsMatrix[rownames(res1)[1],cl2]))
len3 <- length(as.numeric(exprsMatrix[rownames(res1)[1],cl3]))
len4 <- length(as.numeric(exprsMatrix[rownames(res1)[1],cl4]))
if(len1 > 2 & len2 > 2)
{
pv1 <- unlist(pbmclapply(1:dim(res1)[1], function(x){
return(tryCatch(t.test(as.numeric(crisprMatrix[rownames(res1)[x],cl1]), as.numeric(crisprMatrix[rownames(res1)[x],cl2]))$p.value, error = function(e) NA_real_))
}, mc.cores=cores))
}
else
{
pv1 <- NA
}
if(len2 > 2 & len3 > 2)
{
pv2 <- unlist(pbmclapply(1:dim(res1)[1], function(x){
return(tryCatch(t.test(as.numeric(crisprMatrix[rownames(res1)[x],cl2]), as.numeric(crisprMatrix[rownames(res1)[x],cl3]))$p.value, error = function(e) NA_real_))
}, mc.cores=cores))
}
else
{
pv2 <- NA
}
if(len4 > 2 & len3 > 2)
{
pv3 <- unlist(pbmclapply(1:dim(res1)[1], function(x){
return(tryCatch(t.test(as.numeric(crisprMatrix[rownames(res1)[x],cl3]), as.numeric(crisprMatrix[rownames(res1)[x],cl4]))$p.value, error = function(e) NA_real_))
}, mc.cores=cores))
}
else
{
pv3 <- NA
}
fc1 <- res1[,1] - res1[,2]
fc2 <- res1[,2] - res1[,3]
fc3 <- res1[,3] - res1[,4]
dfOUT <- as.data.frame(cbind(res1, fc1, fc2, fc3, pv1, pv2, pv3, len1, len2, len3, len4), stringsAsFactors=FALSE)
dfOUT$gene1 <- names(resultList)[i]
dfOUT$DEMETER_Gene <- rownames(dfOUT)
cow4 <- cow4 + 1
list4groupP[[cow4]] <- dfOUT
}
else if(dim(resultList[[i]][[1]])[2] == 3)
{
cl1 <- res2[which(res2[,3] == 1),1]
cl2 <- res2[which(res2[,3] == 2),1]
cl3 <- res2[which(res2[,3] == 3),1]
len1 <- length(as.numeric(exprsMatrix[rownames(res1)[1],cl1]))
len2 <- length(as.numeric(exprsMatrix[rownames(res1)[1],cl2]))
len3 <- length(as.numeric(exprsMatrix[rownames(res1)[1],cl3]))
if(len1 > 2 & len2 > 2)
{
pv1 <- unlist(pbmclapply(1:dim(res1)[1], function(x){
return(tryCatch(t.test(as.numeric(crisprMatrix[rownames(res1)[x],cl1]), as.numeric(crisprMatrix[rownames(res1)[x],cl2]))$p.value, error = function(e) NA_real_))
}, mc.cores=cores))
}
else
{
pv1 <- NA
}
if(len2 > 2 & len3 > 2)
{
pv2 <- unlist(pbmclapply(1:dim(res1)[1], function(x){
return(tryCatch(t.test(as.numeric(crisprMatrix[rownames(res1)[x],cl2]), as.numeric(crisprMatrix[rownames(res1)[x],cl3]))$p.value, error = function(e) NA_real_))
}, mc.cores=cores))
}
else
{
pv2 <- NA
}
fc1 <- res1[,1] - res1[,2]
fc2 <- res1[,2] - res1[,3]
dfOUT <- as.data.frame(cbind(res1, fc1, fc2, pv1, pv2, len1, len2, len3), stringsAsFactors=FALSE)
dfOUT$gene1 <- names(resultList)[i]
dfOUT$DEMETER_Gene <- rownames(dfOUT)
cow3 <- cow3 + 1
list3groupP[[cow3]] <- dfOUT
}
else if(dim(resultList[[i]][[1]])[2] == 2)
{
cl1 <- res2[which(res2[,3] == 1),1]
cl2 <- res2[which(res2[,3] == 2),1]
len1 <- length(as.numeric(exprsMatrix[rownames(res1)[1],cl1]))
len2 <- length(as.numeric(exprsMatrix[rownames(res1)[1],cl2]))
if(len1 > 2 & len2 > 2)
{
pv1 <- unlist(pbmclapply(1:dim(res1)[1], function(x){
return(tryCatch(t.test(as.numeric(crisprMatrix[rownames(res1)[x],cl1]), as.numeric(crisprMatrix[rownames(res1)[x],cl2]))$p.value, error = function(e) NA_real_))
}, mc.cores=cores))
}
else
{
pv1 <- NA
}
fc1 <- res1[,1] - res1[,2]
dfOUT <- as.data.frame(cbind(res1, fc1, pv1, len1, len2), stringsAsFactors=FALSE)
dfOUT$gene1 <- names(resultList)[i]
dfOUT$DEMETER_Gene <- rownames(dfOUT)
cow2 <- cow2 + 1
list2groupP[[cow2]] <- dfOUT
}
else
{
# Do Nothing
}
}
message(paste("Expression Gene Result: ", i, sep=""))
}
message("Generating mts_InducedDependency results")
# n=2 processing
if(cow2 > 0)
{
for(i in 1:length(list2groupP))
{
list2groupP[[i]]$qv1 <- p.adjust(list2groupP[[i]]$pv1, method="BH")
}
list2groupP2 <- list(data.frame(0))
for(i in 1:length(list2groupP))
{
tabSUB <- list2groupP[[i]]
list2groupP2[[i]] <- tabSUB[which(tabSUB$fc1 > fcVal & tabSUB$pv1 < pVal),]
}
list2groupTABP <- do.call("rbind", list2groupP2)
list2groupTAB2P <- list2groupTABP[order(list2groupTABP$fc1),]
if(dim(list2groupTAB2P)[1] > 0)
{
list2groupTAB2P$num_modes <- 2
tab2v1 <- list2groupTAB2P[,c(7,8,10,5,6,1,2,3,4,9)]
tab2v2 <- cbind(tab2v1[,c(1:5)], group3=NA, group4=NA, group5=NA, tab2v1[,c(6:7)],
mean3=NA, mean4=NA, mean5=NA, tab2v1[,8], shift3_2=NA, shift4_3=NA,
shift5_4=NA, tab2v1[,9], pvalue3_2=NA, pvalue4_3=NA, pvalue5_4=NA,
tab2v1[,10], qvalue3_2=NA, qvalue4_3=NA, qvalue5_4=NA)
colnames(tab2v2) <- c("mRNA_gene", "crispr_gene", "num_modes", "nMode1", "nMode2", "nMode3", "nMode4",
"nMode5", "mMode1", "mMode2", "mMode3", "mMode4","mMode5", "shift2_1", "shift3_2",
"shift4_3", "shift5_4", "pvalue2_1", "pvalue3_2", "pvalue4_3", "pvalue5_4",
"qvalue2_1", "qvalue3_2", "qvalue4_3", "qvalue5_4")
for(i in 3:dim(tab2v2)[2]) { tab2v2[,i] <- as.numeric(tab2v2[,i])}
} else {
tab2v2 <- matrix(ncol=25, nrow=1)
colnames(tab2v2) <- c("mRNA_gene", "crispr_gene", "num_modes", "nMode1", "nMode2", "nMode3", "nMode4",
"nMode5", "mMode1", "mMode2", "mMode3", "mMode4","mMode5", "shift2_1", "shift3_2",
"shift4_3", "shift5_4", "pvalue2_1", "pvalue3_2", "pvalue4_3", "pvalue5_4",
"qvalue2_1", "qvalue3_2", "qvalue4_3", "qvalue5_4")
}
} else {
tab2v2 <- matrix(ncol=25, nrow=1)
colnames(tab2v2) <- c("mRNA_gene", "crispr_gene", "num_modes", "nMode1", "nMode2", "nMode3", "nMode4",
"nMode5", "mMode1", "mMode2", "mMode3", "mMode4","mMode5", "shift2_1", "shift3_2",
"shift4_3", "shift5_4", "pvalue2_1", "pvalue3_2", "pvalue4_3", "pvalue5_4",
"qvalue2_1", "qvalue3_2", "qvalue4_3", "qvalue5_4")
}
# n=3 processing
if(cow3 > 0)
{
for(i in 1:length(list3groupP))
{
list3groupP[[i]]$qv1 <- p.adjust(list3groupP[[i]]$pv1, method="BH")
list3groupP[[i]]$qv2 <- p.adjust(list3groupP[[i]]$pv2, method="BH")
}
list3groupP2 <- list(data.frame(0))
for(i in 1:length(list3groupP))
{
tabSUB <- list3groupP[[i]]
tabSUB <- tabSUB[which(tabSUB[,1] > tabSUB[,2] & tabSUB[,2] > tabSUB[,3]),]
list3groupP2[[i]] <- tabSUB[which(tabSUB$fc1 > fcVal & tabSUB$pv1 < pVal | tabSUB$fc2 > fcVal & tabSUB$pv2 < pVal),]
}
list3groupTABP <- do.call("rbind", list3groupP2)
list3groupTAB2P <- list3groupTABP[order(list3groupTABP$fc1),]
if(dim(list3groupTAB2P)[1] > 0)
{
list3groupTAB2P$num_modes <- 3
tab3v1 <- list3groupTAB2P[,c(11,12,15,8,9,10,1,2,3,4,5,6,7,13,14)]
tab3v2 <- cbind(tab3v1[,c(1:6)], group4=NA, group5=NA, tab3v1[,c(7:9)],
mean4=NA, mean5=NA, tab3v1[,10:11], shift4_3=NA, shift5_4=NA,
tab3v1[,12:13], pvalue4_3=NA, pvalue5_4=NA, tab3v1[,14:15],
qvalue4_3=NA, qvalue5_4=NA)
colnames(tab3v2) <- c("mRNA_gene", "crispr_gene", "num_modes", "nMode1", "nMode2", "nMode3", "nMode4",
"nMode5", "mMode1", "mMode2", "mMode3", "mMode4","mMode5", "shift2_1", "shift3_2",
"shift4_3", "shift5_4", "pvalue2_1", "pvalue3_2", "pvalue4_3", "pvalue5_4",
"qvalue2_1", "qvalue3_2", "qvalue4_3", "qvalue5_4")
for(i in 3:dim(tab3v2)[2]) { tab3v2[,i] <- as.numeric(tab3v2[,i])}
} else {
tab3v2 <- matrix(ncol=25, nrow=1)
colnames(tab3v2) <- c("mRNA_gene", "crispr_gene", "num_modes", "nMode1", "nMode2", "nMode3", "nMode4",
"nMode5", "mMode1", "mMode2", "mMode3", "mMode4","mMode5", "shift2_1", "shift3_2",
"shift4_3", "shift5_4", "pvalue2_1", "pvalue3_2", "pvalue4_3", "pvalue5_4",
"qvalue2_1", "qvalue3_2", "qvalue4_3", "qvalue5_4")
}
} else {
tab3v2 <- matrix(ncol=25, nrow=1)
colnames(tab3v2) <- c("mRNA_gene", "crispr_gene", "num_modes", "nMode1", "nMode2", "nMode3", "nMode4",
"nMode5", "mMode1", "mMode2", "mMode3", "mMode4","mMode5", "shift2_1", "shift3_2",
"shift4_3", "shift5_4", "pvalue2_1", "pvalue3_2", "pvalue4_3", "pvalue5_4",
"qvalue2_1", "qvalue3_2", "qvalue4_3", "qvalue5_4")
}
# n=4 processing
if(cow4 > 0)
{
for(i in 1:length(list4groupP))
{
list4groupP[[i]]$qv1 <- p.adjust(list4groupP[[i]]$pv1, method="BH")
list4groupP[[i]]$qv2 <- p.adjust(list4groupP[[i]]$pv2, method="BH")
list4groupP[[i]]$qv3 <- p.adjust(list4groupP[[i]]$pv3, method="BH")
}
list4groupP2 <- list(data.frame(0))
for(i in 1:length(list4groupP))
{
tabSUB <- list4groupP[[i]]
tabSUB <- tabSUB[which(tabSUB[,1] > tabSUB[,2] & tabSUB[,2] > tabSUB[,3] & tabSUB[,3] > tabSUB[,4]),]
list4groupP2[[i]] <- tabSUB[which(tabSUB$fc1 > fcVal & tabSUB$pv1 < pVal | tabSUB$fc2 > fcVal & tabSUB$pv2 < pVal | tabSUB$fc3 > fcVal & tabSUB$pv3 < pVal),]
}
list4groupTABP <- do.call("rbind", list4groupP2)
list4groupTAB2P <- list4groupTABP[order(list4groupTABP$fc1),]
if(dim(list4groupTAB2P)[1] > 0)
{
list4groupTAB2P$num_modes <- 4
tab4v1 <- list4groupTAB2P[,c(15,16,20,11,12,13,14,1,2,3,4,5,6,7,8,9,10,17,18,19)]
tab4v2 <- as.data.frame(cbind(tab4v1[,c(1:7)], group5=NA, tab4v1[,c(8:11)],
mean5=NA, tab4v1[,12:14], shift5_4=NA, tab4v1[,15:17],
pvalue5_4=NA, tab4v1[,18:20], qvalue5_4=NA), stringsAsFactors=FALSE)
colnames(tab4v2) <- c("mRNA_gene", "crispr_gene", "num_modes", "nMode1", "nMode2", "nMode3", "nMode4",
"nMode5", "mMode1", "mMode2", "mMode3", "mMode4", "mMode5", "shift2_1", "shift3_2",
"shift4_3", "shift5_4", "pvalue2_1", "pvalue3_2", "pvalue4_3", "pvalue5_4",
"qvalue2_1", "qvalue3_2", "qvalue4_3", "qvalue5_4")
for(i in 3:dim(tab4v2)[2]) { tab4v2[,i] <- as.numeric(tab4v2[,i])}
} else {
tab4v2 <- matrix(ncol=25, nrow=1)
colnames(tab4v2) <- c("mRNA_gene", "crispr_gene", "num_modes", "nMode1", "nMode2", "nMode3", "nMode4",
"nMode5", "mMode1", "mMode2", "mMode3", "mMode4","mMode5", "shift2_1", "shift3_2",
"shift4_3", "shift5_4", "pvalue2_1", "pvalue3_2", "pvalue4_3", "pvalue5_4",
"qvalue2_1", "qvalue3_2", "qvalue4_3", "qvalue5_4")
}
} else {
tab4v2 <- matrix(ncol=25, nrow=1)
colnames(tab4v2) <- c("mRNA_gene", "crispr_gene", "num_modes", "nMode1", "nMode2", "nMode3", "nMode4",
"nMode5", "mMode1", "mMode2", "mMode3", "mMode4","mMode5", "shift2_1", "shift3_2",
"shift4_3", "shift5_4", "pvalue2_1", "pvalue3_2", "pvalue4_3", "pvalue5_4",
"qvalue2_1", "qvalue3_2", "qvalue4_3", "qvalue5_4")
}
if(cow5 > 0)
{
for(i in 1:length(list5groupP))
{
list5groupP[[i]]$qv1 <- p.adjust(list5groupP[[i]]$pv1, method="BH")
list5groupP[[i]]$qv2 <- p.adjust(list5groupP[[i]]$pv2, method="BH")
list5groupP[[i]]$qv3 <- p.adjust(list5groupP[[i]]$pv3, method="BH")
list5groupP[[i]]$qv4 <- p.adjust(list5groupP[[i]]$pv4, method="BH")
}
list5groupP2 <- list(data.frame(0))
for(i in 1:length(list5groupP))
{
tabSUB <- list5groupP[[i]]
tabSUB <- tabSUB[which(tabSUB[,1] > tabSUB[,2] & tabSUB[,2] > tabSUB[,3] & tabSUB[,3] > tabSUB[,4]),]
list5groupP2[[i]] <- tabSUB[which(tabSUB$fc1 > fcVal & tabSUB$pv1 < pVal | tabSUB$fc2 > fcVal & tabSUB$pv2 < pVal | tabSUB$fc3 > fcVal & tabSUB$pv3 < pVal | tabSUB$fc4 > fcVal & tabSUB$pv4 < pVal),]
}
list5groupTABP <- do.call("rbind", list5groupP2)
list5groupTAB2P <- list5groupTABP[order(list5groupTABP$fc1),]
if(dim(list5groupTAB2P)[1] > 0)
{
list5groupTAB2P$num_modes <- 5
tab5v2 <- list5groupTAB2P[,c(19,20,25,14,15,16,17,18,1,2,3,4,5,6,7,8,9,10,11,12,13,21,22,23,24)]
colnames(tab5v2) <- c("mRNA_gene", "crispr_gene", "num_modes", "nMode1", "nMode2", "nMode3", "nMode4",
"nMode5", "mMode1", "mMode2", "mMode3", "mMode4","mMode5", "shift2_1", "shift3_2",
"shift4_3", "shift5_4", "pvalue2_1", "pvalue3_2", "pvalue4_3", "pvalue5_4",
"qvalue2_1", "qvalue3_2", "qvalue4_3", "qvalue5_4")
for(i in 3:dim(tab5v2)[2]) { tab5v2[,i] <- as.numeric(tab5v2[,i])}
} else {
tab5v2 <- matrix(ncol=25, nrow=1)
colnames(tab5v2) <- c("mRNA_gene", "crispr_gene", "num_modes", "nMode1", "nMode2", "nMode3", "nMode4",
"nMode5", "mMode1", "mMode2", "mMode3", "mMode4","mMode5", "shift2_1", "shift3_2",
"shift4_3", "shift5_4", "pvalue2_1", "pvalue3_2", "pvalue4_3", "pvalue5_4",
"qvalue2_1", "qvalue3_2", "qvalue4_3", "qvalue5_4")
}
} else {
tab5v2 <- matrix(ncol=25, nrow=1)
colnames(tab5v2) <- c("mRNA_gene", "crispr_gene", "num_modes", "nMode1", "nMode2", "nMode3", "nMode4",
"nMode5", "mMode1", "mMode2", "mMode3", "mMode4","mMode5", "shift2_1", "shift3_2",
"shift4_3", "shift5_4", "pvalue2_1", "pvalue3_2", "pvalue4_3", "pvalue5_4",
"qvalue2_1", "qvalue3_2", "qvalue4_3", "qvalue5_4")
}
allGP <- as.data.frame(rbind(tab2v2, tab3v2, tab4v2, tab5v2))
if(length(which(is.na(allGP[,1]))) > 0)
{
allGP <- allGP[-which(is.na(allGP[,1])),]
return(allGP)
} else {
return(allGP)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.