R/rmbaseplot.r

In mariev/chromatoplotsgui: Interactive graphics and interface for chromatoplots

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

setMethod('cgRmBasePlot', 'xcmsRaw', 
          function(object, mz){
  cgrmbs <- getcgrmbs(object)
  qrmbsplot(cgrmbs, object@filepath, mz)


})

## convert into qdata object
getcgrmbs <- function(object){
  df <- getProfile(object)
  col <- range(log(df$intensity), na.rm = TRUE)
  col <- log(df$intensity)
  col <- col/max(col)
  cgrmbs <- qdata(df, size = .1, color = rgb(1 - col, 1 - col, 0))
  return(cgrmbs)
}

qrmbsplot <- function(qd, filepath, mz){
  mplot <- qscatter(x = time,
                  y = mz,
                  data = qd,
                  main = paste('removeBaseline: ', filepath),
                  xlab = "Seconds",
                  ylab = "m/z",
                  xlim=range(qd$time), 
                  ylim=range(qd$mz), 
                  alpha = 0.5)
  
  
  
  newqd <- as.data.frame(qd)
  newqd <- newqd[order(newqd$time), ]
  col <- log(newqd$intensity)
  col <- col/max(col)
  newqd <- qdata(newqd[,c('time', 'mz', 'intensity')], 
                 color = rgb(1 - col, 1 - col, 0), 
                 border = rgb(1 - col, 1 - col, 0), 
                 size = newqd$.size)
  newqd[newqd$mz != mz, '.visible'] <- FALSE
  splot <- qscatter(x = time,
        y = intensity,
        data = newqd,
        main = paste('removeBaseline: ', filepath, ' :: mz : ', mz),
        xlab = "Seconds",
        ylab = "Intensity",
        xlim = range(newqd$time),
        ylim = range(newqd[newqd$.visible, 'intensity'], na.rm = TRUE)
        )
  
  line_layer <- qlayer(paintFun = function(layer, painter){
    qdrawLine(painter, newqd[newqd$.visible, 'time'], newqd[newqd$.visible, 
          'intensity'], stroke = 'red')}, 
    limits = qrect(splot$meta$limits) )
  
  splot$layerList[[1]][1,2] <- line_layer
  sync_limits(splot$meta, line_layer)
  newmz <- NULL
  
  draw_locator <- function(layer, painter){
    if(!is.null(newmz)){
      qdrawLine(painter, x = mplot$meta$limits[,1], y = c(newmz, newmz), stroke = 'red')
    }
    
  }
  get_mz <- function(layer, event){
    print('yes')
    newmz <<-round(event$pos()$y())
    if(length(newqd[ newqd$.visible,'.visible']) > 0){
      newqd[ newqd$.visible,'.visible'] <- FALSE
    }
    
    if(length(newqd[newqd$mz == newmz, '.visible']) > 0){
      newqd[newqd$mz == newmz, '.visible'] <- TRUE
      splot$meta$limits[,1] <- extend_ranges(round(range(newqd[newqd$.visible, 
                                                               'time'], 
                                                     na.rm = TRUE) + c(-1,1)))
      splot$meta$limits[,2] <- extend_ranges(round(range(newqd[newqd$.visible, 
                                                         'intensity'], 
                                                     na.rm = TRUE) + c(-1,1)))
     
      splot$meta$xat <- axis_loc(splot$meta$limits[,1])
    
      splot$meta$yat <- axis_loc(splot$meta$limits[,2])
      splot$meta$xlabels = format(splot$meta$xat)
      splot$meta$ylabels = format(splot$meta$yat)
   
    }else {
      splot$meta$keys <- 'No data!'
    }
    splot$meta$main = paste('removeBaseline: ', filepath, ' :: mz : ', newmz)
    qupdate(newintlayer)
  }
  
  
  newintlayer <- qlayer(paintFun = draw_locator,  mouseReleaseFun = get_mz,
                        limits = qrect(mplot$meta$limits))
 ## waiting for cranvas update
#   newintlayer <- qlayer(paintFun = draw_locator,  
#                         limits = qrect(mplot$meta$limits))
  mplot$layerList[[1]][1,2] <- newintlayer
  sync_limits(mplot$meta, newintlayer)
 ## waiting for cranvas update
 ## register_handlers(mplot, mouseReleaseFun = get_mz)
  print(mplot)
  print(splot)
  
  
}