Создайте функцию для ручного вычисления значений VIF в R

Мне нужна небольшая помощь, я новичок в R. Я использую пакет plspm для создания модели PLS-SEM (PLS-PM). В пакете не предусмотрена функция VIF для оценки коллинеарности показателей (переменных) скрытых переменных (конструкций)

Я хочу создать функцию, которая может делать это автоматически в цикле и возвращать значения VIF. Я сделал все расчеты VIF вручную.

В приведенном ниже примере у меня есть 2 скрытые переменные. Первый — это Institutional Pressure (IP) с 21 показателем (от X1 до X21). Второй — стратегические ответы (SR) с 16 показателями (от X22 до X37).

Спасибо!

IP

vif_1 <- 1/(1-(summary(lm(X1~X2+X3+X4+X5+X6+X7+X8+X9+X10+X11+X12+X13+X14+X15+X16+X17+X18+X19+X20+X21, 
                data = pls1$data))$r.squared))
vif_2 <- 1/(1-(summary(lm(X2~X1+X3+X4+X5+X6+X7+X8+X9+X10+X11+X12+X13+X14+X15+X16+X17+X18+X19+X20+X21, 
                         data = pls1$data))$r.squared))
vif_3 <- 1/(1-(summary(lm(X3~X2+X1+X4+X5+X6+X7+X8+X9+X10+X11+X12+X13+X14+X15+X16+X17+X18+X19+X20+X21, 
                         data = pls1$data))$r.squared))
vif_4 <- 1/(1-(summary(lm(X4~X2+X3+X1+X5+X6+X7+X8+X9+X10+X11+X12+X13+X14+X15+X16+X17+X18+X19+X20+X21, 
                         data = pls1$data))$r.squared))
vif_5 <- 1/(1-(summary(lm(X5~X2+X3+X1+X1+X6+X7+X8+X9+X10+X11+X12+X13+X14+X15+X16+X17+X18+X19+X20+X21, 
                          data = pls1$data))$r.squared))
vif_6 <- 1/(1-(summary(lm(X6~X2+X3+X1+X5+X1+X7+X8+X9+X10+X11+X12+X13+X14+X15+X16+X17+X18+X19+X20+X21, 
                          data = pls1$data))$r.squared))
vif_7 <- 1/(1-(summary(lm(X7~X2+X3+X1+X5+X6+X1+X8+X9+X10+X11+X12+X13+X14+X15+X16+X17+X18+X19+X20+X21, 
                          data = pls1$data))$r.squared))
vif_8 <- 1/(1-(summary(lm(X8~X2+X3+X1+X5+X6+X7+X1+X9+X10+X11+X12+X13+X14+X15+X16+X17+X18+X19+X20+X21, 
                          data = pls1$data))$r.squared))
vif_9 <- 1/(1-(summary(lm(X9~X2+X3+X1+X5+X6+X7+X8+X1+X10+X11+X12+X13+X14+X15+X16+X17+X18+X19+X20+X21, 
                          data = pls1$data))$r.squared))
vif_10 <- 1/(1-(summary(lm(X10~X2+X3+X1+X5+X6+X7+X8+X9+X1+X11+X12+X13+X14+X15+X16+X17+X18+X19+X20+X21, 
                          data = pls1$data))$r.squared))
vif_11 <- 1/(1-(summary(lm(X11~X2+X3+X1+X5+X6+X7+X8+X9+X10+X1+X12+X13+X14+X15+X16+X17+X18+X19+X20+X21, 
                          data = pls1$data))$r.squared))
vif_12 <- 1/(1-(summary(lm(X12~X2+X3+X1+X5+X6+X7+X8+X9+X10+X11+X1+X13+X14+X15+X16+X17+X18+X19+X20+X21, 
                          data = pls1$data))$r.squared))
vif_13 <- 1/(1-(summary(lm(X13~X2+X3+X1+X5+X6+X7+X8+X9+X10+X11+X12+X1+X14+X15+X16+X17+X18+X19+X20+X21, 
                          data = pls1$data))$r.squared))
vif_14 <- 1/(1-(summary(lm(X14~X2+X3+X1+X5+X6+X7+X8+X9+X10+X11+X12+X13+X1+X15+X16+X17+X18+X19+X20+X21, 
                          data = pls1$data))$r.squared))
vif_15 <- 1/(1-(summary(lm(X15~X2+X3+X1+X5+X6+X7+X8+X9+X10+X11+X12+X13+X14+X1+X16+X17+X18+X19+X20+X21, 
                          data = pls1$data))$r.squared))
vif_16 <- 1/(1-(summary(lm(X16~X2+X3+X1+X5+X6+X7+X8+X9+X10+X11+X12+X13+X14+X15+X1+X17+X18+X19+X20+X21, 
                          data = pls1$data))$r.squared))
vif_17 <- 1/(1-(summary(lm(X17~X2+X3+X1+X5+X6+X7+X8+X9+X10+X11+X12+X13+X14+X15+X16+X1+X18+X19+X20+X21, 
                          data = pls1$data))$r.squared))
vif_18 <- 1/(1-(summary(lm(X18~X2+X3+X1+X5+X6+X7+X8+X9+X10+X11+X12+X13+X14+X15+X16+X17+X1+X19+X20+X21, 
                          data = pls1$data))$r.squared))
vif_19 <- 1/(1-(summary(lm(X19~X2+X3+X1+X5+X6+X7+X8+X9+X10+X11+X12+X13+X14+X15+X16+X17+X18+X1+X20+X21, 
                          data = pls1$data))$r.squared))
vif_20 <- 1/(1-(summary(lm(X20~X2+X3+X1+X5+X6+X7+X8+X9+X10+X11+X12+X13+X14+X15+X16+X17+X18+X19+X1+X21, 
                          data = pls1$data))$r.squared))
vif_21 <- 1/(1-(summary(lm(X21~X2+X3+X1+X5+X6+X7+X8+X9+X10+X11+X12+X13+X14+X15+X16+X17+X18+X19+X20+X1, 
                          data = pls1$data))$r.squared))

SR

vif_22 <- 1/(1-(summary(lm(X22~X23+X24+X25+X26+X27+X28+X29+X30+X31+X32+X33+X34+X35+X36+X37, 
                           data = pls1$data))$r.squared))
vif_23 <- 1/(1-(summary(lm(X23~X22+X24+X25+X26+X27+X28+X29+X30+X31+X32+X33+X34+X35+X36+X37, 
                           data = pls1$data))$r.squared))
vif_24 <- 1/(1-(summary(lm(X24~X23+X22+X25+X26+X27+X28+X29+X30+X31+X32+X33+X34+X35+X36+X37, 
                           data = pls1$data))$r.squared))
vif_25 <- 1/(1-(summary(lm(X25~X23+X24+X22+X26+X27+X28+X29+X30+X31+X32+X33+X34+X35+X36+X37, 
                           data = pls1$data))$r.squared))
vif_26 <- 1/(1-(summary(lm(X26~X23+X24+X25+X22+X27+X28+X29+X30+X31+X32+X33+X34+X35+X36+X37, 
                           data = pls1$data))$r.squared))
vif_27 <- 1/(1-(summary(lm(X27~X23+X24+X25+X26+X22+X28+X29+X30+X31+X32+X33+X34+X35+X36+X37, 
                           data = pls1$data))$r.squared))
vif_28 <- 1/(1-(summary(lm(X28~X23+X24+X25+X26+X27+X22+X29+X30+X31+X32+X33+X34+X35+X36+X37, 
                           data = pls1$data))$r.squared))
vif_29 <- 1/(1-(summary(lm(X29~X23+X24+X25+X26+X27+X28+X22+X30+X31+X32+X33+X34+X35+X36+X37, 
                           data = pls1$data))$r.squared))
vif_30 <- 1/(1-(summary(lm(X30~X23+X24+X25+X26+X27+X28+X29+X22+X31+X32+X33+X34+X35+X36+X37, 
                           data = pls1$data))$r.squared))
vif_31 <- 1/(1-(summary(lm(X31~X23+X24+X25+X26+X27+X28+X29+X30+X22+X32+X33+X34+X35+X36+X37, 
                           data = pls1$data))$r.squared))
vif_32 <- 1/(1-(summary(lm(X32~X23+X24+X25+X26+X27+X28+X29+X30+X31+X22+X33+X34+X35+X36+X37, 
                           data = pls1$data))$r.squared))
vif_33 <- 1/(1-(summary(lm(X33~X23+X24+X25+X26+X27+X28+X29+X30+X31+X32+X22+X34+X35+X36+X37, 
                           data = pls1$data))$r.squared))
vif_34 <- 1/(1-(summary(lm(X34~X23+X24+X25+X26+X27+X28+X29+X30+X31+X32+X33+X22+X35+X36+X37, 
                           data = pls1$data))$r.squared))
vif_35 <- 1/(1-(summary(lm(X35~X23+X24+X25+X26+X27+X28+X29+X30+X31+X32+X33+X34+X22+X36+X37, 
                           data = pls1$data))$r.squared))
vif_36 <- 1/(1-(summary(lm(X36~X23+X24+X25+X26+X27+X28+X29+X30+X31+X32+X33+X34+X35+X22+X37,                           data = pls1$data))$r.squared))
vif_37 <- 1/(1-(summary(lm(X37~X23+X24+X25+X26+X27+X28+X29+X30+X31+X32+X33+X34+X35+X36+X22,                           data = pls1$data))$r.squared))

IP VIF

as.list(c(vif_1,vif_2,vif_3,vif_4,vif_5,vif_6,vif_7,vif_8,vif_9,vif_10,vif_11,vif_12,vif_13,vif_14,vif_15,vif_16,vif_17,vif_18,vif_19,vif_20,vif_21))

SR VIF

as.list(c(vif_22,vif_23,vif_24,vif_25,vif_26,vif_27,vif_28,vif_29,vif_30,vif_31,vif_32,vif_33,vif_34,vif_35,vif_36,vif_37))

r regression correlation r-car
person José Eduardo Storopoli    schedule 06.10.2018    source источник

Ответы (1)


arrow_upward
0
arrow_downward 

vif.1_21 <- numeric()  # a vector storing vif 1~21
vif.22_37 <- numeric() # a vector storing vif 22~37

for(i in 1:21){
  vif <- 1/(1-(summary(lm(paste0("X", i, " ~ ."),
                          data = pls1$data[paste0("X", 1:21)]))$r.squared))
  vif.1_21 <- c(vif.1_21, vif)
}

for(i in 22:37){
  vif <- 1/(1-(summary(lm(paste0("X", i, " ~ ."),
                          data = pls1$data[paste0("X", 22:37)]))$r.squared))
  vif.22_37 <- c(vif.22_37, vif)
}

Наконец, проверьте, соответствуют ли vif.1_21 и vif.22_37 ожидаемому результату.

Общая форма

output <- numeric()
XXX <- subset of your original data
# XXX is a subset of data composed of any combinations of variables you interested

for(i in colnames(XXX)){
  value <- 1/(1-(summary(lm(paste0(i, " ~ ."), data = XXX)))$r.squared)
  output <- c(output, value)
}
person Darren Tsai    schedule 06.10.2018
comment
Потрясающе! Большое спасибо! - person José Eduardo Storopoli; 06.10.2018
comment
В последующем анализе я исключил из модели некоторые переменные. Теперь у меня есть только от X2 до X7 и от X10 до X21. Из 21 переменной я удалил 3 (X1, X8 и X9). Таким образом, данные pls1$ имеют первые 18 столбцов, помеченных как X2 до X7 и X10 до X21. Как мне это сделать? изменить функцию для расчета VIF этого нового набора данных? #VIF IP X2-X7 X9-X21 vif.1_18 <- numeric() # a vector storing vif 1~21 for(i in c(1:7,9:21)){ vif <- 1/(1-(summary(lm(paste0("X", i, " ~ ."), data = pls1$data[paste0("X",c(1:7,9:21))]))$r.squared)) vif.1_18<- c(vif.1_18, vif) } - person José Eduardo Storopoli; 08.10.2018
comment
Вау, еще раз! Благодарность! - person José Eduardo Storopoli; 08.10.2018