~enricoschumann/neighbours

66ea76f00f8a47f461d84e6c82f93dc08f295f70 — Enrico Schumann 4 years ago 4a99694 topic/random_vector
Add vignette; update docs
A .Rbuildignore => .Rbuildignore +1 -0
@@ 0,0 1,1 @@
vignettes/auto

M ChangeLog => ChangeLog +10 -6
@@ 1,11 1,15 @@
2020-03-28  Enrico Schumann  <es@enricoschumann.net>

        * vignettes/neighbours.Rnw: add vignette

2019-12-12  Enrico Schumann  <es@enricoschumann.net>

	* R/neighbourfun.R (neighbourfun,random_vector):
	rename argument 'n' => 'length'
	(random_vector): argument 'n' now stands for the
	number of random vectors to draw; the vectors will
	be the columns of a matrix of dimension 'length'
	times 'n'
        * R/neighbourfun.R (neighbourfun,random_vector):
        rename argument 'n' => 'length'
        (random_vector): argument 'n' now stands for the
        number of random vectors to draw; the vectors will
        be the columns of a matrix of dimension 'length'
        times 'n'

2019-11-14  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: 2019-12-16
Date: 2020-03-28
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
  helper functions for creating random initial solutions and
  for comparing solutions.
License: GPL-3
URL: http://enricoschumann.net/neighbours/,
URL: http://enricoschumann.net/R/neighbours/,
     https://github.com/enricoschumann/neighbours
Suggests: NMOF, tinytest

M R/neighbourfun.R => R/neighbourfun.R +46 -26
@@ 125,40 125,56 @@ neighbourfun <- function(min = 0,
    if (type == "logical") {

        if (missing(stepsize))
            stepsize <- 1
            stepsize <- 1L

        .body <- quote({
            i <- sample.int(length, stepsize)
            x[i] <- !x[i]
            x
        })
        if (is.null(kmin) && is.null(kmax)) {

            ## no constraints on number of TRUE values
            if (!is.null(length)) {
            if (is.null(length)) {
                .body[[2]] <- .sub(.body[[2]],
                                   list(length = quote(length(x)),
                                        stepsize = stepsize))
            } else if (!isTRUE(active)) {
                .body[[2]] <- .sub(.body[[2]],
                                   list(length = sum(active)))
                .body <- .sub(.body,
                              list(x = quote(x[active])))
            }
            ans <- function(x, ...) {}
            body(ans) <- .body
            return(ans)

                function(x, ...) {
                    i <- sample.int(length, stepsize)
                    x[i] <- !x[i]
                    x
                }

            } else {
        } else if (!is.null(kmin) && !is.null(kmax) && kmin == kmax) {

            ## logical with constant number of TRUE values

            if (!is.null(active)) {

                function(x, ...) {
                    i <- sample.int(length(x), stepsize)
                    x[i] <- !x[i]
                    xx <- x[active]
                    true  <- which( xx)
                    false <- which(!xx)
                    xx[true [sample.int(length( true), size = stepsize)]] <- FALSE
                    xx[false[sample.int(length(false), size = stepsize)]] <- TRUE
                    x[active] <- xx
                    x
                }

            }


        } else if (!is.null(kmin) && !is.null(kmax) && kmin == kmax) {

            ## logical with constant number of TRUE values

            function(x, ...) {
                true  <- which( x)
                false <- which(!x)
                x[true [sample.int(length( true), size = stepsize)]] <- FALSE
                x[false[sample.int(length(false), size = stepsize)]] <- TRUE
                x
            } else {
                function(x, ...) {
                    true  <- which( x)
                    false <- which(!x)
                    x[true [sample.int(length( true), size = stepsize)]] <- FALSE
                    x[false[sample.int(length(false), size = stepsize)]] <- TRUE
                    x
                }
            }

        } else if (!is.null(kmin) && !is.null(kmax) && kmin < kmax) {


@@ 242,7 258,7 @@ random_vector <- function(length,
                          max = 1,
                          kmin = NULL,
                          kmax = NULL,
                          sum = TRUE,
                          sum = NULL,
                          type = "numeric",
                          n = 1,
                          ...) {


@@ 276,14 292,18 @@ random_vector <- function(length,
        stopifnot(min <= max)

        if (is.null(kmin) && is.null(kmax)) {
            ans <- runif(length*n, min=min, max=max)
            dim(ans) <- c(length, n)
            if (n == 1) {
                ans <- runif(length, min = min, max = max)
            } else {
                ans <- runif(length*n, min = min, max = max)
                dim(ans) <- c(length, n)
            }
        } else {
            if (is.null(kmin))
                kmin <- 0
            if (is.null(kmax))
                kmax <- length
            ans <- runif(length*n, min=min, max=max)
            ans <- runif(length*n, min = min, max = max)
            dim(ans) <- c(length, n)
            for (j in seq_len(n)) {
                if (kmin == kmax)

M man/neighbourfun.Rd => man/neighbourfun.Rd +8 -9
@@ 22,14 22,12 @@ neighborfun (min = 0, max = 1, kmin = NULL, kmax = NULL,
             A = NULL, ...)
}
\arguments{
  \item{min}{
    a numeric vector
  \item{min}{a numeric vector
  }
  \item{max}{
    a numeric vector
  \item{max}{a numeric vector
  }
  \item{kmin}{
    a numeric vector
  \item{kmin}{%
    integer
  }
  \item{kmax}{
    a numeric vector


@@ 59,7 57,6 @@ neighborfun (min = 0, max = 1, kmin = NULL, kmax = NULL,
    which case the matrix \code{A} be specified. See
    examples.


  }
  \item{A}{
    a numeric matrix


@@ 100,8 97,10 @@ neighborfun (min = 0, max = 1, kmin = NULL, kmax = NULL,
\author{
  Maintainer: Enrico Schumann <es@enricoschumann.net>
}
\seealso{
  \code{\link[NMOF]{TAopt}}
\seealso{%
  implementations of algorithms of the local-search family, such as
  Simulated Annealing (\code{\link[NMOF]{SAopt}} in \pkg{NMOF}) or
  Threshold Accepting (\code{\link[NMOF]{TAopt}} in \pkg{NMOF})
}
\examples{
## a LOGICAL neighbourhood

M man/random_vector.Rd => man/random_vector.Rd +37 -17
@@ 8,32 8,32 @@
}
\usage{
random_vector(length, min = 0, max = 1, kmin = NULL, kmax = NULL,
              sum = TRUE, type = "numeric", n = 1L, ...)
              sum = NULL, type = "numeric", n = 1L, ...)
}
\arguments{
  \item{length}{
    numeric
  \item{length}{%
    integer
  }
  \item{min}{
    numeric
  \item{min}{%
    numeric: either a single number of a vector of length \code{length}
  }
  \item{max}{
    numeric
  \item{max}{%
    numeric: either a single number of a vector of length \code{length}
  }
  \item{kmin}{
  \item{kmin}{%
    numeric
  }
  \item{kmax}{
  \item{kmax}{%
    numeric
  }
  \item{sum}{
    numeric
  \item{sum}{%
    numeric. \bold{Not yet supported.}
  }
  \item{type}{
    a string: \code{"numeric"} or \code{"logical"}
  }
  \item{n}{
    numeric
    integer: how many vectors to create
}
  \item{\dots}{
    other arguments


@@ 41,7 41,8 @@ random_vector(length, min = 0, max = 1, kmin = NULL, kmax = NULL,
}
\details{

  Highly experimental.
  The function creates random vectors, typically as initial solutions
  for optimization and search algorithms

}
\value{


@@ 50,9 51,13 @@ random_vector(length, min = 0, max = 1, kmin = NULL, kmax = NULL,
  \code{\link{dim}} attribute (i.e. a matrix)

}
%% \references{
%%   %% ~put references to the literature/web site here ~
%% }
\references{

  Gilli, M. and Schumann, E. (2010) A note on 'good starting values'
  in numerical optimisation, \acronym{COMISEF} Working Paper Series No. 044.
  \url{https://papers.ssrn.com/sol3/papers.cfm?abstract_id=1620083}

}
\author{
  Enrico Schumann
}


@@ 60,5 65,20 @@ random_vector(length, min = 0, max = 1, kmin = NULL, kmax = NULL,
  \code{\link{compare_vectors}}
}
\examples{
1+1
random_vector(type = "logical", length = 5)
## [1] FALSE  TRUE  TRUE  TRUE  TRUE

random_vector(type = "logical", length = 5, n = 3, kmin = 4)
##       [,1] [,2]  [,3]
## [1,]  TRUE TRUE  TRUE
## [2,]  TRUE TRUE  TRUE
## [3,]  TRUE TRUE FALSE
## [4,] FALSE TRUE  TRUE
## [5,]  TRUE TRUE  TRUE

x <- random_vector(type = "numeric", length = 3, sum = 2, n = 4)
##           [,1]      [,2]      [,3]      [,4]
## [1,] 0.2063878 0.6055332 0.1314114 0.2272488
## [2,] 0.1741989 0.8975089 0.1630611 0.5474513
## [3,] 0.9440980 0.8658824 0.7872635 0.9836578
}

A vignettes/.install_extras => vignettes/.install_extras +1 -0
@@ 0,0 1,1 @@
neighbours[.]bib

A vignettes/neighbours.Rnw => vignettes/neighbours.Rnw +112 -0
@@ 0,0 1,112 @@
%% \VignetteIndexEntry{Neighbourhood functions}
\documentclass[a4paper,11pt]{article}
\usepackage[left = 3cm, top = 2cm, bottom = 2cm, right = 4cm]{geometry}
\usepackage[noae,nogin]{Sweave}
\usepackage{libertine}
\usepackage[scaled=0.9]{inconsolata}
\usepackage[T1]{fontenc}
\renewcommand*\familydefault{\sfdefault} 
\usepackage{amsmath,amstext}
\usepackage{hyperref}
\usepackage{natbib}
\usepackage{xcolor}
\usepackage{framed}
\usepackage[hang]{footmisc}
\definecolor{grau2}{rgb}{.2,.2,.2}
\definecolor{grau7}{rgb}{.7,.7,.7}
\DefineVerbatimEnvironment{Sinput}{Verbatim}{}
\DefineVerbatimEnvironment{Soutput}{Verbatim}{frame=single,
  xleftmargin=0em, formatcom=\color{grau2},rulecolor=\color{grau7}}
\DefineVerbatimEnvironment{Scode}{Verbatim}{xleftmargin=2em}
\fvset{listparameters={\setlength{\topsep}{0pt}}}
\renewenvironment{Schunk}{\vspace{\topsep}}{\vspace{\topsep}}
\SweaveOpts{keep.source = TRUE, eps = TRUE}

<<echo=false>>=
options(continue = "  ", digits = 3, width = 60, useFancyQuotes = FALSE)
pv <- packageVersion("neighbours")
pv <- gsub("(.*)[.](.*)", "\\1-\\2", pv)
@

\begin{document}
\title{}
\author{Enrico Schumann\\\url{es@enricoschumann.net}}

{\raggedright{\LARGE Neighbourhood Functions for Local-Search Algorithms\par}}\hspace*{\fill}
{\footnotesize Package version \Sexpr{pv}}\medskip

\noindent Enrico Schumann\\
\noindent \url{es@enricoschumann.net}\\
\bigskip


\section*{Selecting elements of a list}

<<>>=
library("neighbours")
LSopt. <- function(OF, algo = list(), ...) {
    xc  <- algo$x0
    xcF <- OF(xc, ...)
    for (s in seq_len(algo$nS)) {
        xn <- algo$neighbour(xc, ...)
        xnF <- OF(xn, ...)
        if (xnF <= xcF) {
            xc  <- xn
            xcF <- xnF
        }
    }
    list(xbest = xc, OFvalue = xcF)
}
@ 

<<>>=

## a LOGICAL neighbourhood
x <- logical(8)
x[1:3] <- TRUE
     
N <- neighbourfun(type = "logical", kmin = 3, kmax = 3)
     
cat(ifelse(x, "o", "."), "  | initial solution ", sep = "", fill = TRUE)
for (i in 1:10) {
    x <- N(x)
    cat(ifelse(x, "o", "."), sep = "", fill = TRUE)
}
@ 

We can add a constraint about elements not to
touch. Suppose the initial solution is the following:
<<>>=
x <- logical(9)
x[4:6] <- TRUE
cat(ifelse(x, "o", "."), sep = "")
@

Now we restrict the changes that can be made to the
solution: only elements 3, 4, 6 and 7 may vary.  (They
are \texttt{active}.)
<<restrict>>=
active <- !logical(length(x))
active[c(1:2, 5, 8:9)] <- FALSE
active
@

Let us try a few iterations.
<<>>=
N <- neighbourfun(type = "logical", kmin = 3, kmax = 3,
                  active = active)

for (i in 1:20) {
    if (i == 1L)
        cat(ifelse(x, "o", "."), "  | initial solution ", sep = "", fill = TRUE)
    x <- N(x)
    cat(ifelse(x, "o", "."), sep = "", fill = TRUE)
}
@ 


\citet{Gilli2019}
\bibliographystyle{plainnat}
\bibliography{neighbours}

\end{document}

A vignettes/neighbours.bib => vignettes/neighbours.bib +24 -0
@@ 0,0 1,24 @@
@BOOK{Gilli2019,
  title        = {Numerical Methods and Optimization in Finance},
  publisher    = {Elsevier/Academic Press},
  year         = 2019,
  author       = {Gilli, Manfred and Maringer, Dietmar and Schumann, Enrico},
  edition      = {2nd},
  url          = {http://enricoschumann.net/NMOF}
}

@ARTICLE{Gilli2010i,
  author       = {Manfred Gilli and Enrico Schumann},
  title        = {{A Note on `Good Starting Values' in Numerical Optimisation}},
  journal      = {COMISEF Working Paper Series No. 44},
  year         = 2010,
  note         = {available from \url{http://comisef.eu/?q=working_papers}}
}

@BOOK{Winker2001,
  title        = {Optimization Heuristics in Econometrics:
                  Applications of {T}hreshold {A}ccepting},
  publisher    = {Wiley},
  year         = 2001,
  author       = {Peter Winker}
}