tanu/LSHTM_analysis
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

tested edplot with alr gene

Browse source
This commit is contained in:
Tanushree Tunstall 2022-01-26 13:35:57 +00:00
parent 8750e3126a
commit 1b20f09075
6 changed files with 62 additions and 108 deletions
Download patch file Download diff file Expand all files Collapse all files

63
scripts/functions/my_logolas.R
View file

@ -686,6 +686,7 @@ mixEM = function(matrix_lik,prior,pi_init=NULL,control=list()){
normalize = function(x){return(x/sum(x))}
normalize4 = function(x){return(x/sum(x[!is.na(x)]))}
fixpoint = function(pi, matrix_lik, prior){
pi = normalize(pmax(0,pi)) #avoid occasional problems with negative pis
@ -1228,9 +1229,9 @@ function (table, ic = FALSE, score = c("diff", "log", "log-odds",
# get_logo_heights()
#===========================
get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-odds",
"probKL", "ratio", "unscaled_log", "wKL"), bg = NULL, epsilon = 0.01,
opt = 1, symm = TRUE, alpha = 1, hist = FALSE, quant = 0.5)
get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-odds",
"probKL", "ratio", "unscaled_log", "wKL"), bg = NULL, epsilon = 0.01,
opt = 1, symm = TRUE, alpha = 1, hist = FALSE, quant = 0.5)
{
if (ic & score == "unscaled_log") {
warning("ic = TRUE not compatible with score = `unscaled-log`: switching to\n ic = FALSE")
@ -1286,7 +1287,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
chars <- as.character(rownames(table_mat_norm))
if (!ic) {
if (score == "diff") {
table_mat_adj <- apply((table_mat_norm + epsilon) -
table_mat_adj <- apply((table_mat_norm + epsilon) -
(bgmat + epsilon), 2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1317,7 +1318,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
})
}
else if (score == "log") {
table_mat_adj <- apply(log((table_mat_norm + epsilon)/(bgmat +
table_mat_adj <- apply(log((table_mat_norm + epsilon)/(bgmat +
epsilon), base = 2), 2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1349,7 +1350,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
}
else if (score == "log-odds") {
if (opt == 1) {
table_mat_adj <- apply((table_mat_norm + epsilon)/(bgmat +
table_mat_adj <- apply((table_mat_norm + epsilon)/(bgmat +
epsilon), 2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1381,7 +1382,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
})
}
else {
table_mat_adj <- apply((table_mat_norm + epsilon),
table_mat_adj <- apply((table_mat_norm + epsilon),
2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1402,8 +1403,8 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
}
}
else if (score == "probKL") {
table_mat_adj <- apply((table_mat_norm + epsilon) *
log((table_mat_norm + epsilon)/(bgmat + epsilon),
table_mat_adj <- apply((table_mat_norm + epsilon) *
log((table_mat_norm + epsilon)/(bgmat + epsilon),
base = 2), 2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1434,7 +1435,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
})
}
else if (score == "ratio") {
table_mat_adj <- apply((table_mat_norm + epsilon)/(bgmat +
table_mat_adj <- apply((table_mat_norm + epsilon)/(bgmat +
epsilon), 2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1465,7 +1466,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
})
}
else if (score == "unscaled_log") {
table_mat_adj <- apply(log((table_mat_norm + epsilon)/(bgmat +
table_mat_adj <- apply(log((table_mat_norm + epsilon)/(bgmat +
epsilon), base = 2), 2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1496,7 +1497,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
})
}
else if (score == "wKL") {
table_mat_adj <- apply(log((table_mat_norm + epsilon)/(bgmat +
table_mat_adj <- apply(log((table_mat_norm + epsilon)/(bgmat +
epsilon), base = 2), 2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1533,7 +1534,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
else {
if (score == "diff") {
if (opt == 1) {
table_mat_adj <- apply((table_mat_norm + epsilon) -
table_mat_adj <- apply((table_mat_norm + epsilon) -
(bgmat + epsilon), 2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1564,7 +1565,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
})
}
else {
table_mat_adj <- apply(table_mat_norm + epsilon,
table_mat_adj <- apply(table_mat_norm + epsilon,
2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1585,7 +1586,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
}
else if (score == "log") {
if (opt == 1) {
table_mat_adj <- apply(log((table_mat_norm +
table_mat_adj <- apply(log((table_mat_norm +
epsilon)/(bgmat + epsilon), base = 2), 2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1616,7 +1617,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
})
}
else {
table_mat_adj <- apply(log(table_mat_norm + epsilon,
table_mat_adj <- apply(log(table_mat_norm + epsilon,
base = 2), 2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1637,7 +1638,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
}
else if (score == "log-odds") {
if (opt == 1) {
table_mat_adj <- apply((table_mat_norm + epsilon)/(bgmat +
table_mat_adj <- apply((table_mat_norm + epsilon)/(bgmat +
epsilon), 2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1669,7 +1670,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
})
}
else {
table_mat_adj <- apply((table_mat_norm + epsilon),
table_mat_adj <- apply((table_mat_norm + epsilon),
2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1691,8 +1692,8 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
}
else if (score == "probKL") {
if (opt == 1) {
table_mat_adj <- apply((table_mat_norm + epsilon) *
log((table_mat_norm + epsilon)/(bgmat + epsilon),
table_mat_adj <- apply((table_mat_norm + epsilon) *
log((table_mat_norm + epsilon)/(bgmat + epsilon),
base = 2), 2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1723,8 +1724,8 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
})
}
else {
table_mat_adj <- apply((table_mat_norm + epsilon) *
log(table_mat_norm + epsilon, base = 2), 2,
table_mat_adj <- apply((table_mat_norm + epsilon) *
log(table_mat_norm + epsilon, base = 2), 2,
function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1745,7 +1746,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
}
else if (score == "ratio") {
if (opt == 1) {
table_mat_adj <- apply((table_mat_norm + epsilon)/(bgmat +
table_mat_adj <- apply((table_mat_norm + epsilon)/(bgmat +
epsilon), 2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1776,7 +1777,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
})
}
else {
table_mat_adj <- apply(table_mat_norm + scale,
table_mat_adj <- apply(table_mat_norm + scale,
2, function(x) {
indices <- which(is.na(x))
if (length(indices) == 0) {
@ -1825,29 +1826,29 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
table_mat_neg[table_mat_neg >= 0] = 0
table_mat_neg_norm <- apply(table_mat_neg, 2, function(x) return(x/sum(x)))
table_mat_neg_norm[table_mat_neg_norm == "NaN"] = 0
table_mat_norm <- replace(table_mat_norm, is.na(table_mat_norm),
table_mat_norm <- replace(table_mat_norm, is.na(table_mat_norm),
0)
for (j in 1:dim(table_mat_neg_norm)[2]) {
if (sum(table_mat_neg_norm[, j]) == 0) {
table_mat_neg_norm[, j] <- normalize4(table_mat_neg_norm[,
table_mat_neg_norm[, j] <- normalize4(table_mat_neg_norm[,
j] + 0.001)
}
}
for (j in 1:dim(table_mat_pos_norm)[2]) {
if (sum(table_mat_pos_norm[, j]) == 0) {
table_mat_pos_norm[, j] <- normalize4(table_mat_pos_norm[,
table_mat_pos_norm[, j] <- normalize4(table_mat_pos_norm[,
j] + 0.001)
}
}
if (symm == TRUE) {
table_mat_norm[which(is.na(table))] <- NA
ic <- 0.5 * (ic_computer(table_mat_norm, alpha, hist = hist,
bg = bgmat) + ic_computer(bgmat, alpha, hist = hist,
ic <- 0.5 * (ic_computer(table_mat_norm, alpha, hist = hist,
bg = bgmat) + ic_computer(bgmat, alpha, hist = hist,
bg = table_mat_norm))
}
else {
table_mat_norm[which(is.na(table))] <- NA
ic <- ic_computer(table_mat_norm, alpha, hist = hist,
ic <- ic_computer(table_mat_norm, alpha, hist = hist,
bg = bgmat)
}
tab_neg <- apply(table_mat_adj, 2, function(x) {
@ -1870,7 +1871,7 @@ get_logo_heights <- function (table, ic = FALSE, score = c("diff", "log", "log-o
})
tab_pos[tab_pos == 0] <- 0.001
tab_neg[tab_neg == 0] <- 0.001
pos_neg_scaling <- apply(rbind(tab_pos, tab_neg), 2,
pos_neg_scaling <- apply(rbind(tab_pos, tab_neg), 2,
function(x) return(x/sum(x)))
pos_ic <- pos_neg_scaling[1, ] * ic
neg_ic <- pos_neg_scaling[2, ] * ic