@@ -1,14 +1,14 @@

 Package: MotifDb

 Type: Package

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

-Version: 1.21.6

+Version: 1.21.7

 Date: 2018-05-18

 Author: Paul Shannon, Matt Richards

 Maintainer: Paul Shannon <pshannon@systemsbiology.org>

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

 Suggests: RUnit, seqLogo, MotIV

 Imports: rtracklayer, splitstackshape

-Description: More than 9000 annotated position frequency matrices from 14 public sources, for multiple organisms.

+Description: More than 9900 annotated position frequency matrices from 14 public sources, for multiple organisms.

 License: Artistic-2.0 | file LICENSE

 License_is_FOSS: no

 License_restricts_use: yes

@@ -475,6 +475,9 @@ setMethod ('motifToGene', 'MotifList',

            }

         }

       tbl.out <- rbind(tbl.mdb, tbl.tfc)

+      dups <- which(duplicated(tbl.out[, c("motif", "geneSymbol", "organism", "source")]))

+      if(length(dups) > 0)

+         tbl.out <- tbl.out[-dups,]

       if(length(name.map) > 0)

          tbl.out$motif <- as.character(name.map[tbl.out$motif])

       #browser()

@@ -525,53 +528,62 @@ setMethod ('geneToMotif', 'MotifList',

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

 setMethod('associateTranscriptionFactors', 'MotifList',

-   function(object, tbl.withMotifs, source, expand.rows){

-     source <- tolower(source)

-     stopifnot(source %in% c("motifdb", "tfclass"))

-     tbl.out <- data.frame()

-     if(source %in% c("motifdb")){

-           # lookup up in the object metadata, expect one TF geneSymbol per matrix name

-        pfm.ids <- tbl.withMotifs[, "motifName"]

-        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")){

-        if(! "shortMotif" %in% colnames(tbl.withMotifs)){

-           stop("MotifDb::assoicateTranscriptionFactors needs a 'shortMotif' column with the TFClass source")

-           }

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

-        motif.ids <- tbl.withMotifs[, "shortMotif"]

-        geneSymbols <- lapply(motif.ids, function(id)

-                                 paste(tbl.tfClass$tf.gene[grep(id, tbl.tfClass$motif, fixed=TRUE)], collapse=";"))

-        geneSymbols <- unlist(geneSymbols)

-        pubmedIds   <- lapply(motif.ids, function(id)

-                                 unique(tbl.tfClass$pubmedID[grep(id, tbl.tfClass$motif, fixed=TRUE)]))

-        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

-     })

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

+        stopifnot("motifName" %in% colnames(tbl.withMotifs))

+        tbl.tf <- motifToGene(object, tbl.withMotifs$motifName, source)

+        merge(tbl.withMotifs, tbl.tf, by.x="motifName", by.y="motif", all.x=TRUE)

+        })

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

+# setMethod('associateTranscriptionFactors', 'MotifList',

+#

+#    function(object, tbl.withMotifs, source, expand.rows){

+#      source <- tolower(source)

+#      stopifnot(source %in% c("motifdb", "tfclass"))

+#      tbl.out <- data.frame()

+#      if(source %in% c("motifdb")){

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

+#         pfm.ids <- tbl.withMotifs[, "motifName"]

+#         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")){

+#         if(! "shortMotif" %in% colnames(tbl.withMotifs)){

+#            stop("MotifDb::assoicateTranscriptionFactors needs a 'shortMotif' column with the TFClass source")

+#            }

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

+#         motif.ids <- tbl.withMotifs[, "shortMotif"]

+#         geneSymbols <- lapply(motif.ids, function(id)

+#                                  paste(tbl.tfClass$tf.gene[grep(id, tbl.tfClass$motif, fixed=TRUE)], collapse=";"))

+#         geneSymbols <- unlist(geneSymbols)

+#         pubmedIds   <- lapply(motif.ids, function(id)

+#                                  unique(tbl.tfClass$pubmedID[grep(id, tbl.tfClass$motif, fixed=TRUE)]))

+#         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

+#      })

+#

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

@@ -896,12 +896,12 @@ test.motifToGene <- function()

       # MotifDb mode uses the MotifDb metadata "providerId",

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

-   checkEquals(dim(tbl.mdb), c(4, 5))

-   expected <- sort(c("MA0592.2", "MA0592.2", "ELF1.SwissRegulon", "UP00022"))

+   checkEquals(dim(tbl.mdb), c(3, 5))

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

    actual <- sort(tbl.mdb$motif)

    checkEquals(actual, expected)

-   checkEquals(sort(tbl.mdb$geneSymbol), sort(c("ELF1", "Esrra", "Esrra", "Zfp740")))

-   checkEquals(tbl.mdb$source,     rep("MotifDb", 4))

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

+   checkEquals(tbl.mdb$source,     rep("MotifDb", 3))

       # TFClass mode uses  TF family classifcation

    tbl.tfClass <- motifToGene(MotifDb, motifs, source="TFClass")

@@ -948,7 +948,10 @@ test.motifToGene <- function()

    checkEquals(sort(unique(tbl$motif)), c("Hsapiens-jaspar2016-TFAP2A-MA0003.3", "MA0872.1"))

    checkEquals(sort(unique(tbl$geneSymbol)), c("TFAP2A", "TFAP2B", "TFAP2C", "TFAP2D", "TFAP2E"))

-   tbl <- motifToGene(MotifDb, motifs, source="TFClass")

+   tbl <- motifToGene(MotifDb, motifs, source=c("MotifDb", "TFClass"))

+   checkTrue(all(motifs %in% tbl$motif))

+   checkEquals(sort(unique(tbl$geneSymbol)),

+                    c("AR", "RUNX1", "TFAP2A", "TFAP2A(var.3)", "TFAP2B", "TFAP2C", "TFAP2D", "TFAP2E"))

    } # test.motifToGene

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

@@ -958,66 +961,80 @@ test.associateTranscriptionFactors <- function()

    mdb <- MotifDb

    pfms <- query(mdb, andStrings=c("sapiens", "jaspar2016"))

-      # query(mdb, "jaspar2016", "sapiens")

+      # query(mdb, "jaspar2016", "sapiens")

       # 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(motifName=motif.names, score=runif(5), stringsAsFactors=FALSE)

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

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

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

-   checkEquals(sort(tbl.anno$geneSymbol), sort(c("RUNX1", "TFAP2A", "TFAP2A", "TFAP2A", "AR")))

-

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

-

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

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

-   tbl.anno <- associateTranscriptionFactors(mdb, tbl, 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"

-

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

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

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

-

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

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

-

-      # TFClass only annotates MA0003.3, none of the others

-   checkTrue(all(is.na(tbl.anno$geneSymbol[-4])))

-   checkTrue(all(is.na(tbl.anno$pubmedID[-4])))

-   checkEquals(tbl.anno$geneSymbol[4], "TFAP2A;TFAP2B;TFAP2C;TFAP2D;TFAP2E")

-   checkEquals(tbl.anno$pubmedID[4],   "23180794")

-

-      # now ask for expandsion of the semicolon separated list

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

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

-   checkTrue(all(c("TFAP2A", "TFAP2B", "TFAP2C", "TFAP2D", "TFAP2E") %in% tbl.anno$geneSymbol))

-

-      # 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[4] <- "bogus"

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

-

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

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

-      # after adding bogus to the only mapped motif name, all geneSymbol and pubmedID values should be NA

-   checkTrue(all(is.na(tbl.anno$geneSymbol)))

-   checkTrue(all(is.na(tbl.anno$pubmedID)))

-

-      # now make sure that the absence of the  TFClass-specific "shortMotif" field is detected

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

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

-   checkException(tbl.anno <- associateTranscriptionFactors(mdb, tbl, source="TFClass", expand.rows=FALSE), silent=TRUE)

+   motif.names <- c(names(pfms[1:5]), "MA0872.1", "hocus.pocus")

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

+

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

+   checkEquals(nrow(tbl), nrow(tbl.anno.mdb))

+   checkTrue(is.na(tbl.anno.mdb$geneSymbol[grep("hocus.pocus", tbl.anno.mdb$motifName)]))

+   checkTrue(all(c("AR", "RUNX1", "TFAP2A", "TFAP2A", "TFAP2A", "TFAP2A(var.3)") %in% tbl.anno.mdb$geneSymbol))

+

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

+   checkTrue(nrow(tbl) < nrow(tbl.anno.tfc))

+   checkEquals(sort(unique(tbl.anno.tfc$geneSymbol)), c("TFAP2A", "TFAP2B", "TFAP2C", "TFAP2D", "TFAP2E"))

+

+   tbl.anno.both <- associateTranscriptionFactors(mdb, tbl, source=c("MotifDb", "TFClass"), expand.rows=TRUE)

+   checkEquals(length(grep("MotifDb", tbl.anno.both$source)), 6)

+   checkEquals(length(grep("TFClass", tbl.anno.both$source)), 10)

+

+   #   checkEquals(dim(tbl.anno.mdb), c(nrow(tbl), ncol(tbl) + 4))

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

+   #   checkEquals(sort(tbl.anno.mdb$geneSymbol),

+   #               sort(c("AR", "RUNX1", "TFAP2A", "TFAP2A", "TFAP2A", "TFAP2A(var.3)")))

+   #

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

+   #

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

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

+   #   tbl.anno <- associateTranscriptionFactors(mdb, tbl, 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"

+   #

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

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

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

+   #

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

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

+   #

+   #      # TFClass only annotates MA0003.3, none of the others

+   #   checkTrue(all(is.na(tbl.anno$geneSymbol[-4])))

+   #   checkTrue(all(is.na(tbl.anno$pubmedID[-4])))

+   #   checkEquals(tbl.anno$geneSymbol[4], "TFAP2A;TFAP2B;TFAP2C;TFAP2D;TFAP2E")

+   #   checkEquals(tbl.anno$pubmedID[4],   "23180794")

+   #

+   #      # now ask for expandsion of the semicolon separated list

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

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

+   #   checkTrue(all(c("TFAP2A", "TFAP2B", "TFAP2C", "TFAP2D", "TFAP2E") %in% tbl.anno$geneSymbol))

+   #

+   #      # 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[4] <- "bogus"

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

+   #

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

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

+   #      # after adding bogus to the only mapped motif name, all geneSymbol and pubmedID values should be NA

+   #   checkTrue(all(is.na(tbl.anno$geneSymbol)))

+   #   checkTrue(all(is.na(tbl.anno$pubmedID)))

+   #

+   #      # now make sure that the absence of the  TFClass-specific "shortMotif" field is detected

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

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

+   #   checkException(tbl.anno <- associateTranscriptionFactors(mdb, tbl, source="TFClass", expand.rows=FALSE), silent=TRUE)

       # now some motif names

 } # test.associateTranscriptionFactors