tests/testthat/test-ldecomplimits.R

#############################################################
# Tests for basic functionality of critical limits methods  #
#############################################################

# Prepare 3 datasets

data(people)

## plain data, no names no attributes
X1 <- list()
X1$data <- people
rownames(X1$data) <- NULL
colnames(X1$data) <- NULL
X1$exp_exclrows <- NULL
X1$exp_exclcols <- NULL

## same data but with names and attributes
X2 <- list()
X2$data <- people
X2$exp_exclrows <- NULL
X2$exp_exclcols <- NULL
attr(X2$data, "name") <- "People"
attr(X2$data, "xaxis.name") <- "Properties"
attr(X2$data, "xaxis.values") <- 12:1
attr(X2$data, "yaxis.name") <- "Values"
attr(X2$data, "yaxis.values") <- 32:1

## for full PCA model of People data we know some results - use them for double check
Q_exp <- NULL
T2_exp <- NULL
expvar_exp <- NULL

## data with names and attributes and excluded rows
X3 <- X2
X3$exp_exclrows <- c(1, 10, 20)
X3$data <- mda.exclrows(X3$data, X3$exp_exclrows)

## data with names and attributes, excluded rows and columns
X4 <- X3
X4$data <- mda.exclcols(X4$data, c("Hairleng", "IQ"))

# function to get scores, loadings and residuals from data
getPCARes <- function(X, ncomp) {
   rows_excluded <- attr(X, "exclrows")
   cols_excluded <- attr(X, "exclcols")

   if (is.null(rownames(X))) {
      rownames(X) <- paste0('O', 1:nrow(X))
   }

   if (is.null(colnames(X))) {
      colnames(X) <- paste0('X', 1:ncol(X))
   }

   rownames <- rownames(X)
   colnames <- colnames(X)

   X_cal <- X

   # remove excluded rows from calibration data
   if (length(rows_excluded) > 0) {
      X_cal <- X_cal[-rows_excluded, , drop = FALSE]
   }

   # get mean and center and do autoscaling of the calibration data
   m <- apply(X_cal, 2, mean)
   s <- apply(X_cal, 2, sd)
   X_cal <- scale(X_cal, center = m, scale = s)

   # remove excluded columns
   if (length(cols_excluded) > 0) {
      X_cal <- X_cal[, -cols_excluded, drop = FALSE]
   }

   # find loadings
   loadings_visible <- svd(X_cal)$v[, 1:ncomp, drop = F]
   loadings <- matrix(0, nrow = ncol(X), ncol = ncomp)
   if (length(cols_excluded) > 0) {
      loadings[-cols_excluded, ] <- loadings_visible
   } else {
      loadings <- loadings_visible
   }

   # eigenvalues using only visible rows
   eigenvals <- colSums((X_cal %*% loadings_visible)^2) / (nrow(X_cal) - 1)

   X <- scale(X, center = m, scale = s)
   scores <- X %*% loadings
   residuals <- X - tcrossprod(scores, loadings)

   scores <- mda.setattr(scores, mda.getattr(X), type = 'row')
   residuals <- mda.setattr(residuals, mda.getattr(X))

   attr(loadings, "exclrows") <- attr(X, "exclcols")
   attr(loadings, "yaxis.name") <- attr(X, "xaxis.name")
   attr(loadings, "yaxis.values") <- attr(X, "xaxis.values")

   rownames(scores) <- rownames(residuals) <- rownames
   rownames(loadings) <- colnames(residuals) <- colnames
   colnames(scores) <- colnames(loadings) <- paste("Comp", 1:ncomp)

   return(list(scores = scores, loadings = loadings, residuals = residuals,
      eigenvals = eigenvals, ncomp = ncomp, totvar = sum(X_cal^2)))
}


#########################################################
#region 1. Computing critical limits (chisq/hotelling)  #
#########################################################

## chisq/hotelling for full data
context("misc: computing limits (chisq/hotelling, full data)")

# in this case we use predefined values computed for full People data with autoscaling
# the values we got from PLS_Toolbox and DD-SIMCA Toolbox


test_that("critical limits for Q are correct (jm) full decomposition", {

   # test for both full and partial decomposition
   for (a in c(4, 12)) {
      m <- getPCARes(X1$data, a)

      # expected limits for alpha = 0.05 and gamma = 0.01
      # computed using "residuallimit" function from PLS_Toolbox
      expQlim1 <- rbind(
         c(13.98208375, 8.91523789, 4.86682122, 1.81125667, 0.98188720, 0.57560902, 0.32312846,
            0.18598893, 0.12950361, 0.06958773, 0.02625457, 0),
         c(37.92391547, 27.28432368, 18.46348557, 5.51382242, 2.82348737, 1.68333989, 0.89628978,
            0.47263837, 0.37503680, 0.22537117, 0.09561530, 0)
      )

      # expected limits for alpha = 0.10 and gamma = 0.05
      # computed using "residuallimit" function from PLS_Toolbox
      expQlim2 <- rbind(
         c(11.08714606, 6.88643872, 3.62417784, 1.41387882, 0.77404080, 0.45201939, 0.25555116,
            0.14863431, 0.09998945, 0.05180038, 0.01849205, 0),
         c(29.65164966, 20.68354357, 13.16120605, 4.16057052, 2.16549979, 1.28564550, 0.69582345,
            0.37714904, 0.29044220, 0.17075224, 0.07133111, 0)
      )

      expect_equivalent(jm.crit(m$residuals, m$eigenvals, 0.05, 0.01), expQlim1[, seq_len(a)], tolerance = 10^-5)
      expect_equivalent(jm.crit(m$residuals, m$eigenvals, 0.10, 0.05), expQlim2[, seq_len(a)], tolerance = 10^-5)
   }

})

m <- getPCARes(X1$data, 12)
dist <- ldecomp.getDistances(m$scores, m$loadings, m$residuals, m$eigenvals)

test_that("critical limits for Q are correct (chisq)", {

   # expected distribution parameters
   expParams <- list(
      u0 = apply(dist$Q, 2, mean),
      Nu = apply(dist$Q, 2, function(x) 2 * (mean(x) / sd(x))^2),
      nobj = nrow(dist$Q)
   )

   # expected limits for alpha = 0.05 and gamma = 0.01
   # computed using "residuallimit" function from PLS_Toolbox
   expQlim1 <- rbind(
      c(9.25512512, 7.37431769, 3.64879767, 1.55968461, 0.82955551, 0.52538528, 0.23914330,
         0.15607468, 0.11587272, 0.04727562, 0.04666972, 0.00000000),
      c(16.87605393, 16.33648881, 8.08326204, 4.19946801, 2.23358734, 1.25780278, 0.52977943,
         0.37365182, 0.31198858, 0.15980027, 0.15775224, 0.00000000)
   )

   # expected limits for alpha = 0.10 and gamma = 0.05
   # computed using "residuallimit" function from PLS_Toolbox
   expQlim2 <- rbind(
      c(8.03234581, 6.04655385, 2.99182277, 1.19880757, 0.63761443, 0.42028176, 0.19608497,
         0.12485188, 0.08906230, 0.03329627, 0.03286953, 0.00000000),
      c(14.57482653, 13.53946609, 6.69930078, 3.35119154, 1.78241124, 1.02644677, 0.43907419,
         0.30492357, 0.24896808, 0.12254836, 0.12097776, 0.00000000)
   )

   # parameters
   p <- ddmoments.param(dist$Q)
   expect_equivalent(p, expParams, tolerance = 10^-5)

   # limits
   expect_equivalent(chisq.crit(p, 0.05, 0.01), expQlim1, tolerance = 10^-5)
   expect_equivalent(chisq.crit(p, 0.10, 0.05), expQlim2, tolerance = 10^-5)
})

test_that("critical limits for T2 are correct (hotelling)", {

   # expected limits for alpha = 0.05 and gamma = 0.01
   # computed using "tsqlim" function from PLS_Toolbox
   expT2lim1 <- rbind(
      c(4.15961510, 6.85271430, 9.40913034, 12.01947857, 14.76453307, 17.69939358, 20.87303997,
         24.33584211, 28.14388532, 32.36253393, 37.07020868, 42.36299868),
      c(16.43763399, 22.07592005, 27.49293159, 33.11628022, 39.14366436, 45.72590957, 53.01070123,
         61.16173704, 70.37250826, 80.88041709, 92.98424615, 107.06768987)
   )

   # expected limits for alpha = 0.10 and gamma = 0.05
   # computed using "tsqlim" function from PLS_Toolbox
   expT2lim2 <- rbind(
      c(2.87478394, 5.14334644, 7.32156708, 9.55303105, 11.90044572, 14.40708180, 17.11153965,
         20.05346964, 23.27685391, 26.83267841, 30.78172763, 35.19795488),
      c(11.96070234, 16.61285114, 21.04123968, 25.60304588, 30.45666797, 35.71776166, 41.49572457,
         47.90883728, 55.09430867, 63.21788003, 72.48520544, 83.15679204)
   )

   nobj <- nrow(dist$T2)
   ncomp <- seq_len(ncol(dist$T2))
   expect_equivalent(hotelling.crit(nobj, ncomp, 0.05, 0.01), expT2lim1, tolerance = 10^-5)
   expect_equivalent(hotelling.crit(nobj, ncomp, 0.10, 0.05), expT2lim2, tolerance = 10^-5)
})

## chisq/hotelling for excluded data data
context("misc: computing limits (chisq/hotelling, excluded data)")

m <- getPCARes(X4$data, 10)
dist <- ldecomp.getDistances(m$scores, m$loadings, m$residuals, m$eigenvals)
rows_excluded <- X4$exp_exclrows

test_that("critical limits for Q are correct for excluded data (chisq)", {

   # expected distribution parameters
   expParams <- list(
      u0 = apply(dist$Q[-rows_excluded, , drop = F], 2, mean),
      Nu = apply(dist$Q[-rows_excluded, , drop = F], 2, function(x) 2 * (mean(x) / sd(x))^2),
      nobj = nrow(dist$Q) - length(rows_excluded)
   )

   # expected limits for alpha = 0.05 and gamma = 0.01
   # computed using "residuallimit" function from PLS_Toolbox
   expQlim1 <- rbind(
      c(8.48240511, 4.44080558, 0.89616079, 0.56211531, 0.32748958, 0.18707463, 0.11620620,
         0.05214964, 0.02356848, 0.00000000),
      c(16.22421281, 11.81101671, 1.85705202, 1.49503355, 0.71805040, 0.49755423, 0.30906855,
         0.17377461, 0.07853561, 0.00000000)
   )

   # expected limits for alpha = 0.10 and gamma = 0.05
   # computed using "residuallimit" function from PLS_Toolbox
   expQlim2 <- rbind(
      c(7.24620424, 3.41329992, 0.74768643, 0.43205407, 0.26852429, 0.14378964, 0.08931862,
         0.03672904, 0.01659930, 0.00000000),
      c(13.81464099, 9.39586381, 1.55391044, 1.18932451, 0.59370604, 0.39581282, 0.24586927,
         0.13272621, 0.05998421, 0.00000000)
   )

   # parameters
   p <- ddmoments.param(dist$Q[-rows_excluded, ])
   expect_equivalent(p, expParams, tolerance = 10^-5)

   # limits
   expect_equivalent(chisq.crit(p, 0.05, 0.01), expQlim1, tolerance = 10^-5)
   expect_equivalent(chisq.crit(p, 0.10, 0.05), expQlim2, tolerance = 10^-5)
})

test_that("critical limits for T2 are correct for excluded data (chisq/hotelling)", {

   # expected limits for alpha = 0.05 and gamma = 0.01
   # computed using "residuallimit" function from PLS_Toolbox
   expT2lim1 <- rbind(
      c(4.19597182, 6.95671580, 9.61203588, 12.35902290, 15.28714920, 18.46287368, 21.94998503,
         25.81826344, 30.14945777, 35.04323329),
      c(16.57969094, 22.52147374, 28.33766821, 34.48651357, 41.20190951, 48.68181023, 57.13678256,
         66.81570665, 78.02909222, 91.17751461)
   )

   # expected limits for alpha = 0.10 and gamma = 0.05
   # computed using "residuallimit" function from PLS_Toolbox
   expT2lim2 <- rbind(
      c(2.89384646, 5.20718834, 7.45497071, 9.78540224, 12.26769498, 14.95365699, 17.89298964,
         21.13982013, 24.75715160, 28.82121257),
      c(11.94402185, 16.77785866, 21.45842445, 26.36104904, 31.66743997, 37.52399529, 44.08105163,
         51.51194381, 60.02878045, 69.90058746)
   )

   # limits
   nobj <- nrow(dist$T2) - length(rows_excluded)
   ncomp <- 1:ncol(dist$T2)
   expect_equivalent(hotelling.crit(nobj, ncomp, 0.05, 0.01), expT2lim1, tolerance = 10^-5)
   expect_equivalent(hotelling.crit(nobj, ncomp, 0.10, 0.05), expT2lim2, tolerance = 10^-5)
})

###################################################
# Block 4. Computing critical limits (ddmoments)  #
###################################################

## ddmoments for full data data
context("misc: computing limits (ddmoments, full data)")

### in this case we use 11 components as the 12th explain mostly noise for Q
m <- getPCARes(X1$data, 11)
dist <- ldecomp.getDistances(m$scores, m$loadings, m$residuals, m$eigenvals)
pQ <- ddmoments.param(dist$Q)
pT2 <- ddmoments.param(dist$T2)

test_that("critical limits for Q are correct (ddmoments)", {

   # expected distribution parameters
   expParams <- list(
      u0 = c(5.39623603, 3.22376502, 1.65661907, 0.68981822, 0.38111636, 0.22105099, 0.12476396,
         0.07148856, 0.04489746, 0.02151256, 0.00678829),
      Nu = c(10.00000000, 4.00000000, 4.00000000, 3.00000000, 3.00000000, 3.00000000, 5.00000000,
         4.00000000, 2.00000000, 2.00000000, 1.00000000),
      nobj = nrow(dist$Q)
   )

   # expected limits for alpha = 0.05 and gamma = 0.01
   # computed using DDSimca toolbox
   expQlim1 <- rbind(
      c(11.34617157, 19.08855942, 11.42533747, 6.34336609, 3.34064053, 1.84178155, 0.55799538,
         0.39965752, 0.47200886, 0.25476038, 0.17850637),
      c(19.47199649, 31.77017452, 18.32858290, 10.17605927, 5.41986135, 3.02485080, 0.94234321,
         0.67494207, 0.81004899, 0.42401219, 0.28960906)
   )

   # expected limits for alpha = 0.10 and gamma = 0.05
   # computed using DDSimca toolbox
   expQlim2 <- rbind(
      c(10.00967132, 16.97646011, 10.25820924, 5.69537459, 2.99072482, 1.64367017, 0.49436318,
         0.35408172, 0.41640949, 0.22657181, 0.15980870),
      c(17.04539107, 28.00480337, 16.29329975, 9.04606673, 4.80551079, 2.67446799, 0.82790983,
         0.59298052, 0.70910047, 0.37375866, 0.25678138)
   )

   # check parameters (round DoF first)
   pQ$Nu <- round(pQ$Nu)
   expect_equivalent(pQ, expParams, tolerance = 10^-5)

   # limits
   lim1 <- scale(dd.crit(pQ, pT2, 0.05, 0.01), center = FALSE, scale = pQ$Nu / pQ$u0)
   lim2 <- scale(dd.crit(pQ, pT2, 0.10, 0.05), center = FALSE, scale = pQ$Nu / pQ$u0)

   expect_equivalent(lim1, expQlim1, tolerance = 10^-5)
   expect_equivalent(lim2, expQlim2, tolerance = 10^-5)
})

test_that("critical limits for T2 are correct (ddmoments)", {

   # expected distribution parameters
   expParams <- list(
      u0 = c(0.96875000, 1.93750000, 2.90625000, 3.87500000, 4.84375000, 5.81250000, 6.78125000,
         7.75000000, 8.71875000, 9.68750000, 10.65625000),
      Nu = c(2.00000000, 10.00000000, 13.00000000, 14.00000000, 13.00000000, 12.00000000, 8.00000000,
         9.00000000, 10.00000000, 12.00000000, 15.00000000),
      nobj = nrow(dist$T2)
   )

   # expected limits for alpha = 0.05 and gamma = 0.01
   # computed using DDSimca toolbox
   expT2lim1 <- rbind(
      c(10.18450977, 4.58893048, 6.16731299, 7.63572085, 9.79787223, 12.10733682, 18.95532441,
         19.25620258, 18.33211759, 19.12054367, 18.68127639),
      c(17.47838355, 7.63761785, 9.89363402, 12.24926117, 15.89608595, 19.88449041, 32.01177265,
         32.51989603, 31.46109039, 31.82340773, 30.30853722)
   )

   # expected limits for alpha = 0.10 and gamma = 0.05
   # computed using DDSimca toolbox
   expT2lim2 <- rbind(
      c(8.98484522, 4.08117729, 5.53730578, 6.85571191, 8.77159317, 10.80501016, 16.79371331,
         17.06028019, 16.17272140, 17.00490539, 16.72450430),
      c(15.30022271, 6.73241458, 8.79500317, 10.88905154, 14.09423741, 17.58117559, 28.12442515,
         28.57084459, 27.54040088, 28.05172743, 26.87301266)
   )

   # check parameters (round DoF first)
   pT2$Nu <- round(pT2$Nu)
   expect_equivalent(pT2, expParams, tolerance = 10^-5)

   # limits
   lim1 <- scale(dd.crit(pQ, pT2, 0.05, 0.01), center = FALSE, scale = pT2$Nu / pT2$u0)
   lim2 <- scale(dd.crit(pQ, pT2, 0.10, 0.05), center = FALSE, scale = pT2$Nu / pT2$u0)

   expect_equivalent(lim1, expT2lim1, tolerance = 10^-5)
   expect_equivalent(lim2, expT2lim2, tolerance = 10^-5)
})

## ddmoments for excluded data
context("misc: computing limits (ddmoments, excluded data)")

m <- getPCARes(X4$data, 9)
dist <- ldecomp.getDistances(m$scores, m$loadings, m$residuals, m$eigenvals)
rows_excluded <- X4$exp_exclrows
pQ <- ddmoments.param(dist$Q[-rows_excluded, ])
pT2 <- ddmoments.param(dist$T2[-rows_excluded, ])

test_that("critical limits for Q are correct for excluded data (ddmoments)", {

   # expected distribution parameters
   expParams <- list(
      u0 = c(4.43617757, 2.19049660, 0.44027710, 0.25151771, 0.14625433, 0.08237345, 0.05117557,
         0.02675517, 0.00723308),
      Nu = c(7.00000000, 3.00000000, 5.00000000, 3.00000000, 4.00000000, 3.00000000, 3.00000000,
         2.00000000, 1.00000000),
      nobj = nrow(dist$Q) - length(rows_excluded)
   )

   # expected limits for alpha = 0.05 and gamma = 0.01
   # computed using DDSimca toolbox
   expQlim1 <- rbind(
      c(11.60190138, 19.20059700, 2.76585832, 2.42038062, 1.05556531, 0.75748212, 0.59999005,
         0.35177998, 0.20881386),
      c(20.51821091, 30.94285188, 4.28239312, 3.81776382, 1.66498567, 1.20720511, 0.90716035,
         0.56691340, 0.32937052)
   )

   # expected limits for alpha = 0.10 and gamma = 0.05
   # computed using DDSimca toolbox
   expQlim2 <- rbind(
      c(10.13171606, 17.18942863, 2.50182801, 2.17893453, 0.95026695, 0.68010334, 0.54599027,
         0.31493275, 0.18798355),
      c(17.78135669, 27.40039229, 3.82840757, 3.39793186, 1.48189048, 1.07182017, 0.81563549,
         0.50201092, 0.29315029)
   )

   # check parameters (round DoF first)
   pQ$Nu <- round(pQ$Nu)
   expect_equivalent(pQ, expParams, tolerance = 10^-5)

   # limits
   lim1 <- scale(dd.crit(pQ, pT2, 0.05, 0.01), center = FALSE, scale = pQ$Nu / pQ$u0)
   lim2 <- scale(dd.crit(pQ, pT2, 0.10, 0.05), center = FALSE, scale = pQ$Nu / pQ$u0)

   expect_equivalent(lim1, expQlim1, tolerance = 10^-5)
   expect_equivalent(lim2, expQlim2, tolerance = 10^-5)
})

test_that("critical limits for T2 are correct for excluded data (ddmoments)", {

   # expected distribution parameters
   expParams <- list(
      u0 = c(0.96551724, 1.93103448, 2.89655172, 3.86206897, 4.82758621, 5.79310345, 6.75862069,
         7.72413793, 8.68965517),
      Nu = c(3.00000000, 13.00000000, 15.00000000, 15.00000000, 14.00000000, 14.00000000, 20.00000000,
         14.00000000, 17.00000000),
      nobj = nrow(dist$T2) - length(rows_excluded)
   )

   # expected limits for alpha = 0.05 and gamma = 0.01
   # computed using DDSimca toolbox
   expT2lim1 <- rbind(
      c(5.89192305, 3.90607053, 6.06546174, 7.43301692, 9.95493338, 11.41536020, 11.88586181,
         14.50826197, 14.75672477),
      c(10.41999203, 6.29485437, 9.39118662, 11.72439691, 15.70231730, 18.19274770, 17.97093555,
         23.38088765, 23.27637623)
   )

   # expected limits for alpha = 0.10 and gamma = 0.05
   # computed using DDSimca toolbox
   expT2lim2 <- rbind(
      c(5.14530244, 3.49692880, 5.48644953, 6.69153318, 8.96187480, 10.24925118, 10.81612080,
         12.98859268, 13.28466146),
      c(9.03010480, 5.57419464, 8.39560708, 10.43508810, 13.97556442, 16.15247798, 16.15781902,
         20.70415152, 20.71671903)
   )

   # check parameters (round DoF first)
   pT2$Nu <- round(pT2$Nu)
   expect_equivalent(pT2, expParams, tolerance = 10^-5)

   # limits
   lim1 <- scale(dd.crit(pQ, pT2, 0.05, 0.01), center = FALSE, scale = pT2$Nu / pT2$u0)
   lim2 <- scale(dd.crit(pQ, pT2, 0.10, 0.05), center = FALSE, scale = pT2$Nu / pT2$u0)

   expect_equivalent(lim1, expT2lim1, tolerance = 10^-5)
   expect_equivalent(lim2, expT2lim2, tolerance = 10^-5)
})


###################################################
# Block 5. Computing critical limits (ddrobust)   #
###################################################

## ddmoments for full data data
context("misc: computing limits (ddrobust, full data)")

### in this case we use 11 components as the 12th explain mostly noise for Q
m <- getPCARes(X1$data, 11)
dist <- ldecomp.getDistances(m$scores, m$loadings, m$residuals, m$eigenvals)
pQ <- ddrobust.param(dist$Q)
pT2 <- ddrobust.param(dist$T2)

test_that("critical limits for Q are correct (ddrobust)", {

   # expected distribution parameters
   expParams <- list(
      u0 = c(5.59398247, 3.14412554, 1.68373781, 0.63464055, 0.33473045, 0.21529782, 0.13614951,
         0.06862920, 0.04666029, 0.02054372, 0.00374660),
      Nu = c(18.00000000, 10.00000000, 6.00000000, 3.00000000, 4.00000000, 3.00000000, 5.00000000,
         3.00000000, 4.00000000, 2.00000000, 1.00000000),
      nobj = nrow(dist$Q)
   )

   # expected limits for alpha = 0.05 and gamma = 0.01
   # computed using DDSimca toolbox
   expQlim1 <- rbind(
      c(10.15325434, 14.52405375, 9.87019680, 5.01044538, 2.52248917, 2.34463394, 0.88961632,
         0.74738500, 0.39573108, 0.21597701, 0.09364917),
      c(15.68388669, 20.95236870, 15.01145008, 8.33916906, 3.96573316, 3.62179177, 1.37420388,
         1.15449701, 0.60641832, 0.37065397, 0.15380476)
   )

   # expected limits for alpha = 0.10 and gamma = 0.05
   # computed using DDSimca toolbox
   expQlim2 <- rbind(
      c(9.20367955, 13.38917413, 8.98186792, 4.45605266, 2.27646590, 2.12535397, 0.80641568,
         0.67748643, 0.35943919, 0.19053642, 0.08357579),
      c(14.06529482, 19.09677672, 13.51144603, 7.35081860, 3.54188909, 3.24801945, 1.23238475,
         1.03535183, 0.54485629, 0.32446297, 0.13598882)
   )

   # check parameters (round DoF first)
   pQ$Nu <- round(pQ$Nu)
   expect_equivalent(pQ, expParams, tolerance = 10^-5)

   # limits
   lim1 <- scale(dd.crit(pQ, pT2, 0.05, 0.01), center = FALSE, scale = pQ$Nu / pQ$u0)
   lim2 <- scale(dd.crit(pQ, pT2, 0.10, 0.05), center = FALSE, scale = pQ$Nu / pQ$u0)

   expect_equivalent(lim1, expQlim1, tolerance = 10^-5)
   expect_equivalent(lim2, expQlim2, tolerance = 10^-5)
})

test_that("critical limits for T2 are correct (ddrobust)", {

   # expected distribution parameters
   expParams <- list(
      u0 = c(1.23877706, 1.84445603, 2.67812507, 3.91673370, 4.51759976, 5.66332668, 5.96116787,
         7.19886896, 8.06726598, 8.95166844, 10.01296469),
      Nu = c(3.00000000, 22.00000000, 17.00000000, 11.00000000, 15.00000000, 18.00000000, 16.00000000,
         18.00000000, 18.00000000, 10.00000000, 14.00000000),
      nobj = nrow(dist$T2)
   )

   # expected limits for alpha = 0.05 and gamma = 0.01
   # computed using DDSimca toolbox
   expT2lim1 <- rbind(
      c(13.49051625, 3.87287602, 5.54095383, 8.43336946, 9.07842620, 10.27911626, 12.17217082,
         13.06617385, 15.20430507, 18.82185388, 17.87728459),
      c(20.83900601, 5.58700262, 8.42716245, 14.03613618, 14.27265426, 15.87830752, 18.80253774,
         20.18351784, 23.29907765, 32.30156273, 29.36076688)
   )

   # expected limits for alpha = 0.10 and gamma = 0.05
   # computed using DDSimca toolbox
   expT2lim2 <- rbind(
      c(12.22882677, 3.57025747, 5.04226172, 7.50023912, 8.19298966, 9.31777034, 11.03377852,
         11.84417065, 13.80994172, 16.60477015, 15.95431303),
      c(18.68840097, 5.09220428, 7.58508672, 12.37258654, 12.74724151, 14.23965123, 16.86209814,
         18.10055980, 20.93381524, 28.27613333, 25.95977002)
   )

   # check parameters (round DoF first)
   pT2$Nu <- round(pT2$Nu)
   expect_equivalent(pT2, expParams, tolerance = 10^-5)

   # limits
   lim1 <- scale(dd.crit(pQ, pT2, 0.05, 0.01), center = FALSE, scale = pT2$Nu / pT2$u0)
   lim2 <- scale(dd.crit(pQ, pT2, 0.10, 0.05), center = FALSE, scale = pT2$Nu / pT2$u0)

   expect_equivalent(lim1, expT2lim1, tolerance = 10^-5)
   expect_equivalent(lim2, expT2lim2, tolerance = 10^-5)
})


## ddmoments for excluded data
context("misc: computing limits (ddrobust, excluded data)")

m <- getPCARes(X4$data, 9)
dist <- ldecomp.getDistances(m$scores, m$loadings, m$residuals, m$eigenvals)
rows_excluded <- X4$exp_exclrows
pQ <- ddrobust.param(dist$Q[-rows_excluded, ])
pT2 <- ddrobust.param(dist$T2[-rows_excluded, ])

test_that("critical limits for Q are correct for excluded data (ddrobust)", {

   # expected distribution parameters
   expParams <- list(
      u0 = c(4.62537076, 2.40195599, 0.43916799, 0.23975306, 0.13645627, 0.07560735, 0.04351790,
         0.02600730, 0.00787551),
      Nu = c(16.00000000, 3.00000000, 4.00000000, 3.00000000, 5.00000000, 4.00000000, 2.00000000,
         2.00000000, 1.00000000),
      nobj = nrow(dist$Q) - length(rows_excluded)
   )

   # expected limits for alpha = 0.05 and gamma = 0.01
   # computed using DDSimca toolbox
   expQlim1 <- rbind(
      c(8.71406195, 27.16167173, 4.67241416, 1.99760592, 0.64638798, 0.49704699, 1.18743408,
         0.45737021, 0.20709631),
      c(13.61362649, 41.37423787, 6.80661271, 3.25834093, 1.06828931, 0.80101944, 1.65599362,
         0.69152500, 0.33374746)
   )

   # expected limits for alpha = 0.10 and gamma = 0.05
   # computed using DDSimca toolbox
   expQlim2 <- rbind(
      c(7.86416256, 24.67071673, 4.29149155, 1.78273328, 0.57486684, 0.44498376, 1.10230325,
         0.41620638, 0.18540399),
      c(12.14433627, 37.13321925, 6.17541759, 2.87712373, 0.94039845, 0.70931558, 1.51864614,
         0.62175594, 0.29553873)
   )

   # check parameters (round DoF first)
   pQ$Nu <- round(pQ$Nu)
   expect_equivalent(pQ, expParams, tolerance = 10^-5)

   # limits
   lim1 <- scale(dd.crit(pQ, pT2, 0.05, 0.01), center = FALSE, scale = pQ$Nu / pQ$u0)
   lim2 <- scale(dd.crit(pQ, pT2, 0.10, 0.05), center = FALSE, scale = pQ$Nu / pQ$u0)

   expect_equivalent(lim1, expQlim1, tolerance = 10^-5)
   expect_equivalent(lim2, expQlim2, tolerance = 10^-5)
})

test_that("critical limits for T2 are correct for excluded data (ddrobust)", {

   # expected distribution parameters
   expParams <- list(
      u0 = c(1.39125723, 2.06314350, 2.61209799, 3.71494609, 5.03000803, 5.67830732, 6.11739113,
         7.31069105, 8.12330118),
      Nu = c(3.00000000, 19.00000000, 25.00000000, 12.00000000, 9.00000000, 12.00000000, 37.0000000,
         21.00000000, 15.00000000),
      nobj = nrow(dist$Q) - length(rows_excluded)
   )

   # expected limits for alpha = 0.05 and gamma = 0.01
   # computed using DDSimca toolbox
   expT2lim1 <- rbind(
      c(13.97913356, 3.68373634, 4.44651850, 7.73816836, 13.23719406, 12.44317048, 9.02269130,
         12.24451916, 14.24081027),
      c(21.83903490, 5.61128141, 6.47753566, 12.62190422, 21.87719039, 20.05287550, 12.58303051,
         18.51321075, 22.94987405)
   )

   # expected limits for alpha = 0.10 and gamma = 0.05
   # computed using DDSimca toolbox
   expT2lim2 <- rbind(
      c(12.61572152, 3.34590657, 4.08401223, 6.90581165, 11.77253307, 11.13980940, 8.37582660,
         11.14249858, 12.74915524),
      c(19.48199356, 5.03610347, 5.87685672, 11.14517509, 19.25815009, 17.75714331, 11.53939875,
         16.64538321, 20.32248206)
   )

   # check parameters (round DoF first)
   pT2$Nu <- round(pT2$Nu)
   expect_equivalent(pT2, expParams, tolerance = 10^-5)

   # limits
   lim1 <- scale(dd.crit(pQ, pT2, 0.05, 0.01), center = FALSE, scale = pT2$Nu / pT2$u0)
   lim2 <- scale(dd.crit(pQ, pT2, 0.10, 0.05), center = FALSE, scale = pT2$Nu / pT2$u0)

   expect_equivalent(lim1, expT2lim1, tolerance = 10^-5)
   expect_equivalent(lim2, expT2lim2, tolerance = 10^-5)
})
svkucheryavski/mdatools documentation built on Aug. 25, 2023, 12:27 p.m.