/R/SearchBarList-GUI.R

http://github.com/tengfei/visnab · R · 197 lines · 124 code · 34 blank · 39 comment · 19 complexity · ec2f49e40e712e4d9908b1925e6f2e31 MD5 · raw file

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