@@ -16,6 +16,8 @@ Imports: methods, utils, igraph,

 Suggests: igraph, Gviz, TxDb.Mmusculus.UCSC.mm9.knownGene, RUnit

 Collate: utils.R

 	 SplicingGraphs-class.R

+	 sgdf-methods.R

+	 sgraph-methods.R

 	 countReads.R

 	 toy_data.R

 biocViews: Genetics, Annotation, HighThroughputSequencing

@@ -19,35 +19,69 @@ import(Rsamtools)

 exportClasses(SplicingGraphs)

+

+### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

+### Export S4 methods for generics not defined in SplicingGraphs

+###

+

+exportMethods(

+    length,

+    names,

+    elementLengths,

+    plot,

+    findOverlaps,

+    encodeOverlaps

+)

+

+

+### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

+### Export non-generic functions

+###

+

+export(

+    ## SplicingGraphs-class.R:

+    SplicingGraphs,

+

+    ## sgdf-methods.R:

+    sgdf2,

+

+    ## sgraph-methods.R:

+    sgraph2,

+

+    ## countReads.R:

+    assignSubfeatureHits,

+

+    ## toy_data.R:

+    toy_genes_gff,

+    toy_reads_sam,

+    toy_reads_bam,

+    toy_overlaps,

+    plotToyReads

+)

+

+

+### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

+### Export S4 generics defined in SplicingGraphs + export corresponding

+### methods

+###

+

 export(

-  Spath,

-  UATXHcount,

-  Sgdf,

-  Sgraph,

-  uninformativeSSids,

-  Sgdf2,

-  Sgraph2,

-  SplicingGraphs,

-

-  assignSubfeatureHits,

-

-  toy_genes_gff,

-  toy_reads_sam,

-  toy_reads_bam,

-  toy_overlaps,

-  plotToyReads

+    ## sgdf-methods.R:

+    spath,

+    UATXHcount,

+    sgdf,

+    uninformativeSSids,

+

+    ## sgraph-methods.R:

+    sgraph

 )

+### Exactly the same list as above.

 exportMethods(

-  length,

-  names,

-  elementLengths,

-  Spath,

-  UATXHcount,

-  Sgdf,

-  Sgraph,

-  uninformativeSSids,

-  plot,

-  findOverlaps,

-  encodeOverlaps

+    spath,

+    UATXHcount,

+    sgdf,

+    uninformativeSSids,

+    sgraph

 )

+

@@ -2,6 +2,7 @@

 ### SplicingGraphs objects

 ### -------------------------------------------------------------------------

+

 ### We deliberately choose to not extend GRangesList to make SplicingGraphs

 ### objects read-only and with a very restricted API (opaque objects).

 setClass("SplicingGraphs",

@@ -10,12 +11,6 @@ setClass("SplicingGraphs",

     )

 )

-setOldClass("igraph")

-

-.EX_OR_IN_LEVELS2 <- c("ex", "in", "", "mixed")

-.EDGE_WEIGHTS <- c(1, 0.2, 0.1, 0.4)

-.EX_OR_IN_LEVELS <- .EX_OR_IN_LEVELS2[-4L]

-

 ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 ### Basic accessors.

@@ -50,583 +45,6 @@ setMethod("show", "SplicingGraphs",

 )

-### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-### Spath() accessor

-###

-### Gets all the splicing paths for the specified gene.

-### Returns them in a named IntegerList with 1 top-level element per

-### transcript in the specified gene. Each top-level element 'Spath[[i]]'

-### contains the splicing site ids for the i-th transcript.

-###

-

-setGeneric("Spath", signature="x",

-    function(x, gene_id=NA) standardGeneric("Spath")

-)

-

-### Should return a CompressedIntegerList.

-setMethod("Spath", "SplicingGraphs",

-    function(x, gene_id=NA)

-    {

-        if (!isSingleStringOrNA(gene_id))

-            stop("'gene_id' must be a single string (or NA)")

-        if (length(x) == 0L)

-            stop("'x' must be of length >= 1")

-        x_names <- names(x)

-        ans <- mcols(x@tx)[ , "Spath"]

-        if (is.null(x_names)) {

-            if (!is.na(gene_id))

-                stop("the 'gene_id' arg is not supported ",

-                     "when 'x' is unnamed (in which case all its elements ",

-                     "(i.e. transcripts) are considered to belong to the ",

-                     "same gene)")

-            return(ans) 

-        }

-        if (is.na(gene_id))

-            stop("'gene_id' must be supplied when 'x' has names")

-        ans <- ans[x_names == gene_id]

-        if (length(ans) == 0L)

-            stop("invalid 'gene_id'")

-        ans

-    }

-)

-

-

-### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-### UATXHcount() accessor

-###

-

-setGeneric("UATXHcount", signature="x",

-    function(x, gene_id=NA) standardGeneric("UATXHcount")

-)

-

-### Should return an integer vector or a NULL.

-setMethod("UATXHcount", "SplicingGraphs",

-    function(x, gene_id=NA)

-    {

-        if (!isSingleStringOrNA(gene_id))

-            stop("'gene_id' must be a single string (or NA)")

-        if (length(x) == 0L)

-            stop("'x' must be of length >= 1")

-        x_names <- names(x)

-        ans <- mcols(x@tx)[["UATXHcount"]]

-        if (is.null(x_names)) {

-            if (!is.na(gene_id))

-                stop("the 'gene_id' arg is not supported ",

-                     "when 'x' is unnamed (in which case all its elements ",

-                     "(i.e. transcripts) are considered to belong to the ",

-                     "same gene)")

-            return(ans) 

-        }

-        if (is.na(gene_id))

-            stop("'gene_id' must be supplied when 'x' has names")

-        if (is.null(ans))

-            return(ans)

-        ans <- ans[x_names == gene_id]

-        if (length(ans) == 0L)

-            stop("invalid 'gene_id'")

-        ans

-    }

-)

-

-

-### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-### .hits() accessor (not exported)

-###

-

-setGeneric(".hits", signature="x",

-    function(x, gene_id=NA) standardGeneric(".hits")

-)

-

-### Should return a CompressedCharacterList or a NULL.

-setMethod(".hits", "GRangesList",

-    function(x, gene_id=NA)

-    {

-        if (!isSingleStringOrNA(gene_id))

-            stop("'gene_id' must be a single string (or NA)")

-        if (length(x) == 0L)

-            stop("'x' must be of length >= 1")

-        x_names <- names(x)

-        if (is.null(x_names)) {

-            if (!is.na(gene_id))

-                stop("the 'gene_id' arg is not supported ",

-                     "when 'x' is unnamed (in which case all its elements ",

-                     "(i.e. transcripts) are considered to belong to the ",

-                     "same gene)")

-            ans <- mcols(unlist(x, use.names=FALSE))[["hits"]]

-            return(ans) 

-        }

-        if (is.na(gene_id))

-            stop("'gene_id' must be supplied when 'x' has names")

-        x <- x[x_names == gene_id]

-        if (length(x) == 0L)

-            stop("invalid 'gene_id'")

-        ans <- mcols(unlist(x, use.names=FALSE))[["hits"]]

-        ans

-    }

-)

-

-

-### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-### Sgdf() accessor

-###

-### Returns the splicing graph in a DataFrame with 1 row per edge.

-###

-

-### 'spath' must be an IntegerList containing all the splicing paths for a

-### given gene. Should have been obtained thru the Spath() accessor.

-### Returns a 4-col (or 5-col if 'UATXHcount' is supplied) data.frame representing

-### the splicing graph.

-.make_Sgdf0_from_Spath <- function(spath, UATXHcount=NULL)

-{

-    if (!is.null(UATXHcount)) {

-        if (!is.integer(UATXHcount))

-            stop("'UATXHcount' must be an integer vector or NULL")

-        if (length(UATXHcount) != length(spath))

-            stop("when not NULL, 'UATXHcount' must have ",

-                 "the same length as 'spath'")

-    }

-    sgdf0s <- lapply(seq_along(spath),

-                     function(i) {

-                         SSids <- spath[[i]]

-                         from <- c("R", SSids)

-                         to <- c(SSids, "L")

-                         nb_SSids <- length(SSids)

-                         if (nb_SSids %% 2L != 0L)

-                             stop("some splicing paths in 'spath' go thru an ",

-                                  "odd number of splicing site ids")

-                         nexons <- nb_SSids %/% 2L

-                         if (nexons == 0L) {

-                             ex_or_in <- .EX_OR_IN_LEVELS[3L]

-                         } else {

-                             nintrons <- nexons - 1L

-                             ex_or_in <- c(.EX_OR_IN_LEVELS[3L],

-                                           rep.int(.EX_OR_IN_LEVELS[1:2],

-                                                   nintrons),

-                                           .EX_OR_IN_LEVELS[1L],

-                                           .EX_OR_IN_LEVELS[3L])

-                         }

-                         ex_or_in <- factor(ex_or_in,

-                                            levels=.EX_OR_IN_LEVELS)

-                         data.frame(from=from,

-                                    to=to,

-                                    ex_or_in=ex_or_in,

-                                    stringsAsFactors=FALSE)

-                     })

-    nedges_per_tx <- sapply(sgdf0s, nrow)

-    sgdf0 <- do.call(rbind, sgdf0s)

-    tx_id <- names(spath)

-    if (is.null(tx_id))

-        tx_id <- seq_along(spath)

-    tx_id <- rep.int(factor(tx_id, levels=tx_id), nedges_per_tx)

-    sgdf0$tx_id <- tx_id

-    if (!is.null(UATXHcount))

-        sgdf0$UATXHcount <- rep.int(UATXHcount, nedges_per_tx)

-    sgdf0

-}

-

-### Collapse the duplicated edges in 'sgdf0' into a DataFrame.

-### We use a DataFrame instead of a data.frame because we want to store

-### the tx_id col in a CompressedFactorList (even though this container

-### doesn't formally exist and a CompressedIntegerList is actually what's

-### being used).

-.make_Sgdf_from_Sgdf0 <- function(sgdf0, ex_hits=NULL, in_hits=NULL)

-{

-    from <- sgdf0[ , "from"]

-    to <- sgdf0[ , "to"]

-    ex_or_in <- sgdf0[ , "ex_or_in"]

-    tx_id <- sgdf0[ , "tx_id"]

-    edges <- paste(from, to, sep="~")

-    sm <- match(edges, edges)

-    if (!all(ex_or_in == ex_or_in[sm]))

-        stop("invalid splicing graph")

-    is_not_dup <- sm == seq_along(sm)

-    sgdf <- DataFrame(sgdf0[is_not_dup, , drop=FALSE])

-    sgdf$tx_id <- splitAsList(tx_id, sm)

-    UATXHcount <- sgdf$UATXHcount

-    if (!is.null(UATXHcount))

-        sgdf$UATXHcount <- sum(splitAsList(sgdf0$UATXHcount, sm))

-    if (is.null(ex_hits) && is.null(in_hits))

-        return(sgdf)

-    hits <- relist(character(0), PartitioningByEnd(NG=length(sm)))

-    if (!is.null(ex_hits)) {

-        if (!is(ex_hits, "CharacterList"))

-            stop("'ex_hits' must be a CharacterList object")

-        ex_idx <- which(ex_or_in == "ex")

-        if (length(ex_idx) != length(ex_hits))

-            stop("'ex_hits' is incompatible with 'sgdf0'")

-        hits[ex_idx] <- ex_hits

-    }

-    if (!is.null(in_hits)) {

-        if (!is(in_hits, "CharacterList"))

-            stop("'in_hits' must be a CharacterList object")

-        in_idx <- which(ex_or_in == "in")

-        if (length(in_idx) != length(in_hits))

-            stop("'in_hits' is incompatible with 'sgdf0'")

-        hits[in_idx] <- in_hits

-    }

-    ## TODO: This is quite inefficient. Improve it.

-    for (i in which(!is_not_dup))

-        hits[[sm[i]]] <- unique(hits[[sm[i]]], hits[[i]])

-    sgdf$hits <- hits[is_not_dup]

-    sgdf$nhits <- elementLengths(sgdf$hits)

-    sgdf

-}

-

-setGeneric("Sgdf", signature="x",

-    function(x, gene_id=NA, UATXHcount=NULL, inbytx=NULL, keep.dup.edges=FALSE)

-        standardGeneric("Sgdf")

-)

-

-setMethod("Sgdf", "ANY",

-    function(x, gene_id=NA, UATXHcount=NULL, inbytx=NULL, keep.dup.edges=FALSE)

-    {

-        spath <- Spath(x, gene_id=gene_id)

-        if (is.null(UATXHcount))

-            UATXHcount <- UATXHcount(x, gene_id=gene_id)

-        if (is.null(inbytx))

-            return(Sgdf(spath, UATXHcount=UATXHcount,

-                               keep.dup.edges=keep.dup.edges))

-        if (!is(inbytx, "GRangesList"))

-            stop("'inbytx' must be NULL or a GRangesList object")

-        if (!is(x, "SplicingGraphs"))

-            stop("'x' must be a SplicingGraphs object ",

-                 "when 'inbytx' is a GRangesList object")

-        if (length(inbytx) != length(x))

-            stop("'inbytx' must have the same length as 'x'")

-        if (!identical(elementLengths(inbytx) + 1L, elementLengths(x)))

-            stop("the shape of 'inbytx' is not compatible ",

-                 "with the shape of 'x'")

-        if (!identical(keep.dup.edges, FALSE))

-            stop("'keep.dup.edges' must be FALSE when 'inbytx' is supplied")

-        sgdf0 <- Sgdf(spath, UATXHcount=UATXHcount, keep.dup.edges=TRUE)

-        ex_or_in <- sgdf0[ , "ex_or_in"]

-        ex_hits <- .hits(x@tx, gene_id=gene_id)

-        if (is.null(ex_hits))

-            stop("'x' must have a \"hits\" inner metadata column ",

-                 "when 'inbytx' is a GRangesList object. May be ",

-                 "you forgot to pass it thru assignSubfeatureHits()?")

-        in_hits <- .hits(inbytx, gene_id=gene_id)

-        if (is.null(in_hits))

-            stop("'inbytx' has no \"hits\" inner metadata column. May be ",

-                 "you forgot to pass it thru assignSubfeatureHits()?")

-        .make_Sgdf_from_Sgdf0(sgdf0, ex_hits=ex_hits, in_hits=in_hits)

-    }

-)

-

-setMethod("Sgdf", "IntegerList",

-    function(x, gene_id=NA, UATXHcount=NULL, inbytx=NULL, keep.dup.edges=FALSE)

-    {

-        if (!identical(gene_id, NA))

-            stop("the 'gene_id' arg is not supported ",

-                 "when 'x' is an IntegerList")

-        if (!is.null(inbytx))

-            stop("the 'inbytx' arg is not supported ",

-                 "when 'x' is an IntegerList")

-        sgdf0 <- .make_Sgdf0_from_Spath(x, UATXHcount=UATXHcount)

-        Sgdf(sgdf0, keep.dup.edges=keep.dup.edges)

-    }

-)

-

-setMethod("Sgdf", "data.frame",

-    function(x, gene_id=NA, UATXHcount=NULL, inbytx=NULL, keep.dup.edges=FALSE)

-    {

-        if (!identical(gene_id, NA))

-            stop("the 'gene_id' arg is not supported ",

-                 "when 'x' is a data.frame")

-        if (!is.null(UATXHcount))

-            stop("the 'UATXHcount' arg is not supported ",

-                 "when 'x' is a data.frame")

-        if (!is.null(inbytx))

-            stop("the 'inbytx' arg is not supported ",

-                 "when 'x' is a data.frame")

-        if (!isTRUEorFALSE(keep.dup.edges))

-            stop("'keep.dup.edges' must be TRUE or FALSE")

-        if (keep.dup.edges)

-            return(x)  # no-op

-        .make_Sgdf_from_Sgdf0(x)

-    }

-)

-

-

-### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-### .make_igraph_from_Sgdf()

-###

-

-### 'sgdf' must be a data.frame as returned by:

-###     Sgdf( , keep.dup.edges=TRUE)

-### or a DataFrame as returned by:

-###     Sgdf( , keep.dup.edges=FALSE)

-### Valid extra cols are: "label", "label.color", "lty", "color", "width"

-### and "UATXHcount". They are used to set graphical parameters on the edges.

-.precook_igraph_edges_from_Sgdf <- function(sgdf)

-{

-    required_colnames <- c("from", "to", "ex_or_in", "tx_id")

-    extra_colnames <- c("label", "label.color", "lty", "color",

-                        "width", "UATXHcount")

-    extract_colnames <- c(required_colnames,

-                          intersect(extra_colnames, colnames(sgdf)))

-    ans <- sgdf[ , extract_colnames, drop=FALSE]

-    ex_or_in <- ans[ , "ex_or_in"]

-    ex_or_in_levels <- levels(ex_or_in)

-    if (!identical(ex_or_in_levels, .EX_OR_IN_LEVELS2)

-     && !identical(ex_or_in_levels, .EX_OR_IN_LEVELS))

-        stop("\"ex_or_in\" column has invalid levels")

-    if (!("label.color" %in% extract_colnames))

-        ans$label.color <- "blue"

-    if (!("lty" %in% extract_colnames))

-        ans$lty <- c("solid", "solid", "dashed", "solid")[ex_or_in]

-    if (!("color" %in% extract_colnames))

-        ans$color <- c("green3", "darkgrey", "grey", "black")[ex_or_in]

-    if (!("width" %in% extract_colnames)

-     && "UATXHcount" %in% extract_colnames) {

-        min_UATXHcount <- min(ans$UATXHcount)

-        if (min_UATXHcount < 0L) {

-            warning("'UATXHcount' column contains negative values. Cannot use ",

-                    "it to set the widths of the edges.")

-        } else {

-            max_UATXHcount <- max(ans$UATXHcount)

-            if (max_UATXHcount <= 0L) {

-                warning("'UATXHcount' column has no positive values. Cannot use ",

-                        "it to set the widths of the edges.")

-            } else {

-                ans$width <- 20.0 * ans$UATXHcount / max(ans$UATXHcount)

-            }

-        }

-    }

-    ans

-}

-

-.make_igraph <- function(d)

-{

-    ## Prepare the 'vertices' argument to pass to graph.data.frame().

-    from <- d[ , "from"]

-    to <- d[ , "to"]

-    nodes <- unique(c(from, to))

-    nodes <- sort(as.integer(setdiff(nodes, c("R", "L"))))

-    nodes <- c("R", as.character(nodes), "L")

-    color <- c("gray", rep.int("white", length(nodes)-2L), "gray")

-    label.color <- "black"

-    vertices <- data.frame(name=nodes, color=color, label.color=label.color)

-

-    ## Make the igraph object.

-    g <- graph.data.frame(d, vertices=vertices)

-    layout.kamada.kawai.deterministic <- function(...)

-    {

-        set.seed(33L)

-        layout.kamada.kawai(...)

-    }

-

-    ## Set its layout attribute.

-    g$layout <- layout.kamada.kawai.deterministic

-    #g$layout <- layout.Sgraph

-

-    g

-}

-

-### 'sgdf0' must be a data.frame as returned by:

-###     Sgdf( , keep.dup.edges=TRUE)

-.make_igraph_from_Sgdf0 <- function(sgdf0, gene_id=NA)

-{

-    if (!is.data.frame(sgdf0))

-        stop("'sgdf0' must be a data.frame")

-    d <- .precook_igraph_edges_from_Sgdf(sgdf0)

-    if (!("label" %in% colnames(d)))

-        d$label <- d$tx_id

-    .make_igraph(d)

-}

-

-### 'sgdf' must be a DataFrame as returned by:

-###     Sgdf( , keep.dup.edges=FALSE)

-### or by:

-###     Sgdf2( )

-.make_igraph_from_Sgdf <- function(sgdf, gene_id=NA)

-{

-    if (!is(sgdf, "DataFrame"))

-        stop("'sgdf' must be a DataFrame")

-    d <- .precook_igraph_edges_from_Sgdf(sgdf)

-    if (!("label" %in% colnames(d)))

-        d$label <- sapply(d$tx_id, paste, collapse=",")

-    d$tx_id <- NULL

-    ## Turning 'd' into an ordinary data.frame. (Looks like 'as.data.frame()'

-    ## on a DataFrame ignores the 'stringsAsFactors' arg so we use

-    ## 'data.frame(as.list())' instead.)

-    d <- data.frame(as.list(d), stringsAsFactors=FALSE)

-    .make_igraph(d)

-}

-

-

-### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-### Sgraph() accessor

-###

-### Returns the splicing graph in an igraph object.

-###

-

-setGeneric("Sgraph", signature="x",

-    function(x, gene_id=NA, keep.dup.edges=FALSE, as.igraph=FALSE)

-        standardGeneric("Sgraph")

-)

-

-setMethod("Sgraph", "ANY",

-    function(x, gene_id=NA, keep.dup.edges=FALSE, as.igraph=FALSE)

-    {

-        sgdf <- Sgdf(x, gene_id=gene_id, keep.dup.edges=keep.dup.edges)

-        Sgraph(sgdf, as.igraph=as.igraph)

-    }

-)

-

-setMethod("Sgraph", "data.frame",

-    function(x, gene_id=NA, keep.dup.edges=FALSE, as.igraph=FALSE)

-    {

-        if (!identical(gene_id, NA))

-            stop("the 'gene_id' arg is not supported ",

-                 "when 'x' is a data.frame")

-        if (!identical(keep.dup.edges, FALSE))

-            stop("the 'keep.dup.edges' arg is not supported ",

-                 "when 'x' is a data.frame")

-        igraph <- .make_igraph_from_Sgdf0(x)

-        Sgraph(igraph, as.igraph=as.igraph)

-    }

-)

-

-setMethod("Sgraph", "DataFrame",

-    function(x, gene_id=NA, keep.dup.edges=FALSE, as.igraph=FALSE)

-    {

-        if (!identical(gene_id, NA))

-            stop("the 'gene_id' arg is not supported ",

-                 "when 'x' is a DataFrame")

-        if (!identical(keep.dup.edges, FALSE))

-            stop("the 'keep.dup.edges' arg is not supported ",

-                 "when 'x' is a DataFrame")

-        igraph <- .make_igraph_from_Sgdf(x)

-        Sgraph(igraph, as.igraph=as.igraph)

-    }

-)

-

-setMethod("Sgraph", "igraph",

-    function(x, gene_id=NA, keep.dup.edges=FALSE, as.igraph=FALSE)

-    {

-        if (!identical(gene_id, NA))

-            stop("the 'gene_id' arg is not supported ",

-                 "when 'x' is an igraph object")

-        if (!identical(keep.dup.edges, FALSE))

-            stop("the 'keep.dup.edges' arg is not supported ",

-                 "when 'x' is an igraph object")

-        if (!isTRUEorFALSE(as.igraph))

-            stop("'as.igraph' must be TRUE or FALSE")

-        if (as.igraph) {

-            ## Need to load the igraph package so the user can display, plot,

-            ## and manipulate the returned object.

-            library(igraph)

-            return(x)  # no-op

-        }

-        make_Ragraph_from_igraph(x)

-    }

-)

-

-

-### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-### uninformativeSSids() accessor

-###

-

-setGeneric("uninformativeSSids", signature="x",

-    function(x, gene_id=NA) standardGeneric("uninformativeSSids")

-)

-

-setMethod("uninformativeSSids", "ANY",

-    function(x, gene_id=NA)

-    {

-        x <- Sgdf(x, gene_id=gene_id)

-        uninformativeSSids(x)

-    }

-)

-

-setMethod("uninformativeSSids", "DataFrame",

-    function(x, gene_id=NA)

-    {

-        if (!identical(gene_id, NA))

-            stop("the 'gene_id' arg is not supported ",

-                 "when 'x' is a DataFrame")

-        from <- x[ , "from"]

-        to <- x[ , "to"]

-        from1_SSids <- setdiff(from, from[duplicated(from)])

-        to1_SSids <- setdiff(to, to[duplicated(to)])

-        intersect(from1_SSids, to1_SSids)

-    }

-)

-

-

-### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-### Sgdf2() accessor

-###

-### Same as Sgdf() except that uninformative nodes (i.e. SSids) are removed.

-###

-

-### 'sgdf' must be a DataFrame as returned by:

-###     Sgdf( , keep.dup.edges=FALSE)

-.remove_uninformative_SSids <- function(sgdf)

-{

-    ex_or_in <- sgdf[ , "ex_or_in"]

-    ex_or_in_levels <- levels(ex_or_in)

-    if (!identical(ex_or_in_levels, .EX_OR_IN_LEVELS))

-        stop("Malformed input.\n",

-             "  In the input data.frame (or DataFrame) representing the ",

-             "original splicing graph, the \"ex_or_in\" column has invalid ",

-             "levels. Could it be that it was obtained by a previous call ",

-             "to Sgdf2()?")

-    levels(ex_or_in) <- .EX_OR_IN_LEVELS2

-    uninformative_SSids <- uninformativeSSids(sgdf)

-    if (length(uninformative_SSids) == 0L)

-        return(sgdf)

-    from <- sgdf[ , "from"]

-    to <- sgdf[ , "to"]

-    tx_id <- sgdf[ , "tx_id"]

-    idx1 <- match(uninformative_SSids, from)

-    idx2 <- match(uninformative_SSids, to)

-    ## 2 sanity checks.

-    if (!identical(unname(tx_id[idx1]), unname(tx_id[idx2])))

-        stop("Malformed input.\n",

-             "  In the input data.frame (or DataFrame) representing the ",

-             "original splicing graph, the 2 rows containing a given ",

-             "uninformative splicing site id must contain the same tx_id.",

-             "Could it be that the \"tx_id\" column was manually altered ",

-             "before the data.frame (or DataFrame) was passed to ",

-             "Sgdf2()?")

-    if (!all(idx1 == idx2 + 1L))

-        stop("Malformed input.\n",

-             "  In the input data.frame (or DataFrame) representing the ",

-             "original splicing graph, each uninformative splicing site ",

-             "id must appear in 2 consecutive rows (first in the \"to\" ",

-             "column, then in the \"from\" column. Could it be that the ",

-             "rows were subsetted before the data.frame (or DataFrame) ",

-             "was passed to Sgdf2()?")

-    from <- from[-idx1]

-    to <- to[-idx2]

-    ex_or_in[idx1] <- .EX_OR_IN_LEVELS2[4L]

-    ex_or_in <- ex_or_in[-idx2]

-    tx_id <- tx_id[-idx1]

-    DataFrame(from=from, to=to, ex_or_in=ex_or_in, tx_id=tx_id)

-}

-

-Sgdf2 <- function(x, gene_id=NA)

-{

-    if (!is(x, "DataFrame"))

-        x <- Sgdf(x, gene_id=gene_id)

-    .remove_uninformative_SSids(x)

-}

-

-

-### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-### Sgraph2() accessor

-###

-### Same as Sgraph() except that uninformative nodes (i.e. SSids) are removed.

-###

-

-Sgraph2 <- function(x, gene_id=NA, as.igraph=FALSE)

-{

-    Sgraph(Sgdf2(x, gene_id=gene_id), as.igraph=as.igraph)

-}

-

-

 ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 ### SplicingGraphs() constructor

 ###

@@ -711,18 +129,18 @@ Sgraph2 <- function(x, gene_id=NA, as.igraph=FALSE)

     if (!is.null(tx_id))

         exbytx_mcols$tx_id <- tx_id

-    ## Set Spath metadata col.

-    if ("Spath" %in% colnames(exbytx_mcols))

-        stop("'exbytx' already has metadata column Spath")

+    ## Set spath metadata col.

+    if ("spath" %in% colnames(exbytx_mcols))

+        stop("'exbytx' already has metadata column spath")

     if (on.minus.strand) {

-        Spath <- rbind(SSids$end_SSid, SSids$start_SSid)

+        spath <- rbind(SSids$end_SSid, SSids$start_SSid)

     } else {

-        Spath <- rbind(SSids$start_SSid, SSids$end_SSid)

+        spath <- rbind(SSids$start_SSid, SSids$end_SSid)

     }

-    Spath_partitioning <- PartitioningByEnd(end(PartitioningByEnd(exbytx)) * 2L)

-    names(Spath_partitioning) <- tx_id

-    Spath <- splitAsList(as.vector(Spath), Spath_partitioning)

-    exbytx_mcols$Spath <- Spath

+    spath_partitioning <- PartitioningByEnd(end(PartitioningByEnd(exbytx)) * 2L)

+    names(spath_partitioning) <- tx_id

+    spath <- splitAsList(as.vector(spath), spath_partitioning)

+    exbytx_mcols$spath <- spath

     mcols(exbytx) <- exbytx_mcols

     exbytx

@@ -899,33 +317,3 @@ SplicingGraphs <- function(exbytx, grouping=NULL, check.introns=TRUE)

     new("SplicingGraphs", tx=ans_tx)

 }

-

-### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-### "plot" method.

-###

-

-setMethod("plot", c("SplicingGraphs", "ANY"),

-    function(x, y, gene_id=NA)

-    {

-        if (missing(gene_id)) {

-            if (missing(y)) {

-                gene_id <- NA

-            } else {

-                gene_id <- y

-            }

-        } else {

-            if (!missing(y))

-                warning("'y' is ignored when plotting a SplicingGraphs ",

-                        "object and 'gene_id' is supplied")

-        }

-        if (!isSingleStringOrNA(gene_id))

-            stop("the supplied gene id must be a single string (or NA)")

-        x_names <- names(x)

-        if (!is.null(x_names) && is.na(gene_id))

-            stop("You need to specify a gene id when 'x' has names ",

-                 "e.g. 'plot(sg, \"some gene id\")'. Get all valid ",

-                 "gene ids with 'unique(names(sg))'.")

-        plot(Sgraph(x, gene_id=gene_id))

-    }

-)

-

new file mode 100644

@@ -0,0 +1,397 @@

+### =========================================================================

+### sgdf (and related) methods

+### -------------------------------------------------------------------------

+

+

+EX_OR_IN_LEVELS2 <- c("ex", "in", "", "mixed")

+EX_OR_IN_LEVELS <- EX_OR_IN_LEVELS2[-4L]

+

+

+### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

+### spath() accessor

+###

+### Gets all the splicing paths for the specified gene.

+### Returns them in a named IntegerList with 1 top-level element per

+### transcript in the specified gene. Each top-level element 'spath[[i]]'

+### contains the splicing site ids for the i-th transcript.

+###

+

+setGeneric("spath", signature="x",

+    function(x, gene_id=NA) standardGeneric("spath")

+)

+

+### Should return a CompressedIntegerList.

+setMethod("spath", "SplicingGraphs",

+    function(x, gene_id=NA)

+    {

+        if (!isSingleStringOrNA(gene_id))

+            stop("'gene_id' must be a single string (or NA)")

+        if (length(x) == 0L)

+            stop("'x' must be of length >= 1")

+        x_names <- names(x)

+        ans <- mcols(x@tx)[ , "spath"]

+        if (is.null(x_names)) {

+            if (!is.na(gene_id))

+                stop("the 'gene_id' arg is not supported ",

+                     "when 'x' is unnamed (in which case all its elements ",

+                     "(i.e. transcripts) are considered to belong to the ",

+                     "same gene)")

+            return(ans) 

+        }

+        if (is.na(gene_id))

+            stop("'gene_id' must be supplied when 'x' has names")

+        ans <- ans[x_names == gene_id]

+        if (length(ans) == 0L)

+            stop("invalid 'gene_id'")

+        ans

+    }

+)

+

+

+### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

+### UATXHcount() accessor

+###

+

+setGeneric("UATXHcount", signature="x",

+    function(x, gene_id=NA) standardGeneric("UATXHcount")

+)

+

+### Should return an integer vector or a NULL.

+setMethod("UATXHcount", "SplicingGraphs",

+    function(x, gene_id=NA)

+    {

+        if (!isSingleStringOrNA(gene_id))

+            stop("'gene_id' must be a single string (or NA)")

+        if (length(x) == 0L)

+            stop("'x' must be of length >= 1")

+        x_names <- names(x)

+        ans <- mcols(x@tx)[["UATXHcount"]]

+        if (is.null(x_names)) {

+            if (!is.na(gene_id))

+                stop("the 'gene_id' arg is not supported ",

+                     "when 'x' is unnamed (in which case all its elements ",

+                     "(i.e. transcripts) are considered to belong to the ",

+                     "same gene)")

+            return(ans) 

+        }

+        if (is.na(gene_id))

+            stop("'gene_id' must be supplied when 'x' has names")

+        if (is.null(ans))

+            return(ans)

+        ans <- ans[x_names == gene_id]

+        if (length(ans) == 0L)

+            stop("invalid 'gene_id'")

+        ans

+    }

+)

+

+

+### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

+### .hits() accessor (not exported)

+###

+

+setGeneric(".hits", signature="x",

+    function(x, gene_id=NA) standardGeneric(".hits")

+)

+

+### Should return a CompressedCharacterList or a NULL.

+setMethod(".hits", "GRangesList",

+    function(x, gene_id=NA)

+    {

+        if (!isSingleStringOrNA(gene_id))

+            stop("'gene_id' must be a single string (or NA)")