R/findpeaks.R

In mariev/chromatoplotsgui: Interactive graphics and interface for chromatoplots

#' @export
setGeneric('cgfindPeaksPlot', function(object, rmbs, mz){
  message('No plot method defined!')
  object})

# findpeaks plotting from chromatoplots input
setMethod('cgfindPeaksPlot', 'matrix', 
          function(object, rmbs, mz){
            cgfp <- qdata(object@.Data, size = 1)
            cgrmbs <- getcgrmbs(rmbs)
            fittedL <- getcgpfit(object@.Data, rmbs)
            qfpplot(qd = cgfp, rmbs = cgrmbs, mz = mz, 
                    mzmin = rmbs@mzrange[1], prof = rmbs@env$profile, 
                    filepath = rmbs@filepath, peakscurve = fittedL)
            
            
          })

getcgpfit <- function(peaks, rmbs){
  test <- plyr:::loop_apply(nrow(peaks), f = function(x){
    peak <- peaks[x,]
    
    scanIDs <- rmbs@scantime[profRange(rmbs,
                                  m = peak["mz"],
                                  rtrange = c(peak['rtmin'], 
                                  peak['rtmax']))$scanidx]
    return( data.frame(x = scanIDs, 
                       y = chromatoplots:::egh(scanIDs, peak["rt"], peak["maxf"], 
                               peak["sigma"], 
                                peak["tau"])))
    
    
  })
  #quant <- quantile(prof, protocol@alpha, na.rm = TRUE)
  
}

#' @name Find peaks plotting from qdata inputs
#' @param rmbs qdata for rmbaseline layer
#' @param qd qdata for peaks layer
#' @param mz the initial mz value
#' @param filepath name of the origin file
#' @param mzmin
qfpplot<- function(qd, rmbs, mz, mzmin, prof, filepath, peakscurve){

  
  ## how to handle situation if qd has .brushed points already
  if(nrow(qd[qd$.brushed,]) > 0){
    message('ignoring mz, using .brushed instead')
  } else {
      if(missing(mz) || nrow(qd[qd$mz == mz, ]) == 0){
        message('no data! using min mz instead')
        mz <- min(qd$mz, na.rm = TRUE)
      }
      qd[qd$mz == mz, '.brushed'] <- TRUE  
  }
  
  ## create data for the second plot
  
  # the peaks data
  newqd <- as.data.frame(qd)
  newqd <- qdata(newqd[,c('mz', 'mzmin', 'mzmax', 'rt', 'rtmin', 'rtmax', 'into',
                          'intf','maxo', 'maxf', 'tau', 'sigma', 'error', 'span',
                          'delta_i', 'delta_t', 'peak_sd', 'sigma.h')], 
                 color = 'black', 
                 border = 'black', 
                 size = qd$.size)
  
  # the rmbaseline data
  newrmbs <- as.data.frame(rmbs)
  newrmbs <- qdata(newrmbs[, c('time', 'mz', 'intensity')],
                   color = 'yellow',
                   border = 'yellow',
                   size = 1)
  
  # create the data for the thirdplot
  peaksqd <- as.data.frame(qd)
  peaksqd <- qdata(peaksqd[,c('mz', 'mzmin', 'mzmax', 'rt', 'rtmin', 'rtmax', 'into',
                          'intf','maxo', 'maxf', 'tau', 'sigma', 'error', 'span',
                          'delta_i', 'delta_t', 'peak_sd', 'sigma.h')], 
                 color = 'black', 
                 border = 'black', 
                 size = qd$.size)
  
  ## hide the data points that are not 
  
  if(nrow(newqd[newqd$mz != mz, ]) > 0){
    newqd[newqd$mz != mz, '.visible'] <- FALSE
  }
  
  if(nrow(peaksqd[peaksqd$mz != mz, ]) > 0){
    peaksqd[peaksqd$mz != mz, '.visible'] <- FALSE
  }
  
  if(nrow(newrmbs[newrmbs$mz != mz, ]) > 0){
    newrmbs[newrmbs$mz != mz, '.visible'] <- FALSE
  }
  
  
  
  
  
  ## create the first plot, use rmbs as the default data
  mplot <- qscatter(x = time,
                    y = mz,
                    data = rmbs,
                    main = paste('findPeaks: ', filepath),
                    xlab = "Seconds",
                    ylab = "m/z",
                    xlim = range(rmbs$time), 
                    ylim = range(rmbs$mz), 
                    alpha = 0.5
                      )
  
  ## create the second plot, use newrmbs as the default data
  splot <- qscatter(data = newrmbs,
                    x = time,
                    y = intensity,
                    xlim = range(rmbs$time),
                    ylim = range(newrmbs[newrmbs$.visible, 'intensity']),
                    main = paste('findPeaks :: mz', mz) )
  
  ## create the third plot
  zplot <- qscatter(data = peaksqd,
                    x = rt,
                    y = maxf)
  zplot$view$setGeometry(Qt$QRect(375, 400, 600, 350)) #z

  
 
  ## custom layers and interaction for second plot
  ## filtered pts, fitted peaks
  peakID <- NULL
  selectB <- NULL
  b <- brush(newrmbs)
  bpeaks <- brush(newqd)
  bpeaks$color <- 'blue'
  bpeaks$size <- 3
  bpeaks2 <- brush(peaksqd)
  bpeaks2$color <- 'blue'
  bpeaks2$size <- 3
 
  
  #tree <- createTree(data = data.frame(x = newqd$rt, y = newqd$maxf))
  
  get_peakID <- function(layer, event){
    peakID <<- c(event$pos()$x(), event$pos()$y())
  }
  peak_draw <- function(layer, painter){
    qdrawGlyph(painter, qglyphCircle(r = 2), newqd[newqd$.visible, 'rt'], 
               newqd[newqd$.visible, 'maxf'], stroke = newqd[newqd$.visible, '.border'], 
               fill = newqd[newqd$.visible, '.color'])
    newqd[newqd$.visible, '.brushed'] <- FALSE
    newqd[newqd$.visible, '.color'] <- 'black'
    newqd[newqd$.visible, '.border']   <- 'black'
    peaksqd$rt <- newqd$rt
    peaksqd[peaksqd$.visible, '.brushed'] <- FALSE

    
    if(!is.null(selectB) && splot$meta$limits[1, 1] < 
         (selectB[1] - splot$meta$brush.size[1])){
      qdrawRect(painter, xleft = selectB[1] - splot$meta$brush.size[1], xright = selectB[1],
                ybottom = splot$meta$limits[1, 2], ytop = splot$meta$limits[2, 2], 
                fill = alpha('blue', .18), stroke = 'blue')

      if(length(newqd[newqd$.visible & newqd$rt < selectB[1] & 
                         newqd$rt > (selectB[1] - splot$meta$brush.size[1]), 
            '.brushed' ]) > 0){
        newqd[newqd$.visible & newqd$rt < selectB[1] & 
                newqd$rt > (selectB[1] - splot$meta$brush.size[1]), 
              '.brushed' ] <- TRUE
        newqd[newqd$.visible & newqd$.brushed, '.color'] <- 'blue'
        newqd[newqd$.visible & newqd$.brushed, '.border'] <- 'blue'
        newqd[newqd$.visible & newqd$.brushed, '.size'] <- 5
        peaksqd[peaksqd$.visible & peaksqd$rt < selectB[1] & 
                  peaksqd$rt > (selectB[1] - splot$meta$brush.size[1]), 
              '.brushed' ] <- TRUE
        
        zplot$meta$limits[,1] <- c(selectB[1] - splot$meta$brush.size[1], selectB[1])
# 
#         zplot$meta$limits[,1] <- splot$meta$limits[,1]
#         zplot$meta$xat <- c(splot$meta$limits[1, 1] + 1, 
#                               splot$meta$limits[1, 1] + (0.1 * diff(splot$meta$limits[,1])),
#                               splot$meta$limits[2, 1] - (0.1 * diff(splot$meta$limits[,1])),
#                               splot$meta$limits[2, 1] - 1)
#         zplot$meta$xlabels <- format(c(splot$meta$limits[1, 1], 
#                                        selectB[1] - splot$meta$brush.size[1],
#                                        selectB[1],
#                                        splot$meta$limits[2, 1]), 
#                                      nsmall = 2,
#                                      digits = 2)
#         peaksqd$rt <- rep(1000, length(peaksqd$rt))
      } 

    }
    
  }
  
  
  peak_zoomin <- function(layer, event){
  
    if(match_key("Z", event)){
      selectB <<- peakID
      zplot$view$show()
      splot$view$activateWindow()
      qupdate(peaklayer)
      event$ignore()
    }
  }
  peak_zoomout <- function(layer, event){
    selectB <<- NULL
    qupdate(peaklayer)
    zplot$view$hide()
    
    event$ignore()
  }

  peaklayer <- qlayer(paintFun = peak_draw,
                      hoverMoveFun = get_peakID,
                     # keyPressFun = peak_zoomin,
                    #  keyReleaseFun = peak_zoomout,
                      limits = qrect(splot$meta$limits))
  splot$layerList[[1]][1,2] <- peaklayer
  splot$view$setGeometry(Qt$QRect(25, 400, 350, 350)) 
  register_handlers(splot, keypress = peak_zoomin, 
              keyrelease = peak_zoomout, add = TRUE)
  sync_limits(splot$meta, peaklayer)
  
  
  fitted_draw <- function(layer, painter){
     pcurve <- peakscurve[which(peaksqd$.visible)]
     lapply(pcurve, FUN = function(a){
       qdrawLine(painter, x = a$x, y = a$y, stroke = 'black')})
  }
  fittedlayer <- qlayer(paintFun = fitted_draw,
                        limits = qrect(zplot$meta$limits))
  zplot$layerList[[1]][1,2] <- fittedlayer
  sync_limits(zplot$meta, fittedlayer)
  
  ## drawing and interaction for first plot
  
  # locator red line
  locator_draw <- function(layer, painter){
    qdrawLine(painter, x = mplot$meta$limits[,1], y = c(mz, mz), stroke = 'red')
  }
  
  # update the locator position
  # update visibility for plot 2
  # update plot label
  # update y range on plot 2
  locator_update <- function(layer, event){
    mz <<- round(event$pos()$y())

    if(nrow(newqd[newqd$mz == mz, ]) == 0){
      splot$meta$keys <- 'No fitted peaks!'
    } else {
      newqd$.visible <- FALSE
      peaksqd$.visible <- FALSE
      newqd[newqd$mz == mz, '.visible'] <- TRUE
      peaksqd[peaksqd$mz == mz, '.visible'] <- TRUE
    }
    
    if(nrow(newrmbs[newrmbs$mz == mz, ]) > 0){
      newrmbs$.visible <- FALSE
      newrmbs[newrmbs$mz == mz, '.visible'] <- TRUE
    }
    
    if(nrow(newrmbs[newrmbs$.visible,]) > 0 || nrow(newqd[newqd$.visible,]) > 0){
      splot$meta$limits[,2] <- extend_ranges(range(newqd[newqd$.visible, 'maxf'], 
                                                   newrmbs[newrmbs$.visible, 'intensity']))
      splot$meta$yat <- axis_loc(splot$meta$limits[,2])
      splot$meta$ylabels <- format(splot$meta$yat)
    }
    
    splot$meta$main <- paste('findPeaks ::', filepath, "::", mz)
    
    if(nrow(qd[qd$.brushed, ]) > 0){
      qd[qd$.brushed, '.brushed'] <- FALSE
    }
    if(nrow(qd[qd$mz == mz, ]) > 0){
      qd[qd$mz == mz, '.brushed'] <- TRUE
      
    }
    qupdate(newintlayer)
    qupdate(peaklayer)  
    event$ignore()
    
  }
  
  ## custom layers and interaction for first plot
  
  # peaks & line
  peaks_draw <- function(layer, painter){
    qdrawGlyph(painter, qglyphCircle(r = 2), x = qd$rt, y = qd$mz, 
               stroke = 'black', fill = 'black')
  }
  # fitted line
  peakdatalayer <- qlayer(paintFun = peaks_draw, limits = qrect(mplot$meta$limits))
  newintlayer <- qlayer(paintFun = locator_draw,
                        mouseReleaseFun = locator_update, 
                        limits = qrect(mplot$meta$limits))
  mplot$layerList[[1]][1,2] <- peakdatalayer
  mplot$layerList[[1]][1,2] <- newintlayer
  mplot$view$setGeometry(Qt$QRect(25, 50, 350, 350)) 
  
  sync_limits(mplot$meta, peakdatalayer)
  sync_limits(mplot$meta, newintlayer)
  
  
  
  print(mplot)
  print(splot)
  
  
  brushed_changed <- function(i, j){
   
      
    if(j == '.brushed'){
    #  qupdate(peaklayer)
    } else{
     # print(mz)
    }
  }
  
  
  add_listener(newqd, brushed_changed)
}