# Using testParameterOptimality

#### Jean-Luc Jannink

#### 21 October 2018

#### Load the BreedingSchemeLanguage.

    library(BreedingSchemeLanguage)

#### Define the objective function that you will seek to maximize

    objFunc <- function(sEnv){
      cross(sEnv, nProgeny=200) # popID 4
      scheme_out <- outputResults(sEnv)
      return(mean(scheme_out[nrow(scheme_out), 1:length(sEnv$sims)]))
    }

#### Find the script, data, and set up objects for results

    fileFounderData <- system.file("extdata", "optimizationSchemeData.RData", package = "BreedingSchemeLanguage")
    # Take ".RData" off because it gets added
    fileFounderData <- substr(fileFounderData, 1, nchar(fileFounderData)-6)
    schemeScriptPath <- system.file("extdata", "optimizationScheme.R", package = "BreedingSchemeLanguage")
    allowableBudget <- 1000
    bestObjective <- -1e6
    bestParms <- NULL
    allParms <- NULL

#### Here is the breeding scheme that we want to optimize

Notice that `sEnv` has to be used explicitly in the breeding scheme

#### Function to sample parmList at random

    sampleParmList <- function(){
      return(list(nRepC0=sample(2, 1), nRepC1=sample(2, 1), nFounder=sample(350, 1) + 50, nProg=sample(350, 1) + 50, yesGeno=runif(1) < 0.5))
    }

#### Sample possible parameter vectors and see how they do

Note that this is a very suboptimal approach to optimization

    nIter <- 10
    for (i in 1:nIter){
      # Set up a fresh simulation
      if (exists("simEnv")){
        rm(list=names(simEnv), envir=simEnv)
        rm(simEnv)
      }
      simEnv <- defineSpecies(loadData=fileFounderData)
      defineVariances(plotTypeErrVars = c(Standard = 2))
      defineCosts(phenoCost = c(Standard = 1), genoCost = 0.25)

      parmList <- sampleParmList()
      # Get objective value for the scheme
      schemeOut <- testParameterOptimality(schemeFileName = schemeScriptPath, parmList=parmList, objectiveFunc=objFunc, budget=allowableBudget)

      # If over budget, adjust number of progeny, nProg, to keep within budget
      if (is.na(schemeOut$objective)){
        adjust <- allowableBudget / schemeOut$totalCost
        parmList$nFounder <- floor(parmList$nFounder * adjust)
        parmList$nProg <- floor(parmList$nProg * adjust)
        if (exists("simEnv")){
          rm(list=names(simEnv), envir=simEnv)
          rm(simEnv)
        }
        simEnv <- defineSpecies(loadData=fileFounderData)
        defineVariances(plotTypeErrVars = c(Standard = 2))
        defineCosts(phenoCost = c(Standard = 1), genoCost = 0.25)
        schemeOut <- testParameterOptimality(schemeFileName = schemeScriptPath, parmList=parmList, objectiveFunc=objFunc, budget=allowableBudget)
        if (is.na(schemeOut$objective)) stop("Budget allocation problem")
      }

      # If objective better than anything before, save the parmList
      if (schemeOut$objective > bestObjective){
        bestObjective <- schemeOut$objective
        bestParms <- parmList
      }
      allParms <- rbind(allParms, c(i, unlist(parmList), unlist(schemeOut)))
    }

#### Print the output

    print(paste("Best Reponse", bestObjective))
    #> [1] "Best Reponse 1.9457170407781"
    print("Parameter List")
    #> [1] "Parameter List"
    print(parmList)
    #> $nRepC0
    #> [1] 2
    #>
    #> $nRepC1
    #> [1] 1
    #>
    #> $nFounder
    #> [1] 58
    #>
    #> $nProg
    #> [1] 334
    #>
    #> $yesGeno
    #> [1] TRUE
    print(head(allParms[order(allParms[,"objective"], decreasing=T),]))
    #>        nRepC0 nRepC1 nFounder.Standard nProg.Standard yesGeno objective
    #> [1,] 9      1      1               326            278       0  1.945717
    #> [2,] 4      1      2               213            225       1  1.766991
    #> [3,] 8      1      2               107            247       0  1.721471
    #> [4,] 3      1      2               196            267       0  1.699690
    #> [5,] 7      1      1               334            229       1  1.582317
    #> [6,] 2      1      1               194            311       0  1.573015
    #>      totalCost.Standard
    #> [1,]             882.00
    #> [2,]             997.50
    #> [3,]             848.00
    #> [4,]             997.00
    #> [5,]             932.75
    #> [6,]             816.00