[R] Optimization Grid Search Slow

[ProfJCNash]

optimx does nothing to speed up optim or the other component optimizers. 
In fact, it does a lot of checking and extra work to improve reliability 
and add KKT tests that actually slow things down. The purpose of optimx 
is to allow comparison of methods and discovery of improved approaches 
to a problem. Is your function computing correctly?

Assuming you've got a correct function, then spending some time to speed 
up the function (I've found FORTRAN speediest) is likely your best hope.

JN



On 15-09-17 01:55 PM, Patzelt, Edward wrote:
> R Help -
>
> I am trying to use a grid search for a 2 free parameter reinforcement
> learning model and the grid search is incredibly slow. I've used optimx but
> can't seem to get reasonable answers. Is there a way to speed up this grid
> search dramatically?
>
>
> dat <- structure(list(choice = c(0, 1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 1,
>                                   1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1,
> 0, 1, 0, 1, 0, 1, 0,
>                                   0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1,
> 0, 0, 1, 0, 0, 1, 1,
>                                   1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 0, 0,
> 0, 1, 0, 0, 0, 0, 1,
>                                   1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1,
> 1, 0, 0, 0, 0, 0, 0,
>                                   1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 1,
> 1, 0, 0, 0, 0, 0, 1,
>                                   1, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 1, 1,
> 1, 0, 0, 1, 1, 0, 0,
>                                   0, 1, 1, 0, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1,
> 0, 0, 1, 0, 0, 0, 0,
>                                   1, 0, 1, 1, 1, 0), reward = c(0L, 0L, 0L,
> 0L, 1L, 1L, 0L, 0L,
>                                                                 1L, 0L, 0L,
> 0L, 0L, 0L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 0L, 0L, 1L,
>                                                                 1L, 0L, 1L,
> 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 1L, 0L, 1L,
>                                                                 1L, 0L, 1L,
> 0L, 1L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 0L, 1L, 1L,
>                                                                 0L, 0L, 1L,
> 1L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 0L, 1L, 1L,
>                                                                 1L, 1L, 0L,
> 0L, 0L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 0L,
>                                                                 0L, 0L, 0L,
> 0L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 0L,
>                                                                 1L, 0L, 0L,
> 1L, 1L, 0L, 0L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L,
>                                                                 0L, 1L, 0L,
> 0L, 0L, 1L, 0L, 1L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 0L,
>                                                                 0L, 1L, 0L,
> 1L, 1L, 0L, 1L, 1L, 0L, 0L, 1L, 0L, 1L, 1L, 1L, 0L,
>                                                                 0L, 0L, 1L,
> 0L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 1L, 1L), RepNum = c(1L,
>
>                                                     1L, 1L, 1L, 1L, 1L, 1L,
> 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
>
>                                                     1L, 1L, 1L, 1L, 1L, 1L,
> 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
>
>                                                     1L, 1L, 1L, 1L, 1L, 1L,
> 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
>
>                                                     1L, 2L, 2L, 2L, 2L, 2L,
> 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
>
>                                                     2L, 2L, 2L, 2L, 2L, 2L,
> 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
>
>                                                     2L, 2L, 2L, 2L, 2L, 2L,
> 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
>
>                                                     2L, 2L, 2L, 2L, 2L, 2L,
> 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
>
>                                                     2L, 2L, 3L, 3L, 3L, 3L,
> 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
>
>                                                     3L, 3L, 3L, 3L, 3L, 3L,
> 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
>
>                                                     3L, 3L, 3L, 3L, 3L, 3L,
> 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
>
>                                                     3L, 3L, 3L, 3L)), .Names
> = c("choice", "reward", "RepNum"), row.names = c(NA,
>
>
>                                                   165L), class =
> "data.frame")
>
>
> CNTRACSID <- 0; subjectFit <- 0;
> pLlist <- 0; pRlist <- 0; logLikelihood <- 0; trialProb <- 0;
>
> hmmFunc <- function(delta, temperature){
>
>    pLlist = 1
>    pRlist = 1
>    block = 0
>    for (i in 1:length(dat$choice))
>    {
>      if (dat$RepNum[i] != block)
>      {
>        pL = 0.5
>        pR = 0.5
>        block = dat$RepNum[i]
>      }
>      # Markov Transitions
>      pL <- pL*(1-delta) + pR*delta
>      pR <- 1-pL
>      # Apply feedback
>      #denom <- p(F|L,C) * p(L) + p(F|R,C) * p(R)
>
>      pflc <- ifelse(dat$choice[i] == dat$reward[i], .8, .2)
>      pfrc <- 1 - pflc
>      denom <- pflc * pL + pfrc * pR
>
>      # What's the new belief given observation
>      posteriorL <- pflc * pL/denom
>      posteriorR <- 1-posteriorL
>
>      pL <- posteriorL
>      pR <- posteriorR
>
>      pL <- (1/(1 + exp(-temperature * (pL-.5))))
>      pR <- (1/(1 + exp(-temperature * (pR-.5))))
>
>      pLlist[i] = pL
>      pRlist[i] = pR
>
>      if(i > 1){
>        if(dat$choice[i] == 1){
>          trialProb[i] <- pLlist[i-1]
>        } else
>        {
>          trialProb[i] <- 1-pLlist[i-1]
>        }
>      }
>      else {
>        trialProb[1] <- .5
>      }
>
>    }
>    trialProb2 <- sum(log(trialProb))
>    subFit <- exp(trialProb2/length(dat$choice))
>    hmmOutput <- list("logLikelihood" = trialProb2, "subjectFit" = subFit,
> "probabilities" = pLlist)
>    # print(hmmOutput$logLikelihood)
>    return(hmmOutput)
> }
>
>
> subjectFits <- 0; subLogLike <- 0; bestTemp <- 0; bestDelta= 0;
>
> min = 0.001; max = .5; inc = 0.001;
> deltaList = seq(min, max, inc)
> mina = 0; maxa = 5; inca = .01
> amList = seq(mina, maxa, inca)
>      maxLogValue <- -1000
>      for(delta in deltaList){
>        for(temp in amList){
>          probabilities <- hmmFunc(delta, temp)
>          if(probabilities$logLikelihood > maxLogValue){
>            pList <- probabilities$probabilities
>            maxLogValue <- probabilities$logLikelihood
>            subLogLike <- probabilities$logLikelihood
>            subjectFits <- probabilities$subjectFit
>            bestTemp <- temp
>            bestDelta <- delta
>
>          }
>        }
>      }
>
>
>
>