Буду очень признателен за помощь в оптимизации кода ниже.Что касается количества итераций, которые мне нужно выполнить, в настоящее время это занимает много времени.
По сути, я ищу оптимальный набор параметров модели для оценки интересующей переменной.Я моделирую набор параметров модели и интересующую переменную, используя каждый из них (в цикле) для моделирования интересующего сигнала, затем сравниваю каждый из смоделированного сигнала с наблюдаемым сигналом, и где они минимизированы, выберите одиниз (смоделированных) значений, которые мы пытаемся предсказать.Затем функция RMSE используется для выбора того, какой набор параметров модели предлагает наименьшую ошибку по сравнению с наблюдаемыми значениями.
Большое спасибо
Код
#Empty variable
est_hold <- NULL
# Model Parameters (simulated and/or estimated via NLS earlier)
beta <- seq(0.001,0.2,0.01)
sig.g <- seq(0.028, 0.038,length.out = 20)
sig.v <- seq(0.6, 0.8,length.out = 20)
params <- data.frame(rbind(beta,sig.g,sig.v))
# Simulated variable of interest (Dependant variable)
sim_var <- seq(1,100,0.1)
# Observed signal (Independant variable)
obs_sig <- seq(0.0001,0.8,length.out = 100000)
# Observed variable of interest (Dependant variable)
obs_var2 <- seq(1,100,length.out = 100000)
min.func <- function(x) {sim_var[which.min(x)]}
system.time({
for(c in 1:ncol(params)){
# Modelled signal (Independant)
model_var <- params[2,c]*exp(-params[1,c]*sim_var)+params[3,c]*(1-exp(-params[1,c]*sim_var))
# Calculate difference between each modelled value (using simulated params) and each observed value
diff <- t(apply(as.data.frame(model_var),1,"-",obs_sig))
diff <- abs(diff)
# Apply function, to select a simulated dependant value where differences are minimised
est <- apply(diff,2,min.func)
rm(diff)
est_hold <- cbind(est_hold,unlist(est))
}})
# RMSE function, to calculate RMSE between observed dependant variable and the modelled dependant variable (using simulated params)
rmse.fun = function(x){sqrt(sum((obs_var2-x)^2)/length(obs_var2))}
# Apply the RMSE function to the matrix of modelled values
# (where each column represents modelled values using each of the simulated params)
sim_rmse <- apply(est_hold,2,rmse.fun)
# Find the position of the lowest RMSE
ind <- which.min(sim_rmse)
#Use this position to subset the parameters (...and continue with script/modelling)
final_params <- params[ind]