Skip to content
Snippets Groups Projects
Commit e665890a authored by Mauricio Zambrano-Bigiarini's avatar Mauricio Zambrano-Bigiarini
Browse files

'hydroPSO': immproved checking of some arguments; 'random.update' only used... 

'hydroPSO': immproved checking of some arguments; 'random.update' only used when 'best.update'=async, and more and better examples. 'text\_functions': corrected name of the 'rastringin' function, and corrected definition of the 'shafferF6' function
parent 1893dbf9
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
DESCRIPTION
+ 3
− 3
View file @ e665890a
Package: hydroPSO Package: hydroPSO
Type: Package Type: Package
Title: Model-Independent Particle Swarm Optimisation for Environmental Models Title: Model-Independent Particle Swarm Optimisation for Environmental Models
Version: 0.1-57-1 Version: 0.1-58
Date: 2012-07-03 Date: 2012-09-14
Author: Mauricio Zambrano-Bigiarini [aut, cre] and Rodrigo Rojas [ctb] Author: Mauricio Zambrano-Bigiarini [aut, cre] and Rodrigo Rojas [ctb]
Author@R: c(person("Mauricio", "Zambrano-Bigiarini", email = "mzb.devel@gmail.com", role=c("aut", "cre") ), person("Rodrigo", "Rojas", email = "Rodrigo.RojasMujica@gmail.com", role=c("ctb") ) ) Authors@R: c(person("Mauricio", "Zambrano-Bigiarini", email="mzb.devel@gmail.com", role=c("aut","cre")), person("Rodrigo", "Rojas", email="Rodrigo.RojasMujica@gmail.com", role=c("ctb")) )
Maintainer: Mauricio Zambrano-Bigiarini <mzb.devel@gmail.com> Maintainer: Mauricio Zambrano-Bigiarini <mzb.devel@gmail.com>
Description: This package implements a state-of-the-art version of the Particle Swarm Optimisation (PSO) algorithm, with a special focus on the calibration of environmental models. hydroPSO is model-independent, allowing the user to easily interface any model code with the calibration engine (PSO). hydroPSO includes a series of controlling options and PSO variants to fine-tune the performance of the calibration engine. An advanced sensitivity analysis function together with user-friendly plotting summaries facilitate the interpretation and assessment of the calibration results. Bugs reports/comments/questions are very welcomed. Description: This package implements a state-of-the-art version of the Particle Swarm Optimisation (PSO) algorithm, with a special focus on the calibration of environmental models. hydroPSO is model-independent, allowing the user to easily interface any model code with the calibration engine (PSO). hydroPSO includes a series of controlling options and PSO variants to fine-tune the performance of the calibration engine. An advanced sensitivity analysis function together with user-friendly plotting summaries facilitate the interpretation and assessment of the calibration results. Bugs reports/comments/questions are very welcomed.
License: GPL (>=2) License: GPL (>=2)
......
NAMESPACE
+ 2
− 1
View file @ e665890a
...@@ -44,7 +44,8 @@ export(hydroPSO, ...@@ -44,7 +44,8 @@ export(hydroPSO,
wquantile, wquantile,
rosenbrock, rosenbrock,
sphere, sphere,
rastrigrin, rastrigrin, # wrong name, only used for backward compatibility
rastrigin,
griewank, griewank,
schafferF6, schafferF6,
ackley ackley
......
NEWS
+ 12
− 2
View file @ e665890a
NEWS/ChangeLog for hydroPSO NEWS/ChangeLog for hydroPSO
-------------------------- --------------------------
0.1-58 (under develpment) 0.1-58 14-Sep-2012
o 'hydroPSO' : new function 'hydromod.eval' o 'hydroPSO' : -) 'random.update' is now ONLY used when 'best.update="async". In hydroPSO 0.1-57 'random.update' was set to TRUE
by default, independent of the 'best.update="sync" value.
-) argument values are now effectively checked for: 'MinMax', 'Xini.type', 'Vini.type', 'best.update', 'boundary.wall',
'topology', 'IW.type', 'TVc1.type', 'TVc2.type', 'TVlambda.type'.
-) more and better examples
o 'test_functions': -) name of the "rastrigrin" function was changed to its correct name of "rastrigin", and modified in all the examples.
The old (and wrong) name 'rastrigrin' is kept only for backwards compatibility.
-) The definition of the 'schafferF6' function was corrected (changed) from:
0.5 + ( ( sin( sqrt( sum( x^2 ) ) ) )^2 - 0.5) / ( ( 1 + 0.01*sum(x^2) )^2 )
to:
0.5 + ( ( sin( sqrt( sum( x^2 ) ) ) )^2 - 0.5) / ( ( 1 + 0.001*sum(x^2) )^2 )
0.1-57 29-Jun-2012 0.1-57 29-Jun-2012
o 'hydroPSO' : -) added '...' parameter. It is only used when 'fn' is different from "hydromod". This is only done for 'optim' compatibility. o 'hydroPSO' : -) added '...' parameter. It is only used when 'fn' is different from "hydromod". This is only done for 'optim' compatibility.
......
R/PSO_v2012.R
+ 49
− 38
View file @ e665890a
...@@ -1154,13 +1154,14 @@ hydromod.eval <- function(part, Particles, iter, npart, maxit, ...@@ -1154,13 +1154,14 @@ hydromod.eval <- function(part, Particles, iter, npart, maxit,
# Updates: Dec-2010 # # Updates: Dec-2010 #
# May-2011 ; 28-Oct-2011 ; 14-Nov-2011 ; 23-Nov-2011 ; # # May-2011 ; 28-Oct-2011 ; 14-Nov-2011 ; 23-Nov-2011 ; #
# 15-Jan-2012 ; 23-Jan-2012 ; 30-Jan-2012 ; 23-Feb-2012 ; 23-Mar-2012 # # 15-Jan-2012 ; 23-Jan-2012 ; 30-Jan-2012 ; 23-Feb-2012 ; 23-Mar-2012 #
# 14-Jun-2012 ; 15-Jun-2012 ; 03-Jul-2012 # # 14-Jun-2012 ; 15-Jun-2012 ; 03-Jul-2012 ; 06-Jul-2012 #
# 11-Jul-2012 ; 17-Jul-2012 ; 18-Jul-2012 ; 13-Sep-2012; 14-Sep-2012 #
################################################################################ ################################################################################
# 'lower' : minimum possible value for each parameter # 'lower' : minimum possible value for each parameter
# 'upper' : maximum possible value for each parameter # 'upper' : maximum possible value for each parameter
# 'of.name' : String with the test function that will be used for computing the fitness. # 'of.name' : String with the test function that will be used for computing the fitness.
# Valid values are in: c('sinc', 'rosenbrock', 'sphere', # Valid values are in: c('sinc', 'rosenbrock', 'sphere',
# 'rastrigrin', 'griewank', 'schafferF6', 'hydromod') # 'rastrigin', 'griewank', 'schafferF6', 'hydromod')
# 'MinMax' : character, indicating if PSO have to find a minimum or a # 'MinMax' : character, indicating if PSO have to find a minimum or a
# maximum for the fitness function. # maximum for the fitness function.
# Valid values are in: c('min', 'max') # Valid values are in: c('min', 'max')
...@@ -1437,7 +1438,7 @@ hydroPSO <- function( ...@@ -1437,7 +1438,7 @@ hydroPSO <- function(
Xini.type=c("lhs", "random"), Xini.type=c("lhs", "random"),
Vini.type=c("lhs", "random", "zero"), Vini.type=c("lhs", "random", "zero"),
best.update=c("sync", "async"), best.update=c("sync", "async"),
random.update= TRUE, random.update=TRUE,
boundary.wall=c("reflecting", "damping", "absorbing", "invisible"), boundary.wall=c("reflecting", "damping", "absorbing", "invisible"),
topology=c("random", "gbest", "lbest", "vonNeumann"), K=3, iter.ini=0, ngbest=4, # only used when 'method=ipso' topology=c("random", "gbest", "lbest", "vonNeumann"), K=3, iter.ini=0, ngbest=4, # only used when 'method=ipso'
...@@ -1456,19 +1457,27 @@ hydroPSO <- function( ...@@ -1456,19 +1457,27 @@ hydroPSO <- function(
REPORT=100 REPORT=100
) )
MinMax <- match.arg(control[["MinMax"]], con[["MinMax"]])
Xini.type <- match.arg(control[["Xini.type"]], con[["Xini.type"]])
Vini.type <- match.arg(control[["Vini.type"]], con[["Vini.type"]])
best.update <- match.arg(control[["best.update"]], con[["best.update"]])
boundary.wall <- match.arg(control[["boundary.wall"]], con[["boundary.wall"]])
topology <- match.arg(control[["topology"]], con[["topology"]])
IW.type <- match.arg(control[["IW.type"]], con[["IW.type"]])
TVc1.type <- match.arg(control[["TVc1.type"]], con[["TVc1.type"]])
TVc2.type <- match.arg(control[["TVc2.type"]], con[["TVc2.type"]])
TVlambda.type <- match.arg(control[["TVlambda.type"]], con[["TVlambda.type"]])
nmsC <- names(con) nmsC <- names(con)
con[(namc <- names(control))] <- control con[(namc <- names(control))] <- control
if (length(noNms <- namc[!namc %in% nmsC])) if (length(noNms <- namc[!namc %in% nmsC]))
warning("[Unknown names in control: ", paste(noNms, collapse = ", "), " (not used) !]") warning("[Unknown names in control: ", paste(noNms, collapse = ", "), " (not used) !]")
drty.in <- con[["drty.in"]] drty.in <- con[["drty.in"]]
drty.out <- con[["drty.out"]] drty.out <- con[["drty.out"]]
param.ranges <- con[["param.ranges"]] param.ranges <- con[["param.ranges"]]
digits <- con[["digits"]] digits <- con[["digits"]]
MinMax <- match.arg(control[["MinMax"]], con[["MinMax"]])
npart <- ifelse(is.na(con[["npart"]]),ceiling(10+2*sqrt(n)),con[["npart"]]) npart <- ifelse(is.na(con[["npart"]]),ceiling(10+2*sqrt(n)),con[["npart"]])
maxit <- con[["maxit"]] maxit <- con[["maxit"]]
maxfn <- con[["maxfn"]] maxfn <- con[["maxfn"]]
...@@ -1478,29 +1487,20 @@ hydroPSO <- function( ...@@ -1478,29 +1487,20 @@ hydroPSO <- function(
lambda <- con[["lambda"]] lambda <- con[["lambda"]]
abstol <- con[["abstol"]] abstol <- con[["abstol"]]
reltol <- con[["reltol"]] reltol <- con[["reltol"]]
Xini.type <- match.arg(control[["Xini.type"]], con[["Xini.type"]])
Vini.type <- match.arg(control[["Vini.type"]], con[["Vini.type"]])
best.update <- match.arg(control[["best.update"]], con[["best.update"]])
random.update <- as.logical(con[["random.update"]]) random.update <- as.logical(con[["random.update"]])
boundary.wall <- match.arg(control[["boundary.wall"]], con[["boundary.wall"]])
topology <- match.arg(control[["topology"]], con[["topology"]])
K <- con[["K"]] K <- con[["K"]]
iter.ini <- con[["iter.ini"]] iter.ini <- con[["iter.ini"]]
ngbest <- con[["ngbest"]] ngbest <- con[["ngbest"]]
use.IW <- as.logical(con[["use.IW"]]) use.IW <- as.logical(con[["use.IW"]])
IW.type <- match.arg(control[["IW.type"]], con[["IW.type"]])
IW.w <- con[["IW.w"]] IW.w <- con[["IW.w"]]
IW.exp <- con[["IW.exp"]] IW.exp <- con[["IW.exp"]]
use.TVc1 <- as.logical(con[["use.TVc1"]]) use.TVc1 <- as.logical(con[["use.TVc1"]])
TVc1.type <- match.arg(control[["TVc1.type"]], con[["TVc1.type"]])
TVc1.rng <- con[["TVc1.rng"]] TVc1.rng <- con[["TVc1.rng"]]
TVc1.exp <- con[["TVc1.exp"]] TVc1.exp <- con[["TVc1.exp"]]
use.TVc2 <- as.logical(con[["use.TVc2"]]) use.TVc2 <- as.logical(con[["use.TVc2"]])
TVc2.type <- match.arg(control[["TVc2.type"]], con[["TVc2.type"]])
TVc2.rng <- con[["TVc2.rng"]] TVc2.rng <- con[["TVc2.rng"]]
TVc2.exp <- con[["TVc2.exp"]] TVc2.exp <- con[["TVc2.exp"]]
use.TVlambda <- as.logical(con[["use.TVlambda"]]) use.TVlambda <- as.logical(con[["use.TVlambda"]])
TVlambda.type <- match.arg(control[["TVlambda.type"]], con[["TVlambda.type"]])
TVlambda.rng <- con[["TVlambda.rng"]] TVlambda.rng <- con[["TVlambda.rng"]]
TVlambda.exp <- con[["TVlambda.exp"]] TVlambda.exp <- con[["TVlambda.exp"]]
use.RG <- as.logical(con[["use.RG"]]) use.RG <- as.logical(con[["use.RG"]])
...@@ -1519,7 +1519,7 @@ hydroPSO <- function( ...@@ -1519,7 +1519,7 @@ hydroPSO <- function(
if (maxit < REPORT) { if (maxit < REPORT) {
REPORT <- maxit REPORT <- maxit
warning("'REPORT' is greater than 'maxit' => 'REPORT=maxit'") warning("[ 'REPORT' is greater than 'maxit' => 'REPORT=maxit' ]")
} # IF end } # IF end
if ( (lambda < 0) | (lambda >1) ) if ( (lambda < 0) | (lambda >1) )
...@@ -1527,7 +1527,7 @@ hydroPSO <- function( ...@@ -1527,7 +1527,7 @@ hydroPSO <- function(
if ( K > npart ) { if ( K > npart ) {
K <- npart K <- npart
warning("'K' is greater than 'npart' => 'K=npart'") warning("[ 'K' is greater than 'npart' => 'K=npart' ]")
} # IF end } # IF end
if ( (K < 1) | (floor(K) != K) ) { if ( (K < 1) | (floor(K) != K) ) {
...@@ -1580,7 +1580,7 @@ hydroPSO <- function( ...@@ -1580,7 +1580,7 @@ hydroPSO <- function(
} # ELSE end } # ELSE end
if ( length(model.FUN.args)==0 ) { if ( length(model.FUN.args)==0 ) {
warning( "'model.FUN.args' is an empty list. Are you sure your model doesn't have any argument(s) ?" ) warning( "[ 'model.FUN.args' is an empty list. Are you sure your model does not have any argument(s) ? ]" )
} else { } else {
model.FUN.argsDefaults <- formals(model.FUN) model.FUN.argsDefaults <- formals(model.FUN)
model.FUN.args <- modifyList(model.FUN.argsDefaults, model.FUN.args) model.FUN.args <- modifyList(model.FUN.argsDefaults, model.FUN.args)
...@@ -1625,14 +1625,14 @@ hydroPSO <- function( ...@@ -1625,14 +1625,14 @@ hydroPSO <- function(
if (Xini.type=="lhs") { if (Xini.type=="lhs") {
if ( is.na( match("lhs", installed.packages()[,"Package"] ) ) ) { if ( is.na( match("lhs", installed.packages()[,"Package"] ) ) ) {
warning("Package 'lhs' is not installed => Xini.type='random'") warning("[ Package 'lhs' is not installed => Xini.type='random' ]")
Xini.type <- "random" Xini.type <- "random"
} # IF end } # IF end
} # IF end } # IF end
if (Vini.type=="lhs") { if (Vini.type=="lhs") {
if ( is.na( match("lhs", installed.packages()[,"Package"] ) ) ) { if ( is.na( match("lhs", installed.packages()[,"Package"] ) ) ) {
warning("Package 'lhs' is not installed => Vini.type='random'") warning("[ Package 'lhs' is not installed => Vini.type='random' ]")
Vini.type <- "random" Vini.type <- "random"
} # IF end } # IF end
} # IF end } # IF end
...@@ -1650,7 +1650,7 @@ hydroPSO <- function( ...@@ -1650,7 +1650,7 @@ hydroPSO <- function(
if (IW.type == "linear") { if (IW.type == "linear") {
if (IW.exp != 1) { if (IW.exp != 1) {
warning("IW.type == 'linear' => 'IW.exp=1'") warning("[ IW.type == 'linear' => 'IW.exp=1' ]")
IW.exp= 1 IW.exp= 1
} # IF end } # IF end
} # IF end } # IF end
...@@ -1672,7 +1672,7 @@ hydroPSO <- function( ...@@ -1672,7 +1672,7 @@ hydroPSO <- function(
c1.fin <- TVc1.rng[2] c1.fin <- TVc1.rng[2]
if (TVc1.type == "linear") { if (TVc1.type == "linear") {
if (TVc1.exp != 1) { if (TVc1.exp != 1) {
warning("TVc1.type == 'linear' => 'TVc1.exp=1'") warning("[ TVc1.type == 'linear' => 'TVc1.exp=1' ]")
TVc1.exp= 1 TVc1.exp= 1
} # IF end } # IF end
} # IF end } # IF end
...@@ -1683,7 +1683,7 @@ hydroPSO <- function( ...@@ -1683,7 +1683,7 @@ hydroPSO <- function(
c2.fin <- TVc2.rng[2] c2.fin <- TVc2.rng[2]
if (TVc2.type == "linear") { if (TVc2.type == "linear") {
if (TVc2.exp != 1) { if (TVc2.exp != 1) {
warning("TVc2.type == 'linear' => 'TVc2.exp=1'") warning("[ TVc2.type == 'linear' => 'TVc2.exp=1' ]")
TVc2.exp= 1 TVc2.exp= 1
} # IF end } # IF end
} # IF end } # IF end
...@@ -1695,7 +1695,7 @@ hydroPSO <- function( ...@@ -1695,7 +1695,7 @@ hydroPSO <- function(
vmax.fin <- TVlambda.rng[2] vmax.fin <- TVlambda.rng[2]
if (TVlambda.type == "linear") { if (TVlambda.type == "linear") {
if (TVlambda.exp != 1) { if (TVlambda.exp != 1) {
warning("TVlambda.type == 'linear' => 'TVlambda.exp=1'") warning("[ TVlambda.type == 'linear' => 'TVlambda.exp=1' ]")
TVlambda.exp= 1 TVlambda.exp= 1
} # IF end } # IF end
} # IF end } # IF end
...@@ -1722,7 +1722,7 @@ hydroPSO <- function( ...@@ -1722,7 +1722,7 @@ hydroPSO <- function(
stop("Invalid argument: 'ngbest' must be in [1, 'npart]'" ) stop("Invalid argument: 'ngbest' must be in [1, 'npart]'" )
if ( topology!="gbest") { if ( topology!="gbest") {
if (verbose) warning("[Note: 'method=ipso' => 'topology' was changed to 'gbest' !]" ) if (verbose) warning("[ Note: 'method=ipso' => 'topology' was changed to 'gbest' !]" )
topology <- "gbest" topology <- "gbest"
} # IF end } # IF end
} # IF end } # IF end
...@@ -1813,8 +1813,9 @@ hydroPSO <- function( ...@@ -1813,8 +1813,9 @@ hydroPSO <- function(
############################################################################ ############################################################################
if (write2disk) { if (write2disk) {
if (verbose) message(" ")
if (verbose) message("================================================================================") if (verbose) message("================================================================================")
if (verbose) message("[ Writing the 'PSO_logfile.txt' file ... ]") if (verbose) message("[ Writing the 'PSO_logfile.txt' file ... ]")
if (verbose) message("================================================================================") if (verbose) message("================================================================================")
...@@ -1859,6 +1860,10 @@ hydroPSO <- function( ...@@ -1859,6 +1860,10 @@ hydroPSO <- function(
} # IF end } # IF end
writeLines(c("Boundary wall :", boundary.wall), PSOparam.TextFile, sep=" ") writeLines(c("Boundary wall :", boundary.wall), PSOparam.TextFile, sep=" ")
writeLines("", PSOparam.TextFile) writeLines("", PSOparam.TextFile)
writeLines(c("Best update method:", best.update), PSOparam.TextFile, sep=" ")
writeLines("", PSOparam.TextFile)
writeLines(c("Random update :", random.update), PSOparam.TextFile, sep=" ")
writeLines("", PSOparam.TextFile)
if (use.TVc1) { if (use.TVc1) {
writeLines(c("use.TVc1 :", use.TVc1), PSOparam.TextFile, sep=" ") writeLines(c("use.TVc1 :", use.TVc1), PSOparam.TextFile, sep=" ")
writeLines("", PSOparam.TextFile) writeLines("", PSOparam.TextFile)
...@@ -2000,7 +2005,7 @@ hydroPSO <- function( ...@@ -2000,7 +2005,7 @@ hydroPSO <- function(
############################################################################## ##############################################################################
if (verbose) message("================================================================================") if (verbose) message("================================================================================")
if (verbose) message("[ Writing the 'hydroPSO_logfile.txt' file ... ]") if (verbose) message("[ Writing the 'hydroPSO_logfile.txt' file ... ]")
if (verbose) message("================================================================================") if (verbose) message("================================================================================")
...@@ -2161,10 +2166,7 @@ hydroPSO <- function( ...@@ -2161,10 +2166,7 @@ hydroPSO <- function(
verbose=verbose.FUN, verbose=verbose.FUN,
digits=digits, digits=digits,
model.FUN=model.FUN, model.FUN=model.FUN,
model.FUN.args=model.FUN.args, model.FUN.args=model.FUN.args
parallel=parallel,
ncores=nnodes,
mc.dirs=mc.dirs
) )
for (part in 1:npart){ for (part in 1:npart){
...@@ -2218,7 +2220,9 @@ hydroPSO <- function( ...@@ -2218,7 +2220,9 @@ hydroPSO <- function(
################### Particles Loop (j) - Start ######################## ################### Particles Loop (j) - Start ########################
########################################################################## ##########################################################################
ifelse(random.update, index.part.upd <- sample(npart), index.part.upd <- 1:npart) ifelse( (best.update == "async") & random.update,
index.part.upd <- sample(npart),
index.part.upd <- 1:npart)
for (j in index.part.upd) { for (j in index.part.upd) {
...@@ -2234,6 +2238,7 @@ hydroPSO <- function( ...@@ -2234,6 +2238,7 @@ hydroPSO <- function(
OFout.Text.file, sep=" ") OFout.Text.file, sep=" ")
} else writeLines(as.character(c(iter, j, "NA", "NA" ) ), OFout.Text.file, sep=" ") } else writeLines(as.character(c(iter, j, "NA", "NA" ) ), OFout.Text.file, sep=" ")
writeLines("", OFout.Text.file) writeLines("", OFout.Text.file)
flush(OFout.Text.file)
# File 'Particles.txt' # # File 'Particles.txt' #
if(is.finite(GoF)) { if(is.finite(GoF)) {
...@@ -2245,6 +2250,7 @@ hydroPSO <- function( ...@@ -2245,6 +2250,7 @@ hydroPSO <- function(
formatC(X[j, ], format="E", digits=digits, flag=" ") formatC(X[j, ], format="E", digits=digits, flag=" ")
) ), Particles.TextFile, sep=" ") ) ), Particles.TextFile, sep=" ")
writeLines("", Particles.TextFile) writeLines("", Particles.TextFile)
flush(Particles.TextFile)
# File 'Velocities.txt' # # File 'Velocities.txt' #
if(is.finite(GoF)) { if(is.finite(GoF)) {
...@@ -2255,7 +2261,8 @@ hydroPSO <- function( ...@@ -2255,7 +2261,8 @@ hydroPSO <- function(
} else writeLines( as.character( c(iter, j, "NA", } else writeLines( as.character( c(iter, j, "NA",
formatC(V[j, ], format="E", digits=digits, flag=" ") formatC(V[j, ], format="E", digits=digits, flag=" ")
) ), Velocities.TextFile, sep=" ") ) ), Velocities.TextFile, sep=" ")
writeLines("", Velocities.TextFile) writeLines("", Velocities.TextFile)
flush(Velocities.TextFile)
} # IF end } # IF end
...@@ -2508,7 +2515,8 @@ hydroPSO <- function( ...@@ -2508,7 +2515,8 @@ hydroPSO <- function(
formatC(NormSwarmRadius, format="E", digits=digits, flag=" "), formatC(NormSwarmRadius, format="E", digits=digits, flag=" "),
format( round(GPbest.fit.rate*100, 3), nsmall=3, width=7, justify="right") format( round(GPbest.fit.rate*100, 3), nsmall=3, width=7, justify="right")
) ), ConvergenceMeasures.TextFile, sep=" ") ) ), ConvergenceMeasures.TextFile, sep=" ")
writeLines("", ConvergenceMeasures.TextFile) writeLines("", ConvergenceMeasures.TextFile)
flush(ConvergenceMeasures.TextFile)
# File 'BestParamPerIter.txt' # # File 'BestParamPerIter.txt' #
GoF <- gbest.fit GoF <- gbest.fit
...@@ -2522,6 +2530,7 @@ hydroPSO <- function( ...@@ -2522,6 +2530,7 @@ hydroPSO <- function(
formatC(X.best.part[gbest.pos, ], format="E", digits=digits, flag=" ") formatC(X.best.part[gbest.pos, ], format="E", digits=digits, flag=" ")
) ), BestParamPerIter.TextFile, sep=" ") ) ), BestParamPerIter.TextFile, sep=" ")
writeLines("", BestParamPerIter.TextFile) writeLines("", BestParamPerIter.TextFile)
flush(BestParamPerIter.TextFile)
# File 'PbestPerIter.txt' # # File 'PbestPerIter.txt' #
GoF <- pbest.fit GoF <- pbest.fit
...@@ -2529,6 +2538,7 @@ hydroPSO <- function( ...@@ -2529,6 +2538,7 @@ hydroPSO <- function(
formatC(GoF, format="E", digits=digits, flag=" ") formatC(GoF, format="E", digits=digits, flag=" ")
) ), PbestPerIter.TextFile, sep=" ") ) ), PbestPerIter.TextFile, sep=" ")
writeLines("", PbestPerIter.TextFile) writeLines("", PbestPerIter.TextFile)
flush(PbestPerIter.TextFile)
# File 'LocalBestPerIter.txt' # # File 'LocalBestPerIter.txt' #
GoF <- LocalBest.fit GoF <- LocalBest.fit
...@@ -2536,6 +2546,7 @@ hydroPSO <- function( ...@@ -2536,6 +2546,7 @@ hydroPSO <- function(
formatC(GoF, format="E", digits=digits, flag=" ") formatC(GoF, format="E", digits=digits, flag=" ")
) ), LocalBestPerIter.TextFile, sep=" ") ) ), LocalBestPerIter.TextFile, sep=" ")
writeLines("", LocalBestPerIter.TextFile) writeLines("", LocalBestPerIter.TextFile)
flush(LocalBestPerIter.TextFile)
} # IF end } # IF end
...@@ -2571,9 +2582,9 @@ hydroPSO <- function( ...@@ -2571,9 +2582,9 @@ hydroPSO <- function(
################### START WRITING OUTPUT FILES ################### ################### START WRITING OUTPUT FILES ###################
if (write2disk) { if (write2disk) {
if (verbose) message(" ") if (verbose) message(" ")
if (verbose) message("[Writing output files...]") if (verbose) message("[ Writing output files... ]")
if (verbose) message(" ") if (verbose) message(" ")
niter.real <- iter - 1 niter.real <- iter - 1
......
R/test_functions.R
+ 10
− 3
View file @ e665890a
...@@ -29,13 +29,20 @@ sphere <- function(x) { ...@@ -29,13 +29,20 @@ sphere <- function(x) {
} # 'sphere' END } # 'sphere' END
# MZB, RR, 21-Jun-2011, 14-Nov-2011 # MZB, RR, 21-Jun-2011, 14-Nov-2011. Keep only for backward compatibility
# Rastrigrin function: f(0,..,0)=0. Minimization. In [-5.12, 5.12]^n. AcceptableError < 100 # Rastrigrin function: f(0,..,0)=0. Minimization. In [-5.12, 5.12]^n. AcceptableError < 100
rastrigrin <- function(x) { rastrigrin <- function(x) {
n <- length(x) n <- length(x)
return( 10*n + sum( x^2 - 10*cos(2*pi*x) ) ) return( 10*n + sum( x^2 - 10*cos(2*pi*x) ) )
} # 'rastrigrin' END } # 'rastrigrin' END
# MZB, RR, 17-Jul-2012. The correct name of the function is 'Rastrigin' and NOT 'Rastrigrin' !!!
# Rastrigin function: f(0,..,0)=0. Minimization. In [-5.12, 5.12]^n. AcceptableError < 100
rastrigin <- function(x) {
n <- length(x)
return( 10*n + sum( x^2 - 10*cos(2*pi*x) ) )
} # 'rastrigin' END
# MZB, RR, 21-Jun-2011 # MZB, RR, 21-Jun-2011
# Griewank function: f(0,..,0)=0. Minimization. In [-600, 600]^n. AcceptableError < 0.05 # Griewank function: f(0,..,0)=0. Minimization. In [-600, 600]^n. AcceptableError < 0.05
...@@ -45,10 +52,10 @@ griewank <- function(x) { ...@@ -45,10 +52,10 @@ griewank <- function(x) {
} # 'griewank' END } # 'griewank' END
# MZB, RR, 21-Jun-2011, 14-Nov-2011 # MZB, RR, 21-Jun-2011, 14-Nov-2011, 13-Sep-2012
# Schaffer's f6 function: f(0,..,0)=0. Minimization. In [-100, 100]^n. AcceptableError < 0.00001 # Schaffer's f6 function: f(0,..,0)=0. Minimization. In [-100, 100]^n. AcceptableError < 0.00001
schafferF6 <- function(x) { schafferF6 <- function(x) {
return( 0.5 + ( ( sin( sqrt( sum( x^2 ) ) ) )^2 - 0.5) / ( ( 1 + 0.01*sum(x^2) )^2 ) ) return( 0.5 + ( ( sin( sqrt( sum( x^2 ) ) ) )^2 - 0.5) / ( ( 1 + 0.001*sum(x^2) )^2 ) )
} # 'schafferF6' END } # 'schafferF6' END
......
man/ReadPlot_results.Rd
+ 2
− 2
View file @ e665890a
...@@ -339,11 +339,11 @@ nparam <- 10 ...@@ -339,11 +339,11 @@ nparam <- 10
# boundaries for the test function # boundaries for the test function
x <- c(-100, 100) # "sphere" x <- c(-100, 100) # "sphere"
#x <- c(-5.12, 5.12) # "rastrigrin" #x <- c(-5.12, 5.12) # "rastrigin"
#x <- c(-32, 32) # "ackley" #x <- c(-32, 32) # "ackley"
fn <- "sphere" fn <- "sphere"
#fn <- "rastrigrin" #fn <- "rastrigin"
#fn <- "ackley" #fn <- "ackley"
####################################### #######################################
......
man/hydroPSO-package.Rd
+ 4
− 4
View file @ e665890a
...@@ -23,12 +23,12 @@ The default control arguments in hydroPSO implements the Standard PSO 2007 - SPS ...@@ -23,12 +23,12 @@ The default control arguments in hydroPSO implements the Standard PSO 2007 - SPS
\tabular{ll}{ \tabular{ll}{
Package: \tab hydroPSO\cr Package: \tab hydroPSO\cr
Type: \tab Package\cr Type: \tab Package\cr
Version: \tab 0.1-57\cr Version: \tab 0.1-58\cr
Date: \tab 2012-06-29\cr Date: \tab 2012-09-14\cr
License: \tab GPL (>=2)\cr License: \tab GPL (>=2)\cr
LazyLoad: \tab yes\cr LazyLoad: \tab yes\cr
Packaged: \tab Fri Jun 29 11:26:36 CEST 2012; MZB \cr Packaged: \tab Fri Sep 14 16:30:03 CEST 2012; MZB \cr
BuiltUnder: \tab R version 2.15.0 (2012-03-30); x86_64-redhat-linux-gnu (64-bit) \cr BuiltUnder: \tab R version 2.15.1 (2012-06-22) -- "Roasted Marshmallows"; x86_64-redhat-linux-gnu (64-bit) \cr
} }
%%~~ An overview of how to use the package, including the most important functions ~~ %%~~ An overview of how to use the package, including the most important functions ~~
} }
......
man/hydroPSO.Rd
+ 56
− 18
View file @ e665890a
...@@ -385,33 +385,71 @@ Note for \code{\link[stats]{optim}} users: \cr ...@@ -385,33 +385,71 @@ Note for \code{\link[stats]{optim}} users: \cr
\code{\link[stats]{optim}} \code{\link[stats]{optim}}
} }
\examples{ \examples{
# Number of dimensions to be optimised # Number of dimensions of the optimisation problem (for all the examples)
nparam <- 5 nparam <- 3
\dontrun{ \dontrun{
# Setting the home directory of the user as working directory # Setting the home directory of the user as working directory
setwd("~") setwd("~")
# Setting the seed ################################
# Example 1. Basic use #
################################
# Setting the seed (for reproducible results)
set.seed(100) set.seed(100)
hydroPSO( # Basic use. Rastrigin function (non-linear and multimodal with many local minima)
fn="rastrigrin", hydroPSO(fn="rastrigrin", lower=rep(-5.12, nparam), upper=rep(5.12, nparam) )
lower=rep(-5.12, nparam), upper=rep(5.12, nparam),
control=list(
MinMax="min",
npart=2*nparam,
use.TVlambda= TRUE, TVlambda.type= "linear",
TVlambda.rng= c(1, 0.5), TVlambda.exp= 1,
topology="gbest",
write2disk=TRUE
) # control
) # hydroPSO
# Plotting the results # Plotting the results
plot_results(MinMax="min") plot_results(MinMax="min")
# Plotting the results and saving then into PNG files
plot_results(MinMax="min", do.png=TRUE)
################################
# Example 2. More advanced use #
################################
# Setting the seed (for reproducible results)
set.seed(100)
# Defining the swarm size ('npart'), the relative tolerance ('reltol'),
# the absolute tolerance ('abstol') and the frequency of report messages printed
# to the screen ('REPORT')
hydroPSO( fn="rastrigrin", lower=rep(-5.12, nparam), upper=rep(5.12, nparam),
control=list(npart=15, reltol=1e-15, abstol=1e-14, REPORT=10) )
################################
# Example 3. Gbest Topology #
# (or why is not recommended ) #
################################
# Setting the seed (for reproducible results)
set.seed(100)
# Same as Example 2, but setting the topology to global gest ('topology="gbest"')
hydroPSO( fn="rastrigrin", lower=rep(-5.12, nparam), upper=rep(5.12, nparam),
control=list(npart=15, reltol=1e-15, abstol=1e-14, REPORT=10,
topology="gbest") )
################################
# Example 4. Asynchronus update#
################################
# Setting the seed (for reproducible results)
set.seed(100)
# Same as Example 3, but using asynchronus update of previus and local best
# ('best.update="async"')
hydroPSO( fn="rastrigrin", lower=rep(-5.12, nparam), upper=rep(5.12, nparam),
control=list(npart=15, reltol=1e-15, abstol=1e-14, REPORT=10,
topology="gbest", best.update="async") )
} # dontrun END } # dontrun END
} }
......
man/test_functions.Rd
+ 1
− 0
View file @ e665890a
...@@ -8,6 +8,7 @@ ...@@ -8,6 +8,7 @@
\alias{ackley} \alias{ackley}
\alias{griewank} \alias{griewank}
\alias{rastrigrin} \alias{rastrigrin}
\alias{rastrigin}
\alias{rosenbrock} \alias{rosenbrock}
\alias{schafferF6} \alias{schafferF6}
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment