├── DESCRIPTION ├── NAMESPACE ├── R ├── AllGenerics.R ├── cccp.R ├── ctrl.R ├── dcp.R ├── dlp.R ├── dnl.R ├── dqp.R ├── gp.R ├── l1.R ├── nlfc.R ├── nnoc.R ├── psdc.R ├── rp.R ├── socc.R └── zzz.R ├── README.md ├── demo ├── 00Index ├── ACNT.R ├── FPLN.R ├── GP.R ├── L1.R ├── LPCC.R ├── LPIC.R ├── QPEC.R ├── QPIC.R ├── QPQC.R ├── QPUC.R ├── SDP.R └── SOCP.R ├── inst ├── include │ ├── CPG.h │ └── cccp.h └── unitTests │ ├── runTests.R │ ├── runit.acnt.R │ ├── runit.fpln.R │ ├── runit.gp.R │ ├── runit.lpcc.R │ ├── runit.lpic.R │ ├── runit.qpec.R │ ├── runit.qpic.R │ ├── runit.qpqc.R │ ├── runit.sdp.R │ └── runit.socp.R ├── man ├── Rcpp_CONEC-class.Rd ├── Rcpp_CPG-module.Rd ├── Rcpp_CPS-class.Rd ├── Rcpp_CTRL-class.Rd ├── Rcpp_DCP-class.Rd ├── Rcpp_DLP-class.Rd ├── Rcpp_DNL-class.Rd ├── Rcpp_DQP-class.Rd ├── Rcpp_PDV-class.Rd ├── cccp.Rd ├── cps.Rd ├── ctrl.Rd ├── dcp.Rd ├── dlp.Rd ├── dnl.Rd ├── dqp.Rd ├── getFoo.Rd ├── gp.Rd ├── l1.Rd ├── nlfc.Rd ├── nnoc.Rd ├── psdc.Rd ├── rp.Rd └── socc.Rd ├── src ├── CONEC.cpp ├── DCP.cpp ├── DLP.cpp ├── DNL.cpp ├── DQP.cpp ├── GPP.cpp ├── Makevars ├── Makevars.win ├── Modules.cpp ├── RPP.cpp ├── RcppExports.cpp └── SOPS.cpp └── tests └── doRUnit.R /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: cccp 2 | Version: 0.2-8 3 | Date: 2020-04-24 4 | Title: Cone Constrained Convex Problems 5 | Authors@R: c(person("Bernhard", "Pfaff", role = c("aut", "cre"), email = "bernhard@pfaffikus.de"), person("Lieven", "Vandenberghe", role = "cph", comment = "copyright holder of cvxopt"), person("Martin", "Andersen", role = "cph", comment = "copyright holder of cvxopt"), person("Joachim", "Dahl", role = "cph", comment = "copyright holder of cvxopt")) 6 | Maintainer: Bernhard Pfaff 7 | Depends: R (>= 3.0.1), methods 8 | Suggests: RUnit, numDeriv 9 | LazyLoad: yes 10 | Description: Routines for solving convex optimization problems with cone constraints by means of interior-point methods. The implemented algorithms are partially ported from CVXOPT, a Python module for convex optimization (see for more information). 11 | Imports: Rcpp (>= 0.11.2) 12 | LinkingTo: Rcpp, RcppArmadillo 13 | License: GPL (>= 3) 14 | RcppModules: CPG 15 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | ## 2 | ## Import directives 3 | ## 4 | import(Rcpp, methods) 5 | useDynLib(cccp) 6 | ## 7 | ## Export directives 8 | ## 9 | exportPattern("^[[:alpha:]]+") 10 | -------------------------------------------------------------------------------- /R/AllGenerics.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Generic for extractor of x-variables 3 | setGeneric("cps", function(cpd, ctrl) standardGeneric("cps")) 4 | ## 5 | ## Generic for extractor of x-variables 6 | setGeneric("getx", function(object) standardGeneric("getx")) 7 | ## 8 | ## Generic for extractor of y-variables 9 | setGeneric("gety", function(object) standardGeneric("gety")) 10 | ## 11 | ## Generic for extractor of s-variables 12 | setGeneric("gets", function(object) standardGeneric("gets")) 13 | ## 14 | ## Generic for extractor of z-variables 15 | setGeneric("getz", function(object) standardGeneric("getz")) 16 | ## 17 | ## Generic for extractor of state of convex program 18 | setGeneric("getstate", function(object) standardGeneric("getstate")) 19 | ## 20 | ## Generic for extractor of optimizer's status 21 | setGeneric("getstatus", function(object) standardGeneric("getstatus")) 22 | ## 23 | ## Generic for extractor of number of iterations 24 | setGeneric("getniter", function(object) standardGeneric("getniter")) 25 | ## 26 | ## Generic for extractor of control parameters 27 | setGeneric("getparams", function(object) standardGeneric("getparams")) 28 | -------------------------------------------------------------------------------- /R/cccp.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Main function for defining and solving linear and quadratic programs with cone constraints 3 | cccp <- function(P = NULL, q = NULL, A = NULL, b = NULL, cList = list(), 4 | x0 = NULL, f0 = NULL, g0 = NULL, h0 = NULL, 5 | nlfList = list(), nlgList = list(), nlhList = list(), 6 | optctrl = ctrl()){ 7 | 8 | if(!is.null(x0)){ 9 | if(!is.null(f0) && !is.null(g0) && !is.null(h0)){ 10 | cpd <- dcp(x0 = x0, f0 = f0, g0 = g0, h0 = h0, cList = cList, 11 | nlfList = nlfList, nlgList = nlgList, nlhList = nlhList, 12 | A = A, b = b) 13 | } else if((length(nlfList) > 0) && (length(nlgList) > 0) && (length(nlhList) > 0)){ 14 | cpd <- dnl(q = q, A = A, b = b, cList = cList, 15 | x0 = x0, nlfList = nlfList, nlgList = nlgList, nlhList = nlhList) 16 | } else { 17 | warning("x0 provided, but missing arguments for either:\nf0, g0, h0 and/or nlfList, nlgList, nlhList.\nDiscarding x0.\n") 18 | if(is.null(P) && is.null(q)){ 19 | stop("Ill-defined program formulation: At least P or q must be provided.\n") 20 | } 21 | if(is.null(P) && !is.null(q)){ 22 | cpd <- dlp(q = q, A = A, b = b, cList = cList) 23 | } else { 24 | cpd <- dqp(P = P, q = q, A = A, b = b, cList = cList) 25 | } 26 | } 27 | } else if(is.null(P)){ 28 | cpd <- dlp(q, A, b, cList) 29 | } else { 30 | if(is.null(q)){ 31 | q <- rep(0, ncol(P)) 32 | } 33 | cpd <- dqp(P, q, A, b, cList) 34 | } 35 | 36 | cps(cpd, optctrl) 37 | } 38 | -------------------------------------------------------------------------------- /R/ctrl.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Function for creating 'CTRL' objects 3 | ctrl <- function(maxiters = 100L, abstol = 1e-6, reltol = 1e-6, feastol = 1e-6, 4 | stepadj = 0.95, beta = 0.5, trace = TRUE){ 5 | 6 | if(!is.integer(maxiters)){ 7 | stop("\nThe count of maximal iterations must be an integer.\n") 8 | } 9 | if(maxiters < 1){ 10 | stop("\nThe count of maximal iterations must be positive and greater or equal to one.\n") 11 | } 12 | if(!is.null(dim(abstol)) | length(abstol) > 1){ 13 | stop("\nThe absolute tolerance for convergence must be a real scalar.\n") 14 | } 15 | if(!is.null(dim(reltol)) | length(reltol) > 1){ 16 | stop("\nThe relative tolerance for convergence must be a real scalar.\n") 17 | } 18 | if(!is.null(dim(feastol)) | length(feastol) > 1){ 19 | stop("\nThe feasabile tolerance for convergence must be a real scalar.\n") 20 | } 21 | if(abstol < 0 & reltol < 0){ 22 | stop("\nAt least one of 'reltol' and 'abstol' must be positive.\n") 23 | } 24 | if(feastol <= 0){ 25 | stop("\nThe convergence criteria for feasability must be positive.\n") 26 | } 27 | if(stepadj <= 0 || stepadj > 1.0){ 28 | stop("\nStep-size adjustment must be in the interval: (0, 1].\n") 29 | } 30 | if(beta <= 0 || beta >= 1.0){ 31 | stop("\nBacktracking parameter for domain of non-linear constraints\nmust be in the interval: (0, 1).\n") 32 | } 33 | 34 | new(CTRL, list( 35 | maxiters = maxiters, 36 | abstol = abstol, 37 | reltol = reltol, 38 | feastol = feastol, 39 | stepadj = stepadj, 40 | beta = beta, 41 | trace = as.logical(trace)[1]) 42 | ) 43 | } 44 | -------------------------------------------------------------------------------- /R/dcp.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Function for creating an object of reference-class 'DCP' 3 | dcp <- function(x0, f0, g0, h0, cList = list(), nlfList = list(), nlgList = list(), nlhList = list(), A = NULL, b = NULL){ 4 | x0 <- as.matrix(x0) 5 | n <- nrow(x0) 6 | K <- length(cList) 7 | mnl <- length(nlfList) 8 | ## Checking whether x0 is in the domain of nonlinear objective 9 | f0Dom <- is.nan(f0(x0)) 10 | if(f0Dom){ 11 | stop("Initial point 'x0' is not in the domain of nonlinear objective 'f0'.\n") 12 | } 13 | ## 14 | ## Checking provided non-linear constraints (if applicable) 15 | ## 16 | if(mnl > 0){ 17 | if(!all(unlist(lapply(nlfList, function(f) class(f) == "function")))){ 18 | stop("Not all list elements in 'nlfList' are functions.\n") 19 | } 20 | if(!all(unlist(lapply(nlgList, function(f) class(f) == "function")))){ 21 | stop("Not all list elements in 'nlgList' are functions.\n") 22 | } 23 | if(!all(unlist(lapply(nlhList, function(f) class(f) == "function")))){ 24 | stop("Not all list elements in 'nlhList' are functions.\n") 25 | } 26 | fDom <- unlist(lapply(nlfList, function(fcc) fcc(x0))) 27 | idxnan <- which(is.nan(fDom)) 28 | if(any(idxnan)){ 29 | stop(paste("Initial point 'x0' is not in the domain of nonlinear convex constraint(s): ", idxnan, ".\n", sep = "")) 30 | } 31 | if(length(nlfList) != length(nlgList)){ 32 | stop("Length of lists for nonlinear functions and gradient functions do differ.\n") 33 | } 34 | if(length(nlfList) != length(nlhList)){ 35 | stop("Length of lists for nonlinear functions and Hessian functions do differ.\n") 36 | } 37 | ## Creating list-object of non-linear constraints, their Gradient and Hessian functions 38 | nList <- list(c(list(f0), nlfList), c(list(g0), nlgList), c(list(h0), nlhList)) 39 | ## Creating objects related to NLFC 40 | mnl <- mnl + 1L 41 | Gnl <- matrix(0, nrow = mnl, ncol = n) 42 | hnl <- matrix(0, nrow = mnl, ncol = 1) 43 | } else { 44 | mnl <- 1L 45 | Gnl <- matrix(0, nrow = 1, ncol = n) 46 | hnl <- matrix(0, nrow = 1, ncol = 1) 47 | nList <- list(list(f0), list(g0), list(h0)) 48 | } 49 | ## 50 | ## Checking/defining inequality constraints (epigraph form, right-adding 't') 51 | ## 52 | if(K > 0){ 53 | cone <- unlist(lapply(cList, function(x) x[["conType"]])) 54 | if(!all(cone %in% c("NNOC", "SOCC", "PSDC"))){ 55 | stop("List elements of cone constraints must be either created by calls to:\n'nnoc()', or 'socc()', or 'psdc()'.\n") 56 | } 57 | cone <- c("NLFC", cone) 58 | GList <- c(list(Gnl), lapply(cList, function(x) x[["G"]])) 59 | hList <- c(list(hnl), lapply(cList, function(x) x[["h"]])) 60 | dims <- c(mnl, as.integer(unlist(lapply(cList, function(x) x[["dims"]])))) 61 | K <- K + 1L 62 | G <- do.call("rbind", GList) 63 | G <- cbind(G, 0) 64 | G[1, ncol(G)] <- -1.0 65 | h <- do.call("rbind", hList) 66 | ridx <- cumsum(unlist(lapply(GList, nrow))) 67 | sidx <- cbind(c(0, ridx[-length(ridx)]), ridx - 1) 68 | cList <- new(CONEC, cone, G, h, sidx, dims, K, n + 1L) 69 | } else { ## case: no cone constraints, but nonlinear constraints, at least f0 70 | Gepi <- cbind(Gnl, 0) 71 | Gepi[1, ncol(Gepi)] <- -1.0 72 | sidx <- matrix(c(0, nrow(Gepi) - 1L), nrow = 1, ncol = 2) 73 | nepi <- n + 1L 74 | cList <- new(CONEC, "NLFC", Gepi, hnl, sidx, mnl, 1L, nepi) 75 | } 76 | ## 77 | ## Checking equality constraints 78 | ## 79 | ## checking whether x0 satisfies equality constraints 80 | if(!is.null(A)){ 81 | A <- as.matrix(A) 82 | eq <- identical(as.vector(A %*% x0 - b), rep(0, nrow(A))) 83 | if(!eq){ 84 | stop("Initial point 'x0' does not satisfy equality constraints.\n") 85 | } 86 | } 87 | if(is.null(A)){ 88 | A <- matrix(0, nrow = 0, ncol = n + 1) 89 | } else { 90 | A <- cbind(A, rep(0, nrow(A))) 91 | } 92 | if(is.null(b)){ 93 | b <- matrix(0, nrow = 0, ncol = 1) 94 | } 95 | if(is.null(dim(b))){ 96 | b <- matrix(b, ncol = 1) 97 | } 98 | 99 | ans <- new(DCP, 100 | x0 = rbind(x0, 0.0), ## set initial value of 't = 0.0' 101 | cList = cList, 102 | nList = nList, 103 | A = A, 104 | b = b 105 | ) 106 | return(ans) 107 | } 108 | -------------------------------------------------------------------------------- /R/dlp.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Function for creating an object of reference-class 'DLP' 3 | dlp <- function(q, A = NULL, b = NULL, cList = list()){ 4 | if(is.matrix(q)){ 5 | warning("Matrix provided for q, extracting first column for argument 'q'.\n") 6 | q <- q[, 1] 7 | } 8 | n <- length(q) 9 | if(is.null(A)){ 10 | A <- matrix(0, nrow = 0, ncol = n) 11 | } 12 | if(is.null(dim(A))){ 13 | A <- matrix(A, nrow = 1) 14 | } 15 | if(is.null(b)){ 16 | b <- numeric() 17 | } 18 | K <- length(cList) 19 | if(K < 1){ 20 | warning("LP in standard form: Adding non-negativity constraint(s).\n") 21 | G <- -diag(n) 22 | h <- rep(0, n) 23 | cList <- list(nnoc(G = G, h = h)) 24 | K <- 1 25 | } 26 | if(K > 0){ 27 | cone <- unlist(lapply(cList, function(x) x[["conType"]])) 28 | if(!all(cone %in% c("NNOC", "SOCC", "PSDC"))){ 29 | stop("List elements of cone constraints must be either created by calls to:\n'nnoc()', or 'socc()', or 'psdc()'.\n") 30 | } 31 | GList <- lapply(cList, function(x) x[["G"]]) 32 | G <- do.call("rbind", GList) 33 | h <- do.call("rbind", lapply(cList, function(x) x[["h"]])) 34 | ridx <- cumsum(unlist(lapply(GList, nrow))) 35 | sidx <- cbind(c(0, ridx[-length(ridx)]), ridx - 1) 36 | dims <- as.integer(unlist(lapply(cList, function(x) x[["dims"]]))) 37 | cList <- new(CONEC, cone, G, h, sidx, dims, K, n) 38 | } else { 39 | stop("LP only with equality constraints; undefined or exact solution.\n") 40 | } 41 | ans <- new(DLP, 42 | q = q, 43 | A = A, 44 | b = b, 45 | cList = cList) 46 | return(ans) 47 | } 48 | -------------------------------------------------------------------------------- /R/dnl.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Function for creating an object of reference-class 'DNL' 3 | dnl <- function(q, A = NULL, b = NULL, cList = list(), 4 | x0, nlfList = list(), nlgList = list(), nlhList = list()){ 5 | if(is.matrix(q)){ 6 | warning("Matrix provided for q, extracting first column for argument 'q'.\n") 7 | q <- q[, 1] 8 | } 9 | n <- length(q) 10 | if(is.matrix(x0)){ 11 | warning("Matrix provided for x0, extracting first column for argument 'x0'.\n") 12 | x0 <- x0[, 1] 13 | } 14 | if(!identical(length(x0), length(q))){ 15 | stop("Length of initial point 'x' is not equal to the dimension of the objective.\n") 16 | } 17 | if(is.null(A)){ 18 | A <- matrix(0, nrow = 0, ncol = n) 19 | } 20 | if(is.null(dim(A))){ 21 | A <- matrix(A, nrow = 1) 22 | } 23 | if(is.null(b)){ 24 | b <- numeric() 25 | } 26 | ## 27 | ## Checking provided non-linear constraints 28 | ## 29 | mnl <- length(nlfList) 30 | if(mnl < 1){ 31 | warning("Empty list for non-linear convex constraints provided.\nReturning as DLP object.\n") 32 | cpd <- dlp(q = q, A = A, b = b, cList = cList) 33 | return(cpd) 34 | } 35 | if(!all(unlist(lapply(nlfList, function(f) class(f) == "function")))){ 36 | stop("Not all list elements in 'nlfList' are functions.\n") 37 | } 38 | if(!all(unlist(lapply(nlgList, function(f) class(f) == "function")))){ 39 | stop("Not all list elements in 'nlgList' are functions.\n") 40 | } 41 | if(!all(unlist(lapply(nlhList, function(f) class(f) == "function")))){ 42 | stop("Not all list elements in 'nlhList' are functions.\n") 43 | } 44 | fDom <- unlist(lapply(nlfList, function(fcc) fcc(x0))) 45 | idxnan <- which(is.nan(fDom)) 46 | if(any(idxnan)){ 47 | stop(paste("Initial point 'x0' is not in the domain of nonlinear convex constraint(s): ", idxnan, ".\n", sep = "")) 48 | } 49 | if(length(nlfList) != length(nlgList)){ 50 | stop("Length of lists for nonlinear functions and gradient functions do differ.\n") 51 | } 52 | if(length(nlfList) != length(nlhList)){ 53 | stop("Length of lists for nonlinear functions and Hessian functions do differ.\n") 54 | } 55 | ## Creating list-object of non-linear constraints, their Gradient and Hessian functions 56 | nList <- list(nlfList, nlgList, nlhList) 57 | ## Creating objects related to NLFC 58 | Gnl <- matrix(0, nrow = mnl, ncol = n) 59 | hnl <- matrix(0, nrow = mnl, ncol = 1) 60 | K <- length(cList) 61 | if(K > 0){ 62 | cone <- unlist(lapply(cList, function(x) x[["conType"]])) 63 | if(!all(cone %in% c("NNOC", "SOCC", "PSDC"))){ 64 | stop("List elements of cone constraints must be either created by calls to:\n'nnoc()', or 'socc()', or 'psdc()'.\n") 65 | } 66 | cone <- c("NLFC", cone) 67 | GList <- lapply(cList, function(x) x[["G"]]) 68 | GList <- c(list(Gnl), GList) 69 | G <- do.call("rbind", GList) 70 | hList <- lapply(cList, function(x) x[["h"]]) 71 | hList <- c(list(hnl), hList) 72 | h <- do.call("rbind", hList) 73 | ridx <- cumsum(unlist(lapply(GList, nrow))) 74 | sidx <- cbind(c(0, ridx[-length(ridx)]), ridx - 1) 75 | dims <- c(mnl, as.integer(unlist(lapply(cList, function(x) x[["dims"]])))) 76 | K <- K + 1L 77 | cList <- new(CONEC, cone, G, h, sidx, dims, K, n) 78 | } else { 79 | cList <- new(CONEC, "NLFC", Gnl, hnl, mnl, 1L, n) 80 | } 81 | ans <- new(DNL, 82 | q = q, 83 | A = A, 84 | b = b, 85 | cList = cList, 86 | x0 = as.matrix(x0), 87 | nList = nList) 88 | return(ans) 89 | } 90 | -------------------------------------------------------------------------------- /R/dqp.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Function for creating an object of reference-class 'DQP' 3 | dqp <- function(P, q, A = NULL, b = NULL, cList = list()){ 4 | n <- ncol(P) 5 | if(is.null(A)){ 6 | A <- matrix(0, nrow = 0, ncol = n) 7 | } 8 | if(is.null(dim(A))){ 9 | A <- matrix(A, nrow = 1) 10 | } 11 | if(is.null(b)){ 12 | b <- numeric() 13 | } 14 | if(length(cList) > 0){ 15 | cone <- unlist(lapply(cList, function(x) x[["conType"]])) 16 | if(!all(cone %in% c("NNOC", "SOCC", "PSDC"))){ 17 | stop("List elements of cone constraints must be either created by calls to:\n'nnoc()', or 'socc()', or 'psdc()'.\n") 18 | } 19 | K <- length(cList) 20 | GList <- lapply(cList, function(x) x[["G"]]) 21 | G <- do.call("rbind", GList) 22 | h <- do.call("rbind", lapply(cList, function(x) x[["h"]])) 23 | ridx <- cumsum(unlist(lapply(GList, nrow))) 24 | sidx <- cbind(c(0, ridx[-length(ridx)]), ridx - 1) 25 | dims <- as.integer(unlist(lapply(cList, function(x) x[["dims"]]))) 26 | cList <- new(CONEC, cone, G, h, sidx, dims, K, n) 27 | } else { 28 | cList <- new(CONEC, as.integer(n)) 29 | } 30 | ans <- new(DQP, 31 | P = P, 32 | q = q, 33 | A = A, 34 | b = b, 35 | cList = cList) 36 | return(ans) 37 | } 38 | -------------------------------------------------------------------------------- /R/gp.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## R function for solving a geometric program 3 | ## 4 | gp <- function(F0, g0, FList = list(), gList = list(), 5 | nno = NULL, A = NULL, b = NULL, optctrl = ctrl()){ 6 | n <- ncol(F0) 7 | mnl <- length(FList) 8 | if(!identical(mnl, length(gList))){ 9 | stop("Length of list objects 'FList' and 'gList' differ.\n") 10 | } 11 | mnl <- mnl + 1L 12 | FList <- c(list(F0), FList) 13 | gList <- c(list(g0), gList) 14 | gList <- lapply(gList, function(x) as.matrix(x)) 15 | ## Checking for inequality constraints and 16 | ## creating objects for CONEC (epigraph form) 17 | G <- matrix(0, nrow = mnl, ncol = n) 18 | h <- matrix(0, nrow = mnl, ncol = 1) 19 | dims <- mnl 20 | cone <- "NLFC" 21 | K <- 1L 22 | sidx <- matrix(c(0, mnl - 1L), nrow = 1, ncol = 2) 23 | if(!is.null(nno)){ 24 | cone <- c(cone, "NNOC") 25 | K <- 2L 26 | G <- rbind(G, nno$G) 27 | h <- rbind(h, nno$h) 28 | dims <- c(dims, nrow(nno$G)) 29 | sidx <- rbind(sidx, c(mnl, nrow(G) -1L)) 30 | } else { 31 | if(mnl == 1L){ 32 | warning("No restrictions provided, trying solve().\n") 33 | ans <- try(solve(F0, -g0)) 34 | if(class(ans) == "try-error"){ 35 | stop("Solving unconstrained objective 'F0 * x + g0' failed.\n") 36 | } else { 37 | return(exp(ans)) 38 | } 39 | } 40 | } 41 | G <- cbind(G, 0) 42 | G[1, ncol(G)] <- -1.0 43 | cList <- new(CONEC, cone, G, h, sidx, dims, K, n + 1L) 44 | ## 45 | ## Checking equality constraints 46 | ## 47 | ## checking whether x0 satisfies equality constraints 48 | if(is.null(A)){ 49 | A <- matrix(0, nrow = 0, ncol = n + 1L) 50 | } else { 51 | A <- cbind(A, rep(0, nrow(A))) 52 | } 53 | if(is.null(b)){ 54 | b <- matrix(0, nrow = 0, ncol = 1) 55 | } 56 | if(is.null(dim(b))){ 57 | b <- matrix(b, ncol = 1) 58 | } 59 | ## Calling cpp-routine 60 | gpp(FList, gList, cList, A, b, optctrl) 61 | } 62 | -------------------------------------------------------------------------------- /R/l1.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Function for minimizing a L1-norm ||Pu - q||_1 3 | ## This is a wrapper function for the LP-cps method 4 | l1 <- function(P, q = NULL, optctrl = ctrl()){ 5 | m <- nrow(P) 6 | n <- ncol(P) 7 | if(is.null(q)){ 8 | q <- rep(0, m) 9 | } else { 10 | q <- as.vector(q) 11 | } 12 | ## Creating NNO-constraint 13 | target <- c(rep(0, n), rep(1, m)) 14 | G <- matrix(0, nrow = m + m, ncol = n + m) 15 | G[1:m, 1:n] <- P 16 | D <- diag(m) 17 | G[1:m, -c(1:n)] <- -D 18 | G[-c(1:m), 1:n] <- -P 19 | G[-c(1:m), -c(1:n)] <- -D 20 | h <- matrix(c(q, -q), nrow = m + m, ncol = 1) 21 | nno1 <- nnoc(G = G, h = h) 22 | ## Defining LP and solving 23 | cpd <- dlp(q = target, cList = list(nno1)) 24 | cpd$cps(optctrl) 25 | } 26 | -------------------------------------------------------------------------------- /R/nlfc.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Function for creating 'NLFC' objects 3 | nlfc <- function(G, h){ 4 | return(list(conType = "NLFC", G = as.matrix(G), h = as.matrix(h), dims = nrow(G))) 5 | } 6 | -------------------------------------------------------------------------------- /R/nnoc.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Function for creating 'NNOC' objects 3 | nnoc <- function(G, h){ 4 | return(list(conType = "NNOC", G = as.matrix(G), h = as.matrix(h), dims = nrow(G))) 5 | } 6 | -------------------------------------------------------------------------------- /R/psdc.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Function for creating 'PSDC' objects 3 | psdc <- function(Flist, F0){ 4 | m <- nrow(Flist[[1]]) 5 | G <- do.call("cbind", lapply(Flist, function(x) c(x))) 6 | h <- matrix(drop(F0), ncol = 1) 7 | return(list(conType = "PSDC", G = G, h = h, dims = m)) 8 | } 9 | -------------------------------------------------------------------------------- /R/rp.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Function for risk-parity optimization 3 | ## 4 | rp <- function(x0, P, mrc, optctrl = ctrl()){ 5 | n <- nrow(P) 6 | m <- ncol(P) 7 | if(!identical(n, m)){ 8 | stop("Matrix 'P' must be square.\n") 9 | } 10 | P <- 2 * P 11 | mrc <- as.matrix(mrc) 12 | x0 <- as.matrix(x0) 13 | if(!identical(nrow(mrc), n)){ 14 | stop("Count of marginal risk contributions is not equal to the problem size.\n") 15 | } 16 | if(!identical(nrow(x0), n)){ 17 | stop("Count of start values 'x0' is not equal to the problem size.\n") 18 | } 19 | if(!all.equal(sum(mrc), 1.0)){ 20 | warning("Sum of marginal risk contributions does not equal one: Normalizing risk contributions.\n") 21 | mrc <- mrc / sum(mrc) 22 | } 23 | if(class(optctrl) != "Rcpp_CTRL"){ 24 | stop("Provided argument for 'optctrl' is not a reference class object 'Rcpp_CTRL'.\n") 25 | } 26 | rpp(x0, P, mrc, optctrl) 27 | } 28 | 29 | -------------------------------------------------------------------------------- /R/socc.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Function for creating 'SOCC' objects 3 | socc <- function(F, g, d, f){ 4 | G <- matrix(0, nrow = nrow(F) + 1, ncol = ncol(F)) 5 | G[1, ] <- -d 6 | G[-1, ] <- -F 7 | h <- matrix(c(f, g), ncol = 1) 8 | return(list(conType = "SOCC", G = G, h = h, dims = nrow(G))) 9 | } 10 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | loadModule("CPG", TRUE) 2 | 3 | evalqOnLoad({ 4 | ## 5 | ## show-methods for reference objects 6 | setMethod("show", "Rcpp_CTRL", function(object){ 7 | cat("Control parameters used in optimization:\n\n") 8 | cat(paste("Maximum iterations:\t", object$params$maxiters,"\n")) 9 | cat(paste("Absolute tolerance:\t", object$params$abstol,"\n")) 10 | cat(paste("Relative tolerance:\t", object$params$reltol,"\n")) 11 | cat(paste("Feasible tolerance:\t", object$params$feastol,"\n")) 12 | cat(paste("Tracing progress:\t", object$params$trace,"\n")) 13 | }) 14 | setMethod("show", signature = "Rcpp_DQP", function(object){ 15 | title <- paste("* Definition of Quadratic Program *") 16 | row <- paste(rep("*", nchar(title)), collapse = "") 17 | cat("\n") 18 | cat(row, "\n") 19 | cat(paste(title, "\n")) 20 | cat(row, "\n") 21 | cat("\n") 22 | cat(paste("Count of variables in objective:", ncol(object$P), "\n")) 23 | cat(paste("Count of equality constraints:", nrow(object$A), "\n")) 24 | countcc <- object$cList$K 25 | cat(paste("Count of cone constraints:", countcc, "\n")) 26 | cc <- object$cList$cone 27 | cat("These consist of:\n") 28 | cat(paste("Constraints w.r.t. the nonnegative orthant:", max(0, sum(cc %in% "NNOC")), "\n")) 29 | cat(paste("Constraints w.r.t. the second-order cone:", max(0, sum(cc %in% "SOCC")), "\n")) 30 | cat(paste("Constraints w.r.t. the semidefinite cone:", max(0, sum(cc %in% "PSDC")), "\n")) 31 | cat("\n") 32 | }) 33 | setMethod("show", signature = "Rcpp_DLP", function(object){ 34 | title <- paste("* Definition of Linear Program *") 35 | row <- paste(rep("*", nchar(title)), collapse = "") 36 | cat("\n") 37 | cat(row, "\n") 38 | cat(paste(title, "\n")) 39 | cat(row, "\n") 40 | cat("\n") 41 | cat(paste("Count of variables in objective:", length(object$q), "\n")) 42 | cat(paste("Count of equality constraints:", nrow(object$A), "\n")) 43 | countcc <- object$cList$K 44 | cat(paste("Count of cone constraints:", countcc, "\n")) 45 | cc <- object$cList$cone 46 | cat("These consist of:\n") 47 | cat(paste("Constraints w.r.t. the nonnegative orthant:", max(0, sum(cc %in% "NNOC")), "\n")) 48 | cat(paste("Constraints w.r.t. the second-order cone:", max(0, sum(cc %in% "SOCC")), "\n")) 49 | cat(paste("Constraints w.r.t. the semidefinite cone:", max(0, sum(cc %in% "PSDC")), "\n")) 50 | cat("\n") 51 | }) 52 | setMethod("show", signature = "Rcpp_DNL", function(object){ 53 | title <- paste("* Definition of Linear Program *") 54 | row <- paste(rep("*", nchar(title)), collapse = "") 55 | cat("\n") 56 | cat(row, "\n") 57 | cat(paste(title, "\n")) 58 | cat(row, "\n") 59 | cat("\n") 60 | cat(paste("Count of variables in objective:", length(object$q), "\n")) 61 | cat(paste("Count of equality constraints:", nrow(object$A), "\n")) 62 | countcc <- object$cList$K 63 | cat(paste("Count of constraints:", countcc, "\n")) 64 | cc <- object$cList$cone 65 | cat("These consist of:\n") 66 | cat(paste("Constraints w.r.t. non-linearities:", object$cList$dims[1, 1], "\n")) 67 | cat(paste("Constraints w.r.t. the nonnegative orthant:", max(0, sum(cc %in% "NNOC")), "\n")) 68 | cat(paste("Constraints w.r.t. the second-order cone:", max(0, sum(cc %in% "SOCC")), "\n")) 69 | cat(paste("Constraints w.r.t. the semidefinite cone:", max(0, sum(cc %in% "PSDC")), "\n")) 70 | cat("\n") 71 | }) 72 | setMethod("show", signature = "Rcpp_DCP", function(object){ 73 | title <- paste("* Definition of Convex Program *") 74 | row <- paste(rep("*", nchar(title)), collapse = "") 75 | cat("\n") 76 | cat(row, "\n") 77 | cat(paste(title, "\n")) 78 | cat(row, "\n") 79 | cat("\n") 80 | cat(paste("Count of variables in objective:", nrow(object$x0) - 1L, "\n")) 81 | cat(paste("Count of equality constraints:", nrow(object$A), "\n")) 82 | if(object$cList$dims[1, 1] > 1){ 83 | countcc <- object$cList$K 84 | } else { 85 | countcc <- 0 86 | } 87 | cat(paste("Count of constraints:", countcc, "\n")) 88 | cc <- object$cList$cone 89 | cat("These consist of:\n") 90 | cat(paste("Constraints w.r.t. non-linearities:", object$cList$dims[1, 1] - 1L, "\n")) 91 | cat(paste("Constraints w.r.t. the nonnegative orthant:", max(0, sum(cc %in% "NNOC")), "\n")) 92 | cat(paste("Constraints w.r.t. the second-order cone:", max(0, sum(cc %in% "SOCC")), "\n")) 93 | cat(paste("Constraints w.r.t. the semidefinite cone:", max(0, sum(cc %in% "PSDC")), "\n")) 94 | cat("\n") 95 | }) 96 | setMethod("show", signature = "Rcpp_CPS", function(object){ 97 | title <- "* Solution of Convex Program *" 98 | row <- paste(rep("*", nchar(title)), collapse = "") 99 | cat("\n") 100 | cat(row, "\n") 101 | cat(title, "\n") 102 | cat(row, "\n") 103 | cat("\n") 104 | state <- object$state 105 | cat(paste("Value of primal objective:", signif(state["pobj"]), "\n")) 106 | if(!is.na(state["dobj"])){ 107 | cat(paste("Value of dual objective:", signif(state["dobj"]), "\n")) 108 | } 109 | if(!is.na(state["dgap"])){ 110 | cat(paste("Value of duality gap:", signif(state["dgap"]), "\n")) 111 | } 112 | if(!is.na(state["rdgap"])){ 113 | cat(paste("Value of relative duality gap:", signif(state["rdgap"]), "\n")) 114 | } 115 | if(!is.na(state["certp"])){ 116 | cat(paste("Certificate of primal infeasibility:", signif(state["certp"]), "\n")) 117 | } 118 | if(!is.na(state["certd"])){ 119 | cat(paste("Certificate of dual infeasibility:", signif(state["certd"]), "\n")) 120 | } 121 | if(!is.na(state["pslack"])){ 122 | cat(paste("Value of smallest primal slack:", signif(state["pslack"]), "\n")) 123 | } 124 | if(!is.na(state["dslack"])){ 125 | cat(paste("Value of smallest dual slack:", signif(state["dslack"]), "\n")) 126 | } 127 | cat(paste("Status of solution:", object$status, "\n")) 128 | cat(paste("Count of iterations:", object$niter, "\n\n")) 129 | cat("Solutions are contained in 'PDV'.\n") 130 | cat("Use 'getx()', 'gety()', 'gets()' and 'getz()', respectively.\n") 131 | }) 132 | ## cps-methods 133 | setMethod("cps", signature = c("Rcpp_DLP", "Rcpp_CTRL"), function(cpd, ctrl){ 134 | cpd$cps(ctrl) 135 | }) 136 | ## cps-methods 137 | setMethod("cps", signature = c("Rcpp_DNL", "Rcpp_CTRL"), function(cpd, ctrl){ 138 | cpd$cps(ctrl) 139 | }) 140 | ## cps-methods 141 | setMethod("cps", signature = c("Rcpp_DQP", "Rcpp_CTRL"), function(cpd, ctrl){ 142 | cpd$cps(ctrl) 143 | }) 144 | ## cps-methods 145 | setMethod("cps", signature = c("Rcpp_DCP", "Rcpp_CTRL"), function(cpd, ctrl){ 146 | cpd$cps(ctrl) 147 | }) 148 | ## gets-methods 149 | setMethod("gets", signature = "Rcpp_PDV", function(object){ 150 | object$s 151 | }) 152 | setMethod("gets", signature = "Rcpp_CPS", function(object){ 153 | pdv <- object$pdv 154 | sidx <- object$sidx 155 | if(nrow(sidx) > 1){ 156 | sidx <- sidx + 1 157 | ans <- list() 158 | length(ans) <- nrow(sidx) 159 | for(i in 1:nrow(sidx)){ 160 | ans[[i]] <- pdv$s[sidx[i, 1]:sidx[i, 2], 1] 161 | } 162 | } else { 163 | ans <- gets(pdv) 164 | } 165 | ans 166 | }) 167 | ## getz-methods 168 | setMethod("getz", signature = "Rcpp_PDV", function(object){ 169 | object$z 170 | }) 171 | setMethod("getz", signature = "Rcpp_CPS", function(object){ 172 | pdv <- object$pdv 173 | sidx <- object$sidx 174 | if(nrow(sidx) > 1){ 175 | sidx <- sidx + 1 176 | ans <- list() 177 | length(ans) <- nrow(sidx) 178 | for(i in 1:nrow(sidx)){ 179 | ans[[i]] <- pdv$z[sidx[i, 1]:sidx[i, 2], 1] 180 | } 181 | } else { 182 | ans <- getz(pdv) 183 | } 184 | ans 185 | }) 186 | ## getx-methods 187 | setMethod("getx", signature = "Rcpp_PDV", function(object){ 188 | object$x 189 | }) 190 | setMethod("getx", signature = "Rcpp_CPS", function(object){ 191 | pdv <- object$pdv 192 | getx(pdv) 193 | }) 194 | ## gety-methods 195 | setMethod("gety", signature = "Rcpp_PDV", function(object){ 196 | object$y 197 | }) 198 | setMethod("gety", signature = "Rcpp_CPS", function(object){ 199 | pdv <- object$pdv 200 | gety(pdv) 201 | }) 202 | ## other get-methods for Rcpp_CPS 203 | setMethod("getstatus", signature = "Rcpp_CPS", function(object){ 204 | object$status 205 | }) 206 | setMethod("getstate", signature = "Rcpp_CPS", function(object){ 207 | object$state 208 | }) 209 | setMethod("getniter", signature = "Rcpp_CPS", function(object){ 210 | object$niter 211 | }) 212 | setMethod("getparams", signature = "Rcpp_CTRL", function(object){ 213 | object$params 214 | }) 215 | 216 | }) 217 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # R Package 'cccp' 2 | 3 | Routines for solving convex optimization problems with cone 4 | constraints by means of interior-point methods. The implemented 5 | algorithms are partially ported from [CVXOPT](http://cvxopt.org), a 6 | Python module for convex optimization. 7 | -------------------------------------------------------------------------------- /demo/00Index: -------------------------------------------------------------------------------- 1 | ACNT Analytic center with equality constraints 2 | FPLN Floor Planning: linear objective with non-linear constraints 3 | GP Geometric Program 4 | LPIC Solving Linear Program with linear inequality constraints 5 | LPCC Solving Linear Program with NNO, SOC and PSD constraints 6 | L1 Solving L1-norm approximation by means of LP 7 | QPUC Solving an unconstrained Quadratic Program 8 | QPEC Solving an equality constrained Quadratic Program 9 | QPIC Solving a Quadratic Program with equality and inequality constraints 10 | QPQC Solving a Quadratic Program with quadratic (SOC) constraints 11 | SOCP SOCP with two second-order cone constraints 12 | SDP SDP with two positive semidefinite cone constraints 13 | 14 | 15 | 16 | 17 | -------------------------------------------------------------------------------- /demo/ACNT.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Demo for solving an analytic centering problem with equality constraints 3 | ## (Example taken from cvxopt's userguide) 4 | ## 5 | if(requireNamespace("numDeriv", quietly = TRUE)){ 6 | ## Creating objective, gradient and Hessian 7 | f0 <- function(x) -sum(log(x)) 8 | g0 <- function(x, func = f0) numDeriv::grad(func = func, x = x) 9 | h0 <- function(x, func = f0) numDeriv::hessian(func = func, x = x) 10 | ## equality constraint 11 | A <- matrix(c(1, 1, 2), nrow = 1) 12 | b <- matrix(1, nrow = 1) 13 | ## initial (feasible!) point 14 | x0 = c(0.25, 0.25, 0.25) 15 | ## solving problem 16 | ans <- cccp(x0 = x0, f0 = f0, g0 = g0, h0 = h0, A = A, b = b) 17 | ans 18 | getx(ans) 19 | } 20 | -------------------------------------------------------------------------------- /demo/FPLN.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Floor Planning 3 | ## Demo for solving a linear objective with nonlinear constraints 4 | ## (Example taken from cvxopt's userguide) 5 | ## 6 | if(requireNamespace("numDeriv", quietly = TRUE)){ 7 | ## Creating objective 8 | q <- c(rep(1, 2), rep(0, 20)) 9 | xnames <- c("W", "H", 10 | paste("x", 1:5, sep = ""), 11 | paste("y", 1:5, sep = ""), 12 | paste("w", 1:5, sep = ""), 13 | paste("h", 1:5, sep = "") 14 | ) 15 | ## Fixed constants 16 | gamma <- 5.0 17 | rho <- 1.0 18 | Amin <- 100 19 | ## Inequality constraints 20 | G <- matrix(0.0, nrow = 26, ncol = 22) 21 | h <- matrix(0.0, nrow = 26, ncol = 1) 22 | G[1, 3] <- -1.0 ## -x1 <= 0 23 | G[2, 4] <- -1.0 ## -x2 <= 0 24 | G[3, 6] <- -1.0 ## -x4 <= 0 25 | G[4, c(3, 5, 13)] <- c(1.0, -1.0, 1.0) ## x1 - x3 + w1 <= -rho 26 | h[4, 1] <- -rho 27 | G[5, c(4, 5, 14)] <- c(1.0, -1.0, 1.0) ## x2 - x3 + w2 <= -rho 28 | h[5, 1] <- -rho 29 | G[6, c(5, 7, 15)] <- c(1.0, -1.0, 1.0) ## x3 - x5 + w3 <= -rho 30 | h[6, 1] <- -rho 31 | G[7, c(6, 7, 16)] <- c(1.0, -1.0, 1.0) ## x4 - x5 + w4 <= -rho 32 | h[7, 1] <- -rho 33 | G[8, c(1, 7, 17)] <- c(-1.0, 1.0, 1.0) ## -W + x5 + w5 <= 0 34 | G[9, 9] <- -1.0 ## -y2 <= 0 35 | G[10, 10] <- -1.0 ## -y3 <= 0 36 | G[11, 12] <- -1.0 ## -y5 <= 0 37 | G[12, c(8, 9, 19)] <- c(-1.0, 1.0, 1.0) ## -y1 + y2 + h2 <= -rho 38 | h[12, 1] <- -rho 39 | G[13, c(8, 11, 18)] <- c(1.0, -1.0, 1.0) ## y1 - y4 + h1 <= -rho 40 | h[13, 1] <- -rho 41 | G[14, c(10, 11, 20)] <- c(1.0, -1.0, 1.0) ## y3 - y4 + h3 <= -rho 42 | h[14, 1] <- -rho 43 | G[15, c(2, 11, 21)] <- c(-1.0, 1.0, 1.0) ## -H + y4 + h4 <= 0 44 | G[16, c(2, 12, 22)] <- c(-1.0, 1.0, 1.0) ## -H + y5 + h5 <= 0 45 | G[17, c(13, 18)] <- c(-1.0, 1.0 / gamma) ## -w1 + h1/gamma <= 0 46 | G[18, c(13, 18)] <- c(1.0, -gamma) ## w1 - gamma * h1 <= 0 47 | G[19, c(14, 19)] <- c(-1.0, 1.0 / gamma) ## -w2 + h2/gamma <= 0 48 | G[20, c(14, 19)] <- c(1.0, -gamma) ## w2 - gamma * h2 <= 0 49 | G[21, c(15, 19)] <- c(-1.0, 1.0 / gamma) ## -w3 + h3/gamma <= 0 50 | G[22, c(15, 20)] <- c(1.0, -gamma) ## w3 - gamma * h3 <= 0 51 | G[23, c(16, 20)] <- c(-1.0, 1.0 / gamma) ## -w4 + h4/gamma <= 0 52 | G[24, c(16, 21)] <- c(1.0, -gamma) ## w4 - gamma * h4 <= 0 53 | G[25, c(16, 21)] <- c(-1.0, 1.0 / gamma) ## -w5 + h5/gamma <= 0 54 | G[26, c(17, 22)] <- c(1.0, -gamma) ## w5 - gamma * h5 <= 0 55 | nno1 <- nnoc(G = G, h = h) 56 | ## Nonlinear constraints 57 | f1 <- function(x) -x[13] + Amin / x[18] 58 | f2 <- function(x) -x[14] + Amin / x[19] 59 | f3 <- function(x) -x[15] + Amin / x[20] 60 | f4 <- function(x) -x[16] + Amin / x[21] 61 | f5 <- function(x) -x[17] + Amin / x[22] 62 | ## Gradient functions 63 | g1 <- function(x, func = f1) numDeriv::grad(func = func, x = x) 64 | g2 <- function(x, func = f2) numDeriv::grad(func = func, x = x) 65 | g3 <- function(x, func = f3) numDeriv::grad(func = func, x = x) 66 | g4 <- function(x, func = f4) numDeriv::grad(func = func, x = x) 67 | g5 <- function(x, func = f5) numDeriv::grad(func = func, x = x) 68 | ## Hessian functions 69 | h1 <- function(x, func = f1) numDeriv::hessian(func = func, x = x) 70 | h2 <- function(x, func = f2) numDeriv::hessian(func = func, x = x) 71 | h3 <- function(x, func = f3) numDeriv::hessian(func = func, x = x) 72 | h4 <- function(x, func = f4) numDeriv::hessian(func = func, x = x) 73 | h5 <- function(x, func = f5) numDeriv::hessian(func = func, x = x) 74 | ## Initial value 75 | x0 <- rep(1, 22) 76 | ## Invoking 'cccp' 77 | ans <- cccp(q = q, cList = list(nno1), x0 = x0, 78 | nlfList = list(f1, f2, f3, f4, f5), 79 | nlgList = list(g1, g2, g3, g4, g5), 80 | nlhList = list(h1, h2, h3, h4, h5)) 81 | xsol <- getx(ans) 82 | names(xsol) <- xnames 83 | xsol 84 | ## Plotting floor plan 85 | plot(c(0, xsol["W"]), c(0, xsol["H"]), type = "n", xlab = "", ylab = "", 86 | main = "Floor Planning") 87 | for(i in 1:5){ 88 | rect(xleft = xsol[i + 2], 89 | ybottom = xsol[i + 7], 90 | xright = xsol[i + 2] + xsol[i + 12], 91 | ytop = xsol[i + 7] + + xsol[i + 17], 92 | col = "gray", border = "black", lty = 1, lwd = 1) 93 | text(x = c(xsol[i + 2] + xsol[i + 12] / 2), 94 | y = c(xsol[i + 7] + + xsol[i + 17] / 2), labels = i) 95 | } 96 | } 97 | -------------------------------------------------------------------------------- /demo/GP.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Demo for geometric program 3 | ## Example taken from: 4 | ## Beightler, C.S. and D.T. Phillips, Applied Geometric Programming, 5 | ## John Wiley and Sons, New York, NY, 1976. 6 | ## 7 | ## GP formulation: 8 | ## F0 = 0.44 * x_1^3 * x_2^-2 + 10 * x_1^-1 + 0.592 * x_1 * x_2^-3 9 | ## F1 = 8.62 * x_^1^-1 * x_2^3 <= 1.0 ; x_1, x_2 > 0 10 | ## 11 | ## Creating Problem 12 | F0 <- matrix(c(3, -2, -1, 0, 1, -3), nrow = 3, ncol = 2, byrow = TRUE) 13 | g0 <- log(c(0.44, 10, 0.592)) 14 | F1 <- matrix(c(-1, 3), nrow = 1, ncol = 2, byrow = TRUE) 15 | g1 <- log(8.62) 16 | ans <- gp(F0, g0, FList = list(F1), gList = list(g1)) 17 | ans 18 | -------------------------------------------------------------------------------- /demo/L1.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Demo for solving a L1-norm approximation by means of a Linear Programs 3 | ## (Example taken from cvxopt's userguide) 4 | ## 5 | ## Creating Problem 6 | set.seed(12345) 7 | n <- 10 8 | m <- 20 9 | P <- matrix(rnorm(m * n), nrow = m, ncol = n) 10 | q <- rnorm(m) 11 | ## Solving problem by calling wrapper-function to LP 12 | ans <- l1norm(P = P, q = q, optctrl = ctrl()) 13 | ans 14 | getx(ans)[1:n] 15 | -------------------------------------------------------------------------------- /demo/LPCC.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Demo for solving a Linear Program with NNO, SOC and PSD constraints 3 | ## (Example taken from cvxopt's userguide) 4 | ## 5 | ## Creating LP 6 | q <- c(-6, -4, -5) 7 | ## NNO constraint 8 | G <- matrix(c(16, -14, 5, 9 | 7, 2, 0), 10 | nrow = 2, ncol = 3, byrow = TRUE) 11 | h <- c(-3, 5) 12 | nno1 <- nnoc(G = G, h = h) 13 | ## SOC constraint 14 | F1 <- matrix(c(8, 13, -12, 15 | -8, 18, 6, 16 | 1, -3, -17), 17 | nrow = 3, ncol = 3, byrow = TRUE) 18 | g1 <- c(-2, -14, -13) 19 | d1 <- c(-24, -7, 15) 20 | f1 <- 12 21 | soc1 <- socc(F = F1, g = g1, d = d1, f = f1) 22 | ## PSD constraint 23 | F1 <- matrix(c(7, -5, 1, 24 | -5, 1, -7, 25 | 1, -7, -4), 26 | nrow = 3, ncol = 3, byrow = TRUE) 27 | F2 <- matrix(c(3, 13, -6, 28 | 13, 12, -10, 29 | -6, -10, -28), 30 | nrow = 3, ncol = 3, byrow = TRUE) 31 | F3 <- matrix(c(9, 6, -6, 32 | 6, -7, -7, 33 | -6, -7, -11), 34 | nrow = 3, ncol = 3, byrow = TRUE) 35 | F0 <- matrix(c(68, -30, -19, 36 | -30, 99, 23, 37 | -19, 23, 10), 38 | nrow = 3, ncol = 3, byrow = TRUE) 39 | psd1 <- psdc(Flist = list(F1, F2, F3), F0 = F0) 40 | ## Using main function of package 41 | ans <- cccp(q = q, cList = list(nno1, soc1, psd1)) 42 | ans 43 | getx(ans) 44 | -------------------------------------------------------------------------------- /demo/LPIC.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Demo for solving a Linear Programs with (linear) inequality constraints 3 | ## (Example taken from cvxopt's userguide) 4 | ## 5 | ## First example 6 | ## Creating LP 7 | q <- c(-4, -5) 8 | G <- matrix(c(2, 1, -1, 0, 9 | 1, 2, 0, -1), 10 | nrow = 4, ncol = 2) 11 | h <- c(3, 3, 0, 0) 12 | nno1 <- nnoc(G = G, h = h) 13 | ## Using main function of package 14 | ans <- cccp(q = q, cList = list(nno1), optctrl = ctrl()) 15 | ans 16 | getx(ans) 17 | ## Second example 18 | ## Creating LP 19 | q <- c(2, 1) 20 | ## linear constraints 21 | G <- matrix(c(-1, 1, 22 | -1, -1, 23 | 0, -1, 24 | 1, -2), 25 | nrow = 4, ncol = 2, byrow = TRUE) 26 | h <- matrix(c(1, -2, 0, 4)) 27 | nno1 <- nnoc(G = G, h = h) 28 | ans <- cccp(q = q, cList = list(nno1)) 29 | ans 30 | getx(ans) 31 | -------------------------------------------------------------------------------- /demo/QPEC.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Demo for solving an unconstrained QP 3 | ## 4 | ## Creating objects for QP 5 | P <- 2 * matrix(c(2, .5, .5, 1), nrow = 2, ncol = 2) 6 | q <- c(1.0, 1.0) 7 | A <- matrix(c(1.0, 1.0), nrow = 1, ncol = 2) 8 | b <- 1.0 9 | ## Solving QP 10 | ans <- cccp(P = P, q = q, A = A, b = b) 11 | ans 12 | getx(ans) 13 | -------------------------------------------------------------------------------- /demo/QPIC.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Demo for solving a QP with equality and inequality constraints 3 | ## (Example taken from cvxopt's userguide) 4 | ## 5 | ## Creating QP 6 | P <- 2 * matrix(c(2, .5, .5, 1), nrow = 2, ncol = 2) 7 | q <- c(1.0, 1.0) 8 | G <- -diag(2) 9 | h <- rep(0, 2) 10 | nno1 <- nnoc(G = G, h = h) 11 | A <- matrix(c(1.0, 1.0), nrow = 1, ncol = 2) 12 | b <- 1.0 13 | ## Solving QP 14 | ans <- cccp(P = P, q = q, A = A, b = b, cList = list(nno1)) 15 | ans 16 | getx(ans) 17 | -------------------------------------------------------------------------------- /demo/QPQC.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Demo for solving a constrained Least-Squares Problem: 3 | ## A quadratic program with second-order cone constraint 4 | ## (Example taken from cvxopt's userguide) 5 | ## 6 | ## Creating QP 7 | adat <- c(0.3, -0.4, -0.2, -0.4, 1.3, 8 | 0.6, 1.2, -1.7, 0.3, -0.3, 9 | -0.3, 0.0, 0.6, -1.2, -2.0) 10 | A <- matrix(adat, nrow = 5, ncol = 3) 11 | b <- c(1.5, 0.0, -1.2, -0.7, 0.0) 12 | P <- crossprod(A) 13 | q <- -crossprod(A, b) 14 | G = -diag(3) 15 | h = rep(0, 3) 16 | nno1 <- nnoc(G = G, h = h) 17 | F = diag(3) 18 | g = rep(0, 3) 19 | d = rep(0, 3) 20 | f = 1 21 | soc1 <- socc(F = F, g = g, d = d, f = f) 22 | ## Solving QP 23 | ans <- cccp(P = P, q = q, cList = list(nno1, soc1)) 24 | ans 25 | x <- getx(ans) 26 | round(sqrt(sum(x^2))) 27 | -------------------------------------------------------------------------------- /demo/QPUC.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Demo for solving an unconstrained QP 3 | ## 4 | ## Creating objects for QP 5 | n <- 4L 6 | M <- matrix(rnorm(n^2), nrow = n, ncol = n) 7 | P <- crossprod(M) 8 | q <- rnorm(n) 9 | ## Solving QP 10 | ans <- cccp(P = P, q = q) 11 | ans 12 | getx(ans) 13 | -------------------------------------------------------------------------------- /demo/SDP.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Demo for solving a SDP with two PSD cone constraints 3 | ## (Example taken from cvxopt's userguide) 4 | ## 5 | ## Creating SDP 6 | ## Objective 7 | q <- c(1, -1, 1) 8 | ## First PSD cone constraint 9 | F1 <- matrix(c(-7, -11, -11, 3), nrow = 2, ncol = 2) 10 | F2 <- matrix(c(7, -18, -18, 8), nrow = 2, ncol = 2) 11 | F3 <- matrix(c(-2, -8, -8, 1), nrow = 2, ncol = 2) 12 | F0 <- matrix(c(33, -9, -9, 26), nrow = 2, ncol = 2) 13 | psd1 <- psdc(Flist = list(F1, F2, F3), F0 = F0) 14 | ## Second PSD cone constraint 15 | F1 <- matrix(c(-21, -11, 0, -11, 10, 8, 0, 8, 5), nrow = 3, ncol = 3) 16 | F2 <- matrix(c(0, 10, 16, 10, -10, -10, 16, -10, 3), nrow = 3, ncol = 3) 17 | F3 <- matrix(c(-5, 2, -17, 2, -6, 8, -17, 8, 6), nrow = 3, ncol = 3) 18 | F0 <- matrix(c(14, 9, 40, 9, 91, 10, 40, 10, 15), nrow = 3, ncol = 3) 19 | psd2 <- psdc(Flist = list(F1, F2, F3), F0 = F0) 20 | ## Using main function of package 21 | ans <- cccp(q = q, cList = list(psd1, psd2)) 22 | ans 23 | getx(ans) 24 | -------------------------------------------------------------------------------- /demo/SOCP.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Demo for solving a SOCP with two second-order cone constraints 3 | ## (Example taken from cvxopt's userguide) 4 | ## 5 | ## Creating SOCP 6 | ## Objective 7 | q <- c(-2, 1, 5) 8 | ## First SOC 9 | F1 <- matrix(c(-13, 3, 5, 10 | -12, 12, -6), 11 | nrow = 2, ncol = 3, byrow = TRUE) 12 | g1 <- c(-3, -2) 13 | d1 <- c(-12, -6, 5) 14 | f1 <- -12 15 | soc1 <- socc(F = F1, g = g1, d = d1, f = f1) 16 | ## Second SOC 17 | F2 <- matrix(c(-3, 6, 2, 18 | 1, 9, 2, 19 | -1, -19, 3), 20 | nrow = 3, ncol = 3, byrow = TRUE) 21 | g2 <- c(0, 3, -42) 22 | d2 <- c(-3, 6, -10) 23 | f2 <- 27 24 | soc2 <- socc(F = F2, g = g2, d = d2, f = f2) 25 | ## Using main function of package 26 | ctl <- ctrl(feastol = 1e-5) 27 | ans <- cccp(q = q, cList = list(soc1, soc2), optctrl = ctl) 28 | ans 29 | getx(ans) 30 | -------------------------------------------------------------------------------- /inst/include/CPG.h: -------------------------------------------------------------------------------- 1 | #ifndef REFC_H 2 | #define REFC_H 3 | #include 4 | #endif 5 | // forward declarations and helping module classes 6 | RCPP_EXPOSED_CLASS(CTRL) 7 | RCPP_EXPOSED_CLASS(CONEC) 8 | RCPP_EXPOSED_CLASS(PDV) 9 | RCPP_EXPOSED_CLASS(DQP) 10 | RCPP_EXPOSED_CLASS(DLP) 11 | RCPP_EXPOSED_CLASS(DNL) 12 | RCPP_EXPOSED_CLASS(DCP) 13 | RCPP_EXPOSED_CLASS(CPS) 14 | 15 | #ifndef ARMA_H 16 | #define ARMA_H 17 | #include 18 | #endif 19 | using namespace arma; 20 | 21 | /* 22 | * Class definition and methods for controlling optimization routines 23 | */ 24 | class CTRL { 25 | public: 26 | // constructors 27 | CTRL(): params(Rcpp::List::create()) {} 28 | CTRL(Rcpp::List params_): params(params_){} 29 | // members 30 | Rcpp::List get_params() {return params;} 31 | void set_params(Rcpp::List params_) {params = params_;} 32 | Rcpp::List params; 33 | }; 34 | 35 | /* 36 | * Class definition for inequality (cone) constraints 37 | */ 38 | class CONEC { 39 | public: 40 | CONEC() : cone(std::vector()), G(mat()), 41 | h(mat()), sidx(umat()), dims(uvec()), K(0), n(0) {} 42 | CONEC(std::vector cone_, mat G_, mat h_, umat sidx_, uvec dims_, int K_, int n_): 43 | cone(cone_), G(G_), h(h_), sidx(sidx_), dims(dims_), K(K_), n(n_){} 44 | CONEC(int n_): cone(std::vector()), G(mat()), 45 | h(mat()), sidx(umat()), dims(uvec()), K(0), n(n_){} 46 | // members 47 | std::vector get_cone() {return cone;} 48 | void set_cone(std::vector cone_) {cone = cone_;} 49 | mat get_G() {return G;} 50 | void set_G(mat G_) {G = G_;} 51 | mat get_h() {return h;} 52 | void set_h(mat h_) {h = h_;} 53 | umat get_sidx() {return sidx;} 54 | void set_sidx(umat sidx_) {sidx = sidx_;} 55 | uvec get_dims() {return dims;} 56 | void set_dims(uvec dims_) {dims = dims_;} 57 | int get_K() {return K;} 58 | void set_K(int K_) {K = K_;} 59 | int get_n() {return n;} 60 | void set_n(int n_) {n = n_;} 61 | 62 | friend class DCP; 63 | friend class DLP; 64 | friend class DNL; 65 | friend class DQP; 66 | friend CPS* rpp(mat x0, mat P, mat mrc, CTRL& ctrl); 67 | friend CPS* gpp(std::vector FList, std::vector gList, CONEC& cList, mat A, mat b, CTRL& ctrl); 68 | 69 | double snrm2(mat s); 70 | vec sdot(mat s, mat z); 71 | vec smss(mat u); 72 | mat sone(); 73 | mat sprd(mat s, mat z); 74 | mat sinv(mat s, mat z); 75 | mat sams1(mat u, double alpha); 76 | mat sslb(mat s, mat lambda, bool invers); 77 | mat ssnt(mat s, std::vector > WList, 78 | bool invers, bool transp); 79 | mat getLambda(std::vector > WList); 80 | mat gwwg(std::vector > WList); 81 | mat gwwz(std::vector > WList, mat z); 82 | mat SorZupdate(mat SorZ, mat Lambda, double step); 83 | PDV* initpdv(int p); 84 | std::vector > initnts(); 85 | std::vector > ntsc(mat s, mat z); 86 | std::vector > 87 | ntsu(mat s, mat z, 88 | std::vector > WList); 89 | 90 | private: 91 | std::vector cone; 92 | mat G; 93 | mat h; 94 | umat sidx; 95 | uvec dims; 96 | int K; 97 | int n; 98 | }; 99 | /* 100 | * Class for definition of Quadratic programs 101 | */ 102 | class DQP { 103 | public: 104 | 105 | // constructors 106 | DQP() : P(mat()), q(vec()), A(mat()), b(vec()), cList(CONEC()) {} 107 | DQP(mat P_, vec q_, mat A_, vec b_, CONEC cList_): 108 | P(P_), q(q_), A(A_), b(b_), cList(cList_) {} 109 | // members 110 | mat get_P() {return P;} 111 | void set_P(mat P_) {P = P_;} 112 | vec get_q() {return q;} 113 | void set_q(vec q_) {q = q_;} 114 | mat get_A() {return A;} 115 | void set_A(mat A_) {A = A_;} 116 | vec get_b() {return b;} 117 | void set_b(vec b_) {b = b_;} 118 | CONEC get_cList() {return cList;} 119 | void set_cList(CONEC cList_) {cList = cList_;} 120 | 121 | double pobj(PDV& pdv); 122 | double dobj(PDV& pdv); 123 | double certp(PDV& pdv); 124 | double certd(PDV& pdv); 125 | mat rprim(PDV& pdv); 126 | mat rcent(PDV& pdv); 127 | mat rdual(PDV& pdv); 128 | PDV* sxyz(PDV* pdv, mat LHS, mat RHS, 129 | std::vector > WList); 130 | CPS* cps(CTRL& ctrl); 131 | 132 | private: 133 | mat P; 134 | vec q; 135 | mat A; 136 | vec b; 137 | CONEC cList; 138 | }; 139 | 140 | /* 141 | * Class for definition of Linear programs 142 | */ 143 | class DLP { 144 | public: 145 | 146 | // constructors 147 | DLP() : q(vec()), A(mat()), b(vec()), cList(CONEC()) {} 148 | DLP(vec q_, mat A_, vec b_, CONEC cList_): 149 | q(q_), A(A_), b(b_), cList(cList_) {} 150 | // members 151 | vec get_q() {return q;} 152 | void set_q(vec q_) {q = q_;} 153 | mat get_A() {return A;} 154 | void set_A(mat A_) {A = A_;} 155 | vec get_b() {return b;} 156 | void set_b(vec b_) {b = b_;} 157 | CONEC get_cList() {return cList;} 158 | void set_cList(CONEC cList_) {cList = cList_;} 159 | 160 | double pobj(PDV& pdv); 161 | double dobj(PDV& pdv); 162 | double certp(PDV& pdv); 163 | double certd(PDV& pdv); 164 | mat rprim(PDV& pdv); 165 | mat rcent(PDV& pdv); 166 | mat rdual(PDV& pdv); 167 | PDV* sxyz(PDV* pdv, mat LHS, mat RHS, 168 | std::vector > WList); 169 | CPS* cps(CTRL& ctrl); 170 | 171 | private: 172 | vec q; 173 | mat A; 174 | vec b; 175 | CONEC cList; 176 | }; 177 | 178 | /* 179 | * Class for definition of Linear programs with non-linear constraints 180 | */ 181 | class DNL { 182 | public: 183 | 184 | // constructors 185 | DNL() : q(vec()), A(mat()), b(vec()), cList(CONEC()), x0(mat()), 186 | nList(Rcpp::List::create()) {} 187 | DNL(vec q_, mat A_, vec b_, CONEC cList_, mat x0_, Rcpp::List nList_): 188 | q(q_), A(A_), b(b_), cList(cList_), x0(x0_), nList(nList_) {} 189 | // members 190 | vec get_q() {return q;} 191 | void set_q(vec q_) {q = q_;} 192 | mat get_A() {return A;} 193 | void set_A(mat A_) {A = A_;} 194 | vec get_b() {return b;} 195 | void set_b(vec b_) {b = b_;} 196 | CONEC get_cList() {return cList;} 197 | void set_cList(CONEC cList_) {cList = cList_;} 198 | mat get_x0() {return x0;} 199 | void set_x0(mat x0_) {x0 = x0_;} 200 | Rcpp::List get_nList() {return nList;} 201 | void set_nList(Rcpp::List nList_) {nList = nList_;} 202 | 203 | double pobj(PDV& pdv); 204 | double dobj(PDV& pdv); 205 | double certp(PDV& pdv); 206 | double certd(PDV& pdv); 207 | mat rprim(PDV& pdv); 208 | mat rcent(PDV& pdv); 209 | mat rdual(PDV& pdv); 210 | PDV* sxyz(PDV* pdv, mat LHS, mat RHS, 211 | std::vector > WList); 212 | CPS* cps(CTRL& ctrl); 213 | 214 | private: 215 | vec q; 216 | mat A; 217 | vec b; 218 | CONEC cList; 219 | mat x0; 220 | Rcpp::List nList; 221 | }; 222 | 223 | 224 | /* 225 | * Class for definition of convex programs with non-linear constraints 226 | */ 227 | class DCP { 228 | public: 229 | 230 | // constructors 231 | DCP() : x0(mat()), cList(CONEC()), nList(Rcpp::List::create()), 232 | A(mat()), b(vec()) {} 233 | DCP(mat x0_, CONEC cList_, Rcpp::List nList_, mat A_, vec b_): 234 | x0(x0_), cList(cList_), nList(nList_), A(A_), b(b_) {} 235 | // members 236 | mat get_x0() {return x0;} 237 | void set_x0(mat x0_) {x0 = x0_;} 238 | CONEC get_cList() {return cList;} 239 | void set_cList(CONEC cList_) {cList = cList_;} 240 | Rcpp::List get_nList() {return nList;} 241 | void set_nList(Rcpp::List nList_) {nList = nList_;} 242 | mat get_A() {return A;} 243 | void set_A(mat A_) {A = A_;} 244 | vec get_b() {return b;} 245 | void set_b(vec b_) {b = b_;} 246 | 247 | double pobj(PDV& pdv); 248 | double dobj(PDV& pdv); 249 | double certp(PDV& pdv); 250 | double certd(PDV& pdv); 251 | mat rprim(PDV& pdv); 252 | mat rcent(PDV& pdv); 253 | mat rdual(PDV& pdv); 254 | PDV* sxyz(PDV* pdv, mat LHS, 255 | std::vector > WList); 256 | CPS* cps(CTRL& ctrl); 257 | 258 | private: 259 | mat x0; 260 | CONEC cList; 261 | Rcpp::List nList; 262 | mat A; 263 | vec b; 264 | }; 265 | 266 | 267 | /* 268 | * Class definition for primal/dual variables 269 | */ 270 | class PDV { 271 | public: 272 | 273 | // constructors 274 | PDV() : x(mat()), y(mat()), s(mat()), z(mat()), kappa(1.0), tau(1.0) {} 275 | PDV(mat x_, mat y_, mat s_, mat z_, double kappa_, double tau_): 276 | x(x_), y(y_), s(s_), z(z_), kappa(kappa_), tau(tau_) {} 277 | 278 | // members 279 | mat get_x() {return x;} 280 | void set_x(mat x_) {x = x_;} 281 | mat get_y() {return y;} 282 | void set_y(mat y_) {y = y_;} 283 | mat get_s() {return s;} 284 | void set_s(mat s_) {s = s_;} 285 | mat get_z() {return z;} 286 | void set_z(mat z_) {z = z_;} 287 | double get_kappa() {return kappa;} 288 | void set_kappa(double kappa_) {kappa = kappa_;} 289 | double get_tau() {return tau;} 290 | void set_tau(double tau_) {tau = tau_;} 291 | 292 | friend class DCP; 293 | friend class DLP; 294 | friend class DNL; 295 | friend class DQP; 296 | friend class CONEC; 297 | friend CPS* rpp(mat x0, mat P, mat mrc, CTRL& ctrl); 298 | friend CPS* gpp(std::vector FList, std::vector gList, CONEC& cList, mat A, mat b, CTRL& ctrl); 299 | 300 | private: 301 | mat x; 302 | mat y; 303 | mat s; 304 | mat z; 305 | double kappa; 306 | double tau; 307 | }; 308 | 309 | /* 310 | * Class for solution of convex programs 311 | */ 312 | class CPS { 313 | public: 314 | 315 | // constructors 316 | CPS() : pdv(PDV()), state(Rcpp::NumericVector::create()), 317 | status("unknown"), niter(0), sidx(umat()) 318 | { 319 | state["pobj"] = NA_REAL; 320 | state["dobj"] = NA_REAL; 321 | state["dgap"] = NA_REAL; 322 | state["rdgap"] = NA_REAL; 323 | state["certp"] = NA_REAL; 324 | state["certd"] = NA_REAL; 325 | state["pslack"] = NA_REAL; 326 | state["dslack"] = NA_REAL; 327 | status = "unknown"; 328 | } 329 | CPS(PDV pdv_, Rcpp::NumericVector state_, Rcpp::String status_, 330 | int niter_, umat sidx_): 331 | pdv(pdv_), state(state_), status(status_), niter(niter_) , sidx(sidx_){} 332 | // members 333 | PDV get_pdv() {return pdv;} 334 | void set_pdv(PDV pdv_) {pdv = pdv_;} 335 | Rcpp::NumericVector get_state() {return state;} 336 | void set_state(Rcpp::NumericVector state_) {state = state_;} 337 | Rcpp::String get_status() {return status;} 338 | void set_status(Rcpp::String status_) {status = status_;} 339 | int get_niter() {return niter;} 340 | void set_niter(int niter_) {niter = niter_;} 341 | umat get_sidx() {return sidx;} 342 | void set_sidx(umat sidx_) {sidx = sidx_;} 343 | 344 | PDV pdv; 345 | 346 | private: 347 | Rcpp::NumericVector state; 348 | Rcpp::String status; 349 | int niter; 350 | umat sidx; 351 | }; 352 | 353 | // Function for solving risk parity portfolios 354 | CPS* rpp(mat x0, mat P, mat mrc, CTRL& ctrl); 355 | // Function for solving geometric programs 356 | CPS* gpp(std::vector FList, std::vector gList, CONEC& cList, mat A, mat b, CTRL& ctrl); 357 | -------------------------------------------------------------------------------- /inst/include/cccp.h: -------------------------------------------------------------------------------- 1 | /* 2 | * 3 | * Header file for package cccp3 4 | * 5 | */ 6 | #ifndef CCCP3_H 7 | #define CCCP3_H 8 | 9 | #ifndef ARMA_H 10 | #define ARMA_H 11 | #include 12 | #endif 13 | using namespace arma; 14 | 15 | double sdot_nlp(mat s, mat z); 16 | double sdot_s(mat s, mat z, int m); 17 | double jdot_p(mat s, mat z); 18 | double snrm2_nlp(mat s); 19 | double snrm2_s(mat s, int m); 20 | double jnrm2_p(mat s); 21 | mat sprd_nl(mat s, mat z); 22 | mat sprd_p(mat s, mat z); 23 | mat sprd_s(mat s, mat z, int m); 24 | mat sone_nl(int m); 25 | mat sone_p(int m); 26 | mat sone_s(int m); 27 | mat sinv_nl(mat s, mat z); 28 | mat sinv_p(mat s, mat z); 29 | mat sinv_s(mat s, mat z, int m); 30 | double smss_nl(mat s); 31 | double smss_p(mat s); 32 | double smss_s(mat s, int m); 33 | mat sams1_nl(mat s, double alpha); 34 | mat sams1_p(mat s, double alpha); 35 | mat sams1_s(mat s, double alpha, int m); 36 | mat sams2_nl(mat s, double alpha); 37 | mat sams2_p(mat s, double alpha); 38 | mat sams2_s(mat s, double alpha, mat lambda, vec sigma, int m); 39 | std::map ntsc_n(mat s, mat z); 40 | std::map ntsc_l(mat s, mat z); 41 | std::map ntsc_p(mat s, mat z); 42 | std::map ntsc_s(mat s, mat z, int m); 43 | std::map ntsu_n(std::map W, mat s, mat z); 44 | std::map ntsu_l(std::map W, mat s, mat z); 45 | std::map ntsu_p(std::map W, mat s, mat z); 46 | std::map ntsu_s(std::map W, mat s, mat z, int m); 47 | mat sslb_nl(mat s, mat lambda, bool invers); 48 | mat sslb_p(mat s, mat lambda, bool invers); 49 | mat sslb_s(mat s, mat lambda, bool invers, int m); 50 | mat ssnt_n(mat s, std::map W, bool invers); 51 | mat ssnt_l(mat s, std::map W, bool invers); 52 | mat ssnt_p(mat s, std::map W, bool invers); 53 | mat ssnt_s(mat s, std::map W, bool invers, bool transp); 54 | double feval(mat x, Rcpp::Function Rf); 55 | vec geval(mat x, Rcpp::Function Rf); 56 | mat heval(mat x, Rcpp::Function Rf); 57 | 58 | // Objective, Gradient and Hessian functions for risk parity 59 | double rpp_f0(mat x, mat P, mat mrc); 60 | mat rpp_g0(mat x, mat P, mat mrc); 61 | mat rpp_h0(mat x, mat P, mat mrc); 62 | 63 | // Function value, Gradient and Hessian for geometric programs 64 | std::vector fgp(mat x, mat F, mat g); 65 | 66 | #include "CPG.h" 67 | 68 | #endif 69 | -------------------------------------------------------------------------------- /inst/unitTests/runTests.R: -------------------------------------------------------------------------------- 1 | pkg <- "cccp" 2 | 3 | if(require("RUnit", quietly = TRUE)) 4 | { 5 | 6 | library(package=pkg, character.only = TRUE) 7 | if(!(exists("path") && file.exists(path))) 8 | path <- system.file("unitTests", package = pkg) 9 | 10 | ## --- Testing --- 11 | 12 | ## Define tests 13 | testSuite <- defineTestSuite(name = paste(pkg, "unit testing"), 14 | dirs = path) 15 | 16 | if(interactive()) { 17 | cat("Now have RUnit Test Suite 'testSuite' for package '", 18 | pkg, "' :\n", sep='') 19 | str(testSuite) 20 | cat('', "Consider doing", 21 | "\t tests <- runTestSuite(testSuite)", "\nand later", 22 | "\t printTextProtocol(tests)", '', sep = "\n") 23 | } else { 24 | ## run from shell / Rscript / R CMD Batch / ... 25 | ## Run 26 | tests <- runTestSuite(testSuite) 27 | 28 | if(file.access(path, 02) != 0) { 29 | ## cannot write to path -> use writable one 30 | tdir <- tempfile(paste(pkg, "unitTests", sep="_")) 31 | dir.create(tdir) 32 | pathReport <- file.path(tdir, "report") 33 | cat("RUnit reports are written into ", tdir, "/report.(txt|html)", 34 | sep = "") 35 | } else { 36 | pathReport <- file.path(path, "report") 37 | } 38 | 39 | ## Print Results: 40 | printTextProtocol(tests, showDetails = FALSE) 41 | printTextProtocol(tests, showDetails = FALSE, 42 | fileName = paste(pathReport, "Summary.txt", sep = "")) 43 | printTextProtocol(tests, showDetails = TRUE, 44 | fileName = paste(pathReport, ".txt", sep = "")) 45 | 46 | ## Print HTML Version to a File: 47 | ## printHTMLProtocol has problems on Mac OS X 48 | if (Sys.info()["sysname"] != "Darwin") 49 | printHTMLProtocol(tests, 50 | fileName = paste(pathReport, ".html", sep = "")) 51 | 52 | ## stop() if there are any failures i.e. FALSE to unit test. 53 | ## This will cause R CMD check to return error and stop 54 | tmp <- getErrors(tests) 55 | if(tmp$nFail > 0 | tmp$nErr > 0) { 56 | stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail, 57 | ", R errors: ", tmp$nErr, ")\n\n", sep="")) 58 | } 59 | } 60 | } else { 61 | cat("R package 'RUnit' cannot be loaded -- no unit tests run\n", 62 | "for package", pkg,"\n") 63 | } 64 | 65 | 66 | ################################################################################ 67 | -------------------------------------------------------------------------------- /inst/unitTests/runit.acnt.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Unit testing of analytic centering problem with equality constraints 3 | test.ACNT <- function(){ 4 | if(requireNamespace("numDeriv", quietly = TRUE)){ 5 | ## Creating objective, gradient and Hessian 6 | f0 <- function(x) -sum(log(x)) 7 | g0 <- function(x, func = f0) numDeriv::grad(func = func, x = x) 8 | h0 <- function(x, func = f0) numDeriv::hessian(func = func, x = x) 9 | ## equality constraint 10 | A <- matrix(c(1, 1, 2), nrow = 1) 11 | b <- matrix(1, nrow = 1) 12 | ## initial (feasible!) point 13 | x0 = c(0.25, 0.25, 0.25) 14 | ## solving problem 15 | ans <- cccp(x0 = x0, f0 = f0, g0 = g0, h0 = h0, A = A, b = b) 16 | checkTrue(ans$status == "optimal") 17 | } 18 | return() 19 | } 20 | -------------------------------------------------------------------------------- /inst/unitTests/runit.fpln.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Unit testing of Linear Program with non-linear and cone constraints 3 | test.FPLN <- function(){ 4 | if(requireNamespace("numDeriv", quietly = TRUE)){ 5 | ## Creating objective 6 | q <- c(rep(1, 2), rep(0, 20)) 7 | xnames <- c("W", "H", 8 | paste("x", 1:5, sep = ""), 9 | paste("y", 1:5, sep = ""), 10 | paste("w", 1:5, sep = ""), 11 | paste("h", 1:5, sep = "") 12 | ) 13 | ## Fixed constants 14 | gamma <- 5.0 15 | rho <- 1.0 16 | Amin <- 100 17 | ## Inequality constraints 18 | G <- matrix(0.0, nrow = 26, ncol = 22) 19 | h <- matrix(0.0, nrow = 26, ncol = 1) 20 | G[1, 3] <- -1.0 ## -x1 <= 0 21 | G[2, 4] <- -1.0 ## -x2 <= 0 22 | G[3, 6] <- -1.0 ## -x4 <= 0 23 | G[4, c(3, 5, 13)] <- c(1.0, -1.0, 1.0) ## x1 - x3 + w1 <= -rho 24 | h[4, 1] <- -rho 25 | G[5, c(4, 5, 14)] <- c(1.0, -1.0, 1.0) ## x2 - x3 + w2 <= -rho 26 | h[5, 1] <- -rho 27 | G[6, c(5, 7, 15)] <- c(1.0, -1.0, 1.0) ## x3 - x5 + w3 <= -rho 28 | h[6, 1] <- -rho 29 | G[7, c(6, 7, 16)] <- c(1.0, -1.0, 1.0) ## x4 - x5 + w4 <= -rho 30 | h[7, 1] <- -rho 31 | G[8, c(1, 7, 17)] <- c(-1.0, 1.0, 1.0) ## -W + x5 + w5 <= 0 32 | G[9, 9] <- -1.0 ## -y2 <= 0 33 | G[10, 10] <- -1.0 ## -y3 <= 0 34 | G[11, 12] <- -1.0 ## -y5 <= 0 35 | G[12, c(8, 9, 19)] <- c(-1.0, 1.0, 1.0) ## -y1 + y2 + h2 <= -rho 36 | h[12, 1] <- -rho 37 | G[13, c(8, 11, 18)] <- c(1.0, -1.0, 1.0) ## y1 - y4 + h1 <= -rho 38 | h[13, 1] <- -rho 39 | G[14, c(10, 11, 20)] <- c(1.0, -1.0, 1.0) ## y3 - y4 + h3 <= -rho 40 | h[14, 1] <- -rho 41 | G[15, c(2, 11, 21)] <- c(-1.0, 1.0, 1.0) ## -H + y4 + h4 <= 0 42 | G[16, c(2, 12, 22)] <- c(-1.0, 1.0, 1.0) ## -H + y5 + h5 <= 0 43 | G[17, c(13, 18)] <- c(-1.0, 1.0 / gamma) ## -w1 + h1/gamma <= 0 44 | G[18, c(13, 18)] <- c(1.0, -gamma) ## w1 - gamma * h1 <= 0 45 | G[19, c(14, 19)] <- c(-1.0, 1.0 / gamma) ## -w2 + h2/gamma <= 0 46 | G[20, c(14, 19)] <- c(1.0, -gamma) ## w2 - gamma * h2 <= 0 47 | G[21, c(15, 19)] <- c(-1.0, 1.0 / gamma) ## -w3 + h3/gamma <= 0 48 | G[22, c(15, 20)] <- c(1.0, -gamma) ## w3 - gamma * h3 <= 0 49 | G[23, c(16, 20)] <- c(-1.0, 1.0 / gamma) ## -w4 + h4/gamma <= 0 50 | G[24, c(16, 21)] <- c(1.0, -gamma) ## w4 - gamma * h4 <= 0 51 | G[25, c(16, 21)] <- c(-1.0, 1.0 / gamma) ## -w5 + h5/gamma <= 0 52 | G[26, c(17, 22)] <- c(1.0, -gamma) ## w5 - gamma * h5 <= 0 53 | nno1 <- nnoc(G = G, h = h) 54 | ## Nonlinear constraints 55 | f1 <- function(x) -x[13] + Amin / x[18] 56 | f2 <- function(x) -x[14] + Amin / x[19] 57 | f3 <- function(x) -x[15] + Amin / x[20] 58 | f4 <- function(x) -x[16] + Amin / x[21] 59 | f5 <- function(x) -x[17] + Amin / x[22] 60 | ## Gradient functions 61 | g1 <- function(x, func = f1) numDeriv::grad(func = func, x = x) 62 | g2 <- function(x, func = f2) numDeriv::grad(func = func, x = x) 63 | g3 <- function(x, func = f3) numDeriv::grad(func = func, x = x) 64 | g4 <- function(x, func = f4) numDeriv::grad(func = func, x = x) 65 | g5 <- function(x, func = f5) numDeriv::grad(func = func, x = x) 66 | ## Hessian functions 67 | h1 <- function(x, func = f1) numDeriv::hessian(func = func, x = x) 68 | h2 <- function(x, func = f2) numDeriv::hessian(func = func, x = x) 69 | h3 <- function(x, func = f3) numDeriv::hessian(func = func, x = x) 70 | h4 <- function(x, func = f4) numDeriv::hessian(func = func, x = x) 71 | h5 <- function(x, func = f5) numDeriv::hessian(func = func, x = x) 72 | ## Initial value 73 | x0 <- rep(1, 22) 74 | ## Invoking 'cccp' 75 | ans <- cccp(q = q, cList = list(nno1), x0 = x0, 76 | nlfList = list(f1, f2, f3, f4, f5), 77 | nlgList = list(g1, g2, g3, g4, g5), 78 | nlhList = list(h1, h2, h3, h4, h5)) 79 | checkTrue(ans$status == "optimal") 80 | } 81 | return() 82 | } 83 | -------------------------------------------------------------------------------- /inst/unitTests/runit.gp.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Unit testing of Geometric Program 3 | test.GP <- function(){ 4 | F0 <- matrix(c(3, -2, -1, 0, 1, -3), nrow = 3, ncol = 2, byrow = TRUE) 5 | g0 <- log(c(0.44, 10, 0.592)) 6 | F1 <- matrix(c(-1, 3), nrow = 1, ncol = 2, byrow = TRUE) 7 | g1 <- log(8.62) 8 | ans <- gp(F0, g0, FList = list(F1), gList = list(g1)) 9 | checkTrue(ans$status == "optimal") 10 | return() 11 | } 12 | -------------------------------------------------------------------------------- /inst/unitTests/runit.lpcc.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Unit testing of Linear Program with cone constraints 3 | test.LPCC <- function(){ 4 | ## Creating LP 5 | q <- c(-6, -4, -5) 6 | ## NNO constraint 7 | G <- matrix(c(16, -14, 5, 8 | 7, 2, 0), 9 | nrow = 2, ncol = 3, byrow = TRUE) 10 | h <- c(-3, 5) 11 | nno1 <- nnoc(G = G, h = h) 12 | ## SOC constraint 13 | F1 <- matrix(c(8, 13, -12, 14 | -8, 18, 6, 15 | 1, -3, -17), 16 | nrow = 3, ncol = 3, byrow = TRUE) 17 | g1 <- c(-2, -14, -13) 18 | d1 <- c(-24, -7, 15) 19 | f1 <- 12 20 | soc1 <- socc(F = F1, g = g1, d = d1, f = f1) 21 | ## PSD constraint 22 | F1 <- matrix(c(7, -5, 1, 23 | -5, 1, -7, 24 | 1, -7, -4), 25 | nrow = 3, ncol = 3, byrow = TRUE) 26 | F2 <- matrix(c(3, 13, -6, 27 | 13, 12, -10, 28 | -6, -10, -28), 29 | nrow = 3, ncol = 3, byrow = TRUE) 30 | F3 <- matrix(c(9, 6, -6, 31 | 6, -7, -7, 32 | -6, -7, -11), 33 | nrow = 3, ncol = 3, byrow = TRUE) 34 | F0 <- matrix(c(68, -30, -19, 35 | -30, 99, 23, 36 | -19, 23, 10), 37 | nrow = 3, ncol = 3, byrow = TRUE) 38 | psd1 <- psdc(Flist = list(F1, F2, F3), F0 = F0) 39 | ## Using main function of package 40 | ans <- cccp(q = q, cList = list(nno1, soc1, psd1)) 41 | checkTrue(ans$status == "optimal") 42 | return() 43 | } 44 | -------------------------------------------------------------------------------- /inst/unitTests/runit.lpic.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Unit testing of Linear Program with inequality constraints 3 | test.LPIC <- function(){ 4 | ## First example 5 | q <- c(-4, -5) 6 | G <- matrix(c(2, 1, -1, 0, 7 | 1, 2, 0, -1), 8 | nrow = 4, ncol = 2) 9 | h <- c(3, 3, 0, 0) 10 | nno1 <- nnoc(G = G, h = h) 11 | ans <- cccp(q = q, cList = list(nno1), optctrl = ctrl()) 12 | checkTrue(ans$status == "optimal") 13 | ## Second example 14 | q <- c(2, 1) 15 | G <- matrix(c(-1, 1, 16 | -1, -1, 17 | 0, -1, 18 | 1, -2), 19 | nrow = 4, ncol = 2, byrow = TRUE) 20 | h <- matrix(c(1, -2, 0, 4)) 21 | nno1 <- nnoc(G = G, h = h) 22 | ans <- cccp(q = q, cList = list(nno1)) 23 | checkTrue(ans$status == "optimal") 24 | return() 25 | } 26 | -------------------------------------------------------------------------------- /inst/unitTests/runit.qpec.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Unit testing of Quadratic Program with equality constraints 3 | test.QPEC <- function(){ 4 | P <- 2 * matrix(c(2, .5, .5, 1), nrow = 2, ncol = 2) 5 | q <- c(1.0, 1.0) 6 | A <- matrix(c(1.0, 1.0), nrow = 1, ncol = 2) 7 | b <- 1.0 8 | ## Using main function of package 9 | ans <- cccp(P = P, q = q, A = A, b = b) 10 | checkTrue(ans$status == "optimal") 11 | checkEqualsNumeric(drop(getx(ans)), c(0.25, 0.75)) 12 | checkEqualsNumeric(ans$state[1], 1.875) 13 | return() 14 | } 15 | -------------------------------------------------------------------------------- /inst/unitTests/runit.qpic.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Unit testing of Quadratic Program with equality and inequality constraints 3 | test.QPIC <- function(){ 4 | P <- 2 * matrix(c(2, .5, .5, 1), nrow = 2, ncol = 2) 5 | q <- c(1.0, 1.0) 6 | G <- -diag(2) 7 | h <- rep(0, 2) 8 | nno1 <- nnoc(G = G, h = h) 9 | A <- matrix(c(1.0, 1.0), nrow = 1, ncol = 2) 10 | b <- 1.0 11 | ans <- cccp(P = P, q = q, A = A, b = b, cList = list(nno1)) 12 | checkTrue(ans$status == "optimal") 13 | return() 14 | } 15 | -------------------------------------------------------------------------------- /inst/unitTests/runit.qpqc.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Unit testing of Quadratic Program with NNO and SOC constraints 3 | test.QPIC <- function(){ 4 | adat <- c(0.3, -0.4, -0.2, -0.4, 1.3, 5 | 0.6, 1.2, -1.7, 0.3, -0.3, 6 | -0.3, 0.0, 0.6, -1.2, -2.0) 7 | A <- matrix(adat, nrow = 5, ncol = 3) 8 | b <- c(1.5, 0.0, -1.2, -0.7, 0.0) 9 | P <- crossprod(A) 10 | q <- -crossprod(A, b) 11 | G = -diag(3) 12 | h = rep(0, 3) 13 | nno1 <- nnoc(G = G, h = h) 14 | F = diag(3) 15 | g = rep(0, 3) 16 | d = rep(0, 3) 17 | f = 1 18 | soc1 <- socc(F = F, g = g, d = d, f = f) 19 | ans <- cccp(P = P, q = q, cList = list(nno1, soc1)) 20 | checkTrue(ans$status == "optimal") 21 | return() 22 | } 23 | -------------------------------------------------------------------------------- /inst/unitTests/runit.sdp.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Unit testing of Linear Program with PSD constraints 3 | test.SDP <- function(){ 4 | ## Creating SDP 5 | ## Objective 6 | q <- c(1, -1, 1) 7 | ## First PSD cone constraint 8 | F1 <- matrix(c(-7, -11, -11, 3), nrow = 2, ncol = 2) 9 | F2 <- matrix(c(7, -18, -18, 8), nrow = 2, ncol = 2) 10 | F3 <- matrix(c(-2, -8, -8, 1), nrow = 2, ncol = 2) 11 | F0 <- matrix(c(33, -9, -9, 26), nrow = 2, ncol = 2) 12 | psd1 <- psdc(Flist = list(F1, F2, F3), F0 = F0) 13 | ## Second PSD cone constraint 14 | F1 <- matrix(c(-21, -11, 0, -11, 10, 8, 0, 8, 5), nrow = 3, ncol = 3) 15 | F2 <- matrix(c(0, 10, 16, 10, -10, -10, 16, -10, 3), nrow = 3, ncol = 3) 16 | F3 <- matrix(c(-5, 2, -17, 2, -6, 8, -17, 8, 6), nrow = 3, ncol = 3) 17 | F0 <- matrix(c(14, 9, 40, 9, 91, 10, 40, 10, 15), nrow = 3, ncol = 3) 18 | psd2 <- psdc(Flist = list(F1, F2, F3), F0 = F0) 19 | ## Using main function of package 20 | ans <- cccp(q = q, cList = list(psd1, psd2)) 21 | checkTrue(ans$status == "optimal") 22 | return() 23 | } 24 | -------------------------------------------------------------------------------- /inst/unitTests/runit.socp.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Unit testing of SOCP with two second-order cone constraints 3 | test.SOCP <- function(){ 4 | ## Objective 5 | q <- c(-2, 1, 5) 6 | ## First SOC 7 | F1 <- matrix(c(-13, 3, 5, 8 | -12, 12, -6), 9 | nrow = 2, ncol = 3, byrow = TRUE) 10 | g1 <- c(-3, -2) 11 | d1 <- c(-12, -6, 5) 12 | f1 <- -12 13 | soc1 <- socc(F = F1, g = g1, d = d1, f = f1) 14 | ## Second SOC 15 | F2 <- matrix(c(-3, 6, 2, 16 | 1, 9, 2, 17 | -1, -19, 3), 18 | nrow = 3, ncol = 3, byrow = TRUE) 19 | g2 <- c(0, 3, -42) 20 | d2 <- c(-3, 6, -10) 21 | f2 <- 27 22 | soc2 <- socc(F = F2, g = g2, d = d2, f = f2) 23 | ## Using main function of package 24 | ctl <- ctrl(feastol = 1e-5) 25 | ans <- cccp(q = q, cList = list(soc1, soc2), optctrl = ctl) ## for Windows 32-bit 26 | checkTrue(ans$status == "optimal") 27 | return() 28 | } 29 | -------------------------------------------------------------------------------- /man/Rcpp_CONEC-class.Rd: -------------------------------------------------------------------------------- 1 | \name{Rcpp_CONEC-class} 2 | \Rdversion{1.1} 3 | \docType{class} 4 | \alias{Rcpp_CONEC-class} 5 | 6 | \title{Class \code{"Rcpp_CONEC"}} 7 | 8 | \description{ 9 | Class for inequality (cone) constraints. 10 | } 11 | 12 | \section{Extends}{ 13 | Class \code{"\linkS4class{C++Object}"}, directly. 14 | All reference classes extend and inherit methods from \code{"\linkS4class{envRefClass}"}. 15 | } 16 | 17 | \section{Fields}{ 18 | \describe{ 19 | \item{\code{cone}:}{Object of class \code{activeBindingFunction}: 20 | Type of cone constraints.} 21 | \item{\code{G}:}{Object of class \code{activeBindingFunction}: 22 | Left-hand side of inequality constraints.} 23 | \item{\code{h}:}{Object of class \code{activeBindingFunction}: 24 | Right-hand side of inequality constraints.} 25 | \item{\code{sidx}:}{Object of class \code{activeBindingFunction}: 26 | Row index for subsets of cone constraints.} 27 | \item{\code{dims}:}{Object of class \code{activeBindingFunction}: 28 | Dimension of cone constraints.} 29 | \item{\code{K}:}{Object of class \code{activeBindingFunction}: Count 30 | of inequality constraints.} 31 | \item{\code{n}:}{Object of class \code{activeBindingFunction}: Count 32 | of variables in objective.} 33 | } 34 | } 35 | 36 | \examples{ 37 | showClass("Rcpp_CONEC") 38 | } 39 | \keyword{classes} 40 | -------------------------------------------------------------------------------- /man/Rcpp_CPG-module.Rd: -------------------------------------------------------------------------------- 1 | \name{CPG} 2 | \alias{CONEC} 3 | \alias{CTRL} 4 | \alias{CPG} 5 | \alias{PDV} 6 | \alias{DCP} 7 | \alias{DLP} 8 | \alias{DNL} 9 | \alias{DQP} 10 | \alias{CPS} 11 | \alias{rpp} 12 | \alias{gpp} 13 | 14 | \title{ 15 | Rcpp module: CPG 16 | } 17 | 18 | \description{ 19 | Module for defining and solving convex programs. 20 | } 21 | 22 | \details{ 23 | The module contains the following items: 24 | classes: \describe{ 25 | \item{CONEC}{Class for inequality (cone) constraints.} 26 | \item{CTRL}{Class for control parameters used in optimizations.} 27 | \item{PDV}{Class for primal/dual variables.} 28 | \item{DCP}{Class for definition of convex programs.} 29 | \item{DLP}{Class for definition of linear programs.} 30 | \item{DNL}{Class for definition of linear programs with non-linear constraints.} 31 | \item{DQP}{Class for definition of quadratic programs.} 32 | \item{CPS}{Class for solution of convex programs.} 33 | } 34 | functions: \describe{ 35 | \item{rpp}{Function for solving risk parity portfolios.} 36 | \item{gpp}{Function for solving a geometric program.} 37 | } 38 | } 39 | 40 | \keyword{datasets} 41 | -------------------------------------------------------------------------------- /man/Rcpp_CPS-class.Rd: -------------------------------------------------------------------------------- 1 | \name{Rcpp_CPS-class} 2 | \Rdversion{1.1} 3 | \docType{class} 4 | \alias{Rcpp_CPS-class} 5 | 6 | \title{Class \code{"Rcpp_CPS"}} 7 | 8 | \description{ 9 | Class for solution of convex programs. 10 | } 11 | 12 | \section{Extends}{ 13 | Class \code{"\linkS4class{C++Object}"}, directly. 14 | All reference classes extend and inherit methods from \code{"\linkS4class{envRefClass}"}. 15 | } 16 | 17 | \section{Fields}{ 18 | \describe{ 19 | \item{\code{pdv}:}{Object of class \code{activeBindingFunction}: 20 | Primal-dual variables.} 21 | \item{\code{state}:}{Object of class \code{activeBindingFunction}: 22 | Vector of state variables in convex programs.} 23 | \item{\code{status}:}{Object of class \code{activeBindingFunction}: 24 | Character indicating the status of the returned solution.} 25 | \item{\code{niter}:}{Object of class \code{activeBindingFunction}: 26 | Integer, count of iterations.} 27 | \item{\code{sidx}:}{Object of class \code{activeBindingFunction}: 28 | Integer matrix, start and end indices of slack variables.} 29 | } 30 | } 31 | 32 | \examples{ 33 | showClass("Rcpp_CPS") 34 | } 35 | \keyword{classes} 36 | -------------------------------------------------------------------------------- /man/Rcpp_CTRL-class.Rd: -------------------------------------------------------------------------------- 1 | \name{Rcpp_CTRL-class} 2 | \Rdversion{1.1} 3 | \docType{class} 4 | \alias{Rcpp_CTRL-class} 5 | 6 | \title{Class \code{"Rcpp_CTRL"}} 7 | 8 | \description{ 9 | Class for control options used in optimization routines. 10 | } 11 | 12 | \section{Extends}{ 13 | Class \code{"\linkS4class{C++Object}"}, directly. 14 | All reference classes extend and inherit methods from \code{"\linkS4class{envRefClass}"}. 15 | } 16 | 17 | \section{Fields}{ 18 | \describe{ 19 | \item{\code{ctrlparams}:}{Object of class 20 | \code{activeBindingFunction}: List of control parameters.} 21 | } 22 | } 23 | 24 | \examples{ 25 | showClass("Rcpp_CTRL") 26 | } 27 | \keyword{classes} 28 | -------------------------------------------------------------------------------- /man/Rcpp_DCP-class.Rd: -------------------------------------------------------------------------------- 1 | \name{Rcpp_DCP-class} 2 | \Rdversion{1.1} 3 | \docType{class} 4 | \alias{Rcpp_DCP-class} 5 | 6 | \title{Class \code{"Rcpp_DCP"}} 7 | 8 | \description{ 9 | Class for definition of convex programs with non-linear constraints. 10 | } 11 | 12 | \section{Extends}{ 13 | Class \code{"\linkS4class{C++Object}"}, directly. 14 | All reference classes extend and inherit methods from \code{"\linkS4class{envRefClass}"}. 15 | } 16 | 17 | \section{Fields}{ 18 | \describe{ 19 | \item{\code{x0}:}{Object of class \code{activeBindingFunction}: 20 | Initial values.} 21 | \item{\code{cList}:}{Object of class \code{activeBindingFunction}: 22 | Inequality constraints, class \code{CONEC}.} 23 | \item{\code{nList}:}{Object of class \code{activeBindingFunction}: 24 | List with elements of functions for evaluating non-linear 25 | constraints, their associated gradients and their associated 26 | Hessians.} 27 | \item{\code{A}:}{Object of class \code{activeBindingFunction}: 28 | Left-hand side of equality cosntraints.} 29 | \item{\code{b}:}{Object of class \code{activeBindingFunction}: 30 | Right-hand side of equality cosntraints.} 31 | } 32 | } 33 | 34 | \examples{ 35 | showClass("Rcpp_DCP") 36 | } 37 | \keyword{classes} 38 | -------------------------------------------------------------------------------- /man/Rcpp_DLP-class.Rd: -------------------------------------------------------------------------------- 1 | \name{Rcpp_DLP-class} 2 | \Rdversion{1.1} 3 | \docType{class} 4 | \alias{Rcpp_DLP-class} 5 | 6 | \title{Class \code{"Rcpp_DLP"}} 7 | 8 | \description{ 9 | Class for definition of linear programs. 10 | } 11 | 12 | \section{Extends}{ 13 | Class \code{"\linkS4class{C++Object}"}, directly. 14 | All reference classes extend and inherit methods from \code{"\linkS4class{envRefClass}"}. 15 | } 16 | 17 | \section{Fields}{ 18 | \describe{ 19 | \item{\code{q}:}{Object of class \code{activeBindingFunction}: 20 | Matrix related to linear term in objective.} 21 | \item{\code{A}:}{Object of class \code{activeBindingFunction}: 22 | Left-hand side of equality cosntraints.} 23 | \item{\code{b}:}{Object of class \code{activeBindingFunction}: 24 | Right-hand side of equality cosntraints.} 25 | \item{\code{cList}:}{Object of class \code{activeBindingFunction}: 26 | Inequality constraints, class \code{CONEC}.} 27 | } 28 | } 29 | 30 | \examples{ 31 | showClass("Rcpp_DLP") 32 | } 33 | \keyword{classes} 34 | -------------------------------------------------------------------------------- /man/Rcpp_DNL-class.Rd: -------------------------------------------------------------------------------- 1 | \name{Rcpp_DNL-class} 2 | \Rdversion{1.1} 3 | \docType{class} 4 | \alias{Rcpp_DNL-class} 5 | 6 | \title{Class \code{"Rcpp_DNL"}} 7 | 8 | \description{ 9 | Class for definition of linear programs with non-linear constraints. 10 | } 11 | 12 | \section{Extends}{ 13 | Class \code{"\linkS4class{C++Object}"}, directly. 14 | All reference classes extend and inherit methods from \code{"\linkS4class{envRefClass}"}. 15 | } 16 | 17 | \section{Fields}{ 18 | \describe{ 19 | \item{\code{q}:}{Object of class \code{activeBindingFunction}: 20 | Matrix related to linear term in objective.} 21 | \item{\code{A}:}{Object of class \code{activeBindingFunction}: 22 | Left-hand side of equality cosntraints.} 23 | \item{\code{b}:}{Object of class \code{activeBindingFunction}: 24 | Right-hand side of equality cosntraints.} 25 | \item{\code{cList}:}{Object of class \code{activeBindingFunction}: 26 | Inequality constraints, class \code{CONEC}.} 27 | \item{\code{x0}:}{Object of class \code{activeBindingFunction}: 28 | Initial values.} 29 | \item{\code{nList}:}{Object of class \code{activeBindingFunction}: 30 | List with elements of functions for evaluating non-linear 31 | constraints, their associated gradients and their associated 32 | Hessians.} 33 | } 34 | } 35 | 36 | \examples{ 37 | showClass("Rcpp_DNL") 38 | } 39 | \keyword{classes} 40 | -------------------------------------------------------------------------------- /man/Rcpp_DQP-class.Rd: -------------------------------------------------------------------------------- 1 | \name{Rcpp_DQP-class} 2 | \Rdversion{1.1} 3 | \docType{class} 4 | \alias{Rcpp_DQP-class} 5 | 6 | \title{Class \code{"Rcpp_DQP"}} 7 | 8 | \description{ 9 | Class for definition of quadratic programs. 10 | } 11 | 12 | \section{Extends}{ 13 | Class \code{"\linkS4class{C++Object}"}, directly. 14 | All reference classes extend and inherit methods from \code{"\linkS4class{envRefClass}"}. 15 | } 16 | 17 | \section{Fields}{ 18 | \describe{ 19 | \item{\code{P}:}{Object of class \code{activeBindingFunction}: 20 | Matrix related to quadratic term in objective.} 21 | \item{\code{q}:}{Object of class \code{activeBindingFunction}: 22 | Matrix related to linear term in objective.} 23 | \item{\code{A}:}{Object of class \code{activeBindingFunction}: 24 | Left-hand side of equality cosntraints.} 25 | \item{\code{b}:}{Object of class \code{activeBindingFunction}: 26 | Right-hand side of equality cosntraints.} 27 | \item{\code{cList}:}{Object of class \code{activeBindingFunction}: 28 | Inequality constraints, class \code{CONEC}.} 29 | } 30 | } 31 | 32 | \examples{ 33 | showClass("Rcpp_DQP") 34 | } 35 | \keyword{classes} 36 | -------------------------------------------------------------------------------- /man/Rcpp_PDV-class.Rd: -------------------------------------------------------------------------------- 1 | \name{Rcpp_PDV-class} 2 | \Rdversion{1.1} 3 | \docType{class} 4 | \alias{Rcpp_PDV-class} 5 | 6 | \title{Class \code{"Rcpp_PDV"}} 7 | 8 | \description{ 9 | Class for primal/dual variables in convex programs. 10 | } 11 | 12 | \section{Extends}{ 13 | Class \code{"\linkS4class{C++Object}"}, directly. 14 | All reference classes extend and inherit methods from \code{"\linkS4class{envRefClass}"}. 15 | } 16 | 17 | \section{Fields}{ 18 | \describe{ 19 | \item{\code{x}:}{Object of class \code{activeBindingFunction}: 20 | Primal variables.} 21 | \item{\code{y}:}{Object of class \code{activeBindingFunction}: Dual 22 | variables.} 23 | \item{\code{s}:}{Object of class \code{activeBindingFunction}: 24 | Primal slack variables.} 25 | \item{\code{z}:}{Object of class \code{activeBindingFunction}: Dual 26 | slack variables.} 27 | \item{\code{kappa}:}{Object of class \code{activeBindingFunction}: 28 | Self-dual embedding variable; used in LPs, only.} 29 | \item{\code{tau}:}{Object of class \code{activeBindingFunction}: 30 | Self-dual embedding variable; used in LPs, only.} 31 | } 32 | } 33 | 34 | \examples{ 35 | showClass("Rcpp_PDV") 36 | } 37 | \keyword{classes} 38 | 39 | -------------------------------------------------------------------------------- /man/cccp.Rd: -------------------------------------------------------------------------------- 1 | \name{cccp} 2 | \alias{cccp} 3 | 4 | \title{ 5 | Solving linear and quadratic programs with cone constraints 6 | } 7 | 8 | \description{ 9 | This function is the main function for defining and solving convex 10 | problems in the form of either linear or quadratic programs with cone 11 | constraints. 12 | } 13 | 14 | \usage{ 15 | cccp(P = NULL, q = NULL, A = NULL, b = NULL, cList = list(), 16 | x0 = NULL, f0 = NULL, g0 = NULL, h0 = NULL, 17 | nlfList = list(), nlgList = list(), nlhList = list(), 18 | optctrl = ctrl()) 19 | } 20 | 21 | \arguments{ 22 | \item{P}{An object of class \code{matrix} with dimension \eqn{N \times 23 | N} or \code{NULL}.} 24 | \item{q}{An object of class \code{vector} with dimension \eqn{N \times 25 | 1} or \code{NULL}.} 26 | \item{A}{An object of class \code{matrix} with dimension \eqn{p \times N}.} 27 | \item{b}{An object of class \code{vector} with dimension \eqn{p \times 1}.} 28 | \item{cList}{A \code{list} object containing the cone constraints. 29 | Elements must be of either S4-class \code{NNOC}, or \code{SOCC}, or 30 | \code{PSDC}.} 31 | \item{x0}{An object of class \code{vector} with dimension \eqn{n 32 | \times 1} for the initial values. The point \code{x0} must be in 33 | the domain of the nonlinear constraints.} 34 | \item{f0}{\code{function}: the scalar-valued convex and 35 | twice-differentiable objective function (its first argument must be 36 | \sQuote{\code{x}}).} 37 | \item{g0}{\code{function}: the gradient function of the objective (its 38 | first argument must be \sQuote{\code{x}}).} 39 | \item{h0}{\code{function}: the Hessian function of the objective (its 40 | first argument must be \sQuote{\code{x}}).} 41 | \item{nlfList}{A \code{list} object containing the nonlinear 42 | constraints as its elements. The functions have to be specified with 43 | \code{x} as their first argument and must be casted in implicit 44 | form, \emph{i.e.} \eqn{f(x) \le 0}.} 45 | \item{nlgList}{A \code{list} object containing the gradient functions 46 | as its elements. The functions have to be specified with \code{x} as 47 | their first argument.} 48 | \item{nlhList}{A \code{list} object containing the Hessian functions 49 | as its elements. The functions have to be specified with \code{x} as 50 | their first argument.} 51 | \item{optctrl}{An object of S4-class \code{Rcpp_CTRL}.} 52 | } 53 | 54 | \value{ 55 | An object of class \code{Rcpp_CPS}. 56 | } 57 | 58 | \keyword{optimize} 59 | -------------------------------------------------------------------------------- /man/cps.Rd: -------------------------------------------------------------------------------- 1 | \name{cps} 2 | \alias{cps} 3 | \alias{cps,Rcpp_DLP,Rcpp_CTRL-method} 4 | \alias{cps,Rcpp_DNL,Rcpp_CTRL-method} 5 | \alias{cps,Rcpp_DQP,Rcpp_CTRL-method} 6 | \alias{cps,Rcpp_DCP,Rcpp_CTRL-method} 7 | 8 | \title{ 9 | Solving a convex program 10 | } 11 | 12 | \description{ 13 | This function returns an optimal point for a cone constraint convex 14 | program. 15 | } 16 | 17 | \usage{ 18 | \S4method{cps}{Rcpp_DCP,Rcpp_CTRL}(cpd, ctrl) 19 | \S4method{cps}{Rcpp_DLP,Rcpp_CTRL}(cpd, ctrl) 20 | \S4method{cps}{Rcpp_DNL,Rcpp_CTRL}(cpd, ctrl) 21 | \S4method{cps}{Rcpp_DQP,Rcpp_CTRL}(cpd, ctrl) 22 | } 23 | 24 | \arguments{ 25 | \item{cpd}{An object belonging to the class union \code{CPD}.} 26 | \item{ctrl}{An object of reference-class \code{Rcpp_CTRL}.} 27 | } 28 | 29 | \value{ 30 | An object of reference-class \code{Rcpp_CPS}. 31 | } 32 | 33 | \keyword{optimize} 34 | -------------------------------------------------------------------------------- /man/ctrl.Rd: -------------------------------------------------------------------------------- 1 | \name{ctrl} 2 | \alias{ctrl} 3 | 4 | \title{ 5 | Creating objects of reference-class CTRL 6 | } 7 | 8 | \description{ 9 | This function creates an object of reference-class \code{CTRL} which 10 | contains optimization parameters, \emph{e.g.} the maximum number of 11 | iterations. 12 | } 13 | 14 | \usage{ 15 | ctrl(maxiters = 100L, abstol = 1e-06, reltol = 1e-06, 16 | feastol = 1e-06, stepadj = 0.95, beta = 0.5, trace = TRUE) 17 | } 18 | 19 | \arguments{ 20 | \item{maxiters}{\code{integer}, the maximum count of iterations.} 21 | \item{abstol}{\code{numeric}, the absolute level for convergence to be 22 | achieved.} 23 | \item{reltol}{\code{numeric}, the relative level for convergence to be 24 | achieved.} 25 | \item{feastol}{\code{numeric}, the feasable level for convergence to be 26 | achieved.} 27 | \item{stepadj}{\code{numeric}, step size adjustment in combined step.} 28 | \item{beta}{\code{numeric}, parameter in backtracking line search.} 29 | \item{trace}{\code{logical}, if \code{TRUE} (the default), the 30 | solver's progress during the iterations is shown.} 31 | } 32 | 33 | \value{ 34 | An object of reference-class \code{CTRL}. 35 | } 36 | 37 | \note{ 38 | Either \code{abstol} or \code{reltol} can be set to a negative real 39 | number. \code{feastol} must be greater than zero. 40 | } 41 | 42 | \seealso{ 43 | \code{\linkS4class{Rcpp_CTRL}} 44 | } 45 | 46 | \keyword{optimize} 47 | -------------------------------------------------------------------------------- /man/dcp.Rd: -------------------------------------------------------------------------------- 1 | \name{dcp} 2 | \alias{dcp} 3 | 4 | \title{ 5 | Creating a member object of the reference-class \code{DCP} 6 | } 7 | 8 | \description{ 9 | This function returns an object containing the definition of a convex 10 | program with non-linear constraints and (if provided) cone 11 | constraints. 12 | The returned object is a member of the reference-class \code{DCP}. 13 | } 14 | 15 | \usage{ 16 | dcp(x0, f0, g0, h0, cList = list(), nlfList = list(), nlgList = list(), 17 | nlhList = list(), A = NULL, b = NULL) 18 | } 19 | 20 | \arguments{ 21 | \item{x0}{An object of class \code{vector} with dimension \eqn{n 22 | \times 1} for the initial values. The point \code{x0} must be in 23 | the domain of the nonlinear constraints.} 24 | \item{f0}{\code{function}: the scalar-valued convex and 25 | twice-differentiable objective function (its first argument must be 26 | \sQuote{\code{x}}).} 27 | \item{g0}{\code{function}: the gradient function of the objective (its 28 | first argument must be \sQuote{\code{x}}); returning a vector.} 29 | \item{h0}{\code{function}: the Hessian function of the objective (its 30 | first argument must be \sQuote{\code{x}}); returning a matrix.} 31 | \item{cList}{A \code{list} object containing the cone 32 | constraints. Elements must be of either S4-class \code{NNOC}, or 33 | \code{SOCC}, or \code{PSDC} or an empty list in case of no 34 | inequality constraints.} 35 | \item{nlfList}{A \code{list} object containing the nonlinear 36 | constraints as its elements. The functions have to be specified with 37 | \code{x} as their first argument and must be casted in implicit 38 | form, \emph{i.e.} \eqn{f(x) \le 0}.} 39 | \item{nlgList}{A \code{list} object containing the gradient functions 40 | as its elements. The functions have to be specified with \code{x} as 41 | their first argument.} 42 | \item{nlhList}{A \code{list} object containing the Hessian functions 43 | as its elements. The functions have to be specified with \code{x} as 44 | their first argument.} 45 | \item{A}{An object of class \code{matrix} with dimension \eqn{p \times 46 | n} or \code{NULL} for problems without equality constraints.} 47 | \item{b}{An object of class \code{vector} with dimension \eqn{p \times 48 | 1} or \code{NULL} for problems without equality constraints.} 49 | } 50 | 51 | \value{ 52 | An object belonging to the reference-class \code{DCP}. 53 | } 54 | 55 | \keyword{optimize} 56 | -------------------------------------------------------------------------------- /man/dlp.Rd: -------------------------------------------------------------------------------- 1 | \name{dlp} 2 | \alias{dlp} 3 | 4 | \title{ 5 | Creating a member object of the reference-class \code{DLP} 6 | } 7 | 8 | \description{ 9 | This function returns an object containing the definition of a cone 10 | constrained linear program. The returned object is a member of the 11 | reference-class \code{DLP}. 12 | } 13 | 14 | \usage{ 15 | dlp(q, A = NULL, b = NULL, cList = list()) 16 | } 17 | 18 | \arguments{ 19 | \item{q}{An object of class \code{vector} with dimension \eqn{n \times 1}.} 20 | \item{A}{An object of class \code{matrix} with dimension \eqn{p \times 21 | n} or \code{NULL} for problems without equality constraints.} 22 | \item{b}{An object of class \code{vector} with dimension \eqn{p \times 23 | 1} or \code{NULL} for problems without equality constraints.} 24 | \item{cList}{A \code{list} object containing the cone 25 | constraints. Elements must be of either reference-class \code{NNOC}, or 26 | \code{SOCC}, or \code{PSDC} or an empty list in case of no 27 | inequality constraints.} 28 | } 29 | 30 | \value{ 31 | An object belonging to the reference-class \code{DLP}. 32 | } 33 | 34 | \keyword{optimize} 35 | -------------------------------------------------------------------------------- /man/dnl.Rd: -------------------------------------------------------------------------------- 1 | \name{dnl} 2 | \alias{dnl} 3 | 4 | \title{ 5 | Creating a member object of the reference-class \code{DNL} 6 | } 7 | 8 | \description{ 9 | This function returns an object containing the definition of a linear 10 | program with non-linear constraints and (if provided) cone 11 | constraints. 12 | The returned object is a member of the reference-class \code{DNL}. 13 | } 14 | 15 | \usage{ 16 | dnl(q, A = NULL, b = NULL, cList = list(), 17 | x0, nlfList = list(), nlgList = list(), nlhList = list()) 18 | } 19 | 20 | \arguments{ 21 | \item{q}{\code{vector} of length \eqn{n} for the coefficients in the 22 | objective.} 23 | \item{A}{An object of class \code{matrix} with dimension \eqn{p \times 24 | n} or \code{NULL} for problems without equality constraints.} 25 | \item{b}{An object of class \code{vector} with dimension \eqn{p \times 26 | 1} or \code{NULL} for problems without equality constraints.} 27 | \item{cList}{A \code{list} object containing the cone 28 | constraints. Elements must be of either S4-class \code{NNOC}, or 29 | \code{SOCC}, or \code{PSDC} or an empty list in case of no 30 | inequality constraints.} 31 | \item{x0}{An object of class \code{vector} with dimension \eqn{n 32 | \times 1} for the initial values. The point \code{x0} must be in 33 | the domain of the nonlinear constraints.} 34 | \item{nlfList}{A \code{list} object containing the nonlinear 35 | constraints as its elements. The functions have to be specified with 36 | \code{x} as their first argument and must be casted in implicit 37 | form, \emph{i.e.} \eqn{f(x) \le 0}.} 38 | \item{nlgList}{A \code{list} object containing the gradient functions 39 | as its elements. The functions have to be specified with \code{x} as 40 | their first argument.} 41 | \item{nlhList}{A \code{list} object containing the Hessian functions 42 | as its elements. The functions have to be specified with \code{x} as 43 | their first argument.} 44 | } 45 | 46 | \value{ 47 | An object belonging to the reference-class \code{DNL}. 48 | } 49 | 50 | \keyword{optimize} 51 | -------------------------------------------------------------------------------- /man/dqp.Rd: -------------------------------------------------------------------------------- 1 | \name{dqp} 2 | \alias{dqp} 3 | 4 | \title{ 5 | Creating a member object of the reference-class \code{DQP} 6 | } 7 | 8 | \description{ 9 | This function returns an object containing the definition of a cone 10 | constrained quadratic program. The returned object is a member of the 11 | reference-class \code{DQP}. 12 | } 13 | 14 | \usage{ 15 | dqp(P, q, A = NULL, b = NULL, cList = list()) 16 | } 17 | 18 | \arguments{ 19 | \item{P}{An object of class \code{matrix} with dimension \eqn{n \times n}.} 20 | \item{q}{An object of class \code{vector} with dimension \eqn{n \times 1}.} 21 | \item{A}{An object of class \code{matrix} with dimension \eqn{p \times 22 | n} or \code{NULL} for problems without equality constraints.} 23 | \item{b}{An object of class \code{vector} with dimension \eqn{p \times 24 | 1} or \code{NULL} for problems without equality constraints.} 25 | \item{cList}{A \code{list} object containing the cone 26 | constraints. Elements must be of either reference-class \code{NNOC}, or 27 | \code{SOCC}, or \code{PSDC} or an empty list in case of no 28 | inequality constraints.} 29 | } 30 | 31 | \value{ 32 | An object belonging to the reference-class \code{DQP}. 33 | } 34 | 35 | \keyword{optimize} 36 | -------------------------------------------------------------------------------- /man/getFoo.Rd: -------------------------------------------------------------------------------- 1 | \name{getFoo} 2 | \alias{gets} 3 | \alias{gets,Rcpp_PDV-method} 4 | \alias{gets,Rcpp_CPS-method} 5 | \alias{getx} 6 | \alias{getx,Rcpp_PDV-method} 7 | \alias{getx,Rcpp_CPS-method} 8 | \alias{gety} 9 | \alias{gety,Rcpp_PDV-method} 10 | \alias{gety,Rcpp_CPS-method} 11 | \alias{getz} 12 | \alias{getz,Rcpp_PDV-method} 13 | \alias{getz,Rcpp_CPS-method} 14 | \alias{getstate} 15 | \alias{getstate,Rcpp_CPS-method} 16 | \alias{getstatus} 17 | \alias{getstatus,Rcpp_CPS-method} 18 | \alias{getniter} 19 | \alias{getniter,Rcpp_CPS-method} 20 | \alias{getparams} 21 | \alias{getparams,Rcpp_CTRL-method} 22 | 23 | \title{ 24 | Extractor methods for reference class objects 25 | } 26 | 27 | \description{ 28 | Returns a member of reference class objects. 29 | } 30 | 31 | \usage{ 32 | \S4method{getx}{Rcpp_PDV}(object) 33 | \S4method{getx}{Rcpp_CPS}(object) 34 | \S4method{gety}{Rcpp_PDV}(object) 35 | \S4method{gety}{Rcpp_CPS}(object) 36 | \S4method{gets}{Rcpp_PDV}(object) 37 | \S4method{gets}{Rcpp_CPS}(object) 38 | \S4method{getz}{Rcpp_PDV}(object) 39 | \S4method{getz}{Rcpp_CPS}(object) 40 | \S4method{getstate}{Rcpp_CPS}(object) 41 | \S4method{getstatus}{Rcpp_CPS}(object) 42 | \S4method{getniter}{Rcpp_CPS}(object) 43 | \S4method{getparams}{Rcpp_CTRL}(object) 44 | } 45 | 46 | \arguments{ 47 | \item{object}{An object of either reference-class \code{Rcpp_PDV} or 48 | \code{Rcpp_CPS}, or \code{Rcpp_CTRL}.} 49 | } 50 | 51 | \value{ 52 | The relevant member object of the class. 53 | } 54 | 55 | \keyword{optimize} 56 | -------------------------------------------------------------------------------- /man/gp.Rd: -------------------------------------------------------------------------------- 1 | \name{gp} 2 | \alias{gp} 3 | 4 | \title{ 5 | Geometric program 6 | } 7 | 8 | \description{ 9 | This function solves a geometric program. 10 | } 11 | 12 | \usage{ 13 | gp(F0, g0, FList = list(), gList = list(), nno = NULL, 14 | A = NULL, b = NULL, optctrl = ctrl()) 15 | } 16 | %- maybe also 'usage' for other objects documented here. 17 | \arguments{ 18 | \item{F0}{Matrix in the objective function.} 19 | \item{g0}{Matrix in the objective function (affine terms).} 20 | \item{FList}{List of matrices in posinomial functions.} 21 | \item{gList}{List of matrices in posinomial functions (affine terms).} 22 | \item{nno}{Object created by a call to \code{nnoc()}.} 23 | \item{A}{Lefthand-side matrix of equality constraints.} 24 | \item{b}{Lefthand-side matrix of equality constraints.} 25 | \item{optctrl}{Object of reference class \sQuote{Rcpp_CTRL}, created 26 | by a call to \code{ctrl()}.} 27 | } 28 | 29 | \details{ 30 | Solves a geometric program casted in its epigraph form. 31 | } 32 | 33 | \value{ 34 | An object of S4-class \code{Rcpp_CPS}. 35 | } 36 | 37 | \references{ 38 | Boyd, S., Kim, S.-J., Vandenberghe, L. and A. Hassibi (2007), A tutorial on 39 | geometric programming, \emph{Optim Eng}, Educational Section, 40 | \bold{8}:67--127, Springer. 41 | } 42 | 43 | \keyword{optimize} 44 | -------------------------------------------------------------------------------- /man/l1.Rd: -------------------------------------------------------------------------------- 1 | \name{l1} 2 | \alias{l1} 3 | 4 | \title{ 5 | Minimizing L1-norm 6 | } 7 | 8 | \description{ 9 | This function minimizes a L1-norm of the form \eqn{||P u - q||_1}, 10 | whereby \eqn{P} is a \eqn{(m \times n)} matrix and \eqn{q} is a \eqn{m 11 | \times 1} vector. This function is wrapper function for invoking the 12 | \code{cps}-method of Linear Programs. 13 | } 14 | 15 | \usage{ 16 | l1(P, q = NULL, optctrl = ctrl()) 17 | } 18 | 19 | \arguments{ 20 | \item{P}{\code{matrix} of dimension \eqn{m \times n}.} 21 | \item{q}{\code{vector} of length \eqn{m}.} 22 | \item{optctrl}{An object of S4-class \code{Rcpp_CTRL}.} 23 | } 24 | 25 | \value{ 26 | An object of S4-class \code{Rcpp_CPS}. 27 | } 28 | 29 | \keyword{optimize} 30 | -------------------------------------------------------------------------------- /man/nlfc.Rd: -------------------------------------------------------------------------------- 1 | \name{nlfc} 2 | \alias{nlfc} 3 | 4 | \title{ 5 | Definition of nonlinear inequality constraints 6 | } 7 | 8 | \description{ 9 | This function is the interface to the reference class \code{NLFC} for 10 | creating nonlinear constraints. 11 | } 12 | 13 | \usage{ 14 | nlfc(G, h) 15 | } 16 | 17 | \arguments{ 18 | \item{G}{Object of class \code{"matrix"}: A \eqn{(m \times n)} matrix 19 | containing the coefficients of the lefthand-side linear inequality 20 | constraints.} 21 | \item{h}{Object of class \code{NLFV}: A \eqn{(m \times 1)} vector 22 | containing the coefficients of the righthand-side linear inequality 23 | constraints as slot \code{u}. 24 | } 25 | } 26 | 27 | \value{ 28 | List with elements: \code{conType}, \code{G} and \code{h}. 29 | } 30 | 31 | \keyword{classes} 32 | -------------------------------------------------------------------------------- /man/nnoc.Rd: -------------------------------------------------------------------------------- 1 | \name{nnoc} 2 | \alias{nnoc} 3 | 4 | \title{ 5 | Definition of linear inequality constraints 6 | } 7 | 8 | \description{ 9 | This function is the interface to the reference class \code{NNOC} for 10 | creating linear constraints. 11 | } 12 | 13 | \usage{ 14 | nnoc(G, h) 15 | } 16 | 17 | \arguments{ 18 | \item{G}{Object of class \code{"matrix"}: A \eqn{(m \times n)} matrix 19 | containing the coefficients of the lefthand-side linear inequality 20 | constraints.} 21 | \item{h}{Object of class \code{NNOV}: A \eqn{(m \times 1)} vector 22 | containing the coefficients of the righthand-side linear inequality 23 | constraints as slot \code{u}. 24 | } 25 | } 26 | 27 | \value{ 28 | List with elements: \code{conType}, \code{G} and \code{h}. 29 | } 30 | 31 | \keyword{classes} 32 | -------------------------------------------------------------------------------- /man/psdc.Rd: -------------------------------------------------------------------------------- 1 | \name{psdc} 2 | \alias{psdc} 3 | 4 | \title{ 5 | Definition of positive semidefinite cone inequality constraints 6 | } 7 | 8 | \description{ 9 | This function is the interface to the reference class \code{PSDC} for 10 | creating positive semidefinite cone constraints. 11 | } 12 | 13 | \usage{ 14 | psdc(Flist, F0) 15 | } 16 | 17 | \arguments{ 18 | \item{Flist}{Object of class \code{"list"}: A list with the matrices 19 | appearing on the left-hand side of the matrix inequality.} 20 | \item{F0}{Object of class \code{"matrix"}: The matrix appearing on the 21 | righthand-side.} 22 | } 23 | 24 | \details{ 25 | A psd-cone constraint is given as \eqn{\sum_{i = 1}^n x_i F_i \le 26 | F_0}. The matrix \eqn{G} is created as \eqn{G = [\textrm{vech}(F_1) | 27 | \ldots | \textrm{vech}(F_n)]} and the vector \eqn{h} is constructed as 28 | \eqn{h = [\textrm{vech}(F_0)]}. 29 | } 30 | 31 | \value{ 32 | List with elements: \code{conType}, \code{G} and \code{h}. 33 | } 34 | 35 | \keyword{classes} 36 | -------------------------------------------------------------------------------- /man/rp.Rd: -------------------------------------------------------------------------------- 1 | \name{rp} 2 | \alias{rp} 3 | 4 | \title{ 5 | Risk-parity optimization 6 | } 7 | 8 | \description{ 9 | This function determines a risk-parity solution of a long-only 10 | portfolio with a budget-constraint. 11 | } 12 | 13 | \usage{ 14 | rp(x0, P, mrc, optctrl = ctrl()) 15 | } 16 | 17 | \arguments{ 18 | \item{x0}{\code{matrix} of dimension \eqn{n \times 1}; starting values.} 19 | \item{P}{\code{matrix} of dimension \eqn{n \times n}; dispersion matrix.} 20 | \item{mrc}{\code{matrix} of dimension \eqn{n \times 1}; the marginal 21 | risk contributions.} 22 | \item{optctrl}{An object of S4-class \code{Rcpp_CTRL}.} 23 | } 24 | 25 | \value{ 26 | An object of S4-class \code{Rcpp_CPS}. 27 | } 28 | 29 | \references{ 30 | Spinu, F. (2013), An Algorithm for Computing Risk Parity Weights, 31 | SSRN, \emph{OMERS Capital Markets}, July 2013. 32 | } 33 | 34 | \keyword{optimize} 35 | -------------------------------------------------------------------------------- /man/socc.Rd: -------------------------------------------------------------------------------- 1 | \name{socc} 2 | \alias{socc} 3 | 4 | \title{ 5 | Definition of second-oder cone inequality constraints 6 | } 7 | 8 | \description{ 9 | This function is the interface to the reference class \code{SOCC} for 10 | creating second-oder cone constraints. 11 | } 12 | 13 | \usage{ 14 | socc(F, g, d, f) 15 | } 16 | 17 | \arguments{ 18 | \item{F}{Object of class \code{"matrix"}: The matrix appearing in the 19 | norm-expression on the left-hand side of a second-order cone constraint.} 20 | \item{g}{Object of class \code{"numeric"}: The vector appearing in the 21 | norm-expression on the left-hand side of a second-order cone constraint.} 22 | \item{d}{Object of class \code{"numeric"}: The vector appearing on the 23 | right-hand side of a second-order cone constraint.} 24 | \item{f}{Object of class \code{"numeric"}: The scalar appearing on the 25 | right-hand side of a second-order cone constraint.} 26 | } 27 | 28 | \details{ 29 | A second-order cone constraint is given as \eqn{|| Fx + g ||_2 \le d'x 30 | + f}. The matrix \eqn{G} is created as \eqn{G = [-d, -F]} and the 31 | vector \eqn{h} is constructed as \eqn{h = [f, g]}. 32 | } 33 | 34 | \value{ 35 | List with elements: \code{conType}, \code{G} and \code{h}. 36 | } 37 | 38 | \keyword{classes} 39 | -------------------------------------------------------------------------------- /src/CONEC.cpp: -------------------------------------------------------------------------------- 1 | #include "cccp.h" 2 | /* 3 | * 4 | * Methods for CONEC 5 | * 6 | */ 7 | using namespace arma; 8 | /* 9 | * Inner product of two vectors in S. 10 | */ 11 | vec CONEC::sdot(mat s, mat z){ 12 | vec ans = zeros(K); 13 | 14 | for(int i = 0; i < K; i++){ 15 | if(cone[i] != "PSDC") { 16 | ans.at(i) = sdot_nlp(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 17 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all)); 18 | } else { 19 | ans.at(i) = sdot_s(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 20 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 21 | dims[i]); 22 | } 23 | } 24 | 25 | return ans; 26 | } 27 | /* 28 | * Norm of a vectors in S. 29 | */ 30 | double CONEC::snrm2(mat s){ 31 | double ans = 0.0; 32 | 33 | for(int i = 0; i < K; i++){ 34 | if(cone[i] != "PSDC"){ 35 | ans += snrm2_nlp(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all)); 36 | } else { 37 | ans += snrm2_s(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), dims[i]); 38 | } 39 | } 40 | 41 | return ans; 42 | } 43 | /* 44 | * Product between two vectors in S. 45 | */ 46 | mat CONEC::sprd(mat s, mat z){ 47 | mat ans(G.n_rows, 1); 48 | 49 | for(int i = 0; i < K; i++){ 50 | if((cone[i] == "NLFC") || (cone[i] == "NNOC")){ 51 | ans(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = 52 | sprd_nl(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 53 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all)); 54 | } else if(cone[i] == "SOCC"){ 55 | ans(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = 56 | sprd_p(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 57 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all)); 58 | } else if(cone[i] == "PSDC"){ 59 | ans(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = 60 | sprd_s(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 61 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 62 | dims[i]); 63 | } 64 | } 65 | 66 | return ans; 67 | } 68 | /* 69 | * One-element (neutral) with respect to a vector in S. 70 | */ 71 | mat CONEC::sone(){ 72 | mat ans(G.n_rows, 1); 73 | 74 | for(int i = 0; i < K; i++){ 75 | if((cone[i] == "NLFC") || (cone[i] == "NNOC")){ 76 | ans(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = sone_nl(dims[i]); 77 | } else if(cone[i] == "SOCC"){ 78 | ans(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = sone_p(dims[i]); 79 | } else if(cone[i] == "PSDC"){ 80 | ans(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = sone_s(dims[i]); 81 | } 82 | } 83 | 84 | return ans; 85 | } 86 | /* 87 | * Inverse of product between two vectors in S. 88 | */ 89 | mat CONEC::sinv(mat s, mat z){ 90 | mat ans(G.n_rows, 1); 91 | 92 | for(int i = 0; i < K; i++){ 93 | if((cone[i] == "NLFC") || (cone[i] == "NNOC")){ 94 | ans(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = 95 | sinv_nl(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 96 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all)); 97 | } else if(cone[i] == "SOCC"){ 98 | ans(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = 99 | sinv_p(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 100 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all)); 101 | } else if(cone[i] == "PSDC"){ 102 | ans(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = 103 | sinv_s(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 104 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 105 | dims[i]); 106 | } 107 | } 108 | 109 | return ans; 110 | } 111 | /* 112 | * Determining maximum step-size of a vector in S. 113 | */ 114 | vec CONEC::smss(mat u){ 115 | vec ans = zeros(K); 116 | 117 | for(int i = 0; i < K; i++){ 118 | if((cone[i] == "NLFC") || (cone[i] == "NNOC")){ 119 | ans.at(i) = smss_nl(u(span(sidx.at(i, 0), sidx.at(i, 1)), span::all)); 120 | } else if(cone[i] == "SOCC"){ 121 | ans.at(i) = smss_p(u(span(sidx.at(i, 0), sidx.at(i, 1)), span::all)); 122 | } else if(cone[i] == "PSDC"){ 123 | ans.at(i) = smss_s(u(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), dims[i]); 124 | } 125 | } 126 | 127 | return ans; 128 | } 129 | /* 130 | * Applying maximum step-size to a vector in S (initial). 131 | */ 132 | mat CONEC::sams1(mat u, double alpha){ 133 | mat temp; 134 | 135 | for(int i = 0; i < K; i++){ 136 | temp = u(span(sidx.at(i, 0), sidx.at(i, 1)), span::all); 137 | if((cone[i] == "NLFC") || (cone[i] == "NNOC")){ 138 | temp = sams1_nl(temp, alpha); 139 | } else if(cone[i] == "SOCC"){ 140 | temp = sams1_p(temp, alpha); 141 | } else if(cone[i] == "PSDC"){ 142 | temp = sams1_s(temp, alpha, dims[i]); 143 | } 144 | u(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = temp; 145 | } 146 | 147 | return u; 148 | } 149 | /* 150 | Computation of Nesterov-Todd Scaling 151 | */ 152 | std::vector > CONEC::ntsc(mat s, mat z){ 153 | std::vector > WList; 154 | std::map W; 155 | 156 | for(int i = 0; i < K; i++){ 157 | if(cone[i] == "NLFC"){ 158 | W = ntsc_n(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 159 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all)); 160 | } else if(cone[i] == "NNOC"){ 161 | W = ntsc_l(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 162 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all)); 163 | } else if(cone[i] == "SOCC"){ 164 | W = ntsc_p(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 165 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all)); 166 | } else if(cone[i] == "PSDC"){ 167 | W = ntsc_s(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 168 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), dims[i]); 169 | } 170 | WList.push_back(W); 171 | W.erase(W.begin(), W.end()); 172 | } 173 | 174 | return WList; 175 | } 176 | /* 177 | Update of Nesterov-Todd Scaling 178 | */ 179 | std::vector > CONEC::ntsu(mat s, mat z, std::vector > WList){ 180 | std::map W; 181 | 182 | for(int i = 0; i < K; i++){ 183 | if(cone[i] == "NLFC"){ 184 | W = ntsu_n(WList[i], s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 185 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all)); 186 | } else if(cone[i] == "NNOC"){ 187 | W = ntsu_l(WList[i], s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 188 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all)); 189 | } else if(cone[i] == "SOCC"){ 190 | W = ntsu_p(WList[i], s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 191 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all)); 192 | } else if(cone[i] == "PSDC"){ 193 | W = ntsu_s(WList[i], s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 194 | z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), dims[i]); 195 | } 196 | WList[i] = W; 197 | } 198 | 199 | return WList; 200 | } 201 | /* 202 | * Scaling of vector in S by log-barrier function. 203 | */ 204 | mat CONEC::sslb(mat s, mat lambda, bool invers){ 205 | mat ans(G.n_rows, 1); 206 | 207 | for(int i = 0; i < K; i++){ 208 | if((cone[i] == "NLFC") || (cone[i] == "NNOC")){ 209 | ans(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = 210 | sslb_nl(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 211 | lambda(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), invers); 212 | } else if(cone[i] == "SOCC"){ 213 | ans(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = 214 | sslb_p(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 215 | lambda(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), invers); 216 | } else if(cone[i] == "PSDC"){ 217 | ans(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = 218 | sslb_s(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 219 | lambda(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), 220 | invers, dims[i]); 221 | } 222 | } 223 | 224 | return ans; 225 | } 226 | /* 227 | * Scaling of vector in S by Nesterov-Todd function. 228 | */ 229 | mat CONEC::ssnt(mat s, std::vector > WList, 230 | bool invers, bool transp){ 231 | 232 | for(int i = 0; i < K; i++){ 233 | if(cone[i] == "NLFC"){ 234 | s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = 235 | ssnt_n(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), WList[i], invers); 236 | } else if(cone[i] == "NNOC"){ 237 | s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = 238 | ssnt_l(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), WList[i], invers); 239 | } else if(cone[i] == "SOCC"){ 240 | s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = 241 | ssnt_p(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), WList[i], invers); 242 | } else if(cone[i] == "PSDC"){ 243 | s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = 244 | ssnt_s(s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), WList[i], invers, 245 | transp); 246 | } 247 | } 248 | 249 | return s; 250 | } 251 | /* 252 | Initial Nesterov-Todd scalings 253 | */ 254 | std::vector > CONEC::initnts(){ 255 | std::vector > WList; 256 | std::map W; 257 | mat ans; 258 | 259 | for(int i = 0; i < K; i++){ 260 | if(cone[i] == "NLFC"){ 261 | ans = ones(dims[i],1); 262 | W.insert(std::pair("dnl", ans)); 263 | W.insert(std::pair("dnli", ans)); 264 | ans = zeros(dims[i],1); 265 | W.insert(std::pair("lambda", ans)); 266 | } else if(cone[i] == "NNOC"){ 267 | ans = ones(dims[i],1); 268 | W.insert(std::pair("d", ans)); 269 | W.insert(std::pair("di", ans)); 270 | ans = zeros(dims[i],1); 271 | W.insert(std::pair("lambda", ans)); 272 | } else if(cone[i] == "SOCC"){ 273 | ans = ones(1,1); 274 | W.insert(std::pair("beta", ans)); 275 | ans = zeros(dims[i],1); 276 | ans.at(0,0) = 1.0; 277 | W.insert(std::pair("v", ans)); 278 | ans = zeros(dims[i],1); 279 | W.insert(std::pair("lambda", ans)); 280 | } else if(cone[i] == "PSDC"){ 281 | ans = eye(dims[i],dims[i]); 282 | W.insert(std::pair("r", ans)); 283 | W.insert(std::pair("rti", ans)); 284 | ans = zeros(dims[i] * dims[i], 1); 285 | W.insert(std::pair("lambda", ans)); 286 | } 287 | WList.push_back(W); 288 | W.erase(W.begin(), W.end()); 289 | } 290 | 291 | return WList; 292 | } 293 | /* 294 | Extracting Lagrange-Multipliers as matrix 295 | */ 296 | mat CONEC::getLambda(std::vector > WList){ 297 | mat ans(G.n_rows, 1); 298 | 299 | for(int i = 0; i < K; i++){ 300 | ans(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = WList[i]["lambda"]; 301 | } 302 | 303 | return ans; 304 | } 305 | /* 306 | Computation of: Sum of G_i'W_i^-1W_i^-1'G_i for i = 1, ..., K 307 | */ 308 | mat CONEC::gwwg(std::vector > WList){ 309 | int n = G.n_cols; 310 | mat gwwg(n,n), temp(n,n), witg, wiwitg; 311 | gwwg.zeros(); 312 | temp.zeros(); 313 | 314 | for(int i = 0; i < K; i++){ 315 | if(cone[i] == "NLFC"){ 316 | witg = ssnt_n(G(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), WList[i], true); 317 | wiwitg = ssnt_n(witg, WList[i], true); 318 | temp = G(span(sidx.at(i, 0), sidx.at(i, 1)), span::all).t() * wiwitg; 319 | } else if(cone[i] == "NNOC"){ 320 | witg = ssnt_l(G(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), WList[i], true); 321 | wiwitg = ssnt_l(witg, WList[i], true); 322 | temp = G(span(sidx.at(i, 0), sidx.at(i, 1)), span::all).t() * wiwitg; 323 | } else if(cone[i] == "SOCC"){ 324 | witg = ssnt_p(G(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), WList[i], true); 325 | wiwitg = ssnt_p(witg, WList[i], true); 326 | temp = G(span(sidx.at(i, 0), sidx.at(i, 1)), span::all).t() * wiwitg; 327 | } else if(cone[i] == "PSDC"){ 328 | witg = ssnt_s(G(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), WList[i], true, true); 329 | wiwitg = ssnt_s(witg, WList[i], true, false); 330 | temp = G(span(sidx.at(i, 0), sidx.at(i, 1)), span::all).t() * wiwitg; 331 | } 332 | gwwg = gwwg + temp; 333 | } 334 | 335 | return gwwg; 336 | } 337 | /* 338 | Computation of: Sum of G_i'W_i^-1W_i^-1'G_i for i = 1, ..., K 339 | */ 340 | mat CONEC::gwwz(std::vector > WList, mat z){ 341 | int n = G.n_cols; 342 | mat gwwz(n,1), temp(n,1), witz, wiwitz; 343 | gwwz.zeros(); 344 | temp.zeros(); 345 | 346 | for(int i = 0; i < K; i++){ 347 | if(cone[i] == "NLFC"){ 348 | witz = ssnt_n(z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), WList[i], true); 349 | wiwitz = ssnt_n(witz, WList[i], true); 350 | temp = G(span(sidx.at(i, 0), sidx.at(i, 1)), span::all).t() * wiwitz; 351 | } else if(cone[i] == "NNOC"){ 352 | witz = ssnt_l(z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), WList[i], true); 353 | wiwitz = ssnt_l(witz, WList[i], true); 354 | temp = G(span(sidx.at(i, 0), sidx.at(i, 1)), span::all).t() * wiwitz; 355 | } else if(cone[i] == "SOCC"){ 356 | witz = ssnt_p(z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), WList[i], true); 357 | wiwitz = ssnt_p(witz, WList[i], true); 358 | temp = G(span(sidx.at(i, 0), sidx.at(i, 1)), span::all).t() * wiwitz; 359 | } else if(cone[i] == "PSDC"){ 360 | witz = ssnt_s(z(span(sidx.at(i, 0), sidx.at(i, 1)), span::all), WList[i], true, true); 361 | wiwitz = ssnt_s(witz, WList[i], true, false); 362 | temp = G(span(sidx.at(i, 0), sidx.at(i, 1)), span::all).t() * wiwitz; 363 | } 364 | gwwz = gwwz + temp; 365 | } 366 | 367 | return gwwz; 368 | } 369 | /* 370 | Initializing PDV 371 | */ 372 | PDV* CONEC::initpdv(int p){ 373 | PDV* pdv = new PDV(); 374 | mat s(G.n_rows, 1); 375 | mat ans; 376 | 377 | pdv->x = zeros(n,1); 378 | pdv->y = zeros(p,1); 379 | for(int i = 0; i < K; i++){ 380 | if((cone[i] == "NLFC") || (cone[i] == "NNOC")){ 381 | ans = ones(dims[i], 1); 382 | } else if(cone[i] == "SOCC"){ 383 | ans = zeros(dims[i], 1); 384 | ans.at(0,0) = 1.0; 385 | } else if(cone[i] == "PSDC") { 386 | ans = eye(dims[i],dims[i]); 387 | ans.reshape(dims[i] * dims[i], 1); 388 | } else { 389 | ans = zeros(dims[i], 1); 390 | } 391 | s(span(sidx.at(i, 0), sidx.at(i, 1)), span::all) = ans; 392 | } 393 | pdv->s = s; 394 | pdv->z = s; 395 | pdv->tau = 1.0; 396 | pdv->kappa = 1.0; 397 | 398 | return pdv; 399 | } 400 | /* 401 | Updating Slack-variables 402 | */ 403 | mat CONEC::SorZupdate(mat SorZ, mat Lambda, double step){ 404 | vec eval; 405 | mat tmpmat, evec; 406 | 407 | for(int j = 0; j < K; j++){ 408 | if((cone[j] == "NLFC") || (cone[j] == "NNOC")){ 409 | SorZ(span(sidx.at(j, 0), sidx.at(j, 1)), span::all) = \ 410 | sams2_nl(SorZ(span(sidx.at(j, 0), sidx.at(j, 1)), span::all), step); 411 | SorZ(span(sidx.at(j, 0), sidx.at(j, 1)), span::all) = \ 412 | sslb_nl(SorZ(span(sidx.at(j, 0), sidx.at(j, 1)), span::all), \ 413 | Lambda(span(sidx.at(j, 0), sidx.at(j, 1)), span::all), true); 414 | } else if(cone[j] == "SOCC"){ 415 | SorZ(span(sidx.at(j, 0), sidx.at(j, 1)), span::all) = \ 416 | sams2_p(SorZ(span(sidx.at(j, 0), sidx.at(j, 1)), span::all), step); 417 | SorZ(span(sidx.at(j, 0), sidx.at(j, 1)), span::all) = \ 418 | sslb_p(SorZ(span(sidx.at(j, 0), sidx.at(j, 1)), span::all), \ 419 | Lambda(span(sidx.at(j, 0), sidx.at(j, 1)), span::all), true); 420 | } else if(cone[j] == "PSDC"){ 421 | tmpmat = SorZ(span(sidx.at(j, 0), sidx.at(j, 1)), span::all); 422 | tmpmat.reshape(dims[j], dims[j]); 423 | eig_sym(eval, evec, tmpmat); 424 | evec.reshape(dims[j] * dims[j], 1); 425 | SorZ(span(sidx.at(j, 0), sidx.at(j, 1)), span::all) = \ 426 | sslb_s(evec, Lambda(span(sidx.at(j, 0), sidx.at(j, 1)), span::all), \ 427 | true, dims[j]); 428 | SorZ(span(sidx.at(j, 0), sidx.at(j, 1)), span::all) = \ 429 | sams2_s(SorZ(span(sidx.at(j, 0), sidx.at(j, 1)), span::all), \ 430 | step, Lambda(span(sidx.at(j, 0), sidx.at(j, 1)), span::all), \ 431 | eval, dims[j]); 432 | } 433 | } 434 | 435 | return SorZ; 436 | } 437 | -------------------------------------------------------------------------------- /src/DCP.cpp: -------------------------------------------------------------------------------- 1 | #include "cccp.h" 2 | /* 3 | * 4 | * Methods for Convex Programs with nonlinear constraints 5 | * 6 | */ 7 | using namespace arma; 8 | /* 9 | Primal objective 10 | */ 11 | double DCP::pobj(PDV& pdv){ 12 | double ans = pdv.x.at(pdv.x.n_rows - 1, 0); 13 | return ans; 14 | } 15 | /* 16 | Dual objective 17 | */ 18 | double DCP::dobj(PDV& pdv){ 19 | double term1 = 0.0, term2 = 0.0, term3 = 0.0, ans; 20 | term1 = pdv.x(pdv.x.n_rows - 1, 0); 21 | if(cList.K > 1){ 22 | for(int i = 1; i < cList.K; i++){ 23 | term2 += dot(pdv.z(span(cList.sidx.at(i, 0), cList.sidx.at(i, 1)), span::all), 24 | cList.G(span(cList.sidx.at(i, 0), cList.sidx.at(i, 1)), span::all) * 25 | pdv.x - 26 | cList.h(span(cList.sidx.at(i, 0), cList.sidx.at(i, 1)), span::all)); 27 | } 28 | } 29 | term2 += dot(pdv.z(span(cList.sidx.at(0, 0), cList.sidx.at(0, 1)), span::all), 30 | cList.h(span(cList.sidx.at(0, 0), cList.sidx.at(0, 1)), span::all)); 31 | term3 = dot(pdv.y, (A * pdv.x - b)); 32 | ans = term1 + term2 + term3; 33 | 34 | return ans; 35 | } 36 | /* 37 | Primal Residuals 38 | */ 39 | mat DCP::rprim(PDV& pdv){ 40 | int p = A.n_rows; 41 | mat ans(p, 1); 42 | ans.zeros(); 43 | 44 | ans = b - A * pdv.x; 45 | 46 | return ans; 47 | } 48 | /* 49 | Centrality Residuals 50 | */ 51 | mat DCP::rcent(PDV& pdv){ 52 | mat ans(cList.G.n_rows, 1); 53 | 54 | ans(span(cList.sidx.at(0, 0), cList.sidx.at(0, 1)), span::all) = 55 | pdv.s(span(cList.sidx.at(0, 0), cList.sidx.at(0, 1)), span::all) + 56 | cList.h(span(cList.sidx.at(0, 0), cList.sidx.at(0, 1)), span::all); 57 | 58 | if(cList.K > 1){ 59 | for(int i = 1; i < cList.K; i++){ 60 | ans(span(cList.sidx.at(i, 0), cList.sidx.at(i, 1)), span::all) = 61 | pdv.s(span(cList.sidx.at(i, 0), cList.sidx.at(i, 1)), span::all) + 62 | cList.G(span(cList.sidx.at(i, 0), cList.sidx.at(i, 1)), span::all) * pdv.x - 63 | cList.h(span(cList.sidx.at(i, 0), cList.sidx.at(i, 1)), span::all); 64 | } 65 | } 66 | 67 | return ans; 68 | } 69 | /* 70 | Dual Residuals 71 | */ 72 | mat DCP::rdual(PDV& pdv){ 73 | int n = x0.n_rows; 74 | mat Gz(n,1); 75 | mat Ay(n,1); 76 | mat ans(n,1); 77 | Gz.zeros(); 78 | Ay.zeros(); 79 | ans.zeros(); 80 | 81 | Gz = cList.G.t() * pdv.z; 82 | 83 | if(A.n_rows > 0){ 84 | Ay = A.t() * pdv.y; 85 | } 86 | ans = Gz + Ay; 87 | ans.at(ans.n_rows - 1, 0) += 1.0; 88 | 89 | return ans; 90 | } 91 | /* 92 | Certificate of primal infeasibilty 93 | */ 94 | double DCP::certp(PDV& pdv){ 95 | double nomin, denom, ans1 = 0.0, ans2 = 0.0, ans = 0.0; 96 | mat rz; 97 | 98 | nomin = norm(rprim(pdv)); 99 | denom = std::max(1.0, norm(b)); 100 | ans1 = nomin / denom; 101 | 102 | rz = rcent(pdv); 103 | ans2 = cList.snrm2(rz); 104 | 105 | ans = std::max(ans1, ans2); 106 | 107 | return ans; 108 | } 109 | /* 110 | Certificate of dual infeasibilty 111 | */ 112 | double DCP::certd(PDV& pdv){ 113 | double ans; 114 | 115 | ans = norm(rdual(pdv)); 116 | 117 | return ans; 118 | } 119 | /* 120 | Solving 'KKT-System' 121 | */ 122 | PDV* DCP::sxyz(PDV* pdv, mat LHS, std::vector > WList){ 123 | 124 | int n = x0.n_rows; 125 | int ne = n - 1; 126 | int mnl = cList.dims(0); 127 | int K = cList.K; 128 | double a = pdv->z.at(0, 0); // Slack with respect to f0 129 | double x1 = pdv->x.at(pdv->x.n_rows, 0); // Epigraph-variable 't' 130 | mat ux = mat(ne, 1), uz = pdv->z, RHS(ne + A.n_rows, 1), ans(ne + A.n_rows, 1); 131 | CONEC cEpi = cList; 132 | std::vector > WEpi = WList; 133 | 134 | cEpi.n -= 1; 135 | cEpi.G.set_size(cList.G.n_rows, ne); 136 | cEpi.G = cList.G(span::all, span(0, ne - 1)); // removing last column 137 | ux = pdv->x(span(0, ne - 1), span::all); 138 | ux = ux + pdv->x.at(n - 1, 0) * cEpi.G.row(0).t(); 139 | 140 | // Distinguishing four cases: 141 | // mnl == 1 and K == 1: only f0 and no cone constraints 142 | // mnl == 1 and K > 1 : only f0 and cone constraints 143 | // mnl > 1 and K == 1 : f0 and other nonlinear constraints; no cone constraints 144 | // mnl > 1 and K > 1 : f0 and other nonlinear constraints and cone constraints 145 | // Problem to be solved is reduced to x0 146 | 147 | // mnl == 1 and K == 1 148 | if((mnl == 1) && (K == 1)){ 149 | // upper LHS is only Hessian 150 | RHS.submat(0, 0, ne - 1, 0) = ux; 151 | } 152 | // mnl == 1 and K > 1 153 | if((mnl == 1) && (K > 1)){ 154 | WEpi.erase(WEpi.begin()); 155 | cEpi.K -= 1; 156 | cEpi.G = cEpi.G(span(1, cEpi.G.n_rows - 1), span::all); // removing first row pertinent to f0 157 | cEpi.h = cEpi.h(span(1, cEpi.G.n_rows - 1), span::all); // removing first row pertinent to f0 158 | cEpi.sidx = cEpi.sidx(span(1, cEpi.sidx.n_rows - 1), span::all); 159 | cEpi.sidx -= 1; 160 | cEpi.sidx.at(0, 0) = 0; 161 | cEpi.cone.erase(cEpi.cone.begin()); 162 | cEpi.dims.shed_row(0); 163 | LHS.submat(0, 0, ne - 1, ne - 1) += cEpi.gwwg(WEpi); 164 | uz = uz(span(1, uz.n_rows - 1), span::all); 165 | RHS.submat(0, 0, ne - 1, 0) = ux + cEpi.gwwz(WEpi, uz); 166 | } 167 | // mnl > 1 and K == 1 168 | if((mnl > 1) && (K == 1)){ 169 | WEpi[0]["dnl"] = WEpi[0]["dnl"](span(1, mnl - 1), span::all); 170 | WEpi[0]["dnli"] = WEpi[0]["dnli"](span(1, mnl - 1), span::all); 171 | cEpi.dims(0) -= 1; 172 | cEpi.sidx(0, 1) -= 1; 173 | cEpi.G = cEpi.G(span(1, cEpi.G.n_rows - 1), span::all); // removing first row pertinent to f0 174 | cEpi.h = cEpi.h(span(1, cEpi.G.n_rows - 1), span::all); // removing first row pertinent to f0 175 | LHS.submat(0, 0, ne - 1, ne - 1) += cEpi.gwwg(WEpi); 176 | uz = uz(span(1, uz.n_rows - 1), span::all); 177 | RHS.submat(0, 0, ne - 1, 0) = ux + cEpi.gwwz(WEpi, uz); 178 | } 179 | // mnl > 1 and K > 1 180 | if((mnl > 1) && (K > 1)){ 181 | WEpi[0]["dnl"] = WEpi[0]["dnl"](span(1, mnl - 1), span::all); 182 | WEpi[0]["dnli"] = WEpi[0]["dnli"](span(1, mnl - 1), span::all); 183 | cEpi.dims(0) -= 1; 184 | cEpi.sidx = cEpi.sidx - 1; 185 | cEpi.sidx(0, 0) = 0; 186 | cEpi.G = cEpi.G(span(1, cEpi.G.n_rows - 1), span::all); // removing first row pertinent to f0 187 | cEpi.h = cEpi.h(span(1, cEpi.G.n_rows - 1), span::all); // removing first row pertinent to f0 188 | LHS.submat(0, 0, ne - 1, ne - 1) += cEpi.gwwg(WEpi); 189 | uz = uz(span(1, uz.n_rows - 1), span::all); 190 | RHS.submat(0, 0, ne - 1, 0) = ux + cEpi.gwwz(WEpi, uz); 191 | } 192 | if(pdv->y.n_rows > 0){ 193 | RHS.submat(ne, 0, RHS.n_rows - 1, 0) = pdv->y; 194 | } 195 | // Solving KKT-system 196 | ans = solve(LHS, RHS); 197 | // Preparing pdv 198 | pdv->x.submat(0, 0, ne - 1, 0) = ans.submat(0, 0, ne - 1, 0); 199 | if(pdv->y.n_rows > 0){ 200 | pdv->y = ans.submat(ne, 0, RHS.n_rows - 1, 0); 201 | } 202 | uz = cEpi.G * pdv->x.submat(0, 0, ne - 1, 0) - uz; 203 | if((mnl > 1) || (K > 1)){ 204 | pdv->z(span(1, pdv->z.n_rows - 1), span::all) = cEpi.ssnt(uz, WEpi, true, true); 205 | } 206 | pdv->z.at(0, 0) = -pdv->x.at(pdv->x.n_rows - 1, 0) * WList[0]["dnl"].at(0, 0); 207 | x1 = dot(cList.G.submat(0, 0, 0, ne - 1), pdv->x.submat(0, 0, ne - 1, 0)) + 208 | pow(WList[0]["dnl"].at(0, 0), 2) * pdv->x.at(n - 1, 0) - a; 209 | pdv->x.at(n - 1, 0) = x1; 210 | return pdv; 211 | } 212 | /* 213 | Main routine for solving a Convex Program with nonlinear constraints 214 | */ 215 | CPS* DCP::cps(CTRL& ctrl){ 216 | // Initializing objects 217 | PDV* pdv = cList.initpdv(A.n_rows); 218 | PDV* dpdv = cList.initpdv(A.n_rows); 219 | pdv->x = x0; 220 | Rcpp::List nF(nList[0]); 221 | Rcpp::List gF(nList[1]); 222 | Rcpp::List hF(nList[2]); 223 | 224 | CPS* cps = new CPS(); 225 | cps->set_pdv(*pdv); 226 | cps->set_sidx(cList.sidx); 227 | Rcpp::NumericVector state = cps->get_state(); 228 | bool checkRgap = false, backTrack; 229 | int m = sum(cList.dims), mnl = cList.dims(0), n = cList.n, 230 | ne = n - 1, sizeLHS = A.n_rows + A.n_cols - 1; 231 | double gap = m, resx, resy, resz, pcost, dcost, rgap = NA_REAL, 232 | pres, dres, pres0 = 1.0, dres0 = 1.0, sigma, mu, ts, tz, tm, step; 233 | vec ss(3), Fval(mnl); 234 | mat H = zeros(ne, ne), rx, ry, rz, Lambda, LambdaPrd, Ws3, x; 235 | mat OneE = cList.sone(); 236 | mat LHS(sizeLHS, sizeLHS); 237 | // Initialising LHS matrices 238 | LHS.zeros(); 239 | if(A.n_rows > 0){ // equality constraints 240 | LHS.submat(ne, 0, sizeLHS - 1, ne - 1) = A(span::all, span(0, ne - 1)); 241 | LHS.submat(0, ne, ne - 1, sizeLHS - 1) = A(span::all, span(0, ne - 1)).t(); 242 | } 243 | std::vector > WList; 244 | // Setting control parameters 245 | Rcpp::List params(ctrl.get_params()); 246 | bool trace = Rcpp::as(params["trace"]); 247 | int maxiters = Rcpp::as(params["maxiters"]); 248 | double atol = Rcpp::as(params["abstol"]); 249 | double ftol = Rcpp::as(params["feastol"]); 250 | double rtol = Rcpp::as(params["reltol"]); 251 | double sadj = Rcpp::as(params["stepadj"]); 252 | double beta = Rcpp::as(params["beta"]); 253 | // 254 | // Starting iterations 255 | // 256 | for(int i = 0; i < maxiters; i++){ 257 | H.zeros(); 258 | for(int j = 0; j < mnl; j++){ 259 | // Setting f to first mnl-rows of h-matrix 260 | cList.h(j, 0) = feval(pdv->x(span(0, ne - 1), span::all), nF[j]); 261 | // Setting Df to first mnl-rows of G-matrix 262 | cList.G(j, span(0, ne - 1)) = geval(pdv->x(span(0, ne - 1), span::all), gF[j]).t(); 263 | // Computing Hessian 264 | H += pdv->z.at(j, 0) * heval(pdv->x(span(0, ne - 1), span::all), hF[j]); 265 | } 266 | cList.h(0, 0) = cList.h(0, 0) - pdv->x.at(n - 1, 0); 267 | // Computing gap 268 | gap = sum(cList.sdot(pdv->s, pdv->z)); 269 | // Computing residuals 270 | // Dual Residuals 271 | rx = rdual(*pdv); 272 | resx = norm(rx); 273 | // Primal Residuals 274 | ry = rprim(*pdv); 275 | resy = norm(ry); 276 | // Central Residuals 277 | rz = rcent(*pdv); 278 | resz = cList.snrm2(rz); 279 | // Statistics for stopping criteria 280 | pcost = pobj(*pdv); 281 | dcost = pcost + dot(ry, pdv->y) + sum(cList.sdot(rz, pdv->z)) - gap; 282 | rgap = NA_REAL; 283 | if(pcost < 0.0) rgap = gap / (-pcost); 284 | if(dcost > 0.0) rgap = gap / dcost; 285 | pres = sqrt(resy * resy + resz * resz); 286 | dres = resx; 287 | if(i == 0){ 288 | pres0 = std::max(1.0, pres); 289 | dres0 = std::max(1.0, dres); 290 | } 291 | pres = pres / pres0; 292 | dres = dres / dres0; 293 | // Tracing status quo of IPM 294 | if(trace){ 295 | Rcpp::Rcout << "Iteration: " << i << std::endl; 296 | Rcpp::Rcout << "pobj: " << pcost << std::endl; 297 | Rcpp::Rcout << "dobj: " << dcost << std::endl; 298 | Rcpp::Rcout << "pinf: " << pres << std::endl; 299 | Rcpp::Rcout << "dinf: " << dres << std::endl; 300 | Rcpp::Rcout << "dgap: " << gap << std::endl; 301 | Rcpp::Rcout << std::endl; 302 | } 303 | // Checking convergence 304 | if(!std::isnan(rgap)){ 305 | checkRgap = (rgap <= rtol); 306 | } else { 307 | checkRgap = false; 308 | } 309 | if((pres <= ftol) && (dres <= ftol) && ((gap <= atol) || checkRgap)){ 310 | ts = cList.smss(pdv->s).max(); 311 | tz = cList.smss(pdv->z).max(); 312 | state["pobj"] = pcost; 313 | state["dobj"] = dcost; 314 | state["dgap"] = gap; 315 | state["certp"] = pres; 316 | state["certd"] = dres; 317 | state["pslack"] = -ts; 318 | state["dslack"] = -tz; 319 | if(!std::isnan(rgap)){ 320 | state["rgap"] = rgap; 321 | } 322 | cps->set_state(state); 323 | cps->set_status("optimal"); 324 | cps->set_niter(i); 325 | cps->set_pdv(*pdv); 326 | cps->pdv.x.reshape(ne, 1); // removing variable 't' 327 | if((mnl == 1) && (cList.K == 1)){ // removing slack variables pertinent to 't' 328 | cps->pdv.s.set_size(0, 0); 329 | cps->pdv.z.set_size(0, 0); 330 | cps->set_sidx(umat()); 331 | } 332 | if((mnl > 1) && (cList.K == 1)){ // removing slack variables pertinent to 't' 333 | cps->pdv.s.set_size(cList.dims[0] - 1, 1); 334 | cps->pdv.z.set_size(cList.dims[0] - 1, 1); 335 | cps->pdv.s = pdv->s.submat(1, 0, cList.dims[0] - 1, 0); 336 | cps->pdv.z = pdv->z.submat(1, 0, cList.dims[0] - 1, 0); 337 | umat sidxEpi = cList.sidx; 338 | sidxEpi.at(0, 1) -= 1; 339 | cps->set_sidx(sidxEpi); 340 | } 341 | if((mnl == 1) && (cList.K > 1)){ // removing slack variables pertinent to 't' 342 | cps->pdv.s.set_size(cList.G.n_rows - 1, 1); 343 | cps->pdv.z.set_size(cList.G.n_rows - 1, 1); 344 | cps->pdv.s = pdv->s.submat(1, 0, cList.G.n_rows - 1, 0); 345 | cps->pdv.z = pdv->z.submat(1, 0, cList.G.n_rows - 1, 0); 346 | umat sidxEpi = cList.sidx; 347 | sidxEpi.shed_row(0); 348 | sidxEpi -= 1; 349 | sidxEpi.at(0, 0) = 0; 350 | cps->set_sidx(sidxEpi); 351 | } 352 | if(trace){ 353 | Rcpp::Rcout << "Optimal solution found." << std::endl; 354 | } 355 | return cps; 356 | } 357 | // Compute initial scalings 358 | if(i == 0){ 359 | WList = cList.ntsc(pdv->s, pdv->z); 360 | Lambda = cList.getLambda(WList); 361 | } 362 | LambdaPrd = cList.sprd(Lambda, Lambda); 363 | LHS.submat(0, 0, ne - 1, ne - 1) = H; 364 | sigma = 0.0; 365 | // Finding solution of increments in two-round loop 366 | // (same for affine and combined solution) 367 | for(int ii = 0; ii < 2; ii++){ 368 | mu = gap / m; 369 | dpdv->s = -1.0 * LambdaPrd + OneE * sigma * mu; 370 | dpdv->x = -1.0 * rx; 371 | dpdv->y = -1.0 * ry; 372 | dpdv->z = -1.0 * rz; 373 | // Solving KKT-system 374 | try{ 375 | dpdv->s = cList.sinv(dpdv->s, Lambda); 376 | Ws3 = cList.ssnt(dpdv->s, WList, false, true); 377 | dpdv->z = dpdv->z - Ws3; 378 | dpdv = sxyz(dpdv, LHS, WList); 379 | dpdv->s = dpdv->s - dpdv->z; 380 | } catch(std::runtime_error &ex) { 381 | ts = cList.smss(pdv->s).max(); 382 | tz = cList.smss(pdv->z).max(); 383 | state["pobj"] = pcost; 384 | state["dobj"] = dcost; 385 | state["dgap"] = gap; 386 | state["certp"] = pres; 387 | state["certd"] = dres; 388 | state["pslack"] = -ts; 389 | state["dslack"] = -tz; 390 | if(!std::isnan(rgap)){ 391 | state["rgap"] = rgap; 392 | } 393 | cps->set_state(state); 394 | cps->set_status("unknown"); 395 | cps->set_niter(i); 396 | cps->set_pdv(*pdv); 397 | if(trace){ 398 | Rcpp::Rcout << "Terminated (singular KKT matrix)." << std::endl; 399 | } 400 | return cps; 401 | } catch(...) { 402 | ::Rf_error("C++ exception (unknown reason)"); 403 | } 404 | // Maximum step to boundary 405 | dpdv->s = cList.sslb(dpdv->s, Lambda, false); 406 | dpdv->z = cList.sslb(dpdv->z, Lambda, false); 407 | ts = cList.smss(dpdv->s).max(); 408 | tz = cList.smss(dpdv->z).max(); 409 | ss = { 0.0, ts, tz }; 410 | tm = ss.max(); 411 | if(tm == 0.0){ 412 | step = 1.0; 413 | } else { 414 | step = std::min(1.0, sadj / tm); 415 | } 416 | // Backtracking until x is in the domain of f 417 | backTrack = true; 418 | while(backTrack){ 419 | x = pdv->x + step * dpdv->x; 420 | for(int j = 0; j < mnl; j++){ 421 | Fval(j) = feval(x(span(0, ne - 1), span::all), nF[j]); 422 | } 423 | Fval[0] -= x.at(n - 1, 0); 424 | if(is_finite(Fval)){ 425 | backTrack = false; 426 | } else { 427 | step *= beta; 428 | } 429 | } // end while-loop domain of f 430 | if(ii == 0){ 431 | sigma = pow((1.0 - step), 3.0); 432 | } 433 | } // end ii-loop 434 | 435 | // Updating x, y; s and z (in current scaling) 436 | pdv->x = pdv->x + step * dpdv->x; 437 | pdv->y = pdv->y + step * dpdv->y; 438 | 439 | dpdv->s = cList.SorZupdate(dpdv->s, Lambda, step); 440 | dpdv->z = cList.SorZupdate(dpdv->z, Lambda, step); 441 | 442 | // Updating NT-scaling and Lagrange Multipliers 443 | WList = cList.ntsu(dpdv->s, dpdv->z, WList); 444 | Lambda = cList.getLambda(WList); 445 | pdv->s = cList.ssnt(Lambda, WList, false, true); 446 | pdv->z = cList.ssnt(Lambda, WList, true, false); 447 | gap = sum(cList.sdot(Lambda, Lambda)); 448 | } // end i-loop 449 | 450 | // Preparing result for non-convergence in maxiters iterations 451 | cps->set_pdv(*pdv); 452 | cps->pdv.x.reshape(ne, 1); 453 | cps->set_sidx(cList.sidx); 454 | state["pobj"] = pobj(*pdv); 455 | state["dobj"] = dobj(*pdv); 456 | state["dgap"] = gap; 457 | state["certp"] = certp(*pdv); 458 | state["certd"] = certd(*pdv); 459 | ts = cList.smss(pdv->s).max(); 460 | tz = cList.smss(pdv->z).max(); 461 | state["pslack"] = -ts; 462 | state["dslack"] = -tz; 463 | if(!std::isnan(rgap)){ 464 | state["rgap"] = rgap; 465 | } 466 | cps->set_state(state); 467 | cps->set_niter(maxiters); 468 | cps->set_status("unknown"); 469 | if(trace){ 470 | Rcpp::Rcout << "Optimal solution not determined in " << maxiters << " iteration(s)." << std::endl; 471 | } 472 | if((mnl == 1) && (cList.K == 1)){ // removing slack variables pertinent to 't' 473 | cps->pdv.s.set_size(0, 0); 474 | cps->pdv.z.set_size(0, 0); 475 | cps->set_sidx(umat()); 476 | } 477 | if((mnl > 1) && (cList.K == 1)){ // removing slack variables pertinent to 't' 478 | cps->pdv.s.set_size(cList.dims[0] - 1, 1); 479 | cps->pdv.z.set_size(cList.dims[0] - 1, 1); 480 | cps->pdv.s = pdv->s.submat(1, 0, cList.dims[0] - 1, 0); 481 | cps->pdv.z = pdv->z.submat(1, 0, cList.dims[0] - 1, 0); 482 | umat sidxEpi = cList.sidx; 483 | sidxEpi.at(0, 1) -= 1; 484 | cps->set_sidx(sidxEpi); 485 | } 486 | if((mnl == 1) && (cList.K > 1)){ // removing slack variables pertinent to 't' 487 | cps->pdv.s.set_size(cList.G.n_rows - 1, 1); 488 | cps->pdv.z.set_size(cList.G.n_rows - 1, 1); 489 | cps->pdv.s = pdv->s.submat(1, 0, cList.G.n_rows - 1, 0); 490 | cps->pdv.z = pdv->z.submat(1, 0, cList.G.n_rows - 1, 0); 491 | umat sidxEpi = cList.sidx; 492 | sidxEpi.shed_row(0); 493 | sidxEpi -= 1; 494 | sidxEpi.at(0, 0) = 0; 495 | cps->set_sidx(sidxEpi); 496 | } 497 | 498 | return cps; 499 | } 500 | -------------------------------------------------------------------------------- /src/DLP.cpp: -------------------------------------------------------------------------------- 1 | #include "cccp.h" 2 | /* 3 | * 4 | * Methods for Linear Programs 5 | * 6 | */ 7 | using namespace arma; 8 | /* 9 | Primal objective 10 | */ 11 | double DLP::pobj(PDV& pdv){ 12 | double ans = dot(pdv.x, q); 13 | return ans; 14 | } 15 | /* 16 | Dual objective 17 | */ 18 | double DLP::dobj(PDV& pdv){ 19 | double term1 = 0.0, term2 = 0.0, ans; 20 | term1 = dot(b, pdv.y); 21 | term2 = sum(cList.sdot(pdv.z, cList.h)); 22 | ans = -term1 - term2; 23 | return ans; 24 | } 25 | /* 26 | Primal Residuals 27 | */ 28 | mat DLP::rprim(PDV& pdv){ 29 | int p = A.n_rows; 30 | mat ans(p,1); 31 | ans.zeros(); 32 | 33 | ans = b - A * pdv.x; 34 | 35 | return ans; 36 | } 37 | /* 38 | Centrality Residuals 39 | */ 40 | mat DLP::rcent(PDV& pdv){ 41 | mat ans(cList.G.n_rows, 1); 42 | 43 | ans = pdv.s + cList.G * pdv.x - cList.h; 44 | 45 | return ans; 46 | } 47 | /* 48 | Dual Residuals 49 | */ 50 | mat DLP::rdual(PDV& pdv){ 51 | int n = q.n_rows; 52 | mat Gz(n,1); 53 | mat Ay(n,1); 54 | mat ans(n,1); 55 | Gz.zeros(); 56 | Ay.zeros(); 57 | ans.zeros(); 58 | 59 | if(cList.K > 0){ 60 | Gz = cList.G.t() * pdv.z; 61 | } 62 | if(A.n_rows > 0){ 63 | Ay = A.t() * pdv.y; 64 | } 65 | ans = q + Gz + Ay; 66 | 67 | return ans; 68 | } 69 | /* 70 | Certificate of primal infeasibilty 71 | */ 72 | double DLP::certp(PDV& pdv){ 73 | double nomin, denom, ans1 = 0.0, ans2 = 0.0, ans = 0.0; 74 | 75 | nomin = norm(rprim(pdv)); 76 | denom = std::max(1.0, norm(b)); 77 | ans1 = nomin / denom; 78 | 79 | if(cList.K > 0){ 80 | mat rz; 81 | rz = rcent(pdv); 82 | nomin = 0.0; 83 | denom = std::max(1.0, norm(q)); 84 | nomin = cList.snrm2(rz); 85 | ans2 = nomin / denom; 86 | } 87 | ans = std::max(ans1, ans2); 88 | 89 | return ans; 90 | } 91 | /* 92 | Certificate of dual infeasibilty 93 | */ 94 | double DLP::certd(PDV& pdv){ 95 | double nomin, denom, ans; 96 | 97 | nomin = norm(rdual(pdv)); 98 | denom = std::max(1.0, norm(q)); 99 | ans = nomin / denom; 100 | 101 | return ans; 102 | } 103 | /* 104 | Solving 'KKT-System' 105 | */ 106 | PDV* DLP::sxyz(PDV* pdv, mat LHS, mat RHS, std::vector > WList){ 107 | int n = q.n_rows; 108 | mat lhs1, rhs1, ans; 109 | 110 | lhs1 = cList.gwwg(WList); 111 | LHS.submat(0, 0, n-1, n-1) = lhs1; 112 | rhs1 = cList.gwwz(WList, pdv->z); 113 | RHS.submat(0, 0, n - 1, 0) = pdv->x + rhs1; 114 | if(pdv->y.n_rows > 0){ 115 | RHS.submat(n, 0, RHS.n_rows - 1, 0) = pdv->y; 116 | } 117 | ans = solve(LHS, RHS, solve_opts::refine); 118 | pdv->x = ans.submat(0, 0, n - 1, 0); 119 | if(pdv->y.n_rows > 0){ 120 | pdv->y = ans.submat(n, 0, RHS.n_rows - 1, 0); 121 | } 122 | pdv->z = cList.G * pdv->x - pdv->z; 123 | pdv->z = cList.ssnt(pdv->z, WList, true, true); 124 | 125 | return pdv; 126 | } 127 | /* 128 | Main routine for solving a Linear Program 129 | */ 130 | CPS* DLP::cps(CTRL& ctrl){ 131 | // Initializing objects 132 | PDV* pdv = cList.initpdv(A.n_rows); 133 | PDV InitPrim, InitDual, KktSol; 134 | 135 | PDV* dpdv1 = cList.initpdv(A.n_rows); 136 | PDV* dpdv2 = cList.initpdv(A.n_rows); 137 | CPS* cps = new CPS(); 138 | cps->set_pdv(*pdv); 139 | cps->set_sidx(cList.sidx); 140 | bool checkRgap = false; 141 | int m = sum(cList.dims), n = cList.n, sizeLHS = A.n_rows + A.n_cols; 142 | double resx, resx0, resy, resy0, resz, resz0, pres, dres, 143 | ts, nrms, tz, nrmz, tt, tk, tm, pcost, dcost, gap, rgap = NA_REAL, 144 | hresx, hresy, hresz, hz, by, cx, rt, pinfres, dinfres, 145 | nomin, denom, dg = 1.0, dgi = 1.0, lg = 1.0, lgprd, dkdt = 0.0, mu, sigma, step; 146 | Rcpp::NumericVector state = cps->get_state(); 147 | vec ss(5); 148 | mat rx, ry, rz, hrx, hry, hrz, Lambda, LambdaPrd, Ws3, Wh, Whz, dsdz; 149 | mat OneE = cList.sone(); 150 | mat LHS(sizeLHS, sizeLHS); 151 | mat RHS(sizeLHS, 1); 152 | std::vector > WList; 153 | // Setting control parameters 154 | Rcpp::List params(ctrl.get_params()); 155 | bool trace = Rcpp::as(params["trace"]); 156 | int maxiters = Rcpp::as(params["maxiters"]); 157 | double atol = Rcpp::as(params["abstol"]); 158 | double ftol = Rcpp::as(params["feastol"]); 159 | double rtol = Rcpp::as(params["reltol"]); 160 | double sadj = Rcpp::as(params["stepadj"]); 161 | // Computing fixed values 162 | resx0 = std::max(1.0, norm(q)); 163 | resy0 = std::max(1.0, norm(b)); 164 | resz0 = std::max(1.0, cList.snrm2(cList.h)); 165 | // Initialising LHS matrices 166 | LHS.zeros(); 167 | if(A.n_rows > 0){ // equality constraints 168 | LHS.submat(n, 0, sizeLHS-1, n-1) = A; 169 | LHS.submat(0, n, n-1, sizeLHS-1) = A.t(); 170 | } 171 | // Computing initial values of PDV / CPS and scalings 172 | WList = cList.initnts(); 173 | // Primal Start 174 | InitPrim.x = zeros(n, 1); 175 | InitPrim.y = b; 176 | InitPrim.z = cList.h; 177 | InitPrim = *(sxyz(&InitPrim, LHS, RHS, WList)); 178 | InitPrim.s = -InitPrim.z; 179 | ts = cList.smss(InitPrim.s).max(); 180 | // Dual Start 181 | InitDual.x = -q; 182 | InitDual.y = zeros(b.n_rows, 1); 183 | InitDual.z = zeros(cList.h.n_rows, 1); 184 | InitDual = *(sxyz(&InitDual, LHS, RHS, WList)); 185 | tz = cList.smss(InitDual.z).max(); 186 | // Initial Point 187 | pdv->x = InitPrim.x; 188 | pdv->y = InitDual.y; 189 | pdv->s = InitPrim.s; 190 | pdv->z = InitDual.z; 191 | nrms = sum(cList.snrm2(pdv->s)); 192 | nrmz = sum(cList.snrm2(pdv->z)); 193 | // Initial point optimal? 194 | gap = sum(cList.sdot(pdv->s, pdv->z)); 195 | pcost = pobj(*pdv); 196 | dcost = -dot(b, pdv->y) - sum(cList.sdot(pdv->z, cList.h)); 197 | if(pcost < 0.0) rgap = gap / (-pcost); 198 | if(dcost > 0.0) rgap = gap / dcost; 199 | if(!std::isnan(rgap)){ 200 | checkRgap = (rgap <= rtol); 201 | } else { 202 | checkRgap = false; 203 | } 204 | if((ts <= ftol) && (tz <= ftol) && ((gap <= atol) || checkRgap)){ 205 | // Dual Residuals 206 | rx = rdual(*pdv); 207 | resx = norm(rx); 208 | // Primal Residuals 209 | ry = rprim(*pdv); 210 | resy = norm(ry); 211 | // Central Residuals 212 | rz = rcent(*pdv); 213 | resz = cList.snrm2(rz); 214 | pres = std::max(resy / resy0, resz / resz0); 215 | dres = resx / resx0; 216 | cps->set_pdv(*pdv); 217 | state["pobj"] = pobj(*pdv); 218 | state["dobj"] = dobj(*pdv); 219 | state["dgap"] = gap; 220 | state["certp"] = pres; 221 | state["certd"] = dres; 222 | state["pslack"] = -ts; 223 | state["dslack"] = -tz; 224 | if(!std::isnan(rgap)){ 225 | state["rgap"] = rgap; 226 | } 227 | cps->set_state(state); 228 | cps->set_status("optimal"); 229 | cps->set_niter(0); 230 | if(trace){ 231 | Rcpp::Rcout << "Optimal solution found." << std::endl; 232 | } 233 | return cps; 234 | } 235 | if(ts >= -1e-8 * std::max(1.0, nrms)){ 236 | pdv->s = cList.sams1(pdv->s, ts); 237 | } 238 | if(tz >= -1e-8 * std::max(1.0, nrmz)){ 239 | pdv->z = cList.sams1(pdv->z, tz); 240 | } 241 | // Duality gap for initial solution 242 | gap = sum(cList.sdot(pdv->s, pdv->z)); 243 | // 244 | // Starting iterations 245 | // 246 | for(int i = 0; i < maxiters; i++){ 247 | // Evaluate residuals, gap and stopping criteria 248 | // Dual residuals: hrx = -A'*y - G'z 249 | hrx = -(A.t() * pdv->y) - cList.G.t() * pdv->z; 250 | hresx = sqrt(dot(hrx, hrx)); 251 | // rx = hrx - c*tau = -A'*y - G'z - c*tau 252 | rx = hrx - q * pdv->tau; 253 | resx = sqrt(dot(rx, rx)) / pdv->tau; 254 | // Primal residuals 255 | hry = A * pdv->x; 256 | hresy = sqrt(dot(hry, hry)); 257 | // ry = hry - b*tau = A*x - b*tau 258 | ry = hry - b * pdv->tau; 259 | resy = sqrt(dot(ry, ry)) / pdv->tau; 260 | // Centrality residuals: hrz = s + G*x 261 | hrz = pdv->s + cList.G * pdv->x; 262 | hresz = cList.snrm2(hrz); 263 | // rz = hrz - h*tau = s + G*x - h*tau 264 | rz = hrz - cList.h * pdv->tau; 265 | resz = cList.snrm2(rz) / pdv->tau; 266 | // Self-dual residuals 267 | hz = sum(cList.sdot(cList.h, pdv->z)); 268 | by = dot(b, pdv->y); 269 | cx = dot(q, pdv->x); 270 | rt = pdv->kappa + cx + by + hz; 271 | // Statistics for stopping criteria 272 | pcost = cx / pdv->tau; 273 | dcost = -(by + hz) / pdv->tau; 274 | rgap = NA_REAL; 275 | if(pcost < 0.0) rgap = gap / (-pcost); 276 | if(dcost > 0.0) rgap = gap / dcost; 277 | pres = std::max(resy / resy0, resz / resz0); 278 | dres = resx / resx0; 279 | if(hz + by < 0.0){ 280 | pinfres = hresx / resx0 / (-hz - by); 281 | } else { 282 | pinfres = NA_REAL; 283 | } 284 | if(cx < 0.0){ 285 | dinfres = std::max(hresy / resy0, hresz / resz0) / (-cx); 286 | } else { 287 | dinfres = NA_REAL; 288 | } 289 | if(trace){ 290 | Rcpp::Rcout << "Iteration: " << i << std::endl; 291 | Rcpp::Rcout << "pobj: " << pcost << std::endl; 292 | Rcpp::Rcout << "dobj: " << dcost << std::endl; 293 | Rcpp::Rcout << "pinf: " << pres << std::endl; 294 | Rcpp::Rcout << "dinf: " << dres << std::endl; 295 | Rcpp::Rcout << "dgap: " << gap << std::endl; 296 | Rcpp::Rcout << "k/t : " << pdv->kappa / pdv->tau << std::endl; 297 | Rcpp::Rcout << std::endl; 298 | } 299 | // Checking convergence / infeasibilities 300 | if(!std::isnan(rgap)){ 301 | checkRgap = (rgap <= rtol); 302 | } else { 303 | checkRgap = false; 304 | } 305 | if((pres <= ftol) && (dres <= ftol) && ((gap <= atol) || checkRgap)){ 306 | pdv->x = pdv->x / pdv->tau; 307 | pdv->y = pdv->y / pdv->tau; 308 | pdv->s = pdv->s / pdv->tau; 309 | pdv->z = pdv->z / pdv->tau; 310 | ts = cList.smss(pdv->s).max(); 311 | tz = cList.smss(pdv->z).max(); 312 | state["pobj"] = pobj(*pdv); 313 | state["dobj"] = dobj(*pdv); 314 | state["dgap"] = gap; 315 | state["certp"] = certp(*pdv); 316 | state["certd"] = certd(*pdv); 317 | state["pslack"] = -ts; 318 | state["dslack"] = -tz; 319 | if(!std::isnan(rgap)){ 320 | state["rgap"] = rgap; 321 | } 322 | cps->set_state(state); 323 | cps->set_status("optimal"); 324 | cps->set_niter(i); 325 | cps->set_pdv(*pdv); 326 | if(trace){ 327 | Rcpp::Rcout << "Optimal solution found." << std::endl; 328 | } 329 | return cps; 330 | } else if((!std::isnan(pinfres)) && (pinfres <= ftol)){ 331 | denom = -hz - by; 332 | pdv->x = mat(0,1); 333 | pdv->y = pdv->y / denom; 334 | pdv->s = mat(0,1); 335 | pdv->y = pdv->y / denom; 336 | tz = cList.smss(pdv->z).max(); 337 | state["pobj"] = NA_REAL; 338 | state["dobj"] = 1.0; 339 | state["dgap"] = NA_REAL; 340 | state["rgap"] = NA_REAL; 341 | state["certp"] = pinfres; 342 | state["certd"] = NA_REAL; 343 | state["pslack"] = NA_REAL; 344 | state["dslack"] = -tz; 345 | cps->set_state(state); 346 | cps->set_status("primal infeasible"); 347 | cps->set_niter(i); 348 | cps->set_pdv(*pdv); 349 | if(trace){ 350 | Rcpp::Rcout << "Certificate of primal infeasibility found." << std::endl; 351 | } 352 | return cps; 353 | } else if((!std::isnan(dinfres)) && (dinfres <= ftol)){ 354 | denom = -cx; 355 | pdv->x = pdv->x / denom; 356 | pdv->y = mat(0,1); 357 | pdv->s = pdv->s / denom; 358 | pdv->z = mat(0,1); 359 | ts = cList.smss(pdv->s).max(); 360 | state["pobj"] = -1.0; 361 | state["dobj"] = NA_REAL; 362 | state["dgap"] = NA_REAL; 363 | state["rgap"] = NA_REAL; 364 | state["certp"] = NA_REAL; 365 | state["certd"] = dinfres; 366 | state["pslack"] = -ts; 367 | state["dslack"] = NA_REAL; 368 | cps->set_state(state); 369 | cps->set_status("dual infeasible"); 370 | cps->set_pdv(*pdv); 371 | cps->set_niter(i); 372 | if(trace){ 373 | Rcpp::Rcout << "Certificate of dual infeasibility found." << std::endl; 374 | } 375 | return cps; 376 | } 377 | // Computing initial scalings 378 | // W * z = W^{-T} * s = lambda 379 | // dg * tau = 1 / dg * kappa = lambdag 380 | // lambda_g is stored in the last position of lmbda 381 | if(i == 0){ 382 | WList = cList.ntsc(pdv->s, pdv->z); 383 | Lambda = cList.getLambda(WList); 384 | dg = sqrt(pdv->kappa / pdv->tau); 385 | dgi = sqrt(pdv->tau / pdv->kappa); 386 | lg = sqrt(pdv->tau * pdv->kappa); 387 | } 388 | LambdaPrd = cList.sprd(Lambda, Lambda); 389 | lgprd = lg * lg; 390 | // Solution step 1 (same for affine and combined solution) 391 | // solving a three equation system 392 | try{ 393 | dpdv1->x = -q; 394 | dpdv1->y = b; 395 | dpdv1->z = cList.h; 396 | dpdv1 = sxyz(dpdv1, LHS, RHS, WList); 397 | } catch(std::runtime_error &ex){ 398 | pdv->x = pdv->x / pdv->tau; 399 | pdv->y = pdv->y / pdv->tau; 400 | pdv->s = pdv->s / pdv->tau; 401 | pdv->z = pdv->z / pdv->tau; 402 | ts = cList.smss(pdv->s).max(); 403 | tz = cList.smss(pdv->z).max(); 404 | state["pobj"] = pobj(*pdv); 405 | state["dobj"] = dobj(*pdv); 406 | state["dgap"] = gap; 407 | state["certp"] = pres; 408 | state["certd"] = dres; 409 | state["pslack"] = -ts; 410 | state["dslack"] = -tz; 411 | if(!std::isnan(rgap)){ 412 | state["rgap"] = rgap; 413 | } 414 | cps->set_state(state); 415 | cps->set_status("unknown"); 416 | cps->set_niter(i); 417 | cps->set_pdv(*pdv); 418 | if(trace){ 419 | Rcpp::Rcout << "Terminated (singular KKT matrix)." << std::endl; 420 | } 421 | return cps; 422 | } catch(...){ 423 | ::Rf_error("C++ exception (unknown reason)"); 424 | } 425 | dpdv1->x = dpdv1->x * dgi; 426 | dpdv1->y = dpdv1->y * dgi; 427 | dpdv1->z = dpdv1->z * dgi; 428 | Wh = cList.ssnt(cList.h, WList, true, true); 429 | mu = dot(Lambda, Lambda) / (m + 1); 430 | sigma = 0.0; 431 | // Solving for affine and combined direction in two-round for-loop 432 | // System of six equations 433 | for(int ii = 0; ii < 2; ii++){ 434 | dpdv2->s = LambdaPrd; 435 | dpdv2->kappa = lgprd; 436 | if(ii == 1){ 437 | dpdv2->s = dpdv2->s + dsdz - OneE * sigma * mu; 438 | dpdv2->kappa = dpdv2->kappa + dkdt - sigma * mu; 439 | } 440 | dpdv2->x = (1.0 - sigma) * rx; 441 | dpdv2->y = (1.0 - sigma) * ry; 442 | dpdv2->z = (1.0 - sigma) * rz; 443 | dpdv2->tau = (1.0 - sigma) * rt; 444 | // Solving KKT-system 445 | dpdv2->s = cList.sinv(dpdv2->s, Lambda); 446 | dpdv2->s = -1.0 * dpdv2->s; 447 | Ws3 = cList.ssnt(dpdv2->s, WList, false, true); 448 | dpdv2->z = dpdv2->z + Ws3; 449 | dpdv2->z = -1.0 * dpdv2->z; 450 | dpdv2->y = -1.0 * dpdv2->y; 451 | KktSol = *(sxyz(dpdv2, LHS, RHS, WList)); 452 | // Combining solutions dpdv1 and dpdv2 453 | dpdv2->kappa = -1.0 * dpdv2->kappa / lg; 454 | dpdv2->tau = dpdv2->tau + dpdv2->kappa / dgi; 455 | cx = dot(q, KktSol.x); 456 | by = dot(b, KktSol.y); 457 | Whz = sum(cList.sdot(Wh, KktSol.z)); 458 | nomin = (dgi * (dpdv2->tau + cx + by + Whz)).at(0,0); 459 | denom = 1.0 + sum(cList.sdot(dpdv1->z, dpdv1->z)); 460 | dpdv2->tau = nomin / denom; 461 | dpdv2->x = KktSol.x + dpdv2->tau * dpdv1->x; 462 | dpdv2->y = KktSol.y + dpdv2->tau * dpdv1->y; 463 | dpdv2->z = KktSol.z + dpdv2->tau * dpdv1->z; 464 | dpdv2->s = dpdv2->s - dpdv2->z; 465 | dpdv2->kappa = dpdv2->kappa - dpdv2->tau; 466 | // ds o dz and dkappa * dtau for Mehrotra correction 467 | if(ii == 0){ 468 | dsdz = cList.sprd(dpdv2->s, dpdv2->z); 469 | dkdt = dpdv2->kappa * dpdv2->tau; 470 | } 471 | dpdv2->s = cList.sslb(dpdv2->s, Lambda, false); 472 | dpdv2->z = cList.sslb(dpdv2->z, Lambda, false); 473 | ts = cList.smss(dpdv2->s).max(); 474 | tz = cList.smss(dpdv2->z).max(); 475 | tt = -dpdv2->tau / lg; 476 | tk = -dpdv2->kappa / lg; 477 | ss = { 0.0, ts, tz, tt, tk }; 478 | tm = ss.max(); 479 | if(tm == 0.0){ 480 | step = 1.0; 481 | } else { 482 | if(ii == 0) { 483 | step = std::min(1.0, 1.0 / tm); 484 | } else { 485 | step = std::min(1.0, sadj / tm); 486 | } 487 | } 488 | if(ii == 0){ 489 | sigma = pow((1.0 - step), 3.0); 490 | } 491 | } // end ii-loop 492 | 493 | // Updating x, y; s and z (in current scaling) 494 | pdv->x = pdv->x + step * dpdv2->x; 495 | pdv->y = pdv->y + step * dpdv2->y; 496 | 497 | dpdv2->s = cList.SorZupdate(dpdv2->s, Lambda, step); 498 | dpdv2->z = cList.SorZupdate(dpdv2->z, Lambda, step); 499 | 500 | // Updating NT-scaling and Lagrange Multipliers 501 | WList = cList.ntsu(dpdv2->s, dpdv2->z, WList); 502 | Lambda = cList.getLambda(WList); 503 | dg = dg * sqrt(1.0 - step * tk) / sqrt(1.0 - step * tt); 504 | dgi = 1 / dg; 505 | lg = lg * sqrt(1 - step * tt) * sqrt(1 - step * tk); 506 | pdv->s = cList.ssnt(Lambda, WList, false, true); 507 | pdv->z = cList.ssnt(Lambda, WList, true, false); 508 | pdv->kappa = lg / dgi; 509 | pdv->tau = lg * dgi; 510 | // gap = pow(sqrt(dot(Lambda, Lambda)) / pdv->tau, 2.0); 511 | gap = pow(norm(Lambda) / pdv->tau, 2.0); 512 | } // end i-loop 513 | 514 | pdv->x = pdv->x / pdv->tau; 515 | pdv->y = pdv->y / pdv->tau; 516 | pdv->s = pdv->s / pdv->tau; 517 | pdv->z = pdv->z / pdv->tau; 518 | ts = cList.smss(pdv->s).max(); 519 | tz = cList.smss(pdv->z).max(); 520 | cps->set_pdv(*pdv); 521 | state["pobj"] = pobj(*pdv); 522 | state["dobj"] = dobj(*pdv); 523 | state["dgap"] = gap; 524 | state["certp"] = certp(*pdv); 525 | state["certd"] = certd(*pdv); 526 | state["pslack"] = -ts; 527 | state["dslack"] = -tz; 528 | if(!std::isnan(rgap)){ 529 | state["rgap"] = rgap; 530 | } 531 | cps->set_state(state); 532 | cps->set_niter(maxiters); 533 | 534 | if((state["certp"] <= ftol) && (state["certd"] <= ftol)){ 535 | cps->set_status("optimal"); 536 | } else { 537 | if(trace){ 538 | Rcpp::Rcout << "Optimal solution not determined in " << maxiters << " iteration(s)." << std::endl; 539 | } 540 | cps->set_status("unknown"); 541 | } 542 | 543 | return cps; 544 | } 545 | -------------------------------------------------------------------------------- /src/DNL.cpp: -------------------------------------------------------------------------------- 1 | #include "cccp.h" 2 | /* 3 | * 4 | * Methods for Linear Programs with nonlinear constraints 5 | * 6 | */ 7 | using namespace arma; 8 | /* 9 | Primal objective 10 | */ 11 | double DNL::pobj(PDV& pdv){ 12 | double ans = dot(pdv.x, q); 13 | return ans; 14 | } 15 | /* 16 | Dual objective 17 | */ 18 | double DNL::dobj(PDV& pdv){ 19 | double term1 = 0.0, term2 = 0.0, term3 = 0.0, ans; 20 | term1 = dot(pdv.x, q); 21 | if(cList.K > 1){ 22 | for(int i = 1; i < cList.K; i++){ 23 | term2 += dot(pdv.z(span(cList.sidx.at(i, 0), cList.sidx.at(i, 1)), span::all), 24 | cList.G(span(cList.sidx.at(i, 0), cList.sidx.at(i, 1)), span::all) * 25 | pdv.x - 26 | cList.h(span(cList.sidx.at(i, 0), cList.sidx.at(i, 1)), span::all)); 27 | } 28 | } 29 | term2 += dot(pdv.z(span(cList.sidx.at(0, 0), cList.sidx.at(0, 1)), span::all), 30 | cList.h(span(cList.sidx.at(0, 0), cList.sidx.at(0, 1)), span::all)); 31 | term3 = dot(pdv.y, (A * pdv.x - b)); 32 | ans = term1 + term2 + term3; 33 | 34 | return ans; 35 | } 36 | /* 37 | Primal Residuals 38 | */ 39 | mat DNL::rprim(PDV& pdv){ 40 | int p = A.n_rows; 41 | mat ans(p,1); 42 | ans.zeros(); 43 | 44 | ans = b - A * pdv.x; 45 | 46 | return ans; 47 | } 48 | /* 49 | Centrality Residuals 50 | */ 51 | mat DNL::rcent(PDV& pdv){ 52 | mat ans(cList.G.n_rows, 1); 53 | 54 | ans(span(cList.sidx.at(0, 0), cList.sidx.at(0, 1)), span::all) = 55 | pdv.s(span(cList.sidx.at(0, 0), cList.sidx.at(0, 1)), span::all) + 56 | cList.h(span(cList.sidx.at(0, 0), cList.sidx.at(0, 1)), span::all); 57 | 58 | if(cList.K > 1){ 59 | for(int i = 1; i < cList.K; i++){ 60 | ans(span(cList.sidx.at(i, 0), cList.sidx.at(i, 1)), span::all) = 61 | pdv.s(span(cList.sidx.at(i, 0), cList.sidx.at(i, 1)), span::all) + 62 | cList.G(span(cList.sidx.at(i, 0), cList.sidx.at(i, 1)), span::all) * pdv.x - 63 | cList.h(span(cList.sidx.at(i, 0), cList.sidx.at(i, 1)), span::all); 64 | } 65 | } 66 | 67 | return ans; 68 | } 69 | /* 70 | Dual Residuals 71 | */ 72 | mat DNL::rdual(PDV& pdv){ 73 | int n = q.n_rows; 74 | mat Gz(n,1); 75 | mat Ay(n,1); 76 | mat ans(n,1); 77 | Gz.zeros(); 78 | Ay.zeros(); 79 | ans.zeros(); 80 | 81 | if(cList.K > 0){ 82 | Gz = cList.G.t() * pdv.z; 83 | } 84 | if(A.n_rows > 0){ 85 | Ay = A.t() * pdv.y; 86 | } 87 | ans = q + Gz + Ay; 88 | 89 | return ans; 90 | } 91 | /* 92 | Certificate of primal infeasibilty 93 | */ 94 | double DNL::certp(PDV& pdv){ 95 | double nomin, denom, ans1 = 0.0, ans2 = 0.0, ans = 0.0; 96 | 97 | nomin = norm(rprim(pdv)); 98 | denom = std::max(1.0, norm(b)); 99 | ans1 = nomin / denom; 100 | 101 | if(cList.K > 0){ 102 | mat rz; 103 | rz = rcent(pdv); 104 | nomin = 0.0; 105 | denom = std::max(1.0, norm(q)); 106 | nomin = cList.snrm2(rz); 107 | ans2 = nomin / denom; 108 | } 109 | ans = std::max(ans1, ans2); 110 | 111 | return ans; 112 | } 113 | /* 114 | Certificate of dual infeasibilty 115 | */ 116 | double DNL::certd(PDV& pdv){ 117 | double nomin, denom, ans; 118 | 119 | nomin = norm(rdual(pdv)); 120 | denom = std::max(1.0, norm(q)); 121 | ans = nomin / denom; 122 | 123 | return ans; 124 | } 125 | /* 126 | Solving 'KKT-System' 127 | */ 128 | PDV* DNL::sxyz(PDV* pdv, mat LHS, mat RHS, std::vector > WList){ 129 | int n = q.n_rows; 130 | mat rhs1, ans; 131 | 132 | rhs1 = cList.gwwz(WList, pdv->z); 133 | RHS.submat(0, 0, n - 1, 0) = pdv->x + rhs1; 134 | if(pdv->y.n_rows > 0){ 135 | RHS.submat(n, 0, RHS.n_rows - 1, 0) = pdv->y; 136 | } 137 | ans = solve(LHS, RHS); 138 | pdv->x = ans.submat(0, 0, n - 1, 0); 139 | if(pdv->y.n_rows > 0){ 140 | pdv->y = ans.submat(n, 0, RHS.n_rows - 1, 0); 141 | } 142 | pdv->z = cList.G * pdv->x - pdv->z; 143 | pdv->z = cList.ssnt(pdv->z, WList, true, true); 144 | 145 | return pdv; 146 | } 147 | /* 148 | Main routine for solving a Linear Program with nonlinear constraints 149 | */ 150 | CPS* DNL::cps(CTRL& ctrl){ 151 | // Initializing objects 152 | PDV* pdv = cList.initpdv(A.n_rows); 153 | PDV* dpdv = cList.initpdv(A.n_rows); 154 | pdv->x = x0; 155 | Rcpp::List nF(nList[0]); 156 | Rcpp::List gF(nList[1]); 157 | Rcpp::List hF(nList[2]); 158 | 159 | CPS* cps = new CPS(); 160 | cps->set_pdv(*pdv); 161 | cps->set_sidx(cList.sidx); 162 | Rcpp::NumericVector state = cps->get_state(); 163 | bool checkRgap = false, backTrack; 164 | int m = sum(cList.dims), mnl = cList.dims(0), n = cList.n, sizeLHS = A.n_rows + A.n_cols; 165 | double gap = m, resx, resy, resz, pcost, dcost, rgap = NA_REAL, 166 | pres, dres, pres0 = 1.0, dres0 = 1.0, sigma, mu, ts, tz, tm, step; 167 | vec ss(3), Fval(mnl); 168 | mat H = zeros(n, n), rx, ry, rz, Lambda, LambdaPrd, Ws3, x; 169 | mat OneE = cList.sone(); 170 | mat LHS(sizeLHS, sizeLHS); 171 | // Initialising LHS matrices 172 | LHS.zeros(); 173 | if(A.n_rows > 0){ // equality constraints 174 | LHS.submat(n, 0, sizeLHS-1, n-1) = A; 175 | LHS.submat(0, n, n-1, sizeLHS-1) = A.t(); 176 | } 177 | mat RHS(sizeLHS, 1); 178 | std::vector > WList; 179 | // Setting control parameters 180 | Rcpp::List params(ctrl.get_params()); 181 | bool trace = Rcpp::as(params["trace"]); 182 | int maxiters = Rcpp::as(params["maxiters"]); 183 | double atol = Rcpp::as(params["abstol"]); 184 | double ftol = Rcpp::as(params["feastol"]); 185 | double rtol = Rcpp::as(params["reltol"]); 186 | double sadj = Rcpp::as(params["stepadj"]); 187 | double beta = Rcpp::as(params["beta"]); 188 | // 189 | // Starting iterations 190 | // 191 | for(int i = 0; i < maxiters; i++){ 192 | H.zeros(); 193 | for(int j = 0; j < mnl; j++){ 194 | // Setting f to first mnl-rows of h-matrix 195 | cList.h(j, 0) = feval(pdv->x, nF[j]); 196 | // Setting Df to first mnl-rows of G-matrix 197 | cList.G.row(j) = geval(pdv->x, gF[j]).t(); 198 | // Computing Hessian 199 | H += pdv->z.at(j, 0) * heval(pdv->x, hF[j]); 200 | } 201 | // Computing gap 202 | gap = sum(cList.sdot(pdv->s, pdv->z)); 203 | // Computing residuals 204 | // Dual Residuals 205 | rx = rdual(*pdv); 206 | resx = norm(rx); 207 | // Primal Residuals 208 | ry = rprim(*pdv); 209 | resy = norm(ry); 210 | // Central Residuals 211 | rz = rcent(*pdv); 212 | resz = cList.snrm2(rz); 213 | // Statistics for stopping criteria 214 | pcost = pobj(*pdv); 215 | dcost = pcost + dot(ry, pdv->y) + sum(cList.sdot(rz, pdv->z)) - gap; 216 | rgap = NA_REAL; 217 | if(pcost < 0.0) rgap = gap / (-pcost); 218 | if(dcost > 0.0) rgap = gap / dcost; 219 | pres = sqrt(resy * resy + resz * resz); 220 | dres = resx; 221 | if(i == 0){ 222 | pres0 = std::max(1.0, pres); 223 | dres0 = std::max(1.0, dres); 224 | } 225 | pres = pres / pres0; 226 | dres = dres / dres0; 227 | // Tracing status quo of IPM 228 | if(trace){ 229 | Rcpp::Rcout << "Iteration: " << i << std::endl; 230 | Rcpp::Rcout << "pobj: " << pcost << std::endl; 231 | Rcpp::Rcout << "dobj: " << dcost << std::endl; 232 | Rcpp::Rcout << "pinf: " << pres << std::endl; 233 | Rcpp::Rcout << "dinf: " << dres << std::endl; 234 | Rcpp::Rcout << "dgap: " << gap << std::endl; 235 | Rcpp::Rcout << std::endl; 236 | } 237 | // Checking convergence 238 | if(!std::isnan(rgap)){ 239 | checkRgap = (rgap <= rtol); 240 | } else { 241 | checkRgap = false; 242 | } 243 | if((pres <= ftol) && (dres <= ftol) && ((gap <= atol) || checkRgap)){ 244 | ts = cList.smss(pdv->s).max(); 245 | tz = cList.smss(pdv->z).max(); 246 | state["pobj"] = pcost; 247 | state["dobj"] = dcost; 248 | state["dgap"] = gap; 249 | state["certp"] = pres; 250 | state["certd"] = dres; 251 | state["pslack"] = -ts; 252 | state["dslack"] = -tz; 253 | if(!std::isnan(rgap)){ 254 | state["rgap"] = rgap; 255 | } 256 | cps->set_state(state); 257 | cps->set_status("optimal"); 258 | cps->set_niter(i); 259 | cps->set_pdv(*pdv); 260 | if(trace){ 261 | Rcpp::Rcout << "Optimal solution found." << std::endl; 262 | } 263 | return cps; 264 | } 265 | // Compute initial scalings 266 | if(i == 0){ 267 | WList = cList.ntsc(pdv->s, pdv->z); 268 | Lambda = cList.getLambda(WList); 269 | } 270 | LambdaPrd = cList.sprd(Lambda, Lambda); 271 | LHS.submat(0, 0, n-1, n-1) = H + cList.gwwg(WList); 272 | sigma = 0.0; 273 | // Finding solution of increments in two-round loop 274 | // (same for affine and combined solution) 275 | for(int ii = 0; ii < 2; ii++){ 276 | mu = gap / m; 277 | dpdv->s = -1.0 * LambdaPrd + OneE * sigma * mu; 278 | dpdv->x = -1.0 * rx; 279 | dpdv->y = -1.0 * ry; 280 | dpdv->z = -1.0 * rz; 281 | // Solving KKT-system 282 | try{ 283 | dpdv->s = cList.sinv(dpdv->s, Lambda); 284 | Ws3 = cList.ssnt(dpdv->s, WList, false, true); 285 | dpdv->z = dpdv->z - Ws3; 286 | dpdv = sxyz(dpdv, LHS, RHS, WList); 287 | dpdv->s = dpdv->s - dpdv->z; 288 | } catch(std::runtime_error &ex) { 289 | ts = cList.smss(pdv->s).max(); 290 | tz = cList.smss(pdv->z).max(); 291 | state["pobj"] = pcost; 292 | state["dobj"] = dcost; 293 | state["dgap"] = gap; 294 | state["certp"] = pres; 295 | state["certd"] = dres; 296 | state["pslack"] = -ts; 297 | state["dslack"] = -tz; 298 | if(!std::isnan(rgap)){ 299 | state["rgap"] = rgap; 300 | } 301 | cps->set_state(state); 302 | cps->set_status("unknown"); 303 | cps->set_niter(i); 304 | cps->set_pdv(*pdv); 305 | if(trace){ 306 | Rcpp::Rcout << "Terminated (singular KKT matrix)." << std::endl; 307 | } 308 | return cps; 309 | } catch(...) { 310 | ::Rf_error("C++ exception (unknown reason)"); 311 | } 312 | // Maximum step to boundary 313 | dpdv->s = cList.sslb(dpdv->s, Lambda, false); 314 | dpdv->z = cList.sslb(dpdv->z, Lambda, false); 315 | ts = cList.smss(dpdv->s).max(); 316 | tz = cList.smss(dpdv->z).max(); 317 | ss = { 0.0, ts, tz }; 318 | tm = ss.max(); 319 | if(tm == 0.0){ 320 | step = 1.0; 321 | } else { 322 | step = std::min(1.0, sadj / tm); 323 | } 324 | // Backtracking until x is in the domain of f 325 | backTrack = true; 326 | while(backTrack){ 327 | x = pdv->x + step * dpdv->x; 328 | for(int j = 0; j < mnl; j++){ 329 | Fval(j) = feval(x, nF[j]); 330 | } 331 | if(is_finite(Fval)){ 332 | backTrack = false; 333 | } else { 334 | step *= beta; 335 | } 336 | } // end while-loop domain of f 337 | if(ii == 0){ 338 | sigma = pow((1.0 - step), 3.0); 339 | } 340 | } // end ii-loop 341 | 342 | // Updating x, y; s and z (in current scaling) 343 | pdv->x = pdv->x + step * dpdv->x; 344 | pdv->y = pdv->y + step * dpdv->y; 345 | 346 | dpdv->s = cList.SorZupdate(dpdv->s, Lambda, step); 347 | dpdv->z = cList.SorZupdate(dpdv->z, Lambda, step); 348 | 349 | // Updating NT-scaling and Lagrange Multipliers 350 | WList = cList.ntsu(dpdv->s, dpdv->z, WList); 351 | Lambda = cList.getLambda(WList); 352 | pdv->s = cList.ssnt(Lambda, WList, false, true); 353 | pdv->z = cList.ssnt(Lambda, WList, true, false); 354 | gap = sum(cList.sdot(Lambda, Lambda)); 355 | } // end i-loop 356 | 357 | // Preparing result for non-convergence in maxiters iterations 358 | cps->set_pdv(*pdv); 359 | cps->set_sidx(cList.sidx); 360 | state["pobj"] = pobj(*pdv); 361 | state["dobj"] = dobj(*pdv); 362 | state["dgap"] = gap; 363 | state["certp"] = certp(*pdv); 364 | state["certd"] = certd(*pdv); 365 | ts = cList.smss(pdv->s).max(); 366 | tz = cList.smss(pdv->z).max(); 367 | state["pslack"] = -ts; 368 | state["dslack"] = -tz; 369 | if(!std::isnan(rgap)){ 370 | state["rgap"] = rgap; 371 | } 372 | cps->set_state(state); 373 | cps->set_niter(maxiters); 374 | cps->set_status("unknown"); 375 | if(trace){ 376 | Rcpp::Rcout << "Optimal solution not determined in " << maxiters << " iteration(s)." << std::endl; 377 | } 378 | 379 | return cps; 380 | } 381 | -------------------------------------------------------------------------------- /src/DQP.cpp: -------------------------------------------------------------------------------- 1 | #include "cccp.h" 2 | /* 3 | * 4 | * Methods for Quadratic Programs 5 | * 6 | */ 7 | using namespace arma; 8 | /* 9 | Primal objective 10 | */ 11 | double DQP::pobj(PDV& pdv){ 12 | double ans; 13 | mat term1(1,1); 14 | term1(0,0) = 0.0; 15 | 16 | term1 = (0.5 * pdv.x.t() * P * pdv.x); 17 | ans = term1(0,0) + dot(pdv.x, q); 18 | 19 | return ans; 20 | } 21 | /* 22 | Dual objective 23 | */ 24 | double DQP::dobj(PDV& pdv){ 25 | double ans; 26 | mat term1(1,1), term2(1,1); 27 | term1(0,0) = 0.0; 28 | term2(0,0) = 0.0; 29 | 30 | // dobj term for equality constraints 31 | if(A.n_rows > 0){ 32 | term1 = pdv.y.t() * (A * pdv.x - b); 33 | } 34 | // dobj term for inequality constraints 35 | if(cList.K > 0){ 36 | term2 = dot(pdv.z, cList.G * pdv.x - cList.h); 37 | } 38 | ans = pobj(pdv) + term1(0,0) + term2(0,0); 39 | 40 | return ans; 41 | } 42 | /* 43 | Primal Residuals 44 | */ 45 | mat DQP::rprim(PDV& pdv){ 46 | int p = A.n_rows; 47 | mat ans(p,1); 48 | ans.zeros(); 49 | 50 | ans = b - A * pdv.x; 51 | 52 | return ans; 53 | } 54 | /* 55 | Centrality Residuals 56 | */ 57 | mat DQP::rcent(PDV& pdv){ 58 | mat ans(cList.G.n_rows, 1); 59 | 60 | ans = pdv.s + cList.G * pdv.x - cList.h; 61 | 62 | return ans; 63 | } 64 | /* 65 | Dual Residuals 66 | */ 67 | mat DQP::rdual(PDV& pdv){ 68 | int n = P.n_rows; 69 | mat Gz(n,1); 70 | mat Ay(n,1); 71 | mat ans(n,1); 72 | Gz.zeros(); 73 | Ay.zeros(); 74 | ans.zeros(); 75 | 76 | if(cList.K > 0){ 77 | Gz = cList.G.t() * pdv.z; 78 | } 79 | if(A.n_rows > 0){ 80 | Ay = A.t() * pdv.y; 81 | } 82 | ans = P * pdv.x + q + Gz + Ay; 83 | 84 | return ans; 85 | } 86 | /* 87 | Certificate of primal infeasibilty 88 | */ 89 | double DQP::certp(PDV& pdv){ 90 | double nomin, denom, ans1 = 0.0, ans2 = 0.0, ans = 0.0; 91 | 92 | nomin = norm(rprim(pdv)); 93 | denom = std::max(1.0, norm(b)); 94 | ans1 = nomin / denom; 95 | 96 | if(cList.K > 0){ 97 | mat rz; 98 | rz = rcent(pdv); 99 | nomin = 0.0; 100 | denom = std::max(1.0, norm(q)); 101 | nomin = cList.snrm2(rz); 102 | ans2 = nomin / denom; 103 | } 104 | ans = std::max(ans1, ans2); 105 | 106 | return ans; 107 | } 108 | /* 109 | Certificate of dual infeasibilty 110 | */ 111 | double DQP::certd(PDV& pdv){ 112 | double nomin, denom, ans; 113 | 114 | nomin = norm(rdual(pdv)); 115 | denom = std::max(1.0, norm(q)); 116 | ans = nomin / denom; 117 | 118 | return ans; 119 | } 120 | /* 121 | Solving 'KKT-System' 122 | */ 123 | PDV* DQP::sxyz(PDV* pdv, mat LHS, mat RHS, std::vector > WList){ 124 | int n = P.n_cols; 125 | mat lhs1, rhs1, ans; 126 | 127 | lhs1 = cList.gwwg(WList); 128 | LHS.submat(0, 0, n-1, n-1) = P + lhs1; 129 | rhs1 = cList.gwwz(WList, pdv->z); 130 | 131 | RHS.submat(0, 0, n - 1, 0) = pdv->x + rhs1; 132 | if(pdv->y.n_rows > 0){ 133 | RHS.submat(n, 0, RHS.n_rows - 1, 0) = pdv->y; 134 | } 135 | ans = solve(LHS, RHS); 136 | pdv->x = ans.submat(0, 0, n - 1, 0); 137 | if(pdv->y.n_rows > 0){ 138 | pdv->y = ans.submat(n, 0, RHS.n_rows - 1, 0); 139 | } 140 | pdv->z = cList.G * pdv->x - pdv->z; 141 | pdv->z = cList.ssnt(pdv->z, WList, true, true); 142 | 143 | return pdv; 144 | } 145 | /* 146 | Main routine for solving a Quadratic Program 147 | */ 148 | CPS* DQP::cps(CTRL& ctrl){ 149 | // Initialising object 150 | PDV* pdv = cList.initpdv(A.n_rows); 151 | CPS* cps = new CPS(); 152 | cps->set_pdv(*pdv); 153 | Rcpp::List params(ctrl.get_params()); 154 | Rcpp::NumericVector state = cps->get_state(); 155 | // Case 1: Unconstrained QP 156 | if((cList.K == 0) && (A.n_rows == 0)){ 157 | pdv->x = solve(P, -q); 158 | cps->set_pdv(*pdv); 159 | state["pobj"] = pobj(*pdv); 160 | cps->set_state(state); 161 | cps->set_status("optimal"); 162 | return cps; 163 | } 164 | // Case 2: Equality constrained QP 165 | if((cList.K == 0) && (A.n_rows > 0)){ 166 | mat Pi, PiA, Piq, S, Si; 167 | double ftol = Rcpp::as(params["feastol"]); 168 | try{ 169 | Pi = inv(P); 170 | } catch(std::runtime_error &ex){ 171 | forward_exception_to_r(ex); 172 | } catch(...){ 173 | ::Rf_error("C++ exception (unknown reason)"); 174 | } 175 | Piq = Pi * q; 176 | PiA = Pi * A.t(); 177 | S = -A * PiA; 178 | try{ 179 | Si = inv(S); 180 | } catch(std::runtime_error &ex){ 181 | throw std::range_error("Inversion of Schur complement failed."); 182 | forward_exception_to_r(ex); 183 | } catch(...) { 184 | ::Rf_error("C++ exception (unknown reason)"); 185 | } 186 | pdv->y = Si * (A * Piq + b); 187 | pdv->x = Pi * (-(A.t() * pdv->y) - q); 188 | cps->set_pdv(*pdv); 189 | state["pobj"] = pobj(*pdv); 190 | state["dobj"] = dobj(*pdv); 191 | state["certp"] = certp(*pdv); 192 | state["certd"] = certd(*pdv); 193 | cps->set_state(state); 194 | if((state["certp"] <= ftol) && (state["certd"] <= ftol)){ 195 | cps->set_status("optimal"); 196 | } else { 197 | cps->set_status("unknown"); 198 | } 199 | return cps; 200 | } 201 | // Case 3: At least inequality constrained QP 202 | // Defining variables used in iterations 203 | bool trace = Rcpp::as(params["trace"]); 204 | bool checkRgap = false; 205 | int m = sum(cList.dims), n = P.n_cols, sizeLHS = A.n_rows + A.n_cols; 206 | int maxiters = Rcpp::as(params["maxiters"]); 207 | double resx, resx0, resy, resy0, resz, resz0, 208 | pcost, dcost, gap, rgap = NA_REAL, pres, dres, 209 | ts, nrms, tz, nrmz, tm, step, mu, sigma, dsdz; 210 | double atol = Rcpp::as(params["abstol"]); 211 | double ftol = Rcpp::as(params["feastol"]); 212 | double rtol = Rcpp::as(params["reltol"]); 213 | double sadj = Rcpp::as(params["stepadj"]); 214 | vec ss(3); 215 | mat LHS(sizeLHS, sizeLHS); 216 | mat RHS(sizeLHS, 1); 217 | mat rx, ry, rz, Lambda, LambdaPrd, Ws3; 218 | mat OneE = cList.sone(); 219 | std::vector > WList; 220 | PDV* dpdv = cList.initpdv(A.n_rows); 221 | // Computing fixed values 222 | resx0 = std::max(1.0, norm(q)); 223 | resy0 = std::max(1.0, norm(b)); 224 | resz0 = std::max(1.0, cList.snrm2(cList.h)); 225 | // Initialising LHS and RHS matrices 226 | LHS.zeros(); 227 | if(A.n_rows > 0){ // equality constraints 228 | LHS.submat(n, 0, sizeLHS-1, n-1) = A; 229 | LHS.submat(0, n, n-1, sizeLHS-1) = A.t(); 230 | } 231 | // Initialising Nesterov-Todd scalings 232 | WList = cList.initnts(); 233 | // Initialising PDV for determining (first) interior point 234 | pdv->x = -q; 235 | pdv->y = b; 236 | pdv->z = cList.h; 237 | pdv = sxyz(pdv, LHS, RHS, WList); 238 | pdv->s = -1.0 * (pdv->z); 239 | ts = cList.smss(pdv->s).max(); 240 | nrms = sum(cList.snrm2(pdv->s)); 241 | tz = cList.smss(pdv->z).max(); 242 | nrmz = sum(cList.snrm2(pdv->z)); 243 | if(ts >= -1e-8 * std::max(1.0, nrms)){ 244 | pdv->s = cList.sams1(pdv->s, ts); 245 | } 246 | if(tz >= -1e-8 * std::max(1.0, nrmz)){ 247 | pdv->z = cList.sams1(pdv->z, tz); 248 | } 249 | // Duality gap for initial solution 250 | gap = sum(cList.sdot(pdv->s, pdv->z)); 251 | cps->set_pdv(*pdv); 252 | // 253 | // Starting iterations 254 | // 255 | for(int i = 0; i < maxiters; i++){ 256 | // Dual Residuals 257 | rx = rdual(*pdv); 258 | resx = norm(rx); 259 | // Primal Residuals 260 | ry = rprim(*pdv); 261 | resy = norm(ry); 262 | // Central Residuals 263 | rz = rcent(*pdv); 264 | resz = cList.snrm2(rz); 265 | // Statistics for stopping criteria 266 | pcost = pobj(*pdv); 267 | dcost = pcost + dot(pdv->y, ry) + cList.sdot(pdv->z, rz).at(0, 0) - gap; 268 | rgap = NA_REAL; 269 | if(pcost < 0.0) rgap = gap / (-pcost); 270 | if(dcost > 0.0) rgap = gap / dcost; 271 | pres = std::max(resy / resy0, resz / resz0); 272 | dres = resx / resx0; 273 | // Tracing status quo of IPM 274 | if(trace){ 275 | Rcpp::Rcout << "Iteration: " << i << std::endl; 276 | Rcpp::Rcout << "pobj: " << pcost << std::endl; 277 | Rcpp::Rcout << "dobj: " << dcost << std::endl; 278 | Rcpp::Rcout << "pinf: " << pres << std::endl; 279 | Rcpp::Rcout << "dinf: " << dres << std::endl; 280 | Rcpp::Rcout << "dgap: " << gap << std::endl; 281 | Rcpp::Rcout << std::endl; 282 | } 283 | // Checking convergence 284 | if(!std::isnan(rgap)){ 285 | checkRgap = (rgap <= rtol); 286 | } else { 287 | checkRgap = false; 288 | } 289 | if((pres <= ftol) && (dres <= ftol) && ((gap <= atol) || checkRgap)){ 290 | cps->set_pdv(*pdv); 291 | cps->set_sidx(cList.sidx); 292 | ts = cList.smss(pdv->s).max(); 293 | tz = cList.smss(pdv->z).max(); 294 | state["pobj"] = pobj(*pdv); 295 | state["dobj"] = dobj(*pdv); 296 | state["dgap"] = gap; 297 | state["certp"] = certp(*pdv); 298 | state["certd"] = certd(*pdv); 299 | state["pslack"] = -ts; 300 | state["dslack"] = -tz; 301 | if(!std::isnan(rgap)){ 302 | state["rgap"] = rgap; 303 | } 304 | 305 | cps->set_state(state); 306 | cps->set_status("optimal"); 307 | cps->set_niter(i); 308 | if(trace){ 309 | Rcpp::Rcout << "Optimal solution found." << std::endl; 310 | } 311 | return cps; 312 | } 313 | // Computing initial scalings 314 | if(i == 0){ 315 | WList = cList.ntsc(pdv->s, pdv->z); 316 | } 317 | Lambda = cList.getLambda(WList); 318 | LambdaPrd = cList.sprd(Lambda, Lambda); 319 | mu = gap / m; 320 | sigma = 0.0; 321 | // Solving for affine and combined direction in two-round for-loop 322 | for(int ii = 0; ii < 2; ii++){ 323 | dpdv->x = -rx; 324 | dpdv->y = -ry; 325 | dpdv->z = -rz; 326 | // Solving KKT-System 327 | dpdv->s = -LambdaPrd + OneE * sigma * mu; 328 | dpdv->s = cList.sinv(dpdv->s, Lambda); 329 | Ws3 = cList.ssnt(dpdv->s, WList, false, true); 330 | dpdv->z = dpdv->z - Ws3; 331 | dpdv = sxyz(dpdv, LHS, RHS, WList); 332 | dpdv->s = dpdv->s - dpdv->z; 333 | // ds o dz for Mehrotra correction 334 | dsdz = sum(cList.sdot(dpdv->s, dpdv->z)); 335 | dpdv->s = cList.sslb(dpdv->s, Lambda, false); 336 | dpdv->z = cList.sslb(dpdv->z, Lambda, false); 337 | 338 | ts = cList.smss(dpdv->s).max(); 339 | tz = cList.smss(dpdv->z).max(); 340 | ss = { 0.0, ts, tz }; 341 | tm = ss.max(); 342 | if(tm == 0.0){ 343 | step = 1.0; 344 | } else { 345 | if(ii == 0) { 346 | step = std::min(1.0, 1.0 / tm); 347 | } else { 348 | step = std::min(1.0, sadj / tm); 349 | } 350 | } 351 | if(ii == 0){ 352 | sigma = pow(std::min(1.0, std::max(0.0, 1.0 - step + dsdz / gap * std::pow(step, 2.0))), 3.0); 353 | } 354 | } // end ii-loop 355 | 356 | // Updating x, y; s and z (in current scaling) 357 | pdv->x = pdv->x + step * dpdv->x; 358 | pdv->y = pdv->y + step * dpdv->y; 359 | 360 | dpdv->s = cList.SorZupdate(dpdv->s, Lambda, step); 361 | dpdv->z = cList.SorZupdate(dpdv->z, Lambda, step); 362 | 363 | // Updating NT-scaling and Lagrange Multipliers 364 | WList = cList.ntsu(dpdv->s, dpdv->z, WList); 365 | Lambda = cList.getLambda(WList); 366 | pdv->s = cList.ssnt(Lambda, WList, false, true); 367 | pdv->z = cList.ssnt(Lambda, WList, true, false); 368 | gap = sum(cList.sdot(Lambda, Lambda)); 369 | } // end i-loop 370 | 371 | // Preparing result for non-convergence in maxiters iterations 372 | cps->set_pdv(*pdv); 373 | cps->set_sidx(cList.sidx); 374 | state["pobj"] = pobj(*pdv); 375 | state["dobj"] = dobj(*pdv); 376 | state["dgap"] = gap; 377 | state["certp"] = certp(*pdv); 378 | state["certd"] = certd(*pdv); 379 | state["pslack"] = -ts; 380 | state["dslack"] = -tz; 381 | if(!std::isnan(rgap)){ 382 | state["rgap"] = rgap; 383 | } 384 | cps->set_state(state); 385 | cps->set_niter(maxiters); 386 | 387 | if((state["certp"] <= ftol) && (state["certd"] <= ftol)){ 388 | cps->set_status("optimal"); 389 | } else { 390 | if(trace){ 391 | Rcpp::Rcout << "Optimal solution not determined in " << maxiters << " iteration(s)." << std::endl; 392 | } 393 | cps->set_status("unknown"); 394 | } 395 | return cps; 396 | } 397 | -------------------------------------------------------------------------------- /src/GPP.cpp: -------------------------------------------------------------------------------- 1 | /* 2 | * Function for solving a geometric program 3 | */ 4 | #include "cccp.h" 5 | using namespace arma; 6 | 7 | CPS* gpp(std::vector FList, std::vector gList, CONEC& cList, mat A, mat b, CTRL& ctrl){ 8 | // Initializing objects 9 | int n = cList.n, ne = n - 1, m = sum(cList.dims), 10 | mnl = cList.dims(0), sizeLHS = A.n_rows + A.n_cols - 1; 11 | // Constraints 12 | CONEC cEpi; 13 | // Primal dual variables 14 | PDV* pdv = cList.initpdv(A.n_rows); 15 | PDV* dpdv = cList.initpdv(A.n_rows); 16 | // Solution 17 | CPS* cps = new CPS(); 18 | cps->set_pdv(*pdv); 19 | cps->set_sidx(cList.sidx); 20 | // Objects used in iterations 21 | Rcpp::NumericVector state = cps->get_state(); 22 | bool checkRgap = false, backTrack; 23 | double gap = m, resx, resy, resz, pcost = 1.0, dcost = 1.0, rgap = NA_REAL, 24 | pres = 1.0, dres = 1.0, pres0 = 1.0, dres0 = 1.0, sigma, mu, ts, tz, tm, step, a, x1, 25 | ymax, ysum; 26 | vec ss(3); 27 | mat H(ne, ne), rx, ry, rz(cList.G.n_rows, 1), Lambda, LambdaPrd, Ws3, x, ans(sizeLHS, 1), 28 | ux(ne, 1), uz, RHS(sizeLHS, 1), y, Fval(mnl, 1); 29 | mat OneE = cList.sone(); 30 | // Initialising LHS matrices 31 | mat LHS = zeros(sizeLHS, sizeLHS); 32 | if(A.n_rows > 0){ // equality constraints 33 | LHS.submat(ne, 0, sizeLHS - 1, ne - 1) = A(span::all, span(0, ne - 1)); 34 | LHS.submat(0, ne, ne - 1, sizeLHS - 1) = A(span::all, span(0, ne - 1)).t(); 35 | } 36 | std::vector FGP; 37 | std::vector > WList, WEpi; 38 | // Setting control parameters 39 | Rcpp::List params(ctrl.get_params()); 40 | bool trace = Rcpp::as(params["trace"]); 41 | int maxiters = Rcpp::as(params["maxiters"]); 42 | double atol = Rcpp::as(params["abstol"]); 43 | double ftol = Rcpp::as(params["feastol"]); 44 | double rtol = Rcpp::as(params["reltol"]); 45 | double sadj = Rcpp::as(params["stepadj"]); 46 | double beta = Rcpp::as(params["beta"]); 47 | // 48 | // Starting iterations 49 | // 50 | for(int i = 0; i < maxiters; i++){ 51 | H.zeros(); 52 | for(int j = 0; j < mnl; j++){ 53 | FGP = fgp(pdv->x(span(0, ne - 1), span::all), FList[j], gList[j]); 54 | // Setting f to first mnl-rows of h-matrix 55 | cList.h(j, 0) = FGP[0].at(0, 0); 56 | // Setting Df to first mnl-rows of G-matrix 57 | cList.G(j, span(0, ne - 1)) = FGP[1].t(); 58 | // Computing Hessian 59 | H += pdv->z.at(j, 0) * FGP[2]; 60 | } 61 | cList.h(0, 0) = cList.h(0, 0) - pdv->x.at(n - 1, 0); 62 | // Computing gap 63 | gap = sum(cList.sdot(pdv->s, pdv->z)); 64 | // Computing residuals 65 | // Dual Residuals 66 | rx = cList.G.t() * pdv->z + A.t() * pdv->y; 67 | rx.at(rx.n_rows - 1, 0) += 1.0; // last element of 'q' is 1.0 * t 68 | resx = norm(rx); 69 | // Primal Residuals 70 | ry = b - A * pdv->x; 71 | resy = norm(ry); 72 | // Central Residuals 73 | rz(span(cList.sidx.at(0, 0), cList.sidx.at(0, 1)), span::all) = 74 | pdv->s(span(cList.sidx.at(0, 0), cList.sidx.at(0, 1)), span::all) + 75 | cList.h(span(cList.sidx.at(0, 0), cList.sidx.at(0, 1)), span::all); 76 | if(cList.K > 1){ 77 | rz(span(cList.sidx.at(1, 0), cList.sidx.at(1, 1)), span::all) = 78 | pdv->s(span(cList.sidx.at(1, 0), cList.sidx.at(1, 1)), span::all) + 79 | cList.G(span(cList.sidx.at(1, 0), cList.sidx.at(1, 1)), span::all) * pdv->x - 80 | cList.h(span(cList.sidx.at(1, 0), cList.sidx.at(1, 1)), span::all); 81 | } 82 | resz = cList.snrm2(rz); 83 | // Statistics for stopping criteria 84 | pcost = pdv->x.at(n - 1, 0); 85 | dcost = pcost + dot(ry, pdv->y) + sum(cList.sdot(rz, pdv->z)) - gap; 86 | rgap = NA_REAL; 87 | if(pcost < 0.0) rgap = gap / (-pcost); 88 | if(dcost > 0.0) rgap = gap / dcost; 89 | pres = sqrt(resy * resy + resz * resz); 90 | dres = resx; 91 | if(i == 0){ 92 | pres0 = std::max(1.0, pres); 93 | dres0 = std::max(1.0, dres); 94 | } 95 | pres = pres / pres0; 96 | dres = dres / dres0; 97 | // Tracing status quo of IPM 98 | if(trace){ 99 | Rcpp::Rcout << "Iteration: " << i << std::endl; 100 | Rcpp::Rcout << "pobj: " << pcost << std::endl; 101 | Rcpp::Rcout << "dobj: " << dcost << std::endl; 102 | Rcpp::Rcout << "pinf: " << pres << std::endl; 103 | Rcpp::Rcout << "dinf: " << dres << std::endl; 104 | Rcpp::Rcout << "dgap: " << gap << std::endl; 105 | Rcpp::Rcout << std::endl; 106 | } 107 | // Checking convergence 108 | if(!std::isnan(rgap)){ 109 | checkRgap = (rgap <= rtol); 110 | } else { 111 | checkRgap = false; 112 | } 113 | if((pres <= ftol) && (dres <= ftol) && ((gap <= atol) || checkRgap)){ 114 | ts = cList.smss(pdv->s).max(); 115 | tz = cList.smss(pdv->z).max(); 116 | state["pobj"] = pcost; 117 | state["dobj"] = dcost; 118 | state["dgap"] = gap; 119 | state["certp"] = pres; 120 | state["certd"] = dres; 121 | state["pslack"] = -ts; 122 | state["dslack"] = -tz; 123 | if(!std::isnan(rgap)){ 124 | state["rgap"] = rgap; 125 | } 126 | cps->set_state(state); 127 | cps->set_status("optimal"); 128 | cps->set_niter(i); 129 | cps->set_pdv(*pdv); 130 | cps->pdv.x.reshape(ne, 1); // removing variable 't' 131 | cps->pdv.x = exp(cps->pdv.x); 132 | if((mnl > 1) && (cList.K == 1)){ // removing slack variables pertinent to 't' 133 | cps->pdv.s.set_size(cList.dims[0] - 1, 1); 134 | cps->pdv.z.set_size(cList.dims[0] - 1, 1); 135 | cps->pdv.s = pdv->s.submat(1, 0, cList.dims[0] - 1, 0); 136 | cps->pdv.z = pdv->z.submat(1, 0, cList.dims[0] - 1, 0); 137 | umat sidxEpi = cList.sidx; 138 | sidxEpi.at(0, 1) -= 1; 139 | cps->set_sidx(sidxEpi); 140 | } 141 | if((mnl == 1) && (cList.K > 1)){ // removing slack variables pertinent to 't' 142 | cps->pdv.s.set_size(cList.G.n_rows - 1, 1); 143 | cps->pdv.z.set_size(cList.G.n_rows - 1, 1); 144 | cps->pdv.s = pdv->s.submat(1, 0, cList.G.n_rows - 1, 0); 145 | cps->pdv.z = pdv->z.submat(1, 0, cList.G.n_rows - 1, 0); 146 | umat sidxEpi = cList.sidx; 147 | sidxEpi.shed_row(0); 148 | sidxEpi -= 1; 149 | sidxEpi.at(0, 0) = 0; 150 | cps->set_sidx(sidxEpi); 151 | } 152 | cps->pdv.s = exp(cps->pdv.s); 153 | cps->pdv.z = exp(cps->pdv.z); 154 | if(A.n_rows > 0){ 155 | cps->pdv.y = exp(cps->pdv.y); 156 | } 157 | if(trace){ 158 | Rcpp::Rcout << "Optimal solution found." << std::endl; 159 | } 160 | return cps; 161 | } 162 | // Compute initial scalings 163 | if(i == 0){ 164 | WList = cList.ntsc(pdv->s, pdv->z); 165 | Lambda = cList.getLambda(WList); 166 | } 167 | LambdaPrd = cList.sprd(Lambda, Lambda); 168 | sigma = 0.0; 169 | // 170 | // Creating objects for epigraph form 171 | // 172 | cEpi = cList; 173 | WEpi = WList; 174 | cEpi.n -= 1; 175 | cEpi.G.shed_col(n - 1); 176 | cEpi.G.shed_row(0); 177 | cEpi.h.shed_row(0); 178 | // Distinguishing three cases: 179 | // mnl == 1 and K > 1 : only f0 and NNO constraints 180 | // mnl > 1 and K == 1 : f0 and posinomial constraints; no NNO constraints 181 | // mnl > 1 and K > 1 : f0, posinomial constraints and cone constraints 182 | // Problem to be solved is reduced to x0 183 | 184 | // mnl == 1 and K > 1 185 | if((mnl == 1) && (cList.K > 1)){ 186 | WEpi.erase(WEpi.begin()); 187 | cEpi.K -= 1; 188 | cEpi.sidx.shed_row(0); 189 | cEpi.sidx -= 1; 190 | cEpi.sidx.at(0, 0) = 0; 191 | cEpi.cone.erase(cEpi.cone.begin()); 192 | cEpi.dims.shed_row(0); 193 | } 194 | // mnl > 1 and K == 1 195 | if((mnl > 1) && (cList.K == 1)){ 196 | WEpi[0]["dnl"] = WEpi[0]["dnl"](span(1, mnl - 1), span::all); 197 | WEpi[0]["dnli"] = WEpi[0]["dnli"](span(1, mnl - 1), span::all); 198 | cEpi.dims(0) -= 1; 199 | cEpi.sidx(0, 1) -= 1; 200 | } 201 | // mnl > 1 and K > 1 202 | if((mnl > 1) && (cList.K > 1)){ 203 | WEpi[0]["dnl"] = WEpi[0]["dnl"](span(1, mnl - 1), span::all); 204 | WEpi[0]["dnli"] = WEpi[0]["dnli"](span(1, mnl - 1), span::all); 205 | cEpi.dims(0) -= 1; 206 | cEpi.sidx = cEpi.sidx - 1; 207 | cEpi.sidx(0, 0) = 0; 208 | } 209 | LHS.submat(0, 0, ne - 1, ne - 1) = H + cEpi.gwwg(WEpi); 210 | // Finding solution of increments in two-round loop 211 | // (same for affine and combined solution) 212 | for(int ii = 0; ii < 2; ii++){ 213 | mu = gap / m; 214 | dpdv->s = -1.0 * LambdaPrd + OneE * sigma * mu; 215 | dpdv->x = -1.0 * rx; 216 | dpdv->y = -1.0 * ry; 217 | dpdv->z = -1.0 * rz; 218 | // Solving KKT-system 219 | try{ 220 | dpdv->s = cList.sinv(dpdv->s, Lambda); 221 | Ws3 = cList.ssnt(dpdv->s, WList, false, true); 222 | dpdv->z = dpdv->z - Ws3; 223 | // Solving reduced system 224 | a = dpdv->z.at(0, 0); // Slack with respect to f0 225 | x1 = dpdv->x.at(n - 1, 0); // Epigraph-variable 't' 226 | ux = dpdv->x(span(0, ne - 1), span::all); 227 | ux = ux + dpdv->x.at(n - 1, 0) * cList.G.submat(0, 0, 0, ne - 1).t(); 228 | uz = dpdv->z(span(1, dpdv->z.n_rows - 1), span::all); 229 | RHS.submat(0, 0, ne - 1, 0) = ux + cEpi.gwwz(WEpi, uz); 230 | if(pdv->y.n_rows > 0){ 231 | RHS.submat(ne, 0, RHS.n_rows - 1, 0) = dpdv->y; 232 | } 233 | // Solving KKT-system 234 | ans = solve(LHS, RHS); 235 | dpdv->x.submat(0, 0, ne - 1, 0) = ans.submat(0, 0, ne - 1, 0); 236 | if(dpdv->y.n_rows > 0){ 237 | dpdv->y = ans.submat(ne, 0, RHS.n_rows - 1, 0); 238 | } 239 | // Preparing dpdv 240 | uz = cEpi.G * dpdv->x.submat(0, 0, ne - 1, 0) - uz; 241 | dpdv->z(span(1, dpdv->z.n_rows - 1), span::all) = cEpi.ssnt(uz, WEpi, true, true); 242 | dpdv->z.at(0, 0) = -dpdv->x.at(dpdv->x.n_rows - 1, 0) * WList[0]["dnl"].at(0, 0); 243 | x1 = dot(cList.G.submat(0, 0, 0, ne - 1), dpdv->x.submat(0, 0, ne - 1, 0)) + 244 | pow(WList[0]["dnl"].at(0, 0), 2) * dpdv->x.at(n - 1, 0) - a; 245 | dpdv->x.at(n - 1, 0) = x1; 246 | dpdv->s = dpdv->s - dpdv->z; 247 | } catch(std::runtime_error &ex) { 248 | ts = cList.smss(pdv->s).max(); 249 | tz = cList.smss(pdv->z).max(); 250 | state["pobj"] = pcost; 251 | state["dobj"] = dcost; 252 | state["dgap"] = gap; 253 | state["certp"] = pres; 254 | state["certd"] = dres; 255 | state["pslack"] = -ts; 256 | state["dslack"] = -tz; 257 | if(!std::isnan(rgap)){ 258 | state["rgap"] = rgap; 259 | } 260 | cps->set_state(state); 261 | cps->set_status("unknown"); 262 | cps->set_niter(i); 263 | cps->set_pdv(*pdv); 264 | if(trace){ 265 | Rcpp::Rcout << "Terminated (singular KKT matrix)." << std::endl; 266 | } 267 | return cps; 268 | } catch(...) { 269 | ::Rf_error("C++ exception (unknown reason)"); 270 | } 271 | // Maximum step to boundary 272 | dpdv->s = cList.sslb(dpdv->s, Lambda, false); 273 | dpdv->z = cList.sslb(dpdv->z, Lambda, false); 274 | ts = cList.smss(dpdv->s).max(); 275 | tz = cList.smss(dpdv->z).max(); 276 | ss = { 0.0, ts, tz }; 277 | tm = ss.max(); 278 | if(tm == 0.0){ 279 | step = 1.0; 280 | } else { 281 | step = std::min(1.0, sadj / tm); 282 | } 283 | // Backtracking until x is in the domain of f 284 | backTrack = true; 285 | while(backTrack){ 286 | x = pdv->x + step * dpdv->x; 287 | for(int j = 0; j < mnl; j++){ 288 | y = FList[j] * x(span(0, ne - 1), span::all) + gList[j]; 289 | ymax = y.max(); 290 | y = exp(y - ymax); 291 | ysum = norm(y, 1); 292 | Fval.at(j, 0) = ymax + log(ysum); 293 | } 294 | Fval.at(0, 0) -= x.at(n - 1, 0); 295 | if(is_finite(Fval)){ 296 | backTrack = false; 297 | } else { 298 | step *= beta; 299 | } 300 | } // end while-loop domain of f 301 | if(ii == 0){ 302 | sigma = pow((1.0 - step), 3.0); 303 | } 304 | } // end ii-loop 305 | 306 | // Updating x, y; s and z (in current scaling) 307 | pdv->x = pdv->x + step * dpdv->x; 308 | pdv->y = pdv->y + step * dpdv->y; 309 | 310 | dpdv->s = cList.SorZupdate(dpdv->s, Lambda, step); 311 | dpdv->z = cList.SorZupdate(dpdv->z, Lambda, step); 312 | 313 | // Updating NT-scaling and Lagrange Multipliers 314 | WList = cList.ntsu(dpdv->s, dpdv->z, WList); 315 | Lambda = cList.getLambda(WList); 316 | pdv->s = cList.ssnt(Lambda, WList, false, true); 317 | pdv->z = cList.ssnt(Lambda, WList, true, false); 318 | gap = sum(cList.sdot(Lambda, Lambda)); 319 | } // end i-loop 320 | 321 | // Preparing result for non-convergence in maxiters iterations 322 | cps->set_pdv(*pdv); 323 | cps->pdv.x.reshape(ne, 1); 324 | cps->pdv.x = exp(cps->pdv.x); 325 | cps->set_sidx(cList.sidx); 326 | state["pobj"] = pcost; 327 | state["dobj"] = dcost; 328 | state["dgap"] = gap; 329 | state["certp"] = pres; 330 | state["certd"] = dres; 331 | ts = cList.smss(pdv->s).max(); 332 | tz = cList.smss(pdv->z).max(); 333 | state["pslack"] = -ts; 334 | state["dslack"] = -tz; 335 | if(!std::isnan(rgap)){ 336 | state["rgap"] = rgap; 337 | } 338 | cps->set_state(state); 339 | cps->set_niter(maxiters); 340 | cps->set_status("unknown"); 341 | if(trace){ 342 | Rcpp::Rcout << "Optimal solution not determined in " << maxiters << " iteration(s)." << std::endl; 343 | } 344 | cps->pdv.s.set_size(cList.G.n_rows - 1, 1); 345 | cps->pdv.z.set_size(cList.G.n_rows - 1, 1); 346 | cps->pdv.s = pdv->s.submat(1, 0, cList.G.n_rows - 1, 0); 347 | cps->pdv.z = pdv->z.submat(1, 0, cList.G.n_rows - 1, 0); 348 | cps->pdv.s = exp(cps->pdv.s); 349 | cps->pdv.z = exp(cps->pdv.z); 350 | if(A.n_rows > 0){ 351 | cps->pdv.y = exp(cps->pdv.y); 352 | } 353 | umat sidxEpi = cList.sidx; 354 | sidxEpi -= 1; 355 | sidxEpi.at(0, 0) = 0; 356 | cps->set_sidx(sidxEpi); 357 | 358 | return cps; 359 | } 360 | -------------------------------------------------------------------------------- /src/Makevars: -------------------------------------------------------------------------------- 1 | PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) 2 | PKG_CPPFLAGS = -I../inst/include/ 3 | -------------------------------------------------------------------------------- /src/Makevars.win: -------------------------------------------------------------------------------- 1 | PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) 2 | PKG_CPPFLAGS = -I../inst/include/ 3 | -------------------------------------------------------------------------------- /src/Modules.cpp: -------------------------------------------------------------------------------- 1 | #include "CPG.h" 2 | using namespace arma; 3 | /* 4 | * Module for control options of optimization routines 5 | */ 6 | RCPP_MODULE(CPG){ 7 | 8 | Rcpp::class_( "CTRL" ) 9 | .constructor("Default constructor") 10 | .constructor("sets the CTRL-options") 11 | 12 | .property("params", &CTRL::get_params, &CTRL::set_params, "Getter and setter for control parameters") 13 | ; 14 | 15 | Rcpp::class_( "PDV" ) 16 | .constructor("Default constructor") 17 | .constructor("PDV-values; stacked slack variables.") 18 | 19 | .property("x", &PDV::get_x, &PDV::set_x, "Getter and setter for x") 20 | .property("y", &PDV::get_y, &PDV::set_y, "Getter and setter for y") 21 | .property("s", &PDV::get_s, &PDV::set_s, "Getter and setter for s") 22 | .property("z", &PDV::get_z, &PDV::set_z, "Getter and setter for z") 23 | .property("kappa", &PDV::get_kappa, &PDV::set_kappa, "Getter and setter for kappa") 24 | .property("tau", &PDV::get_tau, &PDV::set_tau, "Getter and setter for tau") 25 | ; 26 | 27 | Rcpp::class_( "CONEC" ) 28 | .constructor("Default constructor") 29 | .constructor, mat, mat, umat, uvec, int, int>("cone constraints") 30 | .constructor("no cone constraints, setting n") 31 | 32 | .property("cone", &CONEC::get_cone, &CONEC::set_cone, "Getter and setter for cone types") 33 | .property("G", &CONEC::get_G, &CONEC::set_G, "Getter and setter for Gmats") 34 | .property("h", &CONEC::get_h, &CONEC::set_h, "Getter and setter for hmats") 35 | .property("sidx", &CONEC::get_sidx, &CONEC::set_sidx, "Getter and setter for sidx") 36 | .property("dims", &CONEC::get_dims, &CONEC::set_dims, "Getter and setter for dims") 37 | .property("K", &CONEC::get_K, &CONEC::set_K, "Getter and setter for K") 38 | .property("n", &CONEC::get_n, &CONEC::set_n, "Getter and setter for K") 39 | 40 | .method("initpdv", &CONEC::initpdv) 41 | 42 | ; 43 | 44 | Rcpp::class_( "DCP" ) 45 | .constructor("Default constructor") 46 | .constructor("sets the DCP-values") 47 | 48 | .property("x0", &DCP::get_x0, &DCP::set_x0, "Getter and setter for x0") 49 | .property("cList", &DCP::get_cList, &DCP::set_cList, "Getter and setter for cList") 50 | .property("nList", &DCP::get_nList, &DCP::set_nList, "Getter and setter for nList") 51 | .property("A", &DCP::get_A, &DCP::set_A, "Getter and setter for A") 52 | .property("b", &DCP::get_b, &DCP::set_b, "Getter and setter for b") 53 | 54 | .method("cps", &DCP::cps) 55 | ; 56 | 57 | Rcpp::class_( "DLP" ) 58 | .constructor("Default constructor") 59 | .constructor("sets the DLP-values") 60 | 61 | .property("q", &DLP::get_q, &DLP::set_q, "Getter and setter for q") 62 | .property("A", &DLP::get_A, &DLP::set_A, "Getter and setter for A") 63 | .property("b", &DLP::get_b, &DLP::set_b, "Getter and setter for b") 64 | .property("cList", &DLP::get_cList, &DLP::set_cList, "Getter and setter for cList") 65 | 66 | .method("cps", &DLP::cps) 67 | ; 68 | 69 | Rcpp::class_( "DNL" ) 70 | .constructor("Default constructor") 71 | .constructor("sets the DNL-values") 72 | 73 | .property("q", &DNL::get_q, &DNL::set_q, "Getter and setter for q") 74 | .property("A", &DNL::get_A, &DNL::set_A, "Getter and setter for A") 75 | .property("b", &DNL::get_b, &DNL::set_b, "Getter and setter for b") 76 | .property("cList", &DNL::get_cList, &DNL::set_cList, "Getter and setter for cList") 77 | .property("x0", &DNL::get_x0, &DNL::set_x0, "Getter and setter for x0") 78 | .property("nList", &DNL::get_nList, &DNL::set_nList, "Getter and setter for nList") 79 | 80 | .method("cps", &DNL::cps) 81 | ; 82 | 83 | Rcpp::class_( "DQP" ) 84 | .constructor("Default constructor") 85 | .constructor("sets the DQP-values") 86 | 87 | .property("P", &DQP::get_P, &DQP::set_P, "Getter and setter for P") 88 | .property("q", &DQP::get_q, &DQP::set_q, "Getter and setter for q") 89 | .property("A", &DQP::get_A, &DQP::set_A, "Getter and setter for A") 90 | .property("b", &DQP::get_b, &DQP::set_b, "Getter and setter for b") 91 | .property("cList", &DQP::get_cList, &DQP::set_cList, "Getter and setter for cList") 92 | 93 | .method("cps", &DQP::cps) 94 | ; 95 | 96 | Rcpp::class_( "CPS" ) 97 | .constructor("Default constructor") 98 | .constructor("sets the CPS-values") 99 | 100 | .property("pdv", &CPS::get_pdv, &CPS::set_pdv, "Getter and setter for pdv") 101 | .property("state", &CPS::get_state, &CPS::set_state, "Getter and setter for state") 102 | .property("status", &CPS::get_status, &CPS::set_status, "Getter and setter for status") 103 | .property("niter", &CPS::get_niter, &CPS::set_niter, "Getter and setter for niter") 104 | .property("sidx", &CPS::get_sidx, &CPS::set_sidx, "Getter and setter for sidx") 105 | ; 106 | 107 | Rcpp::function("rpp", &rpp); 108 | Rcpp::function("gpp", &gpp); 109 | } 110 | 111 | 112 | -------------------------------------------------------------------------------- /src/RPP.cpp: -------------------------------------------------------------------------------- 1 | /* 2 | * Function for solving risk parity portfolios (long-only) 3 | */ 4 | #include "cccp.h" 5 | using namespace arma; 6 | 7 | CPS* rpp(mat x0, mat P, mat mrc, CTRL& ctrl){ 8 | // Initializing objects 9 | int ne = P.n_cols; 10 | int n = ne + 1; 11 | // Constraints 12 | CONEC cList, cEpi; 13 | std::vector cones; 14 | cones.push_back("NLFC"); 15 | cones.push_back("NNOC"); 16 | cList.cone = cones; 17 | cList.G.eye(ne, ne); 18 | cList.G *= -1.0; 19 | cList.G.insert_cols(ne, 1); 20 | cList.G.insert_rows(0, 1); 21 | cList.G(0, ne) = -1.0; 22 | cList.h.zeros(n, 1); 23 | cList.dims << 1 << ne << endr; 24 | cList.sidx << 0 << 0 << endr 25 | << 1 << ne << endr; 26 | cList.K = 2; 27 | cList.n = n; 28 | // Primal dual variables 29 | PDV* pdv = cList.initpdv(0); 30 | PDV* dpdv = cList.initpdv(0); 31 | pdv->x(span(0, ne - 1), span::all) = x0; 32 | // Solution 33 | CPS* cps = new CPS(); 34 | cps->set_pdv(*pdv); 35 | cps->set_sidx(cList.sidx); 36 | // Objects used in iterations 37 | Rcpp::NumericVector state = cps->get_state(); 38 | bool checkRgap = false, backTrack; 39 | int m = sum(cList.dims); 40 | double Fval, gap = m, resx, resz, pcost = 1.0, dcost = 1.0, rgap = NA_REAL, 41 | pres = 1.0, dres = 1.0, pres0 = 1.0, dres0 = 1.0, sigma, mu, ts, tz, tm, step, a, x1; 42 | vec ss(3); 43 | mat H(ne, ne), LHS = zeros(ne, ne), rx, rz(cList.G.n_rows, 1), Lambda, LambdaPrd, Ws3, x, 44 | ux(ne, 1), uz, RHS(ne, 1); 45 | mat OneE = cList.sone(); 46 | std::vector > WList, WEpi; 47 | // Setting control parameters 48 | Rcpp::List params(ctrl.get_params()); 49 | bool trace = Rcpp::as(params["trace"]); 50 | int maxiters = Rcpp::as(params["maxiters"]); 51 | double atol = Rcpp::as(params["abstol"]); 52 | double ftol = Rcpp::as(params["feastol"]); 53 | double rtol = Rcpp::as(params["reltol"]); 54 | double sadj = Rcpp::as(params["stepadj"]); 55 | double beta = Rcpp::as(params["beta"]); 56 | // 57 | // Starting iterations 58 | // 59 | for(int i = 0; i < maxiters; i++){ 60 | // Setting f0 to first row of h-matrix 61 | cList.h(0, 0) = rpp_f0(pdv->x(span(0, ne - 1), span::all), P, mrc) - pdv->x.at(n - 1, 0); 62 | // Setting Df to first row of G-matrix 63 | cList.G(0, span(0, ne - 1)) = rpp_g0(pdv->x(span(0, ne - 1), span::all), P, mrc).t(); 64 | // Computing Hessian 65 | H = pdv->z.at(0, 0) * rpp_h0(pdv->x(span(0, ne - 1), span::all), P, mrc); 66 | // Computing gap 67 | gap = sum(cList.sdot(pdv->s, pdv->z)); 68 | // Computing residuals 69 | // Dual Residuals 70 | rx = cList.G.t() * pdv->z; 71 | rx.at(rx.n_rows - 1, 0) += 1.0; 72 | resx = norm(rx); 73 | // Central Residuals 74 | rz.at(0, 0) = pdv->s.at(0, 0) + cList.h.at(0, 0); 75 | rz(span(cList.sidx.at(1, 0), cList.sidx.at(1, 1)), span::all) = 76 | pdv->s(span(cList.sidx.at(1, 0), cList.sidx.at(1, 1)), span::all) + 77 | cList.G(span(cList.sidx.at(1, 0), cList.sidx.at(1, 1)), span::all) * pdv->x - 78 | cList.h(span(cList.sidx.at(1, 0), cList.sidx.at(1, 1)), span::all); 79 | resz = cList.snrm2(rz); 80 | // Statistics for stopping criteria 81 | pcost = pdv->x.at(pdv->x.n_rows - 1, 0); 82 | dcost = pcost + sum(cList.sdot(rz, pdv->z)) - gap; 83 | rgap = NA_REAL; 84 | if(pcost < 0.0) rgap = gap / (-pcost); 85 | if(dcost > 0.0) rgap = gap / dcost; 86 | pres = sqrt(resz * resz); 87 | dres = resx; 88 | if(i == 0){ 89 | pres0 = std::max(1.0, pres); 90 | dres0 = std::max(1.0, dres); 91 | } 92 | pres = pres / pres0; 93 | dres = dres / dres0; 94 | // Tracing status quo of IPM 95 | if(trace){ 96 | Rcpp::Rcout << "Iteration: " << i << std::endl; 97 | Rcpp::Rcout << "pobj: " << pcost << std::endl; 98 | Rcpp::Rcout << "dobj: " << dcost << std::endl; 99 | Rcpp::Rcout << "pinf: " << pres << std::endl; 100 | Rcpp::Rcout << "dinf: " << dres << std::endl; 101 | Rcpp::Rcout << "dgap: " << gap << std::endl; 102 | Rcpp::Rcout << std::endl; 103 | } 104 | // Checking convergence 105 | if(!std::isnan(rgap)){ 106 | checkRgap = (rgap <= rtol); 107 | } else { 108 | checkRgap = false; 109 | } 110 | if((pres <= ftol) && (dres <= ftol) && ((gap <= atol) || checkRgap)){ 111 | ts = cList.smss(pdv->s).max(); 112 | tz = cList.smss(pdv->z).max(); 113 | state["pobj"] = pcost; 114 | state["dobj"] = dcost; 115 | state["dgap"] = gap; 116 | state["certp"] = pres; 117 | state["certd"] = dres; 118 | state["pslack"] = -ts; 119 | state["dslack"] = -tz; 120 | if(!std::isnan(rgap)){ 121 | state["rgap"] = rgap; 122 | } 123 | cps->set_state(state); 124 | cps->set_status("optimal"); 125 | cps->set_niter(i); 126 | cps->set_pdv(*pdv); 127 | cps->pdv.x.reshape(ne, 1); // removing variable 't' 128 | cps->pdv.x = cps->pdv.x / accu(cps->pdv.x); // Budget constraint 129 | cps->pdv.s.set_size(cList.G.n_rows - 1, 1); 130 | cps->pdv.z.set_size(cList.G.n_rows - 1, 1); 131 | cps->pdv.s = pdv->s.submat(1, 0, cList.G.n_rows - 1, 0); 132 | cps->pdv.z = pdv->z.submat(1, 0, cList.G.n_rows - 1, 0); 133 | umat sidxEpi = cList.sidx; 134 | sidxEpi.shed_row(0); 135 | sidxEpi -= 1; 136 | sidxEpi.at(0, 0) = 0; 137 | cps->set_sidx(sidxEpi); 138 | if(trace){ 139 | Rcpp::Rcout << "Optimal solution found." << std::endl; 140 | } 141 | return cps; 142 | } 143 | // Compute initial scalings 144 | if(i == 0){ 145 | WList = cList.ntsc(pdv->s, pdv->z); 146 | Lambda = cList.getLambda(WList); 147 | } 148 | LambdaPrd = cList.sprd(Lambda, Lambda); 149 | sigma = 0.0; 150 | 151 | // 152 | // Creating objects for epigraph form 153 | // 154 | cEpi = cList; 155 | WEpi = WList; 156 | cEpi.n -= 1; 157 | cEpi.K -= 1; 158 | cEpi.G.shed_col(n - 1); 159 | cEpi.G.shed_row(0); 160 | cEpi.h.shed_row(0); 161 | cEpi.sidx.shed_row(0); 162 | cEpi.sidx -= 1; 163 | cEpi.sidx.at(0, 0) = 0; 164 | cEpi.cone.erase(cEpi.cone.begin()); 165 | cEpi.dims.shed_row(0); 166 | WEpi.erase(WEpi.begin()); 167 | LHS = H + cEpi.gwwg(WEpi); 168 | // Finding solution of increments in two-round loop 169 | // (same for affine and combined solution) 170 | for(int ii = 0; ii < 2; ii++){ 171 | mu = gap / m; 172 | dpdv->s = -1.0 * LambdaPrd + OneE * sigma * mu; 173 | dpdv->x = -1.0 * rx; 174 | dpdv->z = -1.0 * rz; 175 | // Solving KKT-system 176 | try{ 177 | dpdv->s = cList.sinv(dpdv->s, Lambda); 178 | Ws3 = cList.ssnt(dpdv->s, WList, false, true); 179 | dpdv->z = dpdv->z - Ws3; 180 | // Solving reduced system 181 | a = dpdv->z.at(0, 0); // Slack with respect to f0 182 | x1 = dpdv->x.at(n - 1, 0); // Epigraph-variable 't' 183 | ux = dpdv->x(span(0, ne - 1), span::all); 184 | ux = ux + dpdv->x.at(n - 1, 0) * cList.G.submat(0, 0, 0, ne - 1).t(); 185 | uz = dpdv->z(span(1, dpdv->z.n_rows - 1), span::all); 186 | RHS = ux + cEpi.gwwz(WEpi, uz); 187 | dpdv->x.submat(0, 0, ne - 1, 0) = solve(LHS, RHS); 188 | // Preparing dpdv 189 | uz = cEpi.G * dpdv->x.submat(0, 0, ne - 1, 0) - uz; 190 | dpdv->z(span(1, dpdv->z.n_rows - 1), span::all) = cEpi.ssnt(uz, WEpi, true, true); 191 | dpdv->z.at(0, 0) = -dpdv->x.at(dpdv->x.n_rows - 1, 0) * WList[0]["dnl"].at(0, 0); 192 | x1 = dot(cList.G.submat(0, 0, 0, ne - 1), dpdv->x.submat(0, 0, ne - 1, 0)) + 193 | pow(WList[0]["dnl"].at(0, 0), 2) * dpdv->x.at(n - 1, 0) - a; 194 | dpdv->x.at(n - 1, 0) = x1; 195 | dpdv->s = dpdv->s - dpdv->z; 196 | } catch(std::runtime_error &ex) { 197 | ts = cList.smss(pdv->s).max(); 198 | tz = cList.smss(pdv->z).max(); 199 | state["pobj"] = pcost; 200 | state["dobj"] = dcost; 201 | state["dgap"] = gap; 202 | state["certp"] = pres; 203 | state["certd"] = dres; 204 | state["pslack"] = -ts; 205 | state["dslack"] = -tz; 206 | if(!std::isnan(rgap)){ 207 | state["rgap"] = rgap; 208 | } 209 | cps->set_state(state); 210 | cps->set_status("unknown"); 211 | cps->set_niter(i); 212 | cps->set_pdv(*pdv); 213 | if(trace){ 214 | Rcpp::Rcout << "Terminated (singular KKT matrix)." << std::endl; 215 | } 216 | return cps; 217 | } catch(...) { 218 | ::Rf_error("C++ exception (unknown reason)"); 219 | } 220 | // Maximum step to boundary 221 | dpdv->s = cList.sslb(dpdv->s, Lambda, false); 222 | dpdv->z = cList.sslb(dpdv->z, Lambda, false); 223 | ts = cList.smss(dpdv->s).max(); 224 | tz = cList.smss(dpdv->z).max(); 225 | ss = { 0.0, ts, tz }; 226 | tm = ss.max(); 227 | if(tm == 0.0){ 228 | step = 1.0; 229 | } else { 230 | step = std::min(1.0, sadj / tm); 231 | } 232 | // Backtracking until x is in the domain of f 233 | backTrack = true; 234 | while(backTrack){ 235 | x = pdv->x + step * dpdv->x; 236 | Fval = rpp_f0(x(span(0, ne - 1), span::all), P, mrc) - x.at(n - 1, 0); 237 | if(is_finite(Fval)){ 238 | backTrack = false; 239 | } else { 240 | step *= beta; 241 | } 242 | } // end while-loop domain of f 243 | if(ii == 0){ 244 | sigma = pow((1.0 - step), 3.0); 245 | } 246 | } // end ii-loop 247 | 248 | // Updating x, y; s and z (in current scaling) 249 | pdv->x = pdv->x + step * dpdv->x; 250 | pdv->y = pdv->y + step * dpdv->y; 251 | 252 | dpdv->s = cList.SorZupdate(dpdv->s, Lambda, step); 253 | dpdv->z = cList.SorZupdate(dpdv->z, Lambda, step); 254 | 255 | // Updating NT-scaling and Lagrange Multipliers 256 | WList = cList.ntsu(dpdv->s, dpdv->z, WList); 257 | Lambda = cList.getLambda(WList); 258 | pdv->s = cList.ssnt(Lambda, WList, false, true); 259 | pdv->z = cList.ssnt(Lambda, WList, true, false); 260 | gap = sum(cList.sdot(Lambda, Lambda)); 261 | } // end i-loop 262 | 263 | // Preparing result for non-convergence in maxiters iterations 264 | cps->set_pdv(*pdv); 265 | cps->pdv.x.reshape(ne, 1); 266 | cps->set_sidx(cList.sidx); 267 | state["pobj"] = pcost; 268 | state["dobj"] = dcost; 269 | state["dgap"] = gap; 270 | state["certp"] = pres; 271 | state["certd"] = dres; 272 | ts = cList.smss(pdv->s).max(); 273 | tz = cList.smss(pdv->z).max(); 274 | state["pslack"] = -ts; 275 | state["dslack"] = -tz; 276 | if(!std::isnan(rgap)){ 277 | state["rgap"] = rgap; 278 | } 279 | cps->set_state(state); 280 | cps->set_niter(maxiters); 281 | cps->set_status("unknown"); 282 | if(trace){ 283 | Rcpp::Rcout << "Optimal solution not determined in " << maxiters << " iteration(s)." << std::endl; 284 | } 285 | cps->pdv.x = cps->pdv.x / accu(cps->pdv.x); // Budget constraint 286 | cps->pdv.s.set_size(cList.G.n_rows - 1, 1); 287 | cps->pdv.z.set_size(cList.G.n_rows - 1, 1); 288 | cps->pdv.s = pdv->s.submat(1, 0, cList.G.n_rows - 1, 0); 289 | cps->pdv.z = pdv->z.submat(1, 0, cList.G.n_rows - 1, 0); 290 | umat sidxEpi = cList.sidx; 291 | sidxEpi.shed_row(0); 292 | sidxEpi -= 1; 293 | sidxEpi.at(0, 0) = 0; 294 | cps->set_sidx(sidxEpi); 295 | 296 | return cps; 297 | } 298 | -------------------------------------------------------------------------------- /src/RcppExports.cpp: -------------------------------------------------------------------------------- 1 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #include "../inst/include/cccp.h" 5 | #include 6 | #include 7 | 8 | using namespace Rcpp; 9 | 10 | 11 | RcppExport SEXP _rcpp_module_boot_CPG(); 12 | 13 | static const R_CallMethodDef CallEntries[] = { 14 | {"_rcpp_module_boot_CPG", (DL_FUNC) &_rcpp_module_boot_CPG, 0}, 15 | {NULL, NULL, 0} 16 | }; 17 | 18 | RcppExport void R_init_cccp(DllInfo *dll) { 19 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 20 | R_useDynamicSymbols(dll, FALSE); 21 | } 22 | -------------------------------------------------------------------------------- /tests/doRUnit.R: -------------------------------------------------------------------------------- 1 | #### doRUnit.R --- Run RUnit tests 2 | ####------------------------------------------------------------------------ 3 | 4 | ### Origianlly follows Gregor Gojanc's example in CRAN package 'gdata' 5 | ### and the corresponding section in the R Wiki: 6 | ### http://wiki.r-project.org/rwiki/doku.php?id=developers:runit 7 | 8 | ### MM: Vastly changed: This should also be "runnable" for *installed* 9 | ## package which has no ./tests/ 10 | ## ----> put the bulk of the code e.g. in ../inst/unitTests/runTests.R : 11 | 12 | if(require("RUnit", quietly = TRUE)) { 13 | 14 | ## --- Setup --- 15 | 16 | wd <- getwd() 17 | pkg <- sub("\\.Rcheck$", '', basename(dirname(wd))) 18 | 19 | library(package=pkg, character.only=TRUE) 20 | 21 | path <- system.file("unitTests", package = pkg) 22 | 23 | stopifnot(file.exists(path), file.info(path.expand(path))$isdir) 24 | 25 | source(file.path(path, "runTests.R"), echo = TRUE) 26 | } 27 | --------------------------------------------------------------------------------