Commit 8fde1e9e authored by Claus Jonathan Fritzemeier's avatar Claus Jonathan Fritzemeier
Browse files

initial commit of version 2.0.8

parent 6e7de339
Package: sybilSBML
Type: Package
Title: SBML Integration in Package sybil
Version: 2.0.8
Date: 2014-05-21
Authors@R: c(person("Gabriel", "Gelius-Dietrich", role = c("aut", "cre"), email = "geliudie@uni-duesseldorf.de"),
person("Deya", "Alzoubi", role = "ctb"))
Maintainer: Gabriel Gelius-Dietrich <geliudie@uni-duesseldorf.de>
Depends: R (>= 2.14.2), Matrix, sybil (>= 1.2.4)
Imports: methods
Description: SBML (Systems Biology Markup Language) integration in sybil
License: GPL-3
LazyLoad: yes
Collate: generics.R sbmlPtrClass.R sbmlErrorClass.R sybilSBML.R
uglyHack.R readSBMLmod.R zzz.R
Packaged: 2014-05-21 07:11:55 UTC; gabriel
Author: Gabriel Gelius-Dietrich [aut, cre],
Deya Alzoubi [ctb]
NeedsCompilation: yes
Repository: CRAN
Date/Publication: 2014-05-21 10:15:25
useDynLib(sybilSBML)
import(methods)
import(Matrix)
import(sybil)
exportClass(
sbmlPtr,
sbmlError
)
export(
# methods
sbmlPtrType,
sbmlPointer,
sbmlDocKey,
sbmlFileName,
isNULLpointerSBML,
isSBMLdocpointer,
isSBMLmodpointer,
sbmlInfos,
sbmlWarnings,
sbmlErrors,
sbmlFatals,
sbmlDocKey,
sbmlFileName,
getNumErrors,
printSlot,
# function names
sbmlDocPointer,
sbmlModPointer,
sbmlError,
versionLibSBML,
openSBMLfile,
closeSBMLfile,
getSBMLmodel,
delSBMLmodel,
getSBMLlevel,
getSBMLversion,
validateSBMLdocument,
getSBMLerrors,
getSBMLmodId,
getSBMLmodName,
getSBMLnumCompart,
getSBMLnumSpecies,
getSBMLnumReactions,
getSBMLunitDefinitionsList,
getSBMLCompartList,
getSBMLSpeciesList,
getSBMLReactionsList,
readSBMLmod
)
#------------------------------------------------------------------------------#
# Link to libSBML for sybil #
#------------------------------------------------------------------------------#
# generics.R
# Link to libSBML for sybil.
#
# Copyright (C) 2010-2013 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 sybilSBML.
#
# SybilSBML 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.
#
# SybilSBML 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 SybilSBML. If not, see <http://www.gnu.org/licenses/>.
#------------------------------------------------------------------------------#
# generics #
#------------------------------------------------------------------------------#
setGeneric(name = "sbmlPtrType",
def = function(object) { standardGeneric("sbmlPtrType") }
)
setGeneric(name = "sbmlPointer",
def = function(object) { standardGeneric("sbmlPointer") }
)
setGeneric(name = "sbmlDocKey",
def = function(object) { standardGeneric("sbmlDocKey") }
)
setGeneric(name = "sbmlFileName",
def = function(object) { standardGeneric("sbmlFileName") }
)
setGeneric(name = "isNULLpointerSBML",
def = function(object) { standardGeneric("isNULLpointerSBML") }
)
setGeneric(name = "isSBMLdocpointer",
def = function(object) { standardGeneric("isSBMLdocpointer") }
)
setGeneric(name = "isSBMLmodpointer",
def = function(object) { standardGeneric("isSBMLmodpointer") }
)
setGeneric(name = "sbmlInfos",
def = function(object) { standardGeneric("sbmlInfos") }
)
setGeneric(name = "sbmlWarnings",
def = function(object) { standardGeneric("sbmlWarnings") }
)
setGeneric(name = "sbmlErrors",
def = function(object) { standardGeneric("sbmlErrors") }
)
setGeneric(name = "sbmlFatals",
def = function(object) { standardGeneric("sbmlFatals") }
)
setGeneric(name = "getNumErrors",
def = function(object) { standardGeneric("getNumErrors") }
)
setGeneric(name = "printSlot",
def = function(object, ws) { standardGeneric("printSlot") }
)
This diff is collapsed.
#------------------------------------------------------------------------------#
# Link to libSBML for sybil #
#------------------------------------------------------------------------------#
# sbmlErrorClass.R
# Link to libSBML for sybil.
#
# Copyright (C) 2010-2013 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 sybilSBML.
#
# SybilSBML 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.
#
# SybilSBML 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 SybilSBML. If not, see <http://www.gnu.org/licenses/>.
#------------------------------------------------------------------------------#
# definition of class sbmlError #
#------------------------------------------------------------------------------#
# representation of class sbmlError
setClass(Class = "sbmlError",
representation(
sbmlInfos = "list",
sbmlWarnings = "list",
sbmlErrors = "list",
sbmlFatals = "list",
sbmlFileName = "character",
sbmlDocKey = "character"
)
)
#------------------------------------------------------------------------------#
# contructor function for class sbmlError
sbmlError <- function(err, sbmlf) {
stopifnot(is(sbmlf, "sbmlPtr"))
if (is(err, "sbml_error")) {
pObj <- new("sbmlError",
sbmlInfos = err[["infos"]],
sbmlWarnings = err[["warnings"]],
sbmlErrors = err[["errors"]],
sbmlFatals = err[["fatals"]],
sbmlFileName = sbmlFileName(sbmlf),
sbmlDocKey = sbmlDocKey(sbmlf))
}
else {
pObj <- err
}
return(pObj)
}
#------------------------------------------------------------------------------#
# sbmlInfos
setMethod("sbmlInfos", signature(object = "sbmlError"),
function(object) {
return(object@sbmlInfos)
}
)
# sbmlWarnings
setMethod("sbmlWarnings", signature(object = "sbmlError"),
function(object) {
return(object@sbmlWarnings)
}
)
# sbmlErrors
setMethod("sbmlErrors", signature(object = "sbmlError"),
function(object) {
return(object@sbmlErrors)
}
)
# sbmlFatals
setMethod("sbmlFatals", signature(object = "sbmlError"),
function(object) {
return(object@sbmlFatals)
}
)
# sbmlDocKey
setMethod("sbmlDocKey", signature(object = "sbmlError"),
function(object) {
return(object@sbmlDocKey)
}
)
# sbmlFileName
setMethod("sbmlFileName", signature(object = "sbmlError"),
function(object) {
return(object@sbmlFileName)
}
)
# getNumErrors
setMethod("getNumErrors", signature(object = "sbmlError"),
function(object) {
num <- integer(5)
num[1] <- length(sbmlInfos(object))
num[2] <- length(sbmlWarnings(object))
num[3] <- length(sbmlErrors(object))
num[4] <- length(sbmlFatals(object))
num[5] <- sum(num[1:4])
names(num) <- c("Infos", "Warnings", "Errors", "Fatals", "Total")
#cmd <- paste("length(sbml", ws, "(object))", sep = "")
#num <- eval(parse(text = cmd))
#names(num) <- ws
return(num)
}
)
#------------------------------------------------------------------------------#
# show
setMethod("show", signature(object = "sbmlError"),
function(object) {
cat("validation of SBML file ", sbmlFileName(object), "\n\n", sep = "")
.printErrors(sbmlInfos(object), "Infos")
.printErrors(sbmlWarnings(object), "Warnings")
.printErrors(sbmlErrors(object), "Errors")
.printErrors(sbmlFatals(object), "Fatals")
}
)
# length
setMethod("length", signature(x = "sbmlError"),
function(x) {
num <- getNumErrors(x)
names(num) <- NULL
return(num[length(num)])
}
)
setMethod("printSlot", signature(object = "sbmlError", ws = "character"),
function(object, ws) {
cmd <- paste(".printErrors(sbml", ws, "(object), '", ws, "')", sep = "")
eval(parse(text = cmd))
}
)
.printErrors <- function(err, type) {
if (length(err) > 0) {
cat(type, " (", length(err), "):\n", sep = "")
i <- 0
for (e in err) {
i <- i + 1
cat(sub("s$", "", type), " number ", i, ":\n", sep = "")
cat("Id: ", e[["id"]], "\n", sep = "")
cat("line: ", e[["line"]], ", column: ", e[["column"]], "\n", sep = "")
cat("message:\n")
cat(e[["message"]], "\n")
}
}
}
#------------------------------------------------------------------------------#
# Link to libSBML for sybil #
#------------------------------------------------------------------------------#
# sbmlPtrClass.R
# Link to libSBML for sybil.
#
# Copyright (C) 2010-2013 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 sybilSBML.
#
# SybilSBML 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.
#
# SybilSBML 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 SybilSBML. If not, see <http://www.gnu.org/licenses/>.
#------------------------------------------------------------------------------#
# definition of class sbmlPtr #
#------------------------------------------------------------------------------#
# representation of class sbmlPtr
setClass(Class = "sbmlPtr",
representation(
sbmlPtrType = "character",
sbmlPointer = "externalptr",
sbmlDocKey = "character",
sbmlFileName = "character"
)
)
#------------------------------------------------------------------------------#
# contructor for class sbmlPtr
setMethod(f = "initialize",
signature = "sbmlPtr",
definition = function(.Object, p, w, key, fname) {
.Object@sbmlPointer <- attr(p, which = w, exact = TRUE)
.Object@sbmlPtrType <- as.character(p)
.Object@sbmlDocKey <- as.character(key)
.Object@sbmlFileName <- as.character(fname)
return(.Object)
}
)
# contructor for pointers to sbml documents
sbmlDocPointer <- function(pointer) {
if (is(pointer, "sbml_doc_ptr")) {
pObj <- new("sbmlPtr",
p = pointer,
w = as.character("sbml_doc_ptr"),
key = as.character(sybil:::.generateModKey()),
fname = as.character(attr(pointer, which = "file_name", exact = TRUE)))
}
else {
pObj <- pointer
}
return(pObj)
}
# contructor for pointers to sbml models
sbmlModPointer <- function(pointer, sbmlDoc) {
if (is(pointer, "sbml_model_ptr")) {
pObj <- new("sbmlPtr",
p = pointer,
w = as.character("sbml_model_ptr"),
key = sbmlDocKey(sbmlDoc),
fname = sbmlFileName(sbmlDoc))
}
else {
pObj <- pointer
}
return(pObj)
}
#------------------------------------------------------------------------------#
# sbmlPtrType
setMethod("sbmlPtrType", signature(object = "sbmlPtr"),
function(object) {
return(object@sbmlPtrType)
}
)
# sbmlPointer
setMethod("sbmlPointer", signature(object = "sbmlPtr"),
function(object) {
return(object@sbmlPointer)
}
)
# sbmlDocKey
setMethod("sbmlDocKey", signature(object = "sbmlPtr"),
function(object) {
return(object@sbmlDocKey)
}
)
# sbmlFileName
setMethod("sbmlFileName", signature(object = "sbmlPtr"),
function(object) {
return(object@sbmlFileName)
}
)
#------------------------------------------------------------------------------#
setMethod("isNULLpointerSBML", signature(object = "sbmlPtr"),
function(object) {
return(.Call("isNULLptr", PACKAGE = "sybilSBML", sbmlPointer(object)))
}
)
setMethod("isSBMLdocpointer", signature(object = "sbmlPtr"),
function(object) {
return(.Call("isSBMLdocptr", PACKAGE = "sybilSBML", sbmlPointer(object)))
}
)
setMethod("isSBMLmodpointer", signature(object = "sbmlPtr"),
function(object) {
return(.Call("isSBMLmodptr", PACKAGE = "sybilSBML", sbmlPointer(object)))
}
)
#------------------------------------------------------------------------------#
setMethod("show", signature(object = "sbmlPtr"),
function(object) {
if (isNULLpointerSBML(object)) {
ptrtype <- "NULL"
}
else {
if (isSBMLdocpointer(object)) {
ptrtype <- "SBML document"
}
else if (isSBMLmodpointer(object)) {
ptrtype <- "SBML model"
}
else {
ptrtype <- "unknown"
}
}
cat("object of class ", dQuote("sbmlPtr"),
": pointer to ", ptrtype, ".\n", sep = "")
cat(paste("Slot ",
dQuote("sbmlPtrType"), ": ",
sbmlPtrType(object), "\n", sep = ""))
cat(paste("Slot ", dQuote("sbmlPointer"), ": ", sep = ""))
print(slot(object, "sbmlPointer"), sep = "")
cat(paste("Slot ",
dQuote("sbmlDocKey"), ": ",
sbmlDocKey(object), "\n", sep = ""))
cat(paste("Slot ",
dQuote("sbmlFileName"), ": ",
sbmlFileName(object), "\n", sep = ""))
}
)
#------------------------------------------------------------------------------#
# Link to libSBML for sybil #
#------------------------------------------------------------------------------#
# sybilSBML.R
# Link to libSBML for sybil.
#
# Copyright (C) 2010-2013 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 sybilSBML.
#
# SybilSBML 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.
#
# SybilSBML 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 SybilSBML. If not, see <http://www.gnu.org/licenses/>.
#------------------------------------------------------------------------------#
versionLibSBML <- function() {
version <- .Call("getLibSBMLversion", PACKAGE = "sybilSBML")
return(version)
}
#------------------------------------------------------------------------------#
openSBMLfile <- function(fname, ptrtype = "sbml_doc") {
if ( file.exists(fname) == FALSE ) {
stop("file not found: ", sQuote(fname))
}
sbmlf <- .Call("readSBMLfile", PACKAGE = "sybilSBML",
as.character(normalizePath(fname)[1]),
as.character(ptrtype)
)
sbmlfP <- sbmlDocPointer(sbmlf)
return(sbmlfP)
}
#------------------------------------------------------------------------------#
closeSBMLfile <- function(sbmlf) {
invisible(
.Call("delDocument", PACKAGE = "sybilSBML",
sbmlPointer(sbmlf)
)
)
}
#------------------------------------------------------------------------------#
getSBMLmodel <- function(sbmlf, ptrtype = "sbml_mod") {
sbmlm <- .Call("getSBMLmodel", PACKAGE = "sybilSBML",
sbmlPointer(sbmlf),
as.character(ptrtype)
)
sbmlmP <- sbmlModPointer(sbmlm, sbmlf)
if (isTRUE(isNULLpointerSBML(sbmlmP))) {
sbmlmP <- NULL
}