Для начала нужно разделить ваш код на куски, где каждая новая функция работает на каждом уровне данных.Затем вы можете вызывать каждый фрагмент из другого и собирать результаты более идиоматическим образом.
Здесь я сделал функции для 1) кода ядра для каждой пары поезд / тест, 2) повторяя его для каждого желаемого Kи 3) повторяя это для всех возможных пар.
Я согласен с @Deja в том, что реструктуризация ваших данных с использованием метода более «медленного» стиля может привести к еще более интуитивному коду, но если вы не привыкли кЕсли подумать так, это, вероятно, яснее.
## run core code for a particular train/test pair
run1 <- function(train, test, K, seeds) {
set.seed(seeds)
train <- as.data.frame(train)
test <- as.data.frame(test)
kpreds <- class::knn(train[, -ncol(train)],test[,-ncol(test)], train[,ncol(train)],k=K)
Ktable <- table(kpreds ,test[, ncol(test)])
(Ktable[1, 2] + Ktable[2, 1]) / sum(Ktable)
}
## run a particular train/test pair at several values of K
runK <- function(train, test, Ks, seeds) {
errors <- sapply(Ks, function(K) run1(train, test, K, seeds))
data.frame(K=Ks, error=errors)
}
## test several train/test pairs, at several values of K
findKNN <- function(df, Ks=1:5, seeds){
stopifnot(length(df$train)==length(df$test))
out <- lapply(seq_along(df$train), function(i) {
cbind(i=i, runK(df$train[[i]], df$test[[i]], Ks, seeds))
})
out <- do.call(rbind, out)
aggregate(error ~ K, out, mean)
}
## loop over several sets of data
output <- lapply(flist, seeds=12345, findKNN)
Чтобы поместить данные в более «аккуратный» формат, у вас будет по одной строке на пару тест / поезд с дополнительными столбцами, для которых набор данных икакой представитель это.Немного неловко, чтобы понять, с чего вы начали, но вот как это будет выглядеть.
n <- sapply(lapply(flist, `[[`, "train"), length)
ftrain <- do.call(c, lapply(flist, `[[`, "train"))
ftest <- do.call(c, lapply(flist, `[[`, "test"))
nn <- rep(names(n), n)
ii <- unlist(lapply(n, function(i) seq_len(i)))
library(tidyverse)
alld <- tibble(data=nn, i=ii, train=ftrain, test=ftest)
alld
## # A tibble: 6 x 4
## data i train test
## <chr> <int> <list> <list>
## 1 iris 1 <data.frame [150 x 5]> <data.frame [6 x 5]>
## 2 iris 2 <data.frame [150 x 5]> <data.frame [6 x 5]>
## 3 iris 3 <data.frame [150 x 5]> <data.frame [6 x 5]>
## 4 iris2 1 <data.frame [150 x 5]> <data.frame [6 x 5]>
## 5 iris2 2 <data.frame [150 x 5]> <data.frame [6 x 5]>
## 6 iris2 3 <data.frame [150 x 5]> <data.frame [6 x 5]>
Затем вы будете проходить по каждой строке.(Обратите внимание, что для этой работы мне пришлось сделать так, чтобы результат runK был data.frame.)
out <- alld %>% mutate(error=map2(train, test, runK, Ks=1:5, seeds=12345))
out
## # A tibble: 6 x 5
## data i train test error
## <chr> <int> <list> <list> <list>
## 1 iris 1 <data.frame [150 x 5]> <data.frame [6 x 5]> <data.frame [5 x 2]>
## 2 iris 2 <data.frame [150 x 5]> <data.frame [6 x 5]> <data.frame [5 x 2]>
## 3 iris 3 <data.frame [150 x 5]> <data.frame [6 x 5]> <data.frame [5 x 2]>
## 4 iris2 1 <data.frame [150 x 5]> <data.frame [6 x 5]> <data.frame [5 x 2]>
## 5 iris2 2 <data.frame [150 x 5]> <data.frame [6 x 5]> <data.frame [5 x 2]>
## 6 iris2 3 <data.frame [150 x 5]> <data.frame [6 x 5]> <data.frame [5 x 2]>
Затем вы извлекаете исходные данные, «раскручиваете» ошибку data.frame и суммируетенабор данных и К.
out %>% select(-train, -test) %>% unnest() %>%
group_by(data, K) %>% summarize(error=mean(error))
## # A tibble: 10 x 3
## # Groups: data [?]
## data K error
## <chr> <int> <dbl>
## 1 iris 1 0
## 2 iris 2 0
## 3 iris 3 0
## 4 iris 4 0
## 5 iris 5 0
## 6 iris2 1 0
## 7 iris2 2 0
## 8 iris2 3 0
## 9 iris2 4 0
## 10 iris2 5 0