FICO
FICO Xpress Optimization Examples Repository
FICO Optimization Community FICO Xpress Optimization Home
Back to examples browserPrevious exampleNext example

Optimize a composition of investment portfolios using semi-continuous variables

Description

This example concerns the optimal composition of investment portfolios according to maximum total return. We modify the problem several times by changing variable types or right hand sides.



Further explanation of this example: This is a conversion of the Mosel example 'Portfolio Selection'

portfolio_selection_r.zip[download all files]

Source Files
By clicking on a file name, a preview is opened at the bottom of this page.
portfolio_selection.R[download]





portfolio_selection.R

#####################################
# This file is part of the          #
# Xpress-R interface examples       #
#                                   #
#   (c) 2021 Fair Isaac Corporation #
#####################################
#' ---
#' title: "Portfolio Selection"
#' author: Y. Gu
#' date: Jun.2021
#' ---
#'
#'
#'
## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(results = "hold")
knitr::opts_chunk$set(warning = FALSE, message = FALSE)


#'
#'
#' ## Brief Introduction To The Problem
#'
#' This is a conversion of the Mosel example 'Portfolio Selection', <https://www.fico.com/fico-xpress-optimization/docs/latest/examples/mosel/ApplBook/H_EconFin/h3portf.mos>.
#' A brief introduction to this problem is given below, and to see the full
#' mathematical modeling of this problem you may refer to section 13.3, page 199 of the
#' book 'Applications of optimization with Xpress'.
#'
#' This example concerns the optimal composition of investment portfolios according to
#' maximum total return. So, we define decision variable 'buy' for each share to denote
#' the amount of money invested in it. Given the criterion of optimum composition, the
#' objective we want to maximize is the return on investment of all shares, or we minimize
#' the negative of total return.
#'
#' In this example, there are 6 shares from different countries and different categories.
#' According to the requirements of the customer, the countries can be divided into
#' two groups: 'EU' and 'non-EU', and the categories are divided into 'technology' and
#' 'non-technology'. In the beginning, the customer specifies that she wishes to invest
#' at least 5,000 and at most 40,000 into any share. She further wishes to invest half
#' of her capital in European shares and at most 30% in technology shares. Besides these
#' two constraints, another constraint is that the total invested sum must correspond to
#' the initial capital.
#'
#' Later, it turns out that the customer actually wants to invest either 0 or at least
#' 5,000 and at most 40,000 into any share. So, we should change the type of decision
#' variables from continuous to semi-continuous using the function `chgcoltype` to satisfy
#' this requirement.
#'
#' As mentioned in the book, it is possible to restart the optimization by varying certain
#' parameters and in this case, Mathematical Programming becomes an efficient simulation
#' tool in financial applications. In our example, we try to change the upper bound of
#' the investment into technology shares from 30% of initial capital to 40% of initial
#' capital and see how the optimum solution will change.
#'
#' For mathematical formulations of this example, please refer to the book 'Applications
#' of optimization with Xpress'.
#'
#'
#' For this example, we need packages 'xpress' and 'dplyr'. Besides, we use the
#' function `pretty_name` to give the variables and constraints concise names.
#'
## ----Load The Packages And The Function To Give Names-------------------------
library(xpress)
library(dplyr)

pretty_name <- function(prefix, y) {
  "%s_%s" %>% sprintf(prefix,
                      paste(lapply(names(y), function(name)
                        paste(name, y[name], sep = "_")), collapse = "_"))
}


#'
#'
#' Add the values we need for this example.
#'
## ----Data---------------------------------------------------------------------
# maximum investment into tech. shares
MAXTECH = 0.3

# minimum investment into European shares
MINEU = 0.5

# minimum amount for a single share
VMIN = 5000

# maximum amount for a single share
VMAX = 40000

# capital
CAPITAL = 100000

# information about shares
shares.df <-
  data.frame(
    "SHARE" = 1:6,
    # shares chosen for the investment
    "RET" = c(5.3, 6.2, 5.1, 4.9, 6.5, 3.4),
    # expected return on investment of each share
    "EU" = c(FALSE, TRUE, TRUE, FALSE, TRUE, TRUE),
    # 'TRUE' if the share is of European origin
    "TECH" = c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE) # 'TRUE' if it is a technology share
  )


#'
#'
#' Since we need to solve several variants of the initial problem, we can create a function
#' to construct the initial problem. When creating the variants, we will call this function
#' and we just need to make adjustments on the problem this function returns.
#'
## ----The Initial Problem------------------------------------------------------
initprob <- function(shares){
  # create a new problem
  prob <-  createprob()

  # change this problem to a maximization problem
  chgobjsense(prob, objsense = xpress:::OBJ_MAXIMIZE)

  # set the problem name
  setprobname(prob, "Portfolio")

  # Add column
  # firstly, add continuous variables 'buy'
  shares$buy <-
    shares %>% apply(1, function(x)
      xprs_newcol(
        prob,
        lb = VMIN,
        ub = VMAX,
        coltype = "C",
        name = pretty_name("buy", x["SHARE"]),
        objcoef = (x["RET"] /
                     100)
      ))


  # Add row
  # 1. Requirements concerning portfolio composition
  # 1.1 the sum invested in technology must not exceed MAXTECH*CAPITAL, i.e., 0.3*100000=30000
  techlimit <-
    xprs_newrow(
      prob,
      colind = (shares %>% filter(TECH == TRUE) %>% select(buy))$buy,
      rowcoef = rep(1, sum(shares$TECH == TRUE)),
      rowtype = "L",
      rhs = MAXTECH * CAPITAL,
      name = "technology_invest"
    )

  # 1.2 the sum invested in EU shares must be at least MINEU*CAPITAL, i.e., 0.5*100000=50000
  xprs_newrow(
    prob,
    colind = (shares %>% filter(EU == TRUE) %>% select(buy))$buy,
    rowcoef = rep(1, sum(shares$EU == TRUE)),
    rowtype = "G",
    rhs = MINEU * CAPITAL,
    name = "EU_invest"
  )


  # 2. the total invested sum must correspond to the initial capital 'CAPITAL'
  xprs_newrow(
    prob,
    colind = shares$buy,
    rowcoef = rep(1, length(shares$buy)),
    rowtype = "E",
    rhs = CAPITAL,
    name = "capital"
  )


  return(list(
    prob = prob,
    techidx = techlimit,
    shares.df = shares
  ))

}

#'
#'
#' We store some outputs of the function `initprob` that will be used later.
#'
## ----Some Output Of The Initial Problem---------------------------------------
# create a list to store the returned objects from `initprob`
contlst <- initprob(shares.df)

# the data frame 'shares.df' containing column indices
shares.df <- contlst$shares.df

# the row index of the row concerning technology limit
techidx <- contlst$techidx



#'
#'
#' Now we solve the initial problem and display the solutions.
#'
## ----Solve The Initial Problem------------------------------------------------
prob.init <- contlst$prob

setoutput(prob.init)
summary(xprs_optimize(prob.init))

shares.df$contsol <- xprs_getsolution(prob.init)

print(
  paste0(
    "If we define continuous variables, the optimum expected return is :",
    getdblattrib(prob.init, xpress:::LPOBJVAL)
  )
)

print("The amount to invest in each share is:")
for (i in shares.df$SHARE) {
  cat(shares.df$contsol[i],
      labels = as.character(shares.df$SHARE[i]),
      fill = TRUE)
}


#'
#'

#'
#' Then we change the upper bound of technology investment and keep everything
#' else the same, and solve this variant and display the solutions.
#'
## ----Change MAXTECH In Initial Problem----------------------------------------
MAXTECH2 = 0.4
chgrhs(prob.init, techidx, MAXTECH2 * CAPITAL)

setoutput(prob.init)
summary(xprs_optimize(prob.init))

shares.df$contsol2 <- xprs_getsolution(prob.init)

print(
  paste0(
    "If we define continuous variables and change the upper bound of technology investment, the optimum expected return is :",
    getdblattrib(prob.init, xpress:::LPOBJVAL)
  )
)

print("The amount to invest in each share is:")
for (i in shares.df$SHARE) {
  cat(shares.df$contsol2[i],
      labels = as.character(shares.df$SHARE[i]),
      fill = TRUE)
}


#'
#'

#'
#'
#' According to the customer's requirement, we change the variable type to semi-continuous
#' and specify the lower bounds of these variables as 'VMIN', and then we solve this variant
#' and display the solutions.
#'
#' In the first problem with continuous variables, the lower bound for variables is 5000.
#' But now we set the variables as semi-continuous ones, thus the variables can be either
#' 0 or greater than 5000, which allows 0 investment on some shares with low expected ROI.
#' Therefore, this problem is actually a relaxation of the first one in view of the larger
#' feasible domain.
#'
## ----Change Variable Type To Semi-continuous----------------------------------
prob.semicont <- initprob(shares.df)$prob

# change the column types
chgcoltype(prob.semicont, shares.df$buy, rep('S', length(shares.df$buy)))

# set the lower bound for semi-continuous variables
chgglblimit(prob.semicont, shares.df$buy, rep(VMIN, length(shares.df$buy)))

setoutput(prob.semicont)
summary(xprs_optimize(prob.semicont))

shares.df$semicontsol <- xprs_getsolution(prob.semicont)

print(
  paste0(
    "If we define semi-continuous variables, the optimum expected return is :",
    getdblattrib(prob.semicont, xpress:::MIPOBJVAL)
  )
)

print("The amount to invest in each share is:")
for (i in shares.df$SHARE) {
  cat(shares.df$semicontsol[i],
      labels = as.character(shares.df$SHARE[i]),
      fill = TRUE)
}


#'
#'

#'
#'
#' In this part, we change the upper bound of technology investment and keep everything
#' else the same. Then we solve this variant and display the solutions.
#'
## ----Change MAXTECH In Modified Problem---------------------------------------
chgrhs(prob.semicont, techidx, MAXTECH2 * CAPITAL)

setoutput(prob.semicont)
summary(xprs_optimize(prob.semicont))

shares.df$semicontsol2 <- xprs_getsolution(prob.semicont)

print(paste0("If we define semi-continuous variables and change the upper bound of technology investment, the optimum expected return is :",getdblattrib(prob.semicont, xpress:::MIPOBJVAL)))

print("The amount to invest in each share is:")
for (i in shares.df$SHARE) {
  cat(shares.df$semicontsol2[i],
      labels = as.character(shares.df$SHARE[i]),
      fill = TRUE)
}



#'
#'

Back to examples browserPrevious exampleNext example