Nothing
#' @title Minimal modification of whole Boolean model
#'
#' @description
#' This function generates all possible boolean models minimally modified. Returns a lists of 2 lists, deleted models and added models
#'
#' @param bm S4 BoolModel object.
#' @param index integer. Specifying rule of which gene to modify. If NULL, modifies all rules in the model. Defaults to NULL.
#' @param overlap_gene character vector. Specify which genes are present in both model and data inputs.
#' @param sep_list logical. Separate add and del lists.
#' @param encoded logical. Return Boolean models in encoded form to save space.
#' @param model_encoding list. Only used if encoded=T.
#' @param and_bool logical. Default to check_and().
#' @param self_loop logical. Whether to allow self_loop in random starting model. Default to F.
#'
#' @export
minmod_model = function(bm, index=NULL, overlap_gene=NULL, sep_list=F, encoded=F, model_encoding, and_bool=NULL, self_loop=F)
{
if(class(bm) != 'BoolModel')
{
bm = decompress_bmodel(bm, model_encoding)
}
if(is.null(index))
{
#Modify only the overlapping genes
gene_ind = which(bm@target %in% overlap_gene)
del_list = c()
add_list = c()
for(ind in gene_ind) #Modify act and inh rules for one gene at a time.
{
tmp_list = minmod_internal(bm, ind, encoded, model_encoding, and_bool, self_loop)
if(!is.null(tmp_list$dellist))
{
del_list = c(del_list, tmp_list$dellist)
}
if(!is.null(tmp_list$addlist))
{
add_list = c(add_list, tmp_list$addlist)
}
}
if(sep_list)
{
out_list = list(del_list=del_list,
add_list=add_list)
} else
{
out_list = c(del_list, add_list)
}
} else
{
if(sep_list)
{
out_list = minmod_internal(bm, index, encoded, model_encoding, and_bool, self_loop)
} else
{
out_list = unlist(minmod_internal(bm, index, encoded, model_encoding, and_bool, self_loop))
}
}
return(out_list)
}
#' @title Inner function of minimal modification of whole Boolean model
#'
#' @description
#' This function generates all possible boolean models minimally modified. Returns a lists of 2 lists, deleted models and added models
#'
#' @param bm S4 BoolModel object.
#' @param index integer. Specifying rule of which gene to modify.
#' @param encoded logical. Return Boolean models in encoded form to save space.
#' @param model_encoding list. Only used if encoded=T.
#' @param and_bool logical. Default to check_and() if unspecified.
#' @param self_loop logical. Whether to allow self_loop in random starting model. Default to F.
minmod_internal = function(bm, index, encoded, model_encoding, and_bool, self_loop=F)
{
if(is.null(and_bool))
{
and_bool = check_and(bm)
}
arule = bm@rule_act[[index]]
irule = bm@rule_inh[[index]]
#Deletion of act rule.
dellist_arule = list()
if(length(arule) == 1)
{
if(grepl('&' , arule))
{
tmp = unlist(strsplit(arule[1], '&')) #split the AND term into 2.
dellist_arule = c(dellist_arule, list(c(tmp[1], arule[-1]), c(tmp[2], arule[-1])))
} else #allow empty rule.
{
dellist_arule = c(dellist_arule, list(arule[-1]))
}
# else if(arule[1] != '0' & irule[1] != '0') #not allowing empty rule.
# {
# dellist_arule = c(dellist_arule, list('0'))
# }
} else
{
for(i in 1:length(arule))
{
if(grepl('&', arule[i]))
{
tmp = unlist(strsplit(arule[i], '&')) #split the AND term into 2.
dellist_arule = c(dellist_arule, list(c(tmp[1], arule[-i]), c(tmp[2], arule[-i])))
} else
{
dellist_arule = c(dellist_arule, list(arule[-i]))
}
}
}
dellist_arule[sapply(dellist_arule, length)==0] = list('0') #if there is any empty term at the end, add in '0'
#Deletion of inh rule.
dellist_irule = list()
if(length(irule) == 1)
{
if(grepl('&' , irule))
{
tmp = unlist(strsplit(irule[1], '&')) #split the AND term into 2.
dellist_irule = c(dellist_irule, list(c(tmp[1], irule[-1]), c(tmp[2], irule[-1])))
} else #allow empty rule.
{
dellist_irule = c(dellist_irule, list(irule[-1]))
}
# } else if(arule[1] != '0' & irule[1] != '0') #not allowing empty rule.
# {
# dellist_irule = c(dellist_irule, list('0'))
# }
} else
{
for(i in 1:length(irule))
{
if(grepl('&', irule[i]))
{
tmp = unlist(strsplit(irule[i], '&')) #split the AND term into 2.
dellist_irule = c(dellist_irule, list(c(tmp[1], irule[-i]), c(tmp[2], irule[-i])))
} else
{
dellist_irule = c(dellist_irule, list(irule[-i]))
}
}
}
dellist_irule[sapply(dellist_irule, length)==0] = list('0') #if there is any empty term at the end, add in '0'
#Addition of act rule. (single)
if(self_loop)
{
pos_actterm = bm@target_var[!(bm@target_var %in% unlist(strsplit(c(arule, irule), '&')))]
} else
{
pos_actterm = bm@target_var[!(bm@target_var %in% unlist(strsplit(c(arule, irule), '&')) | bm@target_var %in% bm@target_var[index])]
}
addlist_arule = list()
if(length(pos_actterm) != 0)
{
if(arule[1] == '0')
{
for(i in 1:length(pos_actterm))
{
addlist_arule = c(addlist_arule, list(pos_actterm[i]))
}
} else
{
for(i in 1:length(pos_actterm))
{
addlist_arule = c(addlist_arule, list(c(arule, pos_actterm[i])))
}
}
if(and_bool)
{
#Addition of act rule. (double)
if(arule[1] != '0')
{
for(i in 1:length(pos_actterm))
{
for(j in 1:length(arule))
{
if(grepl('&', arule[j]))
{
next
} else
{
tmp = sprintf('%s&%s', pos_actterm[i], arule[j])
addlist_arule = c(addlist_arule, list(c(arule[-j], tmp)))
}
}
}
}
}
}
#Addition of inh rule. (single)
if(self_loop)
{
pos_inhterm = bm@target_var[!(bm@target_var %in% unlist(strsplit(c(arule, irule), '&')))]
} else
{
pos_inhterm = bm@target_var[!(bm@target_var %in% unlist(strsplit(c(arule, irule), '&')) | bm@target_var %in% bm@target_var[index])]
}
#pos_inhterm = pos_inhterm[!is.na(pos_inhterm)]
addlist_irule = list()
if(length(pos_inhterm)!=0)
{
if(irule[1] == '0')
{
for(i in 1:length(pos_inhterm))
{
addlist_irule = c(addlist_irule, list(pos_inhterm[i]))
}
} else
{
for(i in 1:length(pos_inhterm))
{
addlist_irule = c(addlist_irule, list(c(irule, pos_inhterm[i])))
}
}
if(and_bool)
{
#Addition of inh rule. (double)
if(irule[1] != '0')
{
for(i in 1:length(pos_inhterm))
{
for(j in 1:length(irule))
{
if(grepl('&', irule[j]))
{
next
} else
{
tmp = sprintf('%s&%s', pos_inhterm[i], irule[j])
addlist_irule = c(addlist_irule, list(c(irule[-j], tmp)))
}
}
}
}
}
}
#Generate a list of modified models.
bmodel_dellist = list()
bmodel_addlist = list()
if(length(dellist_arule) != 0)
{
for(i in 1:length(dellist_arule))
{
tmp_bm = bm
tmp_bm@rule_act[[index]] = dellist_arule[[i]]
if(encoded)
{
tmp_bm = list(compress_bmodel(tmp_bm, model_encoding))
stopifnot(length(model_encoding[[2]])==max(round(tmp_bm[[1]])))
}
bmodel_dellist = c(bmodel_dellist, tmp_bm)
}
}
if(length(dellist_irule) != 0)
{
for(i in 1:length(dellist_irule))
{
tmp_bm = bm
tmp_bm@rule_inh[[index]] = dellist_irule[[i]]
if(encoded)
{
tmp_bm = list(compress_bmodel(tmp_bm, model_encoding))
stopifnot(length(model_encoding[[2]])==max(round(tmp_bm[[1]])))
}
bmodel_dellist = c(bmodel_dellist, tmp_bm)
}
}
if(length(addlist_arule) != 0)
{
for(i in 1:length(addlist_arule))
{
tmp_bm = bm
tmp_bm@rule_act[[index]] = addlist_arule[[i]]
if(encoded)
{
tmp_bm = list(compress_bmodel(tmp_bm, model_encoding))
stopifnot(length(model_encoding[[2]])==max(round(tmp_bm[[1]])))
}
bmodel_addlist = c(bmodel_addlist, tmp_bm)
}
}
if(length(addlist_irule) != 0)
{
for(i in 1:length(addlist_irule))
{
tmp_bm = bm
tmp_bm@rule_inh[[index]] = addlist_irule[[i]]
if(encoded)
{
tmp_bm = list(compress_bmodel(tmp_bm, model_encoding))
stopifnot(length(model_encoding[[2]])==max(round(tmp_bm[[1]])))
}
bmodel_addlist = c(bmodel_addlist, tmp_bm)
}
}
return(list(dellist=bmodel_dellist,
addlist=bmodel_addlist))
}
#' @title Add extra genes to a Boolean model
#'
#' @description
#' This function adds extra genes to a Boolean model. Return a list of BoolModel object and an initial state.
#'
#' @param in_gene character vector. Genes to be added into the model.
#' @param in_model data frame or BoolModel object. If it is a data frame, it must have 2 columns, which are targets and update functions.
#'
#' @export
grow_bmodel = function(in_gene, in_model)
{
if(class(in_model)=='BoolModel')
{
in_model = bm_to_df(in_model)
}
#Generate a new data frame to be added into the model df.
empty_func = '(0) &! (0)'
in_row = data.frame(in_gene, empty_func)
colnames(in_row) = c('targets', 'factors')
#Modify the model df.
out_model = rbind(in_model, in_row)
#Convert the model df into BoolModel object.
out_model = df_to_bm(out_model)
return(out_model)
}
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.