From 33c904bf3bc4fde5e23e70e5edb804a3b9680711 Mon Sep 17 00:00:00 2001 From: Sergey Kucheryavskiy Date: Wed, 22 Apr 2015 10:02:33 +0200 Subject: [PATCH] v. 0.6.2 --- DESCRIPTION | 4 +- NEWS | 5 +++ R/ldecomp.R | 68 +++++++++++++++++----------------- R/mdaplots.R | 18 +++++---- R/pca.R | 36 +++++++++--------- R/pls.R | 32 ++++++++-------- R/plsda.R | 2 +- R/plsres.R | 2 +- R/simca.R | 40 ++++++++++---------- R/simcam.R | 10 ++--- R/simcamres.R | 32 ++++++++-------- R/simcares.R | 12 +++--- README.md | 2 +- man/ldecomp.Rd | 6 +-- man/ldecomp.getDistances.Rd | 4 +- man/ldecomp.getResLimits.Rd | 6 +-- man/ldecomp.getVariances.Rd | 4 +- man/pca.Rd | 8 ++-- man/pcares.Rd | 4 +- man/plotResiduals.ldecomp.Rd | 5 ++- man/plotResiduals.pca.Rd | 5 ++- man/plotResiduals.simcamres.Rd | 6 +-- man/plotResiduals.simcares.Rd | 6 +-- man/plotXResiduals.pls.Rd | 5 ++- man/plotXResiduals.plsres.Rd | 2 +- man/pls.Rd | 2 +- man/plsdares.Rd | 2 +- man/plsres.Rd | 2 +- man/simca.Rd | 6 +-- man/simca.classify.Rd | 2 +- man/simcam.Rd | 2 +- man/simcamres.Rd | 14 +++---- 32 files changed, 183 insertions(+), 171 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0de2a9d..eb59ad7 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: mdatools Title: Multivariate Data Analysis for Chemometrics -Version: 0.6.1 -Date: 2014-01-22 +Version: 0.6.2 +Date: 2014-04-22 Author: Sergey Kucheryavskiy Maintainer: Sergey Kucheryavskiy Description: Package implements projection based methods for preprocessing, exploring and analysis of multivariate data used in chemometrics. diff --git a/NEWS b/NEWS index ba9c5a4..c6cc459 100755 --- a/NEWS +++ b/NEWS @@ -1,3 +1,8 @@ +v.0.6.2 +======== +* Q2 residuals renamed to Q (Squared residual distance) +* All plots have parameters `lab.col` and `lab.cex` for changing color and font size for data point labels + v.0.6.1 ======== * fixed a bug led to incorrect calculation of specificity diff --git a/R/ldecomp.R b/R/ldecomp.R index 163b0c8..8170f02 100755 --- a/R/ldecomp.R +++ b/R/ldecomp.R @@ -19,8 +19,8 @@ #' number of selected components #' @param T2 #' matrix with calculated T2 values (e.g. for CV) -#' @param Q2 -#' matrix with calculated Q2 values (e.g. for CV) +#' @param Q +#' matrix with calculated Q statistic (e.g. for CV) #' @param cal #' logical, true if data is for calibration of a LDECOMP based model #' @@ -29,7 +29,7 @@ #' \item{scores }{matrix with score values (nobj x ncomp).} #' \item{residuals }{matrix with data residuals (nobj x nvar).} #' \item{T2 }{matrix with T2 distances (nobj x ncomp).} -#' \item{Q2 }{matrix with Q2 distances (nobj x ncomp).} +#' \item{Q }{matrix with Q statistic (nobj x ncomp).} #' \item{tnorm }{vector with singular values used for scores normalization.} #' \item{ncomp.selected }{selected number of components.} #' \item{expvar }{explained variance for each component.} @@ -48,7 +48,7 @@ #' ldecomp = function(scores = NULL, loadings = NULL, residuals = NULL, totvar, tnorm = NULL, ncomp.selected = NULL, - T2 = NULL, Q2 = NULL, cal = TRUE) + T2 = NULL, Q = NULL, cal = TRUE) { if (!is.null(scores)) { @@ -69,12 +69,12 @@ ldecomp = function(scores = NULL, loadings = NULL, residuals = NULL, obj$ncomp.selected = ncomp.selected # calculate residual distances and explained variance - if (is.null(Q2) && is.null(T2) && !is.null(scores) && !is.null(loadings) && !is.null(residuals)) + if (is.null(Q) && is.null(T2) && !is.null(scores) && !is.null(loadings) && !is.null(residuals)) { res = ldecomp.getDistances(scores, loadings, residuals, tnorm, cal) - if (is.null(Q2)) - obj$Q2 = res$Q2 + if (is.null(Q)) + obj$Q = res$Q if (is.null(T2)) obj$T2 = res$T2 @@ -86,12 +86,12 @@ ldecomp = function(scores = NULL, loadings = NULL, residuals = NULL, } else { - obj$Q2 = Q2 + obj$Q = Q obj$T2 = T2 obj$tnorm = tnorm } - var = ldecomp.getVariances(obj$Q2, totvar) + var = ldecomp.getVariances(obj$Q, totvar) obj$expvar = var$expvar obj$cumexpvar = var$cumexpvar @@ -105,7 +105,7 @@ ldecomp = function(scores = NULL, loadings = NULL, residuals = NULL, #' Residuals distances for linear decomposition #' #' @description -#' Computes residual distances (Q2 and T2) and modelling power for a data decomposition X = TP' + E. +#' Computes residual distances (Q and T2) and modelling power for a data decomposition X = TP' + E. #' #' @param scores #' matrix with scores (T). @@ -123,7 +123,7 @@ ldecomp = function(scores = NULL, loadings = NULL, residuals = NULL, #' (number of columns in scores and loadings). #' #' @return -#' Returns a list with Q2, Q2var, T2 and modelling power values for each component. +#' Returns a list with Q, Qvar, T2 and modelling power values for each component. #' ldecomp.getDistances = function(scores, loadings, residuals, tnorm = NULL, cal = TRUE) { @@ -132,7 +132,7 @@ ldecomp.getDistances = function(scores, loadings, residuals, tnorm = NULL, cal = nvar = nrow(loadings) T2 = matrix(0, nrow = nobj, ncol = ncomp) - Q2 = matrix(0, nrow = nobj, ncol = ncomp) + Q = matrix(0, nrow = nobj, ncol = ncomp) modpower = matrix(0, nrow = nvar, ncol = ncomp) # calculate normalized scores @@ -153,7 +153,7 @@ ldecomp.getDistances = function(scores, loadings, residuals, tnorm = NULL, cal = exp = scores[, 1:i, drop = F] %*% t(loadings[, 1:i, drop = F]); res = data - exp; - Q2[, i] = rowSums(res^2) + Q[, i] = rowSums(res^2) T2[, i] = rowSums(scoresn[, 1:i, drop = F]^2) if (nobj > i && cal == TRUE) @@ -161,12 +161,12 @@ ldecomp.getDistances = function(scores, loadings, residuals, tnorm = NULL, cal = } # set dimnames and return results - colnames(Q2) = colnames(T2) = colnames(modpower) = colnames(scores) - rownames(Q2) = rownames(T2) = rownames(scores) + colnames(Q) = colnames(T2) = colnames(modpower) = colnames(scores) + rownames(Q) = rownames(T2) = rownames(scores) rownames(modpower) = rownames(loadings) res = list( - Q2 = Q2, + Q = Q, T2 = T2, modpower = modpower, tnorm = tnorm @@ -179,17 +179,17 @@ ldecomp.getDistances = function(scores, loadings, residuals, tnorm = NULL, cal = #' @description #' Computes explained variance and cumulative explained variance for a data decomposition X = TP' + E. #' -#' @param Q2 -#' Q2 values (squared residuals distance from object to component space). +#' @param Q +#' Q values (squared residuals distance from object to component space). #' @param totvar #' Total variance of the original data (after preprocessing). #' #' @return #' Returns a list with two vectors. #' -ldecomp.getVariances = function(Q2, totvar) +ldecomp.getVariances = function(Q, totvar) { - cumresvar = colSums(Q2) / totvar * 100 + cumresvar = colSums(Q) / totvar * 100 cumexpvar = 100 - cumresvar expvar = c(cumexpvar[1], diff(cumexpvar)) @@ -199,10 +199,10 @@ ldecomp.getVariances = function(Q2, totvar) ) } -#' Statistical limits for Q2 and T2 residuals +#' Statistical limits for Q and T2 residuals #' #' @description -#' Computes statisticsl limits for Q2 and T2 residuals +#' Computes statisticsl limits for Q and T2 residuals #' #' @param eigenvals #' vector with eigenvalues @@ -217,7 +217,7 @@ ldecomp.getVariances = function(Q2, totvar) #' T2 limits are calculated using Hotelling statistics. #' #' @return -#' Returns a list with two vectors: \code{T2lim} and \code{Q2lim}. +#' Returns a list with two vectors: \code{T2lim} and \code{Qlim}. #' ldecomp.getResLimits = function(eigenvals, nobj, ncomp, alpha = 0.05) { @@ -230,8 +230,8 @@ ldecomp.getResLimits = function(eigenvals, nobj, ncomp, alpha = 0.05) T2lim[1, i] = (i * (nobj - 1) / (nobj - i)) * qf(1 - alpha, i, nobj - i); } - # calculate Q2 limit using F statistics - Q2lim = matrix(0, nrow = 1, ncol = ncomp) + # calculate Q limit using F statistics + Qlim = matrix(0, nrow = 1, ncol = ncomp) conflim = 100 - alpha * 100; nvar = length(eigenvals) @@ -253,16 +253,16 @@ ldecomp.getResLimits = function(eigenvals, nobj, ncomp, alpha = 0.05) ca = sqrt(2) * erfinv(cl/100) h1 = ca * sqrt(2 * t2 * h0^2)/t1 h2 = t2 * h0 * (h0 - 1)/(t1^2) - Q2lim[1, i] = t1 * (1 + h1 + h2)^(1/h0) + Qlim[1, i] = t1 * (1 + h1 + h2)^(1/h0) } else - Q2lim[1, i] = 0 + Qlim[1, i] = 0 } - colnames(T2lim) = colnames(Q2lim) = paste('Comp', 1:ncomp) + colnames(T2lim) = colnames(Qlim) = paste('Comp', 1:ncomp) res = list( T2lim = T2lim, - Q2lim = Q2lim + Qlim = Qlim ) } @@ -394,7 +394,7 @@ plotScores.ldecomp = function(obj, comp = c(1, 2), main = 'Scores', #' Residuals plot for linear decomposition #' #' @description -#' Shows a plot with T2 vs Q2 values for data objects. +#' Shows a plot with T2 vs Q values for data objects. #' #' @param obj #' object of \code{ldecomp} class. @@ -413,7 +413,7 @@ plotScores.ldecomp = function(obj, comp = c(1, 2), main = 'Scores', #' @param ... #' most of graphical parameters from \code{\link{mdaplot}} function can be used. #' -plotResiduals.ldecomp = function(obj, ncomp = NULL, main = NULL, xlab = 'T2', ylab = 'Q2', +plotResiduals.ldecomp = function(obj, ncomp = NULL, main = NULL, xlab = 'T2', ylab = 'Squared residual distance (Q)', show.labels = F, show.limits = T, ...) { if (is.null(main)) @@ -428,11 +428,11 @@ plotResiduals.ldecomp = function(obj, ncomp = NULL, main = NULL, xlab = 'T2', yl ncomp = obj$ncomp.selected if (show.limits == T) - show.lines = c(obj$T2lim[1, ncomp], obj$Q2lim[1, ncomp]) + show.lines = c(obj$T2lim[1, ncomp], obj$Qlim[1, ncomp]) else show.lines = F - data = cbind(obj$T2[, ncomp], obj$Q2[, ncomp]) + data = cbind(obj$T2[, ncomp], obj$Q[, ncomp]) colnames(data) = c(xlab, ylab) mdaplot(data, main = main, xlab = xlab, ylab = ylab, show.labels = show.labels, show.lines = show.lines, ...) @@ -465,7 +465,7 @@ print.ldecomp = function(x, str = NULL, ...) cat('\nMajor fields:\n') cat('$scores - matrix with score values\n') cat('$T2 - matrix with T2 distances\n') - cat('$Q2 - matrix with Q2 residuals\n') + cat('$Q - matrix with Q residuals\n') cat('$ncomp.selected - selected number of components\n') cat('$expvar - explained variance for each component\n') cat('$cumexpvar - cumulative explained variance\n') diff --git a/R/mdaplots.R b/R/mdaplots.R index 327b7c3..4080c8f 100755 --- a/R/mdaplots.R +++ b/R/mdaplots.R @@ -684,7 +684,8 @@ mdaplot = function(data, type = 'p', pch = 16, col = NULL, lty = 1, lwd = 1, bwd cgroup = NULL, xlim = NULL, ylim = NULL, colmap = 'default', labels = NULL, main = NULL, xlab = NULL, ylab = NULL, single.x = T, show.labels = F, show.colorbar = T, show.lines = F, show.grid = T, show.axes = T, - xticks = NULL, xticklabels = NULL, yticks = NULL, yticklabels = NULL, ...) + xticks = NULL, xticklabels = NULL, yticks = NULL, yticklabels = NULL, + lab.col = 'darkgray', lab.cex = 0.65, ...) { # Makes a plot for one series of data (scatter, line, scatterline, or bar). # @@ -713,7 +714,7 @@ mdaplot = function(data, type = 'p', pch = 16, col = NULL, lty = 1, lwd = 1, bwd # xticklabels: labels for x axis corresponding to x tick values # yticks: tick values for y axis # yticklabels: labels for y axis corresponding to y tick values - + # lab.col: color for data point labels data = as.matrix(data) if (is.null(dim(data)) || nrow(data) < 1) @@ -837,7 +838,7 @@ mdaplot = function(data, type = 'p', pch = 16, col = NULL, lty = 1, lwd = 1, bwd # show labels if needed if ((show.labels == T || !is.null(labels)) && type != 'e') - mdaplot.showLabels(data, type = type) + mdaplot.showLabels(data, type = type, col = lab.col, cex = lab.cex) # show lines if needed if (is.numeric(show.lines) && length(show.lines) == 2 ) @@ -852,7 +853,8 @@ mdaplotg = function(data, type = 'p', pch = 16, lty = 1, lwd = 1, bwd = 0.8, legend = NULL, xlab = NULL, ylab = NULL, main = NULL, labels = NULL, ylim = NULL, xlim = NULL, colmap = 'default', legend.position = 'topright', single.x = T, show.legend = T, show.labels = F, show.lines = F, show.grid = T, - xticks = NULL, xticklabels = NULL, yticks = NULL, yticklabels = NULL, ...) + xticks = NULL, xticklabels = NULL, yticks = NULL, yticklabels = NULL, + lab.col = 'darkgray', lab.cex = 0.65,...) { # Makes a group of plots for several data sets # @@ -987,7 +989,8 @@ mdaplotg = function(data, type = 'p', pch = 16, lty = 1, lwd = 1, bwd = 0.8, } mdaplot(data[[i]], type = type[i], col = col[i], pch = pch[i], lty = lty[i], - labels = slabels, show.grid = F, show.axes = F, show.labels = show.labels) + labels = slabels, show.grid = F, show.axes = F, show.labels = show.labels, + lab.col = lab.col, lab.cex = lab.cex) } } else @@ -1010,7 +1013,7 @@ mdaplotg = function(data, type = 'p', pch = 16, lty = 1, lwd = 1, bwd = 0.8, mdaplot(cbind(x, y), type = type[i], col = col[i], pch = pch[i], lty = lty[i], bwd = 0.9 * gbwd, labels = labels[, i], show.labels = show.labels, - show.grid = F, show.axes = F) + show.grid = F, show.axes = F, lab.col = lab.col, lab.cex = lab.cex) } } else @@ -1020,7 +1023,8 @@ mdaplotg = function(data, type = 'p', pch = 16, lty = 1, lwd = 1, bwd = 0.8, x = data[, 2 * i - 1, drop = F] y = data[, 2 * i, drop = F] mdaplot(cbind(x, y), type = type[i], col = col[i], pch = pch[i], lty = lty[i], - labels = labels[, i], show.grid = F, show.axes = F, show.labels = show.labels) + labels = labels[, i], show.grid = F, show.axes = F, show.labels = show.labels, + lab.col = lab.col, lab.cex = lab.cex) } } } diff --git a/R/pca.R b/R/pca.R index 88ffa52..7beda07 100755 --- a/R/pca.R +++ b/R/pca.R @@ -12,7 +12,7 @@ pca = function(x, ncomp = 15, center = T, scale = F, cv = NULL, x.test = NULL, # scale: logical, standardize or not data values # cv: number of segments for random cross-validation (1 - for full CV) # x.test: a matrix with data values for test set validation - # alpha: a significance level for Q2 residuals + # alpha: a significance level for Q residuals # method: method to estimate principal component space (only SVD is supported so far) # info: a short text with information about the model # @@ -49,10 +49,10 @@ pca = function(x, ncomp = 15, center = T, scale = F, cv = NULL, x.test = NULL, if (!is.null(x.test)) model$testres = predict.pca(model, x.test) - # calculate and assign limit values for T2 and Q2 residuals + # calculate and assign limit values for T2 and Q residuals lim = ldecomp.getResLimits(model$eigenvals, nrow(x), model$ncomp, model$alpha) model$T2lim = lim$T2lim - model$Q2lim = lim$Q2lim + model$Qlim = lim$Qlim model$call = match.call() class(model) = "pca" @@ -361,7 +361,7 @@ pca.crossval = function(model, x, cv, center = T, scale = F) nseg = nrow(idx); nrep = dim(idx)[3] - Q2 = matrix(0, ncol = ncomp, nrow = nobj) + Q = matrix(0, ncol = ncomp, nrow = nobj) T2 = matrix(0, ncol = ncomp, nrow = nobj) # loop over repetitions and segments @@ -379,21 +379,21 @@ pca.crossval = function(model, x, cv, center = T, scale = F) m = pca.cal(x.cal, ncomp, center, scale) res = predict.pca(m, x.val, cv = T) - Q2[ind, ] = Q2[ind, ] + res$Q2 + Q[ind, ] = Q[ind, ] + res$Q T2[ind, ] = T2[ind, ] + res$T2 } } } - Q2 = Q2 / nrep + Q = Q / nrep T2 = T2 / nrep - rownames(Q2) = rownames(T2) = rownames(x) - colnames(Q2) = colnames(T2) = colnames(model$scores) + rownames(Q) = rownames(T2) = rownames(x) + colnames(Q) = colnames(T2) = colnames(model$scores) # in CV results there are no scores only residuals and variances res = pcares(NULL, NULL, NULL, model$calres$totvar, model$tnorm, model$ncomp.selected, - T2, Q2) - res$Q2lim = model$Q2lim + T2, Q) + res$Qlim = model$Qlim res$T2lim = model$T2lim res @@ -426,7 +426,7 @@ predict.pca = function(object, x, cv = F, ...) { totvar = sum(x^2) res = pcares(scores, object$loadings, residuals, totvar, object$tnorm, object$ncomp.selected) - res$Q2lim = object$Q2lim + res$Qlim = object$Qlim res$T2lim = object$T2lim } else @@ -637,7 +637,7 @@ plotScores.pca = function(obj, comp = c(1, 2), type = 'p', main = 'Scores', xlab #' Residuals plot for PCA #' #' @description -#' Shows a plot with Q2 residuals vs. Hotelling T2 values for selected number of components. +#' Shows a plot with Q residuals vs. Hotelling T2 values for selected number of components. #' #' @param obj #' a PCA model (object of class \code{pca}) @@ -662,7 +662,7 @@ plotScores.pca = function(obj, comp = c(1, 2), type = 'p', main = 'Scores', xlab #' See examples in help for \code{\link{pca}} function. #' plotResiduals.pca = function(obj, ncomp = NULL, main = NULL, xlab = 'T2', - ylab = 'Q2', show.labels = F, show.legend = T, show.limits = T, ...) + ylab = 'Squared residual distance (Q)', show.labels = F, show.legend = T, show.limits = T, ...) { if (is.null(main)) { @@ -676,21 +676,21 @@ plotResiduals.pca = function(obj, ncomp = NULL, main = NULL, xlab = 'T2', ncomp = obj$ncomp.selected if (show.limits == T) - show.lines = c(obj$T2lim[1, ncomp], obj$Q2lim[1, ncomp]) + show.lines = c(obj$T2lim[1, ncomp], obj$Qlim[1, ncomp]) else show.lines = F if (ncomp > obj$ncomp || ncomp < 1) stop('Wrong number of components!') - cdata = cbind(obj$calres$T2[, ncomp], obj$calres$Q2[, ncomp]) + cdata = cbind(obj$calres$T2[, ncomp], obj$calres$Q[, ncomp]) rownames(cdata) = rownames(obj$calres$scores) legend = 'cal' data = list(cdata = cdata) if (!is.null(obj$cvres)) { - cvdata = cbind(obj$cvres$T2[, ncomp], obj$cvres$Q2[, ncomp]) + cvdata = cbind(obj$cvres$T2[, ncomp], obj$cvres$Q[, ncomp]) rownames(cvdata) = rownames(obj$cvres$T2) data$cvdata = cvdata legend = c(legend, 'cv') @@ -698,7 +698,7 @@ plotResiduals.pca = function(obj, ncomp = NULL, main = NULL, xlab = 'T2', if (!is.null(obj$testres)) { - tdata = cbind(obj$testres$T2[, ncomp], obj$testres$Q2[, ncomp]) + tdata = cbind(obj$testres$T2[, ncomp], obj$testres$Q[, ncomp]) rownames(tdata) = rownames(obj$testres$scores) data$tdata = tdata legend = c(legend, 'test') @@ -849,7 +849,7 @@ print.pca = function(x, ...) cat('$center - values for centering data\n') cat('$scale - values for scaling data\n') cat('$cv - number of segments for cross-validation\n') - cat('$alpha - significance level for Q2 residuals\n') + cat('$alpha - significance level for Q residuals\n') cat('$calres - results (scores, etc) for calibration set\n') if (!is.null(obj$cvres)) diff --git a/R/pls.R b/R/pls.R index 55e6c75..d28b3e6 100755 --- a/R/pls.R +++ b/R/pls.R @@ -16,7 +16,7 @@ pls = function(x, y, ncomp = 15, center = T, scale = F, cv = NULL, # x.test: a matrix with predictor values for test set validation # y.test: a vector with response values for test set validation # method: a method to calculate PLS model - # alpha: a sigificance limit for Q2 values + # alpha: a sigificance limit for Q values # info: a short string with information about the model # # Returns: @@ -337,9 +337,9 @@ pls.crossval = function(model, x, y, cv, center = T, scale = F, jack.knife = T) nrep = dim(idx)[3] yp = array(0, dim = c(nobj, ncomp, nresp)) - Q2x = matrix(0, ncol = ncomp, nrow = nobj) + Qx = matrix(0, ncol = ncomp, nrow = nobj) T2x = matrix(0, ncol = ncomp, nrow = nobj) - Q2y = matrix(0, ncol = ncomp, nrow = nobj) + Qy = matrix(0, ncol = ncomp, nrow = nobj) T2y = matrix(0, ncol = ncomp, nrow = nobj) jkcoeffs = array(0, dim = c(nvar, ncomp, ncol(y), nrow(idx))) @@ -368,9 +368,9 @@ pls.crossval = function(model, x, y, cv, center = T, scale = F, jack.knife = T) dim(m$coeffs$values) = c(dim(m$coeffs$values), 1) yp[ind, , ] = yp[ind, , , drop = F] + res$yp - Q2x[ind, ] = Q2x[ind, , drop = F] + xdist$Q2 + Qx[ind, ] = Qx[ind, , drop = F] + xdist$Q T2x[ind, ] = T2x[ind, , drop = F] + xdist$T2 - Q2y[ind, ] = ydist$Q2 + Q2y[ind, , drop = F] + Qy[ind, ] = ydist$Q + Qy[ind, , drop = F] T2y[ind, ] = ydist$T2 + T2y[ind, , drop = F] jkcoeffs[, , , iSeg] = jkcoeffs[, , , iSeg, drop = F] + m$coeffs$values } @@ -379,9 +379,9 @@ pls.crossval = function(model, x, y, cv, center = T, scale = F, jack.knife = T) # average results over repetitions yp = yp / nrep - Q2x = Q2x / nrep + Qx = Qx / nrep T2x = T2x / nrep - Q2y = Q2y / nrep + Qy = Qy / nrep T2y = T2y / nrep jkcoeffs = jkcoeffs / nrep @@ -391,11 +391,11 @@ pls.crossval = function(model, x, y, cv, center = T, scale = F, jack.knife = T) xdecomp = ldecomp(totvar = model$calres$xdecomp$totvar, tnorm = model$calres$xdecomp$tnorm, ncomp.selected = model$ncomp.selected, - Q2 = Q2x, T2 = T2x), + Q = Qx, T2 = T2x), ydecomp = ldecomp(totvar = model$calres$ydecomp$totvar, tnorm = model$calres$ydecomp$tnorm, ncomp.selected = model$ncomp.selected, - Q2 = Q2y, T2 = T2y) + Q = Qy, T2 = T2y) ) if (jack.knife == T) @@ -522,7 +522,7 @@ predict.pls = function(object, x, y.ref = NULL, cv = F, ...) ydist = ldecomp.getDistances(xscores, object$yloadings, yresiduals) ydecomp = ldecomp(yscores, object$yloadings, yresiduals, sum(yy^2), object$ytnorm, object$ncomp.selected, - ydist$T2, ydist$Q2) + ydist$T2, ydist$Q) } else { @@ -1646,7 +1646,7 @@ plotXYLoadings.pls = function(obj, comp = c(1, 2), main = 'XY loadings', #' X residuals plot for PLS #' #' @description -#' Shows a plot with Q2 residuals vs. Hotelling T2 values for PLS decomposition of x data. +#' Shows a plot with Q residuals vs. Hotelling T2 values for PLS decomposition of x data. #' #' @param obj #' a PLS model (object of class \code{pls}) @@ -1669,7 +1669,7 @@ plotXYLoadings.pls = function(obj, comp = c(1, 2), main = 'XY loadings', #' See examples in help for \code{\link{pls}} function. #' plotXResiduals.pls = function(obj, ncomp = NULL, - main = NULL, xlab = 'T2', ylab = 'Q2', + main = NULL, xlab = 'T2', ylab = 'Squared residual distance (Q)', show.labels = F, show.legend = T, ...) { if (is.null(main)) @@ -1685,9 +1685,9 @@ plotXResiduals.pls = function(obj, ncomp = NULL, else if (ncomp <= 0 || ncomp > obj$ncomp) stop('Wrong value for number of components!') - cdata = cbind(obj$calres$xdecomp$T2[, ncomp], obj$calres$xdecomp$Q2[, ncomp]) + cdata = cbind(obj$calres$xdecomp$T2[, ncomp], obj$calres$xdecomp$Q[, ncomp]) - colnames(cdata) = c('T2', 'Q2') + colnames(cdata) = c('T2', 'Q') rownames(cdata) = rownames(obj$calres$xdecomp$scores) data = list(cdata = cdata) @@ -1695,8 +1695,8 @@ plotXResiduals.pls = function(obj, ncomp = NULL, if (!is.null(obj$testres)) { - tdata = cbind(obj$testres$xdecomp$T2[, ncomp], obj$testres$xdecomp$Q2[, ncomp]) - colnames(tdata) = c('T2', 'Q2') + tdata = cbind(obj$testres$xdecomp$T2[, ncomp], obj$testres$xdecomp$Q[, ncomp]) + colnames(tdata) = c('T2', 'Q') rownames(tdata) = rownames(obj$testres$xdecomp$scores) data$tdata = tdata diff --git a/R/plsda.R b/R/plsda.R index 029fd9b..f88841a 100755 --- a/R/plsda.R +++ b/R/plsda.R @@ -16,7 +16,7 @@ plsda = function(x, c, ncomp = 15, center = T, scale = F, cv = NULL, # x.test: a matrix with predictor values for test set validation # c.test: a vector with class values for test set validation # method: a method to calculate PLS model - # alpha: a sigificance limit for Q2 values + # alpha: a sigificance limit for Q values # info: a short string with information about the model # # Returns: diff --git a/R/plsres.R b/R/plsres.R index f2179ff..6695626 100755 --- a/R/plsres.R +++ b/R/plsres.R @@ -120,7 +120,7 @@ plotXYScores.plsres = function(obj, comp = 1, type = 'p', main = 'XY scores', #' X residuals plot for PLS results #' #' @description -#' Shows a plot with Q2 residuals vs. Hotelling T2 values for PLS decomposition of x data. +#' Shows a plot with Q residuals vs. Hotelling T2 values for PLS decomposition of x data. #' #' @param obj #' PLS results (object of class \code{plsres}) diff --git a/R/simca.R b/R/simca.R index 32b9d7a..f66a572 100755 --- a/R/simca.R +++ b/R/simca.R @@ -14,7 +14,7 @@ simca = function(x, classname, ncomp = 15, center = T, scale = F, cv = NULL, x.t # cv: number of segments for random cross-validation (1 - for full CV) # x.test: a matrix with data values for test set validation # c.test: a matrix with class values for test set validation - # alpha: a significance level for Q2 residuals + # alpha: a significance level for Q residuals # method: method to find principal component space (only SVD is supported so far) # info: a text with information about the model # @@ -48,10 +48,10 @@ simca = function(x, classname, ncomp = 15, center = T, scale = F, cv = NULL, x.t model$info = info model$alpha = alpha - # calculate and assign limit values for T2 and Q2 residuals + # calculate and assign limit values for T2 and Q residuals lim = ldecomp.getResLimits(model$eigenvals, nrow(x), model$ncomp.selected, model$alpha) model$T2lim = lim$T2lim - model$Q2lim = lim$Q2lim + model$Qlim = lim$Qlim model$call = match.call() class(model) = c("simca", "classmodel", "pca") @@ -109,7 +109,7 @@ predict.simca = function(object, x, c.ref = NULL, cv = F, ...) colnames(x) = paste('v', 1:ncol(x), sep = '') pres = predict.pca(object, x, cv) - pres$Q2lim = object$Q2lim + pres$Qlim = object$Qlim pres$T2lim = object$T2lim c.pred = simca.classify(object, pres) @@ -131,7 +131,7 @@ predict.simca = function(object, x, c.ref = NULL, cv = F, ...) #' SIMCA classification #' #' @description -#' Make classification based on calculated T2 and Q2 values and corresponding limits +#' Make classification based on calculated T2 and Q values and corresponding limits #' #' @param model #' a SIMCA model (object of class \code{simca}) @@ -147,14 +147,14 @@ predict.simca = function(object, x, c.ref = NULL, cv = F, ...) simca.classify = function(model, res) { ncomp = model$ncomp - c.pred = array(0, dim = c(nrow(res$Q2), ncomp, 1)) - dimnames(c.pred) = list(rownames(res$Q2), paste('Comp', 1:ncomp), model$classname) + c.pred = array(0, dim = c(nrow(res$Q), ncomp, 1)) + dimnames(c.pred) = list(rownames(res$Q), paste('Comp', 1:ncomp), model$classname) for (i in 1:ncomp) { c.pred[, i, 1] = - (res$T2[, i] - model$T2lim[1, i]) < 0.00000001 & - (res$Q2[, i] - model$Q2lim[1, i]) < 0.00000001 + (res$T2[, i] - model$T2lim[1, i]) < 0.0000001 & + (res$Q[, i] - model$Qlim[1, i]) < 0.0000001 } c.pred = c.pred * 2 - 1 @@ -192,9 +192,9 @@ simca.crossval = function(model, x, cv, center = T, scale = F) nseg = nrow(idx); nrep = dim(idx)[3] - Q2 = matrix(0, ncol = ncomp, nrow = nobj) + Q = matrix(0, ncol = ncomp, nrow = nobj) T2 = matrix(0, ncol = ncomp, nrow = nobj) - Q2lim = matrix(0, ncol = ncomp, nrow = 1) + Qlim = matrix(0, ncol = ncomp, nrow = 1) T2lim = matrix(0, ncol = ncomp, nrow = 1) c.pred = array(0, dim = c(nobj, ncomp, 1)) @@ -217,30 +217,30 @@ simca.crossval = function(model, x, cv, center = T, scale = F) m = pca.cal(x.cal, ncomp, center, scale) res = predict.pca(m, x.val, cv = T) - Q2[ind, ] = Q2[ind, ] + res$Q2 + Q[ind, ] = Q[ind, ] + res$Q T2[ind, ] = T2[ind, ] + res$T2 lim = ldecomp.getResLimits(m$eigenvals, nrow(x.cal), ncomp, model$alpha) T2lim = T2lim + lim$T2lim - Q2lim = Q2lim + lim$Q2lim + Qlim = Qlim + lim$Qlim } } } - Q2 = Q2 / nrep; + Q = Q / nrep; T2 = T2 / nrep; - Q2lim = Q2lim / nrep; + Qlim = Qlim / nrep; T2lim = T2lim / nrep; - m = list(Q2lim = Q2lim, T2lim = T2lim, classname = model$classname, ncomp = model$ncomp) - r = list(Q2 = Q2, T2 = T2, classname = model$classname) + m = list(Qlim = Qlim, T2lim = T2lim, classname = model$classname, ncomp = model$ncomp) + r = list(Q = Q, T2 = T2, classname = model$classname) c.pred = simca.classify(m, r) dimnames(c.pred) = list(rownames(x), colnames(model$loadings), model$classname) - rownames(Q2) = rownames(T2) = rownames(c.pred) = rownames(c.ref) = rownames(x) - colnames(Q2) = colnames(T2) = colnames(c.pred) = colnames(model$loadings) - pres = pcares(NULL, NULL, NULL, model$calres$totvar, model$tnorm, model$ncomp.selected, T2, Q2) + rownames(Q) = rownames(T2) = rownames(c.pred) = rownames(c.ref) = rownames(x) + colnames(Q) = colnames(T2) = colnames(c.pred) = colnames(model$loadings) + pres = pcares(NULL, NULL, NULL, model$calres$totvar, model$tnorm, model$ncomp.selected, T2, Q) cres = classres(c.pred, c.ref = c.ref) res = simcares(pres, cres) diff --git a/R/simcam.R b/R/simcam.R index b9f8755..bd7a73b 100755 --- a/R/simcam.R +++ b/R/simcam.R @@ -68,9 +68,9 @@ predict.simcam = function(object, x, c.ref = NULL, cv = F, ...) nobj = nrow(x) c.pred = array(0, dim = c(nobj, 1, object$nclasses)) - Q2 = array(0, dim = c(nobj, object$nclasses)) + Q = array(0, dim = c(nobj, object$nclasses)) T2 = array(0, dim = c(nobj, object$nclasses)) - Q2lim = array(0, dim = c(1, object$nclasses)) + Qlim = array(0, dim = c(1, object$nclasses)) T2lim = array(0, dim = c(1, object$nclasses)) ncomp.selected = matrix(0, nrow = 1, ncol = object$nclasses) @@ -89,15 +89,15 @@ predict.simcam = function(object, x, c.ref = NULL, cv = F, ...) ncomp.selected[i] = object$models[[i]]$ncomp.selected c.pred[, , i] = res$c.pred[, ncomp.selected[i], ] - Q2[, i] = res$Q2[, ncomp.selected[i], drop = F] + Q[, i] = res$Q[, ncomp.selected[i], drop = F] T2[, i] = res$T2[, ncomp.selected[i], drop = F] - Q2lim[i] = res$Q2lim[ncomp.selected[i]] + Qlim[i] = res$Qlim[ncomp.selected[i]] T2lim[i] = res$T2lim[ncomp.selected[i]] } dimnames(c.pred) = list(rownames(x), paste('Comp', ncomp.selected[[i]]), object$classnames) cres = classres(c.pred, c.ref, ncomp.selected = ncomp.selected) - res = simcamres(cres, T2, Q2, T2lim, Q2lim) + res = simcamres(cres, T2, Q, T2lim, Qlim) res } diff --git a/R/simcamres.R b/R/simcamres.R index 1c5bec4..31317ef 100755 --- a/R/simcamres.R +++ b/R/simcamres.R @@ -1,21 +1,21 @@ ## class and methods for SIMCA multi class classification results ## -simcamres = function(cres, T2, Q2, T2lim, Q2lim) +simcamres = function(cres, T2, Q, T2lim, Qlim) { # Creates an object of simcamres class. # # Arguments: # cres: an object of classres class (results for classification) # T2: T2 values for the objects and classes (selected component only) - # Q2: Q2 values for the objects and classes (selected component only) + # Q: Q values for the objects and classes (selected component only) # T2lim: T2 limits for the classes (selected component only) - # Q2lim: Q2 limits for the classes (selected component only) + # Qlim: Q limits for the classes (selected component only) res = cres res$T2 = T2 - res$Q2 = Q2 + res$Q = Q res$T2lim = T2lim - res$Q2lim = Q2lim + res$Qlim = Qlim res$classnames = dimnames(cres$c.pred)[[3]] class(res) = c('simcamres', 'classres') @@ -25,7 +25,7 @@ simcamres = function(cres, T2, Q2, T2lim, Q2lim) #' Residuals plot for SIMCAM results #' #' @description -#' Shows a plot with Q2 vs. T2 residuals for SIMCAM results +#' Shows a plot with Q vs. T2 residuals for SIMCAM results #' #' @param obj #' SIMCAM results (object of class \code{simcamres}) @@ -50,7 +50,7 @@ simcamres = function(cres, T2, Q2, T2lim, Q2lim) #' See examples in help for \code{\link{simcamres}} function. #' plotResiduals.simcamres = function(obj, nc = 1, show.limits = T, type = 'p', main = NULL, - xlab = 'T2', ylab = 'Q2', legend = NULL, ...) + xlab = 'T2', ylab = 'Squared residual distance (Q)', legend = NULL, ...) { # set main title if (is.null(main)) @@ -61,13 +61,13 @@ plotResiduals.simcamres = function(obj, nc = 1, show.limits = T, type = 'p', mai classes = unique(obj$c.ref) data = list() for (i in 1:length(classes)) - data[[i]] = cbind(obj$T2[obj$c.ref == classes[i], nc], obj$Q2[obj$c.ref == classes[i], nc]) + data[[i]] = cbind(obj$T2[obj$c.ref == classes[i], nc], obj$Q[obj$c.ref == classes[i], nc]) if (is.null(legend)) legend = classes if (show.limits == T) - show.lines = c(obj$T2lim[nc], obj$Q2lim[nc]) + show.lines = c(obj$T2lim[nc], obj$Qlim[nc]) else show.lines = F @@ -77,9 +77,9 @@ plotResiduals.simcamres = function(obj, nc = 1, show.limits = T, type = 'p', mai else { - data = cbind(obj$T2[, nc], obj$Q2[, nc]) + data = cbind(obj$T2[, nc], obj$Q[, nc]) if (show.limits == T) - show.lines = c(obj$T2lim[nc], obj$Q2lim[nc]) + show.lines = c(obj$T2lim[nc], obj$Qlim[nc]) else show.lines = F @@ -129,15 +129,15 @@ plotCooman.simcamres = function(obj, nc = c(1, 2), type = 'p', main = "Cooman's classes = unique(obj$c.ref) data = list() for (i in 1:length(classes)) - data[[i]] = cbind(sqrt(obj$Q2[obj$c.ref == classes[i], nc[1]]), - sqrt(obj$Q2[obj$c.ref == classes[i], nc[2]]) + data[[i]] = cbind(sqrt(obj$Q[obj$c.ref == classes[i], nc[1]]), + sqrt(obj$Q[obj$c.ref == classes[i], nc[2]]) ) if (is.null(legend)) legend = classes if (show.limits == T) - show.lines = c(obj$Q2lim[nc[1]], obj$Q2lim[nc[2]]) + show.lines = c(obj$Qlim[nc[1]], obj$Qlim[nc[2]]) else show.lines = F @@ -146,10 +146,10 @@ plotCooman.simcamres = function(obj, nc = c(1, 2), type = 'p', main = "Cooman's } else { - data = cbind(sqrt(obj$Q2[, nc[1]]), sqrt(obj$Q2[, nc[2]])) + data = cbind(sqrt(obj$Q[, nc[1]]), sqrt(obj$Q[, nc[2]])) if (show.limits == T) - show.lines = c(obj$Q2lim[nc[1]], obj$Q2lim[nc[2]]) + show.lines = c(obj$Qlim[nc[1]], obj$Qlim[nc[2]]) else show.lines = F diff --git a/R/simcares.R b/R/simcares.R index a6decac..2efa2b1 100755 --- a/R/simcares.R +++ b/R/simcares.R @@ -18,7 +18,7 @@ simcares = function(pres, cres) #' Residuals plot for SIMCA results #' #' @description -#' Shows a plot with Q2 vs. T2 residuals for SIMCA results +#' Shows a plot with Q vs. T2 residuals for SIMCA results #' #' @param obj #' SIMCA results (object of class \code{simcares}) @@ -43,9 +43,9 @@ simcares = function(pres, cres) #' See examples in help for \code{\link{simcares}} function. #' plotResiduals.simcares = function(obj, ncomp = NULL, show.limits = T, type = 'p', main = NULL, - xlab = 'T2', ylab = 'Q2', legend = NULL, ...) + xlab = 'T2', ylab = 'Squared residual distance (Q)', legend = NULL, ...) { - # Shows residuals plot (T2 vs Q2) + # Shows residuals plot (T2 vs Q) # # Arguments: # obj: SIMCA results (an object of class simcares) @@ -98,8 +98,8 @@ plotResiduals.simcares = function(obj, ncomp = NULL, show.limits = T, type = 'p' for (i in 1:nclasses) { idx = c.ref == classes[i] - data = cbind(obj$T2[idx, ncomp, drop = F], obj$Q2[idx, ncomp, drop = F]) - colnames(data) = c('T2', 'Q2') + data = cbind(obj$T2[idx, ncomp, drop = F], obj$Q[idx, ncomp, drop = F]) + colnames(data) = c('T2', 'Q') rownames(data) = rownames(obj$c.ref[idx]) legend.str = c(legend.str, classes[i]) @@ -111,7 +111,7 @@ plotResiduals.simcares = function(obj, ncomp = NULL, show.limits = T, type = 'p' if (show.limits == T) - show.lines = c(obj$T2lim[1, ncomp], obj$Q2lim[1, ncomp]) + show.lines = c(obj$T2lim[1, ncomp], obj$Qlim[1, ncomp]) else show.lines = F diff --git a/README.md b/README.md index 3d15f15..8f7c3ac 100755 --- a/README.md +++ b/README.md @@ -16,7 +16,7 @@ It can be also installed from sources, just [download](https://github.com/svkuch the `install.packages` command, e.g. if the downloaded file is `mdatools_0.6.0.tar.gz` and it is located in a current working directory, just run the following: ``` -install.packages('mdatools_0.6.0.tar.gz') +install.packages('mdatools_0.6.2.tar.gz') ``` If you have `devtools` package installed, the following command will install the latest release from the GitHub (do not forget to load the `devtools` package first): diff --git a/man/ldecomp.Rd b/man/ldecomp.Rd index 24f258b..d1e30fc 100755 --- a/man/ldecomp.Rd +++ b/man/ldecomp.Rd @@ -5,7 +5,7 @@ \title{Linear decomposition of data} \usage{ ldecomp(scores = NULL, loadings = NULL, residuals = NULL, totvar, - tnorm = NULL, ncomp.selected = NULL, T2 = NULL, Q2 = NULL, + tnorm = NULL, ncomp.selected = NULL, T2 = NULL, Q = NULL, cal = TRUE) } \arguments{ @@ -23,7 +23,7 @@ ldecomp(scores = NULL, loadings = NULL, residuals = NULL, totvar, \item{T2}{matrix with calculated T2 values (e.g. for CV)} -\item{Q2}{matrix with calculated Q2 values (e.g. for CV)} +\item{Q}{matrix with calculated Q statistic (e.g. for CV)} \item{cal}{logical, true if data is for calibration of a LDECOMP based model} } @@ -32,7 +32,7 @@ Returns an object (list) of \code{ldecomp} class with following fields: \item{scores }{matrix with score values (nobj x ncomp).} \item{residuals }{matrix with data residuals (nobj x nvar).} \item{T2 }{matrix with T2 distances (nobj x ncomp).} -\item{Q2 }{matrix with Q2 distances (nobj x ncomp).} +\item{Q }{matrix with Q statistic (nobj x ncomp).} \item{tnorm }{vector with singular values used for scores normalization.} \item{ncomp.selected }{selected number of components.} \item{expvar }{explained variance for each component.} diff --git a/man/ldecomp.getDistances.Rd b/man/ldecomp.getDistances.Rd index 83e02b8..4dfedcc 100755 --- a/man/ldecomp.getDistances.Rd +++ b/man/ldecomp.getDistances.Rd @@ -18,10 +18,10 @@ ldecomp.getDistances(scores, loadings, residuals, tnorm = NULL, cal = TRUE) \item{cal}{logical, are these results for calibration set or not} } \value{ -Returns a list with Q2, Q2var, T2 and modelling power values for each component. +Returns a list with Q, Qvar, T2 and modelling power values for each component. } \description{ -Computes residual distances (Q2 and T2) and modelling power for a data decomposition X = TP' + E. +Computes residual distances (Q and T2) and modelling power for a data decomposition X = TP' + E. } \details{ The distances are calculated for every 1:n components, where n goes from 1 to ncomp diff --git a/man/ldecomp.getResLimits.Rd b/man/ldecomp.getResLimits.Rd index a51b2ed..dd75ea2 100755 --- a/man/ldecomp.getResLimits.Rd +++ b/man/ldecomp.getResLimits.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/ldecomp.R \name{ldecomp.getResLimits} \alias{ldecomp.getResLimits} -\title{Statistical limits for Q2 and T2 residuals} +\title{Statistical limits for Q and T2 residuals} \usage{ ldecomp.getResLimits(eigenvals, nobj, ncomp, alpha = 0.05) } @@ -16,10 +16,10 @@ ldecomp.getResLimits(eigenvals, nobj, ncomp, alpha = 0.05) \item{alpha}{significance level} } \value{ -Returns a list with two vectors: \code{T2lim} and \code{Q2lim}. +Returns a list with two vectors: \code{T2lim} and \code{Qlim}. } \description{ -Computes statisticsl limits for Q2 and T2 residuals +Computes statisticsl limits for Q and T2 residuals } \details{ T2 limits are calculated using Hotelling statistics. diff --git a/man/ldecomp.getVariances.Rd b/man/ldecomp.getVariances.Rd index 91e4738..c6f5f4a 100755 --- a/man/ldecomp.getVariances.Rd +++ b/man/ldecomp.getVariances.Rd @@ -4,10 +4,10 @@ \alias{ldecomp.getVariances} \title{Explained variance for linear decomposition} \usage{ -ldecomp.getVariances(Q2, totvar) +ldecomp.getVariances(Q, totvar) } \arguments{ -\item{Q2}{Q2 values (squared residuals distance from object to component space).} +\item{Q}{Q values (squared residuals distance from object to component space).} \item{totvar}{Total variance of the original data (after preprocessing).} } diff --git a/man/pca.Rd b/man/pca.Rd index ae35a51..3b88be2 100755 --- a/man/pca.Rd +++ b/man/pca.Rd @@ -21,7 +21,7 @@ pca(x, ncomp = 15, center = T, scale = F, cv = NULL, x.test = NULL, \item{scale}{logical, do sdandardization of data or not.} \item{cv}{number of segments for random cross-validation (1 for full cross-validation).} \item{x.test}{a numerical matrix with test data.} - \item{alpha}{significance level for calculating limit for Q2 residuals.} + \item{alpha}{significance level for calculating limit for Q residuals.} \item{method}{method to compute principal components.} \item{info}{a short text line with model description.} } @@ -29,7 +29,7 @@ pca(x, ncomp = 15, center = T, scale = F, cv = NULL, x.test = NULL, \details{ So far only SVD (Singular Value Decompisition) method is available, more coming soon. -By default \code{pca} uses number of components (\code{ncomp}) as a minimum of number of objects - 1, number of variables and default or provided value. Besides that, there is also a parameter for selecting an optimal number of components (\code{ncomp.selected}). The optimal number of components is used to build a residuals plot (with Q2 residuals vs. Hotelling T2 values), calculate confidence limits for Q2 residuals, as well as for SIMCA classification. +By default \code{pca} uses number of components (\code{ncomp}) as a minimum of number of objects - 1, number of variables and default or provided value. Besides that, there is also a parameter for selecting an optimal number of components (\code{ncomp.selected}). The optimal number of components is used to build a residuals plot (with Q residuals vs. Hotelling T2 values), calculate confidence limits for Q residuals, as well as for SIMCA classification. If data contains missing values (NA) the \code{pca} will use an iterative algorithm to fit the values with most probable ones. The algorithm is implemented in a function \code{\link{pca.mvreplace}}. The same center and scale options will be used. You can also do this step manually before calling \code{pca} and play with extra options. @@ -44,7 +44,7 @@ Returns an object of \code{pca} class with following fields: \item{expvar }{vector with explained variance for each component (in percent).} \item{cumexpvar }{vector with cumulative explained variance for each component (in percent).} \item{T2lim }{statistical limit for T2 distance.} -\item{Q2lim }{statistical limit for Q2 distance.} +\item{Qlim }{statistical limit for Q residuals.} \item{info }{information about the model, provided by user when build the model.} \item{calres }{an object of class \code{\link{pcares}} with PCA results for a calibration data.} \item{testres }{an object of class \code{\link{pcares}} with PCA results for a test data, if it was provided.} @@ -67,7 +67,7 @@ Methods for \code{pca} objects: \code{\link{plotLoadings.pca}} \tab shows loadings plot.\cr \code{\link{plotVariance.pca}} \tab shows explained variance plot.\cr \code{\link{plotCumVariance.pca}} \tab shows cumulative explained variance plot.\cr - \code{\link{plotResiduals.pca}} \tab shows Q2 vs. T2 residuals plot.\cr + \code{\link{plotResiduals.pca}} \tab shows Q vs. T2 residuals plot.\cr } Most of the methods for plotting data are also available for PCA results (\code{\link{pcares}}) objects. diff --git a/man/pcares.Rd b/man/pcares.Rd index dc06856..0b5180f 100755 --- a/man/pcares.Rd +++ b/man/pcares.Rd @@ -34,7 +34,7 @@ Returns an object (list) of class \code{pcares} and \code{ldecomp} with followin \item{scores }{matrix with score values (nobj x ncomp).} \item{residuals }{matrix with data residuals (nobj x nvar).} \item{T2 }{matrix with T2 distances (nobj x ncomp).} -\item{Q2 }{matrix with Q2 distances (nobj x ncomp).} +\item{Q }{matrix with Q residuals (nobj x ncomp).} \item{tnorm }{vector with singular values used for scores normalization.} \item{ncomp.selected }{selected number of components.} \item{expvar }{explained variance for each component.} @@ -58,7 +58,7 @@ Methods, inherited from \code{\link{ldecomp}} class: \code{\link{plotScores.ldecomp}} \tab makes scores plot.\cr \code{\link{plotVariance.ldecomp}} \tab makes explained variance plot.\cr \code{\link{plotCumVariance.ldecomp}} \tab makes cumulative explained variance plot.\cr - \code{\link{plotResiduals.ldecomp}} \tab makes Q2 vs. T2 residuals plot.\cr + \code{\link{plotResiduals.ldecomp}} \tab makes Q vs. T2 residuals plot.\cr } Check also \code{\link{pca}} and \code{\link{ldecomp}}. } diff --git a/man/plotResiduals.ldecomp.Rd b/man/plotResiduals.ldecomp.Rd index 04d5937..03faff5 100755 --- a/man/plotResiduals.ldecomp.Rd +++ b/man/plotResiduals.ldecomp.Rd @@ -5,7 +5,8 @@ \title{Residuals plot for linear decomposition} \usage{ \method{plotResiduals}{ldecomp}(obj, ncomp = NULL, main = NULL, - xlab = "T2", ylab = "Q2", show.labels = F, show.limits = T, ...) + xlab = "T2", ylab = "Squared residual distance (Q)", show.labels = F, + show.limits = T, ...) } \arguments{ \item{obj}{object of \code{ldecomp} class.} @@ -25,6 +26,6 @@ \item{...}{most of graphical parameters from \code{\link{mdaplot}} function can be used.} } \description{ -Shows a plot with T2 vs Q2 values for data objects. +Shows a plot with T2 vs Q values for data objects. } diff --git a/man/plotResiduals.pca.Rd b/man/plotResiduals.pca.Rd index 193c111..cbddf05 100755 --- a/man/plotResiduals.pca.Rd +++ b/man/plotResiduals.pca.Rd @@ -5,7 +5,8 @@ \title{Residuals plot for PCA} \usage{ \method{plotResiduals}{pca}(obj, ncomp = NULL, main = NULL, xlab = "T2", - ylab = "Q2", show.labels = F, show.legend = T, show.limits = T, ...) + ylab = "Squared residual distance (Q)", show.labels = F, + show.legend = T, show.limits = T, ...) } \arguments{ \item{obj}{a PCA model (object of class \code{pca})} @@ -27,7 +28,7 @@ \item{...}{other plot parameters (see \code{mdaplotg} for details)} } \description{ -Shows a plot with Q2 residuals vs. Hotelling T2 values for selected number of components. +Shows a plot with Q residuals vs. Hotelling T2 values for selected number of components. } \details{ See examples in help for \code{\link{pca}} function. diff --git a/man/plotResiduals.simcamres.Rd b/man/plotResiduals.simcamres.Rd index 26e50e1..56f04fe 100755 --- a/man/plotResiduals.simcamres.Rd +++ b/man/plotResiduals.simcamres.Rd @@ -5,8 +5,8 @@ \title{Residuals plot for SIMCAM results} \usage{ \method{plotResiduals}{simcamres}(obj, nc = 1, show.limits = T, - type = "p", main = NULL, xlab = "T2", ylab = "Q2", legend = NULL, - ...) + type = "p", main = NULL, xlab = "T2", + ylab = "Squared residual distance (Q)", legend = NULL, ...) } \arguments{ \item{obj}{SIMCAM results (object of class \code{simcamres})} @@ -28,7 +28,7 @@ \item{...}{other plot parameters (see \code{mdaplotg} for details)} } \description{ -Shows a plot with Q2 vs. T2 residuals for SIMCAM results +Shows a plot with Q vs. T2 residuals for SIMCAM results } \details{ See examples in help for \code{\link{simcamres}} function. diff --git a/man/plotResiduals.simcares.Rd b/man/plotResiduals.simcares.Rd index 6756843..4134ca1 100755 --- a/man/plotResiduals.simcares.Rd +++ b/man/plotResiduals.simcares.Rd @@ -5,8 +5,8 @@ \title{Residuals plot for SIMCA results} \usage{ \method{plotResiduals}{simcares}(obj, ncomp = NULL, show.limits = T, - type = "p", main = NULL, xlab = "T2", ylab = "Q2", legend = NULL, - ...) + type = "p", main = NULL, xlab = "T2", + ylab = "Squared residual distance (Q)", legend = NULL, ...) } \arguments{ \item{obj}{SIMCA results (object of class \code{simcares})} @@ -28,7 +28,7 @@ \item{...}{other plot parameters (see \code{mdaplot} for details)} } \description{ -Shows a plot with Q2 vs. T2 residuals for SIMCA results +Shows a plot with Q vs. T2 residuals for SIMCA results } \details{ See examples in help for \code{\link{simcares}} function. diff --git a/man/plotXResiduals.pls.Rd b/man/plotXResiduals.pls.Rd index 4ca1902..a020669 100755 --- a/man/plotXResiduals.pls.Rd +++ b/man/plotXResiduals.pls.Rd @@ -5,7 +5,8 @@ \title{X residuals plot for PLS} \usage{ \method{plotXResiduals}{pls}(obj, ncomp = NULL, main = NULL, xlab = "T2", - ylab = "Q2", show.labels = F, show.legend = T, ...) + ylab = "Squared residual distance (Q)", show.labels = F, + show.legend = T, ...) } \arguments{ \item{obj}{a PLS model (object of class \code{pls})} @@ -25,7 +26,7 @@ \item{...}{other plot parameters (see \code{mdaplotg} for details)} } \description{ -Shows a plot with Q2 residuals vs. Hotelling T2 values for PLS decomposition of x data. +Shows a plot with Q residuals vs. Hotelling T2 values for PLS decomposition of x data. } \details{ See examples in help for \code{\link{pls}} function. diff --git a/man/plotXResiduals.plsres.Rd b/man/plotXResiduals.plsres.Rd index 26dc292..6f6393a 100755 --- a/man/plotXResiduals.plsres.Rd +++ b/man/plotXResiduals.plsres.Rd @@ -16,7 +16,7 @@ \item{...}{other plot parameters (see \code{mdaplot} for details)} } \description{ -Shows a plot with Q2 residuals vs. Hotelling T2 values for PLS decomposition of x data. +Shows a plot with Q residuals vs. Hotelling T2 values for PLS decomposition of x data. } \details{ See examples in help for \code{\link{plsres}} function. diff --git a/man/pls.Rd b/man/pls.Rd index d91e089..e207344 100755 --- a/man/pls.Rd +++ b/man/pls.Rd @@ -86,7 +86,7 @@ Methods for \code{pls} objects: \code{\link{plotYVariance.pls}} \tab shows explained variance plot for y decomposition.\cr \code{\link{plotXCumVariance.pls}} \tab shows cumulative explained variance plot for y decomposition.\cr \code{\link{plotYCumVariance.pls}} \tab shows cumulative explained variance plot for y decomposition.\cr - \code{\link{plotXResiduals.pls}} \tab shows T2 vs. Q2 plot for x decomposition.\cr + \code{\link{plotXResiduals.pls}} \tab shows T2 vs. Q plot for x decomposition.\cr \code{\link{plotYResiduals.pls}} \tab shows residuals plot for y values.\cr \code{\link{plotSelectivityRatio.pls}} \tab shows plot with selectivity ratio values.\cr \code{\link{plotVIPScores.pls}} \tab shows plot with VIP scores values.\cr diff --git a/man/plsdares.Rd b/man/plsdares.Rd index 9959341..e2b0e39 100755 --- a/man/plsdares.Rd +++ b/man/plsdares.Rd @@ -64,7 +64,7 @@ Methods, inherited from \code{plsres} class: \code{\link{plotYVariance.plsres}} \tab shows explained variance plot for y decomposition.\cr \code{\link{plotXCumVariance.plsres}} \tab shows cumulative explained variance plot for y decomposition.\cr \code{\link{plotYCumVariance.plsres}} \tab shows cumulative explained variance plot for y decomposition.\cr - \code{\link{plotXResiduals.plsres}} \tab shows T2 vs. Q2 plot for x decomposition.\cr + \code{\link{plotXResiduals.plsres}} \tab shows T2 vs. Q plot for x decomposition.\cr \code{\link{plotYResiduals.regres}} \tab shows residuals plot for y values.\cr } diff --git a/man/plsres.Rd b/man/plsres.Rd index 6f961ec..17084ca 100755 --- a/man/plsres.Rd +++ b/man/plsres.Rd @@ -70,7 +70,7 @@ Methods for \code{plsres} objects: \code{\link{plotYVariance.plsres}} \tab shows explained variance plot for y decomposition.\cr \code{\link{plotXCumVariance.plsres}} \tab shows cumulative explained variance plot for y decomposition.\cr \code{\link{plotYCumVariance.plsres}} \tab shows cumulative explained variance plot for y decomposition.\cr - \code{\link{plotXResiduals.plsres}} \tab shows T2 vs. Q2 plot for x decomposition.\cr + \code{\link{plotXResiduals.plsres}} \tab shows T2 vs. Q plot for x decomposition.\cr \code{\link{plotYResiduals.regres}} \tab shows residuals plot for y values.\cr } See also \code{\link{pls}} - a class for PLS models. diff --git a/man/simca.Rd b/man/simca.Rd index 81eea48..3091922 100755 --- a/man/simca.Rd +++ b/man/simca.Rd @@ -21,7 +21,7 @@ simca(x, classname, ncomp = 15, center = T, scale = F, cv = NULL, x.test = NULL, \item{cv}{number of segments for random cross-validation (1 for full cross-validation).} \item{x.test}{a numerical matrix with test data.} \item{c.test}{a vector with text values (names of classes) of test data objects.} - \item{alpha}{significance level for calculating limit for T2 and Q2 residuals.} + \item{alpha}{significance level for calculating limit for T2 and Q residuals.} \item{method}{method to compute principal components.} \item{info}{text with information about the model} } @@ -46,7 +46,7 @@ Fields, inherited from \code{\link{pca}} class: \item{expvar }{vector with explained variance for each component (in percent).} \item{cumexpvar }{vector with cumulative explained variance for each component (in percent).} \item{T2lim }{statistical limit for T2 distance.} -\item{Q2lim }{statistical limit for Q2 distance.} +\item{Qlim }{statistical limit for Q residuals.} \item{info }{information about the model, provided by user when build the model.} } @@ -83,7 +83,7 @@ Methods, inherited from \code{\link{pca}} class: \code{\link{plotLoadings.pca}} \tab shows loadings plot.\cr \code{\link{plotVariance.pca}} \tab shows explained variance plot.\cr \code{\link{plotCumVariance.pca}} \tab shows cumulative explained variance plot.\cr - \code{\link{plotResiduals.pca}} \tab shows Q2 vs. T2 residuals plot.\cr + \code{\link{plotResiduals.pca}} \tab shows Q vs. T2 residuals plot.\cr } } diff --git a/man/simca.classify.Rd b/man/simca.classify.Rd index d364b65..86bd10f 100755 --- a/man/simca.classify.Rd +++ b/man/simca.classify.Rd @@ -15,7 +15,7 @@ simca.classify(model, res) vector with predicted class values (\code{c.pred}) } \description{ -Make classification based on calculated T2 and Q2 values and corresponding limits +Make classification based on calculated T2 and Q values and corresponding limits } \details{ This is a service function for SIMCA class, do not use it manually. diff --git a/man/simcam.Rd b/man/simcam.Rd index b40e1f1..200c26a 100755 --- a/man/simcam.Rd +++ b/man/simcam.Rd @@ -52,7 +52,7 @@ Methods for \code{simca} objects: \code{\link{plotDiscriminationPower.simcam}} \tab shows plot with discrimination power.\cr \code{\link{plotModellingPower.simcam}} \tab shows plot with modelling power for individual model.\cr \code{\link{plotCooman.simcam}} \tab shows Cooman's plot for calibration data.\cr - \code{\link{plotResiduals.simcam}} \tab shows plot with Q2 vs. T2 residuals for calibration data.\cr + \code{\link{plotResiduals.simcam}} \tab shows plot with Q vs. T2 residuals for calibration data.\cr } Methods, inherited from \code{classmodel} class: diff --git a/man/simcamres.Rd b/man/simcamres.Rd index 901cb27..134a5da 100755 --- a/man/simcamres.Rd +++ b/man/simcamres.Rd @@ -10,15 +10,15 @@ Results of SIMCA multiclass classification } \usage{ -simcamres(cres, T2, Q2, T2lim, Q2lim) +simcamres(cres, T2, Q, T2lim, Qlim) } \arguments{ \item{cres }{results of classification (class \code{classres}).} \item{T2 }{matrix with T2 values for each object and class.} - \item{Q2 }{matrix with Q2 values for each object and class.} + \item{Q }{matrix with Q values for each object and class.} \item{T2lim }{vector with T2 statistical limits for each class.} - \item{Q2lim }{vector with Q2 statistical limits for each class.} + \item{Qlim }{vector with Q statistical limits for each class.} } \details{ @@ -35,14 +35,14 @@ to show summary and plots for the results. \value{ Returns an object (list) of class \code{simcamres} with the same fields as \code{\link{classres}} plus extra fields for -Q2 and T2 values and limits: +Q and T2 values and limits: \item{c.pred}{predicted class values.} \item{c.ref}{reference (true) class values if provided.} \item{T2}{matrix with T2 values for each object and class.} -\item{Q2}{matrix with Q2 values for each object and class.} +\item{Q}{matrix with Q values for each object and class.} \item{T2lim}{vector with T2 statistical limits for each class.} -\item{Q2lim}{vector with Q2 statistical limits for each class.} +\item{Qlim}{vector with Q statistical limits for each class.} The following fields are available only if reference values were provided. \item{tp}{number of true positives.} @@ -62,7 +62,7 @@ Methods for \code{simcamres} objects: \tabular{ll}{ \code{print.simcamres} \tab shows information about the object.\cr \code{summary.simcamres} \tab shows statistics for results of classification.\cr - \code{\link{plotResiduals.simcamres}} \tab makes Q2 vs. T2 residuals plot.\cr + \code{\link{plotResiduals.simcamres}} \tab makes Q vs. T2 residuals plot.\cr \code{\link{plotCooman.simcamres}} \tab makes Cooman's plot.\cr }