R/RcppExports.R

Defines functions otherChildXICpp getChildXICpp splineFillCpp doAffineAlignmentCpp doAlignmentCpp alignChromatogramsCpp getAlignedTimesCpp sgolayCpp areaIntegrator getBaseGapPenaltyCpp constrainSimCpp getGlobalAlignMaskCpp getChromSimMatCpp getSeqSimMatCpp

Documented in alignChromatogramsCpp areaIntegrator doAffineAlignmentCpp doAlignmentCpp getAlignedTimesCpp getBaseGapPenaltyCpp getChildXICpp getChromSimMatCpp getGlobalAlignMaskCpp getSeqSimMatCpp otherChildXICpp sgolayCpp splineFillCpp

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' Calculates similarity matrix for two sequences
#'
#' @author Shubham Gupta, \email{shubh.gupta@mail.utoronto.ca}
#' ORCID: 0000-0003-3500-8152
#' License: (c) Author (2019) + MIT
#' Date: 2019-03-05
#' @param seq1 (char) A single string.
#' @param seq2 (char) A single string.
#' @param match (double) Score for character match.
#' @param misMatch (double) score for character mismatch.
#' @return s (matrix) Numeric similarity matrix. Rows and columns expresses seq1 and seq2, respectively.
#' @examples
#' # Get sequence similarity of two DNA strings
#' Match=10; MisMatch=-2
#' seq1 = "GCAT"; seq2 = "CAGTG"
#' getSeqSimMatCpp(seq1, seq2, Match, MisMatch)
#' matrix(c(-2, 10, -2, -2, -2, -2, 10, -2, 10, -2, -2, -2, -2, -2, -2, 10, 10, -2, -2, -2),
#'  4, 5, byrow = FALSE)
#' @export
getSeqSimMatCpp <- function(seq1, seq2, match, misMatch) {
    .Call(`_DIAlignR_getSeqSimMatCpp`, seq1, seq2, match, misMatch)
}

#' Calculates similarity matrix of two fragment-ion chromatogram groups or extracted-ion chromatograms(XICs)
#'
#' @author Shubham Gupta, \email{shubh.gupta@mail.utoronto.ca}
#' ORCID: 0000-0003-3500-8152
#' License: (c) Author (2019) + MIT
#' Date: 2019-03-05
#' @param l1 (list) A list of vectors. Length should be same as of l2.
#' @param l2 (list) A list of vectors. Length should be same as of l1.
#' @param normalization (char) A character string. Normalization must be selected from (L2, mean or none).
#' @param simType (char) A character string. Similarity type must be selected from (dotProductMasked, dotProduct, cosineAngle, cosine2Angle, euclideanDist, covariance, correlation, crossCorrelation).\cr
#' Mask = s > quantile(s, dotProdThresh)\cr
#' AllowDotProd= [Mask × cosine2Angle + (1 - Mask)] > cosAngleThresh\cr
#' s_new= s × AllowDotProd
#' @param cosAngleThresh (numeric) In simType = dotProductMasked mode, angular similarity should be higher than cosAngleThresh otherwise similarity is forced to zero.
#' @param dotProdThresh (numeric) In simType = dotProductMasked mode, values in similarity matrix higher than dotProdThresh quantile are checked for angular similarity.
#' @param kerLen (integer) In simType = crossCorrelation, length of the kernel used to sum similarity score. Must be an odd number.
#' @return s (matrix) Numeric similarity matrix. Rows and columns expresses seq1 and seq2, respectively.
#' @examples
#' # Get similarity matrix of dummy chromatograms
#' r1 <- list(c(1.0,3.0,2.0,4.0), c(0.0,0.0,0.0,1.0), c(4.0,4.0,4.0,5.0))
#' r2 <- list(c(1.4,2.0,1.5,4.0), c(0.0,0.5,0.0,0.0), c(2.0,3.0,4.0,0.9))
#' round(getChromSimMatCpp(r1, r2, "L2", "dotProductMasked"), 3)
#' matrix(c(0.125, 0.162, 0.144, 0.208, 0.186, 0.240,
#' 0.213, 0.313, 0.233, 0.273, 0.253, 0.346, 0.101, 0.208, 0.154, 0.273), 4, 4, byrow = FALSE)
#'
#' round(getChromSimMatCpp(r1, r2, "L2", "dotProduct"), 3)
#' matrix(c(0.125, 0.162, 0.144, 0.208, 0.186,0.240, 0.213, 0.313, 0.233,
#' 0.273, 0.253, 0.346, 0.101, 0.208, 0.154, 0.273), 4, 4, byrow = FALSE)
#'
#' round(getChromSimMatCpp(r1, r2, "L2", "cosineAngle"), 3)
#' matrix(c(0.934, 0.999, 0.989, 0.986, 0.933, 0.989,
#'  0.983, 0.996, 0.994, 0.960, 0.995, 0.939, 0.450,
#'  0.761, 0.633, 0.772), 4, 4, byrow = FALSE)
#'
#' round(getChromSimMatCpp(r1, r2, "L2", "cosine2Angle"), 3)
#' matrix(c(0.744, 0.998, 0.957, 0.944, 0.740, 0.956, 0.932,
#' 0.985, 0.974, 0.842, 0.978, 0.764, -0.596, 0.158,
#' -0.200, 0.190), 4, 4, byrow = FALSE)
#'
#' round(getChromSimMatCpp(r1, r2, "mean", "euclideanDist"), 3)
#' matrix(c(0.608, 0.614, 0.680, 0.434, 0.530, 0.742,
#' 0.659, 0.641, 0.520, 0.541, 0.563, 0.511, 0.298,
#' 0.375, 0.334, 0.355), 4, 4, byrow = FALSE)
#'
#' round(getChromSimMatCpp(r1, r2, "L2", "covariance"), 3)
#' matrix(c(0.025, 0.028, 0.027, 0.028, 0.032, 0.034,
#' 0.033, 0.034, 0.055, 0.051, 0.053, 0.051,
#' -0.004, 0.028, 0.012, 0.028), 4, 4, byrow = FALSE)
#'
#' round(getChromSimMatCpp(r1, r2, "L2", "correlation"), 3)
#' matrix(c(0.874, 0.999, 0.974, 0.999, 0.923, 0.986, 0.993,
#' 0.986, 0.991, 0.911, 0.990, 0.911, -0.065, 0.477,
#' 0.214, 0.477), 4, 4, byrow = FALSE)
#' @export
getChromSimMatCpp <- function(l1, l2, normalization, simType, cosAngleThresh = 0.3, dotProdThresh = 0.96, kerLen = 9L) {
    .Call(`_DIAlignR_getChromSimMatCpp`, l1, l2, normalization, simType, cosAngleThresh, dotProdThresh, kerLen)
}

#' Outputs a mask for constraining similarity matrix
#'
#' This function takes in timeVectors from both runs, global-fit mapped values
#' of end-points of first time vector and sample-length of window of no constraining.
#' Outside of window, all elements of matrix are either equally weighted or weighted
#' proportional to distance from window-boundry.
#'
#' @author Shubham Gupta, \email{shubh.gupta@mail.utoronto.ca}
#' ORCID: 0000-0003-3500-8152
#' License: (c) Author (2019) + MIT
#' Date: 2019-03-08
#' @param tA (numeric) A numeric vector. This vector has equally spaced timepoints of XIC A.
#' @param tB (numeric) A numeric vector. This vector has equally spaced timepoints of XIC B.
#' @param B1p (numeric) Timepoint mapped by global fit for tA[1].
#' @param B2p (numeric) Timepoint mapped by global fit for tA[length(tA)].
#' @param noBeef (integer) It defines the distance from the global fit, upto which no penalization is performed.\cr
#' The window length = 2*noBeef.
#' @param hardConstrain (logical) if false; indices farther from noBeef distance are filled with distance from linear fit line.
#' @return mask (matrix) A numeric matrix.
#' @examples
#' tA <- c(3353.2, 3356.6, 3360.0, 3363.5)
#' tB <- c(3325.9, 3329.3, 3332.7, 3336.1)
#' B1p <- 3325.751; B2p <- 3336.119
#' noBeef <- 1
#' mask <- getGlobalAlignMaskCpp(tA, tB, B1p, B2p, noBeef, FALSE)
#' round(mask, 3)
#' matrix(c(0.000, 0.000, 0.707, 1.414, 0.000, 0.000, 0.000, 0.707, 0.707, 0.000,
#' 0.000, 0.000, 1.414, 0.707, 0.000, 0.000), 4, 4, byrow = FALSE)
#' @export
getGlobalAlignMaskCpp <- function(tA, tB, B1p, B2p, noBeef = 50L, hardConstrain = FALSE) {
    .Call(`_DIAlignR_getGlobalAlignMaskCpp`, tA, tB, B1p, B2p, noBeef, hardConstrain)
}

#' Constrain similarity matrix with a mask
#'
#' @author Shubham Gupta, \email{shubh.gupta@mail.utoronto.ca}
#' ORCID: 0000-0003-3500-8152
#' License: (c) Author (2019) + MIT
#' Date: 2019-03-08
#' @param sim (matrix) A numeric matrix. Input similarity matrix.
#' @param MASK (matrix) A numeric matrix. Masked indices have non-zero values.
#' @param samples4gradient (numeric) This paarameter modulates penalization of masked indices.
#' @return s_new (matrix) A constrained similarity matrix.
#' @examples
#' sim <- matrix(c(-2, 10, -2, -2, -2, -2, 10, -2, 10, -2, -2, -2, -2, -2, -2, 10, 10, -2,-2, -2),
#'  4, 5, byrow = FALSE)
#' MASK <- matrix(c(0.000, 0.000, 0.707, 1.414, 0.000, 0.000, 0.000, 0.707, 0.707, 0.000,
#' 0.000, 0.000, 1.414, 0.707, 0, 0, 2.121, 1.414, 0, 0), 4, 5, byrow = FALSE)
#' constrainSimCpp(sim, MASK, 10)
#' matrix(c(-2, 10, -3.414, -4.828, -2, -2, 10, -3.414, 8.586, -2, -2, -2, -4.828,
#' -3.414, -2, 10, 5.758, -4.828, -2, -2), 4, 5, byrow = FALSE)
#' @export
constrainSimCpp <- function(sim, MASK, samples4gradient = 100.0) {
    .Call(`_DIAlignR_constrainSimCpp`, sim, MASK, samples4gradient)
}

#' Calculates gap penalty for dynamic programming based alignment.
#'
#' This function outputs base gap-penalty depending on SimType used. In case of getting base gap-penalty
#' from similarity matrix distribution, gapQuantile will be used to pick the value.
#'
#' @author Shubham Gupta, \email{shubh.gupta@mail.utoronto.ca}
#' ORCID: 0000-0003-3500-8152
#' License: (c) Author (2019) + MIT
#' Date: 2019-03-08
#' @param sim (matrix) A numeric matrix. Input similarity matrix.
#' @param SimType (char) A character string. Similarity type must be selected from (dotProductMasked, dotProduct, cosineAngle, cosine2Angle, euclideanDist, covariance, correlation, crossCorrelation).
#' @param gapQuantile (numeric) Must be between 0 and 1.
#' @return baseGapPenalty (numeric).
#' @examples
#' sim <- matrix(c(-12, 1.0, 12, -2.3, -2, -2, 1.07, -2, 1.80, 2, 22, 42, -2, -1.5, -2, 10), 4, 4,
#'  byrow = FALSE)
#' getBaseGapPenaltyCpp(sim, "dotProductMasked", 0.5) # -0.25
#' @export
getBaseGapPenaltyCpp <- function(sim, SimType, gapQuantile = 0.5) {
    .Call(`_DIAlignR_getBaseGapPenaltyCpp`, sim, SimType, gapQuantile)
}

#' Calculates area between signal-boundaries.
#'
#' This function sums all the intensities between left-index and right-index.
#'
#' @author Shubham Gupta, \email{shubh.gupta@mail.utoronto.ca}
#' ORCID: 0000-0003-3500-8152
#' License: (c) Author (2019) + MIT
#' Date: 2019-03-08
#' @param l1 (list) A list of time vectors.
#' @param l2 (list) A list of intensity vectors.
#' @param left (numeric) left boundary of the peak.
#' @param right (numeric) right boundary of the peak.
#' @param integrationType (string) method to ompute the area of a peak contained in XICs. Must be
#'  from "intensity_sum", "trapezoid", "simpson".
#' @param baselineType (string) method to estimate the background of a peak contained in XICs. Must be
#'  from "base_to_base", "vertical_division_min", "vertical_division_max".
#' @param fitEMG (logical) enable/disable exponentially modified gaussian peak model fitting.
#' @param baseSubtraction (logical) TRUE: remove background from peak signal using estimated noise levels.
#' @return area (numeric).
#' @examples
#' data("XIC_QFNNTDIVLLEDFQK_3_DIAlignR", package = "DIAlignR")
#' XICs <- XIC_QFNNTDIVLLEDFQK_3_DIAlignR[["hroest_K120809_Strep0%PlasmaBiolRepl2_R04_SW_filt"]][["4618"]]
#' l1 <- lapply(XICs, `[[`, 1)
#' l2 <- lapply(XICs, `[[`, 2)
#' areaIntegrator(l1, l2, left = 5203.7, right = 5268.5, "intensity_sum", "base_to_base", FALSE, TRUE)
#' # 66.10481 69.39996 46.53095 16.34266 13.13564 13.42331
#' @export
areaIntegrator <- function(l1, l2, left, right, integrationType, baselineType, fitEMG, baseSubtraction) {
    .Call(`_DIAlignR_areaIntegrator`, l1, l2, left, right, integrationType, baselineType, fitEMG, baseSubtraction)
}

#' Smooth chromatogram with savitzky-golay filter.
#'
#'
#' @author Shubham Gupta, \email{shubh.gupta@mail.utoronto.ca}
#' ORCID: 0000-0003-3500-8152
#' License: (c) Author (2020) + MIT
#' Date: 2019-12-31
#' @param chrom (matrix) chromatogram containing time and intensity vectors.
#' @param kernelLen (integer) length of filter. Must be an odd number.
#' @param polyOrd (integer) TRUE: remove background from peak signal using estimated noise levels.
#' @return (matrix).
#' @examples
#' data("XIC_QFNNTDIVLLEDFQK_3_DIAlignR", package = "DIAlignR")
#' XICs <- XIC_QFNNTDIVLLEDFQK_3_DIAlignR[["hroest_K120809_Strep0%PlasmaBiolRepl2_R04_SW_filt"]][["4618"]]
#' xic <- sgolayCpp(as.matrix(XICs[[1]]), kernelLen = 11L, polyOrd = 4L)
#' @export
sgolayCpp <- function(chrom, kernelLen, polyOrd) {
    .Call(`_DIAlignR_sgolayCpp`, chrom, kernelLen, polyOrd)
}

#' Get aligned indices from MS2 extracted-ion chromatograms(XICs) pair.
#'
#' @author Shubham Gupta, \email{shubh.gupta@mail.utoronto.ca}
#' ORCID: 0000-0003-3500-8152
#' License: (c) Author (2019) + MIT
#' Date: 2019-03-08
#' @param l1 (list) A list of numeric matrix of two columns. l1 and l2 should have same length.
#' @param l2 (list) A list of numeric matrix of two columns. l1 and l2 should have same length.
#' @param kernelLen (integer) length of filter. Must be an odd number.
#' @param polyOrd (integer) TRUE: remove background from peak signal using estimated noise levels.
#' @param alignType (char) A character string. Available alignment methods are "global", "local" and "hybrid".
#' @param adaptiveRT (numeric) Similarity matrix is not penalized within adaptive RT.
#' @param normalization (char) A character string. Normalization must be selected from (L2, mean or none).
#' @param simType (char) A character string. Similarity type must be selected from (dotProductMasked, dotProduct, cosineAngle, cosine2Angle, euclideanDist, covariance, correlation, crossCorrelation).\cr
#' Mask = s > quantile(s, dotProdThresh)\cr
#' AllowDotProd= [Mask × cosine2Angle + (1 - Mask)] > cosAngleThresh\cr
#' s_new= s × AllowDotProd
#' @param B1p (numeric) Timepoint mapped by global fit for tA[1].
#' @param B2p (numeric) Timepoint mapped by global fit for tA[length(tA)].
#' @param goFactor (numeric) Penalty for introducing first gap in alignment. This value is multiplied by base gap-penalty.
#' @param geFactor (numeric) Penalty for introducing subsequent gaps in alignment. This value is multiplied by base gap-penalty.
#' @param cosAngleThresh (numeric) In simType = dotProductMasked mode, angular similarity should be higher than cosAngleThresh otherwise similarity is forced to zero.
#' @param OverlapAlignment (logical) An input for alignment with free end-gaps. False: Global alignment, True: overlap alignment.
#' @param dotProdThresh (numeric) In simType = dotProductMasked mode, values in similarity matrix higher than dotProdThresh quantile are checked for angular similarity.
#' @param gapQuantile (numeric) Must be between 0 and 1. This is used to calculate base gap-penalty from similarity distribution.
#' @param kerLen (integer) In simType = crossCorrelation, length of the kernel used to sum similarity score. Must be an odd number.
#' @param hardConstrain (logical) if false; indices farther from noBeef distance are filled with distance from linear fit line.
#' @param samples4gradient (numeric) This parameter modulates penalization of masked indices.
#' @return NumericMatrix Aligned indices of l1 and l2.
#' @examples
#' data(XIC_QFNNTDIVLLEDFQK_3_DIAlignR, package="DIAlignR")
#' XICs <- XIC_QFNNTDIVLLEDFQK_3_DIAlignR
#' XICs.ref <- lapply(XICs[["hroest_K120809_Strep0%PlasmaBiolRepl2_R04_SW_filt"]][["4618"]], as.matrix)
#' XICs.eXp <- lapply(XICs[["hroest_K120809_Strep10%PlasmaBiolRepl2_R04_SW_filt"]][["4618"]], as.matrix)
#' B1p <- 4964.752
#' B2p <- 5565.462
#' time <- getAlignedTimesCpp(XICs.ref, XICs.eXp, 11, 4, alignType = "hybrid", adaptiveRT = 77.82315,
#'  normalization = "mean", simType = "dotProductMasked", B1p = B1p, B2p = B2p,
#'  goFactor = 0.125, geFactor = 40, cosAngleThresh = 0.3, OverlapAlignment = TRUE,
#'  dotProdThresh = 0.96, gapQuantile = 0.5, hardConstrain = FALSE, samples4gradient = 100)
#' @export
getAlignedTimesCpp <- function(l1, l2, kernelLen, polyOrd, alignType, adaptiveRT, normalization, simType, B1p = 0.0, B2p = 0.0, goFactor = 0.125, geFactor = 40, cosAngleThresh = 0.3, OverlapAlignment = TRUE, dotProdThresh = 0.96, gapQuantile = 0.5, kerLen = 9L, hardConstrain = FALSE, samples4gradient = 100.0) {
    .Call(`_DIAlignR_getAlignedTimesCpp`, l1, l2, kernelLen, polyOrd, alignType, adaptiveRT, normalization, simType, B1p, B2p, goFactor, geFactor, cosAngleThresh, OverlapAlignment, dotProdThresh, gapQuantile, kerLen, hardConstrain, samples4gradient)
}

#' Aligns MS2 extracted-ion chromatograms(XICs) pair.
#'
#' @author Shubham Gupta, \email{shubh.gupta@mail.utoronto.ca}
#' ORCID: 0000-0003-3500-8152
#' License: (c) Author (2019) + MIT
#' Date: 2019-03-08
#' @param l1 (list) A list of numeric vectors. l1 and l2 should have same length.
#' @param l2 (list) A list of numeric vectors. l1 and l2 should have same length.
#' @param alignType (char) A character string. Available alignment methods are "global", "local" and "hybrid".
#' @param tA (numeric) A numeric vector. This vector has equally spaced timepoints of XIC A.
#' @param tB (numeric) A numeric vector. This vector has equally spaced timepoints of XIC B.
#' @param normalization (char) A character string. Normalization must be selected from (L2, mean or none).
#' @param simType (char) A character string. Similarity type must be selected from (dotProductMasked, dotProduct, cosineAngle, cosine2Angle, euclideanDist, covariance, correlation, crossCorrelation).\cr
#' Mask = s > quantile(s, dotProdThresh)\cr
#' AllowDotProd= [Mask × cosine2Angle + (1 - Mask)] > cosAngleThresh\cr
#' s_new= s × AllowDotProd
#' @param B1p (numeric) Timepoint mapped by global fit for tA[1].
#' @param B2p (numeric) Timepoint mapped by global fit for tA[length(tA)].
#' @param noBeef (integer) It defines the distance from the global fit, upto which no penalization is performed.\cr
#' The window length = 2*noBeef.
#' @param goFactor (numeric) Penalty for introducing first gap in alignment. This value is multiplied by base gap-penalty.
#' @param geFactor (numeric) Penalty for introducing subsequent gaps in alignment. This value is multiplied by base gap-penalty.
#' @param cosAngleThresh (numeric) In simType = dotProductMasked mode, angular similarity should be higher than cosAngleThresh otherwise similarity is forced to zero.
#' @param OverlapAlignment (logical) An input for alignment with free end-gaps. False: Global alignment, True: overlap alignment.
#' @param dotProdThresh (numeric) In simType = dotProductMasked mode, values in similarity matrix higher than dotProdThresh quantile are checked for angular similarity.
#' @param gapQuantile (numeric) Must be between 0 and 1. This is used to calculate base gap-penalty from similarity distribution.
#' @param kerLen (integer) In simType = crossCorrelation, length of the kernel used to sum similarity score. Must be an odd number.
#' @param hardConstrain (logical) if false; indices farther from noBeef distance are filled with distance from linear fit line.
#' @param samples4gradient (numeric) This parameter modulates penalization of masked indices.
#' @param objType (char) A character string. Must be either light, medium or heavy.
#' @return affineAlignObj (S4class) A S4class object from C++ AffineAlignObj struct.
#' @examples
#' data(XIC_QFNNTDIVLLEDFQK_3_DIAlignR, package="DIAlignR")
#' XICs <- XIC_QFNNTDIVLLEDFQK_3_DIAlignR
#' data(oswFiles_DIAlignR, package="DIAlignR")
#' oswFiles <- oswFiles_DIAlignR
#' XICs.ref <- XICs[["hroest_K120809_Strep0%PlasmaBiolRepl2_R04_SW_filt"]][["4618"]]
#' XICs.eXp <- XICs[["hroest_K120809_Strep10%PlasmaBiolRepl2_R04_SW_filt"]][["4618"]]
#' tVec.ref <- XICs.ref[[1]][["time"]] # Extracting time component
#' tVec.eXp <- XICs.eXp[[1]][["time"]] # Extracting time component
#' B1p <- 4964.752
#' B2p <- 5565.462
#' noBeef <- 77.82315/3.414
#' l1 <- lapply(XICs.ref, `[[`, 2)
#' l2 <- lapply(XICs.eXp, `[[`, 2)
#' AlignObj <- alignChromatogramsCpp(l1, l2, alignType = "hybrid", tA = tVec.ref, tB = tVec.eXp,
#'  normalization = "mean", simType = "dotProductMasked", B1p = B1p, B2p = B2p, noBeef = noBeef,
#'  goFactor = 0.125, geFactor = 40, cosAngleThresh = 0.3, OverlapAlignment = TRUE,
#'  dotProdThresh = 0.96, gapQuantile = 0.5, hardConstrain = FALSE, samples4gradient = 100,
#'  objType = "light")
#' @export
alignChromatogramsCpp <- function(l1, l2, alignType, tA, tB, normalization, simType, B1p = 0.0, B2p = 0.0, noBeef = 0L, goFactor = 0.125, geFactor = 40, cosAngleThresh = 0.3, OverlapAlignment = TRUE, dotProdThresh = 0.96, gapQuantile = 0.5, kerLen = 9L, hardConstrain = FALSE, samples4gradient = 100.0, objType = "heavy") {
    .Call(`_DIAlignR_alignChromatogramsCpp`, l1, l2, alignType, tA, tB, normalization, simType, B1p, B2p, noBeef, goFactor, geFactor, cosAngleThresh, OverlapAlignment, dotProdThresh, gapQuantile, kerLen, hardConstrain, samples4gradient, objType)
}

#' Perform non-affine global and overlap alignment on a similarity matrix
#'
#' @author Shubham Gupta, \email{shubh.gupta@mail.utoronto.ca}
#' ORCID: 0000-0003-3500-8152
#' License: (c) Author (2019) + MIT
#' Date: 2019-03-08
#' @param sim (NumericMatrix) A numeric matrix with similarity values of two sequences or signals.
#' @param gap (double) Penalty for introducing gaps in alignment.
#' @param OverlapAlignment (logical) An input for alignment with free end-gaps. False: Global alignment, True: overlap alignment.
#' @return AlignObj (S4class) An object from C++ class of AlignObj.
#' @examples
#' # Get sequence similarity of two DNA strings
#' Match=10; MisMatch=-2
#' seq1 = "GCAT"; seq2 = "CAGTG"
#' s <- getSeqSimMatCpp(seq1, seq2, Match, MisMatch)
#' obj_Global <- doAlignmentCpp(s, 22, FALSE)
#' slot(obj_Global, "score") # -2 -4 -6 4 -18
#' obj_Olap <- doAlignmentCpp(s, 22, TRUE)
#' slot(obj_Olap, "score") # 0 10 20 18 18 18
#'
#' Match=1; MisMatch=-1
#' seq1 = "TTTC"; seq2 = "TGC"
#' s <- getSeqSimMatCpp(seq1, seq2, Match, MisMatch)
#' obj_Global <- doAlignmentCpp(s, 2, FALSE)
#' slot(obj_Global, "optionalPaths")
#' matrix(data = c(1,1,1,1,1,1,1,1,1,2,1,2,1,3,3,1,1,3,6,3), nrow = 5, ncol =4, byrow = TRUE)
#' slot(obj_Global, "M_forw")
#' matrix(data = c(0,-2,-4,-6,-2,-7,-22,-45,-4,-20,-72,-184,-6,-41,-178,-547,-8,-72,-366,-1274),
#'  nrow = 5, ncol =4, byrow = TRUE)
#' @export
doAlignmentCpp <- function(sim, gap, OverlapAlignment) {
    .Call(`_DIAlignR_doAlignmentCpp`, sim, gap, OverlapAlignment)
}

#' Perform affine global and overlap alignment on a similarity matrix
#'
#' @author Shubham Gupta, \email{shubh.gupta@mail.utoronto.ca}
#' ORCID: 0000-0003-3500-8152
#' License: (c) Author (2019) + MIT
#' Date: 2019-03-08
#' @param sim (NumericMatrix) A numeric matrix with similarity values of two sequences or signals.
#' @param go (numeric) Penalty for introducing first gap in alignment.
#' @param ge (numeric) Penalty for introducing subsequent gaps in alignment.
#' @param OverlapAlignment (logical) An input for alignment with free end-gaps. False: Global alignment, True: overlap alignment.
#' @return affineAlignObj (S4class) An object from C++ class of AffineAlignObj.
#' @examples
#' # Get sequence similarity of two DNA strings
#' Match=10; MisMatch=-2
#' seq1 = "GCAT"; seq2 = "CAGTG"
#' s <- getSeqSimMatCpp(seq1, seq2, Match, MisMatch)
#' objAffine_Global <- doAffineAlignmentCpp(s, 22, 7, FALSE)
#' slot(objAffine_Global, "score") # -2  -4  -6  4 -18
#' objAffine_Olap <- doAffineAlignmentCpp(s, 22, 7, TRUE)
#' slot(objAffine_Olap, "score") # 0 10 20 18 18 18
#'
#' Match=10; MisMatch=-2
#' seq1 = "CAT"; seq2 = "CAGTG"
#' s <- getSeqSimMatCpp(seq1, seq2, Match, MisMatch)
#' objAffine_Global <- doAffineAlignmentCpp(s, 22, 7, FALSE)
#' slot(objAffine_Global, "score") # 10  20  -2  -9 -11
#' objAffine_Olap <- doAffineAlignmentCpp(s, 22, 7, TRUE)
#' slot(objAffine_Olap, "score") # 10 20 18 18 18
#'
#' Match=10; MisMatch=-2
#' seq1 = "CA"; seq2 = "AG"
#' s <- getSeqSimMatCpp(seq1, seq2, Match, MisMatch)
#' objAffine_Global <- doAffineAlignmentCpp(s, 22, 7, FALSE)
#' slot(objAffine_Global, "simScore_forw") # -4
#' @export
doAffineAlignmentCpp <- function(sim, go, ge, OverlapAlignment) {
    .Call(`_DIAlignR_doAffineAlignmentCpp`, sim, go, ge, OverlapAlignment)
}

#' Interpolate using spline
#'
#' @author Shubham Gupta, \email{shubh.gupta@mail.utoronto.ca}
#' ORCID: 0000-0003-3500-8152
#' License: (c) Author (2021) + MIT
#' Date: 2021-01-06
#' @param x (numeric) A numeric matrix with similarity values of two sequences or signals.
#' @param y (numeric) Penalty for introducing first gap in alignment.
#' @param xout (numeric) Penalty for introducing subsequent gaps in alignment.
#' @return (numeric)
#' @examples
#' time <- seq(from = 3003.4, to = 3048, by = 3.4)
#' y <- c(0.2050595, 0.8850070, 2.2068768, 3.7212677, 5.1652605, 5.8288915, 5.5446804,
#'        4.5671360, 3.3213154, 1.9485889, 0.9520709, 0.3294218, 0.2009581, 0.1420923)
#' y[c(1,6)] <- NA_real_
#' idx <- !is.na(y)
#' splineFillCpp(time[idx], y[idx], time[!idx])
#' zoo::na.spline(zoo::zoo(y[idx], time[idx]), xout = time[!idx], method = "natural")
#' @export
splineFillCpp <- function(x, y, xout) {
    .Call(`_DIAlignR_splineFillCpp`, x, y, xout)
}

#' Get child chromatogram from two parent chromatogram
#'
#' @author Shubham Gupta, \email{shubh.gupta@mail.utoronto.ca}
#' ORCID: 0000-0003-3500-8152
#' License: (c) Author (2021) + MIT
#' Date: 2021-01-08
#' @inheritParams getAlignedTimesCpp
#' @inheritParams childXIC
#' @return (List) of chromatograms and their aligned time vectors.
#' @examples
#' data(XIC_QFNNTDIVLLEDFQK_3_DIAlignR, package="DIAlignR")
#' XICs <- XIC_QFNNTDIVLLEDFQK_3_DIAlignR
#' XICs.ref <- lapply(XICs[["hroest_K120809_Strep0%PlasmaBiolRepl2_R04_SW_filt"]][["4618"]], as.matrix)
#' XICs.eXp <- lapply(XICs[["hroest_K120809_Strep10%PlasmaBiolRepl2_R04_SW_filt"]][["4618"]], as.matrix)
#' B1p <- 4964.752
#' B2p <- 5565.462
#' chrom <- getChildXICpp(XICs.ref, XICs.eXp, 11L, 4L, alignType = "hybrid", adaptiveRT = 77.82315,
#'  normalization = "mean", simType = "dotProductMasked", B1p = B1p, B2p = B2p,
#'  goFactor = 0.125, geFactor = 40, cosAngleThresh = 0.3, OverlapAlignment = TRUE,
#'  dotProdThresh = 0.96, gapQuantile = 0.5, hardConstrain = FALSE, samples4gradient = 100,
#'  wRef = 0.5, keepFlanks= TRUE)
#' @export
getChildXICpp <- function(l1, l2, kernelLen, polyOrd, alignType, adaptiveRT, normalization, simType, B1p = 0.0, B2p = 0.0, goFactor = 0.125, geFactor = 40, cosAngleThresh = 0.3, OverlapAlignment = TRUE, dotProdThresh = 0.96, gapQuantile = 0.5, kerLen = 9L, hardConstrain = FALSE, samples4gradient = 100.0, wRef = 0.5, splineMethod = "natural", mergeStrategy = "avg", keepFlanks = TRUE) {
    .Call(`_DIAlignR_getChildXICpp`, l1, l2, kernelLen, polyOrd, alignType, adaptiveRT, normalization, simType, B1p, B2p, goFactor, geFactor, cosAngleThresh, OverlapAlignment, dotProdThresh, gapQuantile, kerLen, hardConstrain, samples4gradient, wRef, splineMethod, mergeStrategy, keepFlanks)
}

#' Get child chromatogram for other precursors using main precursor alignment
#'
#' @author Shubham Gupta, \email{shubh.gupta@mail.utoronto.ca}
#' ORCID: 0000-0003-3500-8152
#' License: (c) Author (2021) + MIT
#' Date: 2021-01-08
#' @inheritParams getChildXICpp
#' @param mat (matrix) aligned time and child time from the main precursor.
#' @param childTime (numeric) iime vector from the child chromatogram.
#' @return (List) of chromatograms.
#' @examples
#' data(XIC_QFNNTDIVLLEDFQK_3_DIAlignR, package="DIAlignR")
#' XICs <- XIC_QFNNTDIVLLEDFQK_3_DIAlignR
#' XICs.ref <- lapply(XICs[["hroest_K120809_Strep0%PlasmaBiolRepl2_R04_SW_filt"]][["4618"]], as.matrix)
#' XICs.eXp <- lapply(XICs[["hroest_K120809_Strep10%PlasmaBiolRepl2_R04_SW_filt"]][["4618"]], as.matrix)
#' B1p <- 4964.752
#' B2p <- 5565.462
#' chrom <- getChildXICpp(XICs.ref, XICs.eXp, 11L, 4L, alignType = "hybrid", adaptiveRT = 77.82315,
#'  normalization = "mean", simType = "dotProductMasked", B1p = B1p, B2p = B2p,
#'  goFactor = 0.125, geFactor = 40, cosAngleThresh = 0.3, OverlapAlignment = TRUE,
#'  dotProdThresh = 0.96, gapQuantile = 0.5, hardConstrain = FALSE, samples4gradient = 100,
#'  wRef = 0.5, keepFlanks= TRUE)
#' chrom2 <- otherChildXICpp(XICs.ref, XICs.eXp, 11L, 4L, chrom[[2]], chrom[[1]][[1]][,1],
#' 0.5, "natural")
#' @export
otherChildXICpp <- function(l1, l2, kernelLen, polyOrd, mat, childTime, wRef = 0.5, splineMethod = "natural") {
    .Call(`_DIAlignR_otherChildXICpp`, l1, l2, kernelLen, polyOrd, mat, childTime, wRef, splineMethod)
}
Roestlab/DIAlign documentation built on Feb. 25, 2021, 5:18 p.m.