most of new versions for modelorg implemented

DESCRIPTION

 Package: sybil
 Type: Package
 Title: Efficient Constrained Based Modelling in R
-Version: 1.3.4
-Date: 2015-04-18
+Version: 2.0.0
+Date: 2016-05-12
 Authors@R: c(
 	     person(c("C.", "Jonathan"), "Fritzemeier", role = c("cre", "ctb"), email = "clausjonathan.fritzemeier@uni-duesseldorf.de"),
 	     person("Gabriel", "Gelius-Dietrich", role = c("aut")),
@@ -52,8 +52,8 @@ Collate: generics.R validmodelorg.R validoptsol.R validreactId.R
         sysBiolAlg_fbaEasyConstraintClass.R sysBiolAlg_fvClass.R
         sysBiolAlg_lmomaClass.R sysBiolAlg_momaClass.R
         sysBiolAlg_mtfClass.R sysBiolAlg_mtfEasyConstraintClass.R
-        sysBiolAlg_roomClass.R sybilLogClass.R
-Packaged: 2016-01-27 12:34:14 UTC; jonathan
+        sysBiolAlg_roomClass.R sybilLogClass.R upgradeModelorg.R
+Packaged: 2016-05-12 12:34:14 UTC; jonathan
 Author: C. Jonathan Fritzemeier [cre, ctb],
   Gabriel Gelius-Dietrich [aut],
   Rajen Piernikarczyk [ctb],

R/addReact.R

@@ -54,6 +54,10 @@ addReact <- function(model,
         stop("needs an object of class modelorg!")
     }
 	
+	if(!.hasSlot(model, "version")){
+		validObject(model)
+	}
+
     if (length(met) != length(Scoef)) {
         stop("arguments 'met' and 'Scoef' must have the same length")
     }
@@ -291,12 +295,13 @@ addReact <- function(model,
                 newgenes <- append(genes(model), list(gene_rule$gene))
                 newrule  <- gene_rule$rule
 				
-                for (j in 1 : length(geneInd)) {
-                    pat  <- paste("x(", j, ")", sep = "")
-                    repl <- paste("x[", geneInd[j], "]", sep = "")
-    
-                    newrule <- gsub(pat, repl, newrule, fixed = TRUE)
-                }
+				# not needed for modelorg version 2.0
+#                for (j in 1 : length(geneInd)) {
+#                    pat  <- paste("x(", j, ")", sep = "")
+#                    repl <- paste("x[", geneInd[j], "]", sep = "")
+#    
+#                    newrule <- gsub(pat, repl, newrule, fixed = TRUE)
+#                }
 
                 newgprRules <- append(gprRules(model), newrule)
             }

R/geneDel.R

@@ -41,6 +41,10 @@ geneDel <- function(model, genes, checkId = FALSE) {
       stop("needs an object of class modelorg!")
   }
   
+  if(!.hasSlot(model, "version")){
+  	validObject(model)
+  }
+  
   if (isTRUE(checkId)) {
       if (is(genes, "character")) {
           # Check if all genes are there

R/generics.R

@@ -126,6 +126,10 @@ setGeneric(name = "checkStat",
            def  = function(opt) { standardGeneric("checkStat") }
 )
 
+setGeneric(name = "checkVersion",
+           def  = function(object, ...) { standardGeneric("checkVersion") }
+)
+
 setGeneric(name = "chlb",
            def  = function(object) { standardGeneric("chlb") }
 )
@@ -945,6 +949,13 @@ setGeneric(name = "verblevel<-",
            def  = function(object, value) { standardGeneric("verblevel<-") }
 )
 
+setGeneric(name = "version",
+           def  = function(object) { standardGeneric("version") }
+)
+setGeneric(name = "version<-",
+           def  = function(object, value) { standardGeneric("version<-") }
+)
+
 setGeneric(name = "writeProb",
            def  = function(lp, fname, ff = "lp", ...) { standardGeneric("writeProb") }
 )

R/modelorgClass.R

@@ -55,6 +55,7 @@ setClass("modelorg",
          lowbnd       = "numeric",     # vector reactions lower bounds
          uppbnd       = "numeric",     # vector reactions upper bounds
          obj_coef     = "numeric",     # vector objective coefficients
+         version      = "character",   # version to be compatible with changes in the class
          gprRules     = "character",
          genes        = "list",
          gpr          = "character",
@@ -113,6 +114,7 @@ setMethod(f = "initialize",
                   .Object@S          <- Matrix::Matrix(0, 0, 0)
                   .Object@rxnGeneMat <- Matrix::Matrix(0, 0, 0)
                   .Object@subSys     <- Matrix::Matrix(0, 0, length(subSys))
+                  .Object@version    <- SYBIL_SETTINGS("MODELORG_VERSION")
                   if (!is.null(subSys)) {
                       colnames(.Object@subSys) <- as.character(subSys)
                   }
@@ -548,6 +550,21 @@ setReplaceMethod("subSys", signature(object = "modelorg"),
           }
 )
 
+# reaction sub systems
+setMethod("version", signature(object = "modelorg"),
+          function(object) {
+              return(object@version)
+          }
+)
+
+setReplaceMethod("version", signature(object = "modelorg"),
+          function(object, value) {
+              object@version <- value
+              stopifnot(validObject(object))
+              return(object)
+          }
+)
+
 
 #------------------------------------------------------------------------------#
 #                               other methods                                  #
@@ -1073,11 +1090,22 @@ setMethod("singletonMetabolites", signature(object = "modelorg"),
     }
 )
 
+#------------------------------------------------------------------------------#
 
 
 
+setMethod("checkVersion", signature(object = "modelorg"),
+	function(object) {
+		if(!.hasSlot(object, "version")){
+			stop("No version slot found. Please use upgradeModelorg on object")
+		}
 		
-
+		if(compareVersion(version(object), SYBIL_SETTINGS("MODELORG_VERSION")) == 0){
+			return(TRUE)
+		}
+		stop(paste0("modelorg has version ", object(version), ", but you need at least version ", version))
+	}
+)
 
 
 

R/parseBoolean.R

@@ -88,7 +88,7 @@
   gene_uniq <- unique(genes)
 
   newTok    <- match(genes, gene_uniq)
-  newTok    <- sapply(newTok, function(x) paste("x(", x, ")", sep = ""))
+  newTok    <- sapply(newTok, function(x) paste("x[", x, "]", sep = ""))
 
 #  rule <- 
   

R/readTSVmod.R

@@ -950,12 +950,13 @@ readTSVmod <- function(prefix, suffix,
             geneInd <- match(Rgenes[[i]], allGenes)
             rxnGeneMat[i, geneInd] <- TRUE
 			
-            for (j in 1 : length(geneInd)) {
-                pat  <- paste("x(", j, ")", sep = "")
-                repl <- paste("x[", geneInd[j], "]", sep = "")
+			# not needed for version 2.0 modelorgs
+#            for (j in 1 : length(geneInd)) {
+#                pat  <- paste("x(", j, ")", sep = "")
+#                repl <- paste("x[", geneInd[j], "]", sep = "")
 
-                Rrules[i] <- gsub(pat, repl, Rrules[i], fixed = TRUE)
-            }
+#                Rrules[i] <- gsub(pat, repl, Rrules[i], fixed = TRUE)
+#            }
         }
 
     }

R/rmReact.R

@@ -42,6 +42,9 @@ rmReact <- function(model, react, rm_met = TRUE) {
 		stop("needs an object of class modelorg!")
 	}
 	
+	if(!.hasSlot(model, "version")){
+		validObject(model)
+	}
 
 	# check this, propably working wrong
 	if (is.na(match(is(react)[1], c("reactId", "numeric", "integer", "character")))) {

R/settings.R

@@ -42,6 +42,9 @@ SYBIL_SETTINGS <- function(parm, value, ...) {
     }
     
     switch(parm,
+        "MODELORG_VERSION" = {
+        	stop("this value must not be set by the user!")
+        },
     
         "SOLVER" = {
 

R/upgradeModelorg.R

+#  upgradeModelorg.R
+#  FBA and friends with R.
+#
+#  Copyright (C) 2010-2016 Claus Jonathan Fritzemeier, Dpt. for Bioinformatics,
+#  Institute for Informatics, Heinrich-Heine-University, Duesseldorf, Germany.
+#  All right reserved.
+#  Email: clausjonathan.fritzemeier@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: upgradeModelorg
+#
+# Takes an instance of a old modelorg version and returns one updated to the
+# current version.
+#
+
+
+upgradeModelorg <- function(object){
+	stopifnot(is(object, "modelorg"))
+	
+	if(!.hasSlot(object, "version")){
+		# object is from a time before versions were introduced.
+		# just add version slot and run again.
+		object@version <- "2.0"
+		
+		rules <- lapply(gpr(object), sybil:::.parseBoolean)
+		genes(object) <- sapply(rules, "[[", "gene")
+		gprRules(object) <- sapply(rules, "[[", "rule")
+		
+		#recursively upgrad to latest version.
+		return(upgradeModelorg(object))
+	}
+	
+	if(compareVersion(version(object), SYBIL_SETTINGS("MODELORG_VERSION")) == 0){
+		stopifnot(validObject(object))
+		return(object)
+	}
+	
+	stop("unsupported version of modelorg")
+}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

R/validmodelorg.R

@@ -38,6 +38,15 @@
         return("needs an object of class modelorg!")
     }
     
+    if(compareVersion(version(object), SYBIL_SETTINGS("MODELORG_VERSION")) != 0){
+		if(compareVersion(version(object), SYBIL_SETTINGS("MODELORG_VERSION")) == -1){
+			return("You are using an old version of the modelorg-Class. Use upgradeModelorg to get a compatible object!")
+		}
+		if(compareVersion(version(object), SYBIL_SETTINGS("MODELORG_VERSION")) == 1){
+			return("You are using a new version of the modelorg-Class. Plase upgrade your sybil package!")
+		}
+    }
+    
     if ((length(mod_id(object)) != 1) || (length(mod_name(object)) != 1)) {
         return("mod_id and mod_name must have a length of 1!")
     }

R/zzz.R

@@ -36,6 +36,7 @@
     # settings in sybil
 
     .SYBILenv$settings <- list(
+        MODELORG_VERSION = "2.0",
         SOLVER           = "glpkAPI",
         METHOD           = "simplex",
         TOLERANCE        = 1E-6,