@@ -1,8 +1,8 @@

 Package: MotifDb

 Type: Package

 Title: An Annotated Collection of Protein-DNA Binding Sequence Motifs

-Version: 1.19.3

-Date: 2017-08-12

+Version: 1.19.6

+Date: 2017-09-07

 Author: Paul Shannon, Matt Richards

 Maintainer: Paul Shannon <pshannon@systemsbiology.org>

 Depends: R (>= 2.15.0), methods, BiocGenerics, S4Vectors, IRanges, Biostrings

@@ -4,8 +4,9 @@ exportMethods (

    export,

    show,

    query,

-   mapMotifToTranscriptionFactorGeneSymbol,

-   mapTranscriptionFactorGeneSymbolToMotif

+   motifToGene,

+   geneToMotif,

+   associateTranscriptionFactors

    )

 export(

@@ -18,3 +19,4 @@ import(IRanges)

 importFrom(rtracklayer, export)

 import(Biostrings)

 import(methods)

+importFrom(splitstackshape, expandRows)

@@ -1,9 +1,10 @@

 setGeneric('query', signature='object', function(object, queryString, ignore.case=TRUE)

               standardGeneric ('query'))

-setGeneric('mapMotifToTranscriptionFactorGeneSymbol', signature='object', function(object, motifs, mode)

-              standardGeneric('mapMotifToTranscriptionFactorGeneSymbol'))

-setGeneric('mapTranscriptionFactorGeneSymbolToMotif', signature='object', function(object, geneSymbols, mode)

-              standardGeneric('mapTranscriptionFactorGeneSymbolToMotif'))

+setGeneric('motifToGene', signature='object', function(object, motifs, source) standardGeneric('motifToGene'))

+setGeneric('geneToMotif', signature='object', function(object, geneSymbols, source) standardGeneric('geneToMotif'))

+setGeneric('associateTranscriptionFactors', signature='object',

+           function(object, tbl.withMotifs, motif.column.name, source, expand.rows)

+              standardGeneric('associateTranscriptionFactors'))

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

 setClass ('MotifList',

           contains='SimpleList',

@@ -323,7 +324,7 @@ matrixToJasparText <- function (matrices)

       # For each line of the matrix, print the correct letter and the

       # matrix row surrounded by brackets

       motif.matrix <- matrices[name][[1]]

-	    

+

       for (r in 1:nrow(motif.matrix)) {

           s[index] <- sprintf("%s [ %s ]",

@@ -342,35 +343,105 @@ matrixToJasparText <- function (matrices)

 } # matrixToJasparText

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

 # returns a data.frame with motif, geneSymbol, source, pubmedID columns

-setMethod ('mapMotifToTranscriptionFactorGeneSymbol', 'MotifList',

-

-   function (object, motifs, mode) {

-     stopifnot(mode %in% c("direct", "indirect", "both"))

-     if(mode %in% c("direct", "both")){

-        # result <- rbind(result, newRows

+setMethod ('motifToGene', 'MotifList',

+

+   function (object, motifs, source) {

+     stopifnot(source %in% c("MotifDb", "TFClass"))

+     tbl <- data.frame()

+     if(source %in% c("MotifDb")){

+        tbl <- as.data.frame(subset(mcols(object), providerId %in% motifs))

+        tbl <- unique(tbl [, c("geneSymbol", "providerId", "dataSource", "organism", "pubmedID")])

+        colnames(tbl) <- c("geneSymbol", "motif", "dataSource", "organism", "pubmedID")

+        tbl

+        tbl <- tbl[, c("motif", "geneSymbol", "dataSource", "organism", "pubmedID")]

+        tbl$from <- "MotifDb"

         }

-     if(mode %in% c("indirect", "both")){

-        # draw on object@manuallyCuratedGeneMotifAssociationTable

-        # result <- rbind(result, newRows

+     if(source %in% c("TFClass")){

+        tbl <- subset(object@manuallyCuratedGeneMotifAssociationTable, motif %in% motifs)

+        tbl <- unique(tbl[, c("motif", "tf.gene", "pubmedID")])

+        tbl <- tbl[order(tbl$motif),]

+        rownames(tbl) <- NULL

+        colnames(tbl) <- c("motif", "gene", "pubmedID")

+        tbl$from <- "TFClass"

         }

-     result

+     tbl

      })

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

 # returns a data.frame with motif, geneSymbol, source, pubmedID columns

-setMethod ('mapTranscriptionFactorGeneSymbolToMotif', 'MotifList',

-

-   function (object, geneSymbols, mode) {

-     stopifnot(mode %in% c("direct", "indirect"))

-     result <- data.frame()

-     if(mode %in% c("direct", "both")){

-        # result <- rbind(result, newRows

+setMethod ('geneToMotif', 'MotifList',

+

+   function (object, geneSymbols, source) {

+     stopifnot(source %in% c("MotifDb", "TFClass"))

+     #browser()

+     extract.mdb <- function(gene){

+        tbl <- as.data.frame(subset(mcols(object), geneSymbol == gene))

+        tbl <- unique(tbl [, c("geneSymbol", "providerId", "dataSource", "organism", "pubmedID")])

+        colnames(tbl) <- c("geneSymbol", "motif", "dataSource", "organism", "pubmedID")

+        tbl

         }

-     if(mode %in% c("indirect", "both")){

-        # draw on object@manuallyCuratedGeneMotifAssociationTable

-        # result <- rbind(result, newRows

+     if(source %in% c("MotifDb")){

+        tbls <- lapply(geneSymbols, extract.mdb)

+        result <- do.call(rbind, tbls)

+        result$from <- "MotifDb"

+        }

+     if(source %in% c("TFClass")){

+        tbl <- subset(object@manuallyCuratedGeneMotifAssociationTable, tf.gene %in% geneSymbols)

+        tbl <- unique(tbl[, c("motif", "tf.gene", "pubmedID")])

+        tbl <- tbl[order(tbl$tf.gene),]

+        rownames(tbl) <- NULL

+        colnames(tbl) <- c("motif", "gene", "pubmedID")

+        result <- tbl[, c("gene", "motif", "pubmedID")]

+        result$from <- "TFClass"

         }

      result

      })

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

+setMethod('associateTranscriptionFactors', 'MotifList',

+

+   function(object, tbl.withMotifs, motif.column.name, source, expand.rows){

+     stopifnot(source %in% c("MotifDb", "TFClass"))

+     tbl.out <- data.frame()

+     if(source %in% c("MotifDb")){

+        # "direct" means:  lookup up in the object metadata, expect one TF geneSymbol per matrix name

+        pfm.ids <- tbl.withMotifs[, motif.column.name]

+        matched.rows <- match(pfm.ids, names(as.list(object)))

+        #if(length(matched.rows) == nrow(tbl.withMotifs)) {

+        tbl.new <- mcols(object)[matched.rows, c("geneSymbol", "pubmedID")]

+        tbl.new$geneSymbol[nchar(tbl.new$geneSymbol)==0] <- NA

+        tbl.new$pubmedID[nchar(tbl.new$pubmedID)==0] <- NA

+        tbl.out <- as.data.frame(cbind(tbl.withMotifs, tbl.new))

+         #}

+        } # direct

+     if(source %in% c("TFClass")){

+        tbl.tfClass <- read.table(system.file(package="MotifDb", "extdata", "tfClass.tsv"), sep="\t", as.is=TRUE, header=TRUE)

+        motif.ids <- tbl.withMotifs[, motif.column.name]

+        geneSymbols <- lapply(motif.ids, function(id) paste(tbl.tfClass$tf.gene[grep(id, tbl.tfClass$motif)], collapse=";"))

+        geneSymbols <- unlist(geneSymbols)

+        pubmedIds   <- lapply(motif.ids, function(id) unique(tbl.tfClass$pubmedID[grep(id, tbl.tfClass$motif)]))

+        pubmedIds   <- as.character(pubmedIds)

+        pubmedIds   <- gsub("integer(0)", "", pubmedIds, fixed=TRUE)

+        tbl.new     <- data.frame(geneSymbol=geneSymbols, pubmedID=pubmedIds, stringsAsFactors=FALSE)

+        tbl.new$geneSymbol[nchar(tbl.new$geneSymbol)==0] <- NA

+        tbl.new$pubmedID[nchar(tbl.new$pubmedID)==0] <- NA

+        tbl.out <- as.data.frame(cbind(tbl.withMotifs, tbl.new))

+

+        if(expand.rows){

+           rows.with.na <- which(is.na(tbl.out$geneSymbol))

+           rows.with.geneSymbol <- setdiff(1:nrow(tbl.out), rows.with.na)

+           tbl.asIs <- tbl.out[rows.with.na,]

+           tbl.toExpand <- tbl.out[rows.with.geneSymbol,]

+           geneSymbols.split <- strsplit(tbl.toExpand$geneSymbol, ";")

+           counts <- unlist(lapply(geneSymbols.split, length))

+           geneSymbols.split.vec <- unlist(geneSymbols.split)

+           tbl.expanded <- splitstackshape::expandRows(tbl.toExpand, counts, count.is.col=FALSE, drop=FALSE)

+           stopifnot(length(geneSymbols.split.vec) == nrow(tbl.expanded))

+           tbl.expanded$geneSymbol <- geneSymbols.split.vec

+           tbl.out <- rbind(tbl.expanded, tbl.asIs)

+           }

+        } # indirect

+     tbl.out

+     })

+

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

@@ -3,7 +3,7 @@ library (RUnit)

 library (MotIV)

 library (seqLogo)

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

-run.tests = function ()

+runTests = function ()

 {

   test.emptyCtor ()

   test.nonEmptyCtor ()

@@ -36,10 +36,14 @@ run.tests = function ()

   test.MotIV.toTable ()

   test.run_MotIV.motifMatch()

   test.flyFactorGeneSymbols()

-  test.export_jasparFormatStdOut ()

-  test.export_jasparFormatToFile ()

+  test.export_jasparFormatStdOut()

+  test.export_jasparFormatToFile()

-} # run.tests

+  test.geneToMotif()

+  test.motifToGene()

+  test.associateTranscriptionFactors()

+

+} # runTests

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

 test.emptyCtor = function ()

 {

@@ -743,26 +747,144 @@ test.export_jasparFormatToFile = function ()

 } # test.exportjasparFormatToFile

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

-test.motifTfGeneMapping <- function()

+test.geneToMotif <- function()

 {

-   printf("--- test.motifTfGeneMapping")

+   printf("--- test.geneToMotif")

    mdb <- MotifDb

-   set.seed(17)

-   random.10 <- sample(seq_len(nrow(mcols(mdb))), 10)

-   random.10.b <- sample(seq_len(nrow(mcols(mdb))), 10)

+   genes <- c("FOS", "ATF5", "bogus")

+

+      # use  TFClass family classifcation

+   tbl.i <- geneToMotif(mdb, genes, source="TFClass")

+   checkEquals(tbl.i$gene,  c("ATF5", "FOS", "FOS"))

+   checkEquals(tbl.i$motif,  c("MA0833.1", "MA0099.2", "MA0476.1"))

+   checkEquals(tbl.i$from, rep("TFClass", 3))

+

+      # MotifDb mode uses the MotifDb metadata, pulled from many sources

+   tbl.d <- geneToMotif(mdb, genes, source="MotifDb")

+   checkEquals(dim(tbl.d), c(12, 6))

+   checkEquals(subset(tbl.d, dataSource=="jaspar2016" & geneSymbol== "FOS")$motif, "MA0476.1")

+      # no recognizable (i.e., jaspar standard) motif name returned by MotifDb metadata

+      # MotifDb for ATF5

+      # todo: compare the MA0110596_1.02 matrix of cisp_1.02 to japar MA0833.1

+

+    # now try motifs to genes

-   motifs <- mcols(mdb)[random.10, "providerId"]

-   genes  <- mcols(mdb)[random.10, "geneSymbol"]

+} # test.geneToMotif

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

+test.motifToGene <- function()

+{

+   printf("--- test.motifToGene")

+   mdb <- MotifDb

-   tbl.m2tf <- mapMotifToTranscriptionFactorGeneSymbol(mdb, motifs, mode="direct")

-   tbl.m2tf <- mapMotifToTranscriptionFactorGeneSymbol(mdb, motifs, mode="indirect")

+   motifs <- c("MA0592.2", "UP00022", "ELF1.SwissRegulon")

-   tbl.tf2m <- mapTranscriptionFactorGeneSymbolToMotif(mdb, genes, mode="direct")

-   tbl.tf2m <- mapTranscriptionFactorGeneSymbolToMotif(mdb, genes, mode="indirect")

+      # TFClass mode uses  TF family classifcation

+   tbl.d <- motifToGene(mdb, motifs, source="MotifDb")

+   checkEquals(dim(tbl.d), c(3, 6))

+   checkEquals(tbl.d$motif, c("MA0592.2", "ELF1.SwissRegulon", "UP00022"))

+   checkEquals(tbl.d$geneSymbol, c("Esrra", "ELF1", "Zfp740"))

+   checkEquals(tbl.d$dataSource, c("jaspar2016", "SwissRegulon", "UniPROBE"))

+   checkEquals(tbl.d$organism,   c("Mmusculus", "Hsapiens", "Mmusculus"))

+   checkEquals(tbl.d$from,       rep("MotifDb", 3))

+

+      # MotifDb mode uses the MotifDb metadata, pulled from many sources

+   tbl.i <- motifToGene(mdb, motifs, source="TFClass")

+   checkEquals(dim(tbl.i), c(9,4))

+   checkEquals(tbl.i$motif, rep("MA0592.2", 9))

+   checkEquals(sort(tbl.i$gene), c("AR", "ESR1", "ESR2", "ESRRA", "ESRRB", "ESRRG", "NR3C1", "NR3C2", "PGR"))

+   checkEquals(tbl.i$from,       rep("TFClass", 9))

+

+} # test.geneToMotif

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

+test.associateTranscriptionFactors <- function()

+{

+   printf("--- test.associateTranscriptionFactors")

+

+   mdb <- MotifDb

+   pfms <- query(query(mdb, "jaspar2016"), "sapiens")

-      # check these 4 tables for agreement

+      # first check motifs with MotifDb-style long names, using MotifDb lookup, in the

+      # metadata of MotifDb:

+      #      "Hsapiens-jaspar2016-RUNX1-MA0002.1"  "Hsapiens-jaspar2016-TFAP2A-MA0003.1"

+   motif.names <- names(pfms[1:5])

+   tbl <- data.frame(motifLongName=motif.names, score=runif(5), stringsAsFactors=FALSE)

+   tbl.anno <- associateTranscriptionFactors(mdb, tbl, "motifLongName", source="MotifDb", expand.rows=FALSE)

+   checkEquals(dim(tbl.anno), c(nrow(tbl), ncol(tbl) + 2))

+   checkTrue(all(c("geneSymbol", "pubmedID") %in% colnames(tbl.anno)))

-} # test.motifTfGeneMapping

+      # now add in a bogus motif name, one for which there cannot possibly be a TF

+

+   motif.names[3] <- "bogus"

+   tbl <- data.frame(motifLongName=motif.names, score=runif(5), stringsAsFactors=FALSE)

+   tbl.anno <- associateTranscriptionFactors(mdb, tbl, "motifLongName", source="MotifDb", expand.rows=FALSE)

+   checkTrue(is.na(tbl.anno$geneSymbol[3]))

+   checkTrue(is.na(tbl.anno$pubmedID[3]))

+

+      # now check motifs with short, traditional names, in "TFClass" mode, which uses

+      # the tfFamily

+      #      "MA0002.1" "MA0003.1" "MA0003.2" "MA0003.3" "MA0007.2"

+

+   short.motif.names <- unlist(lapply(strsplit(motif.names, "-"), function(tokens) return(tokens[length(tokens)])))

+   tbl <- data.frame(motif=short.motif.names, score=runif(5), stringsAsFactors=FALSE)

+

+   tbl.anno <- associateTranscriptionFactors(mdb, tbl, "motif", source="TFClass", expand.rows=FALSE)

+   checkEquals(dim(tbl.anno), c(nrow(tbl), ncol(tbl) + 2))

+

+      # now add in a bogus motif name, one for which there cannot possibly be a TF

+

+   motif.names <- names(pfms[1:5])

+   short.motif.names <- unlist(lapply(strsplit(motif.names, "-"), function(tokens) return(tokens[length(tokens)])))

+   short.motif.names[3] <- "bogus"

+   tbl <- data.frame(motif=short.motif.names, score=runif(5), stringsAsFactors=FALSE)

+

+   tbl.anno <- associateTranscriptionFactors(mdb, tbl, "motif", source="TFClass", expand.rows=FALSE)

+   checkEquals(dim(tbl.anno), c(nrow(tbl), ncol(tbl) + 2))

+

+} # test.associateTranscriptionFactors

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

+#  MA0003.3 is mapped by TFClass to TFAP2A;TFAP2B;TFAP2C;TFAP2D;TFAP2E   (pumbedID 23180794)

+#  use it as a first test of the "exapand.rows" argument to associateTranscriptionFactors method

+#  MA0017.1  is unmapped by TFClass

+#  MA0017.2  is mapped to NR2F1

+test.associateTranscriptionFactors_expandRows <- function()

+{

+   printf("--- test.assoicateTranscriptionFactors")

+

+   mdb <- MotifDb

+   motifs <- c("MA0003.3", "MA0017.1", "MA0017.2")

+   tbl <- data.frame(motif=motifs, stringsAsFactors=FALSE)

+   tbl.anno <- associateTranscriptionFactors(mdb, tbl, motif.column.name="motif", source="TFClass", expand.rows=FALSE)

+   checkEquals(dim(tbl.anno), c(3,3))

+   checkEquals(tbl.anno$geneSymbol[c(1,3)], c("TFAP2A;TFAP2B;TFAP2C;TFAP2D;TFAP2E", "NR2F1"))

+   checkTrue(is.na(tbl.anno$geneSymbol[2]))

+

+   tbl.annoX <- associateTranscriptionFactors(mdb, tbl, motif.column.name="motif", source="TFClass", expand.rows=TRUE)

+   checkEquals(dim(tbl.annoX), c(7,3))

+   checkEquals(tbl.annoX$motif, c(rep("MA0003.3", 5), "MA0017.2", "MA0017.1"))

+   checkEquals(tbl.annoX$geneSymbol[1:6], c("TFAP2A", "TFAP2B", "TFAP2C", "TFAP2D", "TFAP2E", "NR2F1"))

+   checkTrue(is.na(tbl.annoX$geneSymbol[7]))

+

+      # now a large scale test

+   set.seed(37)

+   mdb.human <- query(mdb, "sapiens")   # > 4000 human matrices

+   indices <- sample(1:length(mdb.human), size=250)

+   motif.long.names <- names(mdb.human)[indices]

+   motif.short.names <- mcols(mdb.human)[indices, "providerId"]

+   tbl <- data.frame(motif.short=motif.short.names, motif.long=motif.long.names, stringsAsFactors=FALSE)

+

+   tbl.anno.mdb <- associateTranscriptionFactors(mdb, tbl, motif.column.name="motif.long", source="MotifDb", expand.rows=FALSE)

+   tbl.anno.mdbX <- associateTranscriptionFactors(mdb, tbl, motif.column.name="motif.long", source="MotifDb", expand.rows=TRUE)

+

+   tbl.anno.tfc  <- associateTranscriptionFactors(mdb, tbl, motif.column.name="motif.short", source="TFClass", expand.rows=FALSE)

+   checkEquals(nrow(tbl.anno.tfc), length(motif.short.names))

+   checkTrue(length(grep(";", tbl.anno.tfc$geneSymbol)) > 20)

+

+   tbl.anno.tfcX <- associateTranscriptionFactors(mdb, tbl, motif.column.name="motif.short", source="TFClass", expand.rows=TRUE)

+   checkTrue(nrow(tbl.anno.tfcX) > nrow(tbl.anno.tfc))   # 250 vs 779

+   checkEquals(length(grep(";", tbl.anno.tfcX$geneSymbol)), 0)

+

+

+} # test.associateTranscriptionFactors_expandRows

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