test_that("Test shrinkage estimator", { # Parameters nSamples <- 500 pTrue <- 2 # True moments trueMean <- c(0,0) trueSigma <- matrix(c(3,2,2,2), nrow=2) chol_trueSigma <- chol(trueSigma) # we run 100 shrinkage estimators lambdas <- rep(0, 100) for(i in seq(100)){ rr <- replicate(nSamples, trueMean) + t(chol_trueSigma)%*%matrix(stats::rnorm(pTrue*nSamples), nrow=pTrue,ncol=nSamples) # Estimate mean and covariance from samples mean_est <- rowMeans(rr) Sigma_est <- cov(t(rr)) mean_est trueMean Sigma_est rr_centered <- rr- replicate(nSamples, mean_est) rowMeans(rr_centered) x <- t(rr) #x <- t(rr_centered) lambdas[i] <- schaferStrimmer_cov(x)$lambda_star } # The average over 100 runs must be within a certain range mean_lambdas <- mean(lambdas) # We expect this to be lower than the 99.99% quantile over 200 simulations of this scenario expect_lte(mean_lambdas, 0.005191634) # We expect this to be greater than the 0.01% quantile over 200 simulations of this scenario expect_gte(mean_lambdas, 0.004843328) }) test_that("Test behavior for p=1", { # Parameters nSamples <- 500 pTrue <- 1 samples <- matrix(stats::rnorm(n=nSamples,sd=2),ncol=pTrue) exp_sample_squared <- matrix(mean(samples^2),1,1) # The function should return E[x^2] and a warning expect_warning(expect_equal(schaferStrimmer_cov(samples)$shrink_cov, exp_sample_squared)) })