Любой способ выбрать лучшие n компонентов PCA из накопительного графика PCA в R?

Question

Мне интересно выбрать 10 лучших компонентов PCA из накопительного графика PCA для моего набора данных. Мне удалось получить сюжет PCA, такой как осыпь, парный сюжет и так далее, но для меня это не имеет особого смысла. Поэтому я хочу выбрать топ-10 PCA-графиков из их накопительного PCA-графика, и я сделал это, но мне нужно поднастроить свой исходный набор данных с помощью этого топ-10 PCA-компонента. Кто-нибудь может указать мне, как сделать попытку более точной и желательной?

Воспроизводимые данные :

persons_df <- data.frame(person1=sample(1:200,20, replace = FALSE),
                    person2=as.factor(sample(20)),
                    person3=sample(1:250,20, replace = FALSE),
                    person4=sample(1:300,20, replace = FALSE),
                    person5=as.factor(sample(20)),
                    person6=as.factor(sample(20)))

row.names(persons_df) <-letters[1:20]

моя попытка :

my_pca <- prcomp(t(persons_df), center=TRUE, scale=FALSE)
summary(my_pca)

my_pca_proportionvariances <- cumsum(((my_pca$sdev^2) / (sum(my_pca$sdev^2)))*100)

общедоступный набор данных :

поскольку у меня возникла проблема при создании выше воспроизводимых данных, здесь я связал открытый пример набора данных

здесь мне нужно выбрать 10 лучших компонентов PCA для persons_df, затем установить исходные данные, а затем выполнить простую линейную регрессию. Как я могу завершить свой подход здесь, чтобы достичь своей цели? Кто-нибудь может быстро указать мне здесь? есть идеи?

Answer 1

Чтобы использовать PCA для уменьшения размерности, вкратце:

1. Пропустите вашу выходную переменную (это обман) и создайте контрастные переменные с model.matrix, если необходимо.(Не используйте непосредственное горячее кодирование факторов с множеством уровней, таких как почтовый индекс, иначе размер ваших данных взорвется. Думайте умнее.) Удалите все переменные с нулевой дисперсией.Разобраться с NA s.
2. Scale.По сравнению с большой переменной (например, заработной платой) все остальное может выглядеть не слишком дисперсионным.
3. Запуск PCA с princomp или prcomp.

pca <- princomp(scale(cbind(mtcars[-1])))

Чтобы получить объясненный процент дисперсии, вытяните вектор stdev из объекта PCA, возведите в квадрат, чтобы получить дисперсию, и масштабируйте по сумме, чтобы она равнялась 1.

pct_var_explained <- pca$sdev^2 / sum(pca$sdev^2)
pct_var_explained
#>      Comp.1      Comp.2      Comp.3      Comp.4      Comp.5      Comp.6 
#> 0.576021744 0.264964319 0.059721486 0.026950667 0.022225006 0.021011744 
#>      Comp.7      Comp.8      Comp.9     Comp.10 
#> 0.013292009 0.008068158 0.005365235 0.002379633

Посмотрите на суммарную сумму отклонений, объясненную, чтобы увидеть, сколько основных компонентов вы хотите сохранить.Например, компоненты 9 и 10 объясняют менее 0,25% дисперсии здесь.Вы также можете использовать summary, чтобы сделать эти вычисления для вас.

cumsum(pct_var_explained)
#>    Comp.1    Comp.2    Comp.3    Comp.4    Comp.5    Comp.6    Comp.7 
#> 0.5760217 0.8409861 0.9007075 0.9276582 0.9498832 0.9708950 0.9841870 
#>    Comp.8    Comp.9   Comp.10 
#> 0.9922551 0.9976204 1.0000000

summary(pca)
#> Importance of components:
#>                           Comp.1    Comp.2     Comp.3     Comp.4
#> Standard deviation     2.3622469 1.6021366 0.76062599 0.51096437
#> Proportion of Variance 0.5760217 0.2649643 0.05972149 0.02695067
#> Cumulative Proportion  0.5760217 0.8409861 0.90070755 0.92765822
#>                            Comp.5     Comp.6     Comp.7      Comp.8
#> Standard deviation     0.46400943 0.45116656 0.35884027 0.279571602
#> Proportion of Variance 0.02222501 0.02101174 0.01329201 0.008068158
#> Cumulative Proportion  0.94988322 0.97089497 0.98418697 0.992255132
#>                             Comp.9     Comp.10
#> Standard deviation     0.227981824 0.151831138
#> Proportion of Variance 0.005365235 0.002379633
#> Cumulative Proportion  0.997620367 1.000000000

Подмножество основных компонентов, которые вы хотите сохранить, и снова связать вашу выходную переменную.

train <- data.frame(
    mpg = mtcars$mpg, 
    predict(pca)[, cumsum(pct_var_explained) < 0.95]
)

Обучите вашу модель.

model <- lm(mpg ~ ., train)
summary(model)
#> 
#> Call:
#> lm(formula = mpg ~ ., data = train)
#> 
#> Residuals:
#>     Min      1Q  Median      3Q     Max 
#> -4.2581 -1.2933 -0.4999  1.3939  5.2861 
#> 
#> Coefficients:
#>             Estimate Std. Error t value Pr(>|t|)    
#> (Intercept) 20.09062    0.44345  45.305  < 2e-16 ***
#> Comp.1      -2.28131    0.18772 -12.153 3.17e-12 ***
#> Comp.2       0.11632    0.27679   0.420   0.6778    
#> Comp.3       1.29925    0.58301   2.229   0.0347 *  
#> Comp.4      -0.09002    0.86787  -0.104   0.9182    
#> Comp.5       0.31279    0.95569   0.327   0.7461    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Residual standard error: 2.509 on 26 degrees of freedom
#> Multiple R-squared:  0.8547, Adjusted R-squared:  0.8268 
#> F-statistic: 30.59 on 5 and 26 DF,  p-value: 4.186e-10

Эта конкретная модель почти просто нуждается в 1 главном компоненте - там много информации, с которой модель ничего не может сделать.(Может быть, это не имеет значения, избыточно или нелинейно.) Повторять.