git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/SplicingGraphs@73443 bc3139a8-67e5-0310-9ffc-ced21a209358
Herve Pages authored on 13/02/2013 02:52:04
| ... | ... |
@@ -14,7 +14,8 @@ Imports: methods, utils, igraph, |
| 14 | 14 |
BiocGenerics, IRanges, GenomicRanges, |
| 15 | 15 |
GenomicFeatures, Rsamtools |
| 16 | 16 |
Suggests: graph, Rgraphviz, Gviz, TxDb.Mmusculus.UCSC.mm9.knownGene, RUnit |
| 17 |
-Collate: splicingGraphs.R |
|
| 17 |
+Collate: utils.R |
|
| 18 |
+ splicingGraphs.R |
|
| 18 | 19 |
countReads.R |
| 19 | 20 |
toy_data.R |
| 20 | 21 |
biocViews: Genetics, Annotation, HighThroughputSequencing |
| 21 | 22 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,90 @@ |
| 1 |
+### Safer than using sub(). |
|
| 2 |
+.safeTranslateEdgeNames <- function(edge_names, old.sep="|", new.sep="~") |
|
| 3 |
+{
|
|
| 4 |
+ edge_names <- strsplit(edge_names, old.sep, fixed=TRUE) |
|
| 5 |
+ stopifnot(all(elementLengths(edge_names) == 2L)) # sanity check |
|
| 6 |
+ edge_names <- unlist(edge_names, use.names=FALSE) |
|
| 7 |
+ paste0(edge_names[c(TRUE, FALSE)], new.sep, edge_names[c(FALSE, TRUE)]) |
|
| 8 |
+} |
|
| 9 |
+ |
|
| 10 |
+### Mappings from igraph attribute names to Rgraphviz attribute names. |
|
| 11 |
+.IGRAPH_2_RGRAPHVIZ_EDGE_ATTRNAMES <- c( |
|
| 12 |
+ width="weight", |
|
| 13 |
+ label.color="fontcolor" |
|
| 14 |
+ #lty="style" |
|
| 15 |
+) |
|
| 16 |
+ |
|
| 17 |
+.IGRAPH_2_RGRAPHVIZ_NODE_ATTRNAMES <- c( |
|
| 18 |
+ color="fillcolor", |
|
| 19 |
+ .IGRAPH_2_RGRAPHVIZ_EDGE_ATTRNAMES |
|
| 20 |
+) |
|
| 21 |
+ |
|
| 22 |
+.safeTranslateAttrNames <- function(attr_names, old2new) |
|
| 23 |
+{
|
|
| 24 |
+ m <- match(attr_names, names(old2new), nomatch=0L) |
|
| 25 |
+ idx <- which(m != 0L) |
|
| 26 |
+ new_names <- old2new[m] |
|
| 27 |
+ do_it <- !(new_names %in% attr_names) |
|
| 28 |
+ attr_names[idx[do_it]] <- new_names[do_it] |
|
| 29 |
+ attr_names |
|
| 30 |
+} |
|
| 31 |
+ |
|
| 32 |
+.make_Ragraph_nodeAttrs_from_graphNEL <- function(graph_nel) |
|
| 33 |
+{
|
|
| 34 |
+ attr_names <- names(nodeDataDefaults(graph_nel)) |
|
| 35 |
+ node_data <- nodeData(graph_nel) |
|
| 36 |
+ node_names <- names(node_data) |
|
| 37 |
+ node_attrs <- lapply(attr_names, |
|
| 38 |
+ function(attr_name) |
|
| 39 |
+ unlist(lapply(node_data, `[[`, attr_name), |
|
| 40 |
+ recursive=FALSE)) |
|
| 41 |
+ names(node_attrs) <- .safeTranslateAttrNames(attr_names, |
|
| 42 |
+ .IGRAPH_2_RGRAPHVIZ_NODE_ATTRNAMES) |
|
| 43 |
+ is_null <- sapply(node_attrs, is.null) |
|
| 44 |
+ node_attrs <- node_attrs[!is_null] |
|
| 45 |
+ |
|
| 46 |
+ node_fontsize <- rep.int("12", length(node_names))
|
|
| 47 |
+ names(node_fontsize) <- node_names |
|
| 48 |
+ node_attrs$fontsize <- node_fontsize |
|
| 49 |
+ |
|
| 50 |
+ node_attrs |
|
| 51 |
+} |
|
| 52 |
+ |
|
| 53 |
+.make_Ragraph_edgeAttrs_from_graphNEL <- function(graph_nel) |
|
| 54 |
+{
|
|
| 55 |
+ attr_names <- names(edgeDataDefaults(graph_nel)) |
|
| 56 |
+ edge_names <- edgeNames(graph_nel) |
|
| 57 |
+ if (length(attr_names) == 0L || length(edge_names) == 0L) |
|
| 58 |
+ return(list()) |
|
| 59 |
+ if (anyDuplicated(edge_names)) |
|
| 60 |
+ warning("graphNEL object has more than 1 edge between the same ",
|
|
| 61 |
+ "2 nodes. Plotting attributes for those edges (e.g. label, ", |
|
| 62 |
+ "color, line width, line style, etc...) are likely to be ", |
|
| 63 |
+ "wrong.") |
|
| 64 |
+ edge_data <- edgeData(graph_nel) |
|
| 65 |
+ stopifnot(identical(.safeTranslateEdgeNames(names(edge_data)), |
|
| 66 |
+ edge_names)) # sanity check |
|
| 67 |
+ names(edge_data) <- edge_names |
|
| 68 |
+ edge_attrs <- lapply(attr_names, |
|
| 69 |
+ function(attr_name) |
|
| 70 |
+ unlist(lapply(edge_data, `[[`, attr_name), |
|
| 71 |
+ recursive=FALSE)) |
|
| 72 |
+ names(edge_attrs) <- .safeTranslateAttrNames(attr_names, |
|
| 73 |
+ .IGRAPH_2_RGRAPHVIZ_EDGE_ATTRNAMES) |
|
| 74 |
+ is_null <- sapply(edge_attrs, is.null) |
|
| 75 |
+ edge_attrs <- edge_attrs[!is_null] |
|
| 76 |
+ |
|
| 77 |
+ edge_fontsize <- rep.int("10", length(edge_names))
|
|
| 78 |
+ names(edge_fontsize) <- edge_names |
|
| 79 |
+ edge_attrs$fontsize <- edge_fontsize |
|
| 80 |
+ |
|
| 81 |
+ edge_attrs |
|
| 82 |
+} |
|
| 83 |
+ |
|
| 84 |
+make_Ragraph_from_graphNEL <- function(graph_nel, gene_id=NA) |
|
| 85 |
+{
|
|
| 86 |
+ node_attrs <- .make_Ragraph_nodeAttrs_from_graphNEL(graph_nel) |
|
| 87 |
+ edge_attrs <- .make_Ragraph_edgeAttrs_from_graphNEL(graph_nel) |
|
| 88 |
+ agopen(graph_nel, name=gene_id, nodeAttrs=node_attrs, edgeAttrs=edge_attrs) |
|
| 89 |
+} |
|
| 90 |
+ |