/R/SearchBarList-GUI.R
R | 197 lines | 124 code | 34 blank | 39 comment | 19 complexity | ec2f49e40e712e4d9908b1925e6f2e31 MD5 | raw file
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}