删除嵌套循环

Question

我必须删除我的函数循环。这并不容易，因为我的数据结构很复杂，我不知道如何在其中使用 apply 系列。

首先，我有这个数据结构

列表

在这个列表中，我还有其他带有 TRAIN 和 TEST 的列表。最后，我在这些级别中有 data.frames。我使用 iris 数据集创建列表的 simul 数据。

data(iris)
head(iris)

iristest<-head(iris)

train<-list(iris,iris,iris)
test<-list(iristest,iristest,iristest)

list1<-list(train,test)
names(list1)<-c("train","test")


iris2<-iris
iris2[,1:4]<-iris[,1:4]+5
iristest2<-head(iris2)

train<-list(iris2,iris2,iris2)
test<-list(iristest2,iristest2,iristest2)

list2<-list(train,test)
names(list2)<-c("train","test")

flist<-list(list1,list2)
names(flist)<-c("iris","iris2")

现在，我创建了一个比我想应用列表的函数。

Kmax<-5
nd<-10
ks<-seq(from=1,to=Kmax,by=1)
kn<-seq(1:nd)

findKNN<-function(listdf,seeds){
  indx<-1

  outs<-matrix(0, nrow = 5*length(listdf[[1]]), ncol = 3)

  for (i in seq_along(listdf[[1]])){
    for (K in 1:5){
      train<- as.data.frame(listdf$train[i])
      test <- as.data.frame(listdf$test[i])

      set.seed(seeds)

      kpreds <- knn(train[,-ncol(train)],test[,-ncol(test)], train[,ncol(train)],k=K)
      Ktable <-table(kpreds ,test[,ncol(test)])

      outs[indx,1] <- (Ktable[1, 2] + Ktable[2, 1]) / sum(Ktable)
      outs[indx,2] <- K
      outs[indx,3] <- i
      indx<-indx+1
    }
  }

  outs<-data.frame(outs)
  names(outs)<-c("error","K","I")
  outs<-aggregate(error ~ K,outs, mean)
}

output<-lapply(flist,seeds=12345,findKNN)

但我不知道如何有效地运行此代码。

谢谢

Answer 1

这只是黑暗中的一次尝试，但在我看来，这两个循环的原因是您将数据结构化为列表中的列表？可能在列表中的列表中列出？对我来说，这似乎是更大的问题，然后 for 循环效率不高。

只是一个想法，但也许可以将数据的存储方式重组为地图之类的东西，您可以在其中将值与键相关联。例如，您有一个带有键“list1”“list2”的映射，并且映射中的所有值都与它们的键配对。然后你只需要一个带有 if 的 for 循环，如果键匹配我想要的数据。只是一个想法。

Answer 2

根据this thread，apply 函数实际上不再比for 循环具有效率优势。

如果您的目标只是减少运行时间，那么将循环转换为 apply 函数可能毫无意义。这些函数的优势现在主要是生成更易读的代码。

Answer 3

首先将您的代码分解为块，其中每个新函数都适用于每个级别的数据。然后你可以互相调用每个部分并以更惯用的方式收集结果。

在这里，我为 1) 每个训练/测试对的核心代码创建了函数，2) 为每个所需的 K 重复该代码，以及 3) 在可能的对中重复该代码。

我同意@Deja 的观点，将您的数据重组为更“tidyverse”风格的方法可能会产生更直观的代码，但如果您不习惯以这种方式思考，这可能会更清晰。

## 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]>

然后你取出原始数据，“unnest”错误data.frame，并总结数据集和K。

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