R/Spectra_visulization.R

Defines functions .set.rdt.set .get.rdt.set ComputeEncasing scale_range rgba_to_hex_opacity my.json.scatter plotBPIs plotTICs plotSingleTIC plotMSfeature PlotSpectraBPIadj PlotSpectraRTadj PlotSpectraPCA PlotSpectraInsensityStistics PlotXIC SetPlotParam PerformDataInspect

Documented in PerformDataInspect plotBPIs plotMSfeature plotSingleTIC PlotSpectraBPIadj PlotSpectraInsensityStistics PlotSpectraPCA PlotSpectraRTadj plotTICs PlotXIC SetPlotParam

#' @title PerformDataInspect
#' @description This functions provide a path for users to visually inspect their raw data before the data
#' trimming so as to remove the dirty or significantly uneluted peaks.
#' @param datapath Character, the path of the raw MS data files (.mzXML, .CDF and .mzML)
#' for the visual and intuitive data inspectation or the file folder (if only a folder path provided, the first file will
#' be inspected).
#' @param rt.range Numerics, a congregation of two values to define the lower and upper RT range (seconds) for
#' users to inspect. This is an optional parameter, if absent, will display the MS of the whole RT range.
#' @param mz.range Numerics, a congregation of two values to define the lower and upper mz range for
#' users to inspect. This is an optional parameter, if absent, will display the MS of the whole mz range.
#' @param dimension Character, the dimension for sample to display, including '2D' or '3D'. The default is '3D'.
#' @param res Numeric, the resolution for data inspectation. The larger the value, the higher the resolution.
#' The default value is 100. This value is usually clearly enough and also give consideration to the speed.
#' @export
#' @return will output a figure for viewing the data structure
#' @import MSnbase
#' @importFrom Cairo Cairo
#' @author Zhiqiang Pang \email{zhiqiang.pang@mail.mcgill.ca} Jeff Xia \email{jeff.xia@mcgill.ca}
#' Mcgill University
#' License: GNU GPL (>= 2)
#' @examples 
#' ## Get raw spectra files
#' DataFiles <- dir(system.file("mzData", package = "mtbls2"), full.names = TRUE,
#'                  recursive = TRUE)[c(10:12, 14:16)]
#' PerformDataInspect(DataFiles[1])

PerformDataInspect <-
  function(datapath = NULL,
           rt.range = c(0,0),
           mz.range = c(0,0),
           dimension = "3D",
           res = 100) {
    
    if(.on.public.web()){
      
      fullUserPath <- getwd();
      
      if (datapath == "null" | is.null(datapath)) {
        if (.on.public.web() & dir.exists("upload/QC")) {
          datapath <- "/upload/QC"
          datapath <- paste0(fullUserPath, datapath)
        } else if (.on.public.web()) {
          datapath <- paste0("/upload/", list.files("upload", recursive = TRUE)[1])
          datapath <- paste0(fullUserPath, datapath)
        } else {
          MessageOutput("Local Inspectation !\n")
        }
      } else {
        files <-
          list.files(paste0(getwd(), "/upload/"),
                     full.names = TRUE,
                     recursive = TRUE)
        
        
        if (isEmpty(files)) {
          # Handle the example issue - show other files
          files <-
            list.files(
              "/home/glassfish/projects/MetaboDemoRawData/upload/",
              full.names = TRUE,
              recursive = TRUE
            )
          datapath =  files[datapath == basename(files)]
          
        } else {
          # Handle the regular data insepctation
          datapath =  files[datapath == basename(files)]
        }
        
      }
      
      if (basename(datapath) == "NA") {
        # Handle the example issue - default showing
        datapath <-
          "/home/glassfish/projects/MetaboDemoRawData/upload/QC"
      }
    }
    
    if (!grepl(pattern = c("*.mzXML"), basename(datapath)) &
        !grepl(pattern = c("*.mzxml"), basename(datapath)) &
        !grepl(pattern = c("*.mzData"), basename(datapath)) &
        !grepl(pattern = c("*.mzdata"), basename(datapath)) &
        !grepl(pattern = c("*.mzML"), basename(datapath)) &
        !grepl(pattern = c("*.mzml"), basename(datapath)) &
        !grepl(pattern = c("*.CDF"), basename(datapath)) &
        !grepl(pattern = c("*.cdf"), basename(datapath))) {
      MessageOutput(paste("First file in ", datapath, " will be inspected !\n"),SuppressWeb = TRUE)
      mzf <- list.files(datapath, recursive = FALSE, full.names = TRUE)[1]
    } else {
      mzf <- datapath
    }
    
    if (grepl(pattern = c("*.CDF"), basename(mzf)) |
        grepl(pattern = c("*.cdf"), basename(mzf))) {
      # centroid_cdf();
      return()
    }
    
    ms <- mzR::openMSfile(mzf)
    hd <- header(ms)
    
    ms1 <- which(hd$msLevel == 1)
    
    if (missing(rt.range) | (rt.range[1] == 0 & rt.range[2] == 0)) {
      rtsel <-
        hd$retentionTime[ms1] >= min(hd$retentionTime) &
        hd$retentionTime[ms1] <= max(hd$retentionTime)
      
      rt.extension <- FALSE
      MessageOutput(paste(
        "RT range is:",
        min(hd$retentionTime),
        "and",
        max(hd$retentionTime),
        "seconds !\n"
      ), SuppressWeb = TRUE)
      
    } else{
      if (rt.range[2] < rt.range[1]) {
        a1 <- rt.range[1]
        rt.range[1] <- rt.range[2]
        rt.range[2] <- a1
      } else if (rt.range[2] == rt.range[1]) {
        rt.range[2] <- rt.range[2] + 1
        rt.range[1] <- rt.range[1] - 1
      }
      MessageOutput(paste("RT range is:", rt.range[1], "and", rt.range[2], "seconds !\n"),SuppressWeb = TRUE)
      
      rtsel <-
        hd$retentionTime[ms1] > rt.range[1] &
        hd$retentionTime[ms1] < rt.range[2]
      
      rt.min <- min(hd$retentionTime[ms1])
      rt.max <- max(hd$retentionTime[ms1])
      
      if (rt.range[1] < rt.min | rt.range[2] > rt.max) {
        rt.extension <- TRUE
      } else {
        rt.extension <- FALSE
      }
    }
    if (missing(mz.range) | (mz.range[1] == 0 & mz.range[2] == 0)) {
      min.mz <- min(hd$lowMZ)
      max.mz <- max(hd$highMZ)
      
      if (min.mz == 0 & max.mz == 0 | min.mz == max.mz) {
        MessageOutput(
          "mz.range information is missing in your data file. mz between 100 and 1200 will be shown here !\n"
        )
        min.mz <- 100
        max.mz <- 1200
        
      } else if (is.infinite(min.mz) |
                 is.infinite(max.mz) | min.mz == -1 | max.mz == -1) {
        MessageOutput(
          "mz.range information is missing in your data file. mz between 50 and 2000 will be shown here !\n"
        )
        min.mz <- 50
        max.mz <- 2000
      }
      
      MessageOutput(paste("MZ range is:", min.mz, "and", max.mz, "Thomson !\n"),SuppressWeb = TRUE)
      
      res.mz <- (max.mz - min.mz) / res
      M <- MSmap(ms,
                 ms1[rtsel],
                 min.mz,
                 max.mz,
                 res.mz,
                 hd,
                 zeroIsNA = TRUE)
      
    } else{
      if (mz.range[2] < mz.range[1]) {
        a1 <- mz.range[1]
        mz.range[1] <- mz.range[2]
        mz.range[2] <- a1
      } else if (mz.range[2] == mz.range[1]) {
        mz.range[2] <- mz.range[2] + 0.01
        mz.range[1] <- mz.range[1] - 0.01
      }
      
      MessageOutput(paste("MZ range is:", mz.range[1], "and", mz.range[2], "Thomson !\n"),SuppressWeb = TRUE)
      
      res.mz <- (mz.range[2] - mz.range[1]) / res
      M <- MSmap(ms,
                 ms1[rtsel],
                 mz.range[1],
                 mz.range[2],
                 res.mz,
                 hd,
                 zeroIsNA = TRUE)
    }
    
    if (rt.extension) {
      if (min(M@rt) > rt.range[1]) {
        M@rt <- c(rt.range[1], M@rt)
        M@map <- rbind(rep(NA, dim(M@map)[2]), M@map)
        M@ms <- c(M@ms, 1)
      }
      
      if (max(M@rt) < rt.range[2]) {
        M@rt <- c(M@rt, rt.range[2])
        M@map <- rbind(M@map, rep(NA, dim(M@map)[2]))
        M@ms <- c(M@ms, 1)
      }
    }
    
    if (missing(dimension)) {
      dimension = "3D"
    }
    
    FN <- tools::file_path_sans_ext(basename(mzf))
    
    filename <-
      paste0(
        FN,
        "_mz_",
        mz.range[1],
        "_",
        mz.range[2],
        "_RT_",
        rt.range[1],
        "_",
        rt.range[2],
        dimension,
        ".png"
      )

    if(.on.public.web()){
      Cairo::Cairo(
        file = filename,
        unit = "in",
        dpi = 72,
        width = 7,
        height = 7,
        type = "png",
        bg = "white"
      )
    }

    seed.cols <- c("#fafafa", "#e0e0e0");
    cols <- colorRampPalette(seed.cols)(8)
    seed.cols22 <- c("#ffee00","#ffc400", "#ff0000","#a600ff", "#0006b0","#000363")
    cols2 <- colorRampPalette(seed.cols22)(8)
    
    if (dimension == "3D") {
      print(plot.MS_3D(M))
    } else {
      M@mz <- round(M@mz,3)
      print(plot(M, aspect = 1, allTicks = FALSE, col.regions = c(cols, cols2)))
    }
    
    if(.on.public.web()){
      dev.off()
    }
    
    return(filename)
  }

#' @title SetPlotParam
#' @description This function sets the generic Plotting Parameters for different functions
#' @param Plot Logical, if true, the function will plot internal figures for different functions.
#' @param labels Logical, if true, the labels in the plot will be added.
#' @param format Numeric, input the format of the image to create.
#' @param dpi Numeric, input the dpi of the image to create.
#' @param width Numeric, input the width of the image to create.
#' @param ... Other specific parameters for specific function. Please set them according to the corresponding function.
#' @author Zhiqiang Pang \email{zhiqiang.pang@mail.mcgill.ca}, and Jeff Xia \email{jeff.xia@mcgill.ca}
#' McGill University, Canada
#' License: GNU GPL (>= 2)
#' @return will return a plotting parameters set
#' @export
#' @examples
#' SetPlotParam(Plot = TRUE, dpi = 144, width = 12)

SetPlotParam <-
  function(Plot = FALSE,
           labels = TRUE,
           format = "png",
           dpi = 72,
           width = 9,
           ...) {
    return(list(
      Plot = Plot,
      labels = labels,
      format = format,
      dpi = dpi,
      width = width,
      ...
    ))
  }

#' @title PlotXIC/EIC
#' @description This functionn creates an extracted ion chromatogram (XIC/EIC) for a specific
#' m/z and retention time. This is used for quality-control of raw m/s data.
#' @param mSet mSet Object. Should contain the spectra processing result.
#' @param featureNum Numeric, Feature number in the feature table.
#' @param sample_labeled Logical, whether to lable the sample name.
#' @param Group_labeled Logical, whether to lable the group name.
#' @param format Character, to give the format of BPI figures ploted. Can be "jpeg", "png", "pdf", "svg",
#'  "tiff" or "ps". Default is "png".
#' @param dpi Numeric, to define the dpi of the figures. Default is 72.
#' @param width Numeric, to define the width of the figure.
#' @param height Numeric, to define the height of the figure.
#' @param sample_filled Logical, to determine the EIC/XIC is filled or not for sample EIC
#' @param group_filled Logical, to determine the EIC/XIC is filled or not for group EIC
#' @importFrom Cairo Cairo
#' @importFrom ggrepel geom_text_repel
#' @importFrom grid viewport
#' @importFrom MSnbase filterMz
#' @export
#' @return will return a figure of EIC/XIC
#' @examples 
#' data(mSet);
#' newPath <- dir(system.file("mzData", package = "mtbls2"),
#'                full.names = TRUE, recursive = TRUE)[c(10, 11, 12)]
#' mSet <- updateRawSpectraPath(mSet, newPath);
#' #PlotXIC(mSet, 1, TRUE, TRUE);


PlotXIC <-
  function(mSet = NULL,
           featureNum,
           sample_labeled,
           Group_labeled,
           format,
           dpi,
           width,
           height,
           sample_filled,
           group_filled) {
    # Parameters initialization
    if (missing(sample_labeled)) {
      sample_labeled <- FALSE
    }
    if (missing(Group_labeled)) {
      Group_labeled <- TRUE
    }
    if (missing(format)) {
      format <- "png"
    }
    if (missing(dpi)) {
      dpi <- 72
    }
    if (missing(width)) {
      width <- 6
    }
    if (missing(height)) {
      height <- width * 1.05
    }
    
    if(missing(sample_filled)){
      sample_filled <- FALSE;
    }
    
    if(missing(group_filled)){
      group_filled <- TRUE;
    }
    
    # Load data results
    if(.on.public.web()){
      load("mSet.rda")
    } else if(is.null(mSet)) {
      stop("mSet is missing!")
    }

    raw_data <- mSet@rawOnDisk;
    raw_data@featureData$retentionTime <-
      unlist(mSet@peakRTcorrection$adjustedRT);
    
    # Get groups information
    groupsInfo0 <- groupsInfo <- raw_data@phenoData@data[["sample_group"]]
    group_levels <- levels(as.factor(groupsInfo))
    
    groupsInfo <-
      sapply(
        group_levels,
        FUN = function(x) {
          which(x == groupsInfo)
        }
      )
    
    samples_names <- raw_data@phenoData@data[["sample_name"]]
    
    # Get current feature information
    peak_idx_current <-mSet@peakfilling$FeatureGroupTable@listData$peakidx[[featureNum]]
    
    #peak_table <- mSet[["msFeatureData"]][["chromPeaks"]][peak_idx_current,];
    peak_table <- mSet@peakfilling[["msFeatureData"]][["chromPeaks"]][peak_idx_current,]
    peak_table <- peakTableSUM(peak_table)
    
    rtrange <-
      c(mSet@peakfilling[["FeatureGroupTable"]]@listData[["rtmin"]][featureNum] - 10,
        mSet@peakfilling[["FeatureGroupTable"]]@listData[["rtmax"]][featureNum] + 10)
    
    mzrange <-
      c(mSet@peakfilling[["FeatureGroupTable"]]@listData[["mzmin"]][featureNum] - 0.2,
        mSet@peakfilling[["FeatureGroupTable"]]@listData[["mzmax"]][featureNum] + 0.2)
    
    RawData <- MSnbase::filterMz(MSnbase::filterRt(raw_data, rtrange), mzrange)
    
    title <-
      paste0(round(mSet@peakfilling[["FeatureGroupTable"]]@listData[["mzmed"]][[featureNum]], 4),
             "mz@",
             round(mSet@peakfilling[["FeatureGroupTable"]]@listData[["rtmed"]][[featureNum]], 2),
             "s")
    
    
    # Get feature details as a list in MSdb
    MSdb0 <- MSdb <- IntoLists <- IntoListg <- list()
    
    for (i in group_levels) {
      IntoListg[[i]] <- 0
      #Different groups
      if (is(groupsInfo,"list")) {
        array_sample <- groupsInfo[[i]]
      } else {
        array_sample <- groupsInfo[, i]
      }
      nc <- 0
      
      for (x in array_sample) {
        #Different samples per group
        sample_idx <- which(x == peak_table[, "sample"])
        
        #print(paste0("sample_idx: ",x, sample_idx))
        for (j in sample_idx) {
          #Multiple features in corresponding sample  - extract a little bit more
          mzr <-
            c(peak_table[j, 2] - 0.001, peak_table[j, 3] + 0.001)
          rtr <- c(peak_table[j, which(colnames(peak_table) == "rtmin")] - 0.1, 
                   peak_table[j, which(colnames(peak_table) == "rtmax")] + 0.1)
          IntoListg[[i]] <- IntoListg[[i]] +  peak_table[j, 7]
          IntoLists[[i]][[samples_names[x]]] <- peak_table[j, 7]
          
          MSdb0[[samples_names[x]]] <-
            chromatogram(
              RawData,
              mz = mzr,
              rt = rtr,
              aggregationFun = "max"
            )[[x]]
          
          nc <- nc + 1
        }
      }
      # Do the average on the same group
      if (nc != 0) {
        IntoListg[[i]] <- IntoListg[[i]] / nc
      } else {
        IntoListg[[i]] <- 0.0
      }
      
      if (!identical(MSdb0, list())) {
        MSdb[[i]] <- MSdb0
        MSdb0 <- list()
      }
    }
    
    ## Get Group CV Table
    y <- NULL;
    CVTable <- PeakGroupCV(IntoLists, groupsInfo);
    
    CVTable <- data.frame(x = CVTable$V1,y=CVTable$V2);
    pCV <- ggplot(data=CVTable, aes(x=x, y=y, fill =x, alpha = 0.5))  + 
      geom_col(width = 1.32/ncol(CVTable)) + 
      theme_bw() + 
      theme(text = element_text(size=8.5), 
            axis.title.x = element_blank(),
            axis.text.x=element_blank(), 
            legend.position = "none",
            panel.grid.major = element_blank(), 
            panel.grid.minor = element_blank()) + 
      labs(y = expression(italic("Coefficient of variation"))) + 
      geom_hline(yintercept=1, linetype="dashed", color = "red");

    ## PLotting sample EIC begin -
    res0 <- lapply(
      MSdb,
      FUN = function(x) {
        res_sample <- data.frame()
        
        if (length(x) != 0) {
          for (j in seq_along(x)) {
            sampleRes <- data.frame(x[[j]]@rtime, x[[j]]@intensity, rep(names(x)[j], length(x[[j]]@rtime)));
            rtdiff <- mean(diff(sampleRes$x..j...rtime));
            insertEmptyScan <- data.frame(c(unname(x[[j]]@rtime[1]) - 4*rtdiff, unname(x[[j]]@rtime[1]) - 3*rtdiff, 
                                            unname(x[[j]]@rtime[1]) - 2*rtdiff, unname(x[[j]]@rtime[1]) - rtdiff,
                                            unname(tail(x[[j]]@rtime,1)) + rtdiff, unname(tail(x[[j]]@rtime,1)) + 2*rtdiff,
                                            unname(tail(x[[j]]@rtime,1)) + 3*rtdiff, unname(tail(x[[j]]@rtime,1)) + 4*rtdiff),
                                            rep(0, 8), 
                                            rep(names(x)[j], 8));
            colnames(sampleRes) <- colnames(insertEmptyScan) <- colnames(sampleRes);
            sampleRes <- rbind(insertEmptyScan, sampleRes)
            res_sample <- rbind(res_sample,sampleRes);
          }
        }
        
        res_sample[is.na(res_sample)] <- 0
        return(res_sample)
      }
    )
    
    res <- data.frame()
    
    for (w in seq_along(res0)) {
      ncouts <- nrow(res0[[w]])
      
      resds <-
        cbind(res0[[w]], rep(names(res0)[w], nrow(res0[[w]])), rep(NA, ncouts))
      
      for (ww in seq_along(unique(resds[, 3]))) {
        cn <- unique(resds[, 3])[ww]
        cint <- IntoLists[[w]][cn == names(IntoLists[[w]])]
        resds[resds[, 3] == cn,][which(resds[resds[, 3] == cn, 2] == max(resds[resds[, 3] == cn, 2])), 5] <-
          formatC(cint[[1]], format = "e", digits = 2)
      }
      
      res <- rbind(res, resds)
    }
    
    colnames(res) <-
      c("RT", "Intensity", "Samples", "Groups", "Labels");
    peak_width <- max(res$RT) - min(res$RT);
    
    ## Resume for the missing peaks
    minRT <- min(res$RT);
    maxRT <- max(res$RT);
    RTvec <- c(minRT, minRT + (maxRT - minRT)/4, minRT + (maxRT - minRT)/2, minRT + (maxRT - minRT)*3/4, maxRT)
    
    missingIdx <- which(!(samples_names %in% unique(res$Samples)));

    for(m in missingIdx){
      res <- rbind(res, data.frame(RT=RTvec, 
                                   Intensity = rep(0, 5), 
                                   Samples = rep(samples_names[m], 5), 
                                   Groups = rep(groupsInfo0[m], 5), 
                                   Labels = c(NA, NA, 0, NA, NA)))
    }

    
    
    if(!is.null(mSet@params[["Peak_method"]])){
      if(mSet@params[["Peak_method"]] == "Massifquant"){
        spanValue <- 0.8
      }else {
        spanValue <- 0.6
      }
    } else {
      spanValue <- 0.55
    }
    print(paste0("EIC_", title, "_sample_", dpi, ".", format));
    if (.on.public.web()) {
      Cairo::Cairo(
        file = paste0("EIC_", title, "_sample_", dpi, ".", format),
        unit = "in",
        dpi = dpi,
        width = width,
        height = height,
        type = format,
        bg = "white"
      )
    }
    
    if(sample_filled){
      s_image0 <- ggplot(res, aes_string(x = "RT", y = "Intensity", color = "Samples")) +
        stat_smooth(
          geom = 'area',
          method = "loess",
          se = FALSE,
          span = spanValue,
          size = 0.35,
          formula = "y ~ x",
          alpha = 1 / 4,
          aes_string(fill = "Samples")
        )
    } else {
      s_image0 <- ggplot(res, aes_string(x = "RT", y = "Intensity", color = "Samples")) +
        stat_smooth(
          method = "loess",
          se = FALSE,
          span = spanValue,
          size = 0.35,
          formula = "y ~ x",
          alpha = 1 / 4,
          aes_string(color = "Samples"),
          fill = NA
        )
    }
    
    s_image <-s_image0 +
      theme_bw() +
      ylim(0, NA) +
      xlim(min(res$RT) - peak_width * 0.05 , max(res$RT) + peak_width * 0.35) +
      theme(
        legend.position = c(0.87, 0.85),
        plot.title = element_text(
          size = 12,
          face = "bold",
          hjust = 0.5
        ),
        legend.title = element_text(size = 8.5),
        legend.text = element_text(size = 8),
        legend.key.size = unit(3, "mm"),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank()
      ) +
      ggtitle(title)
    
    if (sample_labeled) {
      s_image <-
        s_image + geom_text_repel(aes_string(y = "Intensity * 0.2", label = "Labels"),
                                  force = 1.5,
                                  show.legend = FALSE)
    }
    
    print(s_image);
    
    if (.on.public.web()) {
      dev.off()
    }
    ## PLotting sample EIC finished -
    
    ## PLotting group EIC begin --
    res <- NULL
    res <- lapply(MSdb, featureSUM, frtr = rtrange)
    
    if (any(sapply(res, is.null))) {
      res <- res[-which(sapply(res, is.null))]
    }
    
    res_data <- data.frame();
    
    for (k in seq_along(res)) {
      ncout <- nrow(res[[k]]);
      
      resd <-
        cbind(res[[k]], rep(names(res[k]), ncout), rep(NA, ncout))
      
      resd[which(resd$Inten_mean == max(resd$Inten_mean)), 4] <-
        formatC(IntoListg[[names(res[k])]], format = "e", digits = 2)
      
      res_data <- rbind(res_data, resd)
    }
    
    colnames(res_data) <- c("RT", "Intensity", "Groups", "Labels");
    rownames(res_data) <- NULL;
    peak_width <- max(res_data$RT) - min(res_data$RT);
    
    ## ADD the missing groups
    minRT <- maxRT <- RTvec <- missingIdx <- m <- NULL;
    minRT <- min(res_data$RT);
    maxRT <- max(res_data$RT);
    RTvec <- c(minRT, minRT + (maxRT - minRT)/4, minRT + (maxRT - minRT)/2, minRT + (maxRT - minRT)*3/4, maxRT)
    
    missingIdx <- which(!(unique(groupsInfo0) %in% unique(res_data$Groups)));
    
    for(m in missingIdx){
      res_data <- rbind(res_data, data.frame(RT=RTvec,
                                             Intensity = rep(0, 5),
                                             Groups = rep(unique(groupsInfo0)[m], 5), 
                                             Labels = c(NA, NA, 0, NA, NA)))
    }
    
    
    if (.on.public.web()) {
      Cairo::Cairo(
        file = paste0("EIC_", title, "_group_", dpi, ".", format),
        unit = "in",
        dpi = dpi,
        width = width,
        height = height,
        type = format,
        bg = "white"
      )
    }
    
    if(group_filled){
      g_image0 <- ggplot(res_data, aes_string(x = "RT", y = "Intensity", color = "Groups")) + #geom_line() +
        stat_smooth(
          geom = 'area',
          method = "loess",
          se = FALSE,
          span = spanValue,
          size = 0.35,
          formula = "y ~ x",
          alpha = 1 / 4,
          aes_string(fill = "Groups")
        ) 
    } else {
      g_image0 <- ggplot(res_data, aes_string(x = "RT", y = "Intensity", color = "Groups")) + #geom_line() +
        stat_smooth(
          geom = 'area',
          method = "loess",
          se = FALSE,
          span = spanValue,
          size = 0.35,
          formula = "y ~ x",
          alpha = 1 / 4,
          aes_string(color = "Groups"),
          fill = NA
        ) 
    }
    
    g_image <- g_image0 +
      theme_bw() +
      ylim(0, NA) +
      xlim(min(res_data$RT) - peak_width * 0.75 ,
           max(res_data$RT) + peak_width * 0.75) +
      theme(
        legend.position = c(0.85, 0.88),
        plot.title = element_text(
          size = 12,
          face = "bold",
          hjust = 0.5
        ),
        legend.title = element_text(size = 9),
        legend.text = element_text(size = 9),
        legend.key.size = unit(4, "mm"),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank()
      ) +
      ggtitle(title)
    
    if (Group_labeled) {
      g_image <-
        g_image + geom_text_repel(aes_string(y = "Intensity * 0.2", label = "Labels"),
                                  force = 1.5,
                                  show.legend = FALSE)
    }
    #require(grid);
    print(g_image); print(pCV,vp=viewport(.3, .76, .24, 0.24));
    
    if (.on.public.web()) {
      dev.off()
    }
    ## PLotting group EIC finished --
    return(title)
  }


#' @title PlotSpectraInsensityStistics
#' @description This function is used to do the statistics on the spectra intensity
#' @param mSet mSet object, usually generated after the peakannotaion finished here.
#' @param imgName Character, to give the name of BPI figures ploted.
#' @param format Character, to give the format of BPI figures ploted. Can be "jpeg", "png", "pdf", "svg",
#'  "tiff" or "ps". Default is "png".
#' @param dpi Numeric, to define the dpi of the figures. Default is 72.
#' @param width Numeric, to define the width of the figure. Height = width * 0.618. 
#' @export
#' @return will return a figure of spectral peak intensity
#' @importFrom Cairo Cairo
#' @importFrom graphics par
#' @importFrom graphics boxplot
#' @importFrom graphics grid
#' @import RColorBrewer
#' @examples 
#' data(mSet);
#' newPath <- dir(system.file("mzData", package = "mtbls2"),
#'                full.names = TRUE, recursive = TRUE)[c(10, 11, 12)]
#' mSet <- updateRawSpectraPath(mSet, newPath);
#' PlotSpectraInsensityStistics(mSet);

PlotSpectraInsensityStistics <-
  function(mSet = NULL,
           imgName,
           format = "png",
           dpi = 72,
           width = NA) {
    
    if(is.null(mSet) & .on.public.web()){
      load("mSet.rda");
    } else if(is.null(mSet)) {
      stop("mSet is missing!")
    }
    
    sample_idx <- mSet@rawOnDisk@phenoData@data[["sample_group"]];
    
    sample_num <-
      mSet@rawOnDisk@phenoData@data[["sample_name"]];
    
    if (length(unique(sample_idx)) > 9) {
      col.fun <-
        grDevices::colorRampPalette(RColorBrewer::brewer.pal(12, "Set3"))
      group_colors <- col.fun(length(unique(sample_idx)))
      
    } else{
      group_colors <-
        paste0(RColorBrewer::brewer.pal(9, "Set1")[seq_along(unique(sample_idx))], "60")
    }
    
    ints <-
      split(log2(mSet@peakfilling$msFeatureData$chromPeaks[, "into"]),
            f = mSet@peakfilling$msFeatureData$chromPeaks[, "sample"])
    
    if(mSet@params$BlankSub & any(sample_idx == "BLANK")){
      ints <- ints[names(ints) != 0];
      sample_num <- sample_num[sample_idx != "BLANK"]
    }
    
    names(ints) <- as.character(sample_num)
    
    sample_idx <- as.factor(sample_idx)
    group_colors <-
      sapply(
        seq(length(levels(sample_idx))),
        FUN = function(x) {
          rep(group_colors[x], length(sample_idx[sample_idx == levels(sample_idx)[x]]))
        }
      )
    
    if(!.on.public.web()){
      oldpar <- par(no.readonly = TRUE);
      on.exit(par(oldpar));
    }

    if (.on.public.web()) {
      Cairo::Cairo(
        file = imgName,
        unit = "in",
        dpi = dpi,
        width = width,
        height = length(sample_num) * 0.65 * (width/8),
        type = format,
        bg = "white"
      )
    }
    
    #op <- 
      par(mar = c(3.5, 10, 4, 1.5), xaxt = "s")
    
    sampleNMs <- names(ints);
    len_nms <- nchar(sampleNMs);
    if(any(len_nms > 15)){
      names(ints) <- 
        unname(unlist(sapply(sampleNMs, function(x){
          LEN_x <- nchar(x);
          if(LEN_x > 15){
            substring(x, LEN_x-14,LEN_x)
          } else {
            x
          }
        })))
    }
    
    boxplot(
      ints,
      varwidth = TRUE,
      col = as.character(unlist(group_colors)),
      ylab = "",
      horizontal = TRUE,
      las = 2,
      main = expression(log[2] ~ intensity),
      cex.lab = 0.8,
      cex.main = 1.25
    )
    
    #title(ylab=expression(log[2]~intensity), line=7.5, cex.lab=1.2)
    grid(nx = NA, ny = NULL)
    
    if (.on.public.web()) {
      dev.off()
    }
  }






#' @title PlotSpectraPCA
#' @description This function is used to plot the PCA of all spectra
#' @param mSet mSet object, usually generated after the peakannotaion finished here.
#' @param imgName Character, to give the name of BPI figures ploted.
#' @param format Character, to give the format of BPI figures ploted. Can be "jpeg", "png", "pdf", "svg",
#'  "tiff" or "ps". Default is "png".
#' @param dpi Numeric, to define the dpi of the figures. Default is 72.
#' @param width Numeric, to define the width of the figure. Height = width * 0.618. 
#' @importFrom ggrepel geom_text_repel
#' @importFrom RJSONIO toJSON
#' @importFrom stats prcomp
#' @import RColorBrewer
#' @return will return a figure of PCA after log tranformation (log2)
#' @export
#' @examples 
#' data(mSet);
#' newPath <- dir(system.file("mzData", package = "mtbls2"),
#'                full.names = TRUE, recursive = TRUE)[c(10, 11, 12)]
#' mSet <- updateRawSpectraPath(mSet, newPath);
#' PlotSpectraPCA(mSet);

PlotSpectraPCA <-
  function(mSet = NULL,
           imgName,
           format = "png",
           dpi = 72,
           width = NA) {
    
    if(missing(mSet) || is.null(mSet)){
      load("mSet.rda")
    }
    
    if (.on.public.web()) {
      Cairo::Cairo(
        file = imgName,
        unit = "in",
        dpi = dpi,
        width = width,
        height = width * 0.80,
        type = format,
        bg = "white"
      )
    }
    
    sample_idx <-
      mSet@rawOnDisk@phenoData@data[["sample_group"]];
    
    if(mSet@params$BlankSub & any(sample_idx == "BLANK")){
      sample_idx <- sample_idx[sample_idx != "BLANK"]
    }
    
    # feature_value <-
    #   .feature_values(
    #     pks = mSet@peakfilling$msFeatureData$chromPeaks,
    #     fts = mSet@peakfilling$FeatureGroupTable,
    #     method = "medret",
    #     value = "into",
    #     intensity = "into",
    #     colnames = mSet@rawOnDisk@phenoData@data[["sample_name"]],
    #     missing = NA
    #   );
    
    feature_value0 <- mSet@dataSet[-1,];
    rownames(feature_value0) <- feature_value0[,1];
    feature_value <- feature_value0[,-1];
    feature_value[is.na(feature_value)] <- 0;
    
    int.mat <- as.matrix(feature_value)
    rowNms <- rownames(int.mat);
    colNms <- colnames(int.mat);
    int.mat <- t(apply(int.mat, 1, function(x) .replace.by.lod(as.numeric(x))));
    rownames(int.mat) <- rowNms;
    colnames(int.mat) <- colNms; 
    feature_value <- int.mat;
    feature_value[feature_value==0] <- 1;
    
    pca_feats <- log10(feature_value);
    
    if (nrow(feature_value) < 2) {
      MessageOutput(
        mes =  paste0(
          "<font color=\"red\">",
          "\nERROR: No enough peaks detected, please adjust your parameters or use other Peak/Alignment method",
          "</font>"
        ),
        ecol = "\n",
        progress = 65
      );
      
      if (.on.public.web()) {
        dev.off()
      }
      
      return(NULL)
    }
    
    pca_feats[is.na(pca_feats)] <- 0;
    df0 <- na.omit(pca_feats);
    df1 <- df0[is.finite(rowSums(df0)),];
    df <- t(df1);
    
    mSet_pca <- prcomp(df, center = TRUE, scale = FALSE);
    sum.pca <- summary(mSet_pca);
    var.pca <-
      sum.pca$importance[2,]; # variance explained by each PCA
    
    xlabel <- paste("PC1", "(", round(100 * var.pca[1], 1), "%)");
    ylabel <- paste("PC2", "(", round(100 * var.pca[2], 1), "%)");
    zlabel <- paste("PC3", "(", round(100 * var.pca[3], 1), "%)");
    
    # using ggplot2
    df <- as.data.frame(mSet_pca$x);
    df$group <- sample_idx;
    
    ## Handle to generate json file for PCA3D online
    if(.on.public.web()){
      ## For score plot
      pca3d <- list();
      pca3d$score$axis <- c(xlabel, ylabel, zlabel);
      xyz0 <- df[,seq_len(3)];
      colnames(xyz0) <- rownames(xyz0) <- NULL;
      pca3d$score$xyz <- data.frame(t(xyz0));
      colnames(pca3d$score$xyz) <- NULL;
      pca3d$score$name <- rownames(df);
      pca3d$score$facA <- df$group;
      
      if(length(unique(df$group)) < 9){
        col.fun <-
          grDevices::colorRampPalette(RColorBrewer::brewer.pal(length(unique(df$group)), "Set1"));
      } else {
        col.fun <-
          grDevices::colorRampPalette(RColorBrewer::brewer.pal(length(unique(df$group)), "Set3"));
      }
      
      pca3d$score$colors <- col.fun(length(unique(df$group)));
      
      # json.obj <- RJSONIO::toJSON(pca3d, .na='null');
      # sink("spectra_3d_score.json");
      # cat(json.obj);
      # sink();
      
      ## For loading plot
      #pca3d <- list();
      
      pca3d$loading$axis <- paste("Loading ", seq_len(3), sep="");
      coords0 <- coords <- data.frame(t(signif(mSet_pca$rotation[,seq_len(3)], 5)));
      colnames(coords) <- NULL; 
      pca3d$loading$xyz <- coords;
      pca3d$loading$name <- rownames(mSet_pca$rotation);
      pca3d$loading$entrez <- paste0(round(mSet@peakfilling[["FeatureGroupTable"]]@listData$mzmed, 4), 
                                     "@", 
                                     round(mSet@peakfilling[["FeatureGroupTable"]]@listData$rtmed, 2));
      
      dists <- GetDist3D(coords0);
      pca3d$loading$cols <- GetRGBColorGradient(dists);
      
      pca3d$cls =  df$group;
      
      # json.obj <- RJSONIO::toJSON(pca3d, .na='null');
      # sink("spectra_3d_loading.json");
      # cat(json.obj);
      # sink();
      qs::qsave(pca3d$score, "score3d.qs");
      qs::qsave(pca3d$loading, "loading3d.qs");
      fileNm <- paste0("spectra_3d_loading.json");
      
      my.json.scatter(fileNm, T);
      
    }
    
    if (nrow(df) < 30) {
      if (length(unique(sample_idx)) > 9) {
        col.fun <-
          grDevices::colorRampPalette(RColorBrewer::brewer.pal(12, "Set3"));

        p <-
          ggplot2::ggplot(df, aes_string(
            x = "PC1",
            y = "PC2",
            color = "group",
            label = "row.names(df)"
          )) +
          geom_text_repel(force = 1.5) + 
          geom_point(size = 5,  fill = col.fun(length(unique(sample_idx)))) + 
          theme(axis.text = element_text(size = 12))

      } else{
        p <-
          ggplot2::ggplot(df, aes_string(
            x = "PC1",
            y = "PC2",
            color = "group",
            label = "row.names(df)"
          )) +
          geom_text_repel(force = 1.5) + 
          geom_point(size = 5) + 
          scale_color_brewer(palette = "Set1") + 
          theme(axis.text = element_text(size = 12))
      }

    } else {
      if (length(unique(sample_idx)) > 9) {
        p <-
          ggplot2::ggplot(df, aes_string(x = "PC1",
                                  y = "PC2",
                                  color = "group")) + geom_point(size = 5)

      } else{
        p <-
          ggplot2::ggplot(df, aes_string(x = "PC1",
                                  y = "PC2",
                                  color = "group")) + geom_point(size = 5) + scale_color_brewer(palette = "Set1");
      }
    }

    p <-
      p + xlab(xlabel) + ylab(ylabel) + theme_bw() + theme(axis.title = element_text(size = 12));

    print(p)
    
    if (.on.public.web()) {
      dev.off()
    }
  }


#' @title PlotSpectraRTadj
#' @description This function is used to plot the adjustment of retention time of all spectra
#' @param mSet mSet object, usually generated after the peakannotaion finished here.
#' @param imgName Character, to give the name of BPI figures ploted.
#' @param format Character, to give the format of BPI figures ploted. Can be "jpeg", "png", "pdf", "svg",
#'  "tiff" or "ps". Default is "png".
#' @param dpi Numeric, to define the dpi of the figures. Default is 72.
#' @param width Numeric, to define the width of the figure. Height = width * 0.618. 
#' @return will return a figure of spectral adjustment of retention time
#' @export
#' @import RColorBrewer
#' @importFrom Cairo Cairo
#' @importFrom graphics points
#' @examples 
#' data(mSet);
#' newPath <- dir(system.file("mzData", package = "mtbls2"),
#'                full.names = TRUE, recursive = TRUE)[c(10, 11, 12)]
#' mSet <- updateRawSpectraPath(mSet, newPath);
#' PlotSpectraRTadj(mSet);

PlotSpectraRTadj <-
  function(mSet = NULL,
           imgName,
           format = "png",
           dpi = 72,
           width = NA) {
    
    if(is.null(mSet) & .on.public.web()){
      load("mSet.rda")
    } else if(is.null(mSet)) {
      stop("mSet is missing!")
    }
    
    sample_idx <- mSet@rawOnDisk@phenoData@data[["sample_group"]];
    
    if(mSet@params$BlankSub & any(sample_idx == "BLANK")){
      sample_idx <- sample_idx[sample_idx != "BLANK"];
      
      specdata0 <- mSet@rawOnDisk;
      blk2rms <- which(specdata0@phenoData@data[["sample_group"]] == "BLANK");
      fdnew <- specdata0@featureData
      fdnew@data <- fdnew@data[!(fdnew@data[["fileIdx"]] %in% blk2rms),];
      #fdnew@data[["fileIdx"]] <- fdnew@data[["fileIdx"]] - length(blk2rms)
      ii <- 1;
      for(fii in unique(fdnew@data[["fileIdx"]])){
        fdnew@data[["fileIdx"]][fdnew@data[["fileIdx"]] == fii] <- ii;
        ii <- ii + 1
      }
      
      pdnew <- specdata0@phenoData;
      pdnew@data <- pdnew@data[-blk2rms,];
      
      numfiles <- length(specdata0@experimentData@instrumentModel) - length(blk2rms)

      specdata <- new(
        "OnDiskMSnExp",
        processingData = new("MSnProcess",
                             files = specdata0@processingData@files[-blk2rms]),
        featureData = fdnew,
        phenoData = pdnew,
        experimentData = new("MIAPE",
                             instrumentManufacturer = rep("a",numfiles),
                             instrumentModel = rep("a",numfiles),
                             ionSource = rep("a",numfiles),
                             analyser = rep("a",numfiles),
                             detectorType = rep("a",numfiles)))
      
    } else {
      specdata <-  mSet@rawOnDisk;
    }
    
    if (.on.public.web()) {
      Cairo::Cairo(
        file = imgName,
        unit = "in",
        dpi = dpi,
        width = width,
        height = width * 0.75,
        type = format,
        bg = "white"
      )
    }
    
    if (length(unique(sample_idx)) > 9) {
      col.fun <-
        grDevices::colorRampPalette(RColorBrewer::brewer.pal(12, "Set3"))
      group_colors <- col.fun(length(unique(sample_idx)))
    } else{
      group_colors <-
        paste0(RColorBrewer::brewer.pal(9, "Set1")[seq_along(unique(sample_idx))], "60")
    }
    
    names(group_colors) <- unique(sample_idx)
    
    ## Extract RT information
    rt.set <-
      list(rtime(specdata), unlist(mSet@peakRTcorrection$adjustedRT))
    
    diffRt <- rt.set[[2]] - rt.set[[1]]
    diffRt <- split(diffRt, fromFile(specdata))
    xRt <- mSet@peakRTcorrection$adjustedRT
    col = group_colors[sample_idx]
    lty = 1
    lwd = 1
    col <- rep(col, length(diffRt))
    lty <- rep(lty, length(diffRt))
    lwd <- rep(lwd, length(diffRt))
    ylim <- range(diffRt, na.rm = TRUE)
    
    plot(
      3,
      3,
      pch = NA,
      xlim = range(xRt, na.rm = TRUE),
      ylim = ylim,
      xlab = "RT_Adjustment",
      ylab = "RT_Difference"
    )
    
    for (i in seq_along(diffRt)) {
      points(
        x = xRt[[i]],
        y = diffRt[[i]],
        col = col[i],
        lty = lty[i],
        type = "l",
        lwd = lwd[i]
      )
    }
    
    rawRt <-
      split(rtime(specdata), fromFile(specdata))
    
    adjRt <- xRt
    
    ####
    peaks_0 <- mSet@peakfilling$msFeatureData$chromPeaks;
    subs <-
      seq_along(specdata@phenoData@data[["sample_name"]]);
    ####
    pkGroup <- mSet@peakRTcorrection[["pkGrpMat_Raw"]];
    ####
    
    rawRt <- rawRt[subs]
    adjRt <- adjRt[subs]
    ## Have to "adjust" these for peakgroup only:
    pkGroupAdj <- pkGroup
    if (!is.null(pkGroup)) {
      for (i in seq_len(ncol(pkGroup))){
        pkGroupAdj[, i] <-
          .applyRtAdjustment(pkGroup[, i], rawRt[[i]], adjRt[[i]])
      }
      
      diffRt <- pkGroupAdj - pkGroup
      xRt <- pkGroupAdj
      
      ## Loop through the rows and plot points - ordered by diffRt!
      for (i in seq_len(nrow(xRt))){
        idx <- order(diffRt[i, ])
        points(
          x = xRt[i, ][idx],
          diffRt[i, ][idx],
          col = "#00000080",
          type = "b",
          pch = 16,
          lty = 3
        )
      }
      
    }
    
    legend(
      "topright",
      legend = unique(sample_idx),
      pch = 15,
      col = group_colors
    )
    
    if (.on.public.web()) {
      dev.off()
    }
  }


#' @title PlotSpectraBPIadj
#' @description This function is used to plot the adjust BPI (Base Peak Ion)
#' @param mSet mSet object, usually generated after the peakannotaion finished here.
#' @param imgName Character, to give the name of BPI figures ploted.
#' @param format Character, to give the format of BPI figures ploted. Can be "jpeg", "png", "pdf", "svg",
#'  "tiff" or "ps". Default is "png".
#' @param dpi Numeric, to define the dpi of the figures. Default is 72.
#' @param width Numeric, to define the width of the figure. Height = width * 0.618. 
#' @return will return a figure of adjusted BPIs
#' @export
#' @import RColorBrewer
#' @importFrom Cairo Cairo
#' @examples 
#' data(mSet);
#' newPath <- dir(system.file("mzData", package = "mtbls2"),
#'                full.names = TRUE, recursive = TRUE)[c(10, 11, 12)]
#' mSet <- updateRawSpectraPath(mSet, newPath);
#' PlotSpectraBPIadj(mSet);

PlotSpectraBPIadj <-
  function(mSet = NULL,
           imgName,
           format = "png",
           dpi = 72,
           width = NA) {
    
    if(is.null(mSet) & .on.public.web()){
      load("mSet.rda")
    } else if(is.null(mSet)) {
      stop("mSet is missing!")
    }
    
    if (.on.public.web()) {
      Cairo::Cairo(
        file = imgName,
        unit = "in",
        dpi = dpi,
        width = width,
        height = width * 0.75,
        type = format,
        bg = "white"
      )
    }
    
    sample_idx <-
      mSet@rawOnDisk@phenoData@data[["sample_group"]];
    
    if(mSet@params$BlankSub & any(sample_idx == "BLANK")){
      sample_idx <- sample_idx[sample_idx != "BLANK"];
      
      specdata0 <- mSet@rawOnDisk;
      blk2rms <- which(specdata0@phenoData@data[["sample_group"]] == "BLANK");
      fdnew <- specdata0@featureData
      fdnew@data <- fdnew@data[!(fdnew@data[["fileIdx"]] %in% blk2rms),];
      #fdnew@data[["fileIdx"]] <- fdnew@data[["fileIdx"]] - length(blk2rms)
      ii <- 1;
      for(fii in unique(fdnew@data[["fileIdx"]])){
        fdnew@data[["fileIdx"]][fdnew@data[["fileIdx"]] == fii] <- ii;
        ii <- ii + 1
      }
      
      pdnew <- specdata0@phenoData;
      pdnew@data <- pdnew@data[-blk2rms,];
      
      numfiles <- length(specdata0@experimentData@instrumentModel) - length(blk2rms)
      
      object_od <- new(
        "OnDiskMSnExp",
        processingData = new("MSnProcess",
                             files = specdata0@processingData@files[-blk2rms]),
        featureData = fdnew,
        phenoData = pdnew,
        experimentData = new("MIAPE",
                             instrumentManufacturer = rep("a",numfiles),
                             instrumentModel = rep("a",numfiles),
                             ionSource = rep("a",numfiles),
                             analyser = rep("a",numfiles),
                             detectorType = rep("a",numfiles)))
      
      
    } else {
      object_od <- mSet@rawOnDisk;
    }
    sample_idx <- as.factor(sample_idx);
    
    if (length(unique(sample_idx)) > 9) {
      col.fun <-
        grDevices::colorRampPalette(RColorBrewer::brewer.pal(12, "Set3"))
      group_colors <- col.fun(length(unique(sample_idx)))
      
    } else{
      group_colors <-
        paste0(RColorBrewer::brewer.pal(9, "Set1")[seq_along(unique(sample_idx))], "60")
    }
    
    group_colors2 <- group_colors
    names(group_colors2) <- unique(sample_idx)
    
    group_colors <-
      sapply(
        seq(length(levels(sample_idx))),
        FUN = function(x) {
          rep(group_colors[x], length(sample_idx[sample_idx == levels(sample_idx)[x]]))
        }
      )
    
    #object_od <- mSet@rawOnDisk
    adj_rt <- unlist(mSet@peakRTcorrection$adjustedRT)
    
    object_od <- selectFeatureData(
      object_od,
      fcol = c(
        "fileIdx",
        "spIdx",
        "seqNum",
        "acquisitionNum",
        "msLevel",
        "polarity",
        "retentionTime",
        "precursorScanNum"
      )
    )
    object_od@featureData$retentionTime <- adj_rt
    
    res <- MSnbase::chromatogram(
      object_od,
      aggregationFun = "max",
      missing = NA_real_,
      msLevel = 1L,
      BPPARAM = MulticoreParam(4)
    )
    
    plot(res, col = as.character(unlist(group_colors)))
    
    legend(
      "topright",
      legend = unique(sample_idx),
      pch = 15,
      col = group_colors2
    )
    
    if (.on.public.web()) {
      dev.off()
    }
}

#' @title plotMSfeature
#' @description plotMSfeature is used to plot the feature intensity of different groups
#' @param mSet mSet Object, should be processed aby 'PerformPeakProfiling'.
#' @param FeatureNM Numeric, feature number in the feature table.
#' @param dpi Numeric, to define the dpi of the figures. Default is 72. (only works for web version)
#' @param format Character, to give the format of BPI figures ploted. Can be "jpeg", "png", "pdf", "svg",
#'  "tiff" or "ps". Default is "png". (only works for web version)
#' @param width Numeric, width of the figure (default is NA, usually set it as 6~12)
#' @export
#' @return will return a figure of ms stats
#' @import RColorBrewer
#' @importFrom Cairo Cairo
#' @examples 
#' data(mSet);
#' newPath <- dir(system.file("mzData", package = "mtbls2"),
#'                full.names = TRUE, recursive = TRUE)[c(10, 11, 12)]
#' mSet <- updateRawSpectraPath(mSet, newPath);
#' plotMSfeature (mSet, 1); # Here is only one group

plotMSfeature <- function(mSet = NULL, 
                          FeatureNM = 1,
                          dpi = 72,
                          format = "png",
                          width = NA) {
  
  if(is.null(mSet)){
    if(.on.public.web()){
      load("mSet.rda")
    } else {
      stop("No mSet Object found !")
    }
  }

  peakdata <- mSet@peakAnnotation$camera_output;
  peakdata1 <-
    peakdata[, c((-1):-6,-ncol(peakdata),-ncol(peakdata) + 1,-ncol(peakdata) + 2,
                 -ncol(peakdata) + 3, -ncol(peakdata) + 4, -ncol(peakdata) + 5)]
  
  peakdata1[is.na(peakdata1)] <- 0
  
  group_info <- mSet@dataSet[c(1),-1]
  
  data_table <-
    as.data.frame(t(rbind(
      round(as.numeric(peakdata1[FeatureNM,]), 1), as.character(as.matrix(group_info))
    )))
  
  data_table[, 1] <- as.numeric(data_table[, 1])
  colnames(data_table) <- c("value", "Group")
  rownames(data_table) <- NULL
  
  if(is.na(width)){
    width = 6;
    title = paste0(round(peakdata[FeatureNM, 1], 4), "mz@", round(peakdata[FeatureNM, 4], 2), "s")
  } else {
    title = paste0(round(peakdata[FeatureNM, 1], 4), "mz@", round(peakdata[FeatureNM, 4], 2), "s_", dpi, "_", width)
  }
  
  if (.on.public.web()) {
    Cairo::Cairo(
      file = paste0(title, ".", format),
      unit = "in",
      dpi = dpi,
      width = width,
      height = width/6*6.18,
      type = format,
      bg = "white"
    )
  }
    
  p1 <-
    ggplot(data_table, aes_string(
      x = "Group",
      y = "log2(value + 1)",
      fill = "Group"
    )) + # geom_violin(trim = TRUE,draw_quantiles = TRUE) +
    stat_boxplot(geom = "errorbar", width = 0.15, aes(color = "black")) +
    geom_boxplot(
      size = 0.35,
      width = 0.5,
      fill = "white",
      outlier.fill = "white",
      outlier.color = "white"
    ) +
    geom_jitter(aes_string(fill = "Group"),
                width = 0.2,
                shape = 21,
                size = 2.5) +
    scale_color_manual(
      values = c(
        "black",
        "black",
        "black",
        "black",
        "black",
        "black",
        "black",
        "black",
        "black",
        "black",
        "black",
        "black",
        "black"
      )
    ) +
    theme_bw() +
    theme(
      legend.position = "none",
      axis.text.x = element_text(
        #family = "Arial",
        size = 12,
        angle = 45,
        hjust = 1
      ),
      axis.text.y = element_text(
        #family = "Arial",
        size = 12,
        face = "plain"
      ),
      axis.title.y = element_text(
        #family = "Arial",
        size = 16,
        face = "plain"
      ),
      axis.title.x = element_text(
        #family = "Arial",
        size = 16,
        face = "plain"
      ),
      plot.title = element_text(
        #family = "Arial",
        size = 16,
        face = "bold",
        hjust = 0.5
      )
    ) +
    ylab(expression(log[2] ~ intensity)) + xlab("Groups") + ggtitle(title)
  
  print(p1)
  
  if (.on.public.web()) {
    dev.off()
    return(paste0(title, ".", format))
  }
}

#' @title plotSingleTIC
#' @description plotSingleTIC is used to plot the TIC of a certain spectra
#' @param mSet mSet Object, should be processed by ImportMSData.
#' @param filename Character, to give the filename for the TIC plotting.
#' @param imagename Character, to give the filename of the TIC plotted. (only works for web version)
#' @param dpi Numeric, dpi of the figure (default is 72, usually set it as 72, 144, 360)
#' @param width Numeric, width of the figure (default is 7, usually set it as 6~12)
#' @param format Character, format of the figure (default is 'png', usually can be 'png', 'pdf','tiff','svg','eps','jpg')
#' @export
#' @return will return a figure of a single TIC
#' @importFrom Cairo Cairo
#' @examples
#' data(mSet);
#' newPath <- dir(system.file("mzData", package = "mtbls2"),
#'                full.names = TRUE, recursive = TRUE)[c(10, 11, 12)]
#' mSet <- updateRawSpectraPath(mSet, newPath);
#' plotSingleTIC(mSet, "MSpos-Ex2-Col0-48h-Ag-2_1-A,3_01_9829.mzData", 
#'               "MSpos-Ex2-Col0-48h-Ag-2_1-A,3_01_9829.png")

plotSingleTIC <- function(mSet = NULL, 
                          filename, 
                          imagename, 
                          dpi = 72, 
                          width = 7, 
                          format = "png") {
  
  if(is.null(mSet)){
    if(.on.public.web()){
      load("mSet.rda");
    } else {
      stop("No mSet found !")
    }
  }
  
  AllFileNMs <- sub(pattern = "(.*)\\..*$", replacement = "\\1", basename(mSet@rawOnDisk@processingData@files));
  file_order <-
    which(filename == AllFileNMs)
  
  raw_data_filt <-
    filterFile(mSet@rawOnDisk, file = file_order);
  
  tics <- chromatogram(raw_data_filt, aggregationFun = "sum", MulticoreParam(4));

  if (.on.public.web()) {
    Cairo::Cairo(
      file = imagename,
      unit = "in",
      dpi = dpi,
      width = width,
      height = width/7*5,
      type = format,
      bg = "white"
    )
  }
  
  plot(tics, col = "#0080FF", main = filename);
  
  if (.on.public.web()) {
    dev.off()
  }
}

#' @title plotTICs
#' @description plotTICs is used to plot the TIC of all files
#' @param mSet mSet Object, should be processed by ImportMSData.
#' @param imgName Character, to name the imgName for the TIC plotting.
#' @param dpi Numeric, to define the dpi of the figures. Default is 72. (only works for web version)
#' @param format Character, to give the format of BPI figures ploted. Can be "jpeg", "png", "pdf", "svg",
#'  "tiff" or "ps". Default is "png". (only works for web version)
#' @param width Numeric, width of the figure (default is NA, usually set it as 6~12)
#' @export
#' @return will return a figure of TICs
#' @importFrom Cairo Cairo
#' @import RColorBrewer
#' @examples
#' newPath <- dir(system.file("mzData", package = "mtbls2"), 
#' full.names = TRUE, recursive = TRUE)[c(10:12)]
#' data(mSet)
#' mSet <- updateRawSpectraPath(mSet, newPath)
#' plotTICs(mSet)
plotTICs <-function(mSet = NULL,
                   imgName,
                   format = "png",
                   dpi = 72,
                   width = NA){
  tics <- NULL;
  #need to extract the plotting part from import function
  if(is.null(mSet) & !.on.public.web()){
    load("mSet.rda")
    raw_data_filt <- mSet@rawOnDisk;
  } else if(!.on.public.web() & (is(mSet, "mSet"))) {
    raw_data_filt <- mSet@rawOnDisk;
    tics <- chromatogram(raw_data_filt, aggregationFun = "sum", MulticoreParam(4))
  } else if(.on.public.web()) {
    load("raw_data_filt.rda");
    load("tics.rda");
  } else if(is.null(mSet)) {
    stop("mSet is missing!")
  }
  
  samplegroup <- raw_data_filt@phenoData@data$sample_group;
  samplename <- raw_data_filt@phenoData@data$sample_name;
  
  groupInfo <-as.factor(samplegroup);
  groupNum <- nlevels(groupInfo)
  
  if (groupNum > 9) {
    col.fun <-
      grDevices::colorRampPalette(RColorBrewer::brewer.pal(12, "Set3"))
    group_colors <- col.fun(groupNum)
    
  } else{
    group_colors <-
      paste0(RColorBrewer::brewer.pal(9, "Set1")[seq_len(groupNum)], "60")
  }
  
  names(group_colors) <- levels(groupInfo)
  if (.on.public.web()) {
    Cairo::Cairo(
      file = imgName,
      unit = "in",
      dpi = dpi,
      width = width,
      height = width* 0.75,
      type = format,
      bg = "white"
    )
  }
  
  plot(tics, col = group_colors[raw_data_filt$sample_group])
  legend(
    "topright",
    legend = levels(groupInfo),
    pch = 15,
    col = group_colors
  )
  
  if (.on.public.web()) {
    dev.off()
  }

}

#' @title plotBPIs
#' @description plotBPIs is used to plot the BPI of all files
#' @param mSet mSet Object, should be processed by ImportMSData.
#' @param imgName Character, to give the filename for the TIC plotting.
#' @param dpi Numeric, to define the dpi of the figures. Default is 72. (only works for web version)
#' @param format Character, to give the format of BPI figures ploted. Can be "jpeg", "png", "pdf", "svg",
#'  "tiff" or "ps". Default is "png". (only works for web version)
#' @param width Numeric, width of the figure (default is NA, usually set it as 6~12)
#' @export
#' @import RColorBrewer
#' @importFrom Cairo Cairo
#' @return will return a figure of BPIs
#' @examples
#' newPath <- dir(system.file("mzData", package = "mtbls2"), 
#' full.names = TRUE, recursive = TRUE)[c(10:12)]
#' data(mSet)
#' mSet <- updateRawSpectraPath(mSet, newPath)
#' plotBPIs(mSet)
plotBPIs <-function(mSet = NULL,
                    imgName,
                    format = "png",
                    dpi = 72,
                    width = NA){
  bpis <- NULL;
  #need to extract the plotting part from import function
  if(is.null(mSet) & !.on.public.web()){
    load("mSet.rda")
    raw_data_filt <- mSet@rawOnDisk;
  } else if(!.on.public.web() & (is(mSet, "mSet"))) {
    raw_data_filt <- mSet@rawOnDisk;
    bpis <- chromatogram(raw_data_filt, aggregationFun = "max", MulticoreParam(4))
  } else if(.on.public.web()) {
    load("raw_data_filt.rda");
    load("bpis.rda");
  } else if(is.null(mSet)) {
    stop("mSet is missing!")
  }
  
  samplegroup <- raw_data_filt@phenoData@data$sample_group;
  samplename <- raw_data_filt@phenoData@data$sample_name;
  
  groupInfo <-as.factor(samplegroup);
  groupNum <- nlevels(groupInfo)
  
  if (groupNum > 9) {
    col.fun <-
      grDevices::colorRampPalette(RColorBrewer::brewer.pal(12, "Set3"))
    group_colors <- col.fun(groupNum)
    
  } else{
    group_colors <-
      paste0(RColorBrewer::brewer.pal(9, "Set1")[seq_len(groupNum)], "60")
  }
  
  names(group_colors) <- levels(groupInfo)
  if (.on.public.web()) {
    Cairo::Cairo(
      file = imgName,
      unit = "in",
      dpi = dpi,
      width = width,
      height = width* 0.75,
      type = format,
      bg = "white"
    )
  }
  
  plot(bpis, col = group_colors[raw_data_filt$sample_group])
  legend(
    "topright",
    legend = levels(groupInfo),
    pch = 15,
    col = group_colors
  )
  
  if (.on.public.web()) {
    dev.off()
  }
}




my.json.scatter <- function(filenm, containsLoading=F){
  library(igraph);
  res <- qs::qread("score3d.qs")
  nodes <- vector(mode="list");
  names <- res$name;
  if(ncol(res$xyz) > nrow(res$xyz)){
    orig.pos.xyz <- t(res$xyz);
  }else{
    orig.pos.xyz <- res$xyz;
  }
  ticksX <- pretty(range(orig.pos.xyz[,1]*1.2),10, bound=F);
  ticksY <- pretty(range(orig.pos.xyz[,2]*1.2),10, bound=F);
  ticksZ <- pretty(range(orig.pos.xyz[,3]*1.2),10, bound=F);
  #add two nodes, 1 with all min values and another with all max values. For scaling purposes
  minNode <-  c(min(ticksX), min(ticksY), min(ticksZ));
  maxNode <-  c(max(ticksX), max(ticksY), max(ticksZ));
  # Add the new rows to the data frame
  orig.pos.xyz.mod <- rbind(orig.pos.xyz, minNode)
  orig.pos.xyz.mod <- rbind(orig.pos.xyz.mod, maxNode)
  #scaling
  pos.xyz <- orig.pos.xyz.mod;
  pos.xyz[,1] <- scale_range(orig.pos.xyz.mod[,1], -1,1);
  pos.xyz[,2] <- scale_range(orig.pos.xyz.mod[,2], -1,1);
  pos.xyz[,3] <- scale_range(orig.pos.xyz.mod[,3], -1,1);
  #remove last two rows
  pos.xyz <- pos.xyz[1:(nrow(pos.xyz) - 2), ]
  metadf <- res$facA
  if(!is.factor(metadf)){
    metadf <- as.factor(metadf);
  }
  col = vector();
  meta.vec = as.vector(metadf)
  meta.vec.num = as.integer(as.factor(metadf))
  col.s <- res$colors
  for(i in 1:length(meta.vec.num)){
    col[i] = col.s[meta.vec.num[i]];
  }
  legendData <- list(label=levels(metadf),color=col.s)
  #for IPCA in multifactor
  if("facB" %in% names(res)){
    meta.vec2 <- res$facB
    metadf <- res$metadata_list;
    shape <- vector();
    meta.vec.num <- as.integer(as.factor(meta.vec2))
    shape.s <- c("circle", "triangle", "square", "diamond")[1:length(unique(meta.vec2))];
    for(i in 1:length(meta.vec.num)){
      shape[i] = shape.s[meta.vec.num[i]];
    }
    legendData2 <- list(label=unique(meta.vec2),shape=shape.s);
  }
  nodeSize = 18;
  for(i in 1:length(names)){
    nodes[[i]] <- list(
      id=names[i],
      label=names[i],
      size=nodeSize,
      meta=meta.vec[i],
      fx = unname(pos.xyz[i,1])*1000,
      fy = unname(pos.xyz[i,2])*1000,
      fz = unname(pos.xyz[i,3])*1000,
      origX = unname(orig.pos.xyz[i,1]),
      origY = unname(orig.pos.xyz[i,2]),
      origZ = unname(orig.pos.xyz[i,3]),
      colorb=col[i]
    );
    if("facB" %in% names(res)){
      nodes[[i]][["meta2"]] <- meta.vec2[i]
      nodes[[i]][["shape"]] <- shape[i]
    }
  }
  ticks <- list(x=ticksX, y=ticksY, z=ticksZ);
  library(RJSONIO)
  if(!containsLoading){
    netData <- list(nodes=nodes,
                    edges="NA",
                    meta=metadf,
                    loading="NA",
                    axis=res$axis,
                    ticks=ticks,
                    metaCol = legendData);
  }else{
    res2 <- qs::qread("loading3d.qs");
    if(ncol(res2$xyz) > nrow(res2$xyz)){
      orig.load.xyz <- t(res2$xyz);
    }else{
      orig.load.xyz <- res2$xyz;
    }
    ticksX <- pretty(range(orig.load.xyz[,1]),10);
    ticksY <- pretty(range(orig.load.xyz[,2]),10);
    ticksZ <- pretty(range(orig.load.xyz[,3]),10);
    #add two nodes, 1 with all min values and another with all max values. For scaling purposes
    minNode <-  c(min(ticksX), min(ticksY), min(ticksZ));
    maxNode <-  c(max(ticksX), max(ticksY), max(ticksZ));
    # Add the new rows to the data frame
    orig.load.xyz.mod <- rbind(orig.load.xyz, minNode)
    orig.load.xyz.mod <- rbind(orig.load.xyz.mod, maxNode)
    load.xyz <- orig.load.xyz.mod;
    load.xyz[,1] <- scale_range(orig.load.xyz.mod[,1], -1,1);
    load.xyz[,2] <- scale_range(orig.load.xyz.mod[,2], -1,1);
    load.xyz[,3] <- scale_range(orig.load.xyz.mod[,3], -1,1);
    #remove last two rows
    load.xyz <- load.xyz[1:(nrow(load.xyz) - 2), ];
    names <- res2$name;
    if("entrez" %in% names(res2)){
      ids <- res2$entrez;
    }else{
      ids <- res2$name;
    }
    colres <- rgba_to_hex_opacity(res2$cols);
    colorb <- colres[[1]];
    opacity_array <- colres[[2]];
    nodes2 <- vector(mode="list");
    for(i in 1:length(names)){
      nodes2[[i]] <- list(
        id=ids[i],
        label=names[i],
        size=24,
        opacity=opacity_array[i],
        fx = unname(load.xyz[i,1])*1000,
        fy = unname(load.xyz[i,2])*1000,
        fz = unname(load.xyz[i,3])*1000,
        origX = unname(orig.load.xyz[i,1]),
        origY = unname(orig.load.xyz[i,2]),
        origZ = unname(orig.load.xyz[i,3]),
        seedArr = "notSeed",
        colorb=colorb[i],
        colorw=colorb[i]
      );
    }
    ticksLoading <- list(x=ticksX, y=ticksY, z=ticksZ);
    netData <- list(omicstype="",
                    nodes=nodes,
                    meta=metadf,
                    loading=nodes2,
                    misc="", ticks=ticks,
                    ticksLoading=ticksLoading,
                    axis=res$axis,
                    axisLoading=res2$axis,
                    metaCol = legendData);
  }
  if("facB" %in% names(res)){
    netData$metaShape <- legendData2;
  }
  rownames(pos.xyz) <- res$name;
  res$pos.xyz <- pos.xyz;
  .set.rdt.set(res);
  sink(filenm);
  cat(toJSON(netData));
  sink();
  return(1);
}



# Define a function to convert RGBA to Hex and opacity values
rgba_to_hex_opacity <- function(rgba_array) {
  # Define an empty vector to store the hex color values
  hex_values <- vector("character", length = length(rgba_array))
  # Define an empty vector to store the opacity values
  opacity_values <- vector("numeric", length = length(rgba_array))
  # Loop through each element in the input array
  for (i in seq_along(rgba_array)) {
    rgba <- rgba_array[i]
    rgba <- gsub("rgba\\(", "",rgba);
    rgba <- gsub("\\)", "",rgba);
    # Convert the RGBA value to a list of numeric values
    rgba <- strsplit(rgba, ",")[[1]]
    rgba <- as.numeric(rgba)
    # Convert the RGB values to hexadecimal notation
    hex <- rgb(rgba[1], rgba[2], rgba[3], maxColorValue = 255)
    hex_values[i] <- hex
    # Extract the opacity value from the RGBA string
    opacity_values[i] <- rgba[4]
  }
  # Return a list containing the hex color values and opacity values
  return(list(hex_values = hex_values, opacity_values = opacity_values))
}

scale_range <- function(x, new_min = 0, new_max = 1) {
  range <- pretty(x,10);
  old_min <- min(range);
  old_max <- max(range);
  (x - old_min) / (old_max - old_min) * (new_max - new_min) + new_min
}

ComputeEncasing <- function(filenm, type, names.vec, level=0.95, omics="NA"){
  level <- as.numeric(level)
  names = strsplit(names.vec, "; ")[[1]]
  res <- .get.rdt.set();
  res <- res$pos.xyz
  pos.xyz <- res
  inx = rownames(pos.xyz) %in% names;
  coords = as.matrix(pos.xyz[inx,c(1:3)])
  mesh = list()
  if(type == "alpha"){
    library(alphashape3d)
    library(rgl)
    sh=ashape3d(coords, 1.0, pert = FALSE, eps = 1e-09);
    mesh[[1]] = as.mesh3d(sh, triangles=T);
  }else if(type == "ellipse"){
    library(rgl);
    pos=cov(coords, y = NULL, use = "everything");
    mesh[[1]] = ellipse3d(x=as.matrix(pos), level=level);
  }else{
    library(ks);
    res=kde(coords);
    r = plot(res, cont=level*100, display="rgl");
    sc = scene3d();
    mesh = sc$objects;
  }
  library(RJSONIO);
  sink(filenm);
  cat(toJSON(mesh));
  sink();
  return(filenm);
}

.get.rdt.set <- function(){
  return(qs::qread("rdt.set.qs"));
}

.set.rdt.set <- function(my.set){
  qs::qsave(my.set, file="rdt.set.qs");
}
xia-lab/OptiLCMS documentation built on March 27, 2024, 11:11 a.m.