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
是通过 lapply
在 unlist(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
我正在尝试在嵌套列表中生成数据框中的所有行组合,在每个集合上拟合和预测线性模型,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
是通过 lapply
在 unlist(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