@@ -247,7 +247,7 @@ setMethod('show', 'MotifList',

       if (length (object) == 0)

         return ()

-      cat ('| Created from downloaded public sources: 2013-Aug-30', '\n', sep='')

+      cat ('| Created from downloaded public sources, last update: 2022-Mar-04', '\n', sep='')

       tbl.dataSource = as.data.frame (table (mcols (object)$dataSource))

       tbl.org = as.data.frame (table (mcols (object)$organism))

@@ -159,7 +159,7 @@ matrixToMemeText = function (matrices)

     s [index] = sprintf ('MOTIF %s', fixed.name)

     index = index + 1

     new.line =

-       sprintf ('letter-probability matrix: alength= 4 w= %d nsites= %d E=8.1e-020',

+       sprintf ('letter-probability matrix: alength= 4 w= %d nsites= %d E=%f',

           nrow (tfMat), 45, 8.1e-020)

     s [index] =  new.line

     index = index + 1

@@ -4,8 +4,8 @@ setGeneric('geneToMotif', signature='object', function(object, geneSymbols, sour

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

            function(object, tbl.withMotifs,  source, expand.rows, motifColumnName="motifName")

               standardGeneric('associateTranscriptionFactors'))

-setGeneric('matchMotif', signature='object', function(object, motifs, genomeName, regions, pval.cutoff,

-                                                      fimoDataFrameStyle=FALSE) standardGeneric('matchMotif'))

+#setGeneric('matchMotif', signature='object', function(object, motifs, genomeName, regions, pval.cutoff,

+#                                                      fimoDataFrameStyle=FALSE) standardGeneric('matchMotif'))

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

 setClass ('MotifList',

           contains='SimpleList',

@@ -64,29 +64,29 @@ MotifList = function (matrices=list(), tbl.metadata=data.frame ())

 } # ctor

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

-setMethod('matchMotif', signature='MotifList',

-

-   function(object, motifs, genomeName, regions, pval.cutoff, fimoDataFrameStyle=FALSE){

-     motifs.pfmatrix <- lapply(motifs, function(motif) convert_motifs(motif, "TFBSTools-PFMatrix"))

-     motifs.pfmList <- do.call(PFMatrixList, motifs.pfmatrix)

-     gr.list <- matchMotifs(motifs.pfmList, regions, genome=genomeName, out="positions", p.cutoff=pval.cutoff)

-     result <- gr.list

-     if(fimoDataFrameStyle){

-        gr <- unlist(gr.list)

-        motif.names <- names(gr)

-        names(gr) <- NULL

-        tbl <- as.data.frame(gr)

-        tbl$motif_id <- motif.names

-        colnames(tbl)[1] <- "chrom"

-        tbl$chrom <- as.character(tbl$chrom)

-        colnames(tbl)[grep("score", colnames(tbl))] <- "mood.score"

-        new.order <- order(tbl$start, decreasing=FALSE)

-        tbl <- tbl[new.order,]

-        result <- tbl

-        }

-     return(result)

-     })

-

+# setMethod('matchMotif', signature='MotifList',

+#

+#    function(object, motifs, genomeName, regions, pval.cutoff, fimoDataFrameStyle=FALSE){

+#      motifs.pfmatrix <- lapply(motifs, function(motif) convert_motifs(motif, "TFBSTools-PFMatrix"))

+#      motifs.pfmList <- do.call(PFMatrixList, motifs.pfmatrix)

+#      gr.list <- motifmatchr::matchMotifs(motifs.pfmList, regions, genome=genomeName, out="positions", p.cutoff=pval.cutoff)

+#      result <- gr.list

+#      if(fimoDataFrameStyle){

+#         gr <- unlist(gr.list)

+#         motif.names <- names(gr)

+#         names(gr) <- NULL

+#         tbl <- as.data.frame(gr)

+#         tbl$motif_id <- motif.names

+#         colnames(tbl)[1] <- "chrom"

+#         tbl$chrom <- as.character(tbl$chrom)

+#         colnames(tbl)[grep("score", colnames(tbl))] <- "mood.score"

+#         new.order <- order(tbl$start, decreasing=FALSE)

+#         tbl <- tbl[new.order,]

+#         result <- tbl

+#         }

+#      return(result)

+#      })

+#

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

 setMethod ('subset', signature = 'MotifList',

@@ -4,6 +4,8 @@ setGeneric('geneToMotif', signature='object', function(object, geneSymbols, sour

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

            function(object, tbl.withMotifs,  source, expand.rows, motifColumnName="motifName")

               standardGeneric('associateTranscriptionFactors'))

+setGeneric('matchMotif', signature='object', function(object, motifs, genomeName, regions, pval.cutoff,

+                                                      fimoDataFrameStyle=FALSE) standardGeneric('matchMotif'))

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

 setClass ('MotifList',

           contains='SimpleList',

@@ -61,6 +63,30 @@ MotifList = function (matrices=list(), tbl.metadata=data.frame ())

   object

 } # ctor

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

+setMethod('matchMotif', signature='MotifList',

+

+   function(object, motifs, genomeName, regions, pval.cutoff, fimoDataFrameStyle=FALSE){

+     motifs.pfmatrix <- lapply(motifs, function(motif) convert_motifs(motif, "TFBSTools-PFMatrix"))

+     motifs.pfmList <- do.call(PFMatrixList, motifs.pfmatrix)

+     gr.list <- matchMotifs(motifs.pfmList, regions, genome=genomeName, out="positions", p.cutoff=pval.cutoff)

+     result <- gr.list

+     if(fimoDataFrameStyle){

+        gr <- unlist(gr.list)

+        motif.names <- names(gr)

+        names(gr) <- NULL

+        tbl <- as.data.frame(gr)

+        tbl$motif_id <- motif.names

+        colnames(tbl)[1] <- "chrom"

+        tbl$chrom <- as.character(tbl$chrom)

+        colnames(tbl)[grep("score", colnames(tbl))] <- "mood.score"

+        new.order <- order(tbl$start, decreasing=FALSE)

+        tbl <- tbl[new.order,]

+        result <- tbl

+        }

+     return(result)

+     })

+

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

 setMethod ('subset', signature = 'MotifList',

@@ -307,8 +307,10 @@ setMethod ('query', 'MotifList',

          # get the cumulative intersection of all the "and" terms

          # this steadily dimishes the set of indices

-       for(indices in and.indices)

-         final.indices <- intersect(final.indices, indices)

+       for(indices in and.indices){

+          final.indices <- intersect(final.indices, indices)

+          #message(sprintf(" final.indices length is now %d", length(final.indices)))

+          }

          # lump all of the "or" terms together: they all get included

        final.indices <- intersect(unlist(or.indices), final.indices)

@@ -319,6 +321,7 @@ setMethod ('query', 'MotifList',

        object [final.indices]

        })

+

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

 # Addition on 2017/06/15 from Matt Richards

@@ -2,7 +2,8 @@ setGeneric('query', signature='object', function(object, andStrings, orStrings=c

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

 setGeneric('geneToMotif', signature='object', function(object, geneSymbols, source, ignore.case=FALSE) standardGeneric('geneToMotif'))

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

-           function(object, tbl.withMotifs,  source, expand.rows) standardGeneric('associateTranscriptionFactors'))

+           function(object, tbl.withMotifs,  source, expand.rows, motifColumnName="motifName")

+              standardGeneric('associateTranscriptionFactors'))

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

 setClass ('MotifList',

           contains='SimpleList',

@@ -529,10 +530,10 @@ setMethod ('geneToMotif', 'MotifList',

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

 setMethod('associateTranscriptionFactors', 'MotifList',

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

+     function(object, tbl.withMotifs, source, expand.rows, motifColumnName="motifName"){

+        stopifnot(motifColumnName %in% colnames(tbl.withMotifs))

+        tbl.tf <- motifToGene(object, unique(tbl.withMotifs[, motifColumnName]), source)

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

         })

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

@@ -491,7 +491,7 @@ setMethod ('geneToMotif', 'MotifList',

    function (object, geneSymbols, source, ignore.case=FALSE) {

      source <- tolower(source)

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

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

      extract.mdb <- function(gene){

         geneSymbol <- NULL # workaround the R CMD check "no visible binding for global variable"

         if(ignore.case)

@@ -503,13 +503,13 @@ setMethod ('geneToMotif', 'MotifList',

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

         tbl

         }

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

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

         tbls <- lapply(geneSymbols, extract.mdb)

         result <- do.call(rbind, tbls)

         if(nrow(result) > 0)

            result$source <- "MotifDb"

         }

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

+     if("tfclass" %in% source){

         if(ignore.case)

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

         else

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

       # the mcols (the metadata, the annotation) which accompanies

       # each pfm matrix

+     tbl.mdb <- data.frame()

+     tbl.tfc <- data.frame()

+

      name.map <- as.list(motifs)

      names(name.map) <- motifs

      for(i in seq_len(length(motifs))){

@@ -441,46 +444,44 @@ setMethod ('motifToGene', 'MotifList',

            motifs[i] <-newValue

             }

         } # for i

-     #browser()

+

      source <- tolower(source)

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

-     tbl.mdb <- data.frame()

      if("motifdb" %in% source){

         providerId <- NULL   # avoid R CMD check note

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

-        if(nrow(tbl.mdb) == 0)

-           return(data.frame())

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

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

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

         if(nrow(tbl.mdb) > 0){

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

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

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

            tbl.mdb$source <- "MotifDb"

            tbl.mdb <- tbl.mdb[, c("motif", "geneSymbol", "pubmedID", "organism", "source")]

            rownames(tbl.mdb) <- NULL

-           }

+           } # nrow of tbl.mdb > 0

         }  # motifDb

-     tbl.tfc <- data.frame()

+

      if("tfclass" %in% source){

         motif <- NULL

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

-        if(nrow(tbl.tfc) == 0)

-           return(data.frame())

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

-        tbl.tfc <- tbl.tfc[order(tbl.tfc$motif),]

-        rownames(tbl.tfc) <- NULL

-        colnames(tbl.tfc) <- c("motif", "geneSymbol", "pubmedID")

         if(nrow(tbl.tfc) > 0){

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

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

+           rownames(tbl.tfc) <- NULL

+           colnames(tbl.tfc) <- c("motif", "geneSymbol", "pubmedID")

            tbl.tfc$source <- "TFClass"

            tbl.tfc$organism <- "Hsapiens"

-           }

-        }

+           } # nrow(tbl.tfc) > 0

+        } # tfclass

+

+      if(nrow(tbl.mdb) == 0 && nrow(tbl.tfc) == 0)

+         return(data.frame())

+

       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()

       tbl.out

       })

@@ -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

+#      })

+#

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

@@ -1,5 +1,4 @@

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

-setGeneric('query2', signature='object', function(object, andStrings, orStrings=c(), notStrings=c(), ignore.case=TRUE) standardGeneric ('query2'))

+setGeneric('query', signature='object', function(object, andStrings, orStrings=c(), notStrings=c(), ignore.case=TRUE) standardGeneric ('query'))

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

 setGeneric('geneToMotif', signature='object', function(object, geneSymbols, source, ignore.case=FALSE) standardGeneric('geneToMotif'))

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

@@ -271,17 +270,17 @@ setMethod('show', 'MotifList',

       }

     })

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

-setMethod ('query', 'MotifList',

-

-   function (object, queryString, ignore.case=TRUE) {

-       indices = unique (as.integer (unlist (sapply (colnames (mcols (object)),

-                    function (colname)

-                       grep (queryString, mcols (object)[, colname],

-                             ignore.case=ignore.case)))))

-        object [indices]

-      })

+#setMethod ('query', 'MotifList',

+#

+#   function (object, queryString, ignore.case=TRUE) {

+#       indices = unique (as.integer (unlist (sapply (colnames (mcols (object)),

+#                    function (colname)

+#                       grep (queryString, mcols (object)[, colname],

+#                             ignore.case=ignore.case)))))

+#        object [indices]

+#      })

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

-setMethod ('query2', 'MotifList',

+setMethod ('query', 'MotifList',

    function (object, andStrings, orStrings=c(), notStrings=c(), ignore.case=TRUE) {

       find.indices <- function(queryString)

@@ -384,37 +383,103 @@ matrixToJasparText <- function (matrices)

 } # matrixToJasparText

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

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

+# setMethod ('oldMotifToGene', 'MotifList',

+#

+#    function (object, motifs, source) {

+#      source <- tolower(source)

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

+#      tbl <- data.frame()

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

+#         providerId <- NULL   # avoid R CMD check note

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

+#         if(nrow(tbl) == 0)

+#            return(data.frame())

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

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

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

+#         if(nrow(tbl) > 0)

+#            tbl$source <- "MotifDb"

+#         }

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

+#         motif <- NULL

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

+#         if(nrow(tbl) == 0)

+#            return(data.frame())

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

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

+#         rownames(tbl) <- NULL

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

+#         if(nrow(tbl) > 0)

+#            tbl$source <- "TFClass"

+#         }

+#      tbl

+#      }) # oldMotifToGene

+#

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

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

 setMethod ('motifToGene', 'MotifList',

    function (object, motifs, source) {

+      # for MotifDb, motif names come in a variety of forms, and our first step

+      # is to convert them all, if needed, into that which is found in

+      # the "providerId" column of the MotifDb metadata table.

+      #

+      # first check to see if the supplied motif name is actually a MotifDb

+      # matrix list name, e.g., Hsapiens-HOCOMOCOv10-IKZF1_HUMAN.H10MO.C

+      # when those cases are discovered, they are translated to the matrices

+      # providerId - which is our standard currency for lookup, using

+      # the mcols (the metadata, the annotation) which accompanies

+      # each pfm matrix

+

+     name.map <- as.list(motifs)

+     names(name.map) <- motifs

+     for(i in seq_len(length(motifs))){

+        x <-match(motifs[i], names(MotifDb));

+        if(!is.na(x)){

+           newValue <-  mcols(MotifDb[motifs[i]])$providerId

+           names(name.map)[i] <- newValue

+           motifs[i] <-newValue

+            }

+        } # for i

+     #browser()

      source <- tolower(source)

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

-     tbl <- data.frame()

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

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

+     tbl.mdb <- data.frame()

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

         providerId <- NULL   # avoid R CMD check note

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

-        if(nrow(tbl) == 0)

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

+        if(nrow(tbl.mdb) == 0)

            return(data.frame())

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

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

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

-        if(nrow(tbl) > 0)

-           tbl$source <- "MotifDb"

-        }

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

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

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

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

+        if(nrow(tbl.mdb) > 0){

+           tbl.mdb$source <- "MotifDb"

+           tbl.mdb <- tbl.mdb[, c("motif", "geneSymbol", "pubmedID", "organism", "source")]

+           rownames(tbl.mdb) <- NULL

+           }

+        }  # motifDb

+     tbl.tfc <- data.frame()

+     if("tfclass" %in% source){

         motif <- NULL

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

-        if(nrow(tbl) == 0)

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

+        if(nrow(tbl.tfc) == 0)

            return(data.frame())

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

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

-        rownames(tbl) <- NULL

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

-        if(nrow(tbl) > 0)

-           tbl$source <- "TFClass"

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

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

+        rownames(tbl.tfc) <- NULL

+        colnames(tbl.tfc) <- c("motif", "geneSymbol", "pubmedID")

+        if(nrow(tbl.tfc) > 0){

+           tbl.tfc$source <- "TFClass"

+           tbl.tfc$organism <- "Hsapiens"

+           }

         }

-     tbl

-     })

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

+      if(length(name.map) > 0)

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

+      #browser()

+      tbl.out

+      })

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

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

@@ -1,5 +1,5 @@

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

-              standardGeneric ('query'))

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

+setGeneric('query2', signature='object', function(object, andStrings, orStrings=c(), notStrings=c(), ignore.case=TRUE) standardGeneric ('query2'))

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

 setGeneric('geneToMotif', signature='object', function(object, geneSymbols, source, ignore.case=FALSE) standardGeneric('geneToMotif'))

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

@@ -281,6 +281,45 @@ setMethod ('query', 'MotifList',

         object [indices]

       })

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

+setMethod ('query2', 'MotifList',

+

+   function (object, andStrings, orStrings=c(), notStrings=c(), ignore.case=TRUE) {

+      find.indices <- function(queryString)

+         {unique(as.integer(unlist(sapply(colnames(mcols(object)),

+                 function(colname) grep(queryString, mcols(object)[,colname],ignore.case=ignore.case)))))

+             }

+          # setup defaults

+       and.indices <- list(seq_len(length(object)))

+       or.indices <- list(seq_len(length(object)))

+       not.indices <- list(c())

+

+       if(length(andStrings) > 0)

+          and.indices <- lapply(andStrings, find.indices)

+

+       if(length(orStrings) > 0)

+          or.indices <- lapply(orStrings, find.indices)

+

+       if(length(notStrings) > 0)

+          not.indices <- lapply(notStrings, find.indices)

+

+          # start with the indices of all elements

+       final.indices <- seq_len(length(object))

+

+         # get the cumulative intersection of all the "and" terms

+         # this steadily dimishes the set of indices

+       for(indices in and.indices)

+         final.indices <- intersect(final.indices, indices)

+

+         # lump all of the "or" terms together: they all get included

+       final.indices <- intersect(unlist(or.indices), final.indices)

+

+         # finally reduce the set to exclude all indices of all "not" terms

+       for(indices in not.indices)

+         final.indices <- setdiff(final.indices, indices)

+

+       object [final.indices]

+       })

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

 # Addition on 2017/06/15 from Matt Richards

 # This will not exactly match JASPAR because units are PFM and JASPAR uses PCM

@@ -1,7 +1,7 @@

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

               standardGeneric ('query'))

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

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

+setGeneric('geneToMotif', signature='object', function(object, geneSymbols, source, ignore.case=FALSE) standardGeneric('geneToMotif'))

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

            function(object, tbl.withMotifs,  source, expand.rows) standardGeneric('associateTranscriptionFactors'))

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

@@ -359,7 +359,8 @@ setMethod ('motifToGene', 'MotifList',

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

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

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

-        tbl$source <- "MotifDb"

+        if(nrow(tbl) > 0)

+           tbl$source <- "MotifDb"

         }

      if(source %in% c("tfclass")){

         motif <- NULL

@@ -370,7 +371,8 @@ setMethod ('motifToGene', 'MotifList',

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

         rownames(tbl) <- NULL

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

-        tbl$source <- "TFClass"

+        if(nrow(tbl) > 0)

+           tbl$source <- "TFClass"

         }

      tbl

      })

@@ -379,12 +381,16 @@ setMethod ('motifToGene', 'MotifList',

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

 setMethod ('geneToMotif', 'MotifList',

-   function (object, geneSymbols, source) {

+   function (object, geneSymbols, source, ignore.case=FALSE) {

      source <- tolower(source)

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

      extract.mdb <- function(gene){

         geneSymbol <- NULL # workaround the R CMD check "no visible binding for global variable"

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

+        if(ignore.case)

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

+        else

+           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

@@ -392,17 +398,22 @@ setMethod ('geneToMotif', 'MotifList',

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

         tbls <- lapply(geneSymbols, extract.mdb)

         result <- do.call(rbind, tbls)

-        result$source <- "MotifDb"

+        if(nrow(result) > 0)

+           result$source <- "MotifDb"

         }

      if(source %in% c("tfclass")){

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

+        if(ignore.case)

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

+        else

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

         tf.gene <- NULL; motif <- NULL  # workaround R CMD CHECK "no visible binding ..." bogus error

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

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

         rownames(tbl) <- NULL

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

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

-        result$source <- "TFClass"

+        if(nrow(result) > 0)

+           result$source <- "TFClass"

         }

      result

      })

@@ -352,23 +352,25 @@ setMethod ('motifToGene', 'MotifList',

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

      tbl <- data.frame()

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

+        providerId <- NULL   # avoid R CMD check note

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

         if(nrow(tbl) == 0)

            return(data.frame())

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

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

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

-        tbl$from <- "MotifDb"

+        tbl$source <- "MotifDb"

         }

      if(source %in% c("tfclass")){

+        motif <- NULL

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

         if(nrow(tbl) == 0)

            return(data.frame())

         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"

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

+        tbl$source <- "TFClass"

         }

      tbl

      })

@@ -380,8 +382,8 @@ setMethod ('geneToMotif', 'MotifList',

    function (object, geneSymbols, source) {

      source <- tolower(source)

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

-     #browser()

      extract.mdb <- function(gene){

+        geneSymbol <- NULL # workaround the R CMD check "no visible binding for global variable"

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

@@ -390,16 +392,17 @@ setMethod ('geneToMotif', 'MotifList',

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

         tbls <- lapply(geneSymbols, extract.mdb)

         result <- do.call(rbind, tbls)

-        result$from <- "MotifDb"

+        result$source <- "MotifDb"

         }

      if(source %in% c("tfclass")){

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

+        tf.gene <- NULL; motif <- NULL  # workaround R CMD CHECK "no visible binding ..." bogus error

         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"

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

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

+        result$source <- "TFClass"

         }

      result

      })

@@ -353,14 +353,17 @@ setMethod ('motifToGene', 'MotifList',

      tbl <- data.frame()

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

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

+        if(nrow(tbl) == 0)

+           return(data.frame())

         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(source %in% c("tfclass")){

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

+        if(nrow(tbl) == 0)

+           return(data.frame())

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

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

         rownames(tbl) <- NULL

@@ -424,9 +427,11 @@ setMethod('associateTranscriptionFactors', 'MotifList',

            }

         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)], collapse=";"))

+        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)]))

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

@@ -348,9 +348,10 @@ matrixToJasparText <- function (matrices)

 setMethod ('motifToGene', 'MotifList',

    function (object, motifs, source) {

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

+     source <- tolower(source)

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

      tbl <- data.frame()

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

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

@@ -358,7 +359,7 @@ setMethod ('motifToGene', 'MotifList',

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

         tbl$from <- "MotifDb"

         }

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

+     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),]

@@ -374,7 +375,8 @@ setMethod ('motifToGene', 'MotifList',

 setMethod ('geneToMotif', 'MotifList',

    function (object, geneSymbols, source) {

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

+     source <- tolower(source)

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

      #browser()

      extract.mdb <- function(gene){

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

@@ -382,12 +384,12 @@ setMethod ('geneToMotif', 'MotifList',

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

         tbl

         }

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

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

         tbls <- lapply(geneSymbols, extract.mdb)

         result <- do.call(rbind, tbls)

         result$from <- "MotifDb"

         }

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

+     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),]

@@ -403,9 +405,10 @@ setMethod ('geneToMotif', 'MotifList',

 setMethod('associateTranscriptionFactors', 'MotifList',

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

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

+     source <- tolower(source)

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

      tbl.out <- data.frame()

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

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

@@ -415,7 +418,7 @@ setMethod('associateTranscriptionFactors', 'MotifList',

         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(source %in% c("tfclass")){

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

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

            }

@@ -335,7 +335,10 @@ matrixToJasparText <- function (matrices)

       s[index] <- ""

       index <- index + 1

-    } # for name

+  } # for name

+

+  # Remove the last blank line

+  s <- s[-length(s)]

   invisible (s)

@@ -3,8 +3,7 @@ setGeneric('query', signature='object', function(object, queryString, ignore.cas

 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)