git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/DEGraph@69372 bc3139a8-67e5-0310-9ffc-ced21a209358
... | ... |
@@ -115,8 +115,10 @@ getKEGGPathways <- function(path=NULL, rootPath="networkData/ftp.genome.jp/pub/k |
115 | 115 |
pw <- parseKGML(pathname) |
116 | 116 |
pwInfo <- getPathwayInfo(pw) |
117 | 117 |
gr <- KEGGpathway2Graph(pw, genesOnly=TRUE, expandGenes=TRUE) |
118 |
- attr(gr, "info") <- pwInfo |
|
119 |
- attr(gr, "label") <- getTitle(pwInfo) |
|
118 |
+ #attr(gr, "info") <- pwInfo |
|
119 |
+ gr@graphData$info <- pwInfo |
|
120 |
+ #attr(gr, "label") <- getTitle(pwInfo) |
|
121 |
+ gr@graphData$label <- getTitle(pwInfo) |
|
120 | 122 |
increase(pb) |
121 | 123 |
gr |
122 | 124 |
}) |
... | ... |
@@ -196,7 +196,10 @@ getSignedGraph <- function(graph, positiveInteractionLabels=c("activation", "exp |
196 | 196 |
} |
197 | 197 |
} |
198 | 198 |
|
199 |
- attr(graph, 'signMat') <- signMat |
|
199 |
+ |
|
200 |
+ graph@graphData$signMat <- signMat |
|
201 |
+ |
|
202 |
+ #attr(graph, 'signMat') <- signMat |
|
200 | 203 |
verbose && exit(verbose) |
201 | 204 |
|
202 | 205 |
graph |
... | ... |
@@ -137,7 +137,8 @@ testOneConnectedComponent <- function(graph, data, classes, ..., prop=0.2, verbo |
137 | 137 |
X2 <- t(data[, classes==cls[2]]) |
138 | 138 |
|
139 | 139 |
## get sign information (if any) and infer from its presence the type of graph |
140 |
- signMat <- attr(graph, 'signMat') |
|
140 |
+ #signMat <- attr(graph, 'signMat') |
|
141 |
+ signMat <- graph@graphData$signMat |
|
141 | 142 |
if (is.null(signMat)) { |
142 | 143 |
verbose && cat(verbose, "Unsigned graph") |
143 | 144 |
## use adjacency matrix of the corresponding undirected graph |