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

Solve a routing problem using an arc-paths formulation for a telecommunication network

Description

A private telephone company exploits a network (shown below) among five cities and the edge labels represent the capacities of the link in terms of circuits. The capacity of an edge is consumed in increments of a bidirectional circuit and we do not consider any directed flows. Faced with demands for circuits, the company wants to know whether it is possible to satisfy the demands entirely. If it is not possible, the company wants to transmit as much as possible.



Further explanation of this example: This is a conversion of the Mosel example 'Routing Telephone Calls'

routingtelecalls_r.zip[download all files]

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





routingtelecalls.R

#####################################
# This file is part of the          #
# Xpress-R interface examples       #
#                                   #
#   (c) 2022-2024 Fair Isaac Corporation #
#####################################
#' ---
#' title: "Routing Telephone Calls"
#' 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 'Routing Telephone Calls'](https://www.fico.com/fico-xpress-optimization/docs/latest/examples/mosel/ApplBook/G_Telecomm/g3routing.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 12.3, page 180 of the
#' book 'Applications of optimization with Xpress'.
#'
#' A private telephone company exploits a network (shown below) among five cities and
#' the edge labels represent the capacities of the link in terms of circuits. The capacity
#' of an edge is consumed in increments of a bidirectional circuit and we do not consider
#' any directed flows. So, if 10 persons call from Nantes to Nice and 20 from Nice to
#' Nantes, then 30 circuits are used. The problem is that faced with demands for circuits,
#' the company wants to know whether it is possible to satisfy the demands entirely. If
#' it is not possible, the company wants to transmit as much as possible.
#'
#' To solve this problem, we use arc-paths formulation. This formulation uses a single
#' integer variable 'flow_p' for the flow all along a path p, where this path corresponds
#' to a known pair of cities, and the flow conservation laws per node are implicitly fulfilled.
#'
#' The objective we want to maximize is obviously the sum of 'flow' on all paths that
#' may be used. Two sets of constraints should be satisfied, the first one is that for
#' every arc, the sum of flows on the paths passing through it must not exceed its
#' capacity. The second one is that for every pair of cities, the sum of flows exchanged
#' between them over various paths must not exceed the demand for circuits.
#'
#' More detailed explanations and full mathematical formulation about this example are
#' included in the book 'Applications of optimization with Xpress'.
#'
#'
#' For this example, we need packages 'xpress', 'dplyr' and 'igraph'.
#'
## ----Load The Packages--------------------------------------------------------
library(xpress)
library(dplyr)
library(igraph)


#'
#'
#' Create a new empty problem, set the objective sense as maximization and give the
#' problem a suitable name.
#'
## ----Create The Problem-------------------------------------------------------
# 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, "Routing")


#'
#'
#' Add the values we need for this example and plot the network.
#'
## ----Data And Graph-----------------------------------------------------------
# 1. 'CALLS': the set of city pairs between which there are demands for calls
#    'DEM': demands between pairs of cities
demand.df <- data.frame("CALLS" = c("Nantes-Nice", "Nantes-Troyes", "Nantes-Valenciennes",
                                       "Nice-Valenciennes", "Paris-Troyes"),
                        "DEM" = c(100, 80, 75, 100, 70))

# 2. 'ARCS': the set of (undirected) arcs
#    'CAP': the capacity of each arc
capacity.df <- data.frame("ARCS" = c("Nantes-Paris", "Nantes-Nice", "Paris-Nice",
                                     "Paris-Valenciennes", "Troyes-Nice", "Valenciennes-Troyes"),
                          "CAP" = c(300, 120, 300, 200, 80, 70))

# 3. list of arcs composing the routes for demands
ROUTE.lst <- list(c("Nantes-Nice"),
                  c("Nantes-Paris", "Paris-Nice"),
                  c("Nantes-Paris","Paris-Valenciennes", "Valenciennes-Troyes", "Troyes-Nice"),
                  c("Nantes-Paris", "Paris-Valenciennes", "Valenciennes-Troyes"),
                  c("Nantes-Paris", "Paris-Nice", "Troyes-Nice"),
                  c("Nantes-Nice", "Troyes-Nice"),
                  c("Nantes-Nice", "Paris-Nice", "Paris-Valenciennes", "Valenciennes-Troyes"),
                  c("Nantes-Paris", "Paris-Valenciennes"),
                  c("Nantes-Nice", "Paris-Nice", "Paris-Valenciennes"),
                  c("Nantes-Paris", "Paris-Nice", "Troyes-Nice", "Valenciennes-Troyes"),
                  c("Nantes-Nice", "Troyes-Nice", "Valenciennes-Troyes"),
                  c("Nantes-Nice", "Nantes-Paris", "Paris-Valenciennes"),
                  c("Paris-Nice", "Paris-Valenciennes"),
                  c("Troyes-Nice", "Valenciennes-Troyes"),
                  c("Paris-Valenciennes", "Valenciennes-Troyes"),
                  c("Nantes-Paris", "Nantes-Nice", "Troyes-Nice"),
                  c("Paris-Nice", "Troyes-Nice"))

# 4. 'Cindex': pair of cities at the ends of every path
CINDEX <- data.frame(
  Routeidx = 1:length(ROUTE.lst),
  Cindex = c(
    rep("Nantes-Nice", 3),
    rep("Nantes-Troyes", 4),
    rep("Nantes-Valenciennes", 4),
    rep("Nice-Valenciennes", 3),
    rep("Paris-Troyes", 3)
  )
)

# 5. the network
elist <- data.frame(tails=c("Nantes", "Nantes", "Paris", "Paris", "Troyes", "Valenciennes"),
                    heads=c("Paris", "Nice", "Nice", "Valenciennes", "Nice", "Troyes"))
graph <- graph_from_data_frame(d = elist, directed = F)

set.seed(66)
plot(
  graph,
  vertex.color = "gold",
  vertex.size = 25,
  vertex.frame.color = "gray",
  vertex.label.color = "black",
  edge.color = "gray",
  edge.label = capacity.df$CAP,
  layout = layout.auto(graph)
)


#'
#'
#' Create variables 'flow' and store their indices in a newly created vector 'flow' in
#' data frame 'CINDEX'.
#'
## ----Add Columns--------------------------------------------------------------
# integer variable 'flow' representing flows on each path
CINDEX$flow <-
  CINDEX %>% apply(1, function(x)
    xprs_newcol(
      prob,
      lb = 0,
      ub = Inf,
      coltype = "I",
      name = sprintf("flow_%s", x["Routeidx"]),
      objcoef = 1
    ))


#'
#'
#' Add the constraints mentioned in introduction.
#'
## ----Add Rows, results='hide'-------------------------------------------------
# 1. for every pair of cities in 'CALLS', the sum of flows exchanged between them over
#    the various paths must not exceed the demand for circuits
apply(demand.df, 1, function(x)
  xprs_addrow(
    prob,
    colind = (CINDEX %>% filter(Cindex == x["CALLS"]) %>% select(flow))$flow,
    rowcoef = rep(1, sum(CINDEX$Cindex == x["CALLS"])),
    rowtype = "L",
    rhs = as.numeric(x["DEM"]),
    name = sprintf("flow_%s", x["CALLS"])
  ))

# 2. for every arc in 'ARCS', the sum of flows on the paths passing through it must
#    not exceed its capacity
for (i in capacity.df$ARCS) {
  colidx <- c()
  for (j in 1:length(ROUTE.lst)) {
    if (i %in% ROUTE.lst[[j]]) {
      colidx <- c(colidx, CINDEX$flow[j])
    }
  }
  xprs_addrow(
    prob,
    colind = colidx,
    rowcoef = rep(1, length(colidx)),
    rowtype = "L",
    rhs = capacity.df$CAP[which(capacity.df$ARCS == i)],
    name = sprintf("arc_capacity_%s", i)
  )

}


#'
#'
#' Now we can solve this problem.
#'
## ----Solve The Problem--------------------------------------------------------
setoutput(prob)
summary(xprs_optimize(prob))

#'
#'
#' Display the solutions here.
#'
## ----Solutions And Graph------------------------------------------------------
CINDEX$flow.sol <- xprs_getsolution(prob)

print(paste0(
  "The optimum total flow is: ",
  getdblattrib(prob, xpress:::MIPOBJVAL)
))
for (d in 1:nrow(demand.df)) {
  cat(
    demand.df$CALLS[d],
    "(demand: ",
    demand.df$DEM[d],
    ", routed calls: ",
    CINDEX %>% filter(Cindex == demand.df$CALLS[d]) %>% select(flow.sol) %>%
      sum(),
    ")\n"
  )

  p.route <-
    CINDEX %>% filter(Cindex == demand.df$CALLS[d] & flow.sol > 0) %>%
      select(Routeidx)

  apply(p.route, 1, function(x)
    cat(" ", CINDEX$flow.sol[x], ":", ROUTE.lst[[x]], "\n"))

}


print("Unused capacity:")
capacity.df$used <- rep(0, nrow(capacity.df))

for (i in capacity.df$ARCS) {
  used <- 0

  for (j in 1:length(ROUTE.lst)) {
    if (i %in% ROUTE.lst[[j]]) {
      used <- used + CINDEX$flow.sol[j]
    }
  }
  capacity.df$used[which(capacity.df$ARCS == i)] <- used
  unused <- capacity.df$CAP[which(capacity.df$ARCS == i)] - used
  if (unused > 0) {
    print(paste0(" ", i, ": ", unused))
  }
}

# the graph
elabel <-
  apply(capacity.df, 1, function(x)
    paste0(x["used"], "/", x["CAP"]))

set.seed(66)
plot(
  graph,
  vertex.color = "gold",
  vertex.size = 20,
  vertex.frame.color = "gray",
  vertex.label.color = "black",
  edge.color = "gray",
  edge.label = elabel,
  edge.arrow.size = 0.5,
  layout = layout.auto(graph)
)


#'
#'

Back to examples browserPrevious exampleNext example