/R/SearchBarList-GUI.R

  1if(FALSE) {
  2## load("~/gene/melanie/genesymbol.rda")
  3
  4## gr1 <-
  5##   GRanges(seqnames =
  6##           Rle(c("chr1", "chr2", "chr1", "chr3"), c(1, 3, 2, 4)),
  7##           ranges =
  8##           IRanges(1:10, end = 7:16, names = head(letters, 10)),
  9##           strand =
 10##           Rle(strand(c("-", "+", "*", "+", "-")),
 11##               c(1, 2, 2, 3, 2)),
 12##           score = 1:10,
 13##           GC = seq(1, 0, length=10))
 14
 15## gr2 <-
 16##   GRanges(seqnames =
 17##           Rle(c("chr2", "chr4", "chr1", "chr5"), c(1, 3, 2, 4)),
 18##           ranges =
 19##           IRanges(4:13, end = 8:17, names = tail(letters, 10)),
 20##           strand =
 21##           Rle(strand(c("-", "+", "*", "+", "-")),
 22##               c(1, 2, 2, 3, 2)),
 23##           geneID = as.factor(c("gene1",rep("gene2",2),rep("gene3",3),
 24##             rep("gene4",4))),
 25##           GC = seq(1, 0, length=10))
 26
 27## grl <- GenomicRangesList("gr1" = gr1, "gr2" = gr2)
 28
 29# search bar for searching through a GenomicRangesList
 30qsetClass("SearchBar", Qt$QLineEdit, function(grl, ref = NULL, parent = NULL)
 31{
 32  super(parent)
 33  this$grl <- grl; this$ref <- ref
 34
 35  unqSeqnames <- function(gr) levels(seqnames(gr))
 36  unqMetaData <- function(gr) unique(as.character(unlist(values(gr))))
 37
 38  namesList <- lapply(grl,unqSeqnames)
 39  names <- unlist(namesList)
 40  names <- unique(names)
 41  #names <- unique(unlist(lapply(grl,unqSeqnames)))
 42  metadataList <- lapply(grl,unqMetaData)
 43  metadata <- unlist(metadataList)
 44  metadata <- unique(metadata)
 45  #metadata <- unique(unlist(lapply(grl,unqMetaData)))
 46
 47  namesRef <- NULL
 48  metadataRef <- NULL
 49  if(!is.null(ref)) {
 50    namesRef <- levels(seqnames(ref))
 51    metadataRef <- unique(unlist(sapply(values(ref),as.character)))
 52  }  
 53  
 54  compVec <- sort(unique(c(names,metadata,namesRef,metadataRef)))
 55  comp <- Qt$QCompleter(compVec)
 56  this$setCompleter(comp)
 57
 58  # initialize the GRanges object containing the search range
 59  searchRange <- NULL
 60
 61  # parse the text and update GRanges object when return pressed
 62  qconnect(this, "returnPressed", function() {
 63    parseSearchString(this$text, grl, ref)
 64  })
 65  
 66})
 67
 68qsetSignal("rangeChanged", SearchBar)
 69
 70qsetMethod("getSearchRange", SearchBar, function() {
 71  this$searchRange
 72})
 73
 74qsetMethod("setSearchRange", SearchBar, function(newRange) {
 75  this$searchRange <- newRange
 76})
 77
 78qsetMethod("parseSearchString", SearchBar, function(text, grl, ref = NULL) {
 79  colon <- grepl(":",text,fixed=TRUE)
 80  minus <- grepl("-",text,fixed=TRUE)
 81  plus <- grepl("+",text,fixed=TRUE)
 82
 83  if(colon & minus) {  # seqname and interval specified
 84    # obtain seqname, start, end
 85    colonIdx <- regexpr(":",text,fixed=TRUE)
 86    minusIdx <- regexpr("-",text,fixed=TRUE)
 87    name <- substr(text,1,colonIdx-1)
 88    start <- as.integer(substr(text,colonIdx+1,minusIdx-1))
 89    end <- as.integer(substr(text,minusIdx+1,nchar(text)))
 90
 91    # return GRanges object with relevant sequence
 92    this$searchRange <- GRanges(seqnames =
 93                     Rle(name, 1),
 94                     ranges =
 95                       IRanges(start = start, end = end),
 96                   )
 97
 98    this$rangeChanged()
 99           
100  } else if(colon & plus) {  # seqname and center/radius specified
101    # obtain seqname, start, end
102    colonIdx <- regexpr(":",text,fixed=TRUE)
103    plusIdx <- regexpr("+",text,fixed=TRUE)
104    name <- substr(text,1,colonIdx-1)
105    center <- as.integer(substr(text,colonIdx+1,plusIdx-1))
106    radius <- as.integer(substr(text,plusIdx+1,nchar(text)))
107    start <- center - radius
108    end <- center + radius
109
110    # return GRanges object with relevant sequence
111    this$searchRange <- GRanges(seqnames =
112                     Rle(name, 1),
113                     ranges =
114                       IRanges(start = start, end = end),
115                   )
116
117    this$rangeChanged()
118    
119  } else {
120    allMetaData <- function(gr) as.character(unlist(values(gr)))
121
122    grNames <- as.vector(sapply(sapply(grl,seqnames),as.character))
123    in.names <- grep(text,grNames)
124    metaData <- as.vector(sapply(grl,allMetaData))
125    in.metadata <- grep(text,metaData)
126    in.namesRef <- NULL
127    in.metadataRef <- NULL
128    if(!is.null(ref)) {
129      # there's gotta be a better way to do this!!
130      namesReference <- levels(seqnames(ref))
131      in.namesRef <- grep(text,namesReference)
132      metaDataReference <- unlist(sapply(values(ref),as.character))
133      in.metadataRef <- grep(text,metaDataReference)
134    }
135    if(length(in.names) > 0) {
136      grSubset <- gr[seqnames(gr) == text]
137      minLoc <- min(IRanges::start(grSubset))
138      maxLoc <- max(IRanges::end(grSubset))
139
140      # return GRanges object with relevant sequence
141      this$searchRange <- GRanges(seqnames =
142                       Rle(text, 1),
143                       ranges =
144                         IRanges(start = minLoc, end = maxLoc),
145                     )
146
147      this$rangeChanged()
148    } else if (length(in.metadataRef) > 0 & (!is.null(ref))) {
149      matchRows <- in.metadataRef %% dim(values(ref))[1]
150      matchRows[matchRows == 0] <- dim(values(ref))[1]
151      
152      # return GRanges object with matching rows in reference set
153      refSubset <- ref[matchRows]
154      this$searchRange <- refSubset
155
156      this$rangeChanged()
157
158      # change text in search bar to match intervals being displayed
159      setText(base::paste(GenomicRanges::seqnames(refSubset),":",
160                          IRanges::start(refSubset),
161                          "-",IRanges::end(refSubset),collapse="; ",sep=""))
162    } else if (length(in.namesRef) > 0) {
163      refSubset <- ref[seqnames(ref) == text]
164      minLoc <- min(start(refSubset))
165      maxLoc <- max(end(refSubset))
166
167      # return GRanges object with relevant sequence
168      this$searchRange <- GRanges(seqnames =
169                       Rle(text, 1),
170                       ranges =
171                         IRanges(start = minLoc, end = maxLoc),
172                     )
173
174      this$rangeChanged()      
175    } else if (length(in.metadata) > 0) {
176      matchRows <- in.metadata %% dim(values(gr))[1]
177      matchRows[matchRows == 0] <- dim(values(gr))[1]
178      
179      # return GRanges object with matching rows in reference set
180      grSubset <- gr[matchRows]
181      this$searchRange <- grSubset
182
183      this$rangeChanged()
184
185      # change text in search bar to match intervals being displayed
186      setText(base::paste(GenomicRanges::seqnames(grSubset),":",
187                          IRanges::start(grSubset),"-",
188                          IRanges::end(grSubset),collapse="; ",sep=""))
189    } else {
190      setText("")
191      setPlaceholderText("Error: search string not recognized")
192      this$searchRange <- NULL
193    }
194  }
195
196})
197}