From 5416fb09d82cbe87bcd701cc7bf389c6116e57ee Mon Sep 17 00:00:00 2001 From: jo Date: Thu, 14 Jul 2016 19:55:34 +0200 Subject: [PATCH] cran 1.5 release --- DESCRIPTION | 4 +- R/Arena.R | 81 ++++--- R/Organism.R | 42 +--- R/Stuff.R | 314 ++++++++++++++-------------- man/Organism-class.Rd | 9 +- man/addEval.Rd | 2 +- man/addSubs.Rd | 2 +- man/cellgrowth.Rd | 9 - man/checkCorr.Rd | 2 +- man/checkPhen.Rd | 7 - man/evalArena.Rd | 2 +- man/extractMed.Rd | 2 +- man/findFeeding3.Rd | 26 +++ man/getArena.Rd | 2 +- man/getCorrM.Rd | 2 +- man/getPhenoMat.Rd | 2 +- man/growExp.Rd | 8 - man/growLin.Rd | 6 - man/growth.Rd | 9 - man/minePheno.Rd | 2 +- man/move.Rd | 2 +- man/plotAbundance.Rd | 9 - man/plotCurves.Rd | 2 +- man/plotCurves2.Rd | 2 +- man/plotFluxVar.Rd | 17 ++ man/plotGrowthCurve.Rd | 3 +- man/plotInterNum.Rd | 2 + man/plotPhenNum.Rd | 2 + man/plotShadowCost.Rd | 29 +++ man/plotSubCurve.Rd | 3 +- man/plotSubVar.Rd | 17 ++ man/plotTotFlux.Rd | 2 +- man/redEval.Rd | 2 +- man/selPheno.Rd | 4 +- man/simBac.Rd | 2 + man/simEnv.Rd | 4 +- man/simEnv_par.Rd | 2 +- man/statPheno.Rd | 2 +- vignettes/BacArena-Introduction.Rmd | 15 +- 39 files changed, 330 insertions(+), 324 deletions(-) create mode 100644 man/findFeeding3.Rd create mode 100644 man/plotFluxVar.Rd create mode 100644 man/plotShadowCost.Rd create mode 100644 man/plotSubVar.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 268d8bd..e1733c3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -18,8 +18,7 @@ Depends: sybil (>= 1.3.0), ReacTran (>= 1.4.2), deSolve (>= 1.12), - Matrix (>= 1.2), - glpkAPI + Matrix (>= 1.2) Imports: igraph, methods, @@ -28,6 +27,7 @@ Imports: graphics, ggplot2, reshape2, + glpkAPI, Rcpp Suggests: sybilSBML, diff --git a/R/Arena.R b/R/Arena.R index 1e3f4b7..d2a6f84 100644 --- a/R/Arena.R +++ b/R/Arena.R @@ -261,7 +261,7 @@ setMethod("addOrg", "Arena", function(object, specI, amount, x=NULL, y=NULL, gro #' minweight=0.05,growtype="exponential") #initialize a bacterium #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms -#' arena <- addSubs(arena,20,c("EX_glc(e)","EX_o2(e)","EX_pi(e)")) #add substances glucose, oxygen and phosphate +#' arena <- addSubs(arena,20,c("EX_glc(e)","EX_o2(e)","EX_pi(e)")) #add glucose, o2, pi setGeneric("addSubs", function(object, smax=0, mediac=object@mediac, difunc="pde", difspeed=6.7e-6, unit="mmol/cell", add=TRUE){standardGeneric("addSubs")}) #' @rdname addSubs #' @export @@ -573,12 +573,6 @@ setMethod("changeOrg", "Arena", function(object, neworgdat){ #' @return Returns a number indicating the number of the phenotype in the phenotype list. #' @details The phenotypes are defined by flux through exchange reactions, which indicate potential differential substrate usages. Uptake of substances are indicated by a negative and production of substances by a positive number. #' @seealso \code{\link{Arena-class}} and \code{\link{getPhenotype}} -#' @examples -#' data(Ec_core, envir = environment()) #get Escherichia coli core metabolic model -#' bac <- Bac(Ec_core,deathrate=0.05, -#' minweight=0.05,growtype="exponential") #initialize a bacterium -#' arena <- Arena(n=20,m=20) #initialize the environment -#' checkPhen(arena,bac) #returns 1 as the index of the current phenotype in the list. setGeneric("checkPhen", function(object, org, cutoff=1e-6, fbasol){standardGeneric("checkPhen")}) #' @export #' @rdname checkPhen @@ -670,6 +664,7 @@ setMethod("addPhen", "Arena", function(object, org, pvec){ #' @param cl_size If diff_par is true then cl_size defines the number of cores to be used in parallelized diffusion. #' @param sec_obj character giving the secondary objective for a bi-level LP if wanted. #' @param cutoff value used to define numeric accuracy +#' @param pcut A number giving the cutoff value by which value of objective function is considered greater than 0. #' @return Returns an object of class \code{Eval} which can be used for subsequent analysis steps. #' @details The returned object itself can be used for a subsequent simulation, due to the inheritance between \code{Eval} and \code{Arena}. #' @seealso \code{\link{Arena-class}} and \code{\link{Eval-class}} @@ -680,7 +675,7 @@ setMethod("addPhen", "Arena", function(object, org, pvec){ #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) setGeneric("simEnv", function(object, time, lrw=NULL, continue=FALSE, reduce=FALSE, diffusion=TRUE, diff_par=FALSE, cl_size=2, sec_obj="none", cutoff=1e-6, pcut=1e-6){standardGeneric("simEnv")}) #' @export #' @rdname simEnv @@ -847,7 +842,7 @@ setMethod("diffuse", "Arena", function(object, lrw, sublb){ #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) setGeneric("simEnv_par", function(object, time, lrw=NULL, continue=FALSE, reduce=FALSE, cluster_size=NULL, diffusion=TRUE, sec_obj="none", cutoff=1e-6){standardGeneric("simEnv_par")}) #' @export #' @rdname simEnv_par @@ -931,28 +926,28 @@ setMethod("simEnv_par", "Arena", function(object, time, lrw=NULL, continue=FALSE todo_pheno <- phen_res[[1]] list("neworgdat"=neworgdat, "sublb"=sublb, "fbasol"=fbasol, "todo_pheno"=todo_pheno, "todo_pheno_nr"=todo_pheno_nr) }) - list("neworgdat"=sapply(test, with, neworgdat), "sublb"=sapply(test, with, sublb), "fbasol_flux"=sapply(test, with, fbasol$fluxes), "todo_pheno"=sapply(test, with, todo_pheno), "todo_pheno_nr"=sapply(test, with, todo_pheno_nr)) + list("neworgdat"=sapply(test, with, test$neworgdat), "sublb"=sapply(test, with, test$sublb), "fbasol_flux"=sapply(test, with, fbasol$fluxes), "todo_pheno"=sapply(test, with, test$todo_pheno), "todo_pheno_nr"=sapply(test, with, test$todo_pheno_nr)) #}) }, mc.cores=cluster_size))[3] par_post_init_t <- proc.time()[3] tmpnames <- colnames(arena@orgdat) - orgdat2 <- data.frame(matrix(unlist(sapply(parallel_sol, with, neworgdat)), ncol=dim(arena@orgdat)[2], byrow=TRUE)) + orgdat2 <- data.frame(matrix(unlist(sapply(parallel_sol, with, parallel_sol$neworgdat)), ncol=dim(arena@orgdat)[2], byrow=TRUE)) colnames(orgdat2) <- tmpnames if(all(apply(orgdat2, 1, is.numeric)) != TRUE) browser() arena@orgdat <<- orgdat2 tmpnames <- colnames(sublb) - sublb2 <- matrix(unlist(sapply(parallel_sol, with, sublb)), ncol=dim(sublb)[2], byrow=TRUE) + sublb2 <- matrix(unlist(sapply(parallel_sol, with, parallel_sol$parallel_solsublb)), ncol=dim(sublb)[2], byrow=TRUE) colnames(sublb2) <- tmpnames sublb <<- sublb2 - fba_fluxes <- sapply(parallel_sol, with, fbasol_flux) + fba_fluxes <- sapply(parallel_sol, with, parallel_sol$parallel_solfbasol_flux) arena@mflux[[names(arena@specs)[[spec_nr]]]] <<- arena@mflux[[names(arena@specs)[[spec_nr]]]] + colSums(matrix(unlist(fba_fluxes), ncol=length(arena@mflux[[names(arena@specs)[[spec_nr]]]]), byrow = TRUE)) # remember active fluxes #arena@shadow[[names(arena@specs)[[spec_nr]]]] <<- arena@shadow[[names(arena@specs)[[spec_nr]]]] + colSums(matrix(unlist(fba_fluxes), ncol=length(arena@mflux[[names(arena@specs)[[spec_nr]]]]), byrow = TRUE)) # remember active fluxes - todo_pheno <- sapply(parallel_sol, with, todo_pheno) + todo_pheno <- sapply(parallel_sol, with, parallel_sol$parallel_soltodo_pheno) todo_pheno <- as.numeric(unname(unlist(todo_pheno))) - todo_pheno_nr <- sapply(parallel_sol, with, todo_pheno_nr) + todo_pheno_nr <- sapply(parallel_sol, with, parallel_sol$parallel_soltodo_pheno_nr) todo_pheno_nr <- unlist(todo_pheno_nr) if(all(is.na(arena@orgdat$phenotype))) arena@orgdat$phenotype <<- todo_pheno # init case if(length(todo_pheno_nr) > 0){ # handle new phenotypes @@ -1227,9 +1222,9 @@ setMethod("findInArena", "Arena", function(object, pattern, search_rea=TRUE, sea print(object@mediac[res_name]) } - if(search_rea & length(arena@models)>0){ - for(i in 1:length(arena@models)){ - model = arena@models[[i]] + if(search_rea & length(object@models)>0){ + for(i in 1:length(object@models)){ + model = object@models[[i]] cat(paste0("\n\n", i, ". ", model@mod_desc, model@mod_name)) res_rea_id <- grep(x=model@react_id, pattern=pattern, ignore.case = TRUE) print(paste(model@react_id[res_rea_id], model@react_name[res_rea_id])) @@ -1364,7 +1359,7 @@ setMethod("subchange", "Eval", function(object){return(object@subchange)}) #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) #' addEval(eval,arena) setGeneric("addEval", function(object, arena, replace=F){standardGeneric("addEval")}) #' @export @@ -1425,7 +1420,7 @@ setMethod("addEval", "Eval", function(object, arena, replace=F){ #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) #' arena5 <- getArena(eval,5) setGeneric("getArena", function(object, time=(length(object@medlist)-1)){standardGeneric("getArena")}) #' @export @@ -1462,7 +1457,7 @@ setMethod("getArena", "Eval", function(object, time=(length(object@medlist)-1)){ #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) #' eval_reduce <- redEval(eval,5) setGeneric("redEval", function(object, time="all"){standardGeneric("redEval")}) #' @export @@ -1493,7 +1488,7 @@ setMethod("redEval", "Eval", function(object, time=1:length(object@medlist)){ #i #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) #' med5 <- extractMed(eval,5) setGeneric("extractMed", function(object, time=length(object@medlist), mediac=object@mediac){standardGeneric("extractMed")}) #' @export @@ -1534,7 +1529,7 @@ setMethod("extractMed", "Eval", function(object, time=length(object@medlist), me #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) #' evalArena(eval) #'\dontrun{ #' ## if animation package is installed a movie of the simulation can be stored: @@ -1638,7 +1633,7 @@ setMethod("evalArena", "Eval", function(object, plot_items='Population', phencol #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) #' plotCurves(eval) setGeneric("plotCurves", function(object, medplot=object@mediac, retdata=F, remove=F, legend=F){standardGeneric("plotCurves")}) #' @export @@ -1711,7 +1706,7 @@ setMethod("getVarSubs", "Eval", function(object, show_products=FALSE, show_subst mediac <- object@mediac #rownames(mat) <- gsub("\\(e\\)","", gsub("EX_","",mediac)) rownames(mat) <- mediac - mat_var <- apply(mat, 1, var) + mat_var <- apply(mat, 1, stats::var) if(!(show_products || show_substrates)) { ret <- sort(mat_var[which(mat_var>0)], decreasing=TRUE) len_ret <- length(ret) @@ -1791,7 +1786,7 @@ setMethod("getSubHist", "Eval", function(object, sub){ #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) #' plotCurves2(eval) setGeneric("plotCurves2", function(object, legendpos="topleft", ignore=c("EX_h(e)","EX_pi(e)", "EX_h2o(e)"), num=10, phencol=FALSE, biomcol=FALSE, dict=NULL, subs=list(), growthCurve=TRUE, subCurve=TRUE){standardGeneric("plotCurves2")}) @@ -1816,7 +1811,7 @@ setMethod("plotCurves2", "Eval", function(object, legendpos="topright", ignore=c mediac <- object@mediac[-ignore_subs] } else mediac <- object@mediac rownames(mat) <- gsub("\\[e\\]","", gsub("\\(e\\)","", gsub("EX_","",mediac))) - mat_var <- apply(mat, 1, var) + mat_var <- apply(mat, 1, stats::var) num_var <- length(which(mat_var>0)) if(num_var>0){ mat_nice <- tail(mat[order(mat_var),], ifelse(num_var>num, num, num_var)) @@ -1900,7 +1895,7 @@ setMethod("plotCurves2", "Eval", function(object, legendpos="topright", ignore=c #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) #' plotTotFlux(eval) setGeneric("plotTotFlux", function(object, legendpos="topright", num=20){standardGeneric("plotTotFlux")}) #' @export @@ -1942,7 +1937,7 @@ setMethod("plotTotFlux", "Eval", function(object, legendpos="topright", num=20){ #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) #' phenmat <- getPhenoMat(eval) setGeneric("getPhenoMat", function(object, time="total", sparse=F){standardGeneric("getPhenoMat")}) #' @export @@ -1996,7 +1991,7 @@ setMethod("getPhenoMat", "Eval", function(object, time="total", sparse=F){ #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) #' minePheno(eval) setGeneric("minePheno", function(object, plot_type="pca", legend=F, time="total"){standardGeneric("minePheno")}) #' @export @@ -2056,8 +2051,8 @@ setMethod("minePheno", "Eval", function(object, plot_type="pca", legend=F, time= #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) -#' selPheno(eval,time=10,type='ecoli_core_model',reduce=TRUE) +#' eval <- simEnv(arena,5) +#' selPheno(eval,time=5,type='ecoli_core_model',reduce=TRUE) setGeneric("selPheno", function(object, time, type, reduce=F){standardGeneric("selPheno")}) #' @export #' @rdname selPheno @@ -2134,7 +2129,7 @@ setMethod(show, signature(object="Eval"), function(object){ #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) #' statPheno(eval, type_nr=1, phenotype_nr=2) setGeneric("statPheno", function(object, type_nr=1, phenotype_nr, dict=NULL){standardGeneric("statPheno")}) #' @export @@ -2407,9 +2402,9 @@ setMethod("findFeeding2", "Eval", function(object, time, mets, rm_own=T, ind_thr vertexatt = data.frame(name = names(object@specs),color=1:length(object@specs),weight=as.vector(table(object@simlist[[time]]$type))) g <- igraph::graph.data.frame(inter[,1:2], directed=TRUE, vertices=vertexatt) l <- igraph::layout.kamada.kawai(g) - plot(g,vertex.size=vertexatt$weight/max(vertexatt$weight)*20,edge.color=rainbow(length(levels(inter$met)))[as.numeric(inter$met)], + plot(g,vertex.size=vertexatt$weight/max(vertexatt$weight)*20,edge.color=grDevices::rainbow(length(levels(inter$met)))[as.numeric(inter$met)], edge.arrow.size=0.5,edge.width=(inter$rel_prod*inter$rel_cons)*5,vertex.color=vertexatt$color+1,layout=l) - legend("bottomright",legend=levels(inter$met),col=rainbow(length(levels(inter$met))), pch=19, cex=0.7) + legend("bottomright",legend=levels(inter$met),col=grDevices::rainbow(length(levels(inter$met))), pch=19, cex=0.7) return(list(inter,g)) }) @@ -2445,9 +2440,9 @@ setMethod("findFeeding3", "Eval", function(object, time, mets){ } g <- igraph::graph.data.frame(inter[,1:2], directed=TRUE) l <- igraph::layout.kamada.kawai(g) - plot(g,edge.color=rainbow(length(levels(inter$met)))[as.numeric(inter$met)], + plot(g,edge.color=grDevices::rainbow(length(levels(inter$met)))[as.numeric(inter$met)], edge.width=3,edge.arrow.size=0.8,vertex.color=1:length(V(g)),layout=l) - legend("bottomright",legend=levels(inter$met),col=rainbow(length(levels(inter$met))), pch=19, cex=0.7) + legend("bottomright",legend=levels(inter$met),col=grDevices::rainbow(length(levels(inter$met))), pch=19, cex=0.7) return(list(inter,g)) }) @@ -2525,7 +2520,7 @@ setMethod("statSpec", "Eval", function(object, type_nr=1, dict=NULL, #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) #' getCorrM(eval) setGeneric("getCorrM", function(object, reactions=TRUE, bacs=TRUE, substrates=TRUE){standardGeneric("getCorrM")}) #' @export @@ -2581,7 +2576,7 @@ setMethod("getCorrM", "Eval", function(object, reactions=TRUE, bacs=TRUE, substr #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' eval <- simEnv(arena,10) +#' eval <- simEnv(arena,5) #' checkCorr(eval, tocheck="o2") setGeneric("checkCorr", function(object, corr=NULL, tocheck=list()){standardGeneric("checkCorr")}) #' @export @@ -2625,7 +2620,7 @@ setMethod("plotShadowCost", "Eval", function(object, spec_nr=1, sub_nr=10, cutof df <- as.data.frame(m) colnames(df) <- names(object@shadowlist[[1]][[spec_nr]]) - variance <- apply(m,2,var) + variance <- apply(m,2,stats::var) sorted_var <- sort(variance, decreasing=T, index.return=T) df <- df[,sorted_var$ix[1:sub_nr]] @@ -2635,10 +2630,10 @@ setMethod("plotShadowCost", "Eval", function(object, spec_nr=1, sub_nr=10, cutof df <- reshape2::melt(df, id.vars="time") colnames(df)[2:3] <- c("sub", "shadow") - q1 <- ggplot(df, aes(x=time, y=shadow)) + geom_line(aes(col=sub), size=1) + q1 <- ggplot2::ggplot(df, ggplot2::aes(x=df$time, y=df$shadow)) + ggplot2::geom_line(ggplot2::aes(col=df$sub), size=1) - q2 <- ggplot(df, aes(factor(sub), shadow)) + geom_boxplot(aes(color=factor(sub), fill=factor(sub)), alpha=0.2) + ggtitle(names(object@specs)[spec_nr]) + - theme(axis.text.x = element_blank()) + q2 <- ggplot2::ggplot(df, ggplot2::aes(factor(df$sub), df$shadow)) + ggplot2::geom_boxplot(ggplot2::aes(color=factor(df$sub), fill=factor(df$sub)), alpha=0.2) + ggplot2::ggtitle(names(object@specs)[spec_nr]) + + ggplot2::theme(axis.text.x = ggplot2::element_blank()) return(list(q1, q2)) }) diff --git a/R/Organism.R b/R/Organism.R index 277b7cb..b0e6387 100644 --- a/R/Organism.R +++ b/R/Organism.R @@ -25,8 +25,8 @@ #' @slot speed A integer vector representing the speed by which bacterium is moving (given by cell per iteration). #' @slot cellarea A numeric value indicating the surface that one organism occupies (unit: mu cm^2) #' @slot maxweight A numeric value giving the maximal dry weight of single organism (unit: fg) -#' @param cellweight_mean A numeric giving the mean of starting biomass -#' @param cellweight_sd A numeric giving the standard derivation of starting biomass +#' @slot cellweight_mean A numeric giving the mean of starting biomass +#' @slot cellweight_sd A numeric giving the standard derivation of starting biomass #' @slot model Object of class sybil::modelorg containging the genome sclae metabolic model setClass("Organism", representation( @@ -351,13 +351,6 @@ setMethod("consume", "Organism", function(object, sublb, cutoff=1e-6, bacnum, fb #' @return Returns the phenotype of the organisms where the uptake of substances is indicated by a negative and production of substances by a positive number #' @details The phenotypes are defined by flux through exchange reactions, which indicate potential differential substrate usages. Uptake of substances is indicated by a negative and production of substances by a positive number. #' @seealso \code{\link{Organism-class}}, \code{\link{checkPhen}} and \code{\link{minePheno}} -#' @examples -#' \dontrun{ -#' data(Ec_core, envir = environment()) #get Escherichia coli core metabolic model -#' org <- Organism(Ec_core,deathrate=0.05, -#' minweight=0.05,growtype="exponential") #initialize a organism -#' getPhenotype(org) -#' } setGeneric("getPhenotype", function(object, cutoff=1e-6, fbasol, par=FALSE){standardGeneric("getPhenotype")}) #' @export #' @rdname getPhenotype @@ -383,11 +376,6 @@ setMethod("getPhenotype", "Organism", function(object, cutoff=1e-6, fbasol, par= #' @return Returns the updated biomass of the organisms of interest. #' @details Linear growth of organisms is implemented by adding the calculated growthrate by \code{optimizeLP} to the already present growth value. #' @seealso \code{\link{Organism-class}} and \code{\link{optimizeLP}} -#' @examples -#' data(Ec_core, envir = environment()) #get Escherichia coli core metabolic model -#' org <- Organism(Ec_core,deathrate=0.05, -#' minweight=0.05,growtype="exponential") #initialize a organism -#' growLin(org,1) setGeneric("growLin", function(object, growth, fbasol){standardGeneric("growLin")}) #' @export #' @rdname growLin @@ -412,13 +400,6 @@ setMethod("growLin", "Organism", function(object, growth, fbasol){ #' @return Returns the updated biomass of the organisms of interest. #' @details Exponential growth of organisms is implemented by adding the calculated growthrate multiplied with the current growth calculated by \code{optimizeLP} plus to the already present growth value #' @seealso \code{\link{Organism-class}} and \code{\link{optimizeLP}} -#' @examples -#' \dontrun{ -#' data(Ec_core, envir = environment()) #get Escherichia coli core metabolic model -#' org <- Organism(Ec_core,deathrate=0.05, -#' minweight=0.05,growtype="exponential") #initialize a organism -#' growExp(org,1) -#' } setGeneric("growExp", function(object, growth, fbasol){standardGeneric("growExp")}) #' @export #' @rdname growExp @@ -548,7 +529,7 @@ setMethod("NemptyHood", "Organism", function(object, pos, n, m, x, y){ #' arena <- Arena(n=20,m=20) #initialize the environment #' arena <- addOrg(arena,bac,amount=10) #add 10 organisms #' arena <- addSubs(arena,40) #add all possible substances -#' move(bac,n=20,m=20,j=1,pos=arena@orgdat[,c('x','y')]) +#' move(bac,n=20,m=20,j=1,pos=arena@orgdat[,c('x','y')], occupyM=arena@occupyM) setGeneric("move", function(object, pos, n, m, j, occupyM){standardGeneric("move")}) #' @export #' @rdname move @@ -643,14 +624,6 @@ setMethod("chem", "Bac", function(object){return(object@chem)}) #' @return Boolean variable of the \code{j}th individual indicating if individual died. #' @details Linear growth of organisms is implemented by adding the calculated growthrate by \code{optimizeLP} to the already present growth value. Exponential growth of organisms is implemented by adding the calculated growthrate multiplied with the current growth calculated by \code{optimizeLP} plus to the already present growth value #' @seealso \code{\link{Bac-class}}, \code{\link{growLin}} and \code{\link{growExp}} -#' @examples -#' data(Ec_core, envir = environment()) #get Escherichia coli core metabolic model -#' bac <- Bac(Ec_core,deathrate=0.05, -#' minweight=0.05,growtype="exponential") #initialize a bacterium -#' arena <- Arena(n=20,m=20) #initialize the environment -#' arena <- addOrg(arena,bac,amount=10) #add 10 organisms -#' arena <- addSubs(arena,40) #add all possible substances -#' growth(bac,arena,1) setGeneric("growth", function(object, population, j, occupyM, fbasol){standardGeneric("growth")}) #' @export #' @rdname growth @@ -777,6 +750,7 @@ setMethod("chemotaxis", "Bac", function(object, population, j){ #' @param sublb A vector containing the substance concentrations in the current position of the individual of interest. #' @param sec_obj character giving the secondary objective for a bi-level LP if wanted. #' @param cutoff value used to define numeric accuracy. +#' @param pcut A number giving the cutoff value by which value of objective function is considered greater than 0. #' @return Returns the updated enivironment of the \code{population} parameter with all new positions of individuals on the grid and all new substrate concentrations. #' @details Bacterial individuals undergo step by step the following procedures: First the individuals are constrained with \code{constrain} to the substrate environment, then flux balance analysis is computed with \code{optimizeLP}, after this the substrate concentrations are updated with \code{consume}, then the bacterial growth is implemented with \code{growth}, the potential new phenotypes are added with \code{checkPhen}, finally the additional and conditional functions \code{lysis}, \code{move} or \code{chemotaxis} are performed. Can be used as a wrapper for all important bacterial functions in a function similar to \code{simEnv}. #' @seealso \code{\link{Bac-class}}, \code{\link{Arena-class}}, \code{\link{simEnv}}, \code{constrain}, \code{optimizeLP}, \code{consume}, \code{growth}, \code{checkPhen}, \code{lysis}, \code{move} and \code{chemotaxis} @@ -964,14 +938,6 @@ setMethod("changeFobj", "Human", function(object, new_fobj, model, alg="fba"){ #' @return Boolean variable of the \code{j}th individual indicating if individual died. #' @details Linear growth of organisms is implemented by adding the calculated growthrate by \code{optimizeLP} to the already present growth value. Exponential growth of organisms is implemented by adding the calculated growthrate multiplied with the current growth calculated by \code{optimizeLP} plus to the already present growth value. #' @seealso \code{\link{Human-class}}, \code{\link{growLin}} and \code{\link{growExp}} -#' @examples -#' data(Ec_core, envir = environment()) #get Escherichia coli core metabolic model -#' human <- Human(Ec_core,deathrate=0.05, -#' minweight=0.05,growtype="exponential") #initialize a bacterium -#' arena <- Arena(n=20,m=20) #initialize the environment -#' arena <- addOrg(arena,human,amount=10) #add 10 organisms -#' arena <- addSubs(arena,40) #add all possible substances -#' cellgrowth(human,arena,1) setGeneric("cellgrowth", function(object, population, j, occupyM, fbasol){standardGeneric("cellgrowth")}) #' @export #' @rdname cellgrowth diff --git a/R/Stuff.R b/R/Stuff.R index 5e641e7..3a4e4c3 100644 --- a/R/Stuff.R +++ b/R/Stuff.R @@ -187,7 +187,7 @@ reset_screen <- function(){ #' @export #' @rdname usd #' -usd <- function(y){mean(y) + sd(y)} +usd <- function(y){mean(y) + stats::sd(y)} #' @title Computer standard deviation lower bound #' #' @description Helper function to get lower error bounds in plotting @@ -195,7 +195,7 @@ usd <- function(y){mean(y) + sd(y)} #' @export #' @rdname lsd #' -lsd <- function(y){lb=mean(y)-sd(y); ifelse(lb<0,0,lb)} +lsd <- function(y){lb=mean(y)-stats::sd(y); ifelse(lb<0,0,lb)} #' @title Plot substance curve for several simulations @@ -210,10 +210,11 @@ lsd <- function(y){lb=mean(y)-sd(y); ifelse(lb<0,0,lb)} #' @param scol Vector with colors that should be used. #' @param ret_data Set true if data should be returned #' @param num_var Number of varying substances to be shown (if mediac is not specified) +#' @param unit Unit for the substances which should be used for plotting (default: mmol) #' #' @return list of three ggplot object for further formating #' -plotSubCurve <-function(simlist, mediac=NULL, time=c(NULL,NULL), scol=NULL,title="Substance curve with standard deviation",size=1,unit="mmol", ret_data=FALSE, num_var=10){ +plotSubCurve <-function(simlist, mediac=NULL, time=c(NULL,NULL), scol=NULL, unit="mmol", ret_data=FALSE, num_var=10){ if(length(simlist) < 1 | !all(lapply(simlist, class) == "Eval") == TRUE) stop("Simlist is invalid.") if(sum(mediac %in% simlist[[1]]@mediac) != length(mediac)) stop("Substance does not exist in exchange reactions.") if(all(!is.null(time)) && (!time[1] cutoff),,drop = FALSE] # do not drop if date is used further - q1 <- ggplot(df, aes(x=time, y=mflux)) + geom_line(aes(col=spec), size=1) + facet_wrap(~sub, scales="free_y")+ xlab("") + ylab("mmol/(h*g_dw)") + q1 <- ggplot2::ggplot(df, ggplot2::aes(x=df$time, y=df$mflux)) + ggplot2::geom_line(ggplot2::aes(col=df$spec), size=1) + ggplot2::facet_wrap(~df$sub, scales="free_y")+ ggplot2::xlab("") + ggplot2::ylab("mmol/(h*g_dw)") - q2 <- ggplot(df, aes(factor(spec), mflux)) + geom_boxplot(aes(color=factor(spec), fill=factor(spec)), alpha=0.2) + - facet_wrap(~sub, scales="free_y") + theme(axis.text.x = element_blank()) + xlab("") + ylab("mmol/(h*g_dw)") + q2 <- ggplot2::ggplot(df, ggplot2::aes(factor(df$spec), df$mflux)) + ggplot2::geom_boxplot(ggplot2::aes(color=factor(df$spec), fill=factor(df$spec)), alpha=0.2) + + ggplot2::facet_wrap(~sub, scales="free_y") + ggplot2::theme(axis.text.x =ggplot2::element_blank()) + ggplot2::xlab("") + ggplot2::ylab("mmol/(h*g_dw)") if(ret_data) return(df) else return(list(q1, q2)) } @@ -798,17 +798,17 @@ plotSpecActivity <- function(simlist, subs=list(), var_nr=10, spec_list=NULL, re if(length(subs)==0){ # in case subs is not specified take substances with highest variance mflux_var <- unlist(lapply(levels(df$sub), function(sub){ - var(df[which(df$sub==sub),]$mflux) + stats::var(df[which(df$sub==sub),]$mflux) })) names(mflux_var) <- levels(df$sub) mflux_var <- sort(mflux_var, decreasing = TRUE) df <- df[which(df$sub %in% names(mflux_var)[1:var_nr]),] } - q1 <- ggplot(df, aes(x=time, y=mflux)) + geom_line(aes(col=sub), size=1) + facet_wrap(~spec, scales="free_y") + xlab("") + ylab("mmol/(h*g_dw)") + q1 <- ggplot2::ggplot(df, ggplot2::aes(x=df$time, y=df$mflux)) + ggplot2::geom_line(ggplot2::aes(col=df$sub), size=1) + ggplot2::facet_wrap(~spec, scales="free_y") + ggplot2::xlab("") + ggplot2::ylab("mmol/(h*g_dw)") - q2 <- ggplot(df, aes(factor(sub), mflux)) + geom_boxplot(aes(color=factor(sub), fill=factor(sub)), alpha=0.2) + facet_wrap(~spec, scales="free_y") + - theme(axis.text.x = element_blank()) + xlab("") + ylab("mmol/(h*g_dw)") + q2 <- ggplot2::ggplot(df, ggplot2::aes(factor(df$sub), df$mflux)) + ggplot2::geom_boxplot(ggplot2::aes(color=factor(df$sub), fill=factor(df$sub)), alpha=0.2) + ggplot2::facet_wrap(~df$spec, scales="free_y") + + ggplot2::theme(axis.text.x =ggplot2::element_blank()) + ggplot2::xlab("") + ggplot2::ylab("mmol/(h*g_dw)") if(ret_data) return(df) else return(list(q1, q2)) } diff --git a/man/Organism-class.Rd b/man/Organism-class.Rd index bcbf724..8c25cdf 100644 --- a/man/Organism-class.Rd +++ b/man/Organism-class.Rd @@ -4,11 +4,6 @@ \name{Organism-class} \alias{Organism-class} \title{Structure of the S4 class "Organism"} -\arguments{ -\item{cellweight_mean}{A numeric giving the mean of starting biomass} - -\item{cellweight_sd}{A numeric giving the standard derivation of starting biomass} -} \description{ Structure of the S4 class \code{Organism} representing the organisms present in the environment. } @@ -45,6 +40,10 @@ Structure of the S4 class \code{Organism} representing the organisms present in \item{\code{maxweight}}{A numeric value giving the maximal dry weight of single organism (unit: fg)} +\item{\code{cellweight_mean}}{A numeric giving the mean of starting biomass} + +\item{\code{cellweight_sd}}{A numeric giving the standard derivation of starting biomass} + \item{\code{model}}{Object of class sybil::modelorg containging the genome sclae metabolic model} }} diff --git a/man/addEval.Rd b/man/addEval.Rd index 252507b..6e8f481 100644 --- a/man/addEval.Rd +++ b/man/addEval.Rd @@ -30,7 +30,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) addEval(eval,arena) } \seealso{ diff --git a/man/addSubs.Rd b/man/addSubs.Rd index d04498d..5bdef86 100644 --- a/man/addSubs.Rd +++ b/man/addSubs.Rd @@ -39,7 +39,7 @@ bac <- Bac(Ec_core,deathrate=0.05, minweight=0.05,growtype="exponential") #initialize a bacterium arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms -arena <- addSubs(arena,20,c("EX_glc(e)","EX_o2(e)","EX_pi(e)")) #add substances glucose, oxygen and phosphate +arena <- addSubs(arena,20,c("EX_glc(e)","EX_o2(e)","EX_pi(e)")) #add glucose, o2, pi } \seealso{ \code{\link{Arena-class}} and \code{\link{changeSub}} diff --git a/man/cellgrowth.Rd b/man/cellgrowth.Rd index 818ad10..ad12cd4 100644 --- a/man/cellgrowth.Rd +++ b/man/cellgrowth.Rd @@ -30,15 +30,6 @@ The generic function \code{cellgrowth} implements different growth models for an \details{ Linear growth of organisms is implemented by adding the calculated growthrate by \code{optimizeLP} to the already present growth value. Exponential growth of organisms is implemented by adding the calculated growthrate multiplied with the current growth calculated by \code{optimizeLP} plus to the already present growth value. } -\examples{ -data(Ec_core, envir = environment()) #get Escherichia coli core metabolic model -human <- Human(Ec_core,deathrate=0.05, - minweight=0.05,growtype="exponential") #initialize a bacterium -arena <- Arena(n=20,m=20) #initialize the environment -arena <- addOrg(arena,human,amount=10) #add 10 organisms -arena <- addSubs(arena,40) #add all possible substances -cellgrowth(human,arena,1) -} \seealso{ \code{\link{Human-class}}, \code{\link{growLin}} and \code{\link{growExp}} } diff --git a/man/checkCorr.Rd b/man/checkCorr.Rd index 3efaace..25db263 100644 --- a/man/checkCorr.Rd +++ b/man/checkCorr.Rd @@ -30,7 +30,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) checkCorr(eval, tocheck="o2") } \seealso{ diff --git a/man/checkPhen.Rd b/man/checkPhen.Rd index 82b97c3..0a359b5 100644 --- a/man/checkPhen.Rd +++ b/man/checkPhen.Rd @@ -28,13 +28,6 @@ The generic function \code{checkPhen} checks and adds the phenotypes of organism \details{ The phenotypes are defined by flux through exchange reactions, which indicate potential differential substrate usages. Uptake of substances are indicated by a negative and production of substances by a positive number. } -\examples{ -data(Ec_core, envir = environment()) #get Escherichia coli core metabolic model -bac <- Bac(Ec_core,deathrate=0.05, - minweight=0.05,growtype="exponential") #initialize a bacterium -arena <- Arena(n=20,m=20) #initialize the environment -checkPhen(arena,bac) #returns 1 as the index of the current phenotype in the list. -} \seealso{ \code{\link{Arena-class}} and \code{\link{getPhenotype}} } diff --git a/man/evalArena.Rd b/man/evalArena.Rd index 49666a0..4433118 100644 --- a/man/evalArena.Rd +++ b/man/evalArena.Rd @@ -45,7 +45,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) evalArena(eval) \dontrun{ ## if animation package is installed a movie of the simulation can be stored: diff --git a/man/extractMed.Rd b/man/extractMed.Rd index 5ede044..c75c2dc 100644 --- a/man/extractMed.Rd +++ b/man/extractMed.Rd @@ -34,7 +34,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) med5 <- extractMed(eval,5) } \seealso{ diff --git a/man/findFeeding3.Rd b/man/findFeeding3.Rd new file mode 100644 index 0000000..ca0a7bb --- /dev/null +++ b/man/findFeeding3.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Arena.R +\docType{methods} +\name{findFeeding3} +\alias{findFeeding3} +\alias{findFeeding3,Eval-method} +\title{Function for investigation of feeding between phenotypes} +\usage{ +findFeeding3(object, time, mets) + +\S4method{findFeeding3}{Eval}(object, time, mets) +} +\arguments{ +\item{object}{An object of class Eval.} + +\item{time}{A numeric vector giving the simulation steps which should be plotted.} + +\item{mets}{Character vector of substance names which should be considered} +} +\value{ +Graph (igraph) +} +\description{ +The generic function \code{findFeeding3} +} + diff --git a/man/getArena.Rd b/man/getArena.Rd index e720451..1d093bf 100644 --- a/man/getArena.Rd +++ b/man/getArena.Rd @@ -31,7 +31,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) arena5 <- getArena(eval,5) } \seealso{ diff --git a/man/getCorrM.Rd b/man/getCorrM.Rd index 06d63f8..dff921f 100644 --- a/man/getCorrM.Rd +++ b/man/getCorrM.Rd @@ -36,7 +36,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) getCorrM(eval) } \seealso{ diff --git a/man/getPhenoMat.Rd b/man/getPhenoMat.Rd index be3d0f0..f0097ae 100644 --- a/man/getPhenoMat.Rd +++ b/man/getPhenoMat.Rd @@ -33,7 +33,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) phenmat <- getPhenoMat(eval) } \seealso{ diff --git a/man/growExp.Rd b/man/growExp.Rd index 1cd28df..7ce9b38 100644 --- a/man/growExp.Rd +++ b/man/growExp.Rd @@ -26,14 +26,6 @@ The generic function \code{growExp} implements a growth model of organisms in th \details{ Exponential growth of organisms is implemented by adding the calculated growthrate multiplied with the current growth calculated by \code{optimizeLP} plus to the already present growth value } -\examples{ -\dontrun{ -data(Ec_core, envir = environment()) #get Escherichia coli core metabolic model -org <- Organism(Ec_core,deathrate=0.05, - minweight=0.05,growtype="exponential") #initialize a organism -growExp(org,1) -} -} \seealso{ \code{\link{Organism-class}} and \code{\link{optimizeLP}} } diff --git a/man/growLin.Rd b/man/growLin.Rd index 8675f88..4311bfd 100644 --- a/man/growLin.Rd +++ b/man/growLin.Rd @@ -26,12 +26,6 @@ The generic function \code{growLin} implements a growth model of organisms in th \details{ Linear growth of organisms is implemented by adding the calculated growthrate by \code{optimizeLP} to the already present growth value. } -\examples{ -data(Ec_core, envir = environment()) #get Escherichia coli core metabolic model -org <- Organism(Ec_core,deathrate=0.05, - minweight=0.05,growtype="exponential") #initialize a organism -growLin(org,1) -} \seealso{ \code{\link{Organism-class}} and \code{\link{optimizeLP}} } diff --git a/man/growth.Rd b/man/growth.Rd index 1bbf803..9334037 100644 --- a/man/growth.Rd +++ b/man/growth.Rd @@ -30,15 +30,6 @@ The generic function \code{growth} implements different growth models for an obj \details{ Linear growth of organisms is implemented by adding the calculated growthrate by \code{optimizeLP} to the already present growth value. Exponential growth of organisms is implemented by adding the calculated growthrate multiplied with the current growth calculated by \code{optimizeLP} plus to the already present growth value } -\examples{ -data(Ec_core, envir = environment()) #get Escherichia coli core metabolic model -bac <- Bac(Ec_core,deathrate=0.05, - minweight=0.05,growtype="exponential") #initialize a bacterium -arena <- Arena(n=20,m=20) #initialize the environment -arena <- addOrg(arena,bac,amount=10) #add 10 organisms -arena <- addSubs(arena,40) #add all possible substances -growth(bac,arena,1) -} \seealso{ \code{\link{Bac-class}}, \code{\link{growLin}} and \code{\link{growExp}} } diff --git a/man/minePheno.Rd b/man/minePheno.Rd index 50ef71c..c78507f 100644 --- a/man/minePheno.Rd +++ b/man/minePheno.Rd @@ -36,7 +36,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) minePheno(eval) } \seealso{ diff --git a/man/move.Rd b/man/move.Rd index 8629c14..5317bb5 100644 --- a/man/move.Rd +++ b/man/move.Rd @@ -36,7 +36,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -move(bac,n=20,m=20,j=1,pos=arena@orgdat[,c('x','y')]) +move(bac,n=20,m=20,j=1,pos=arena@orgdat[,c('x','y')], occupyM=arena@occupyM) } \seealso{ \code{\link{Organism-class}}, \code{\link{emptyHood}} diff --git a/man/plotAbundance.Rd b/man/plotAbundance.Rd index 07fbdb4..07b0a1f 100644 --- a/man/plotAbundance.Rd +++ b/man/plotAbundance.Rd @@ -2,13 +2,10 @@ % Please edit documentation in R/Stuff.R \name{plotAbundance} \alias{plotAbundance} -\alias{plotSubVar} \title{Plot abundances of species} \usage{ plotAbundance(simlist, time = c(NULL, NULL), col = colpal3, return_dat = F, use_biomass = F) - -plotSubVar(simlist, metsel) } \arguments{ \item{simlist}{A list of simulations (eval objects).} @@ -20,14 +17,8 @@ plotSubVar(simlist, metsel) \item{return_dat}{Should plain text mean abundances be returned? (default false)} \item{use_biomass}{If enabled then biomass is used instead of cell number} - -\item{simlist}{A list of simulations (eval objects).} - -\item{metlist}{A vector with the name of exchange reactions of interest} } \description{ The function \code{plotAbundance} takes a list of simulations and return a boxplot with species abundances - -The function \code{plotSubVar} takes a list of simulations and return a barplot with most varying substances } diff --git a/man/plotCurves.Rd b/man/plotCurves.Rd index 01818bf..78f1650 100644 --- a/man/plotCurves.Rd +++ b/man/plotCurves.Rd @@ -39,7 +39,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) plotCurves(eval) } \seealso{ diff --git a/man/plotCurves2.Rd b/man/plotCurves2.Rd index ce52d1d..6bc5811 100644 --- a/man/plotCurves2.Rd +++ b/man/plotCurves2.Rd @@ -52,7 +52,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) plotCurves2(eval) } \seealso{ diff --git a/man/plotFluxVar.Rd b/man/plotFluxVar.Rd new file mode 100644 index 0000000..c534d80 --- /dev/null +++ b/man/plotFluxVar.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Stuff.R +\name{plotFluxVar} +\alias{plotFluxVar} +\title{Plot population flux variations} +\usage{ +plotFluxVar(simlist, metsel) +} +\arguments{ +\item{simlist}{A list of simulations (eval objects).} + +\item{metsel}{A vector with the name of exchange reactions of interest} +} +\description{ +The function \code{plotFluxVar} takes a list of simulations and metabolites, returning a plot with metabolite fluxes for each species +} + diff --git a/man/plotGrowthCurve.Rd b/man/plotGrowthCurve.Rd index e4be7d2..04ae3ae 100644 --- a/man/plotGrowthCurve.Rd +++ b/man/plotGrowthCurve.Rd @@ -4,8 +4,7 @@ \alias{plotGrowthCurve} \title{Plot growth curve for several simulations} \usage{ -plotGrowthCurve(simlist, bcol = colpal3, time = c(NULL, NULL), title = "", - size = 1) +plotGrowthCurve(simlist, bcol = colpal3, time = c(NULL, NULL)) } \arguments{ \item{simlist}{A list of simulations (eval objects).} diff --git a/man/plotInterNum.Rd b/man/plotInterNum.Rd index 08ab3f6..3073dba 100644 --- a/man/plotInterNum.Rd +++ b/man/plotInterNum.Rd @@ -10,6 +10,8 @@ plotInterNum(simlist, title = "Variation in number of interactions", \arguments{ \item{simlist}{A list of simulations (eval objects).} +\item{title}{Title of the plot} + \item{size}{A scaling factor for plot text and line size} } \description{ diff --git a/man/plotPhenNum.Rd b/man/plotPhenNum.Rd index cfa297b..5404820 100644 --- a/man/plotPhenNum.Rd +++ b/man/plotPhenNum.Rd @@ -9,6 +9,8 @@ plotPhenNum(simlist, title = "Phenotype number variation", size = 1) \arguments{ \item{simlist}{A list of simulations (eval objects).} +\item{title}{Title of the plot} + \item{size}{A scaling factor for plot text and line size} } \description{ diff --git a/man/plotShadowCost.Rd b/man/plotShadowCost.Rd new file mode 100644 index 0000000..7014ce2 --- /dev/null +++ b/man/plotShadowCost.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Arena.R +\docType{methods} +\name{plotShadowCost} +\alias{plotShadowCost} +\alias{plotShadowCost,Eval-method} +\title{Function to plot substance shadow costs for a specie} +\usage{ +plotShadowCost(object, spec_nr = 1, sub_nr = 10, cutoff = -1) + +\S4method{plotShadowCost}{Eval}(object, spec_nr = 1, sub_nr = 10, + cutoff = -1) +} +\arguments{ +\item{object}{An object of class Eval.} + +\item{spec_nr}{Number of the specie} + +\item{sub_nr}{Maximal number of substances to be show} + +\item{cutoff}{Shadow costs should be smaller than cutoff} +} +\description{ +The generic function \code{plotShadowCost} plots substances have the highest impact on further growth (shadow cost < 0) +} +\details{ +Returns ggplot objects +} + diff --git a/man/plotSubCurve.Rd b/man/plotSubCurve.Rd index 73a8b94..173ad04 100644 --- a/man/plotSubCurve.Rd +++ b/man/plotSubCurve.Rd @@ -5,7 +5,6 @@ \title{Plot substance curve for several simulations} \usage{ plotSubCurve(simlist, mediac = NULL, time = c(NULL, NULL), scol = NULL, - title = "Substance curve with standard deviation", size = 1, unit = "mmol", ret_data = FALSE, num_var = 10) } \arguments{ @@ -17,6 +16,8 @@ plotSubCurve(simlist, mediac = NULL, time = c(NULL, NULL), scol = NULL, \item{scol}{Vector with colors that should be used.} +\item{unit}{Unit for the substances which should be used for plotting (default: mmol)} + \item{ret_data}{Set true if data should be returned} \item{num_var}{Number of varying substances to be shown (if mediac is not specified)} diff --git a/man/plotSubVar.Rd b/man/plotSubVar.Rd new file mode 100644 index 0000000..952ea1f --- /dev/null +++ b/man/plotSubVar.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Stuff.R +\name{plotSubVar} +\alias{plotSubVar} +\title{Plot substance variations} +\usage{ +plotSubVar(simlist, metsel) +} +\arguments{ +\item{simlist}{A list of simulations (eval objects).} + +\item{metsel}{A vector with the name of exchange reactions of interest} +} +\description{ +The function \code{plotSubVar} takes a list of simulations and return a barplot with most varying substances +} + diff --git a/man/plotTotFlux.Rd b/man/plotTotFlux.Rd index 8a19fb2..e51bc17 100644 --- a/man/plotTotFlux.Rd +++ b/man/plotTotFlux.Rd @@ -27,7 +27,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) plotTotFlux(eval) } diff --git a/man/redEval.Rd b/man/redEval.Rd index b7f19e0..ac2e7af 100644 --- a/man/redEval.Rd +++ b/man/redEval.Rd @@ -31,7 +31,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) eval_reduce <- redEval(eval,5) } \seealso{ diff --git a/man/selPheno.Rd b/man/selPheno.Rd index bd00623..a901ca5 100644 --- a/man/selPheno.Rd +++ b/man/selPheno.Rd @@ -35,8 +35,8 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) -selPheno(eval,time=10,type='ecoli_core_model',reduce=TRUE) +eval <- simEnv(arena,5) +selPheno(eval,time=5,type='ecoli_core_model',reduce=TRUE) } \seealso{ \code{\link{Eval-class}} and \code{\link{getPhenoMat}} diff --git a/man/simBac.Rd b/man/simBac.Rd index 8fb86d1..1f9d5fc 100644 --- a/man/simBac.Rd +++ b/man/simBac.Rd @@ -26,6 +26,8 @@ simBac(object, arena, j, sublb, bacnum, sec_obj = "none", cutoff = 1e-06, \item{sec_obj}{character giving the secondary objective for a bi-level LP if wanted.} \item{cutoff}{value used to define numeric accuracy.} + +\item{pcut}{A number giving the cutoff value by which value of objective function is considered greater than 0.} } \value{ Returns the updated enivironment of the \code{population} parameter with all new positions of individuals on the grid and all new substrate concentrations. diff --git a/man/simEnv.Rd b/man/simEnv.Rd index abf3886..75f1c7e 100644 --- a/man/simEnv.Rd +++ b/man/simEnv.Rd @@ -34,6 +34,8 @@ simEnv(object, time, lrw = NULL, continue = FALSE, reduce = FALSE, \item{sec_obj}{character giving the secondary objective for a bi-level LP if wanted.} \item{cutoff}{value used to define numeric accuracy} + +\item{pcut}{A number giving the cutoff value by which value of objective function is considered greater than 0.} } \value{ Returns an object of class \code{Eval} which can be used for subsequent analysis steps. @@ -51,7 +53,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) } \seealso{ \code{\link{Arena-class}} and \code{\link{Eval-class}} diff --git a/man/simEnv_par.Rd b/man/simEnv_par.Rd index 85cf2eb..fc5cb40 100644 --- a/man/simEnv_par.Rd +++ b/man/simEnv_par.Rd @@ -49,7 +49,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) } \seealso{ \code{\link{Arena-class}} and \code{\link{Eval-class}} diff --git a/man/statPheno.Rd b/man/statPheno.Rd index 30e392e..b185bdf 100644 --- a/man/statPheno.Rd +++ b/man/statPheno.Rd @@ -32,7 +32,7 @@ bac <- Bac(Ec_core,deathrate=0.05, arena <- Arena(n=20,m=20) #initialize the environment arena <- addOrg(arena,bac,amount=10) #add 10 organisms arena <- addSubs(arena,40) #add all possible substances -eval <- simEnv(arena,10) +eval <- simEnv(arena,5) statPheno(eval, type_nr=1, phenotype_nr=2) } \seealso{ diff --git a/vignettes/BacArena-Introduction.Rmd b/vignettes/BacArena-Introduction.Rmd index a0a94eb..e5f2fe3 100644 --- a/vignettes/BacArena-Introduction.Rmd +++ b/vignettes/BacArena-Introduction.Rmd @@ -3,16 +3,13 @@ title: "BacArena - An Agent-Based Modeling Framework for Cellular Communities" author: "Eugen Bauer and Johannes Zimmermann" date: "`r Sys.Date()`" output: - rmarkdown::html_vignette: - toc: true - rmarkdown::pdf_vignette: - toc: true -#output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{Vignette Title} - %\VignetteEngine{knitr::rmarkdown} - \usepackage[utf8]{inputenc} + html_document: + theme: flatly --- + # Introduction to BacArena