Nothing
# multiDel.R
# FBA and friends with R.
#
# Copyright (C) 2010-2014 Gabriel Gelius-Dietrich, Dpt. for Bioinformatics,
# Institute for Informatics, Heinrich-Heine-University, Duesseldorf, Germany.
# All right reserved.
# Email: geliudie@uni-duesseldorf.de
#
# This file is part of sybil.
#
# Sybil is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Sybil is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with sybil. If not, see <http://www.gnu.org/licenses/>.
################################################
# Function: multDel
#
#
#
#
multiDel <- function(model, nProc = 2,
todo = "oneGeneDel",
del1 = NA, del2 = NA, ...) {
# #unlistResult = FALSE, ...) {
if (!is(model, "modelorg")) {
stop("needs an object of class modelorg!")
}
if (nProc < 2) {
stop("argument nProc must be equal or greater than 2!")
}
#--------------------------------------------------------------#
# split delX to a list of length numCo
#--------------------------------------------------------------#
spDel <- function(del) {
if(is(del, "matrix")) {
nd <- ncol(del)
splitmat <- TRUE
}
else {
nd <- length(del)
splitmat <- FALSE
}
if (numCo > nd) {
numCo <- nd
}
if (isTRUE(splitmat)) {
gs <- floor(seq(1, nd, length.out = numCo+1))
dL <- vector(mode = "list", length = numCo)
for (i in seq(along = gs[1:numCo])) {
en <- ifelse(i == numCo, gs[i+1], gs[i+1]-1)
dL[[i]] <- del[, gs[i]:en, drop = FALSE]
#dL[[i]] <- c(gs[i], en)
}
}
else {
gs <- floor(seq(0, nd, length.out = numCo+1))
# convert to factor
spf <- cut(1:nd, gs)
# use spf as factor for split()
dL <- split(del, spf)
}
return(dL)
}
#--------------------------------------------------------------#
# load library 'parallel'
if (!requireNamespace("parallel", quietly = TRUE)) {
stop("package parallel not found.")
}
# unwanted conditioning for loading packages...
# if(!isTRUE(require("parallel"))) {
# stop("package parallel not found.")
# }
# number of cores
ncore <- parallel::detectCores()
numCo <- ifelse(nProc > ncore, as.integer(ncore), as.integer(nProc))
#--------------------------------------------------------------#
# split input into lists of size numCo
if (any(is.na(del1))) {
dL1 <- spDel(allGenes(model))
}
else {
dL1 <- spDel(del1)
}
if (any(is.na(del2))) {
dL2 <- as.list(rep(NA, length(dL1)))
}
else {
if (length(del1) != length(del2)) {
stop(paste("if argument del2 is not NA,",
"del1 and del2 must have same length!"))
}
dL2 <- spDel(del2)
cdL <- vector("list", length(dL1))
for (i in seq(along = cdL)) {
cdL[[i]] <- c(dL1[i], dL2[i])
}
}
#--------------------------------------------------------------#
# run optimizations
sol <- switch(todo,
"oneGeneDel" = {
parallel::mclapply(dL1,
function(x) oneGeneDel(model,
geneList = x,
verboseMode = 0, ...),
mc.cores = nProc)
},
"doubleGeneDel" = {
parallel::mclapply(cdL, function(x) doubleGeneDel(model,
geneList1 = x[[1]],
geneList2 = x[[2]],
verboseMode = 0, ...),
mc.cores = nProc)
},
"oneFluxDel" = {
parallel::mclapply(dL1, function(x) oneFluxDel(model,
react = x,
verboseMode = 0, ...),
mc.cores = nProc)
},
"doubleFluxDel" = {
parallel::mclapply(cdL, function(x) doubleFluxDel(model,
react1 = x[[1]],
react2 = x[[2]],
verboseMode = 0, ...),
mc.cores = nProc)
},
"fluxVar" = {
parallel::mclapply(dL1, function(x) fluxVar(model,
react = x,
verboseMode = 0, ...),
mc.cores = nProc)
},
"geneDeletion" = {
parallel::mclapply(dL1, function(x) geneDeletion(model,
genes = x,
verboseMode = 0, ...),
mc.cores = nProc)
},
{
stop("argument todo is not valid!")
}
)
# if ( (isTRUE(unlistResult)) && (is(sol, "list")) ) {
# ## maybe we can use something like unlist here
# sv <- solver(sol[[1]])
# nc <- lp_num_cols(sol[[1]])
# nr <- lp_num_rows(sol[[1]])
# of <- obj_function(sol[[1]])
# np <- sum(mapply(num_of_prob, sol)) - (numCo-1)
#
#
# # generate an index-vector of elements we want to use from sol
# # every first element is the wild-type solution and this should be
# # excluded, except for the first one
#
# npL <- mapply(num_of_prob, sol, SIMPLIFY = FALSE, USE.NAMES = FALSE)
# np <- sum(unlist(npL)) - (numCo-1)
#
# indL <- mapply(rep, npL, MoreArgs = list(x=TRUE), SIMPLIFY = FALSE)
#
# for (i in seq(along = indL)[-1]) {
# indL[[i]][1] <- FALSE
# }
#
# newSol <- switch(todo,
# "oneGeneDel" = {
# optsol_geneDel(solver,
# nprob,
# lpdir,
# ncols,
# nrows,
# objf,
# fld,
# comb = 1)
#
# },
# "doubleGeneDel" = {
# optsol_doublegenedel(solver,
# nprob,
# lpdir,
# nrows,
# ncols,
# delrows,
# delcols,
# objf,
# fld)
# },
# "oneFluxDel" = {
# optsol_fluxdel(solver,
# nprob,
# lpdir,
# ncols,
# nrows,
# objf,
# fld,
# comb = 1)
# },
# "doubleFluxDel" = {
# optsol_doublefluxdel(solver,
# nprob,
# lpdir,
# nrows,
# ncols,
# delrows,
# delcols,
# objf,
# fld)
# },
# "fluxVar" = {
# optsol_fluxVar(solver,
# method,
# nprob,
# lpdir,
# ncols,
# nrows,
# objf,
# fld,
# rc)
# },
# "geneDeletion" = {
# optsol_geneDel(solver,
# nprob,
# lpdir,
# ncols,
# nrows,
# objf,
# fld,
# comb = 1)
# },
# {
# stop("argument todo is not valid!")
# }
# )
#
# }
return(sol)
}
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.