update renderSbgn and print.SBGNview

R/SBGNview.R

@@ -217,7 +217,7 @@ SBGNview <- function(gene.data = NULL, cpd.data = NULL, simulate.data = FALSE, i
         sbgn.result.list <- renderSbgn(input.sbgn = input.sbgn.full.path, output.file = output.file.sbgn, 
                                        arcs.info = arcs.info, compartment.layer.info = compartment.layer.info, 
                                        user.data = user.data, output.formats = output.formats, 
-                                       sbgn.id.attr = sbgn.id.attr, if.write.files = FALSE, pathway.name = pathway.name.on.graph, 
+                                       sbgn.id.attr = sbgn.id.attr, pathway.name = pathway.name.on.graph, 
                                        if.plot.svg = FALSE, ...)
         # record all parameters. They might be used again when we later modify the 'SBGNview' object
         sbgn.result.list[["render.sbgn.parameters.list"]] <- list(input.sbgn = input.sbgn.full.path, 
@@ -231,6 +231,7 @@ SBGNview <- function(gene.data = NULL, cpd.data = NULL, simulate.data = FALSE, i
 
     SBGNview.obj <- createSBGNviewObject(data = SBGNview.obj.data, output.file = output.file,
                                          output.formats = output.formats)
+    message("SBGNview object generated")
     return(SBGNview.obj)
 }
 

R/SBGNview.obj.fun.R

@@ -40,41 +40,70 @@
 #'  print(SBGNview.obj)
 #' @export
 
+# get glyphs and arcs from object and use plot.glyph, plot.arc functions 
+# and other svg code from object and generate output svg and other files
 "print.SBGNview" <- function(x, ...) {
-
-    output.file <- NULL
-    #SBGNview.obj <- x
+    # reconstruct entity specific parameters.list
     SBGNview.obj <- merge.entity.specific.parameters.list(x)
-    glyphs.arcs.list <- SBGNview.obj$data
-    sbgns <- names(glyphs.arcs.list)
-    for (s in seq_len(length.out = length(glyphs.arcs.list))) {
-        # for each sbgn file
-        data.this.sbgn <- glyphs.arcs.list[[s]]
-        sbgn.parameters.list <- data.this.sbgn$render.sbgn.parameters.list
-        if (!is.null(output.file)) {
-            sbgn.parameters.list$output.file <- gsub(SBGNview.obj$output.file, output.file, 
-                sbgn.parameters.list$output.file)
-        }
+
+    for(i in seq_along(SBGNview.obj$data)) {
 
-        # if input sbgn-ml file doesn't exist while printing: download file if in ID in pathways.info, else user's file
-        if(!file.exists(sbgn.parameters.list$input.sbgn)) {
-            if(sbgns[s] %in% pathways.info[, "pathway.id"]) {
-                message(sbgn.parameters.list$input.sbgn, " not in current working directory")
-                message("Downloading SBGN-ML file for pathway.id: ", sbgns[s])
-                downloadSbgnFile(pathway.id = sbgns[s])
-            } else {
-                stop(sbgn.parameters.list$input.sbgn, " not in current working directory.\nPlease make sure SBGN-ML file is in current working directory")
+        input.sbgn <- SBGNview.obj$data[[i]]
+        glyphs <- input.sbgn$glyphs.list
+        arcs <- input.sbgn$arcs.list
+        svg.glyphs <- ""
+        svg.arcs <- ""
+
+        for(glyph in glyphs) {
+            # for plotting ports, check @svg.port slot of glyph and use that svg code for plotting ports
+            # if slot is not empty. Skip if class of glyph is port.
+            if(is(glyph, "port")) next
+            if(!identical(glyph@svg.port, character(0))) {
+                #svg.glyphs <- paste(svg.glyphs, plot.glyph(glyph), sep = "\n")
+                svg.glyphs <- paste(svg.glyphs, glyph@svg.port, sep = "\n")
+            }
+            # plot cardinality glyphs if global.parameters.list$if.plot.cardinality is true
+            # add glyph class is cardinality.sbgn
+            if (input.sbgn$global.parameters.list$if.plot.cardinality == T & is(glyph, "cardinality.sbgn")) {
+                svg.glyphs <- paste(svg.glyphs, plot.glyph(glyph), sep = "\n")
+            } 
+            # plot all other glyphs
+            if(!is(glyph, "cardinality.sbgn")) {
+                svg.glyphs <- paste(svg.glyphs, plot.glyph(glyph), sep = "\n")
             }
-        }
 
-        tp <- renderSbgn(input.sbgn = sbgn.parameters.list$input.sbgn, output.file = sbgn.parameters.list$output.file, 
-            arcs.info = sbgn.parameters.list$arcs.info, compartment.layer.info = sbgn.parameters.list$compartment.layer.info, 
-            user.data = sbgn.parameters.list$user.data, output.formats = SBGNview.obj$output.formats, 
-            sbgn.id.attr = sbgn.parameters.list$sbgn.id.attr, glyphs.user = data.this.sbgn$glyphs.list, 
-            arcs.user = data.this.sbgn$arcs.list, pathway.name = sbgn.parameters.list$pathway.name, 
-            global.parameters.list = data.this.sbgn$global.parameters.list)
-        message("Image files written: ", sbgn.parameters.list$output.file, "\n")
-    }
+        } 
+        for(arc in arcs) {
+            svg.arcs <- paste(svg.arcs, plot.arc(arc), sep = "\n")
+        }
+
+        col.panel.svg <- input.sbgn$printing.info$col.panel.svg
+        pathway.name.svg <- input.sbgn$printing.info$pathway.name.svg
+        stamp.svg <- input.sbgn$printing.info$stamp.svg
+
+        svg.head <- sprintf(svg.header, input.sbgn$svg.dim.x, input.sbgn$svg.dim.y)
+        out.svg <- paste(svg.head, svg.glyphs, svg.arcs, 
+                         col.panel.svg, pathway.name.svg, stamp.svg, 
+                         svg.end)
+        Encoding(out.svg) <- "native.enc"  # This is necessary. Some node labels have special symbols that need native encoding
+
+        output.file <- input.sbgn$render.sbgn.parameters.list$output.file
+        output.svg.file <- paste(output.file, ".svg", sep = "") 
+        write(out.svg, output.svg.file)
+        if ("pdf" %in%  SBGNview.obj$output.formats) {
+            rsvg::rsvg_pdf(output.svg.file, paste(output.file, ".pdf", sep = ""))
+        }
+        if ("png" %in% SBGNview.obj$output.formats) {
+            rsvg::rsvg_png(output.svg.file, paste(output.file, ".png", sep = ""))
+        }
+        if ("ps" %in% SBGNview.obj$output.formats) {
+            rsvg::rsvg_ps(output.svg.file, paste(output.file, ".ps", sep = ""))
+        }
+
+        message("Image files written: ", output.file)
+
+    } # end main for loop
+
     return(invisible())
 }
 
@@ -152,3 +181,44 @@ outputFile <- function(obj) {
 }
 
 #########################################################################################################
+#### old version of print function that calls renderSbgn()
+#### updated function uses parsed data in SBGNview object to generate output
+# "print.SBGNview" <- function(x, ...) {
+#     
+#     output.file <- NULL
+#     #SBGNview.obj <- x
+#     SBGNview.obj <- merge.entity.specific.parameters.list(x)
+#     glyphs.arcs.list <- SBGNview.obj$data
+#     sbgns <- names(glyphs.arcs.list)
+#     for (s in seq_len(length.out = length(glyphs.arcs.list))) {
+#         # for each sbgn file
+#         data.this.sbgn <- glyphs.arcs.list[[s]]
+#         sbgn.parameters.list <- data.this.sbgn$render.sbgn.parameters.list
+#         if (!is.null(output.file)) {
+#             sbgn.parameters.list$output.file <- gsub(SBGNview.obj$output.file, output.file, 
+#                                                      sbgn.parameters.list$output.file)
+#         }
+#         
+#         # if input sbgn-ml file doesn't exist while printing: download file if in ID in pathways.info, else user's file
+#         if(!file.exists(sbgn.parameters.list$input.sbgn)) {
+#             if(sbgns[s] %in% pathways.info[, "pathway.id"]) {
+#                 message(sbgn.parameters.list$input.sbgn, " not in current working directory")
+#                 message("Downloading SBGN-ML file for pathway.id: ", sbgns[s])
+#                 downloadSbgnFile(pathway.id = sbgns[s])
+#             } else {
+#                 stop(sbgn.parameters.list$input.sbgn, " not in current working directory.\nPlease make sure SBGN-ML file is in current working directory")
+#             }
+#         }
+#         
+#         tp <- renderSbgn(input.sbgn = sbgn.parameters.list$input.sbgn, output.file = sbgn.parameters.list$output.file, 
+#                          arcs.info = sbgn.parameters.list$arcs.info, compartment.layer.info = sbgn.parameters.list$compartment.layer.info, 
+#                          user.data = sbgn.parameters.list$user.data, output.formats = SBGNview.obj$output.formats, 
+#                          sbgn.id.attr = sbgn.parameters.list$sbgn.id.attr, glyphs.user = data.this.sbgn$glyphs.list, 
+#                          arcs.user = data.this.sbgn$arcs.list, pathway.name = sbgn.parameters.list$pathway.name, 
+#                          global.parameters.list = data.this.sbgn$global.parameters.list)
+#         message("Image files written: ", sbgn.parameters.list$output.file, "\n")
+#     }
+#     return(invisible())
+# }
+
+#########################################################################################################

R/mapping.utilities.R

@@ -1,8 +1,52 @@
 
 #########################################################################################################
 # add input user data to glyph
+# add.omics.data.to.glyph <- function(glyph.info, glyph, node, sbgn.id.attr, user.data) {
+#   
+#   node.omics.data.id <- glyph.info[sbgn.id.attr]
+#   # remove complex name from omics.data.id for metacyc
+#   node.omics.data.id.without.complex <- gsub("_Complex.+:@:", ":@:", node.omics.data.id)
+#   node.omics.data.id.without.complex <- gsub("_Complex_.+", "", node.omics.data.id)
+#   
+#   if (!xml2::xml_attr(xml2::xml_parent(glyph), "class") %in% c("complex", "submap")) {
+#     # molecules within a complex sometimes have different ids, so we don't count them
+#     # when calculating the mapped nodes
+#   }
+#   user.data=user.data[[1]]
+#   ################################################################ 
+#   if (node.omics.data.id %in% rownames(user.data)) {
+#     [email protected] <- user.data[node.omics.data.id,] #user.data[[node.omics.data.id]]
+#     if (!xml2::xml_attr(xml2::xml_parent(glyph), "class") %in% c("complex", "submap")) {
+#       # molecules within a complex sometimes have different ids, so we don't count them
+#       # when calculating the mapped nodes
+#       
+#     }
+#   } else if (node.omics.data.id.without.complex %in% rownames(user.data)) {
+#     [email protected] <- user.data[node.omics.data.id.without.complex,] #[[node.omics.data.id.without.complex]]
+#     if (!xml2::xml_attr(xml2::xml_parent(glyph), "class") %in% c("complex", "submap")) {
+#       # molecules within a complex sometimes have different ids, so we don't count them
+#       # when calculating the mapped nodes
+#       
+#     }
+#   } else {
+#     [email protected] <- c("no.user.data")
+#   }
+#   if (length([email protected]) == 1) {
+#     [email protected] <- as.matrix(t(c([email protected], [email protected])))
+#   }
+#   return(list(node = node))
+# }
+
+## updated function checks if user.data has gene and/or cpd
+## gets both gene and cpd if both exist and adds omics data to glyphs 
 add.omics.data.to.glyph <- function(glyph.info, glyph, node, sbgn.id.attr, user.data) {
 
+  user.data.1 <- user.data[[1]] # get gene data
+  user.data.2 <- NULL
+  if(length(user.data) > 3) { # contains both converted gene and cpd data matrix
+    user.data.2 <- user.data[[4]] # get cpd data
+  } 
+
   node.omics.data.id <- glyph.info[sbgn.id.attr]
   # remove complex name from omics.data.id for metacyc
   node.omics.data.id.without.complex <- gsub("_Complex.+:@:", ":@:", node.omics.data.id)
@@ -12,32 +56,46 @@ add.omics.data.to.glyph <- function(glyph.info, glyph, node, sbgn.id.attr, user.
     # molecules within a complex sometimes have different ids, so we don't count them
     # when calculating the mapped nodes
   }
-  user.data=user.data[[1]]
-  ################################################################ 
-  if (node.omics.data.id %in% rownames(user.data)) {
-    node@user.data <- user.data[node.omics.data.id,] #user.data[[node.omics.data.id]]
+
+  if (node.omics.data.id %in% rownames(user.data.1)) {
+    node@user.data <- user.data.1[node.omics.data.id,] #user.data[[node.omics.data.id]]
     if (!xml2::xml_attr(xml2::xml_parent(glyph), "class") %in% c("complex", "submap")) {
       # molecules within a complex sometimes have different ids, so we don't count them
       # when calculating the mapped nodes
-
     }
-  } else if (node.omics.data.id.without.complex %in% rownames(user.data)) {
-    node@user.data <- user.data[node.omics.data.id.without.complex,] #[[node.omics.data.id.without.complex]]
+  } else if (node.omics.data.id.without.complex %in% rownames(user.data.1)) {
+    node@user.data <- user.data.1[node.omics.data.id.without.complex,] #[[node.omics.data.id.without.complex]]
     if (!xml2::xml_attr(xml2::xml_parent(glyph), "class") %in% c("complex", "submap")) {
       # molecules within a complex sometimes have different ids, so we don't count them
       # when calculating the mapped nodes
-
     }
+  } else if (!is.null(user.data.2)) { # add data to cpd glyphs
+
+    if (node.omics.data.id %in% rownames(user.data.2)) {
+      node@user.data <- user.data.2[node.omics.data.id,] #user.data[[node.omics.data.id]]
+      if (!xml2::xml_attr(xml2::xml_parent(glyph), "class") %in% c("complex", "submap")) {
+        # molecules within a complex sometimes have different ids, so we don't count them
+        # when calculating the mapped nodes
+      }
+    } else if (node.omics.data.id.without.complex %in% rownames(user.data.2)) {
+      node@user.data <- user.data.2[node.omics.data.id.without.complex,] #[[node.omics.data.id.without.complex]]
+      if (!xml2::xml_attr(xml2::xml_parent(glyph), "class") %in% c("complex", "submap")) {
+        # molecules within a complex sometimes have different ids, so we don't count them
+        # when calculating the mapped nodes
+      }
+    }
+
   } else {
     node@user.data <- c("no.user.data")
   }
+
   if (length(node@user.data) == 1) {
     node@user.data <- as.matrix(t(c(node@user.data, node@user.data)))
   }
+
   return(list(node = node))
 }
 
-
 #########################################################################################################
 # generate glyph objects for glyphs found in sbgn file
 generate.node.obj <- function(glyph, glyph.class, glyph.info, node, if.plot.svg, y.margin,