DEoptimR/0000755000176200001440000000000015041474612011741 5ustar liggesusersDEoptimR/tests/0000755000176200001440000000000015041467316013106 5ustar liggesusersDEoptimR/tests/NCDEoptim-tst.R0000644000176200001440000000332614456542373015635 0ustar liggesusersrequire(DEoptimR) c.time <- function(...) cat('Time elapsed: ', ..., '\n') S.time <- function(expr) c.time(system.time(expr)) (doExtras <- DEoptimR:::doExtras()) set.seed(2345) # Bound-constrained test problems ---------------------------------------------- bl <- function(x) { # Becker and Lago problem # # -10 <= x1, x2 <= 10 # The function has four minima located at (+-5, +-5), all with f(x*) = 0. # # Source: # Ali, M. Montaz, Khompatraporn, Charoenchai, and Zabinsky, Zelda B. (2005). # A numerical evaluation of several stochastic algorithms on selected # continuous global optimization test problems. # Journal of Global Optimization 31, 635-672. sum((abs(x) - 5)^2) } S.time(bl_ <- NCDEoptim(-c(10, 10), c(10, 10), bl, niche_radius = 5, maxiter = 100)) # Only inequality constraints -------------------------------------------------- # Function F1 # # f(x) = x^2 # subject to: # g(x) = 1 - x^2 <= 0 # # -2 <= x <= 2 # The two global optima are (x1*, x2*; f*) = (1, -1; 1). # # Source: # Poole, Daniel J. and Allen, Christian B. (2019). # Constrained niching using differential evolution. # Swarm and Evolutionary Computation 44, 74-100. S.time(F1_ <- NCDEoptim(-2, 2, function(x) x^2, function(x) 1 - x^2, niche_radius = 1, maxiter = 200)) # Expected optimal values ------------------------------------------------------ stopifnot( all.equal( as.vector(abs(bl_$solution_arch)), rep(5, 8), tolerance = 1e-3 ), all.equal( as.vector(abs(F1_$solution_arch)), c(1, 1), tolerance = 1e-2 ) ) c.time(proc.time()) DEoptimR/tests/JDEoptim-tst.R0000644000176200001440000000477014452636140015522 0ustar liggesusersrequire("DEoptimR") c.time <- function(...) cat('Time elapsed: ', ..., '\n') S.time <- function(expr) c.time(system.time(expr)) source(system.file("xtraR/opt-test-funs.R", package = "DEoptimR")) ## sf1(), swf() + g11, RND, HEND, and alkylation list of $obj and $con testing functions (doExtras <- DEoptimR:::doExtras()) set.seed(2345) # Bound-constrained test problems ---------------------------------------------- S.time(sf1. <- JDEoptim(c(-100, -100), c(100, 100), sf1, NP = 50, tol = 1e-7, maxiter = 800)) S.time(swf. <- JDEoptim(rep(-500, 10), rep(500, 10), swf, tol = 1e-7)) # Only equality constraints ---------------------------------------------------- S.time(g11. <- JDEoptim(-c(1, 1), c(1, 1), fn = g11$obj, constr = g11$con, meq = g11$eq, eps = 1e-3, tol = 1e-7)) # Only inequality constraints -------------------------------------------------- S.time(RND. <- JDEoptim(c(1e-5, 1e-5), c(16, 16), RND$obj, RND$con, NP = 40, tol = 1e-7)) if (doExtras) { S.time(HEND. <- JDEoptim(c( 100, 1000, 1000 , 10, 10), c(10000, 10000, 10000, 1000, 1000), fn = HEND$obj, constr = HEND$con, tol = 1e-4, trace = TRUE)) S.time(alkylation. <- JDEoptim(c(1500, 1, 3000, 85, 90, 3, 145), c(2000, 120, 3500, 93, 95, 12, 162), fn = alkylation$obj, constr = alkylation$con, tol = 0.1, trace = TRUE)) } # Expected optimal values ------------------------------------------------------ bare.p.v <- function(r) unlist(unname(r[c("par", "value")])) stopifnot( all.equal( bare.p.v(sf1.), c(0, 0, 0), tolerance = 1e-4 ), all.equal( bare.p.v(swf.), c(rep(420.97, 10), -418.9829*10), tolerance = 1e-4 ), all.equal( bare.p.v(RND.), c(3.036504, 5.096052, -0.388812), tolerance = 1e-2 ), all.equal( unname(c(abs(g11.$par[1]), g11.$par[2], g11.$value)), c(1/sqrt(2), 0.5, 0.75), tolerance = 1e-2 ) ) if (doExtras) { stopifnot( all.equal( bare.p.v(HEND.), c(579.19, 1360.13, 5109.92, 182.01, 295.60, 7049.25), tolerance = 1e-3 ), all.equal( bare.p.v(alkylation.), c(1698.256922, 54.274463, 3031.357313, 90.190233, 95.0, 10.504119, 153.535355, -1766.36), tolerance = 1e-2 ) ) } c.time(proc.time()) DEoptimR/MD50000644000176200001440000000105515041474612012252 0ustar liggesusers6a6e45742cc400b96fd64b06c14aacba *DESCRIPTION 33529186848b9627acaf529a68ab59da *NAMESPACE bfbdb21d46b6f6eb8edcc9137451cc12 *R/JDEoptim.R d5bfaa27c86b6e8c4bed17328718ec6e *R/NCDEoptim.R 1bf18d9c216b8d95033f0bd2fe2906b2 *build/partial.rdb c4d528ddb915ef9085c049b0e9a4d16d *inst/NEWS.Rd 6f22a91df1975e192f7efd64eeb72a48 *inst/xtraR/opt-test-funs.R 683e7192dd6e17e45068c420e1098b7d *man/JDEoptim.Rd 740484a15f868802ed0f009d740f126d *man/NCDEoptim.Rd 49c04f0cf264f0c6c7df5caab4157fc1 *tests/JDEoptim-tst.R 5b648ab0243181fbcb6b23db782dd1c4 *tests/NCDEoptim-tst.R DEoptimR/R/0000755000176200001440000000000015041467316012145 5ustar liggesusersDEoptimR/R/NCDEoptim.R0000644000176200001440000004556214472514543014070 0ustar liggesusersNCDEoptim <- function( lower, upper, fn, constr = NULL, meq = 0, eps = 1e-5, crit = 1e-5, niche_radius = NULL, archive_size = 100, reinit_if_solu_in_arch = TRUE, NP = 100, Fl = 0.1, Fu = 1, CRl = 0, CRu = 1.1, nbngbrsl = NP/20, nbngbrsu = NP/5, tau_F = 0.1, tau_CR = 0.1, tau_pF = 0.1, tau_nbngbrs = 0.1, jitter_factor = 0.001, maxiter = 2000, add_to_init_pop = NULL, trace = FALSE, triter = 1, ...) { # Copyright 2023, Eduardo L. T. Conceicao # Available under the GPL (>= 2) handle_bounds <- function(x, u) { # Check feasibility of bounds and enforce parameters limits # by a deterministic variant of bounce-back resetting # (also known as midpoint target/base) # Price, KV, Storn, RM, and Lampinen, JA (2005) # Differential Evolution: A Practical Approach to Global Optimization. # Springer, p 206 bad <- x > upper x[bad] <- 0.5*(upper[bad] + u[bad]) bad <- x < lower x[bad] <- 0.5*(lower[bad] + u[bad]) x } perform_reproduction <- function() { # Mutate/recombine ignore <- runif(d) > CRtrial if (all(ignore)) # ensure that trial gets at least ignore[sample(d, 1)] <- FALSE # one mutant parameter # Source for trial is the base vector plus weighted differential trial <- if (runif(1) <= pFtrial) X_base + Ftrial*(X_r1 - X_r2) else X_base + 0.5*(Ftrial + 1)*(X_r1 + X_r2 - 2*X_base) # or trial parameter comes from target vector X_i itself. trial[ignore] <- X_i[ignore] trial } which_best <- if (!is.null(constr)) function(x) { ind <- TAVpop <= mu if (all(ind)) which.min(x) else if (any(ind)) which(ind)[which.min(x[ind])] else which.min(TAVpop) } else which.min # Check input parameters stopifnot(length(upper) == length(lower), length(lower) > 0, is.numeric(lower), is.finite(lower), length(upper) > 0, is.numeric(upper), is.finite(upper), lower <= upper, is.function(fn)) if (!is.null(constr)) stopifnot(is.function(constr), length(meq) == 1, meq == as.integer(meq), meq >= 0, is.numeric(eps), is.finite(eps), eps > 0, length(eps) == 1 || length(eps) == meq) stopifnot(length(crit) == 1, is.numeric(crit), is.finite(crit), crit > 0) if (!is.null(niche_radius)) stopifnot(length(niche_radius) == 1, is.numeric(niche_radius), is.finite(niche_radius), niche_radius > 0) stopifnot(length(archive_size) == 1, archive_size == as.integer(archive_size), archive_size >= 0, length(reinit_if_solu_in_arch) == 1, is.logical(reinit_if_solu_in_arch), !is.na(reinit_if_solu_in_arch)) stopifnot(length(NP) == 1, NP == as.integer(NP), NP >= 0, length(Fl) == 1, is.numeric(Fl), length(Fu) == 1, is.numeric(Fu), Fl <= Fu, length(CRl) == 1, is.numeric(CRl), length(CRu) == 1, is.numeric(CRu), CRl <= CRu) stopifnot(length(tau_F) == 1, is.numeric(tau_F), tau_F >= 0, tau_F <= 1, length(tau_CR) == 1, is.numeric(tau_CR), tau_CR >= 0, tau_CR <= 1, length(tau_pF) == 1, is.numeric(tau_pF), tau_pF >= 0, tau_pF <= 1, length(tau_nbngbrs) == 1, is.numeric(tau_nbngbrs), tau_nbngbrs >= 0, tau_nbngbrs <= 1) if (!is.null(jitter_factor)) stopifnot(length(jitter_factor) == 1, is.numeric(jitter_factor), is.finite(jitter_factor)) stopifnot(length(maxiter) == 1, maxiter == as.integer(maxiter), maxiter >= 0) if (!is.null(add_to_init_pop)) stopifnot(NROW(add_to_init_pop) == length(lower), is.numeric(add_to_init_pop), is.finite(add_to_init_pop), add_to_init_pop >= lower, add_to_init_pop <= upper) stopifnot(length(trace) == 1, is.logical(trace), !is.na(trace), length(triter) == 1, triter == as.integer(triter), triter >= 1) check_archive <- if (reinit_if_solu_in_arch) { expression({ if (ftrial < best_fpop || isTRUE(all.equal(best_fpop, ftrial, tolerance = crit))) { if (is.null(S)) S <- as.matrix(c(ftrial, trial)) if (ftrial < best_fpop) best_fpop <- ftrial found_ind <- sqrt(colSums( (trial - S[-1, , drop = FALSE])^2 )) <= R if (any(found_ind)) { # Re-initialize nearest neighbor of the trial vector pop[, k] <- runif(d, lower, upper) fpop[k] <- fn1(pop[, k]) F[, k] <- if (use_jitter) runif(1, Fl, Fu) * (1 + jitter_factor*runif(d, -0.5, 0.5)) else runif(1, Fl, Fu) CR[k] <- runif(1, CRl, CRu) pF[k] <- runif(1) nbngbrs[k] <- runif(1, nbngbrsl, nbngbrsu) S[, found_ind & (ftrial < S[1, ])] <- c(ftrial, trial) if (sum(found_ind) > 1) S <- unique(S, MARGIN = 2) } else if (ncol(S) < archive_size) S <- cbind(S, c(ftrial, trial)) } }) } else { expression({ if (ftrial < best_fpop || isTRUE(all.equal(best_fpop, ftrial, tolerance = crit))) { if (is.null(S)) S <- as.matrix(c(ftrial, trial)) if (ftrial < best_fpop) best_fpop <- ftrial found_ind <- sqrt(colSums( (trial - S[-1, , drop = FALSE])^2 )) <= R if (any(found_ind)) { S[, found_ind & (ftrial < S[1, ])] <- c(ftrial, trial) if (sum(found_ind) > 1) S <- unique(S, MARGIN = 2) } else if (ncol(S) < archive_size) S <- cbind(S, c(ftrial, trial)) } }) } check_archive_constr <- if (reinit_if_solu_in_arch) { expression({ if (all( htrial <= 0 ) && (ftrial < best_fpop || isTRUE(all.equal(best_fpop, ftrial, tolerance = crit)))) { if (ftrial < best_fpop) { if (is.null(S)) S <- as.matrix(c(ftrial, trial, htrial)) best_fpop <- ftrial } found_ind <- sqrt(colSums( (trial - S[x_ind_in_S, , drop = FALSE])^2 )) <= R if (any(found_ind)) { # Re-initialize nearest neighbor of the trial vector pop[, k] <- runif(d, lower, upper) fpop[k] <- fn1(pop[, k]) hpop[, k] <- constr1(pop[, k]) F[, k] <- if (use_jitter) runif(1, Fl, Fu) * (1 + jitter_factor*runif(d, -0.5, 0.5)) else runif(1, Fl, Fu) CR[k] <- runif(1, CRl, CRu) pF[k] <- runif(1) nbngbrs[k] <- runif(1, nbngbrsl, nbngbrsu) TAVpop[k] <- sum(pmax(hpop[, k], 0)) S[, found_ind & (ftrial < S[1, ])] <- c(ftrial, trial, htrial) if (sum(found_ind) > 1) S <- unique(S, MARGIN = 2) } else if (ncol(S) < archive_size) S <- cbind(S, c(ftrial, trial, htrial)) } }) } else { expression({ if (all( htrial <= 0 ) && (ftrial < best_fpop || isTRUE(all.equal(best_fpop, ftrial, tolerance = crit)))) { if (ftrial < best_fpop) { if (is.null(S)) S <- as.matrix(c(ftrial, trial, htrial)) best_fpop <- ftrial } found_ind <- sqrt(colSums( (trial - S[x_ind_in_S, , drop = FALSE])^2 )) <= R if (any(found_ind)) { S[, found_ind & (ftrial < S[1, ])] <- c(ftrial, trial, htrial) if (sum(found_ind) > 1) S <- unique(S, MARGIN = 2) } else if (ncol(S) < archive_size) S <- cbind(S, c(ftrial, trial, htrial)) } }) } identification_radius <- if (is.null(niche_radius)) { expression({ dist <- vapply( pop_index, function(i) min(sqrt(colSums( (pop[, i] - pop[, -i, drop = FALSE])^2 ))), 0 ) R <- min(R, mean(dist)) }) } else expression() update_pop <- if (is.null(constr)) { expression({ pop <- pop_next fpop <- fpop_next F <- F_next CR <- CR_next pF <- pF_next nbngbrs <- nbngbrs_next }) } else { expression({ pop <- pop_next fpop <- fpop_next hpop <- hpop_next F <- F_next CR <- CR_next pF <- pF_next nbngbrs <- nbngbrs_next TAVpop <- TAVpop_next }) } child <- if (is.null(constr)) { # Evaluate/select expression({ ftrial <- fn1(trial) if (ftrial <= fpop[k]) { pop_next[, k] <- trial fpop_next[k] <- ftrial F_next[, k] <- Ftrial CR_next[k] <- CRtrial pF_next[k] <- pFtrial nbngbrs_next[k] <- nbngbrstrial eval(check_archive) } }) } else if (meq > 0) { # equality constraints are present # alongside the inequalities # Zhang, Haibo, and Rangaiah, G. P. (2012). # An efficient constraint handling method with integrated differential # evolution for numerical and engineering optimization. # Computers and Chemical Engineering 37, 74-88. expression({ htrial <- constr1(trial) TAVtrial <- sum( pmax(htrial, 0) ) if (TAVtrial > mu) { if (TAVtrial <= TAVpop[k]) { # trial and target are both pop_next[, k] <- trial # infeasible, the one with smaller hpop_next[, k] <- htrial # constraint violation is chosen F_next[, k] <- Ftrial # or trial vector when both are CR_next[k] <- CRtrial # solutions of equal quality pF_next[k] <- pFtrial nbngbrs_next[k] <- nbngbrstrial TAVpop_next[k] <- TAVtrial } } else if (TAVpop[k] > mu) { # trial is feasible and target is not pop_next[, k] <- trial fpop_next[k] <- fn1(trial) hpop_next[, k] <- htrial F_next[, k] <- Ftrial CR_next[k] <- CRtrial pF_next[k] <- pFtrial nbngbrs_next[k] <- nbngbrstrial TAVpop_next[k] <- TAVtrial } else { # between two feasible solutions, the ftrial <- fn1(trial) # one with better objective function if (ftrial <= fpop[k]) { # value is chosen pop_next[, k] <- trial # or trial vector when both are fpop_next[k] <- ftrial # solutions of equal quality hpop_next[, k] <- htrial F_next[, k] <- Ftrial CR_next[k] <- CRtrial pF_next[k] <- pFtrial nbngbrs_next[k] <- nbngbrstrial TAVpop_next[k] <- TAVtrial eval(check_archive_constr) FF <- sum(TAVpop <= mu)/NP mu <- mu*(1 - FF/NP) } } }) } else { # only inequality constraints are present expression({ htrial <- constr1(trial) TAVtrial <- sum( pmax(htrial, 0) ) if (TAVtrial > mu) { if (TAVtrial <= TAVpop[k]) { # trial and target both infeasible pop_next[, k] <- trial hpop_next[, k] <- htrial F_next[, k] <- Ftrial CR_next[k] <- CRtrial pF_next[k] <- pFtrial nbngbrs_next[k] <- nbngbrstrial TAVpop_next[k] <- TAVtrial } } else if (TAVpop[i] > mu) { # trial is feasible and target is not pop_next[, k] <- trial fpop_next[k] <- fn1(trial) hpop_next[, k] <- htrial F_next[, k] <- Ftrial CR_next[k] <- CRtrial pF_next[k] <- pFtrial nbngbrs_next[k] <- nbngbrstrial TAVpop_next[k] <- TAVtrial FF <- sum(TAVpop <= mu)/NP mu <- mu*(1 - FF/NP) } else { # two feasible solutions ftrial <- fn1(trial) if (ftrial <= fpop[k]) { pop_next[, k] <- trial fpop_next[k] <- ftrial hpop_next[, k] <- htrial F_next[, k] <- Ftrial CR_next[k] <- CRtrial pF_next[k] <- pFtrial nbngbrs_next[k] <- nbngbrstrial TAVpop_next[k] <- TAVtrial eval(check_archive_constr) FF <- sum(TAVpop <= mu)/NP mu <- mu*(1 - FF/NP) } } }) } fn1 <- function(par) fn(par, ...) if (!is.null(constr)) constr1 <- if (meq > 0) { equal_index <- 1:meq function(par) { h <- constr(par, ...) h[equal_index] <- abs(h[equal_index]) - eps h } } else function(par) constr(par, ...) use_jitter <- !is.null(jitter_factor) # Initialization d <- length(lower) pop <- matrix(runif(NP*d, lower, upper), nrow = d) if (!is.null(add_to_init_pop)) { pop <- unname(cbind(pop, add_to_init_pop)) NP <- ncol(pop) } stopifnot(NP >= 4, length(nbngbrsl) == 1, is.numeric(nbngbrsl), nbngbrsl >= 3, length(nbngbrsu) == 1, is.numeric(nbngbrsu), nbngbrsu <= NP - 1, nbngbrsl <= nbngbrsu) # Combine jitter with dither # Storn, Rainer (2008). # Differential evolution research - trends and open questions. # In: U. K. Chakraborty (Ed.), Advances in Differential Evolution, # SCI 143, Springer-Verlag, pp 11-12 F <- if (use_jitter) (1 + jitter_factor*runif(d, -0.5, 0.5)) %o% runif(NP, Fl, Fu) else matrix(runif(NP, Fl, Fu), nrow = 1) CR <- runif(NP, CRl, CRu) pF <- runif(NP) nbngbrs <- runif(NP, nbngbrsl, nbngbrsu) fpop <- apply(pop, 2, fn1) stopifnot(is.vector(fpop), !anyNA(fpop), !is.nan(fpop), !is.logical(fpop)) pop_next <- pop F_next <- F CR_next <- CR pF_next <- pF nbngbrs_next <- nbngbrs fpop_next <- fpop if (!is.null(constr)) { hpop <- apply(pop, 2, constr1) stopifnot(is.matrix(hpop) || is.vector(hpop), !anyNA(hpop), !is.nan(hpop), !is.logical(hpop)) if (is.vector(hpop)) dim(hpop) <- c(1, length(hpop)) TAVpop <- apply( hpop, 2, function(x) sum(pmax(x, 0)) ) mu <- median(TAVpop) hpop_next <- hpop TAVpop_next <- TAVpop } S <- NULL R <- if (is.null(niche_radius)) Inf else niche_radius best_fpop <- if (!is.null(constr)) Inf else min(fpop) x_ind_in_S <- 2:(d+1) pop_index <- 1:NP iteration <- 0 while (iteration < maxiter) { # Generation loop iteration <- iteration + 1 eval(identification_radius) for (i in pop_index) { # Start loop through population # Equalize the mean lifetime of all vectors # Price, KV, Storn, RM, and Lampinen, JA (2005) # Differential Evolution: A Practical Approach to # Global Optimization. Springer, p 284 i <- ((iteration + i) %% NP) + 1 # Self-adjusting parameter control scheme Ftrial <- if (runif(1) <= tau_F) { # Combine jitter with dither if (use_jitter) runif(1, Fl, Fu) * (1 + jitter_factor*runif(d, -0.5, 0.5)) else runif(1, Fl, Fu) } else F[, i] CRtrial <- if (runif(1) <= tau_CR) runif(1, CRl, CRu) else CR[i] pFtrial <- if (runif(1) <= tau_pF) runif(1) else pF[i] nbngbrstrial <- if (runif(1) <= tau_nbngbrs) runif(1, nbngbrsl, nbngbrsu) else nbngbrs[i] # DE/rand/1/either-or/bin X_i <- pop[, i] # Select smallest distance members to the target vector subpop_ind <- order( sqrt(colSums((X_i - pop[, -i, drop = FALSE])^2)) )[1:nbngbrstrial] # Randomly pick 3 vectors from the subpopulation r <- sample((pop_index[-i])[subpop_ind], 3) X_base <- pop[, r[1L]] X_r1 <- pop[, r[2L]] X_r2 <- pop[, r[3L]] trial <- handle_bounds(perform_reproduction(), X_base) # Identify the most similar individual of the trial vector k <- which.min( sqrt(colSums((trial - pop)^2)) ) eval(child) } eval(update_pop) if (trace && (iteration %% triter == 0)) { x_best_in_pop <- which_best(fpop) x_best_in_S <- which.min(S[1, ]) cat(iteration, ":", "<", R, ">", "population>>", "(", fpop[x_best_in_pop], ")", pop[, x_best_in_pop], if (!is.null(constr)) paste("{", which(hpop[, x_best_in_pop] > 0), "}"), "archive>>", "[", ncol(S), "]", "(", S[1, x_best_in_S], ")", S[x_ind_in_S, x_best_in_S], fill = TRUE) } } res <- list(iter = iteration) if (!is.null(S)) { ord <- order(S[1, ]) res$solution_arch <- unname(S[x_ind_in_S, ord, drop = FALSE]) res$objective_arch <- unname(S[1, ord]) if (!is.null(constr)) res$constr_value_arch <- unname(S[-(1:(d+1)), ord, drop = FALSE]) } if (!is.null(constr)) { ord <- order(apply(hpop > 0, 2, any), fpop) res$constr_value_pop <- hpop[, ord, drop = FALSE] } else ord <- order(fpop) res$solution_pop <- pop[, ord, drop = FALSE] res$objective_pop <- fpop[ord] res } DEoptimR/R/JDEoptim.R0000644000176200001440000002764115041466424013754 0ustar liggesusersJDEoptim <- function(lower, upper, fn, constr = NULL, meq = 0, eps = 1e-5, NP = 10*length(lower), Fl = 0.1, Fu = 1, tau_F = 0.1, tau_CR = 0.1, tau_pF = 0.1, jitter_factor = 0.001, tol = 1e-15, maxiter = 2000*length(lower), fnscale = 1, compare_to = c("median", "max"), add_to_init_pop = NULL, trace = FALSE, triter = 1, details = FALSE, ...) # Copyright 2013, 2014, 2016, 2023, 2025, Eduardo L. T. Conceicao # Available under the GPL (>= 2) { handle.bounds <- function(x, u) { # Check feasibility of bounds and enforce parameters limits # by a deterministic variant of bounce-back resetting # (also known as midpoint target/base) # Price, KV, Storn, RM, and Lampinen, JA (2005) # Differential Evolution: A Practical Approach to Global Optimization. # Springer, p 206 bad <- x > upper x[bad] <- 0.5*(upper[bad] + u[bad]) bad <- x < lower x[bad] <- 0.5*(lower[bad] + u[bad]) x } performReproduction <- function() { # Mutate/recombine ignore <- runif(d) > CRtrial if (all(ignore)) # ensure that trial gets at least ignore[sample(d, 1)] <- FALSE # one mutant parameter # Source for trial is the base vector plus weighted differential trial <- if (runif(1) <= pFtrial) X.base + Ftrial*(X.r1 - X.r2) else X.base + 0.5*(Ftrial + 1)*(X.r1 + X.r2 - 2*X.base) # or trial parameter comes from target vector X.i itself. trial[ignore] <- X.i[ignore] trial } which.best <- if (!is.null(constr)) function(x) { ind <- TAVpop <= mu if (all(ind)) which.min(x) else if (any(ind)) which(ind)[which.min(x[ind])] else which.min(TAVpop) } else which.min # Check input parameters compare_to <- match.arg(compare_to) stopifnot(length(upper) == length(lower), length(lower) > 0, is.numeric(lower), is.finite(lower), length(upper) > 0, is.numeric(upper), is.finite(upper), lower <= upper, is.function(fn)) if (!is.null(constr)) stopifnot(is.function(constr), length(meq) == 1, meq == as.integer(meq), meq >= 0, is.numeric(eps), is.finite(eps), eps > 0, length(eps) == 1 || length(eps) == meq) stopifnot(length(NP) == 1, NP == as.integer(NP), NP >= 0, length(Fl) == 1, is.numeric(Fl), length(Fu) == 1, is.numeric(Fu), Fl <= Fu) stopifnot(length(tau_F) == 1, is.numeric(tau_F), 0 <= tau_F, tau_F <= 1, length(tau_CR) == 1, is.numeric(tau_CR), 0 <= tau_CR, tau_CR <= 1, length(tau_pF) == 1, is.numeric(tau_pF), 0 <= tau_pF, tau_pF <= 1) if (!is.null(jitter_factor)) stopifnot(length(jitter_factor) == 1, is.numeric(jitter_factor), is.finite(jitter_factor)) stopifnot(length(tol) == 1, is.numeric(tol), is.finite(tol), length(maxiter) == 1, maxiter == as.integer(maxiter), maxiter >= 0, length(fnscale) == 1, is.numeric(fnscale), is.finite(fnscale), fnscale > 0) if (!is.null(add_to_init_pop)) stopifnot(NROW(add_to_init_pop) == length(lower), is.numeric(add_to_init_pop), is.finite(add_to_init_pop), add_to_init_pop >= lower, add_to_init_pop <= upper) stopifnot(length(trace) == 1, is.logical(trace), !is.na(trace), length(triter) == 1, triter == as.integer(triter), triter >= 1, length(details) == 1, is.logical(details), !is.na(details)) child <- if (is.null(constr)) { # Evaluate/select expression({ ftrial <- fn1(trial) if (ftrial <= fpop[i]) { pop[, i] <- trial fpop[i] <- ftrial F[, i] <- Ftrial CR[i] <- CRtrial pF[i] <- pFtrial } }) } else if (meq > 0) { # equality constraints are present # alongside the inequalities # Zhang, Haibo, and Rangaiah, G. P. (2012). # An efficient constraint handling method with integrated differential # evolution for numerical and engineering optimization. # Computers and Chemical Engineering 37, 74-88. expression({ htrial <- constr1(trial) TAVtrial <- sum( pmax(htrial, 0) ) if (TAVtrial > mu) { if (TAVtrial <= TAVpop[i]) { # trial and target are both pop[, i] <- trial # infeasible, the one with smaller hpop[, i] <- htrial # constraint violation is chosen F[, i] <- Ftrial # or trial vector when both are CR[i] <- CRtrial # solutions of equal quality pF[i] <- pFtrial TAVpop[i] <- TAVtrial } } else if (TAVpop[i] > mu) { # trial is feasible and target is not pop[, i] <- trial fpop[i] <- fn1(trial) hpop[, i] <- htrial F[, i] <- Ftrial CR[i] <- CRtrial pF[i] <- pFtrial TAVpop[i] <- TAVtrial } else { # between two feasible solutions, the ftrial <- fn1(trial) # one with better objective function if (ftrial <= fpop[i]) { # value is chosen pop[, i] <- trial # or trial vector when both are fpop[i] <- ftrial # solutions of equal quality hpop[, i] <- htrial F[, i] <- Ftrial CR[i] <- CRtrial pF[i] <- pFtrial TAVpop[i] <- TAVtrial FF <- sum(TAVpop <= mu)/NP mu <- mu*(1 - FF/NP) } } }) } else { # only inequality constraints are present expression({ htrial <- constr1(trial) TAVtrial <- sum( pmax(htrial, 0) ) if (TAVtrial > mu) { if (TAVtrial <= TAVpop[i]) { # trial and target both infeasible pop[, i] <- trial hpop[, i] <- htrial F[, i] <- Ftrial CR[i] <- CRtrial pF[i] <- pFtrial TAVpop[i] <- TAVtrial } } else if (TAVpop[i] > mu) { # trial is feasible and target is not pop[, i] <- trial fpop[i] <- fn1(trial) hpop[, i] <- htrial F[, i] <- Ftrial CR[i] <- CRtrial pF[i] <- pFtrial TAVpop[i] <- TAVtrial FF <- sum(TAVpop <= mu)/NP mu <- mu*(1 - FF/NP) } else { # two feasible solutions ftrial <- fn1(trial) if (ftrial <= fpop[i]) { pop[, i] <- trial fpop[i] <- ftrial hpop[, i] <- htrial F[, i] <- Ftrial CR[i] <- CRtrial pF[i] <- pFtrial TAVpop[i] <- TAVtrial FF <- sum(TAVpop <= mu)/NP mu <- mu*(1 - FF/NP) } } }) } fn1 <- function(par) fn(par, ...) if (!is.null(constr)) constr1 <- if (meq > 0) { eqI <- 1:meq function(par) { h <- constr(par, ...) h[eqI] <- abs(h[eqI]) - eps h } } else function(par) constr(par, ...) use.jitter <- !is.null(jitter_factor) # Zielinski, Karin, and Laur, Rainer (2008). # Stopping criteria for differential evolution in # constrained single-objective optimization. # In: U. K. Chakraborty (Ed.), Advances in Differential Evolution, # SCI 143, Springer-Verlag, pp 111-138 conv <- expression( ( do.call(compare_to, list(fpop)) - fpop[x.best.ind] )/fnscale ) # Initialization d <- length(lower) pop <- matrix(runif(NP*d, lower, upper), nrow = d) if (!is.null(add_to_init_pop)) { pop <- unname(cbind(pop, add_to_init_pop)) NP <- ncol(pop) } stopifnot(NP >= 4) # Combine jitter with dither # Storn, Rainer (2008). # Differential evolution research - trends and open questions. # In: U. K. Chakraborty (Ed.), Advances in Differential Evolution, # SCI 143, Springer-Verlag, pp 11-12 F <- if (use.jitter) (1 + jitter_factor*runif(d, -0.5, 0.5)) %o% runif(NP, Fl, Fu) else matrix(runif(NP, Fl, Fu), nrow = 1) CR <- runif(NP) pF <- runif(NP) fpop <- apply(pop, 2, fn1) stopifnot(is.vector(fpop), !anyNA(fpop), !is.nan(fpop), !is.logical(fpop)) if (!is.null(constr)) { hpop <- apply(pop, 2, constr1) stopifnot(is.matrix(hpop) || is.vector(hpop), !anyNA(hpop), !is.nan(hpop), !is.logical(hpop)) if (is.vector(hpop)) dim(hpop) <- c(1, length(hpop)) TAVpop <- apply( hpop, 2, function(x) sum(pmax(x, 0)) ) mu <- median(TAVpop) } popIndex <- 1:NP x.best.ind <- which.best(fpop) converge <- eval(conv) rule <- if (!is.null(constr)) expression(converge >= tol || any(hpop[, x.best.ind] > 0)) else expression(converge >= tol) convergence <- 0 iteration <- 0 while (eval(rule)) { # Generation loop if (iteration >= maxiter) { warning("maximum number of iterations reached without convergence") convergence <- 1 break } iteration <- iteration + 1 for (i in popIndex) { # Start loop through population # Equalize the mean lifetime of all vectors # Price, KV, Storn, RM, and Lampinen, JA (2005) # Differential Evolution: A Practical Approach to # Global Optimization. Springer, p 284 i <- ((iteration + i) %% NP) + 1 # Self-adjusting parameter control scheme Ftrial <- if (runif(1) <= tau_F) { # Combine jitter with dither if (use.jitter) runif(1, Fl, Fu) * (1 + jitter_factor*runif(d, -0.5, 0.5)) else runif(1, Fl, Fu) } else F[, i] CRtrial <- if (runif(1) <= tau_CR) runif(1) else CR[i] pFtrial <- if (runif(1) <= tau_pF) runif(1) else pF[i] # DE/rand/1/either-or/bin X.i <- pop[, i] # Randomly pick 3 vectors all diferent from target vector r <- sample(popIndex[-i], 3) X.base <- pop[, r[1L]] X.r1 <- pop[, r[2L]] X.r2 <- pop[, r[3L]] trial <- handle.bounds(performReproduction(), X.base) eval(child) x.best.ind <- which.best(fpop) } converge <- eval(conv) if (trace && (iteration %% triter == 0)) cat(iteration, ":", "<", converge, ">", "(", fpop[x.best.ind], ")", pop[, x.best.ind], if (!is.null(constr)) paste("{", which(hpop[, x.best.ind] > 0), "}"), fill = TRUE) } res <- list(par = pop[, x.best.ind], value = fpop[x.best.ind], iter = iteration, convergence = convergence) if (details) { res$poppar <- pop res$popcost <- fpop } res } ## Not exported, and only used because CRAN checks must be faster doExtras <- function() { interactive() || nzchar(Sys.getenv("R_DEoptimR_check_extra")) || identical("true", unname(Sys.getenv("R_PKG_CHECKING_doExtras"))) } DEoptimR/NAMESPACE0000644000176200001440000000010114451623744013156 0ustar liggesusersimportFrom( stats, runif, median ) export( JDEoptim, NCDEoptim ) DEoptimR/inst/0000755000176200001440000000000015041467316012721 5ustar liggesusersDEoptimR/inst/xtraR/0000755000176200001440000000000015041467316014021 5ustar liggesusersDEoptimR/inst/xtraR/opt-test-funs.R0000644000176200001440000001264214222375330016673 0ustar liggesusersswf <- function(x) { # Schwefel problem # # -500 <= xi <= 500, i = {1, 2, ..., n} # The number of local minima for a given n is not known, but the global # minimum f(x*) = -418.9829n is located at x* = (s, s, ..., s), s = 420.97. # # Source: # Ali, M. Montaz, Khompatraporn, Charoenchai, and Zabinsky, Zelda B. (2005). # A numerical evaluation of several stochastic algorithms on selected # continuous global optimization test problems. # Journal of Global Optimization 31, 635-672. -crossprod( x, sin(sqrt(abs(x))) ) } sf1 <- function(x) { # Schaffer 1 problem # # -100 <= x1, x2 <= 100 # The number of local minima is not known but the global minimum # is located at x* = (0, 0) with f(x*) = 0. # # Source: # Ali, M. Montaz, Khompatraporn, Charoenchai, and Zabinsky, Zelda B. (2005). # A numerical evaluation of several stochastic algorithms on selected # continuous global optimization test problems. # Journal of Global Optimization 31, 635-672. temp <- x[1]^2 + x[2]^2 0.5 + (sin(sqrt(temp))^2 - 0.5)/(1 + 0.001*temp)^2 } g11 <- list( obj = function(x) { # -1 <= xi <= 1 (i = 1, 2) # The optimal solution is x* = (+-1/sqrt(2), 1/2) # and the optimal value f(x*) = 0.75. # # Source: # Runarsson, Thomas P., and Yao, Xin (2000). # Stochastic ranking for constrained evolutionary optimization. # IEEE Transactions on Evolutionary Computation 4, 284-294. x[1]^2 + (x[2] - 1)^2 }, eq = 1, con = function(x) x[2] - x[1]^2 ) RND <- list( obj = function(x) { # Reactor network design # # 1e-5 <= x5, x6 <= 16 # It possesses two local solutions at x = (16, 0) with f = -0.37461 # and at x = (0, 16) with f = -0.38808. # The global optimum is (x5, x6; f) = (3.036504, 5.096052; -0.388812). # # Source: # Babu, B. V., and Angira, Rakesh (2006). # Modified differential evolution (MDE) for optimization of nonlinear # chemical processes. # Computers and Chemical Engineering 30, 989-1002. x5 <- x[1]; x6 <- x[2] k1 <- 0.09755988; k2 <- 0.99*k1; k3 <- 0.0391908; k4 <- 0.9*k3 -( k2*x6*(1 + k3*x5) + k1*x5*(1 + k2*x6) ) / ( (1 + k1*x5)*(1 + k2*x6)* (1 + k3*x5)*(1 + k4*x6) ) }, con = function(x) sqrt(x[1]) + sqrt(x[2]) - 4 ) HEND <- list( obj = function(x) { # Heat exchanger network design # # 100 <= x1 <= 10000, 1000 <= x2, x3 <= 10000, 10 <= x4, x5 <= 1000 # The global optimum is (x1, x2, x3, x4, x5; f) = (579.19, 1360.13, # 5109.92, 182.01, 295.60; 7049.25). # # Source: # Babu, B. V., and Angira, Rakesh (2006). # Modified differential evolution (MDE) for optimization of nonlinear # chemical processes. # Computers and Chemical Engineering 30, 989-1002. x[1] + x[2] + x[3] }, con = function(x) { x1 <- x[1]; x2 <- x[2]; x3 <- x[3]; x4 <- x[4]; x5 <- x[5] c(100*x1 - x1*(400 - x4) + 833.33252*x4 - 83333.333, x2*x4 - x2*(400 - x5 + x4) - 1250*x4 + 1250*x5, x3*x5 - x3*(100 + x5) - 2500*x5 + 1250000) } ) alkylation <- list( obj = function(x) { # Optimal operation of alkylation unit # # Variable Lower Bound Upper Bound # ------------------------------------ # x1 1500 2000 # x2 1 120 # x3 3000 3500 # x4 85 93 # x5 90 95 # x6 3 12 # x7 145 162 # ------------------------------------ # The maximum profit is $1766.36 per day, and the optimal # variable values are x1 = 1698.256922, x2 = 54.274463, x3 = 3031.357313, # x4 = 90.190233, x5 = 95.0, x6 = 10.504119, x7 = 153.535355. # # Source: # Babu, B. V., and Angira, Rakesh (2006). # Modified differential evolution (MDE) for optimization of nonlinear # chemical processes. # Computers and Chemical Engineering 30, 989-1002. x1 <- x[1]; x3 <- x[3] 1.715*x1 + 0.035*x1*x[6] + 4.0565*x3 + 10.0*x[2] - 0.063*x3*x[5] }, con = function(x) { x1 <- x[1]; x2 <- x[2]; x3 <- x[3]; x4 <- x[4] x5 <- x[5]; x6 <- x[6]; x7 <- x[7] c(0.0059553571*x6^2*x1 + 0.88392857*x3 - 0.1175625*x6*x1 - x1, 1.1088*x1 + 0.1303533*x1*x6 - 0.0066033*x1*x6^2 - x3, 6.66173269*x6^2 + 172.39878*x5 - 56.596669*x4 - 191.20592*x6 - 10000, 1.08702*x6 + 0.32175*x4 - 0.03762*x6^2 - x5 + 56.85075, 0.006198*x7*x4*x3 + 2462.3121*x2 - 25.125634*x2*x4 - x3*x4, 161.18996*x3*x4 + 5000.0*x2*x4 - 489510.0*x2 - x3*x4*x7, 0.33*x7 - x5 + 44.333333, 0.022556*x5 - 0.007595*x7 - 1.0, 0.00061*x3 - 0.0005*x1 - 1.0, 0.819672*x1 - x3 + 0.819672, 24500.0*x2 - 250.0*x2*x4 - x3*x4, 1020.4082*x4*x2 - 1.2244898*x3*x4 - 100000*x2, 6.25*x1*x6 + 6.25*x1 - 7.625*x3 - 100000, 1.22*x3 - x6*x1 - x1 + 1.0) } ) DEoptimR/inst/NEWS.Rd0000644000176200001440000000230515041466424013763 0ustar liggesusers\name{NEWS} \title{News for package \pkg{DEoptimR}} \section{Changes in DEoptimR version 1.1-4 (2025-07-27)}{ \itemize{ \item In \code{JDEoptim()}, the default value of \code{maxiter} is increased tenfold. } } \section{Changes in DEoptimR version 1.1-0 (2023-07-10)}{ \itemize{ \item New \code{NCDEoptim()} adds a bespoke implementation of the NCDE algorithm for multimodal optimization. } } \section{Changes in DEoptimR version 1.0-6 (2016-07-05)}{ \itemize{ \item In \code{JDEoptim()}, \code{FUN} renamed to \code{compare_to}. } } \section{Changes in DEoptimR version 1.0-5 (2016-07-01)}{ \itemize{ \item In \code{JDEoptim()}, \code{tau1}, \code{tau2} and \code{tau3} renamed to \code{tau_F}, \code{tau_CR} and \code{tau_pF}, respectively. } } \section{Changes in DEoptimR version 1.0-0 (2014-01-27)}{ \itemize{ \item First release of DEoptimR: implementation of a bespoke variant of the jDE algorithm for single-objective optimization. \item Constraint handling based on biasing feasible over unfeasible solutions by a parameter-less variant of the \eqn{\varepsilon}{epsilon}-constrained method. } }DEoptimR/build/0000755000176200001440000000000015041467401013036 5ustar liggesusersDEoptimR/build/partial.rdb0000644000176200001440000000007515041467401015165 0ustar liggesusers‹‹àb```b`aed`b1…À€… H02°0piÖ¼ÄÜÔb C"Éð ´¤7DEoptimR/man/0000755000176200001440000000000015041467316012517 5ustar liggesusersDEoptimR/man/NCDEoptim.Rd0000644000176200001440000002366414505343150014574 0ustar liggesusers\name{NCDEoptim} \alias{NCDEoptim} \title{ Bound-Constrained and Nonlinear Constrained Multimodal Optimization via Differential Evolution } \description{ A bespoke implementation of the \sQuote{NCDE} (neighborhood based crowding DE) algorithm by Qu \emph{et al.} (2012) \doi{10.1109/TEVC.2011.2161873}, assisted with the dynamic archive mechanism of Epitropakis \emph{et al.} (2013) \doi{10.1109/CEC.2013.6557556}. } \usage{ NCDEoptim(lower, upper, fn, constr = NULL, meq = 0, eps = 1e-5, crit = 1e-5, niche_radius = NULL, archive_size = 100, reinit_if_solu_in_arch = TRUE, NP = 100, Fl = 0.1, Fu = 1, CRl = 0, CRu = 1.1, nbngbrsl = NP/20, nbngbrsu = NP/5, tau_F = 0.1, tau_CR = 0.1, tau_pF = 0.1, tau_nbngbrs = 0.1, jitter_factor = 0.001, maxiter = 2000, add_to_init_pop = NULL, trace = FALSE, triter = 1, ...) } \arguments{ \item{lower, upper}{numeric vectors, the lower and upper bounds of the search space (\emph{box constraints}); must be finite (\code{\link{is.finite}}).} \item{fn}{a \code{\link{function}} to be \strong{minimized} that takes a numeric vector \eqn{X_i} as first argument and returns the value of the objective.} \item{constr}{a vector \code{\link{function}} specifying the \strong{left-hand side} of equality constraints defined to equal zero (\eqn{h_j(X_i) = 0,\; j = 1,\ldots,\mathrm{meq}}), followed by inequality constraints defined as lesser than zero (\eqn{g_j(X_i) \le 0,\; j = \mathrm{meq}+1,\ldots}). This function takes \eqn{X_i} as its first argument and returns a numeric vector with the same length of the total number of constraints. It defaults to \code{NULL}, which means that \strong{bound-constrained} minimization is used.} \item{meq}{an integer, the first \code{meq} constraints are \emph{equality} constraints whereas the remaining ones are \emph{inequality} constraints. Defaults to \code{0} (inequality constraints only).} \item{eps}{the maximal admissible constraint violation for equality constraints. A numeric vector of small positive tolerance values with length \code{meq} used in the transformation of equalities into inequalities of the form \eqn{|h_j(X_i)| - \epsilon \le 0}. A scalar value is expanded to apply to all equality constraints. Default is \code{1e-5}.} \item{crit}{a numeric, the acceptance threshold on the archive strategy. If \code{\link{isTRUE}(\link{all.equal}(fn(X_best_so_far_in_archive), fn(X_i), tolerance = crit))}, a solution \eqn{X_i} is checked for possible insertion into the dynamic archive. Defaults to \code{1e-5}.} \item{niche_radius}{a numeric, the absolute tolerance used to decide whether the solution \eqn{X_i} is \emph{identical} to an already existing local or global solution \emph{in the archive}. It defaults to \code{NULL}, meaning that the niche radius is adaptively chosen during the search. Results are \strong{much better} if one is able to provide a reasonable value.} \item{archive_size}{an integer, the maximum number of solutions that can be kept in the archive; entries above this limit are discarded. Default is \code{100}.} \item{reinit_if_solu_in_arch}{a logical, if \code{TRUE}, any solution \eqn{X_i} already in the archive \strong{reinitializes} its nearest neighbor \emph{in the population} within the range \eqn{[\mathrm{lower}, \mathrm{upper}]}. Default is \code{TRUE}.} \item{NP}{an integer, the population size. Defaults to \code{100}.} \item{Fl}{a numeric, the minimum value that the \emph{scaling factor} \code{F} could take. It defaults to \code{0.1}.} \item{Fu}{a numeric, the maximum value that the \emph{scaling factor} \code{F} could take. It defaults to \code{1}.} \item{CRl}{a numeric, the minimum value to be used for the \emph{crossover constant} \code{CR}. It defaults to \code{0}.} \item{CRu}{a numeric, the maximum value to be used for the \emph{crossover constant} \code{CR}. It defaults to \code{1.1}.} \item{nbngbrsl}{an integer, the lower limit for the \emph{neighborhood size} \code{nbngbrs}. It defaults to \code{1/20} of the population size.} \item{nbngbrsu}{an integer, the upper limit for the \emph{neighborhood size} \code{nbngbrs}. It defaults to \code{1/5} of the population size.} \item{tau_F}{a numeric, the probability that the \emph{scaling factor} \code{F} is updated. Defaults to \code{0.1}.} \item{tau_CR}{a numeric, the probability that the \emph{crossover constant} \code{CR} is updated. Defaults to \code{0.1}.} \item{tau_pF}{a numeric, the probability that the \emph{mutation probability} \eqn{p_F}{pF} in the mutation strategy DE/rand/1/either-or is updated. Defaults to \code{0.1}.} \item{tau_nbngbrs}{a numeric, the probability that the \emph{neighborhood size} \code{nbngbrs} is updated. Defaults to \code{0.1}.} \item{jitter_factor}{a numeric, the tuning constant for \emph{jitter}. If \code{NULL} only \emph{dither} is used. Default is \code{0.001}.} \item{maxiter}{an integer, the maximum number of iterations allowed which is the \strong{stopping condition}. Default is \code{2000}.} \item{add_to_init_pop}{numeric vector of length \code{length(lower)} or column-wise \code{\link{matrix}} with \code{length(lower)} rows specifying initial candidate solutions which are appended to the randomly generated initial population. Default is \code{NULL}.} \item{trace}{a logical, determines whether or not to monitor the iteration process. Default is \code{FALSE}.} \item{triter}{an integer, trace output is printed at every \code{triter} iterations. Default is \code{1}.} \item{\dots}{additional arguments passed to \code{fn} and \code{constr}.} } \details{ This implementation differs mainly from the original \sQuote{NCDE} algorithm of Qu \emph{et al.} (2012) by employing the archiving procedure proposed in Epitropakis \emph{et al.} (2013) and the adaptive \sQuote{jDE} strategy instead of canonical Diferential Evolution. The key reason for archiving good solutions during the search process is to prevent them from being lost during evolution. Constraints are tackled through the \eqn{\varepsilon}{epsilon}-constrained method as proposed in Poole and Allen (2019). The \sQuote{jDE} and \eqn{\varepsilon}{epsilon}-constrained mechanisms are applied in the same way as in \code{\link{JDEoptim}}, but with \emph{synchronous} mode of population update. In contrast, the reinitialization in the current population triggered by already found solutions is done \emph{asynchronously}. Each line of trace output follows the format of: \code{iteration : < value of niche radius > population>> ( value of best solution ) best solution { index of violated constraints } archive>> [ number of solutions found ] ( value of best solution ) best solution} } \value{ A list with the following components: \item{solution_arch}{a \code{\link{matrix}} whose columns are the local and global minima stored in the \strong{archive} of feasible solutions in ascending order of the objective function values.} \item{objective_arch}{the values of \eqn{\mathrm{fn}(X_i)} for the corresponding columns of \code{solution_arch}.} \item{solution_pop}{a \code{\link{matrix}} whose columns are the local and global minima stored in the \strong{final population} in ascending order of the objective function values; feasible solutions come first followed by the infeasible ones.} \item{objective_pop}{the values of \eqn{\mathrm{fn}(X_i)} for the corresponding columns of \code{solution_pop}.} \item{iter}{the number of iterations used.} and if there are general constraints present: \item{constr_value_arch}{a \code{\link{matrix}} whose columns contain the values of the constraints for \code{solution_arch}.} \item{constr_value_pop}{a \code{\link{matrix}} whose columns contain the values of the constraints for \code{solution_pop}.} } \references{ Epitropakis, M. G., Li, X. and Burke, E. K. (2013) A dynamic archive niching differential evolution algorithm for multimodal optimization; in \emph{2013 IEEE Congress on Evolutionary Computation (CEC)}. IEEE, pp. 79--86. \doi{10.1109/CEC.2013.6557556}. Poole, D. J. and Allen, C. B. (2019) Constrained niching using differential evolution. \emph{Swarm and Evolutionary Computation} \bold{44}, 74--100. \doi{10.1016/j.swevo.2018.11.004}. Qu, B. Y., Suganthan, P. N. and Liang, J. J. (2012) Differential evolution with neighborhood mutation for multimodal optimization. \emph{IEEE Transactions on Evolutionary Computation} \bold{16}, 601--614. \doi{10.1109/TEVC.2011.2161873}. } \author{ Eduardo L. T. Conceicao \email{mail@eduardoconceicao.org} } \note{ \bold{This function is in an experimental stage.} } \examples{ \donttest{ # NOTE: Examples were excluded from testing # to reduce package check time. # Use a preset seed so test values are reproducible. set.seed(1234) # Warning: the examples are run using a very small number of # iterations to decrease execution time. # Bound-constrained optimization # Vincent function # # f(x) = -mean(sin(10*log(x))) # # 0.25 <= xi <= 10, i = {1, 2, ..., n} # The function has 6^n global minima without local minima. NCDEoptim(c(0.25, 0.25), c(10, 10), function(x) -mean(sin(10*log(x))), niche_radius = 0.2, maxiter = 200, trace = TRUE, triter = 20) # Nonlinear constrained optimization # Function F10 of Poole and Allen (2019) # # f(x) = -sin(5*pi*x)^6 + 1 # subject to: # g(x) = -cos(10*pi*x) <= 0 # # 0 <= x <= 1 # The 10 global optima are # (x1*, ..., x10*; f*) = ((2*(1:10) - 1)/20; 0.875). NCDEoptim(0, 1, function(x) -sin(5*pi*x)^6 + 1, function(x) -cos(10*pi*x), niche_radius = 0.05, maxiter = 200, trace = TRUE, triter = 20) } } \concept{multimodal optimization} DEoptimR/man/JDEoptim.Rd0000644000176200001440000004734715041466424014477 0ustar liggesusers\name{JDEoptim} \alias{JDEoptim} \title{ Bound-Constrained and Nonlinear Constrained Single-Objective Optimization via Differential Evolution } \description{ A bespoke implementation of the \sQuote{jDE} variant by Brest \emph{et al.} (2006) \doi{10.1109/TEVC.2006.872133}. } \usage{ JDEoptim(lower, upper, fn, constr = NULL, meq = 0, eps = 1e-05, NP = 10*length(lower), Fl = 0.1, Fu = 1, tau_F = 0.1, tau_CR = 0.1, tau_pF = 0.1, jitter_factor = 0.001, tol = 1e-15, maxiter = 2000*length(lower), fnscale = 1, compare_to = c("median", "max"), add_to_init_pop = NULL, trace = FALSE, triter = 1, details = FALSE, ...) } \arguments{ \item{lower, upper}{numeric vectors of \emph{lower} and \emph{upper} bounds for the parameters to be optimized over. Must be finite (\code{\link{is.finite}}) as they bound the hyper-rectangle of the initial random population.} \item{fn}{(nonlinear) objective \code{\link{function}} to be \emph{minimized}. It takes as first argument the vector of parameters over which minimization is to take place. It must return the value of the function at that point.} \item{constr}{an optional \code{\link{function}} for specifying the \emph{left-hand side} of nonlinear constraints under which we want to minimize \code{fn}. Nonlinear equalities should be given first and defined to equal zero (\eqn{h_j(X) = 0}), followed by nonlinear inequalities defined as lesser than zero (\eqn{g_i(X) \le 0}). This function takes the vector of parameters as its first argument and returns a real vector with the length of the total number of constraints. It defaults to \code{NULL}, meaning that \emph{bound-constrained} minimization is used.} \item{meq}{an optional positive integer specifying that the first \code{meq} constraints are treated as \emph{equality} constraints, and all the remaining as \emph{inequality} constraints. Defaults to \code{0} (inequality constraints only).} \item{eps}{maximal admissible constraint violation for equality constraints. An optional real vector of small positive tolerance values with length \code{meq} used in the transformation of equalities into inequalities of the form \eqn{|h_j(X)| - \epsilon \le 0}. A scalar value is expanded to apply to all equality constraints. Default is \code{1e-5}.} \item{NP}{an optional positive integer giving the number of candidate solutions in the randomly distributed initial population. Defaults to \code{10*length(lower)}.} \item{Fl}{an optional scalar which represents the minimum value that the \emph{scaling factor} \code{F} could take. Default is \code{0.1}, which is almost always satisfactory.} \item{Fu}{an optional scalar which represents the maximum value that the \emph{scaling factor} \code{F} could take. Default is \code{1}, which is almost always satisfactory.} \item{tau_F}{an optional scalar which represents the probability that the \emph{scaling factor} \code{F} is updated. Defaults to \code{0.1}, which is almost always satisfactory.} \item{tau_CR}{an optional constant value which represents the probability that the \emph{crossover probability} \code{CR} is updated. Defaults to \code{0.1}, which is almost always satisfactory.} \item{tau_pF}{an optional scalar which represents the probability that the \emph{mutation probability} \eqn{p_F}{pF} in the mutation strategy DE/rand/1/either-or is updated. Defaults to \code{0.1}.} \item{jitter_factor}{an optional tuning constant for \emph{jitter}. If \code{NULL} only \emph{dither} is used. Defaults to \code{0.001}.} \item{tol}{an optional positive scalar giving the tolerance for the stopping criterion. Default is \code{1e-15}.} \item{maxiter}{an optional positive integer specifying the maximum number of iterations that may be performed before the algorithm is halted. Defaults to \code{2000*length(lower)}.} \item{fnscale}{an optional positive scalar specifying the typical magnitude of \code{fn}. It is used only in the \emph{stopping criterion}. Defaults to \code{1}. See \sQuote{Details}.} \item{compare_to}{an optional character string controlling which function should be applied to the \code{fn} values of the candidate solutions in a generation to be compared with the so-far best one when evaluating the \emph{stopping criterion}. If \dQuote{\code{median}} the \code{median} function is used; else, if \dQuote{\code{max}} the \code{max} function is used. It defaults to \dQuote{\code{median}}. See \sQuote{Details}.} \item{add_to_init_pop}{an optional real vector of length \code{length(lower)} or \code{\link{matrix}} with \code{length(lower)} rows specifying initial values of the parameters to be optimized which are appended to the randomly generated initial population. It defaults to \code{NULL}.} \item{trace}{an optional logical value indicating if a trace of the iteration progress should be printed. Default is \code{FALSE}.} \item{triter}{an optional positive integer giving the frequency of tracing (every \code{triter} iterations) when \code{trace = TRUE}. Default is \code{triter = 1}, in which case \code{iteration : < value of stopping test > ( value of best solution ) best solution { index of violated constraints }} is printed at each iteration.} \item{details}{an optional logical value. If \code{TRUE} the output will contain the parameters in the final population and their respective \code{fn} values. Defaults to \code{FALSE}.} \item{\dots}{optional additional arguments passed to \code{fn} and \code{constr}.} } \details{ \describe{ \item{Overview:}{ The setting of the \emph{control parameters} of canonical Differential Evolution (DE) is crucial for the algorithm's performance. Unfortunately, when the generally recommended values for these parameters (see, \emph{e.g.}, Storn and Price, 1997) are unsuitable for use, their determination is often difficult and time consuming. The jDE algorithm proposed in Brest \emph{et al.} (2006) employs a simple self-adaptive scheme to perform the automatic setting of control parameters scale factor \code{F} and crossover rate \code{CR}. This implementation differs from the original description, most notably in the use of the \emph{DE/rand/1/either-or} mutation strategy (Price \emph{et al.}, 2005), combination of \emph{jitter with dither} (Storn, 2008), and the random initialization of \code{F} and \code{CR}. The mutation operator brings an additional control parameter, the mutation probability \eqn{p_F}{pF}, which is self-adapted in the same manner as \code{CR}. As done by jDE and its variants (Brest \emph{et al.}, 2021) each worse parent in the current population is \emph{immediately replaced} (asynchronous update) by its newly generated better or equal offspring (Babu and Angira, 2006) instead of updating the current population with all the new solutions at the same time as in classical DE (synchronous update). As the algorithm subsamples via \code{\link{sample}()} which from \R version 3.6.0 depends on \code{\link{RNGkind}(*, sample.kind)}, exact reproducibility of results from \R versions 3.5.3 and earlier requires setting \code{\link{RNGversion}("3.5.0")}. In any case, do use \code{\link{set.seed}()} additionally for reproducibility! } \item{Constraint Handling:}{ Constraint handling is done using the approach described in Zhang and Rangaiah (2012), but with a \emph{different reduction updating scheme} for the constraint relaxation value (\eqn{\mu}). Instead of doing it once for every generation or iteration, the reduction is triggered for two cases when the \emph{constraints only contain inequalities}. Firstly, every time a feasible solution is selected for replacement in the next generation by a new feasible trial candidate solution with a better objective function value. Secondly, whenever a current infeasible solution gets replaced by a feasible one. If the constraints \emph{include equalities}, then the reduction is not triggered in this last case. This constitutes an original feature of the implementation. The performance of any constraint handling technique for metaheuristics is severely impaired by a small feasible region. Therefore, equality constraints are particularly difficult to handle due to the tiny feasible region they define. So, instead of explicitly including all equality constraints in the formulation of the optimization problem, it might prove advantageous to eliminate some of them. This is done by expressing one variable \eqn{x_k} in terms of the remaining others for an equality constraint \eqn{h_j(X) = 0} where \eqn{X = [x_1,\ldots,x_k,\ldots,x_d]} is the vector of solutions, thereby obtaining a relationship as \eqn{x_k = R_{k,j}([x_1,\ldots,x_{k-1},x_{k+1},\ldots,x_d])}. In this way both the variable \eqn{x_k} and the equality constraint \eqn{h_j(X) = 0} can be removed altogether from the original optimization formulation, since the value of \eqn{x_k} can be calculated during the search process by the relationship \eqn{R_{k,j}}. Notice, however, that two additional inequalities \deqn{l_k \le R_{k,j}([x_1,\ldots,x_{k-1},x_{k+1},\ldots,x_d]) \le u_k,} where the values \eqn{l_k} and \eqn{u_k} are the lower and upper bounds of \eqn{x_k}, respectively, must be provided in order to obtain an equivalent formulation of the problem. For guidance and examples on applying this approach see Wu \emph{et al.} (2015). Bound constraints are enforced by the \emph{midpoint base} approach (see, \emph{e.g.}, Biedrzycki \emph{et al.}, 2019). } \item{Discrete and Integer Variables:}{ Any DE variant is easily extended to deal with \emph{mixed integer nonlinear programming} problems using a small variation of the technique presented by Lampinen and Zelinka (1999). Integer values are obtained by means of the \code{floor()} function \emph{only} in the evaluation of the objective function and constraints, whereas DE itself still uses continuous variables. Additionally, each upper bound of the integer variables should be added by \code{1}. Notice that the final solution needs to be converted with \code{floor()} to obtain its \emph{integer} elements. } \item{Stopping Criterion:}{ The algorithm is stopped if \deqn{\frac{\mathrm{compare\_to}\{[\mathrm{fn}(X_1),\ldots,\mathrm{fn}(X_\mathrm{npop})]\} - \mathrm{fn}(X_\mathrm{best})}{\mathrm{fnscale}} \le \mathrm{tol},}{% ( compare_to{ [fn(X_1),\ldots,fn(X_npop)] } - fn(X_best) )/fnscale <= tol,} where the \dQuote{best} individual \eqn{X_\mathrm{best}}{X_best} is the \emph{feasible} solution with the lowest objective function value in the population and the total number of elements in the population, \code{npop}, is \code{NP+NCOL(add_to_init_pop)}. For \code{compare_to = "max"} this is the \emph{Diff} criterion studied by Zielinski and Laur (2008) among several other alternatives, which was found to yield the best results. } } } \value{ A list with the following components: \item{par}{The best set of parameters found.} \item{value}{The value of \code{fn} corresponding to \code{par}.} \item{iter}{Number of iterations taken by the algorithm.} \item{convergence}{An integer code. \code{0} indicates successful completion. \code{1} indicates that the iteration limit \code{maxiter} has been reached.} and if \code{details = TRUE}: \item{poppar}{Matrix of dimension \code{(length(lower), npop)}, with columns corresponding to the parameter vectors remaining in the population.} \item{popcost}{The values of \code{fn} associated with \code{poppar}, vector of length \code{npop}.} } \note{ It is possible to perform a warm start, \emph{i.e.}, starting from the previous run and resume optimization, using \code{NP = 0} and the component \code{poppar} for the \code{add_to_init_pop} argument. } \author{ Eduardo L. T. Conceicao \email{mail@eduardoconceicao.org} } \references{ Babu, B. V. and Angira, R. (2006) Modified differential evolution (MDE) for optimization of non-linear chemical processes. \emph{Computers and Chemical Engineering} \bold{30}, 989--1002. \doi{10.1016/j.compchemeng.2005.12.020}. Biedrzycki, R., Arabas, J. and Jagodzinski, D. (2019) Bound constraints handling in differential evolution: An experimental study. \emph{Swarm and Evolutionary Computation} \bold{50}, 100453. \doi{10.1016/j.swevo.2018.10.004}. Brest, J., Greiner, S., Boskovic, B., Mernik, M. and Zumer, V. (2006) Self-adapting control parameters in differential evolution: A comparative study on numerical benchmark problems. \emph{IEEE Transactions on Evolutionary Computation} \bold{10}, 646--657. \doi{10.1109/TEVC.2006.872133}. Brest, J., Maucec, M. S. and Boskovic, B. (2021) Self-adaptive differential evolution algorithm with population size reduction for single objective bound-constrained optimization: Algorithm j21; in \emph{2021 IEEE Congress on Evolutionary Computation (CEC)}. IEEE, pp. 817--824. \doi{10.1109/CEC45853.2021.9504782}. Lampinen, J. and Zelinka, I. (1999). Mechanical engineering design optimization by differential evolution; in Corne, D., Dorigo, M. and Glover, F., Eds., \emph{New Ideas in Optimization}. McGraw-Hill, pp. 127--146. Price, K. V., Storn, R. M. and Lampinen, J. A. (2005) \emph{Differential evolution: A practical approach to global optimization}. Springer, Berlin, Heidelberg, pp. 117--118. \doi{10.1007/3-540-31306-0_2}. Storn, R. (2008) Differential evolution research --- Trends and open questions; in Chakraborty, U. K., Ed., \emph{Advances in differential evolution}. SCI 143, Springer, Berlin, Heidelberg, pp. 11--12. \doi{10.1007/978-3-540-68830-3_1}. Storn, R. and Price, K. (1997) Differential evolution - A simple and efficient heuristic for global optimization over continuous spaces. \emph{Journal of Global Optimization} \bold{11}, 341--359. \doi{10.1023/A:1008202821328}. Wu, G., Pedrycz, W., Suganthan, P. N. and Mallipeddi, R. (2015) A variable reduction strategy for evolutionary algorithms handling equality constraints. \emph{Applied Soft Computing} \bold{37}, 774--786. \doi{10.1016/j.asoc.2015.09.007}. Zhang, H. and Rangaiah, G. P. (2012) An efficient constraint handling method with integrated differential evolution for numerical and engineering optimization. \emph{Computers and Chemical Engineering} \bold{37}, 74--88. \doi{10.1016/j.compchemeng.2011.09.018}. Zielinski, K. and Laur, R. (2008) Stopping criteria for differential evolution in constrained single-objective optimization; in Chakraborty, U. K., Ed., \emph{Advances in differential evolution}. SCI 143, Springer, Berlin, Heidelberg, pp. 111--138. \doi{10.1007/978-3-540-68830-3_4}. } \seealso{ Function \code{\link[DEoptim]{DEoptim}()} in the \CRANpkg{DEoptim} package has many more options than \code{JDEoptim()}, but does not allow constraints in the same flexible manner. } \examples{ \donttest{ # NOTE: Examples were excluded from testing # to reduce package check time. # Use a preset seed so test values are reproducible. set.seed(1234) # Bound-constrained optimization # Griewank function # # -600 <= xi <= 600, i = {1, 2, ..., n} # The function has a global minimum located at # x* = (0, 0, ..., 0) with f(x*) = 0. Number of local minima # for arbitrary n is unknown, but in the two dimensional case # there are some 500 local minima. # # Source: # Ali, M. Montaz, Khompatraporn, Charoenchai, and # Zabinsky, Zelda B. (2005). # A numerical evaluation of several stochastic algorithms # on selected continuous global optimization test problems. # Journal of Global Optimization 31, 635-672. # https://doi.org/10.1007/s10898-004-9972-2 griewank <- function(x) { 1 + crossprod(x)/4000 - prod( cos(x/sqrt(seq_along(x))) ) } JDEoptim(rep(-600, 10), rep(600, 10), griewank, tol = 1e-7, trace = TRUE, triter = 50) # Nonlinear constrained optimization # 0 <= x1 <= 34, 0 <= x2 <= 17, 100 <= x3 <= 300 # The global optimum is # (x1, x2, x3; f) = (0, 16.666667, 100; 189.311627). # # Source: # Westerberg, Arthur W., and Shah, Jigar V. (1978). # Assuring a global optimum by the use of an upper bound # on the lower (dual) bound. # Computers and Chemical Engineering 2, 83-92. # https://doi.org/10.1016/0098-1354(78)80012-X fcn <- list(obj = function(x) { 35*x[1]^0.6 + 35*x[2]^0.6 }, eq = 2, con = function(x) { x1 <- x[1]; x3 <- x[3] c(600*x1 - 50*x3 - x1*x3 + 5000, 600*x[2] + 50*x3 - 15000) }) JDEoptim(c(0, 0, 100), c(34, 17, 300), fn = fcn$obj, constr = fcn$con, meq = fcn$eq, tol = 1e-7, trace = TRUE, triter = 50) # Designing a pressure vessel # Case A: all variables are treated as continuous # # 1.1 <= x1 <= 12.5*, 0.6 <= x2 <= 12.5*, # 0.0 <= x3 <= 240.0*, 0.0 <= x4 <= 240.0 # Roughly guessed* # The global optimum is (x1, x2, x3, x4; f) = # (1.100000, 0.600000, 56.99482, 51.00125; 7019.031). # # Source: # Lampinen, Jouni, and Zelinka, Ivan (1999). # Mechanical engineering design optimization # by differential evolution. # In: David Corne, Marco Dorigo and Fred Glover (Editors), # New Ideas in Optimization, McGraw-Hill, pp 127-146 pressure_vessel_A <- list(obj = function(x) { x1 <- x[1]; x2 <- x[2]; x3 <- x[3]; x4 <- x[4] 0.6224*x1*x3*x4 + 1.7781*x2*x3^2 + 3.1611*x1^2*x4 + 19.84*x1^2*x3 }, con = function(x) { x1 <- x[1]; x2 <- x[2]; x3 <- x[3]; x4 <- x[4] c(0.0193*x3 - x1, 0.00954*x3 - x2, 750.0*1728.0 - pi*x3^2*x4 - 4/3*pi*x3^3) }) JDEoptim(c( 1.1, 0.6, 0.0, 0.0), c(12.5, 12.5, 240.0, 240.0), fn = pressure_vessel_A$obj, constr = pressure_vessel_A$con, tol = 1e-7, trace = TRUE, triter = 50) # Mixed integer nonlinear programming # Designing a pressure vessel # Case B: solved according to the original problem statements # steel plate available in thicknesses multiple # of 0.0625 inch # # wall thickness of the # shell 1.1 [18*0.0625] <= x1 <= 12.5 [200*0.0625] # heads 0.6 [10*0.0625] <= x2 <= 12.5 [200*0.0625] # 0.0 <= x3 <= 240.0, 0.0 <= x4 <= 240.0 # The global optimum is (x1, x2, x3, x4; f) = # (1.125 [18*0.0625], 0.625 [10*0.0625], # 58.29016, 43.69266; 7197.729). pressure_vessel_B <- list(obj = function(x) { x1 <- floor(x[1])*0.0625 x2 <- floor(x[2])*0.0625 x3 <- x[3]; x4 <- x[4] 0.6224*x1*x3*x4 + 1.7781*x2*x3^2 + 3.1611*x1^2*x4 + 19.84*x1^2*x3 }, con = function(x) { x1 <- floor(x[1])*0.0625 x2 <- floor(x[2])*0.0625 x3 <- x[3]; x4 <- x[4] c(0.0193*x3 - x1, 0.00954*x3 - x2, 750.0*1728.0 - pi*x3^2*x4 - 4/3*pi*x3^3) }) res <- JDEoptim(c( 18, 10, 0.0, 0.0), c(200+1, 200+1, 240.0, 240.0), fn = pressure_vessel_B$obj, constr = pressure_vessel_B$con, tol = 1e-7, trace = TRUE, triter = 50) res # Now convert to integer x1 and x2 c(floor(res$par[1:2]), res$par[3:4]) } } \keyword{nonlinear} \keyword{optimize} \concept{global optimization} DEoptimR/DESCRIPTION0000644000176200001440000000316315041474612013452 0ustar liggesusersPackage: DEoptimR Version: 1.1-4 Date: 2025-07-27 Title: Differential Evolution Optimization in Pure R Authors@R: c( person(c("Eduardo", "L. T."), "Conceicao", role = c("aut", "cre"), email = "mail@eduardoconceicao.org"), person("Martin", "Maechler", role = "ctb", email = "maechler@stat.math.ethz.ch", comment = c(ORCID = "0000-0002-8685-9910")) ) URL: svn://svn.r-forge.r-project.org/svnroot/robustbase/pkg/DEoptimR Description: Differential Evolution (DE) stochastic heuristic algorithms for global optimization of problems with and without general constraints. The aim is to curate a collection of its variants that (1) do not sacrifice simplicity of design, (2) are essentially tuning-free, and (3) can be efficiently implemented directly in the R language. Currently, it provides implementations of the algorithms 'jDE' by Brest et al. (2006) for single-objective optimization and 'NCDE' by Qu et al. (2012) for multimodal optimization (single-objective problems with multiple solutions). Imports: stats Enhances: robustbase License: GPL (>= 2) Author: Eduardo L. T. Conceicao [aut, cre], Martin Maechler [ctb] (ORCID: ) Maintainer: Eduardo L. T. Conceicao Repository: CRAN Repository/R-Forge/Project: robustbase Repository/R-Forge/Revision: 1009 Repository/R-Forge/DateTimeStamp: 2025-07-27 18:16:52 Date/Publication: 2025-07-27 19:10:02 UTC NeedsCompilation: no Packaged: 2025-07-27 18:25:06 UTC; rforge