r 中具有可变数量参数的回归函数答案

【问题标题】：Regression function with variable number of arguments in rr 中具有可变数量参数的回归函数
【发布时间】：2023-03-25 03:12:01
【问题描述】：

我编写了一个函数来计算 nls 回归模型的 VIF。它看起来像这样：

function (a,b,c,d,e,f,g) {
    VIFa <- 1/(1- (R2 <- summary(lm(a ~ b + c + d + e + f + g))$r.square))
    PMa <- ifelse (sqrt(VIFa) > 2, "JE", "NI")
    VIFb <- 1/(1- (R2 <- summary(lm(b ~ a + c + d + e + f + g))$r.square))
    PMb <- ifelse (sqrt(VIFb) > 2, "JE", "NI")
    VIFc <- 1/(1- (R2 <- summary(lm(c ~ a + b + d + e + f + g))$r.square))
    PMc <- ifelse (sqrt(VIFc) > 2, "JE", "NI")
    VIFd <- 1/(1- (R2 <- summary(lm(d ~ a + b + c + e + f + g))$r.square))
    PMd <- ifelse (sqrt(VIFd) > 2, "JE", "NI")
    VIFe <- 1/(1- (R2 <- summary(lm(e ~ a + b + c + d + f + g))$r.square))
    PMe <- ifelse (sqrt(VIFe) > 2, "JE", "NI")
    VIFf <- 1/(1- (R2 <- summary(lm(f ~ a + b + c + d + e + g))$r.square))
    PMf <- ifelse (sqrt(VIFf) > 2, "JE", "NI")
    VIFg <- 1/(1- (R2 <- summary(lm(g ~ a + b + c + d + e + f))$r.square))
    PMg <- ifelse (sqrt(VIFg) > 2, "JE", "NI")
    rezultat <- data.frame(c(VIFa, VIFb, VIFc, VIFd, VIFe, VIFf, VIFg), 
                           c(PMa, PMb, PMc, PMd, PMe, PMf, PMg)) 
    names(rezultat) <- c("VIF", "Multikolinearnost")
    return(as.matrix.data.frame(rezultat))
    }

其中 a,b,c,d,e,f,g 是特定模型中使用的变量。 VIFa 是“a”变量的方差膨胀因子，PMa 是一个逻辑值，显示方差膨胀是否会导致模型出现重大差异（JE = 是）或否（NO = 不是）。

我的问题是如何使这个函数适用于任意数量的参数？我已经尝试使用 lapply 函数，但是我找不到一种方法可以将每个变量一次用作依赖变量，而将所有其他变量用作独立变量（对于任意数量的变量）。

【问题讨论】：

函数如何知道公式中没有平方项、交互项等？单独的变量名称不能正确定义回归模型。

标签： r function arguments regression

【解决方案1】：

这是另一种解决方案，使用省略号表示不同数量的参数。

您应用的回归模型仅包含附加项（请参阅我对您问题的评论）。在这种情况下，您可以遍历变量（例如在 data.frame 中）。

vif <- function(...){
  dat <- data.frame(...)
  n <- ncol(dat)

  out <- data.frame(VIF=numeric(n), MK=numeric(n))
  for(ii in 1:n){
    dv <- colnames(dat)[ii]
    iv <- colnames(dat)[-ii]
    fml <- as.formula(paste(dv,paste(iv,collapse="+"),sep="~"))

    VIF <- 1/(1- (R2 <- summary(lm(fml))$r.square))
    KM <- ifelse(sqrt(VIF)>2, "JE", "NI")
    out[ii,] <- c(round(VIF,5),KM)
  }
  return(out)
}

适用于变量和 data.frames 作为输入。

a <- c(1,2,3,4,5)
b <- c(1,3,2,2,4)
x <- c(3,3,2,4,5)
dat <- data.frame(a,b,x)

# > vif(a,b,x)
#       VIF MK
# 1 2.47059 NI
# 2 2.06471 NI
# 3 2.06471 NI
# > vif(dat)
#       VIF MK
# 1 2.47059 NI
# 2 2.06471 NI
# 3 2.06471 NI

干杯！

【讨论】：

【解决方案2】：

尝试以下方法：

regapply <- function(l) {
   ids <- names(l)
   n <- length(l)
   vifs <- numeric(n)
   pms <- character(n)
   for (i in seq_along(l)) {
      f <- parse(text=sprintf("%s ~ %s", ids[i], paste(ids[-i], collapse=" + ")))[[1]]
      vifs[i] <- 1/(1- (R2 <- summary(lm(f, data=l))$r.square))
      pms[i] <- ifelse (sqrt(vifs[i]) > 2, "JE", "NI")
   }
   data.frame(var=ids, vif=vifs, pm=pms)
}

在命名列表（例如数据框）上调用上述内容，例如：

regapply(iris[-5])
##            var       vif pm
## 1 Sepal.Length  7.072722 JE
## 2  Sepal.Width  2.100872 NI
## 3 Petal.Length 31.261498 JE
## 4  Petal.Width 16.090175 JE

解释：parse(text=sprintf("%s ~ %s", ids[i], paste(ids[-i], collapse=" + ")))[[1]] 创建了一系列公式。在上面的例子中，我们有：

Sepal.Length ~ Sepal.Width + Petal.Length + Petal.Width
Sepal.Width ~ Sepal.Length + Petal.Length + Petal.Width
Petal.Length ~ Sepal.Length + Sepal.Width + Petal.Width
Petal.Width ~ Sepal.Length + Sepal.Width + Petal.Length

【讨论】：