R中的回归子集算法

我想在R中为“beta回归”模型构建一个回归子集算法。 R中有一个包

betareg

，它适合贝塔回归，我感兴趣的是最大化“对数可能性”的模型

基本上，这是通过选择最佳的k因子回归模型来实现的，对于k=1,2，…，p，其中p是变量的数量

例如，如果我将x_1、x_2、x_3作为变量，y作为响应。我想要一些能：

步骤1：找到最佳单因素模型

mod1 <- betareg(y~x_1, data = test)
mod1.sum <- summary(mod1)

mod2 <- betareg(y~x_2, data = test)
mod2.sum <- summary(mod2)

mod3 <- betareg(y~x_3, data = test)
mod3.sum <- summary(mod3)

---

mod1这里有一个不使用betareg的替代解决方案。输出类似，供您考虑

以下是我使用的数据集：

set.seed(12345)
dat <- data.frame(y=runif(50), x_1=runif(50), x_2=runif(50), x_3=runif(50))

就我所知，对于beta回归（在R或其他情况下），没有专门的最佳子集选择的高效实现。然而，有一些通用的实现提供了近似的解决方案，例如，基于遗传算法，如
kofinga
包（on和发表于）。请参见下面的示例。（要使用正向搜索代替最佳子集选择，请参阅我的其他答案。）

或者，您可以使用一个（通用的）线性模型来近似
betareg
的功能，并使用子集选择。例如，您可以对响应进行logit转换（即，
qlogis（y）
），然后通过
leaps
（）或
lmSubsets
（）使用线性回归运行最佳子集选择。或者您可以将GLM与
family=quasibinomial
一起使用，并使用
glmulti
（，）。然后你可以使用近似模型的最佳子集结果，并将其应用于贝塔回归。当然，这不会给你最好的贝塔回归结果，但它可能是进一步分析的有用起点

因此，回到直接遗传算法进行贝塔回归。为了说明如何使用
kofnGA
实现这一点，我们首先加载包和示例数据：

library("betareg")
library("kofnGA")
data("FoodExpenditure", package = "betareg")

然后，我们用响应变量
y
和回归矩阵
x
构建一个列表。请注意，我们在这里省略了截距，以便稍后将其强制引入模型（即，截距不应受到选择的约束）

最后，在这个简短的示例中，我们只运行了100代遗传算法，以节省一些计算时间：

set.seed(1)
ga <- kofnGA(n = 42, k = 2, OF = nll, data = fe_data, ngen = 100)

因此，在这个非常简单的人工设置中，遗传算法确实选择了前2个回归器（来自真实数据），而不是我们添加的任何不相关的随机40个回归器。所以我们现在可以继续用回归器重新构建一个合适的贝塔回归模型

colnames(fe_data$x)[ga$bestsol]
## [1] "income"  "persons"

请注意，此处使用的贝塔回归仅使用固定精度参数（带有对数链接）。如果你想要一个可变的离散度，那么你需要相应地修改
nll
。
除了我的另一个答案，它显示了如何使用
kofnGA
为贝塔回归进行最佳子集选择外，我还提供了一个如何手工进行正向选择的示例

我们再次从加载包和数据开始：

library("betareg")
data("FoodExpenditure", package = "betareg")

我还用响应加上所有回归器（包括40个随机回归器）建立列表（注意，与另一个不同，我将截距保留在
x
中，这在这里更方便）

然后我们存储所有可能回归的索引
vall
，并用截距初始化搜索（
v）这不是一个最佳子集算法吗？这对于p-large来说效率很低？同样，用betareg替换lm会给出beta回归的结果吗？不确定为什么选择lm，如果它使用betareg那么简单？这与leaps包有关吗？我没有使用leaps-best-subset函数来确定最佳子集.相反，我只是用它来提取预测项的所有可能组合（因此使用高nvmax和穷举/真的.big方法）。如果有大量预测项，这是记录所有可能公式的更有效方法（如果只有3个预测项，则没有意义）.至于lm，我使用它是因为我懒得安装/阅读betareg。我不知道当你已经可以从统计数据包中提取beta系数时，拥有这么多不同的回归包有什么意义。但是你可以为每个可能的预测组合拟合一个线性模型？这难道不是一个最好的子集算法吗rithm？抱歉，请阅读betareg。它似乎是在数据上运行逻辑回归，而不是lm。谢谢，我以前从未使用过
kofnGA
，所以这是一个最佳子集选择算法，其中选择了最佳的2变量模型。我想知道是否有一个前向子集算法等效？因为这将是com如果我为所有可能的尺寸为k的型号运行该函数，则可能会非常密集。我也不太确定
ngen=100
参数在做什么？这是否意味着该函数只适用于尺寸为
k=2
的100个型号？而不是全部可能的40个型号，选择2=780？
kofinga
运行的型号比所有可能的型号都少（实际上，这里选择2）但它不是通过简单的随机选择来实现的。它是一种遗传算法，保持候选模型的“群体”。在每一代中，一些后代是通过随机“突变”、“交叉”产生的等等，只有最适者生存。这一过程重复了100代，最后只报告了最适者生存。这是一种广泛应用于许多领域的优化启发式方法，通常在穷举搜索在计算上不可行时效果良好。有关更多详细信息，请参阅JSS论文
kofinga
。此外，我还添加了一个第二个答案是关于如何手工进行正向搜索（所有常规的正向搜索注意事项都适用于此）。
library("betareg")
library("kofnGA")
data("FoodExpenditure", package = "betareg")

fe_data <- list(
  y = with(FoodExpenditure, food/income),
  x = model.matrix(~ income + persons, data = FoodExpenditure)[, -1]
)

fe_data$x <- cbind(fe_data$x,
  matrix(rnorm(40 * nrow(fe_data$x)), ncol = 40))
colnames(fe_data$x)[3:42] <- paste0("x", 1:40)

nll <- function(v, data) -betareg.fit(x = cbind(1, data$x[, v]),
  y = data$y)$loglik

set.seed(1)
ga <- kofnGA(n = 42, k = 2, OF = nll, data = fe_data, ngen = 100)

summary(ga)
## Genetic algorithm search, 100 generations
## Number of unique solutions in the final population: 1 
## 
## Objective function values:
##                      average   minimum
## Initial population -36.56597 -41.74583
## Final population   -45.33351 -45.33351
## 
## Best solution (found at generation 1):
## 1 2 

colnames(fe_data$x)[ga$bestsol]
## [1] "income"  "persons"

library("betareg")
data("FoodExpenditure", package = "betareg")

fe_data <- list(
  y = with(FoodExpenditure, food/income),
  x = model.matrix(~ income + persons, data = FoodExpenditure)
)
set.seed(123)
fe_data$x <- cbind(fe_data$x,
  matrix(rnorm(40 * nrow(fe_data$x)), ncol = 40))
colnames(fe_data$x)[4:43] <- paste0("x", 1:40)

nll <- function(v, data) -betareg.fit(x = data$x[, v, drop = FALSE],
  y = data$y)$loglik

vall <- 1:ncol(fe_data$x)
v <- 1
n <- nll(v, data = fe_data)

for(i in 1:15) {
  vi <- vall[-v]
  ni <- sapply(vi, function(vii) nll(v = c(v, vii), data = fe_data))
  v <- c(v, vi[which.min(ni)])
  n <- c(n, ni[which.min(ni)])
}

colnames(fe_data$x)[v]
##  [1] "(Intercept)" "income"      "persons"     "x28"         "x18"        
##  [6] "x29"         "x22"         "x11"         "x5"          "x8"         
## [11] "x38"         "x24"         "x13"         "x23"         "x36"        
## [16] "x16"        

m <- seq_along(v)
plot(m, n, type = "b",
  xlab = "Number of regressors", ylab = "Log-likelihood")
plot(m, n + log(nrow(fe_data$x)) * (m + 1), type = "b",
  xlab = "Number of regressors", ylab = "BIC")