R/00_api.R

In localsolver: R API to LocalSolver

#----------------------------------------------------------------------------
# localsolver
# Copyright (c) 2014, WLOG Solutions
#----------------------------------------------------------------------------

has.localsolver <- function(ls.path) {
  ls.exe.path <- ifelse(is.null(ls.path), 'localsolver', file.path(ls.path, 'localsolver'))
  
  res <- try(system2(ls.exe.path, stdout=TRUE), silent=TRUE)
  if (class(res) == "try-error") {
    return(FALSE)
  }
  return(regexec("^LocalSolver [[:digit:]]", res[[1]])[[1]] != -1)
}

#' 
#' Load LSP model example code.
#' 
#' @param example.file example file path relative to packaged root.
#' @return text of model formulated in LSP language.
#' 
#' @export
#' 
#' @examples
#' lsp.model.example('extdata/knapsack.txt')
#' 

lsp.model.example <- function(example.file) {
  file <- system.file(example.file, package="localsolver")
  if (file == "") {
    stop(sprintf("Exemplary model file %s not found in localsolver package", example.file))
  }
  model <- paste(readLines(file, warn=FALSE), collapse='\n')
  return(model)
}


#' Create problem instance from model formulated in LSP language.
#' 
#' Creates problem instance from model LSP code passed. Detects functions in model LSP code.
#' 
#' Functions detected in model LSP code must contain \code{model} function as it main 'workhorse' function of
#' LocalSolver model. They can contain \code{param}, \code{display} and any other custom functions. 
#' 
#' Because localsolver package defines \code{input} function based on data passed to \code{\link{ls.solve}} and 
#' \code{output} function base on output expressions added to problem instance with \code{\link{add.output.expr}} 
#' these two(\code{input} and \code{output}) functions cannot occur in model LSP code passed. Passing them will 
#' cause appropriate error.
#'
#' For mode details see LocalSolver LSP language reference manual: \url{http://www.localsolver.com/lspreferencemanual.html}.
#'
#' @param model.text.lsp text of model formulated in LSP language.
#' @param ls.path path to the LocalSolver executable. Optional argument (NULL by default). If not provided, the 
#'   LocalSolver will be searched by the system in \env{PATH} environment variable.
#' @return created ls.problem instance.
#' 
#' @export
#' 
#' @examples
#' model.text.lsp <- lsp.model.example('extdata/knapsack.txt')
#' lsp <- ls.problem(model.text.lsp)
#' 
ls.problem <- function(model.text.lsp, ls.path = NULL) {
  
  stopifnot(!missing(model.text.lsp))
  stopifnot(has.localsolver(ls.path))
  
  functions.detected <- detect.functions(model.text.lsp)
  if (is.null(functions.detected$model)) {
    stop("No model function detected!")
  }
  if (!is.null(functions.detected$input)) {
    stop("input function must be generated by the package from problem data!")
  }
  if (!is.null(functions.detected$output)) {
    stop("output function must be generated by the package from output expressions!")
  }  
  
  result <- list(
    model = model.text.lsp,
    functions = functions.detected,
    output.exprs = list(),

    temp.dir = tempdir(),    
    ls.exe.path = ifelse(is.null(ls.path), 'localsolver', file.path(ls.path, 'localsolver')),
    
    params = list(lsTimeLimit = NULL, 
                  lsIterationLimit = NULL, 
                  lsTimeBetweenDisplays = NULL, 
                  lsSeed = NULL, 
                  lsNbThreads = NULL, 
                  lsAnnealingLevel = NULL, 
                  lsVerbosity = NULL, 
                  indexFromZero = FALSE)
  )  
  
  class(result) <- 'ls.problem'
  result <- reset.lsp.params(lsp=result)
  return(result)
}

#'
#' Add expression to output of ls.problem.
#' 
#' Added expression will be printed out by the LocalSolver and added to \code{\link{ls.solve}} result.
#' 
#' Each added expression is extracted out of LocalSolver output according to \code{dimensions} provided.
#' Extracted values are converted into R data structures. If \code{dimension} is 1 the expression is considered
#' to be a number. Otherwise the expression is converted to R \code{array} with \code{dimensions} passed as 
#' dim(see \code{\link{array}}).
#' 
#' All output expression values are exposed as \code{\link{numeric}s}.
#' 
#' \strong{Currently errors in expression and inconsistency in dimensions passed are not detected properly. Handling
#' such situations is planned to be implemented in next localsolver package version.}
#' 
#' @param lsp problem instance created with \code{\link{ls.problem}}.
#' @param expr.text.lsp text of expression in LSP language (an objective function, constraint or decision variable name).
#' @param dimensions vector of variables expected dimensions. 1 for a number, length
#'    of a vector or dimensions of resulting matrix or array (see \code{\link{array}} \code{dim} parameter). The vector of the 
#'    dimensions must be of length 1, 2 or 3, as the library does not maintain arrays of more than 3 dimensions.
#' @return Updated \code{ls.problem} instance.
#' 
#' @export
#' 
#' @examples
#' model.text.lsp <- lsp.model.example('extdata/knapsack.txt')
#' lsp <- ls.problem(model.text.lsp)
#' lsp <- add.output.expr(lsp, "knapsackWeight")
#' # produces table x[i in 1..5][j in 1..10] in LocalSolver output
#' # and array with dims = c(5,10) under name x in output of ls.solve.
#' lsp <- add.output.expr(lsp, "x", c(5, 10))
#' 
add.output.expr <- function(lsp, expr.text.lsp, dimensions = 1) {
  stopifnot(class(lsp) == 'ls.problem')
  if(!is.element(el=length(dimensions), set=c(1,2,3))){
    stop(sprintf("Incorrect dimension of the expression %s!", expr.text.lsp))
  }
  # TODO: validation of parameters
  #  expression can cause error in output: handle it somehow

  exprName <- sprintf("__outexpr_%d", length(lsp$output.exprs))
  lsp$output.exprs[[exprName]] <- list(expr = expr.text.lsp, dimensions = dimensions)
  
  return(lsp)
}

#'
#' Remove all output expressions (see: \code{\link{add.output.expr}}).
#' 
#' @param lsp problem instance created with \code{\link{ls.problem}}.
#' @return updated ls.problem instance.
#' 
#' @export
#' 
#' @examples
#' model.text.lsp <- lsp.model.example('extdata/knapsack.txt')
#' lsp <- ls.problem(model.text.lsp)
#' lsp <- add.output.expr(lsp, "knapsackWeight")
#' lsp <- clear.output.exprs(lsp)
#' 
clear.output.exprs <- function(lsp) {
  lsp$output.exprs <- list()
  return(lsp)
}


#'
#' Set ls.problem instance parameters.
#' 
#' Updates the chosen parameters of an object of class \code{ls.problem}. 
#' 
#' @param lsp problem instance created with \code{\link{ls.problem}}.
#' @param lsTimeLimit the number of the seconds which will be spent to optimize the objective function (functions), or a vector of times (in seconds) assigned to each objective function. The length of the vector should correspond to the length of the number of objective functions.
#' @param lsIterationLimit the number of iterations made to optimize the objective function (functions), or a vector of iteration numbers assigned to each objective function. The length of the vector should correspond to the length of the number of objective functions.
#' @param lsTimeBetweenDisplays the time (in seconds) between successive displays of the information about the search (default: 1)
#' @param lsSeed pseudo-random number generator seed (default: 0).
#' @param lsNbThreads the number of threads over which the search is paralleled (default: 2).
#' @param lsAnnealingLevel simulated annealing level (no annealing: 0, default: 1).
#' @param lsVerbosity verbosity (no display: 0, default: 1).
#' @param indexFromZero indicates whether the data and decision variables (vectors and matrices) are to be indexed from 0. If 
#'  \code{FALSE} (by default), they will be indexed from 1.
#' @return updated ls.problem instance.
#'  
#' @export
#' 
#' @examples
#' model.text.lsp <- lsp.model.example('extdata/knapsack.txt')
#' lsp <- ls.problem(model.text.lsp)
#' lsp <- set.params(lsp, lsTimeLimit=10, lsIterationLimit= 5)
#' 
set.params <- function(lsp,
                       lsTimeLimit = lsp$params$lsTimeLimit, lsIterationLimit = lsp$params$lsIterationLimit, 
                       lsTimeBetweenDisplays = lsp$params$lsTimeBetweenDisplays, lsSeed = lsp$params$lsSeed, 
                       lsNbThreads = lsp$params$lsNbThreads, lsAnnealingLevel = lsp$params$lsAnnealingLevel, 
                       lsVerbosity = lsp$params$lsVerbosity, indexFromZero = lsp$params$indexFromZero) {
  if (!missing(lsTimeLimit)) {
    if(!is.element(el=class(lsTimeLimit), set=c("numeric", "integer", "NULL"))){
      stop("Incorrect format of the argument lsTimeLimit!")
    }
    lsp$params$lsTimeLimit <- lsTimeLimit    
  }

  if(is.null(lsp$params$lsTimeLimit) & is.null(lsp$params$lsIterationLimit)){
    stop("Either time or iteration limit must be provided!")
  }
  
  if (!missing(lsIterationLimit)) {
    if(!is.element(el=class(lsIterationLimit), set=c("numeric", "integer", "NULL"))){
      stop("Incorrect format of the argument lsIterationLimit!")
    }
    lsp$params$lsIterationLimit <- lsIterationLimit
  }
  
  if (!missing(lsSeed)) {
    if(!is.element(el=class(lsSeed), set=c("numeric", "integer", "NULL"))){
      stop("Incorrect format of the argument lsSeed!")
    }
    lsp$params$lsSeed <- lsSeed
  }

  if (!missing(lsTimeBetweenDisplays)) {
    if(!is.element(el=class(lsTimeBetweenDisplays), set=c("numeric", "integer", "NULL"))){
      stop("Incorrect format of the argument lsTimeBetweenDisplays!")
    }
    lsp$params$lsTimeBetweenDisplays <- lsTimeBetweenDisplays
  }
  
  
  if (!missing(lsNbThreads)) {
    if(!is.element(el=class(lsNbThreads), set=c("numeric", "integer", "NULL"))){
      stop("Incorrect format of the argument lsNbThreads!")
    }
    lsp$params$lsNbThreads <- lsNbThreads
  }

  if (!missing(lsAnnealingLevel)) {
    if(!is.element(el=class(lsAnnealingLevel), set=c("numeric", "integer", "NULL"))){
      stop("Incorrect format of the argument lsAnnealingLevel!")
    }
    lsp$params$lsAnnealingLevel <- lsAnnealingLevel
  }
  
  if (!missing(lsVerbosity)) {
    if(!is.element(el=class(lsVerbosity), set=c("numeric", "integer", "NULL"))){
      stop("Incorrect format of the argument lsVerbosity!")
    }
    lsp$params$lsVerbosity <- lsVerbosity
  }
  if(!is.element(el=indexFromZero, set=c(TRUE, FALSE))){
    stop("Incorrect format of the argument indexFromZero!")
  }  
  lsp$params$indexFromZero <- indexFromZero
  
  return(lsp)
}


#' 
#' Reset all ls.problem instance parameters.
#'
#' Problem parameters can be set with \code{\link{set.params}}. This method resets all their 
#' values to defaults, which have been described in help for the \code{\link{set.params}} function.
#' 
#'
#' @param lsp the lsp object whose parameters are to be reset.
#' @return lsp object with all parameters reset to their default values.
#' 
#' @export
#' 
#' @examples
#' 
#' modelText <- lsp.model.example('extdata/knapsack.txt')
#' lsp <- ls.problem(modelText)
#' lsp$params
#' lsp <- set.params(lsp, lsTimeLimit=60, lsSeed=7)
#' lsp$params
#' lsp <- reset.lsp.params(lsp)
#' lsp$params
#' 
reset.lsp.params <- function(lsp) {
  lsp$params = list(      
    lsTimeLimit = NULL, 
    lsIterationLimit = NULL, 
    lsTimeBetweenDisplays = NULL, 
    lsSeed = NULL, 
    lsNbThreads = NULL, 
    lsAnnealingLevel = NULL, 
    lsVerbosity = NULL, 
    indexFromZero = FALSE
  )
  return(lsp)
}

#'
#' Solves a LocalSolver problem on data passed.
#'  
#' Prepares input and data for LocalSolver, runs the application and parses its output to get
#' resulting values.
#' 
#' Result of this function is named list of output expressions added to the problem 
#' (for description of R data structures form see \code{\link{add.output.expr}}). Parameters set
#' with \code{\link{set.params}} are passed to LocalSolver by means of generation(or modification) of
#' LocalSolver \code{param} function (see LocalSolver LSP language reference manual 
#' \url{http://www.localsolver.com/lspreferencemanual.html} for more details). 
#' 
#' \strong{Make sure you pass integers in \code{data} if you want them to be \code{ints} in LocalSolver. Otherwise
#' they will be considered \code{doubles}.}
#' 
#' Errors occurred in model LSP code (passed while creating problem with \code{\link{ls.problem}}) are 
#' handled: They cause error containing original error message and error occurrence context to make it
#' easier to detect potential errors in model LSP code. All other LocalSolver errors (e.g. in output 
#' expressions) and interaction errors (between localsolver package and LocalSolver process) are passed
#' to caller without processing.
#' 
#' @param lsp problem instance created with \code{\link{ls.problem}}.
#' @param data named list of data items. Each element of the list should be indexed with the 
#'    parameter name and should be a number, vector, matrix or array (of dimension 2 or 3) of 
#'    numbers. The class of the numbers should be either integer (they will be then handled as 
#'    integer by the LocalSolver) or numeric (LocalSolver will then treat them as elements of
#'    class double).
#' @return named list of all output expression values on best solution found.
#'  
#' @export
#' 
#' @examples
#' model.text.lsp <- lsp.model.example('extdata/knapsack.txt')
#' lsp <- ls.problem(model.text.lsp)
#' lsp <- set.params(lsp, lsTimeLimit=60)
#' lsp <- add.output.expr(lsp, "x", 4)
#' data <- list(nbItems=4L, itemWeights=c(1L,2L,3L,4L), itemValues=c(5,6,7,8), knapsackBound=40L)
#' result <- ls.solve(lsp, data)
#' 
ls.solve <- function(lsp, data) {
  stopifnot(class(lsp) == 'ls.problem')
  
  # TODO: validate arguments

  # LSP file and data file preparation
  inp.file.path <- file.path(lsp$temp.dir, "input.lsp")
  inp.file <- file(description=inp.file.path, encoding="utf-8", open="w")

  inp.line.no <- 1
  inp.append <- function(str) { 
    eolNo <- length(which(gregexpr('\n', text=str)[[1]] != -1))
    inp.line.no <<- inp.line.no + eolNo
    cat(str, file = inp.file, append = TRUE) 
    return(inp.line.no)
  }
  inp.append('')  # create/clear inp.file
  
  dat.file.path <- file.path(lsp$temp.dir, "data.txt")
  dat.file <- file(description=dat.file.path, encoding="utf-8", open="w")
  dat.append <- function(str) { cat(str, file = dat.file, append = TRUE) }
  dat.append('') # create/clear dat.file
  
  generate.input(data, inp.append, dat.append, lsp$params$indexFromZero)
  close(dat.file)
  
  generate.param(lsp, inp.append)
  func.locations <- generate.model(lsp, inp.append)
  generate.output(lsp, inp.append, lsp$params$indexFromZero)
  close(inp.file)
    
  out.file.path <- file.path(lsp$temp.dir, "output.txt")
  err.file.path <- file.path(lsp$temp.dir, "error.txt")
  
  output <- system2(lsp$ls.exe.path, args=inp.file.path, stdin=dat.file.path, stdout=out.file.path, stderr=err.file.path);
  if (output != 0) {
    err.file <- file(description=err.file.path, encoding="utf-8", open="r")
    error <- parse.ls.error(lsp, func.locations, err.file)
    close(err.file)
    stop(error)
  }    
    
  out.file <- file(description=out.file.path, encoding="utf-8", open="r")
  result <- parse.ls.output(lsp$output.exprs, out.file)
  close(out.file)
  return(result)
}


#' Prints an object of class ls.problem.
#' 
#' @param x problem instance created with \code{\link{ls.problem}}.
#' @param ... further arguments passed to or from other methods.
#'  
#' @export
#' 
#' @examples
#' model.text.lsp <- lsp.model.example('extdata/knapsack.txt')
#' lsp <- ls.problem(model.text.lsp)
#' lsp
#' 

print.ls.problem <- function(x, ...){
 cat("*** A LocalSolver optimization problem ***\n\n")
 cat("*** Model formulation: ***\n")
 cat(x$model)
 cat("\n\n")
 if(length(x$output.exprs) == 0){
   cat("*** No output expressions have been chosen. ***\n\n")
 }else{
   cat("*** Required output expressions: ***\n")
   for(exprName in names(x$output.exprs)){
     expr <- x$output.exprs[[exprName]]
     cat(sprintf("   *  %s - object of dimension%s %s\n", expr$expr, ifelse(length(expr$dimensions) > 1, "s:", ""),
                 paste(expr$dimensions, collapse = " ")))
   }
   cat("\n")
 }
 cat(sprintf("*** Temporary directory: ***\n%s\n\n", x$temp.dir))
 if(x$ls.exe.path != "localsolver")
   cat(sprintf("*** LocalSolver localization directory: ***\n%s\n\n", x$ls.exe.path)) 

 if(length(names(x$params)) > 0){
   cat("*** Solver parameters: ***\n")
   for(paramName in names(x$params)){
     param <- as.character(x$params[[paramName]])
     if(length(param) > 1){
       param <- paste(param, collapse = " ")
     }
     cat(sprintf("   *  %s: %s\n", paramName, param))       
   } 
 }else{
   cat("*** No solver parameters have been set! ***\n")
 }
 
}


#' 
#' Sets folder to use for the problem instance solving process temporary data.
#' 
#' Exposed for technical reasons. Temporary folder is used to store files for communication 
#' with LocalSolver application. By default system received temp folder is used. Setting temporary
#' folder is useful in case \code{\link{ls.solve}} is performed in parallel. In that case each call 
#' should use own lsp instance with dedicated temporary folder. In case of changing this directory, 
#' it is important to choose a path to a folder with write access.
#' 
#' @param lsp problem instance created with \code{\link{ls.problem}}.
#' @param path the directory, which will be used for temporary data.
#' 
#' @export
#' 
#' @examples
#' model.text.lsp <- lsp.model.example('extdata/knapsack.txt')
#' lsp <- ls.problem(model.text.lsp)
#' lsp <- set.temp.dir(lsp, tempdir()) 
#' 
set.temp.dir <- function(lsp, path) {
  stopifnot(class(lsp) == 'ls.problem')

  info <- file.info(path)
  if (is.na(info$isdir) || !info$isdir) {
    stop(sprintf("%s: Folder does not exist", path))
  }
  
  lsp$temp.dir <- path
  return(lsp)
}