Author: Kabir O. Olorede

# Getting Started with spfcICOMP

#### Kabir O. Olorede

# Introduction

The `spfcICOMP` package implements Shrinkage Principal Fitted Components (SPFC) methodology for sufficient dimension reduction under high-dimensional settings.

The package combines

- shrinkage covariance estimation,
- principal fitted components,
- information-complexity model selection,
- adaptive feature screening, and
- downstream predictive modelling

within a unified framework.

# Load package

    library(spfcICOMP)

# Simulate data

    set.seed(123)

    sim <- simulate_spfc_continuous(
      n = 100,
      p = 50,
      d = 1,
      s = 5,
      rho_x = 0.5,
      snr = 2
    )

    X <- sim$X
    y <- sim$y

# Fit SPFC

    fit <- spfc_fit(
      X = X,
      y = y,
      d = 1,
      ytype = "continuous",
      cov_method = "mec",
      nslices = 5,
      poly_degree = 2
    )

    fit

    ##
    ## Shrinkage Principal Fitted Components Fit
    ## =========================================
    ##
    ## Response type:       continuous
    ## Covariance method:   mec
    ## Structural dimension: 1
    ## Shrinkage rho:       0.334172
    ## Slices used:         5
    ##
    ## Leading eigenvalues:
    ## [1] 1.756594 0.444314 0.000000 0.000000 0.000000 0.000000
    ##
    ## Reduced score matrix dimension:
    ## [1] 100   1

    summary(fit)

    ##
    ## Summary of Shrinkage Principal Fitted Components Fit
    ## ====================================================
    ##
    ## Response type:       continuous
    ## Covariance method:   mec
    ## Structural dimension: 1
    ## Shrinkage rho:       0.334172
    ## Slices used:         5
    ##
    ## Preprocessing:
    ## Centred:             TRUE
    ## Scaled:              FALSE
    ##
    ## Score matrix dimension:
    ## [1] 100   1
    ##
    ## Eigenvalue summary:
    ##    component eigenvalue proportion cumulative_proportion
    ## 1          1  1.7565935  0.7981225             0.7981225
    ## 2          2  0.4443135  0.2018775             1.0000000
    ## 3          3  0.0000000  0.0000000             1.0000000
    ## 4          4  0.0000000  0.0000000             1.0000000
    ## 5          5  0.0000000  0.0000000             1.0000000
    ## 6          6  0.0000000  0.0000000             1.0000000
    ## 7          7  0.0000000  0.0000000             1.0000000
    ## 8          8  0.0000000  0.0000000             1.0000000
    ## 9          9  0.0000000  0.0000000             1.0000000
    ## 10        10  0.0000000  0.0000000             1.0000000

# Extract estimated directions

    coef(fit)

    ##               dir1
    ##  [1,] -0.144789015
    ##  [2,]  0.066982646
    ##  [3,]  0.755598441
    ##  [4,]  0.437298165
    ##  [5,]  0.161266594
    ##  [6,]  0.078488719
    ##  [7,]  0.040066485
    ##  [8,] -0.027000408
    ##  [9,] -0.038766088
    ## [10,] -0.048790194
    ## [11,]  0.039893765
    ## [12,] -0.063439753
    ## [13,] -0.045789728
    ## [14,] -0.107824894
    ## [15,] -0.151024192
    ## [16,]  0.015384677
    ## [17,]  0.063066373
    ## [18,] -0.051192235
    ## [19,] -0.051227957
    ## [20,] -0.032227983
    ## [21,]  0.010966359
    ## [22,] -0.092314116
    ## [23,] -0.009047916
    ## [24,] -0.033750824
    ## [25,]  0.056240919
    ## [26,] -0.026041093
    ## [27,]  0.007381842
    ## [28,]  0.076870322
    ## [29,] -0.033637149
    ## [30,] -0.075260220
    ## [31,]  0.022255242
    ## [32,] -0.030489694
    ## [33,]  0.075816476
    ## [34,] -0.031958361
    ## [35,] -0.047534473
    ## [36,] -0.038778821
    ## [37,] -0.055427849
    ## [38,] -0.020983452
    ## [39,]  0.124279900
    ## [40,]  0.120473767
    ## [41,]  0.104758094
    ## [42,]  0.051068370
    ## [43,] -0.065226539
    ## [44,] -0.081000382
    ## [45,] -0.105136881
    ## [46,]  0.040933147
    ## [47,]  0.042819366
    ## [48,]  0.023815682
    ## [49,]  0.099651957
    ## [50,] -0.003062986

# Obtain reduced scores

    scores <- fitted(fit)

    head(scores)

    ##            SPFC1
    ## [1,]  1.85053361
    ## [2,]  2.00267298
    ## [3,] -2.43877726
    ## [4,]  0.68275423
    ## [5,] -0.07949886
    ## [6,]  2.65260788

# Predict new observations

    predict(
      fit,
      newdata = X[1:5, ]
    )

    ##            SPFC1
    ## [1,]  1.85053361
    ## [2,]  2.00267298
    ## [3,] -2.43877726
    ## [4,]  0.68275423
    ## [5,] -0.07949886

# Structural dimension selection

    dsel <- spfc_select_dimension(
      X = X,
      y = y,
      d_grid = 1:3,
      cov_method = "mec",
      ytype = "continuous"
    )

    ## Scoring d = 1 using covariance method: mec

    ## Scoring d = 2 using covariance method: mec

    ## Scoring d = 3 using covariance method: mec

    dsel$criteria

    ##   cov_method      ytype d       rho nslices_used reduced_model    loglik npar
    ## 1        mec continuous 1 0.3341716            5            lm -81.91911    3
    ## 2        mec continuous 2 0.3341716            5            lm -74.30525    4
    ## 3        mec continuous 3 0.3341716            5            lm -73.17670    5
    ##        AIC      BIC     CAIC ICOMP_IFIM ICOMP_MISSPEC   CICOMP
    ## 1 169.8382 177.6537 180.6537   164.2588      164.1571 180.9971
    ## 2 156.6105 167.0312 171.0312   149.1793      148.9210 171.3878
    ## 3 156.3534 169.3793 174.3793   147.4786      147.1968 175.3587

    dsel$selected

    ##       criterion selected_d minimum_value
    ## 1           AIC          3      156.3534
    ## 2           BIC          2      167.0312
    ## 3          CAIC          2      171.0312
    ## 4    ICOMP_IFIM          3      147.4786
    ## 5 ICOMP_MISSPEC          3      147.1968
    ## 6        CICOMP          2      171.3878

# Feature screening

The default C1F-calibrated feature-screening rule uses the covariance of the fitted downstream reduced model. The reduced-space model is therefore fitted before C1F-based screening is applied.

    reduced_model <- fit_reduced_model(
      Z = scores,
      y = y,
      ytype = "continuous"
    )

    vsel <- spfc_select_variables(
      fit = fit,
      method = "adaptive_weighted_l1",
      selection_rule = "c1f",
      reduced_model = reduced_model
    )

    head(vsel)

    ##   variable importance       weight      penalty shrunk_importance selected
    ## 1        3  0.7555984 1.013777e-05 7.514317e-05         0.7555233     TRUE
    ## 2        4  0.4372982 3.026699e-05 2.243450e-04         0.4370738     TRUE
    ## 3        5  0.1612666 2.225542e-04 1.649616e-03         0.1596170     TRUE
    ## 4       15  0.1510242 2.537649e-04 1.880956e-03         0.1491432     TRUE
    ## 5        1  0.1447890 2.760917e-04 2.046447e-03         0.1427426     TRUE
    ## 6       39  0.1242799 3.747337e-04 2.777601e-03         0.1215023     TRUE

# Benchmark covariance estimators

    bench <- benchmark_spfc(
      X = X,
      y = y,
      d = 1,
      methods = c(
        "mec",
        "oas",
        "sre",
        "sde",
        "cse"
      ),
      verbose = FALSE
    )

    bench

    ##
    ## SPFC Benchmark
    ## ==============
    ##
    ## Response type:       continuous
    ## Structural dimension: 1
    ## Variable method:     adaptive_weighted_l1
    ## Validation:          resubstitution
    ## Methods compared:    mec, oas, sre, sde, cse
    ##
    ## Summary:
    ##   cov_method     validation      ytype d       rho nslices_used reduced_model
    ## 1        mec resubstitution continuous 1 0.3341716            5            lm
    ## 2        oas resubstitution continuous 1 0.1898839           NA            lm
    ## 3        sre resubstitution continuous 1 0.1000000           NA            lm
    ## 4        sde resubstitution continuous 1        NA           NA            lm
    ## 5        cse resubstitution continuous 1 0.5000000           NA            lm
    ##   runtime_sec      rmse       mae mean_rmse sd_rmse mean_mae sd_mae accuracy
    ## 1 0.020030975 0.5489503 0.4491404        NA      NA       NA     NA       NA
    ## 2 0.009188890 0.5614532 0.4595925        NA      NA       NA     NA       NA
    ## 3 0.007362843 0.3764402 0.3051238        NA      NA       NA     NA       NA
    ## 4 0.006926060 0.6179009 0.5107200        NA      NA       NA     NA       NA
    ## 5 0.013350010 0.4674027 0.3837767        NA      NA       NA     NA       NA
    ##   sensitivity specificity precision f1 balanced_accuracy mean_accuracy
    ## 1          NA          NA        NA NA                NA            NA
    ## 2          NA          NA        NA NA                NA            NA
    ## 3          NA          NA        NA NA                NA            NA
    ## 4          NA          NA        NA NA                NA            NA
    ## 5          NA          NA        NA NA                NA            NA
    ##   mean_sensitivity mean_specificity mean_precision mean_f1
    ## 1               NA               NA             NA      NA
    ## 2               NA               NA             NA      NA
    ## 3               NA               NA             NA      NA
    ## 4               NA               NA             NA      NA
    ## 5               NA               NA             NA      NA
    ##   mean_balanced_accuracy n_selected
    ## 1                     NA         36
    ## 2                     NA         32
    ## 3                     NA         31
    ## 4                     NA         27
    ## 5                     NA         32

    summary(bench)

    ##
    ## Summary of SPFC Benchmark
    ## =========================
    ##
    ## Response type:       continuous
    ## Structural dimension: 1
    ## Variable method:     adaptive_weighted_l1
    ## Validation:          resubstitution
    ## Selection metric:    rmse
    ## Smaller is better:   TRUE
    ## Best method:         sre
    ##
    ## Benchmark table:
    ##   cov_method     validation      ytype d       rho nslices_used reduced_model
    ## 1        mec resubstitution continuous 1 0.3341716            5            lm
    ## 2        oas resubstitution continuous 1 0.1898839           NA            lm
    ## 3        sre resubstitution continuous 1 0.1000000           NA            lm
    ## 4        sde resubstitution continuous 1        NA           NA            lm
    ## 5        cse resubstitution continuous 1 0.5000000           NA            lm
    ##   runtime_sec      rmse       mae mean_rmse sd_rmse mean_mae sd_mae accuracy
    ## 1 0.020030975 0.5489503 0.4491404        NA      NA       NA     NA       NA
    ## 2 0.009188890 0.5614532 0.4595925        NA      NA       NA     NA       NA
    ## 3 0.007362843 0.3764402 0.3051238        NA      NA       NA     NA       NA
    ## 4 0.006926060 0.6179009 0.5107200        NA      NA       NA     NA       NA
    ## 5 0.013350010 0.4674027 0.3837767        NA      NA       NA     NA       NA
    ##   sensitivity specificity precision f1 balanced_accuracy mean_accuracy
    ## 1          NA          NA        NA NA                NA            NA
    ## 2          NA          NA        NA NA                NA            NA
    ## 3          NA          NA        NA NA                NA            NA
    ## 4          NA          NA        NA NA                NA            NA
    ## 5          NA          NA        NA NA                NA            NA
    ##   mean_sensitivity mean_specificity mean_precision mean_f1
    ## 1               NA               NA             NA      NA
    ## 2               NA               NA             NA      NA
    ## 3               NA               NA             NA      NA
    ## 4               NA               NA             NA      NA
    ## 5               NA               NA             NA      NA
    ##   mean_balanced_accuracy n_selected
    ## 1                     NA         36
    ## 2                     NA         32
    ## 3                     NA         31
    ## 4                     NA         27
    ## 5                     NA         32

# Simulation study

    results <- run_spfc_simulation(
      response_type = "continuous",
      nrep = 5,
      n = 100,
      p = 50,
      d = 1,
      s = 5,
      rho_x = 0.5,
      snr = 2,
      cov_methods = c(
        "mec",
        "oas"
      )
    )

    summary_results <-
      summarise_spfc_simulation(
        results
      )

    summary_results

    ##        ytype cov_method criterion selection_rule      variable_method   n  p
    ## 1 continuous        mec   KNOWN_D            c1f adaptive_weighted_l1 100 50
    ## 2 continuous        mec   KNOWN_D            c1f        c1f_extension 100 50
    ## 3 continuous        oas   KNOWN_D            c1f adaptive_weighted_l1 100 50
    ## 4 continuous        oas   KNOWN_D            c1f        c1f_extension 100 50
    ##   true_d s rho_x snr nrep dimension_recovery_rate mean_selected_d sd_selected_d
    ## 1      1 5   0.5   2    5                       1               1             0
    ## 2      1 5   0.5   2    5                       1               1             0
    ## 3      1 5   0.5   2    5                       1               1             0
    ## 4      1 5   0.5   2    5                       1               1             0
    ##   mean_runtime_sec sd_runtime_sec mean_subspace_distance sd_subspace_distance
    ## 1      0.018012571    0.002230873              0.6208041            0.1117431
    ## 2      0.021338415    0.003860143              0.6208041            0.1117431
    ## 3      0.009530401    0.002788551              0.6260605            0.1097125
    ## 4      0.008028221    0.002309219              0.6260605            0.1097125
    ##   mean_precision sd_precision mean_recall sd_recall mean_f1_variable
    ## 1      0.1455734  0.006367509           1         0        0.2541062
    ## 2      0.1455734  0.006367509           1         0        0.2541062
    ## 3      0.1545897  0.007176028           1         0        0.2677293
    ## 4      0.1545897  0.007176028           1         0        0.2677293
    ##   sd_f1_variable mean_n_selected sd_n_selected mean_c1f
    ## 1    0.009713502            34.4      1.516575 0.195997
    ## 2    0.009713502            34.4      1.516575 0.195997
    ## 3    0.010777776            32.4      1.516575 0.202018
    ## 4    0.010777776            32.4      1.516575 0.202018
    ##   mean_c1f_complexity_fraction mean_c1f_loading_scale mean_c1f_hd_factor
    ## 1                    0.1611789             0.05026529           0.279715
    ## 2                    0.1611789             0.05026529           0.279715
    ## 3                    0.1654130             0.05155130           0.279715
    ## 4                    0.1654130             0.05155130           0.279715
    ##   mean_c1f_complexity_multiplier mean_c1f_global_penalty mean_rmse   sd_rmse
    ## 1                       1.161179              0.01619011 0.6444747 0.1153448
    ## 2                       1.161179              0.01619011 0.6444747 0.1153448
    ## 3                       1.165413              0.01661490 0.6465237 0.1171882
    ## 4                       1.165413              0.01661490 0.6465237 0.1171882
    ##    mean_mae     sd_mae mean_accuracy sd_accuracy mean_sensitivity
    ## 1 0.5068063 0.08563456            NA          NA               NA
    ## 2 0.5068063 0.08563456            NA          NA               NA
    ## 3 0.5083053 0.08434289            NA          NA               NA
    ## 4 0.5083053 0.08434289            NA          NA               NA
    ##   sd_sensitivity mean_specificity sd_specificity mean_f1_classification
    ## 1             NA               NA             NA                     NA
    ## 2             NA               NA             NA                     NA
    ## 3             NA               NA             NA                     NA
    ## 4             NA               NA             NA                     NA
    ##   sd_f1_classification
    ## 1                   NA
    ## 2                   NA
    ## 3                   NA
    ## 4                   NA

# Plotting

    plot_rmse_by_covariance(results)

    plot_runtime_by_covariance(results)

    plot_subspace_distance_by_covariance(results)

# References

Cook, R. D. and Forzani, L. (2008). Principal Fitted Components for dimension reduction in regression. Statistical Science, 23(4), 485–501. doi:10.1214/08-STS275.

Chen, Y., Wiesel, A., Eldar, Y. C. and Hero, A. O. (2010). Shrinkage algorithms for MMSE covariance estimation. IEEE Transactions on Signal Processing, 58(10), 5016–5029. doi:10.1109/TSP.2010.2053029.

Bozdogan, H. (2000). Akaike’s Information Criterion and recent developments in information complexity. Journal of Mathematical Psychology, 44(1), 62–91. doi:10.1006/jmps.1999.1277.

Olorede, K. O. and Yahya, W. B. (2019). A new covariance estimator for sufficient dimension reduction in high-dimensional and undersized sample problems. arXiv. doi:10.48550/arXiv.1909.13017.