M ChangeLog => ChangeLog +6 -1
@@ 1,6 1,11 @@
+2022-07-29 Enrico Schumann <es@enricoschumann.net>
+
+ * R/neighbourfun.R (neighbourfun): rewrite code
+ for numeric neighbourhood functions
+
2021-09-01 Enrico Schumann <es@enricoschumann.net>
- * R/neighbourfun.R (ans): add type "permute"
+ * R/neighbourfun.R (ans): add type "permute"
2020-06-05 Enrico Schumann <es@enricoschumann.net>
M DESCRIPTION => DESCRIPTION +2 -2
@@ 2,7 2,7 @@ Package: neighbours
Type: Package
Title: Neighbourhood Functions for Local-Search Algorithms
Version: 0.1-0
-Date: 2022-07-04
+Date: 2022-07-29
Maintainer: Enrico Schumann <es@enricoschumann.net>
Authors@R: person(given = "Enrico", family = "Schumann",
role = c("aut", "cre"),
@@ 23,6 23,6 @@ Description: Neighbourhood functions are key components of
Optimization in Finance" by M. Gilli, D. Maringer and
E. Schumann (2019, ISBN:978-0128150658).
License: GPL-3
-URL: http://enricoschumann.net/R/neighbours/,
+URL: http://enricoschumann.net/R/packages/neighbours/,
https://github.com/enricoschumann/neighbours
Suggests: NMOF, tinytest
M NEWS => NEWS +4 -4
@@ 1,11 1,11 @@
-v0.1-0 (2022-??-??)
+v0.1-0 (2022-08-01)
o Initial release. The package provides a function
neighbourfun() that constructs neighbourhood
functions for local-search algorithms. Supported
are numeric and logical solutions. The algorithms
were originally created for portfolio-optimisation
- applications, but can be used for other models as
- well. The package also provides a helper function
- for comparing solutions.
+ applications, but can be used for other models,
+ such as variable selection. The package also
+ provides a helper function for comparing solutions.
M R/neighbourfun.R => R/neighbourfun.R +88 -45
@@ 28,43 28,89 @@ neighbourfun <- function(min = 0,
if (type == "numeric") {
if (isTRUE(budget) || is.numeric(budget) && length(budget) == 1L) {
+
+ ## NOTE 'budget' is a scalar, default is 1. Two
+ ## elements are selected: one is increased,
+ ## the other is decreased.
+
.body <- quote({
- decrease <- which(x > wmin)
- increase <- which(x < wmax)
+
+ ## NOTE If wmin/wmax are -Inf/Inf, then all
+ ## elements could be selected.
+ decrease <- which((x > wmin)[active])
+ increase <- which((x < wmax)[active])
+
+ ## NOTE More than two elements could be selected.
+ ## It might also be necessary to check if
+ ## enough elements are available:
+ ## min(size, length(decrease), length(icnrease))
i <- decrease[sample.int(length(decrease), size = 1L)]
- j <- increase[sample.int(length(increase), size = 1L)]
+ j <- increase[sample.int(length(increase), size = 1L)]
stepsize <- .stepsize
stepsize <- min(x[i] - wmin[i], wmax[j] - x[j], stepsize)
x[i] <- x[i] - stepsize
x[j] <- x[j] + stepsize
x
})
- } else if (is.numeric(budget) && length(budget) == 2L) {
- .body <- quote({
- i <- sample.int(length(x), size = 1L)
- stepsize <- sample(c(-1, 1), size = 1) * .stepsize
- stepsize <-
- if (stepsize < 0)
- max(wmin - x[i], stepsize, budget[1L] - sum(x))
- else
- min(wmax - x[i], stepsize, budget[2L] - sum(x))
- x[i] <- x[i] + stepsize
- x
- })
- } else if (isFALSE(budget)) {
+ if (length(wmin) == 1) {
+
+ ## if 'wmin' is a scalar, there is no
+ ## need for subsetting
+
+ ## .body[[7]]
+ ## ==> stepsize <- min(x[i] - wmin[i], wmax[j] - x[j], stepsize)
+ ## .body[[7]][[3]]
+ ## ==> min(x[i] - wmin[i], wmax[j] - x[j], stepsize)
+ ## .body[[7]][[3]][[2]]
+ ## ==> x[i] - wmin[i]
+ ## .body[[7]][[3]][[2]][[3]]
+ ## ==> wmin[i]
+ .body[[7]][[3]][[2]][[3]] <- wmin
+ }
+
+ if (length(wmax) == 1) {
+
+ ## if 'wmax' is a scalar, there is no
+ ## need for subsetting
+
+ ## .body[[7]]
+ ## ==> stepsize <- min(x[i] - wmin[i], wmax[j] - x[j], stepsize)
+ ## .body[[7]][[3]]
+ ## ==> min(x[i] - wmin[i], wmax[j] - x[j], stepsize)
+ ## .body[[7]][[3]][[3]]
+ ## ==> wmax[j] - x[j]
+ ## .body[[7]][[3]][[3]][[2]]
+ ## ==> wmax[j]
+ .body[[7]][[3]][[3]][[2]] <- wmax
+ }
+
+ } else if (isFALSE(budget) || is.numeric(budget) && length(budget) == 2L) {
+
+ ## budget is of length 2 or not defined
+
.body <- quote({
- i <- sample.int(length(x), size = 1L)
stepsize <- sample(c(-1, 1), size = 1) * .stepsize
- stepsize <-
- if (stepsize < 0) {
- max(wmin - x[i], stepsize)
- } else {
- min(wmax - x[i], stepsize)
- }
+ if (stepsize < 0) {
+ decrease <- which((x > wmin)[active])
+ i <- decrease[sample.int(length(decrease), size = 1L)]
+ stepsize <- max(wmin - x[i], stepsize, budget[1L] - sum(x))
+ ## ^^^^^^^^^^^^^^^^^^^
+ } else {
+ increase <- which((x < wmax)[active])
+ i <- increase[sample.int(length(increase), size = 1L)]
+ stepsize <- min(wmax - x[i], stepsize, budget[2L] - sum(x))
+ ## ^^^^^^^^^^^^^^^^^^^
+ }
x[i] <- x[i] + stepsize
x
})
+ if (isFALSE(budget)) {
+ .body[[3]][[3]][[4]][[3]][[4]] <- NULL
+ .body[[3]][[4]][[4]][[3]][[4]] <- NULL
+ }
+ } else {
+ stop("budget must be logical or numeric")
}
@@ 78,30 124,30 @@ neighbourfun <- function(min = 0,
## [wmin/wmax]
- if (length(wmin) > 1L || length(wmax) > 1L) {
+ ## if (length(wmin) > 1L || length(wmax) > 1L) {
- ## wmin or wmax or both have length > 1
- if (length(wmin) == 1L)
- wmin <- rep(wmin, length(wmax))
- if (length(wmax) == 1L)
- wmax <- rep(wmax, length(wmin))
+ ## ## wmin or wmax or both have length > 1
+ ## if (length(wmin) == 1L)
+ ## wmin <- rep(wmin, length(wmax))
+ ## if (length(wmax) == 1L)
+ ## wmax <- rep(wmax, length(wmin))
- if (!isTRUE(active))
- .body <- .sub(.body, list(wmin = quote(wmin[active]),
- wmax = quote(wmax[active])))
+ ## if (!isTRUE(active))
+ ## .body <- .sub(.body, list(wmin = quote(wmin[active]),
+ ## wmax = quote(wmax[active])))
- } else if (!isFALSE(budget) && length(budget) == 1L) {
+ ## } else if (!isFALSE(budget) && length(budget) == 1L) {
- ## wmin and wmax have length 1: no subsetting
- .body[[7L]] <- quote(
- stepsize <- min(x[i] - wmin, wmax - x[j], stepsize))
- }
+ ## ## wmin and wmax have length 1: no subsetting
+ ## .body[[7L]] <- quote(
+ ## stepsize <- min(x[i] - wmin, wmax - x[j], stepsize))
+ ## }
- ## [active]
- if (!isTRUE(active)) {
- .body <- .sub(.body, list(x = quote(x[active])))
- .body[[length(.body)]] <- quote(x)
- }
+ ## ## [active]
+ ## if (!isTRUE(active)) {
+ ## .body <- .sub(.body, list(x = quote(x[active])))
+ ## .body[[length(.body)]] <- quote(x)
+ ## }
## [update]
@@ 114,9 160,6 @@ neighbourfun <- function(min = 0,
-
-
-
ans <- function(x, ...) {}
body(ans) <- .body
return(ans)
M inst/tinytest/test_neighbours.R => inst/tinytest/test_neighbours.R +2 -2
@@ 1,7 1,7 @@
## -*- truncate-lines: t; -*-
-library("tinytest")
-library("neighbours")
+## library("tinytest")
+## library("neighbours")
steps <- if (Sys.getenv("ES19_TESTING") == "TRUE")
50000 else 1000
M man/neighbourfun.Rd => man/neighbourfun.Rd +5 -7
@@ 38,7 38,7 @@ neighborfun (min = 0, max = 1, kmin = NULL, kmax = NULL,
logical or numeric. If specified and of length 1, only zero-sum
changes will be applied to a solution (i.e. the sum over all
elements in a solution remains unchanged).
-
+
}
\item{random}{
logical. Should the stepsize be random or fixed?
@@ 64,7 64,7 @@ neighborfun (min = 0, max = 1, kmin = NULL, kmax = NULL,
a numeric matrix
}
\item{type}{
- string: either \code{"numeric"} or \code{"logical"}
+ string: either \code{"numeric"}, \code{"logical"} or \code{"permute"}
}
\item{length}{
integer: the length of a vector
@@ 142,11 142,9 @@ all.equal(A \%*\% x, attr(x, "Ax"))
-\donttest{
-## a useful way to store/specify parameters
-settings <- list(...)
-do.call(neighbourfun, settings)
-}
+## ## a useful way to store/specify parameters
+## settings <- list(...)
+## do.call(neighbourfun, settings)
}
\keyword{ optimize }