[英]Replacing for loop with apply function in R
我正在嘗試計算主隊和客隊得分的平均進球數,但“今日”比賽。
可以在這里找到數據: http : //www.football-data.co.uk/mmz4281/1415/E0.csv
我的密碼
pl <- pl[,2:6]
pl$Date <- as.Date(pl$Date, "%d/%m/%y")
pl$HomeTeam <- as.character(pl$HomeTeam)
pl$AwayTeam <- as.character(pl$AwayTeam)
pl.func <- function(tf){
tf$avg.ht <- rep(NA,nrow(tf))
tf$avg.at <- rep(NA,nrow(tf))
for(i in 1:nrow(tf)){
tf$avg.ht[i] <- (sum(tf$FTHG[tf$HomeTeam == tf$HomeTeam[i] & tf$Date < tf$Date[i]]) + sum(tf$FTAG[tf$AwayTeam == tf$HomeTeam[i] & tf$Date <tf$Date[i]])) / sum(tf$HomeTeam == tf$HomeTeam[i] & tf$Date < tf$Date[i] | tf$AwayTeam == tf$HomeTeam[i] & tf$Date < tf$Date[i])
tf$avg.at[i] <- (sum(tf$FTHG[tf$HomeTeam == tf$AwayTeam[i] & tf$Date < tf$Date[i]]) + sum(tf$FTAG[tf$AwayTeam == tf$AwayTeam[i] & tf$Date <tf$Date[i]])) / sum(tf$HomeTeam == tf$AwayTeam[i] & tf$Date < tf$Date[i] | tf$AwayTeam == tf$AwayTeam[i] & tf$Date < tf$Date[i])
}
return(tf)
}
pl <- pl.func(pl)
我需要在團隊中“比賽”,並且需要更早的約會。 上面的代碼有效,但是由於我要計算數百個計算而比較慢。 誰能暗示或顯示我如何使用某種套用功能來做到這一點? 我不成功,因為我不知道以正確的方式替換循環中的[i]參數。
您實際需要的是運行條件平均值。 最近,我回答了一個類似的問題: OP需要按組每15分鍾運行一次平均值,而您需要對團隊過去每場比賽的運行平均值進行平均。
因此,請考慮以下sapply()
方法,該方法使用示例數據並運行您的代碼,並返回等效的輸出。 可能會根據您的需求進一步提高性能:
pl$runavgHT <- sapply(1:nrow(pl),
function(i) {
(sum(((pl[1:i, c("Date")] < (pl$Date[i]))
& (pl[1:i, c("HomeTeam")] == pl$HomeTeam[i]))
* pl[1:i,]$FTHG) +
sum(((pl[1:i, c("Date")] < (pl$Date[i]))
& (pl[1:i, c("AwayTeam")] == pl$HomeTeam[i]))
* pl[1:i,]$FTAG)) /
sum(((pl[1:i, c("Date")] < (pl$Date[i])) &
(pl[1:i, c("HomeTeam")] == pl$HomeTeam[i]))
|((pl[1:i, c("Date")] < (pl$Date[i])) &
(pl[1:i, c("AwayTeam")] == pl$HomeTeam[i])))
}
)
pl$runavgAT <- sapply(1:nrow(pl),
function(i) {
(sum(((pl[1:i, c("Date")] < (pl$Date[i]))
& (pl[1:i, c("HomeTeam")] == pl$AwayTeam[i]))
* pl[1:i,]$FTHG) +
sum(((pl[1:i, c("Date")] < (pl$Date[i]))
& (pl[1:i, c("AwayTeam")] == pl$AwayTeam[i]))
* pl[1:i,]$FTAG)) /
sum(((pl[1:i, c("Date")] < (pl$Date[i])) &
(pl[1:i, c("HomeTeam")] == pl$AwayTeam[i]))
|((pl[1:i, c("Date")] < (pl$Date[i])) &
(pl[1:i, c("AwayTeam")] == pl$AwayTeam[i])))
}
)
以下是一些可能的改進(以及最終基准):
1)這是函數的修改版本,僅對循環進行了一些改進:
pl.func2 <- function(DF){
DF$avg.ht <- rep(NA,nrow(DF))
DF$avg.at <- rep(NA,nrow(DF))
for(i in 1:nrow(DF)){
currDate <- DF$Date[i]
currHT <- DF$HomeTeam[i]
currAT <- DF$AwayTeam[i]
prevHT.eq.HT <- which(DF$HomeTeam == currHT & DF$Date < currDate)
prevHT.eq.AT <- which(DF$HomeTeam == currAT & DF$Date < currDate)
prevAT.eq.HT <- which(DF$AwayTeam == currHT & DF$Date < currDate)
prevAT.eq.AT <- which(DF$AwayTeam == currAT & DF$Date < currDate)
DF$avg.ht[i] <- (sum(DF$FTHG[prevHT.eq.HT]) + sum(tf$FTAG[prevAT.eq.HT])) / (length(prevHT.eq.HT) + length(prevAT.eq.HT))
DF$avg.at[i] <- (sum(DF$FTHG[prevHT.eq.AT]) + sum(tf$FTAG[prevAT.eq.AT])) / (length(prevHT.eq.AT) + length(prevAT.eq.AT))
}
return(DF)
}
2)這是您函數的另一個修改版本,該版本使用累積的信息來避免子集和匯總所有前幾天(注意,這要求data.frame必須按Date排序):
pl.func3 <- function(DF){
DF$avg.ht <- rep(NA,nrow(DF))
DF$avg.at <- rep(NA,nrow(DF))
teams <- unique(c(DF$HomeTeam,DF$AwayTeam))
cumul.info <- t(sapply(teams,FUN=function(team) c(cumulFTG=0,cumulMatches=0)))
# store column indexes to reuse them
cumulFTG <- 1
cumulMatches <- 2
for(i in 1:nrow(DF)){
currHT <- DF$HomeTeam[i]
currAT <- DF$AwayTeam[i]
DF$avg.ht[i] <- cumul.info[currHT,cumulFTG] / cumul.info[currHT,cumulMatches]
DF$avg.at[i] <- cumul.info[currAT,cumulFTG] / cumul.info[currAT,cumulMatches]
cumul.info[currHT,cumulFTG] = cumul.info[currHT,cumulFTG] + DF$FTHG[i]
cumul.info[currHT,cumulMatches] = cumul.info[currHT,cumulMatches] + 1
cumul.info[currAT,cumulFTG] = cumul.info[currAT,cumulFTG] + DF$FTAG[i]
cumul.info[currAT,cumulMatches] = cumul.info[currAT,cumulMatches] + 1
}
return(DF)
}
檢查和基准測試:
# this is necessary for pl.func3
pl <- pl[order(pl$Date),]
# are the results identical ? -> TRUE
identical(pl.func(pl),pl.func2(pl)) && identical(pl.func(pl),pl.func3(pl))
# benchmark
library(microbenchmark)
microbenchmark(pl.func(pl),pl.func2(pl),pl.func3(pl))
Unit: milliseconds
expr min lq mean median uq max neval cld
pl.func(pl) 184.36644 186.10643 188.38130 187.16322 188.80065 255.2101 100 c
pl.func2(pl) 84.95047 85.80966 89.27945 87.41589 88.33845 159.6284 100 b
pl.func3(pl) 30.72683 31.05515 32.02944 31.41211 33.22858 35.8644 100 a
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.