我希望這個問題不會被認為是廣泛的。然而，我不確定如何提出不同的問題：在他的 youtube 視頻中，Ed Boone 用 R 介紹了 ABM。他撰寫了以下代碼（僅更改了一些變數名稱）。代碼在 1000 次觀察時運行良好，但是當我放大觀察時它變得非常慢。因此，我想提高函式的速度。我可以start.time_x <- Sys.time()在每一行之后手動添加等（看看什么需要很多時間），但我想知道是否有更好的方法來識別瓶頸，因為所有嵌套的 for 回圈甚至使這變得非常復雜（因為我還必須考慮每個代碼運行多少次）：
# ABM_Covid - II
start.time <- Sys.time()
Data_Generator <- function(nPop1, E0, I0) {
# Create a population of susceptibles
Data <- data.frame( AgentNo=1:nPop1,
State="Susceptible",
Mixing= runif(nPop1,0,1),
TimeE = 0,
TimeI = 0,
stringsAsFactors = FALSE)
Data$State[1:E0] <- "Exposed" # This just says that the first person is exposed, since the mixing is random anyway, this is not an issue (because the mixing of Exposed is random)
Data$Time[1:E0] <- rbinom(E0, 13, 0.5) 1 # Exposure up to 14 days
Data$State[(E0 1):(E0 I0)] <- "Infected"
Data$Time[(E0 1):(E0 I0)] <- rbinom(I0, 12, 0.5)
return(Data)
}
ABM_Covid <- function(Data, parameters, runtime){
nPop1 <- nrow(Data)
# runtime <- 15
Results <- data.frame( Susceptible = rep (0, runtime),
Exposed = rep (0, runtime),
Infected = rep (0, runtime),
Recovered = rep (0, runtime),
Deaths = rep (0, runtime))
# Move people through time
for (k in 1:runtime){
# Moving people through time
StateSusceptible <- (1:nPop1)[Data$State == "Susceptible"]
StateSusceptible_or_Exposed <- (1:nPop1)[Data$State == "Susceptible" | Data$State == "Exposed"]
for (i in StateSusceptible) {
# Determine if they like to meet others
Mix1 <- Data$Mixing[i]
# How many agents will they meet? The plus one meets everybody meets somebody
Meetings <- round(Mix1*parameters$MaxMix,0) 1
# Grab the agents they will meet
People_met <- sample(StateSusceptible_or_Exposed, Meetings, replace=TRUE, prob = Data$Mixing[StateSusceptible_or_Exposed])
for (j in 1:length(People_met)) {
# Grab who they will meet
Meetingsa <- Data[People_met[j], ]
# If exposed change State
if(Meetingsa$State== "Exposed") {
Urand1 <- runif(1,0,1)
if (Urand1 < parameters$S2E){
Data$State[i] <- "Exposed"
}
}
}
}
# Grab those who have been exposed and increment
StateE1 <- (1:nPop1)[Data$State== "Exposed"]
Data$TimeE[StateE1] = Data$TimeE[StateE1] 1
StateE2 <- (1:nPop1)[Data$State== "Exposed" & Data$TimeE > 14]
Data$State[StateE2] <- "Recovered"
# Grab those who could become sick
StateE3 <- (1:nPop1)[Data$State== "Exposed" & Data$TimeE > 3]
for (i in StateE3){
Urand1 <- runif(1,0,1)
# randomly assign whether they get sick or not
if ( Urand1 < parameters$E2I ) {
Data$State[i] <- "Infected"
}
}
# Update how long they have been sick
StateI1 <- (1:nPop1)[Data$State== "Infected"]
Data$TimeI[StateI1] = Data$TimeI[StateI1] 1
# Recovered bin
StateI2 <- (1:nPop1)[Data$State== "Infected" & Data$TimeI > 14]
Data$State[StateI2] <- "R"
# Not recovered could potentially die
StateI3 <- (1:nPop1)[Data$State== "Infected" & Data$TimeI < 15]
Data$State[StateI3] <- ifelse(runif(length(StateI3), 0, 1 ) > parameters$I2D, "Infected", "Deaths")
Results$Susceptible[k] <- length(Data$State[Data$State=="Susceptible"])
Results$Exposed[k] <- length(Data$State[Data$State=="Exposed"])
Results$Infected[k] <- length(Data$State[Data$State=="Infected"])
Results$Recovered[k] <- length(Data$State[Data$State=="Recovered"])
Results$Deaths[k] <- length(Data$State[Data$State=="Deaths"])
}
return(Results)
}
Data <- Data_Generator(1000, E0=5, I0=2)
parameters <- data.frame( MaxMix = 10,
S2E = 0.25,
E2I = 0.1,
I2D = 0.1)
Model1 <- ABM_Covid(Data, parameters, runtime=25)
plot(1:25, Model1$Susceptible, type="l", col="purple", ylim = c(0,1000))
lines(1:25, Model1$Exposed, type="l", col="orange")
lines(1:25, Model1$Infected, type="l", col="red")
lines(1:25, Model1$Recovered, type="l", col="seagreen")
lines(1:25, Model1$Deaths, type="l", col="black")
end.time <- Sys.time()
time.taken <- end.time - start.time
uj5u.com熱心網友回復：
這是優化功能的一部分（狀態更新）的一種方法。這樣你就可以擺脫i回圈和j回圈。
我不確定我是否理解演算法的每個細節。但是也許您無論如何都可以使用此解決方案的某些部分和想法。
update_State <- function(nmeeting, seed = 123) {
set.seed(seed)
x <- Data %>%
filter(State %in% c("Susceptible", "Exposed")) %>%
slice_sample(n = nmeeting) %>%
filter(State == "Exposed") %>%
summarise(prob = any(runif(n()) <= paramters$S2E)) %>%
pull(prob)
return(if (x) "Exposed" else "Susceptible")
}
Data %>%
filter(State %in% c("Susceptible", "Exposed")) %>%
mutate(
n_meetings = round(Mixing*parameters$MaxMix,0) 1,
new_State = map(n_meetings, update_State) #this is the new State after all the Meetings have been made
)
這個想法是一次性檢查所有與特定人員會面的暴露人員。
這將在 4-5 秒內運行。
uj5u.com熱心網友回復：
大多數版本的 R 編譯時都支持分析，請參閱?Rprof。用途是這樣的：
Rprof()
# <Your code without the system.time calls>
Rprof(Null)
summaryRprof()
# $by.self
# self.time self.pct total.time total.pct
# "[" 0.20 26.32 0.62 81.58
# "[[.data.frame" 0.16 21.05 0.24 31.58
# "[.data.frame" 0.10 13.16 0.42 55.26
# ...
基于此頁面的示例。
轉載請註明出處，本文鏈接：https://www.uj5u.com/net/324577.html
上一篇：在R中優化qbeta的運行時