是否可以將Rpp中的sapply與一個約束結合起來？

Question

我適合不同的車型，然後我想從包車計算VIF。 VIF需要公式中有多個迴歸因子，因此會返回錯誤。這個想法是在運行該功能之前檢查是否有多個迴歸器。或者，我可以嘗試按照迴歸器的數量對模型進行排序，以便僅從第i個位置開始調用VIF函數。

我的代碼是：

ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14) 
trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69) 
ot=rnorm(length(trt)) 
ot2=rnorm(length(trt)) 
DF=as.data.frame(cbind(ot,ot2,ctl,trt)) 
y=colnames(DF[1]) 
x = colnames(DF) 
x = x[! x %in% y] 
n = length(x) 

id = unlist(
    lapply(1:n, 
     function(i)combn(1:n,i,simplify=F) 
) 
    ,recursive=F) 

models = sapply(id,function(i) 
    paste(y,paste(x[i],collapse="+"), sep="~") 
) 

allModelsResults=lapply(models, function(i) 
    lm(as.formula(i), data=DF)) 

library(car) 
vif.r=sapply(allModelsResults,vif) 

Answer 1

這工作：

sapply(allModelsResults, 
     function(mod) if (length(labels(terms(mod))) < 2) NA else vif(mod)) 

# [[1]] 
# [1] NA 
# 
# [[2]] 
# [1] NA 
# 
# [[3]] 
# [1] NA 
# 
# [[4]] 
#  ot2  ctl 
# 1.157776 1.157776 
# 
# [[5]] 
#  ot2  trt 
# 1.439415 1.439415 
# 
# [[6]] 
#  ctl  trt 
# 1.264959 1.264959 
# 
# [[7]] 
#  ot2  ctl  trt 
# 1.47575 1.29689 1.61237 

注意length(labels(terms(mod))) < 2是什麼vif使用作爲其標準，見getAnywhere(vif.lm)。