我必须删除函数的循环。这并不容易，因为我的数据结构很困难，而且我不知道如何在其中使用应用族。
首先，我具有这种数据结构
列表<-列表数据1 <-列出数据2
在此列表中，还有其他列表，其中包含TRAIN和TEST。最后，我在这些层次上有data.frames。我用虹膜数据集创建列表的模拟数据。
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)
但是我不知道如何有效地运行此代码。
谢谢
答案 0 :(得分：1)
这只是黑暗中的一个刺，但在我看来，这两个循环的原因是您已将数据结构化为列表中的列表？可能在列表内的列表内的列表？对我来说，这似乎是更大的问题，因为for循环效率不高。
只是一个想法，但也许可以将数据的存储结构重新构建为类似地图的地图，您可以在其中将值与键相关联。例如，您有一个键为“ list1”，“ list2”的映射，并且映射中的所有值都与它们的键配对。然后，您只需要一个for循环，如果有则表示密钥是否匹配我想要的数据。只是一个想法。
答案 1 :(得分：1)
根据this thread，<!DOCTYPE html>
<html>
<head>
<title>Delete restaurant record using jquery ajax</title>
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap /3.3.7/css/bootstrap.min.css">
<script src="https://cdnjs.cloudflare.com/ajax/libs/jquery/3.2.1/jquery.min.js"></script>
</head>
<body>
<div class="container">
<h3 class="text-center">PHP mysql confirmation box before delete record using jquery ajax</h3>
<table class="table table-bordered">
<tr>
<th>Restaurant ID</th>
<th>Restaurant Name</th>
<th width="100px">Action</th>
</tr>
<?php
require('config.php');
$sql = "SELECT * FROM restaurant";
$restaurants = $link->query($sql);
while($restaurant = $restaurants->fetch_assoc()){
?>
<tr rId="<?php echo $restaurant['rId'] ?>">
<td><?php echo $restaurant['rname'] ?></td>
<td><button class="btn btn-danger btn-sm remove">Delete</button></td>
</tr>
<?php } ?>
</table>
</div> <!-- container / end -->
</body>
<script type="text/javascript">
$(".remove").click(function(){
var rId = $(this).parents("tr").attr("rId");
if(confirm('Are you sure to remove this record ?')) {
$.ajax({
url: 'http://localhost/PhpProject2/deleter.php',
type: 'GET',
data: {rId: rId},
error: function() {
alert('Something is wrong');
},
success: function(data) {
$("#"+rId).remove();
alert("Record removed successfully");
}
});
}
});
</script>
</html>
函数实际上不再比<?php
require('config.php');
if(isset($_GET['rId'])) {
$sql = "DELETE FROM restaurant WHERE rId=".$_GET['rId'];
$link->query($sql);
echo 'Deleted successfully.';
}
?>
循环具有效率优势。
如果您的目标只是减少运行时间，那么将循环转换为apply函数可能没有意义。这些功能的优势现在主要是产生更具可读性的代码。
答案 2 :(得分：1)
开始的地方是将代码分解成块，每个新函数都在数据的每个级别上起作用。然后，您可以互相调用每个片段，并以一种更加惯用的方式收集结果。
在这里，我为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]>
然后您取出原始数据，“嵌套”错误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