/R/TxdbView-class.R
R | 442 lines | 248 code | 53 blank | 141 comment | 17 complexity | 6ac641d7510c3d307f9623fe58e67cf0 MD5 | raw file
1##----------------------------------------------------------## 2## For class "IntervalView" 3##----------------------------------------------------------## 4 5## setAs("TranscriptDb", "GRanges", function(From){ 6 7## }) 8 9## TxdbGRanges.gen <- setProxyGRanges("Txdb") 10TxdbView.gen <- setRefClass("TxdbView", 11 contains=c("QtVisnabView", "LinearView"), 12 fields=list( 13 track ="TranscriptDb", 14 introns="GRangesList", 15 fiveUTR="GRangesList", 16 threeUTR="GRangesList", 17 cds="GRangesList", 18 tx="GRanges", 19 exons = "GRanges" 20 ), 21 methods = list( 22 fetchFromSource = function(){ 23 ## compute exons/intons/... store to operands? 24 } 25 26 )) 27 28##----------------------------------------------------------## 29## "IntervalView" constructor 30##----------------------------------------------------------## 31 32##' To create a view for displaying information in a \code{TranscriptDb} 33##' object. 34##' 35##' The constructor may take some time to retrieve information from 36##' a \code{TranscriptDb} object, and store all the information which 37##' required for visualiztion as fields, this is currently not ideal, 38##' since \pkg{GenomicFeatures} doesn't support sending a small query to 39##' SQLite database yet. 40##' 41##' ##' @title \code{TxdbView} object constructor. 42##' @param track A TranscriptDb object 43##' @param seqname Chromosome name, expect the 44##' name with 'chr' prefix, e.g. 'chr1'. 45##' @param geom Geometry of the view. default is 'full'. 46##' \describe{ 47##' \item{\code{full}}{Showing all the introns/cds/5'-UTR/3'-UTR, 48##' grouped by transcripts.} 49##' \item{\code{dense}}{Showing one single genmoic structure, collapse 50##' all information into one single strand.} 51##' \item{\code{slice}}{Cut off introns and facilitate gene-centric view.} 52##' } 53##' @param rescale Control view port behaviors when zoom in/out 54##' \describe{ 55##' \item{\code{geometry}}{Hide sroll bar when zoomed in, default} 56##' \item{\code{transform}}{...} 57##' \item{\code{none}}{Showing scroll bar when zoomed in} 58##' } 59##' @param viewname Name used for this view, will show as widget title when 60##' embeded into tracks view. 61##' @return A \code{TxdbView} object. 62##' @author Tengfei Yin <yintengfei@gmail.com> 63TxdbView <- function(track, 64 seqname, 65 geom=c("full", "dense", "slice"), 66 rescale = c("geometry", "transform", "none"), 67 viewname = "TranscriptDb", 68 ...){ 69 ## tootip information 70 ## TODO: need to get information automatical some where 71 ## may be integrate some data automatically 72 tooltips <- capture.output(print(track)) 73 74 if(missing(seqname)) 75 seqname <- as.character(unique(as.character(seqnames(seqinfo(track))))[1]) 76 start <- 0 77 end <- seqlengths(track)[[seqname]] 78 seqlength <- end 79 xlimZoom <- c(start,end) 80 81 geom <- match.arg(geom) 82 geom <- new("TxdbViewGeomSingleEnum", geom) 83 84 rescale <- match.arg(rescale) 85 rescale <- new("RescaleSingleEnum", rescale) 86 87 pars <- GraphicPars(xlimZoom = xlimZoom, 88 geom = geom, 89 view = "TxdbView") 90 ## store those infor in object, so make switch to other chromosome fast 91 message("Loading Introns...") 92 introns <- intronsByTranscript(track) 93 message("Loading 5' UTR...") 94 fiveUTR <- fiveUTRsByTranscript(track) 95 message("Loading 3' UTR...") 96 threeUTR <- threeUTRsByTranscript(track) 97 message("Loading CDS...") 98 cds <- cdsBy(track,by="tx") 99 message("Loading transcripts...") 100 tx <- transcripts(track) 101 ## loading exons? 102 viewrange <- MutableGRanges(seqname, IRanges(start, end)) 103 seqlengths(viewrange) <- end 104 105 mode <- IModeGroup(scaleMode = ScaleMode(zoomMode = "Horizontal")) 106 obj <- TxdbView.gen$new(track = track, pars = pars, mode = mode, 107 viewrange = viewrange, 108 introns = introns, fiveUTR = fiveUTR, threeUTR = threeUTR, 109 rescale = rescale, tooltipinfo = tooltips, 110 cds = cds,tx = tx, viewname = viewname, 111 eventTrace = new("EventTrace")) 112 113 ## add default attributes 114 ## addAttr(obj$track,.color=obj$pars$fill,.hover=FALSE,.brushed=FALSE) 115 message("Processing and creating view...") 116 obj$createView() 117 obj$regSignal() 118 message("Ready") 119 return(obj) 120} 121 122############################################################ 123## createview method 124############################################################ 125TxdbView.gen$methods(createView = function(){ 126 127 seqname <- as.character(seqnames(viewrange)) 128 setDislayWidgets() 129 setBgColor() 130 131 ## compute levels 132 tx.sub <- tx[seqnames(tx)==seqname] 133 tx_id <- values(tx.sub)$tx_id 134 135 .levels <- disjointBins(ranges(tx.sub)) 136 names(.levels) <- tx_id 137 138 introns.sub <- introns[names(introns) %in% as.character(tx_id)] 139 fiveUTR.sub <- fiveUTR[names(fiveUTR) %in% as.character(tx_id)] 140 threeUTR.sub <- threeUTR[names(threeUTR) %in% as.character(tx_id)] 141 cds.sub <- cds[names(cds) %in% as.character(tx_id)] 142 ## exons.sub <- exons[names(exons) %in% as.character(tx_id)] 143 144 int.l <- elementLengths(introns.sub) 145 futr.l <- elementLengths(fiveUTR.sub) 146 tutr.l <- elementLengths(threeUTR.sub) 147 cds.l <- elementLengths(cds.sub) 148 ## exons.l <- elementLengths(exons.sub) 149 150 int <- unlist(introns.sub) 151 futr <- unlist(fiveUTR.sub) 152 tutr <- unlist(threeUTR.sub) 153 cdss <- unlist(cds.sub) 154 ## exn <- unlist(exons.sub) 155 ## prepare for "reduce" geom 156 int.r <- reduce(int) 157 cds.r <- reduce(cdss) 158 five.r <- reduce(futr) 159 three.r <- reduce(tutr) 160 ## should think a better way to do this 161 162 irs <- reduce(c(cds.r,five.r,three.r)) 163 int.r <- setdiff(int.r,irs) 164 165 values(int)$tx_id <- rep(names(introns.sub),int.l) 166 values(futr)$tx_id <- rep(names(fiveUTR.sub),futr.l) 167 values(tutr)$tx_id <- rep(names(threeUTR.sub),tutr.l) 168 values(cdss)$tx_id <- rep(names(cds.sub),cds.l) 169 ## values(exn)$tx_id <- rep(names(exons.sub),exons.l) 170 171 values(int)$.level <- .levels[as.character(values(int)$tx_id)] 172 values(futr)$.level <- .levels[as.character(values(futr)$tx_id)] 173 values(tutr)$.level <- .levels[as.character(values(tutr)$tx_id)] 174 values(cdss)$.level <- .levels[as.character(values(cdss)$tx_id)] 175 ## values(exn)$.level <- .levels[as.character(values(exn)$tx_id)] 176 177 ## int.pos <- int[strand(int)=="+"] 178 ## int.neg <- int[strand(int)=="-"] 179 180 ## tail(sort(width(introns.sub))) 181 182 st.int <- start(int) 183 ed.int <- end(int) 184 lv.int <- values(int)$.level 185 strand.int <- as.character(strand(int)) 186 187 st.five <- start(futr) 188 ed.five <- end(futr) 189 lv.five <- values(futr)$.level 190 191 st.three <- start(tutr) 192 ed.three <- end(tutr) 193 lv.three <- values(tutr)$.level 194 195 st.cds <- start(cdss) 196 ed.cds <- end(cdss) 197 lv.cds <- values(cdss)$.level 198 199 ## for "dense" 200 st.five.r <- start(five.r) 201 ed.five.r <- end(five.r) 202 203 st.three.r <- start(three.r) 204 ed.three.r <- end(three.r) 205 206 st.cds.r <- start(cds.r) 207 ed.cds.r <- end(cds.r) 208 209 st.int.r <- start(int.r) 210 ed.int.r <- end(int.r) 211 strand.int.r <- as.character(strand(int.r)) 212 213 ylim <- c(0,max(c(lv.int, lv.five, lv.cds, lv.three))*5+10) 214 xlim <- c(0,seqlengths(viewrange)) 215 ## xlim.mar <- 0.05*diff(xlim) 216 ## ylim.mar <- 0.05*diff(ylim) 217 218 ## pars$xlim <<- c(xlim[1]-xlim.mar,xlim[2]+xlim.mar) 219 ## pars$ylim <<- c(ylim[1]-ylim.mar,ylim[2]+ylim.mar) 220 pars$xlimChanged$block() 221 pars$ylimChanged$block() 222 pars$xlim <<- xlim 223 pars$ylim <<- expand_range(ylim, mul = 0.05) 224 pars$xlimChanged$unblock() 225 pars$ylimChanged$unblock() 226 227 228 ## canonical strucuture 229 drawfun <- function(layer,painter,exposed){ 230 pars$xlimZoomChanged$block() 231 pars$xlimZoom <<- as.matrix(exposed)[,1] 232 xlimZoom <- pars$xlimZoom 233 if(!eventTrace$selfSignal){ 234 viewrange$rangesChanged$unblock() 235 ranges(viewrange) <<- IRanges(pars$xlimZoom[1], pars$xlimZoom[2]) 236 } 237 if(eventTrace$selfSignal){ 238 viewrange$rangesChanged$block() 239 ranges(viewrange) <<- IRanges(pars$xlimZoom[1], pars$xlimZoom[2]) 240 } 241 pars$xlimZoomChanged$unblock() 242 243 if(pars$geom=="full"){ 244 ## 5'UTR 245 if(length(st.five)>0) 246 qdrawRect(painter,st.five,10*lv.five-2,ed.five, 247 10*lv.five+2,fill="black",stroke=NA) 248 ## 3' 249 if(length(st.three)>0) 250 qdrawRect(painter,st.three,10*lv.three-2,ed.three, 251 10*lv.three+2,fill="black",stroke=NA) 252 ## cds 253 if(length(st.cds)>0) 254 qdrawRect(painter,st.cds,10*lv.cds-4,ed.cds,10*lv.cds+4, 255 fill="black",stroke=NA) 256 ## intron 257 if(length(st.int)>0) 258 qdrawSegment(painter,st.int,10*lv.int,ed.int,10*lv.int,stroke="black") 259 260 if(diff(xlimZoom)<8e5){ 261 unit <- as.integer(diff(xlimZoom)/50) 262 ## draw arrow to indicate strand 263 ## subset first 264 seqlengths(int) 265 grsub <- GRanges(seqnames(viewrange), ranges = ranges(viewrange)) 266 intsub <- subsetByOverlaps(int, grsub) 267 st.int <- start(intsub) 268 ed.int <- end(intsub) 269 lv.int <- values(intsub)$.level 270 ardf <- lapply(seq_along(st.int), function(i){ 271 n <- round((ed.int[i]-st.int[i])/unit, dig = 0) 272 xs <- cbreaks(c(st.int[i], ed.int[i]), pretty_breaks(n))$breaks 273 xs <- xs[xs >= st.int[i] & xs <= ed.int[i]] 274 df <- data.frame(x = xs, y = rep(as.numeric(lv.int[i])*10, length(xs))) 275 }) 276 ardf <- do.call("rbind", ardf) 277 ## negative strand 278 idx <- as.character(strand(intsub)) == "-" 279 arrow <- qglyphArrow(dir = "left") 280 qdrawGlyph(painter, arrow, ardf[idx, "x"], ardf[idx, "y"], cex = 0.5, fill = NA) 281 arrow <- qglyphArrow(dir = "right") 282 qdrawGlyph(painter, arrow, ardf[!idx, "x"], ardf[!idx, "y"], cex = 0.5, fill = NA) 283 ## positive strand 284 } 285 pars$ylim <<- ylim 286 } 287 if(pars$geom=="dense"){ 288 ## reduced structure 289 ## 5'UTR 290 if(length(st.five.r)>0) 291 qdrawRect(painter,st.five.r,10-2,ed.five.r, 292 10+2,fill="black",stroke=NA) 293 ## 3'UTR 294 if(length(st.three.r)>0) 295 qdrawRect(painter,st.three.r,10-2,ed.three.r, 296 10+2,fill 297 ="black",stroke=NA) 298 ## cds 299 if(length(st.cds.r)>0) 300 qdrawRect(painter,st.cds.r,10-4,ed.cds.r,10+4, 301 fill="black",stroke=NA) 302 ## introns 303 if(length(st.int.r)>0) 304 qdrawSegment(painter,st.int.r,10,ed.int.r,10,stroke="black") 305 306 ## if(diff(xlimZoom)<8e5){ 307 ## unit <- as.integer(diff(xlimZoom)/50) 308 ## ## draw arrow to indicate strand 309 ## ## subset first 310 ## grsub <- GRanges(seqnames(viewrange), ranges = ranges(viewrange)) 311 ## intsub <- subsetByOverlaps(int, grsub) 312 ## st.int <- start(intsub) 313 ## ed.int <- end(intsub) 314 ## lv.int <- values(intsub)$.level 315 ## ardf <- lapply(seq_along(st.int), function(i){ 316 ## n <- round((ed.int[i]-st.int[i])/unit, dig = 0) 317 ## xs <- cbreaks(c(st.int[i], ed.int[i]), pretty_breaks(n))$breaks 318 ## xs <- xs[xs >= st.int[i] & xs <= ed.int[i]] 319 ## df <- data.frame(x = xs, y = rep(10, length(xs))) 320 ## }) 321 ## ardf <- do.call("rbind", ardf) 322 ## ## negative strand 323 ## idx <- as.character(strand(intsub)) == "-" 324 ## ## reduce with no arrow 325 ## ## arrow <- qglyphArrow(dir = "left") 326 ## ## qdrawGlyph(painter, arrow, ardf[idx, "x"], ardf[idx, "y"], cex = 0.5, fill = NA) 327 ## ## arrow <- qglyphArrow(dir = "right") 328 ## ## qdrawGlyph(painter, arrow, ardf[!idx, "x"], ardf[!idx, "y"], cex = 0.5, fill = NA) 329 ## ## positive strand 330 ## } 331 332 pars$ylim <<- c(-20,40) 333 } 334 } 335 ## selectedRangesFun 336 ## selectedRangesFun <- function(layer, painter){ 337 ## srm <- selectedRangesModel 338 ## if(length(srm)>0){ 339 ## cols <- selectedRangesModelColor 340 ## if((as.character(cols) %in% names(elementMetadata(srm)))){ 341 ## cols.value <- elementMetadata(srm)[[cols]] 342 ## if(is.numeric(cols.value)){ 343 ## cols <- cscale(cols.value, pars$cpal) 344 ## }else{ 345 ## cols <- dscale(factor(cols.value), pars$dpal) 346 ## }}else{ 347 ## cols <- rep(cols,length(srm)) 348 ## } 349 ## idx <- as.character(seqnames(selectedRangesModel)) == seqname 350 ## qdrawRect(painter, start(srm)[idx], 0, 351 ## end(srm)[idx], 10, stroke = NA, fill = cols[idx]) 352 ## } 353 ## } 354 keyOutFun <- function(layer, event){ 355 eventTrace$focusin <<- FALSE 356 } 357 hoverEnterFun <- function(layer, event){ 358 eventTrace$focusin <<- TRUE 359 } 360 hoverLeaveFun <- function(layer, event){ 361 eventTrace$focusin <<- FALSE 362 } 363 364 rootLayer[0,0] <<- qlayer(scene, drawfun, 365 wheelFun= wheelEventZoom(), 366 keyPressFun = keyPressEventZoom(), 367 hoverEnterFun = hoverEnterFun, 368 focusOutFun = keyOutFun, hoverLeaveFun = hoverLeaveFun) 369 370 rootLayer[0,0]$setLimits(qrect(pars$xlim[1],pars$ylim[1], 371 pars$xlim[2],pars$ylim[2])) 372 373 pars$ylimChanged$connect(function(){ 374 rootLayer[0,0]$setLimits(qrect(pars$xlim,pars$ylim)) 375 }) 376 if(pars$geom == "dense") 377 rootLayer$setGeometry(0, 0, 800, 50) 378}) 379 380TxdbView.gen$methods(regSignal = function(){ 381 382 viewrange$rangesChanged$connect(function(){ 383 ## pars$xlimZoomChanged$block() 384 ## pars$xlimZoom <- as.matrix(exposed)[,1] 385 ## xlimZoom <- pars$xlimZoom 386 qupdate(scene) 387 }) 388 389 pars$xlimZoomChanged$connect(function(){ 390 zoom_factor <- diff(pars$xlimZoom)/seqlengths(viewrange) 391 ## then scale view 392 view$resetTransform() 393 view$scale(1/zoom_factor, 1) 394 ## then center view 395 pos.x <- mean(pars$xlimZoom) 396 pos.y <- mean(pars$ylim) 397 pos.scene <- as.numeric(rootLayer[0,0]$mapToScene(pos.x, pos.y)) 398 view$centerOn(pos.scene[1], pos.scene[2]) 399 }) 400 ## geom 401 pars$geomChanged$connect(function(){ 402 qupdate(scene) 403 }) 404 ## signal when change xlimZoom 405 ## seqname change should update view and update seqlength 406 viewrange$seqnamesChanged$connect(function(){ 407 ## end <- max(end(ranges(track[seqnames(track)==seqname]))) 408 viewrange$seqnamesChanged$block() 409 seqlengths(viewrange) <<- seqlengths(track)[[as.character(seqnames(viewrange))]] 410 viewrange$seqnamesChanged$unblock() 411 ## pars$xlimZoom <<- c(0 ,end) 412 ## selectedRange <<- c(start,end) 413 ## rootLayer[0,0]$close() 414 ## obj$rootLayer[0,0]$gridLayout()$removeAt(0) 415 rootLayer[0,0]$close() 416 view$resetTransform() 417 createView() 418 regSignal() 419 }) 420 ## selectedRangesModelChanged$connect(function(){ 421 ## qupdate(scene) 422 ## }) 423 pars$bgColorChanged$connect(function(){ 424 bgcol <- pars$bgColor 425 bgalpha <- pars$alpha 426 qcol <- col2qcol(bgcol,bgalpha) 427 scene$setBackgroundBrush(qbrush(qcol)) 428 }) 429}) 430 431TxdbView.gen$methods(show = function(){ 432 view$show() 433}) 434 435setMethod("print","TxdbView",function(x,..){ 436 x$show() 437}) 438 439 440 441 442