Skip to content
GitLab
Commit 9c74be98 authored by ardalan's avatar ardalan
Browse files

new Version Ardalan Habil

parent a1717cb4
Expand all Hide whitespace changes
Inline Side-by-side
DESCRIPTION
View file @ 9c74be98
......@@ -14,7 +14,7 @@ License: GPL-3 | file LICENSE
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
Packaged: 2016-10-18 13:31:19 UTC; ardalan
Author: C. Jonathan Fritzemeier [cre, ctb],
Gabriel Gelius-Dietrich [aut],
Deya Alzoubi [ctb]
......
NAMESPACE
View file @ 9c74be98
......@@ -48,5 +48,9 @@ getSBMLunitDefinitionsList,
getSBMLCompartList,
getSBMLSpeciesList,
getSBMLReactionsList,
readSBMLmod
readSBMLmod,
exportSBML,
getSBMLFbcversion,
getSBMLmodNotes,
getSBMLmodAnnotation
)
R/readSBMLmod.R
View file @ 9c74be98
......@@ -247,7 +247,13 @@ parseNotesReact <- function(notes) {
gpr <- sub("GENE[_ ]?ASSOCIATION: *", "", fields_str[j])
gene_rule <- sybil:::.parseBoolean(gpr)
#print(gene_rule)
}
}#Ardalan Habil
else if (grepl("GPR[_ ]?ASSOCIATION", fields_str[j])) {
gpr <- sub("GPR[_ ]?ASSOCIATION: *", "", fields_str[j])
gene_rule <- sybil:::.parseBoolean(gpr)
}
if (charmatch("SUBSYSTEM", fields_str[j], nomatch = -1) != -1) {
subSyst <- sub("SUBSYSTEM: *", "", fields_str[j])
subSyst <- sub("^S_", "", subSyst, perl = TRUE)
......@@ -283,6 +289,14 @@ sbmldoc <- openSBMLfile(filename)
message("OK")
# warning if new Version/Level/
SBMLlevel<- getSBMLlevel(sbmldoc)
SBMLversion<- getSBMLversion(sbmldoc)
FBCversion<-getSBMLFbcversion(sbmldoc)
if(SBMLlevel == 3 && SBMLversion > 1)
warning(paste("No support for Level 3 Version ",SBMLversion))
if (FBCversion > 2)
warning(paste("No support for Fbc Version ",FBCversion))
#------------------------------------------------------------------------------#
# check the model #
......@@ -380,6 +394,7 @@ if (mdesc == filename) {
sybil::mod_desc(mod) <- mdesc
#------------------------------------------------------------------------------#
# units #
#------------------------------------------------------------------------------#
......@@ -430,6 +445,7 @@ missingId(metabolitesList)
metSpIds <- metabolitesList[["id"]]
#nummet <- getSBMLnumSpecies(sbmlmod)
if (isTRUE(bndCond)) {
metSpBnd <- metabolitesList[["boundaryCondition"]]
met_id_pos <- !metSpBnd
......@@ -485,12 +501,20 @@ gpr <- character(numreact)
hasNotes <- FALSE
hasAnnot <- FALSE
#FBC contraints @Ardalan Habil
fbclowbnd<-reactionsList[["fbc_lowbnd"]]
fbcuppbnd<-reactionsList[["fbc_uppbnd"]]
fbcgprRules<-reactionsList[["fbc_gprRules"]]
fbcObjectives<-reactionsList[["fbc_Objectives"]]
for (i in 1 : numreact) {
# the notes/annotations field
notes <- reactionsList[["notes"]][i]
annot <- reactionsList[["annotation"]][i]
# Notes und Annotation can be null ( @Ardalan Habil)
if(!is.null( reactionsList[["notes"]]))
if (nchar(notes) > 0) {
hasNotes <- TRUE
......@@ -504,7 +528,7 @@ for (i in 1 : numreact) {
}
else {
if(!is.null( reactionsList[["annotation"]]))
if (nchar(annot) > 0) {
hasAnnot <- TRUE
pn <- regexpr("Pathway Name: [^<]+", annot, perl = TRUE)
......@@ -512,7 +536,18 @@ for (i in 1 : numreact) {
}
}
fbcgene_rule <- NA
if ( !is.null(fbcgprRules))
{
fbcgene_rule<- sybil:::.parseBoolean(fbcgprRules[i])
genes[[i]] <- fbcgene_rule$gene # list of genes
rules[i] <- fbcgene_rule$rule # rules
gpr[i] <- fbcgprRules[i]
}
# Check here if reactants and products lists exist, same for the stoichiometry slot
......@@ -565,6 +600,16 @@ for (i in 1 : numreact) {
# }
# the constraints
#FBC contraints @Ardalan Habil
if ( !is.null(fbclowbnd) && !is.null(fbcuppbnd))
{
lbnd[i] <- checkupplowbnd(fbclowbnd[i])
ubnd[i] <- checkupplowbnd(fbcuppbnd[i])
}
#read from kinetic_law if fbc is empty
else
{
parm <- reactionsList[["kinetic_law"]][[i]]
if (is.null(parm)) {
ubnd[i] <- def_bnd
......@@ -591,10 +636,16 @@ for (i in 1 : numreact) {
# reduced cost? (sbml file)
}
}
}
#FBC Objective @Ardalan Habil
if(!is.null(fbcObjectives))
{
ocof[i]<-as.numeric(fbcObjectives[i])
}
}
# ---------------------------------------------------------------------------- #
# search for unused metabolites and unused reactions
......@@ -877,7 +928,7 @@ else {
rules <- rules[SKIP_REACTION]
gpr <- gpr[SKIP_REACTION]
if (isTRUE(hasNotes)) {
if (isTRUE(hasNotes) || !is.null(fbcgprRules) ) {
message("GPR mapping ... ", appendLF = FALSE)
#allGenes <- unique(allGenes)
......@@ -969,6 +1020,56 @@ react_name_tmp <- sub( "\\s+$", "", react_name_tmp, perl = TRUE)
sybil::react_name(mod) <- react_name_tmp
#------------------------------------------------------------------------------#
# Reaction Attr @Ardalan #
#------------------------------------------------------------------------------#
# Test for new Slots
if( .hasSlot(mod,"mod_attr") && .hasSlot(mod,"comp_attr") && .hasSlot(mod,"met_attr") && .hasSlot(mod,"react_attr") )
newSybil<-TRUE
else newSybil<-FALSE
numreact<-nummet <- sum(SKIP_REACTION)
reactannotation <- reactionsList[["annotation"]][SKIP_REACTION]
reactnotes <- reactionsList[["notes"]][SKIP_REACTION]
if(newSybil)
{
sybil::react_attr(mod) <-data.frame(row.names=1:numreact)
#Speed optimierung durch notes NULL falls nichts drin steht
if( !is.null(reactannotation) && length(reactannotation)==numreact )sybil::react_attr(mod)[['annotation']]<-reactannotation
if( !is.null(reactnotes) && length(reactnotes)==numreact )sybil::react_attr(mod)[['notes']]<-reactnotes
}
#------------------------------------------------------------------------------#
# Model Attr @Ardalan #
#------------------------------------------------------------------------------#
modanno<-getSBMLmodAnnotation(sbmlmod)
modnotes<-getSBMLmodNotes(sbmlmod)
if(newSybil)
{
sybil::mod_attr(mod) <-data.frame(row.names=1)
if(nchar(modanno)>1)sybil::mod_attr(mod)[['annotation']]<-modanno
if(nchar(modnotes)>1)sybil::mod_attr(mod)[['notes']]<-modnotes
}
#------------------------------------------------------------------------------#
# compartments Attr @Ardalan #
#------------------------------------------------------------------------------#
numcom<-length(mod_compart(mod))
comannotation <- compartmentsList[["annotation"]]
comnotes <- compartmentsList[["notes"]]
if(newSybil)
{
sybil::comp_attr(mod) <-data.frame(row.names=1:numcom)
if( !is.null(comannotation) && length(comannotation)==numcom )sybil::comp_attr(mod)[['annotation']]<-comannotation
if( !is.null(comnotes) && length(comnotes)==numcom )sybil::comp_attr(mod)[['notes']]<-comnotes
}
#------------------------------------------------------------------------------#
# metabolite id's #
#------------------------------------------------------------------------------#
......@@ -1001,6 +1102,67 @@ met_name_tmp <- sub( "\\s+$", "", met_name_tmp, perl = TRUE)
sybil::met_name(mod) <- met_name_tmp
#------------------------------------------------------------------------------#
# metabolite attr @Ardalan Habil #
#------------------------------------------------------------------------------#
#ChemicalFormula Charge Notes Annotation MetaID @Ardalan Habil
metformula <- metabolitesList[["chemicalFormula"]][met_id_pos][SKIP_METABOLITE]
metcharge <- metabolitesList[["charge"]][met_id_pos][SKIP_METABOLITE]
metnotes <- metabolitesList[["notes"]][met_id_pos][SKIP_METABOLITE]
metannotation <- metabolitesList[["annotation"]][met_id_pos][SKIP_METABOLITE]
metchargenote<-NULL
metformulanote<-NULL
# check metnotes for Formula and Charge
if( !is.null(metnotes) && length(metnotes==nummet))
{
pn <- regexpr("FORMULA: [^<]+", metnotes, perl = TRUE)
metformulanote <- substr(metnotes, (pn+9), pn + ((attr(pn, "match.length"))-1))
pn <- regexpr("CHARGE: [^<]+", metnotes, perl = TRUE)
metchargenote <- substr(metnotes, (pn+8), pn + ((attr(pn, "match.length"))-1))
metchargenote <- as.integer(metchargenote)
metchargenote[is.na(metchargenote)] <- 0
}
nummet <- sum(SKIP_METABOLITE)
if(newSybil)
{
# save attributes to met_attr slot
sybil::met_attr(mod) <-data.frame(row.names=1:nummet)
if( !is.null(metformula) && length(metformula)==nummet)
{sybil::met_attr(mod)[['chemicalFormula']]<-metformula}
else{
if(length(metformulanote)==nummet)
{ if(max(nchar(metformulanote)) >0)
sybil::met_attr(mod)[['chemicalFormula']]<-metformulanote
}
}
if( !is.null(metcharge) && length(metcharge)==nummet && sum(metcharge)!=0)
{sybil::met_attr(mod)[['charge']]<-metcharge}
else{
if( length(metchargenote)==nummet)
{ if(max(nchar(metchargenote)) >0)
sybil::met_attr(mod)[['charge']]<-metchargenote
}
}
if( !is.null(metnotes) && length(metnotes)==nummet)sybil::met_attr(mod)[['notes']]<-metnotes
if( !is.null(metannotation) && length(metannotation)==nummet)sybil::met_attr(mod)[['annotation']]<-metannotation
# Save boundaryCondition when bndCond=FALSE
if (!isTRUE(bndCond)) {
metBnd <- metabolitesList[["boundaryCondition"]][met_id_pos][SKIP_METABOLITE]
# When all metBnd = False -> metabolite removed by extMetFlag
if( !is.null(metBnd) && length(metBnd)==nummet && !all(metBnd == FALSE) )sybil::met_attr(mod)[['boundaryCondition']]<-metBnd
}
}
#------------------------------------------------------------------------------#
# check reversibilities #
#------------------------------------------------------------------------------#
......
R/sybilSBML.R
View file @ 9c74be98
......@@ -124,6 +124,17 @@ getSBMLversion <- function(sbmlf) {
return(version)
}
#------------------------------------------------------------------------------#
getSBMLFbcversion <- function(sbmlf) {
version <- .Call("getSBMLFbcversion", PACKAGE = "sybilSBML",
sbmlPointer(sbmlf)
)
return(version)
}
#------------------------------------------------------------------------------#
......@@ -186,6 +197,28 @@ getSBMLmodName <- function(sbmlm) {
return(modn)
}
#------------------------------------------------------------------------------#
getSBMLmodNotes <- function(sbmlm) {
modnotes <- .Call("getSBMLmodNotes", PACKAGE = "sybilSBML",
sbmlPointer(sbmlm)
)
return(modnotes)
}
#------------------------------------------------------------------------------#
getSBMLmodAnnotation <- function(sbmlm) {
modanno <- .Call("getSBMLmodAnnotation", PACKAGE = "sybilSBML",
sbmlPointer(sbmlm)
)
return(modanno)
}
#------------------------------------------------------------------------------#
......@@ -271,6 +304,272 @@ getSBMLReactionsList <- function(sbmlm) {
}
#------------------------------------------------------------------------------#
#export mod to SBML
deformatSBMLid <- function(idstr) {
idstr <- gsub("-", "_DASH_", idstr, fixed = TRUE)
idstr <- gsub("(", "_LPAREN_", idstr, fixed = TRUE)
idstr <- gsub(")", "_RPAREN_", idstr, fixed = TRUE)
idstr <- gsub("[", "_", idstr, fixed = TRUE)
idstr <- gsub("]", "", idstr, fixed = TRUE)
idstr <- gsub(",", "_COMMA_", idstr, fixed = TRUE)
idstr <- gsub(".", "_PERIOD_", idstr, fixed = TRUE)
idstr <- gsub("'", "_APOS_", idstr, fixed = TRUE)
idstr <- sub("\\(e\\)$", "_e_", idstr)
idstr <- gsub("-", "_", idstr, fixed = TRUE)
return(idstr)
}
deformatGene<-function(idstr) {
# idstr <- gsub("and", "&&", idstr, fixed = TRUE)
# idstr <- gsub("or", "||", idstr, fixed = TRUE)
idstr <- gsub("( ", "(", idstr, fixed = TRUE)
idstr <- gsub(" (", "(", idstr, fixed = TRUE)
idstr <- gsub(") ", ")", idstr, fixed = TRUE)
idstr <- gsub(" )", ")", idstr, fixed = TRUE)
idstr <- gsub(":", "_", idstr, fixed = TRUE)
return(idstr)
}
exportSBML<- function(morg=NULL,level=2,version=4,FbcLevel=0,filename="export.xml",validation=TRUE){
#morg<-modelorg[["modelorg"]]
if(class(morg)!="modelorg"){
stop("morg has to be of class modelorg\n")
}
###right
if(level==1)
{
# test if Matrix has no double values
if( !all( S(morg) == floor(S(morg))) ) warning("Level 1 does not support double values")
FbcLevel=0
if(version != 2)
{
warning("just Level 1 Version 2 will be supported")
version=2
}
}else if (level==2)
{
FbcLevel=0
if(version >5)
{
warning("Level 2 Version 5 will be supported")
version=5
}
if(version < 1)
{
warning("Level 2 Version 1 will be supported")
version=1
}
}
else if (level==3)
{ if(FbcLevel >2)FbcLevel=2
if(version != 1)
{
print("Level 3 Version 1 will be supported")
version=1
}
}else {
stop(" Support just for Level 1,2 and 3 \n")
}
##All GENES###
allgenes<- unique(unlist(genes(morg)))
allgenes<-allgenes[allgenes != ""]
##EXCHANGE REACTIONS##
ex <- findExchReact(morg)
ex_react<-NULL
if(!is.null(ex))
{
if(!(all(diag(S(morg)[met_pos(ex), react_pos(ex)])==-1)))
stop("exchange reactions with Scoeff different than -1\n")
ex_react<-as.integer(react_pos(ex))
}
### Build wrapper for C Function #####
##Met Attribute###
com_meta_id<- NULL
met_meta_id<- NULL
com_notes <- NULL
com_annotation<- NULL
met_notes<- NULL
met_anno<- NULL
met_bnd<- NULL
met_charge<-NULL
met_formula<-NULL
react_notes<-NULL
react_anno<-NULL
mod_notes<-NULL
mod_anno<-NULL
#subsystem
# is subsystem Empty
if(length( colnames(subSys(morg)))==1 && colnames(subSys(morg))[1]=="" ) modhasubSys<-FALSE
else modhasubSys<-TRUE
newsubS<- NULL
# TODO ATRRIBUTE NUR LESEN BEI NEUER SYBIL VERSION
if( .hasSlot(morg,"mod_attr") && .hasSlot(morg,"comp_attr") && .hasSlot(morg,"met_attr") && .hasSlot(morg,"react_attr") )
newSybil<-TRUE
else newSybil<-FALSE
### Start newSybil attr
if(newSybil)
{
if("notes" %in% colnames(mod_attr(morg))) mod_notes<-as.character(mod_attr(morg)[['notes']])
if("annotation" %in% colnames(mod_attr(morg))) mod_annotation<-as.character(mod_attr(morg)[['annotation']])
if("notes" %in% colnames(comp_attr(morg))) com_notes<-as.character(as.list((comp_attr(morg)[['notes']])))
if("annotation" %in% colnames(comp_attr(morg))) com_annotation<-as.character(as.list((comp_attr(morg)[['annotation']])))
if("charge" %in% colnames(met_attr(morg))) met_charge<- as.integer(as.list((met_attr(morg)[['charge']])))
if("chemicalFormula" %in% colnames(met_attr(morg))) met_formula<-as.character(as.list((met_attr(morg)[['chemicalFormula']])))
if("annotation" %in% colnames(met_attr(morg))) met_anno<-as.character(as.list((met_attr(morg)[['annotation']])))
if("boundaryCondition" %in% colnames(met_attr(morg))) met_bnd<-as.logical(as.list((met_attr(morg)[['boundaryCondition']])))
if("notes" %in% colnames(met_attr(morg)))
{ # delete Formular and charge from notes to do
met_notes<-as.character(as.list((met_attr(morg)[['notes']])))
if (!is.null(met_charge) || !is.null(met_formula))
{
for ( i in 1:met_num(morg))
{
if(nchar(met_notes[i])> 8)
{
# Have Assocation in Notes?yes: replace no: append
if (regexpr("html:p", met_notes[i], fixed = TRUE) == -1)tag <- "p"
else tag <- "html:p"
if (!is.null(met_formula))
{
haveform<-grepl("FORMULA: [^<]+",met_notes[i])
#Have Gene if not ->no need to write in FBC2
if(haveform)
{
if(FbcLevel==0)met_notes[i]<-sub("FORMULA: [^<]+",paste("FORMULA: ",met_formula[i], sep = ""), met_notes[i], perl = TRUE)
else met_notes[i]<-sub(paste("<",tag,">","FORMULA: [^<]+","</",tag,">",sep = ""),"",met_notes[i], perl = TRUE)
}
else if(FbcLevel==0) met_notes[i]<-gsub("</notes>",paste("<",tag,">","FORMULA: ",met_formula[i],"</",tag,">","\n</notes>",sep = ""),met_notes[i])
}
if (!is.null(met_charge))
{
havecharge<-grepl("CHARGE: [^<]+",met_notes[i])
#Have Subsystem
if(havecharge)
{
if(FbcLevel !=0 || (level==2 && version==1 ))
met_notes[i]<-sub(paste("<",tag,">","CHARGE: [^<]+","</",tag,">",sep = ""),"",met_notes[i], perl = TRUE)
else met_notes[i]<-sub("CHARGE: [^<]+",paste("CHARGE: ",met_charge[i], sep = ""), met_notes[i], perl = TRUE)
}
else if(FbcLevel==0) if(level!=2 && version!=1) met_notes[i]<-gsub("</notes>",paste("<",tag,">","CHARGE: ",met_charge[i],"</",tag,">","\n</notes>",sep = ""),met_notes[i])
}
}
}
}
}
if("annotation" %in% colnames(react_attr(morg))) react_anno<-as.character(as.list((react_attr(morg)[['annotation']])))
# Merge Notes with "our" Notes and make sure gpr Rules from gpr
if("notes" %in% colnames(react_attr(morg)))
{
react_notes<-as.character(as.list((react_attr(morg)[['notes']])))
# using
# SubSystem EXISTIERT nicht colnames(subSys(ec))
for ( i in 1:react_num(morg))
{
# using the for loop
if(modhasubSys)newsubS[i]<- paste(names(which(subSys(morg)[i,])), collapse=", ")
if(nchar(react_notes[i])> 8)
{
# Have Association in Notes? yes: replace no: append
if (regexpr("html:p", react_notes[i], fixed = TRUE) == -1)tag <- "p"
else tag <- "html:p"
havegene<-grepl("GENE[_ ]?ASSOCIATION: [^<]+",react_notes[i])
havesub<-grepl("SUBSYSTEM: [^<]+",react_notes[i])
#Have Gene if not ->no need to write in FBC2
if(havegene)
{
if(FbcLevel==2) react_notes[i]<-sub(paste("<",tag,">","GENE[_ ]?ASSOCIATION: [^<]+","</",tag,">",sep = ""),"",react_notes[i], perl = TRUE)
else react_notes[i]<-sub("GENE[_ ]?ASSOCIATION: [^<]+",paste("GENE_ASSOCIATION: ",gpr(morg)[i], sep = ""), react_notes[i], perl = TRUE)
}
else if(FbcLevel!=2)react_notes[i]<-gsub("</notes>",paste("<",tag,">","GENE_ASSOCIATION: ",gpr(morg)[i],"</",tag,">","\n</notes>",sep = ""),react_notes[i])
#Have Subsystem
if(havesub)react_notes[i]<-sub("SUBSYSTEM: [^<]+",paste("SUBSYSTEM: ",newsubS[i], sep = ""), react_notes[i], perl = TRUE)
else if(modhasubSys) react_notes[i]<-gsub("</notes>",paste("<",tag,">","SUBSYSTEM: ",newsubS[i],"</",tag,">","\n</notes>",sep = ""),react_notes[i])
}
}
}
} ####END newSybil attr
# Subsystem
if(is.null(newsubS) && !(modhasubSys) ) for ( i in 1:react_num(morg)) {newsubS[i]<- paste(names(which(subSys(morg)[i,])), collapse=", ")}
newmet_id <- paste0("M_", (deformatSBMLid(met_id(morg))))
#newmet_id <- sub("\\[(\\w)\\]$", "_\\1", newmet_id) # append compartment id, if in postfix with square brkts
newreact_id <- paste0("R_", deformatSBMLid(react_id(morg)))
newmet_comp<-mod_compart(morg)[met_comp(morg)]
success <-.Call("exportSBML", PACKAGE = "sybilSBML",
as.integer(version),
as.integer(level),
as.integer(FbcLevel),
as.character(filename),
SYBIL_SETTINGS("MAXIMUM"),
as.character(mod_desc(morg)),
as.character(mod_name(morg)),
as.character(mod_compart(morg)),
as.character(newmet_id),
as.character(met_name(morg)),
as.character(newmet_comp),
met_formula,
met_charge,
as.character(newreact_id),
as.character(react_name(morg)),
as.logical(react_rev(morg)),
as.numeric(lowbnd(morg)),
as.numeric(uppbnd(morg)),
as.integer(obj_coef(morg)),
as.character(newsubS),
as.character(deformatGene(gpr(morg))),
as.numeric(shrinkMatrix(morg,j=1:react_num(morg))),
mod_notes,
mod_anno,
com_notes,
com_annotation,
met_notes,
met_anno,
met_bnd,
react_notes,
react_anno,
ex_react,
as.character(deformatGene(allgenes))
)