##================================================================================
## This file is part of the evoper package - EvoPER
##
## (C)2016, 2017 Antonio Prestes Garcia <@>
## For license terms see DESCRIPTION and/or LICENSE
##
## @file: class-objective.R
##
## This file contains the classes abstracting the objective function
##================================================================================
#' @title ObjectiveFunction class
#'
#' @description The base class for optimization functions.
#'
#' @field object The raw output of objective function
#' @field objective The objective function
#' @field parameters The parameter list for objective function
#' @field value The results from objective function
#'
#' @importFrom methods new
#' @export ObjectiveFunction
#' @exportClass ObjectiveFunction
ObjectiveFunction<- setRefClass("ObjectiveFunction",
fields = list(
object = 'ANY',
objective = 'function',
replicates = 'numeric',
objective.defaults = 'ANY',
parameters = 'ANY',
value = 'ANY',
rawdata = 'ANY',
tolerance = 'ANY',
converged = 'ANY',
maximize = 'ANY',
counter = 'ANY'),
methods = list(
initialize = function(funct) {
object<<- NULL
objective<<- funct
replicates<<- 1
objective.defaults<<- NULL
parameters<<- NULL
value<<- NULL
rawdata<<- NULL
tolerance<<- .Machine$double.eps^0.30
converged<<- FALSE
maximize<<- FALSE
counter<<- 0
},
stats = function() {
cbind(total_evals=counter,converged=converged,tolerance=tolerance)
},
isConverged = function(v) {
if(!converged) {
converged<<- (v <= tolerance)
}
converged
},
setTolerance = function(v) {
tolerance<<- v
},
setMaximize = function(v=FALSE) {
maximize<<- v
},
Parameter0 = function(...) {
assert(hasArg(name) && ((hasArg(min) && hasArg(min)) || hasArg(levels)), "Please provide the required parameters")
if(is.null(parameters)) {
parameters<<- rrepast::AddFactor0(factors=c(), ...)
} else {
parameters<<- rrepast::AddFactor0(factors=parameters, ...)
}
},
Parameter = function(name, min, max, forceint=FALSE) {
assert(hasArg(name) && hasArg(min) && hasArg(min), "Please provide the required parameters")
if(is.null(parameters)) {
parameters<<- rrepast::AddFactor(factors=c(), name=name, min=min, max=max, int=forceint)
} else {
parameters<<- rrepast::AddFactor(factors=parameters, name=name, min=min, max=max, int=forceint)
}
},
getParameterRange = function(key) {
as.numeric(parameters[which(parameters[,"name"] == key),"max"]) - as.numeric(parameters[which(parameters[,"name"] == key),"min"])
},
getParameter = function(key) {
p<- parameters[which(parameters[,"name"] == key),]
p<- as.data.frame(as.list(p))
for(k in names(p)) {
if(is.factor(p[,k])) {
v<- levels(p[,k])
} else {
v<- p[,k]
}
if(k %in% c("min","max")) {
p[,k]<- as.numeric(v)
} else {
p[,k]<- v
}
}
p
},
getParameterNames = function() {
parameters[,"name"]
},
getParameterValue = function(key, name) {
parameters[which(parameters[,"name"] == key),name]
},
getParameters = function() {
p<- data.frame(parameters, stringsAsFactors=FALSE)
for(i in 1:length(p[,1])) {
for(k in names(p)) {
v<- p[,k]
if(k %in% c("min","max")) {
p[,k]<- as.numeric(v)
} else {
p[,k]<- v
}
}
}
p
},
ParametersSize = function() {
length(parameters[,1])
},
defaults = function(v = NULL) {
if(!is.null(v)) {
objective.defaults<<- v
} else {
objective.defaults
}
},
RawData = function(v = NULL) {
if(!is.null(v)) {
rawdata<<- v
}
rawdata
},
Replicates = function(v= NULL) {
if(!is.null(v)) {
replicates<<- v
}
replicates
},
Value = function(v = NULL) {
if(!is.null(v)) {
if(maximize) {
v<- 1/v
}
value<<- v
}
value
},
Evaluate = function(swarm) {
assert(!is.null(objective),"The objective has not been provided!")
assert(!is.null(swarm),"Solution must not be null!")
## Stats: Update the call counter
counter<<- counter + nrow(swarm)
},
## Evaluate population and return results
EvalFitness = function(swarm) {
Evaluate(swarm)
Value()
}
)
)
#' @title PlainFunction
#'
#' @description PlainFunction Class
#'
#' @importFrom methods new
#' @export PlainFunction
#' @exportClass PlainFunction
PlainFunction<- setRefClass("PlainFunction", contains = "ObjectiveFunction",
methods = list(
initialize = function(o= NULL) {
assert(!is.null(o),"NUll function!")
assert(is.function(o),"Invalid function!")
if(is.null(o)) {
o<- objective
}
callSuper(o)
},
Evaluate = function(swarm) {
callSuper(swarm)
v<- Value(as.data.frame(t(apply(expand.grid(j=1,i=1:nrow(swarm)),1,function(k) { c(pset=as.integer(k[2]),fitness=do.call(objective,swarm[k[2],])) }))))
}
)
)
#' @title RepastFunction
#'
#' @description RepastFunction class
#'
#' @importFrom methods new
#' @export RepastFunction
#' @exportClass RepastFunction
RepastFunction<- setRefClass("RepastFunction", contains = "ObjectiveFunction",
fields = list(
model = 'ANY',
directory = 'character',
datasource = 'character',
endAt = 'numeric'
),
methods = list(
initialize = function(d= NULL, ds= NULL, t= NULL, o= NULL) {
if(is.null(o)) {
o<- objective
} else {
directory<<- d
datasource<<- ds
endAt<<- t
}
callSuper(o)
},
Evaluate = function(swarm) {
callSuper(swarm)
## Initialization of Repast Model instance
rrepast::Easy.Setup(directory)
##model<<- rrepast::Model(directory,endAt,datasource,TRUE)
my.model<- rrepast::Model(directory,endAt,datasource,TRUE)
## --- Update if needed the default parameters
if(!is.null(defaults())) {
rrepast::UpdateDefaultParameters(my.model, defaults())
}
## Building up parameter set
p<- rrepast::GetSimulationParameters(my.model)
if(!is.null(swarm)){
tmp<- p
p<- rrepast::BuildParameterSet(swarm, tmp)
}
## Evaluate model
object<<- RunExperiment(my.model,r=replicates,p, objective)
## Clean UP
Engine.Finish(my.model)
## Sum the objective output and change the column name
object$output<<- col.sum(object$output)
n<- names(object$output)
names(object$output)<<- replace(n, which(n == "total"),c("fitness"))
## Store the available model's raw data
RawData(object)
Value(object$output)
},
toString = function() {
sstring<- c()
paste0(sstring, "Model path= ",directory,", ")
paste0(sstring, "Datasource=",datasource,", ")
paste0(sstring, "MaX iterations=",endAt)
sstring
},
show = function() {
print(paste("Model directory is .... [",directory,"]"))
print(paste("Model datasource is ... [",datasource,"]"))
print(paste("Simulation time is .... [",endAt,"]"))
})
)
#' @title NetLogoFunction
#'
#' @description NetLogoFunction class
#'
#' @importFrom methods new
#' @export NetLogoFunction
#' @exportClass NetLogoFunction
NetLogoFunction<- setRefClass("NetLogoFunction", contains = "ObjectiveFunction",
fields = list(
model = 'ANY',
netlogodir = 'character',
modelfile = 'character',
datasource = 'character',
maxiterations = 'numeric'
),
methods = list(
initialize = function(nldir= NULL, model= NULL, output= NULL, iterations= NULL, objfn= NULL) {
if(is.null(objfn)) {
objfn<- objective
} else {
netlogodir<<- nldir
modelfile<<- model
datasource<<- output
maxiterations<<- iterations
}
callSuper(objfn)
},
Evaluate = function(swarm) {
callSuper(swarm)
## --- Model instantiation
my.model<- evoper::NLWrapper.Model(netlogodir, modelfile, datasource, maxiterations)
## --- Update if needed the default parameters
if(!is.null(defaults())) {
evoper::NLWrapper.SetParameter(my.model, defaults())
}
## Evaluate model
object<<- evoper::NLWrapper.RunExperiment(my.model, r=1, swarm, objective)
## Clean UP
evoper::NLWrapper.Shutdown(my.model)
## Sum the objective output and change the column name
object$output<<- col.sum(object$output)
n<- names(object$output)
names(object$output)<<- replace(n, which(n == "total"),c("fitness"))
## Store the available model's raw data
RawData(object)
Value(object$output)
},
toString = function() {
sstring<- c()
paste0(sstring, "NetLogo path= ",netlogodir,", ")
paste0(sstring, "Model file=",modelfile,", ")
paste0(sstring, "Model datasource=",datasource,", ")
paste0(sstring, "MaX iterations=",maxiterations)
sstring
})
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.