Оптимизация [большой] справочной таблицы в цикле, в R - PullRequest
0 голосов
/ 22 ноября 2018

Буду очень признателен за помощь в оптимизации кода ниже.Что касается количества итераций, которые мне нужно выполнить, в настоящее время это занимает много времени.

По сути, я ищу оптимальный набор параметров модели для оценки интересующей переменной.Я моделирую набор параметров модели и интересующую переменную, используя каждый из них (в цикле) для моделирования интересующего сигнала, затем сравниваю каждый из смоделированного сигнала с наблюдаемым сигналом, и где они минимизированы, выберите одиниз (смоделированных) значений, которые мы пытаемся предсказать.Затем функция 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]
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...