R - Select 使用嵌套列表的最佳行组合(暴力破解)

R - Select the best combinations of rows using nested list (Brute Forcing)

我正在尝试在嵌套列表中生成数据框中的所有行组合,在每个集合上拟合和预测线性模型,select 最佳集合(最小误差)。

我的数据框:

    myFunction <- function (x) {
                  (x[2] - 5.1/(4 * pi^2) * (x[1] ^2) + 5/pi * x[1] - 6)^2 +
                  10 * (1 - 1/(8 * pi)) * cos(x[1] ) + 10
    }
    set.seed(1)
    x1 <- runif(5)*15-5
    x2 <- runif(5)*15
    y <- as.matrix(apply(cbind(x1,x2),1,myFunction))
    df <- data.frame(x1,x2,y)

我生成了所有行的组合:

    Mycomb <- function(elements, simplify = FALSE){
    result <- lapply(seq_along(elements), function(m)
    combn(elements, m, simplify = simplify))
  
    result
    }

    combinations <- Mycomb(1:5)

    sub_df_list <- lapply(combinations, function(inx_list)
    lapply(inx_list, function(i) df[c(1, i),])
    )

    >sub_df_list

#[[1]]
#[[1]][[1]]
#          x1       x2        y
#1 -1.0173701 13.47585 47.79895
#2  0.5818585 14.17013 99.96885

#[[1]][[2]]
#        x1        x2        y
#1 -1.01737 13.475845 47.79895
#3  3.59280  9.911967 64.76098

#[[1]][[3]]
#         x1        x2        y
#1 -1.017370 13.475845 47.79895
#4  8.623117  9.436711 60.39821

#[[1]][[4]]
#         x1         x2        y
#1 -1.017370 13.4758453 47.79895
#5 -1.974771  0.9267941 82.26291


#[[2]]
#[[2]][[1]]
#          x1        x2        y
#1 -1.0173701 13.475845 47.79895
#2  0.5818585 14.170129 99.96885
#3  3.5928005  9.911967 64.76098

#...

但我不知道如何在每个生成的集合上应用拟合和预测 lm 到 select 哪个集合产生的误差最小:

    fit <- lm(y~x1+x2, sub_df_list)
    mytest <- data.frame(x1=1,x2=2) # test data is fixed
    pred <- predict(fit,mytest)
    real <- myFunction(c(1,2))
    sqrt((pred - real)^2) # calculates error

我真的不知道如何进行。任何帮助将不胜感激。

首先我会把你压扁 sub_df_list 所以这是一个 data.frames 的简单列表。目前它是一个列表列表(data.frames)。

datasets = unlist(sub_df_list, recursive=F)

之后,我们想要运行一个数据参数每次都改变的lm,来匹配sub_df_list的元素。这可以通过将 lapply 与匿名函数一起使用来完成,就像生成组合一样。

models = lapply(datasets, function(dataset) { lm(y~x1+x2, data=dataset) })

从那时起,您的其余代码应该可以正常工作。您只需要将它放在一个函数中并使用 lapply 即可在模型列表的每个元素上使用它。

也许你可以试试下面的代码,其中 sub_df_list 是通过 lapplyunlist(combinations, recursive = FALSE)

上获得的
sub_df_list <- lapply(unlist(combinations, recursive = FALSE), function(k) df[k, ])

然后计算关于real

的误差
errors <- sapply(
  sub_df_list,
  function(v) abs(predict(lm(y ~ ., v), data.frame(x1 = 1, x2 = 2)) - myFunction(c(1, 2)))
)

这样

        1         1         1         1         1         1         1         1 
 26.17132  78.34121  43.13334  38.77058  60.63527  91.98179  33.59375  28.80784
        1         1         1         1         1         1         1         1
 46.44878  73.45175  76.28356  81.23705  45.38206  51.28394  54.49797 204.15358
        1         1         1         1         1         1         1         1
361.40750 158.85971 100.03526  61.93911  58.12593  21.52984  40.75905  51.79650
        1         1         1         1         1         1         1
 56.25079  69.51678  56.16817  54.03099  59.05836  49.33699  53.05278