tests/testthat/test-g01-dgp2dcp.R

context("test-g01-dgp2dcp")
TOL <- 1e-6

Solution <- CVXR:::Solution
perform <- CVXR:::perform
reduce <- CVXR:::reduce
invert <- CVXR:::invert
retrieve <- CVXR:::retrieve
unpack_problem <- CVXR:::unpack_problem
cvxr_expr <- CVXR:::expr

Dgp2Dcp <- function(problem = NULL) { new("Dgp2Dcp", problem = problem) }
Dgp2Dcp.add_canon <- CVXR:::Dgp2Dcp.add_canon
Dgp2Dcp.mulexpression_canon <- CVXR:::Dgp2Dcp.mulexpression_canon
Dgp2Dcp.prod_canon <- CVXR:::Dgp2Dcp.prod_canon
Dgp2Dcp.trace_canon <- CVXR:::Dgp2Dcp.trace_canon

form_solution <- function(prob, result) {
  primal <- list()
  for(var in prob@variables)
    primal[[as.character(var@id)]] <- result$getValue(var)

  dual <- list()
  for(constr in prob@constraints)
    dual[[as.character(constr@id)]] <- result$getDualValue(constr)

  attr <- list(solve_time = result$solve_time, setup_time = result$setup_time, num_iters = result$num_iters)
  Solution(result$status, result$value, primal, dual, attr)
}

test_that("test unconstrained monomial", {
  skip_on_cran()
  x <- Variable(pos = TRUE)
  y <- Variable(pos = TRUE)
  prod <- x*y
  dgp <- Problem(Minimize(prod))
  dgp2dcp <- Dgp2Dcp(dgp)

  tmp <- reduce(dgp2dcp)
  dgp2dcp <- tmp[[1]]
  dcp <- tmp[[2]]

  expect_equal(class(cvxr_expr(dcp@objective))[1], "AddExpression")
  expect_equal(length(cvxr_expr(dcp@objective)@args), 2)
  expect_equal(class(cvxr_expr(dcp@objective)@args[[1]])[1], "Variable")
  expect_equal(class(cvxr_expr(dcp@objective)@args[[2]])[1], "Variable")
  opt <- solve(dcp)

  # dcp is solved in log-space, so it is unbounded below
  # (since the OPT for dgp is 0 + epsilon).
  expect_equal(opt$value, -Inf)
  expect_equal(opt$status, "unbounded")

  solution <- form_solution(dcp, opt)
  dgp_unpack <- unpack_problem(dgp, retrieve(dgp2dcp, solution))
  expect_equal(dgp_unpack$value, 0.0)
  expect_equal(dgp_unpack$status, "unbounded")
  opt <- solve(dgp, gp = TRUE)
  expect_equal(opt$value, 0.0)
  expect_equal(opt$status, "unbounded")

  dgp <- Problem(Maximize(prod))
  dgp2dcp <- Dgp2Dcp(dgp)
  tmp <- reduce(dgp2dcp)
  dgp2dcp <- tmp[[1]]
  dcp <- tmp[[2]]
  opt <- solve(dcp)
  expect_equal(opt$value, Inf)
  expect_equal(opt$status, "unbounded")

  solution <- form_solution(dcp, opt)
  dgp_unpack <- unpack_problem(dgp, retrieve(dgp2dcp, solution))
  expect_equal(dgp_unpack$value, Inf)
  expect_equal(dgp_unpack$status, "unbounded")
  opt <- solve(dgp, gp = TRUE)
  expect_equal(opt$value, Inf)
  expect_equal(opt$status, "unbounded")
})

test_that("test basic equality constraint", {
  skip_on_cran()
  x <- Variable(pos = TRUE)
  dgp <- Problem(Minimize(x), list(x == 1.0))
  dgp2dcp <- Dgp2Dcp(dgp)

  tmp <- reduce(dgp2dcp)
  dgp2dcp <- tmp[[1]]
  dcp <- tmp[[2]]
  expect_equal(class(dcp@objective@args[[1]])[1], "Variable")

  opt <- solve(dcp)
  expect_equal(opt$value, 0.0, tolerance = TOL)
  expect_equal(opt$getValue(variables(dcp)[[1]]), 0.0, tolerance = TOL)

  solution <- form_solution(dcp, opt)
  dgp_unpack <- unpack_problem(dgp, retrieve(dgp2dcp, solution))
  expect_equal(dgp_unpack$value, 1.0, tolerance = TOL)
  expect_equal(dgp_unpack$getValue(x), 1.0, tolerance = TOL)
  result <- solve(dgp, gp = TRUE)
  expect_equal(result$value, 1.0, tolerance = TOL)
  expect_equal(result$getValue(x), 1.0, tolerance = TOL)
})

test_that("test basic GP", {
  skip_on_cran()
  x <- Variable(pos = TRUE)
  y <- Variable(pos = TRUE)
  z <- Variable(pos = TRUE)
  constraints <- list(2*x*y + 2*x*z + 2*y*z <= 1.0, x >= 2*y)
  problem <- Problem(Minimize(1/(x*y*z)), constraints)
  result <- solve(problem, gp = TRUE)
  expect_equal(15.59, result$value, tolerance = 1e-2)
})

test_that("test max_elemwise", {
  skip_on_cran()
  x <- Variable(pos = TRUE)
  y <- Variable(pos = TRUE)
  z <- Variable(pos = TRUE)

  prod1 <- x*y^(0.5)
  prod2 <- 3.0*x*y^(0.5)
  obj <- Minimize(max_elemwise(prod1, prod2))
  constr <- list(x == 1.0, y == 4.0)

  dgp <- Problem(obj, constr)
  dgp2dcp <- Dgp2Dcp(dgp)
  tmp <- reduce(dgp2dcp)
  dgp2dcp <- tmp[[1]]
  dcp <- tmp[[2]]
  opt <- solve(dcp)
  solution <- form_solution(dcp, opt)
  dgp_unpack <- unpack_problem(dgp, retrieve(dgp2dcp, solution))
  expect_equal(dgp_unpack$value, 6.0, tolerance = TOL)
  expect_equal(dgp_unpack$getValue(x), 1.0, tolerance = TOL)
  expect_equal(dgp_unpack$getValue(y), 4.0, tolerance = TOL)
  result <- solve(dgp, gp = TRUE)
  expect_equal(result$value, 6.0, tolerance = TOL)
  expect_equal(result$getValue(x), 1.0, tolerance = TOL)
})

# TODO_NARAS_5: Test keepdims. Need to edit test to match CVXPY.
test_that("test prod_entries", {
  skip_on_cran()
  X <- matrix(0:11, nrow = 4, ncol = 3)
  expect_equal(prod(X), value(prod_entries(X)))
  expect_equal(apply(X, 1, prod), value(prod_entries(X, axis = 1)))
  expect_equal(apply(X, 2, prod), value(prod_entries(X, axis = 2)))

  prod <- prod_entries(X)
  X_canon <- Dgp2Dcp.prod_canon(prod, prod@args)[[1]]
  expect_equal(sum(X), value(X_canon))

  prod <- prod_entries(X, axis = 1)
  X_canon <- Dgp2Dcp.prod_canon(prod, prod@args)[[1]]
  expect_equal(apply(X, 1, sum), value(X_canon))

  prod <- prod_entries(X, axis = 2)
  X_canon <- Dgp2Dcp.prod_canon(prod, prod@args)[[1]]
  expect_equal(apply(X, 2, sum), value(X_canon))

  X <- matrix(0:11, nrow = 12, ncol = 1)
  expect_equal(prod(X), value(prod_entries(X)))

  prod <- prod_entries(X)
  X_canon <- Dgp2Dcp.prod_canon(prod, prod@args)[[1]]
  expect_equal(sum(X), value(X_canon))

  x <- Variable(pos = TRUE)
  y <- Variable(pos = TRUE)
  posy1 <- x*y^(0.5) + 3.0*x*y^(0.5)
  posy2 <- x*y^(0.5) + 3.0*x^2*y^(0.5)
  expect_true(is_log_log_convex(prod_entries(posy1, posy2)))
  expect_false(is_log_log_concave(prod_entries(posy1, posy2)))
  expect_false(is_dgp(prod_entries(posy1, 1/posy1)))

  m <- x*y^(0.5)
  expect_true(is_log_log_affine(prod_entries(m, m)))
  expect_true(is_log_log_concave(prod_entries(m, 1/posy1)))
  expect_false(is_log_log_convex(prod_entries(m, 1/posy1)))
})

test_that("test max_entries", {
  skip_on_cran()
  x <- Variable(pos = TRUE)
  y <- Variable(pos = TRUE)
  z <- Variable(pos = TRUE)

  prod1 <- x*y^(0.5)
  prod2 <- 3.0*x*y^(0.5)
  obj <- Minimize(max_entries(hstack(prod1, prod2)))
  constr <- list(x == 1.0, y == 4.0)

  dgp <- Problem(obj, constr)
  dgp2dcp <- Dgp2Dcp(dgp)
  tmp <- reduce(dgp2dcp)
  dgp2dcp <- tmp[[1]]
  dcp <- tmp[[2]]
  opt <- solve(dcp)
  solution <- form_solution(dcp, opt)
  dgp_unpack <- unpack_problem(dgp, retrieve(dgp2dcp, solution))
  expect_equal(dgp_unpack$value, 6.0)
  expect_equal(dgp_unpack$getValue(x), 1.0)
  expect_equal(dgp_unpack$getValue(y), 4.0)
  result <- solve(dgp, gp = TRUE)
  expect_equal(result$value, 6.0, tolerance = TOL)
  expect_equal(result$getValue(x), 1.0, tolerance = TOL)
})

test_that("test min_elemwise", {
  skip_on_cran()
  x <- Variable(pos = TRUE)
  y <- Variable(pos = TRUE)
  z <- Variable(pos = TRUE)

  prod1 <- x*y^(0.5)
  prod2 <- 3.0*x*y^(0.5)
  posy <- prod1 + prod2
  obj <- Maximize(min_elemwise(prod1, prod2, 1/posy))
  constr <- list(x == 1.0, y == 4.0)

  dgp <- Problem(obj, constr)
  result <- solve(dgp, gp = TRUE)
  expect_equal(result$value, 1.0/(2.0 + 6.0), tolerance = TOL)
  expect_equal(result$getValue(x), 1.0, tolerance = TOL)
  expect_equal(result$getValue(y), 4.0, tolerance = TOL)
})

test_that("test min_entries", {
  skip_on_cran()
  x <- Variable(pos = TRUE)
  y <- Variable(pos = TRUE)
  z <- Variable(pos = TRUE)

  prod1 <- x*y^(0.5)
  prod2 <- 3.0*x*y^(0.5)
  posy <- prod1 + prod2
  obj <- Maximize(min_entries(hstack(prod1, prod2, 1/posy)))
  constr <- list(x == 1.0, y == 4.0)

  dgp <- Problem(obj, constr)
  result <- solve(dgp, gp = TRUE)
  expect_equal(result$value, 1.0/(2.0 + 6.0), tolerance = TOL)
  expect_equal(result$getValue(x), 1.0, tolerance = TOL)
  expect_equal(result$getValue(y), 4.0, tolerance = TOL)
})

# TODO: Enable test once sum_largest is implemented.
# test_that("test sum_largest", {
#   x <- Variable(4, pos = TRUE)
#   obj <- Minimize(sum_largest(x, 3))
#   constr <- list(x[1]*x[2]*x[3]*x[4] >= 16)
#   dgp <- Problem(obj, constr)
#   dgp2dcp <- Dgp2Dcp(dgp)
#   tmp <- reduce(dgp2dcp)
#   dgp2dcp <- tmp[[1]]
#   dcp <- tmp[[2]]
#   result <- solve(dcp)
#   dgp <- unpack_problem(dgp, retrieve(dgp2dcp, result$solution))
#   opt <- 6.0
#   expect_equal(dgp@value, opt, tolerance = TOL)
#   expect_equal(value(x[1]*x[2]*x[3]*x[4]), 16, tolerance = 1e-2)
#   dgp <- clear_solution(dgp)
#   result <- solve(dgp, gp = TRUE)
#   expect_equal(result$value, opt, tolerance = TOL)
#   expect_equal(value(x[1]*x[2]*x[3]*x[4]), 16, tolerance = 1e-2)
#
#   # An unbounded problem.
#   x <- Variable(4, pos = TRUE)
#   y <- Variable(pos = TRUE)
#   obj <- Minimize(sum_largest(x, 3)*y)
#   constr <- list(x[1]*x[2]*x[3]*x[4] >= 16)
#   dgp <- Problem(obj, constr)
#   dgp2dcp <- Dgp2Dcp(dgp)
#   tmp <- reduce(dgp2dcp)
#   dgp2dcp <- tmp[[1]]
#   dcp <- tmp[[2]]
#   opt <- solve(dcp)
#   expect_equal(dcp@value, -Inf)
#   dgp <- unpack_problem(dgp, retrieve(dgp2dcp, opt$solution))
#   expect_equal(dgp@value, 0.0, tolerance = TOL)
#   expect_equal(dgp@status, "unbounded")
#   dgp <- clear_solution(dgp)
#   result <- solve(dgp, gp = TRUE)
#   expect_equal(result$value, 0.0, tolerance = TOL)
#   expect_equal(result$status, "unbounded")
#
#   # Another unbounded problem.
#   x <- Variable(2, pos = TRUE)
#   obj <- Minimize(sum_largest(x, 1))
#   dgp <- Problem(obj)
#   dgp2dcp <- Dgp2Dcp(dgp)
#   tmp <- reduce(dgp2dcp)
#   dgp2dcp <- tmp[[1]]
#   dcp <- tmp[[2]]
#   opt <- solve(dcp)
#   expect_equal(result$value, -Inf)
#   dgp <- unpack_problem(dgp, retrieve(dgp2dcp, opt$solution))
#   expect_equal(dgp@value, 0.0, tolerance = TOL)
#   expect_equal(dgp@status, "unbounded")
#   dgp <- clear_solution(dgp)
#   result <- solve(dgp, gp = TRUE)
#   expect_equal(dgp@value, 0.0, tolerance = TOL)
#   expect_equal(dgp@status, "unbounded")
#
#   # Composition with posynomials.
#   x <- Variable(4, pos = TRUE)
#   obj <- Minimize(sum_largest(hstack(list(3*x[1]^(0.5) * x[2]^(0.5), x[1]*x[2] + 0.5*x[2]*x[4]^3, x[3])), 2))
#   constr <- list(x[1]*x[2] >= 16)
#   dgp <- Problem(obj, constr)
#   dgp2dcp <- Dgp2Dcp(dgp)
#   dcp <- reduce(dgp2dcp)
#   result <- solve(dcp)
#   dgp <- unpack_problem(dgp, retrieve(dgp2dcp, result$solution))
#
#   # opt = 3 * sqrt(4) * sqrt(4) + (4 * 4 + 0.5 * 4 * epsilon) = 28
#   opt <- 28.0
#   expect_equal(dgp@value, opt, tolerance = 1e-2)
#   expect_equal(value(x[1]*x[2]), 16.0, tolerance = 1e-2)
#   expect_equal(value(x[4]), 0.0, tolerance = 1e-2)
#   dgp <- clear_solution(dgp)
#   result <- solve(dgp, gp = TRUE)
#   expect_equal(result$value, opt, tolerance = 1e-2)
#   expect_equal(value(x[1]*x[2]), 16.0, tolerance = 1e-2)
#   expect_equal(value(x[4]), 0.0, tolerance = 1e-2)
# })

test_that("test div", {
  skip_on_cran()
  x <- Variable(pos = TRUE)
  y <- Variable(pos = TRUE)
  p <- Problem(Minimize(x*y), list(y/3 <= x, y >= 1))
  result <- solve(p, gp = TRUE)
  expect_equal(result$value, 1.0/3.0, tolerance = TOL)
  expect_equal(result$getValue(y), 1.0, tolerance = TOL)
  expect_equal(result$getValue(x), 1.0/3.0, tolerance = TOL)
})

test_that("test geo_mean", {
  skip_on_cran()
  x <- Variable(3, pos = TRUE)
  p <- c(1, 2, 0.5)
  expr <- geo_mean(x, p)
  dgp <- Problem(Minimize(expr))
  dgp2dcp <- Dgp2Dcp(dgp)
  tmp <- reduce(dgp2dcp)
  dgp2dcp <- tmp[[1]]
  dcp <- tmp[[2]]
  result <- solve(dcp)
  expect_equal(result$value, -Inf)

  solution <- form_solution(dcp, result)
  dgp_unpack <- unpack_problem(dgp, retrieve(dgp2dcp, solution))
  expect_equal(dgp_unpack$value, 0.0)
  expect_equal(dgp_unpack$status, "unbounded")
  result <- solve(dgp, gp = TRUE)
  expect_equal(result$value, 0.0)
  expect_equal(result$status, "unbounded")
})

test_that("test solving non-dgp problem raises error", {
  skip_on_cran()
  problem <- Problem(Minimize(-1.0*Variable()))
  expect_error(solve(problem, gp = TRUE))
  result <- solve(problem)
  expect_equal(result$status, "unbounded")
  expect_equal(result$value, -Inf)
})

test_that("test solving non-dcp problem raises error", {
  skip_on_cran()
  problem <- Problem(Minimize(Variable(pos = TRUE) * Variable(pos = TRUE)))
  expect_error(solve(problem))
  result <- solve(problem, gp = TRUE)
  expect_equal(result$status, "unbounded", tolerance = TOL)
  expect_equal(result$value, 0.0, tolerance = TOL)
})

test_that("test add_canon", {
  skip_on_cran()
  X <- Constant(rbind(1:3, 4:6))
  Y <- Constant(rbind(2:4, 5:7))
  Z <- X + Y
  canon <- Dgp2Dcp.add_canon(Z, Z@args)
  canon_matrix <- canon[[1]]
  constraints <- canon[[2]]
  expect_equal(length(constraints), 0)
  expect_equal(dim(canon_matrix), dim(Z))
  expected <- log(exp(value(X)) + exp(value(Y)))
  expect_equal(expected, value(canon_matrix), tolerance = TOL)

  # Test promotion.
  X <- Constant(rbind(1:3, 4:6))
  y <- Constant(2.0)
  Z <- X + y
  canon <- Dgp2Dcp.add_canon(Z, Z@args)
  canon_matrix <- canon[[1]]
  constraints <- canon[[2]]
  expect_equal(length(constraints), 0)
  expect_equal(dim(canon_matrix), dim(Z))
  expected <- log(exp(value(X)) + as.numeric(exp(value(y))))
  expect_equal(expected, value(canon_matrix), tolerance = TOL)
})

test_that("test matmul_canon", {
  skip_on_cran()
  X <- Constant(rbind(1:3, 4:6))
  Y <- Constant(matrix(1:3, nrow = 3))
  Z <- X %*% Y
  canon <- Dgp2Dcp.mulexpression_canon(Z, Z@args)
  canon_matrix <- canon[[1]]
  constraints <- canon[[2]]
  expect_equal(length(constraints), 0)
  expect_equal(dim(canon_matrix), c(2,1))
  first_entry <- log(exp(2.0) + exp(4.0) + exp(6.0))
  second_entry <- log(exp(5.0) + exp(7.0) + exp(9.0))
  expect_equal(first_entry, as.numeric(value(canon_matrix[1,1])), tolerance = TOL)
  expect_equal(second_entry, as.numeric(value(canon_matrix[2,1])), tolerance = TOL)
})

test_that("test trace_canon", {
  skip_on_cran()
  X <- Constant(rbind(c(1.0, 5.0), c(9.0, 14.0)))
  Y <- matrix_trace(X)
  canon <- Dgp2Dcp.trace_canon(Y, Y@args)
  canon_matrix <- canon[[1]]
  constraints <- canon[[2]]
  expect_equal(length(constraints), 0)
  expect_true(is_scalar(canon_matrix))
  expected <- log(exp(1.0) + exp(14.0))
  expect_equal(expected, value(canon_matrix), tolerance = TOL)
})

test_that("test one_minus_pos", {
  skip_on_cran()
  x <- Variable(pos = TRUE)
  obj <- Maximize(x)
  constr <- list(one_minus_pos(x) >= 0.4)
  problem <- Problem(obj, constr)
  result <- solve(problem, gp = TRUE)
  expect_equal(result$value, 0.6, tolerance = TOL)
  expect_equal(result$getValue(x), 0.6, tolerance = TOL)
})

test_that("test qp solver not allowed", {
  skip_on_cran()
  x <- Variable(pos = TRUE)
  problem <- Problem(Minimize(x))
  expect_error(solve(problem, solver = "OSQP", gp = TRUE))
})

# TODO: Enable test once sum_largest is implemented.
# test_that("test paper example sum_largest", {
#   x <- Variable(4, pos = TRUE)
#   x1 <- x[1]
#   x2 <- x[2]
#   x3 <- x[3]
#   x4 <- x[4]
#   obj <- Minimize(sum_largest(hstack(3*x1^(0.5) * x2^(0.5), x1*x2 + 0.5*x2*x4^3, x3), 2))
#   constr <- list(x1*x2*x3 >= 16)
#   p <- Problem(obj, constr)
#   expect_silent(solve(p, gp = TRUE))   # Smoke test.
# })

test_that("test paper example one_minus_pos", {
  skip_on_cran()
  x <- Variable(pos = TRUE)
  y <- Variable(pos = TRUE)
  obj <- Minimize(x*y)
  constr <- list((y * one_minus_pos(x/y))^2 >= 1, x >= y/3)
  problem <- Problem(obj, constr)
  expect_silent(solve(problem, gp = TRUE))   # Smoke test.
})

test_that("test paper example eye_minus_inv", {
  skip_on_cran()
  X <- Variable(2,2, pos = TRUE)
  obj <- Minimize(matrix_trace(eye_minus_inv(X)))
  constr <- list(geo_mean(diag(X)) == 0.1)
  problem <- Problem(obj, constr)
  expect_silent(solve(problem, gp = TRUE, solver = "SCS"))   # Smoke test.
})

test_that("test paper example exp_log", {
  skip_on_cran()
  x <- Variable(pos = TRUE)
  y <- Variable(pos = TRUE)
  obj <- Minimize(x*y)
  constr <- list(exp(y/x) <= log(y))
  problem <- Problem(obj, constr)
  expect_silent(solve(problem, gp = TRUE))   # Smoke test.
})

test_that("test pf matrix completion", {
  skip_on_cran()
  X <- Variable(3,3, pos = TRUE)
  obj <- Minimize(pf_eigenvalue(X))
  known_indices <- cbind(c(1,1,2,3,3), c(1,3,2,1,2))
  constr <- list(X[known_indices] == c(1.0, 1.9, 0.8, 3.2, 5.9),
                 X[1,2] * X[2,1] * X[2,3] * X[3,3] == 1.0)
  problem <- Problem(obj, constr)
  expect_silent(solve(problem, gp = TRUE))   # Smoke test.
})

test_that("test rank one nmf", {
  skip_on_cran()
  X <- Variable(3,3, pos = TRUE)
  x <- Variable(3, pos = TRUE)
  y <- Variable(3, pos = TRUE)
  xy <- hstack(x[1]*y, x[2]*y, x[3]*y)
  R <- max_elemwise(multiply(X, (xy)^(-1.0)), multiply(X^(-1.0), xy))
  objective <- sum(R)
  constraints <- list(X[1,1] == 1.0, X[1,3] == 1.9, X[2,2] == 0.8, X[3,1] == 3.2, X[3,2] == 5.9,
                      x[1] * x[2] * x[3] == 1.0)
  # Smoke test.
  prob <- Problem(Minimize(objective), constraints)
  expect_silent(solve(prob, gp = TRUE))
})

test_that("test documentation problem", {
  skip_on_cran()
  x <- Variable(pos = TRUE)
  y <- Variable(pos = TRUE)
  z <- Variable(pos = TRUE)

  objective_fn <- x*y*z
  constraints <- list(4*x*y*z + 2*x*z <= 10, x <= 2*y, y <= 2*x, z >= 1)
  problem <- Problem(Maximize(objective_fn), constraints)
  expect_silent(solve(problem, gp = TRUE))   # Smoke test.
})

test_that("test solver error", {
  skip_on_cran()
  x <- Variable(pos = TRUE)
  y <- Variable(pos = TRUE)
  prod <- x*y
  dgp <- Problem(Minimize(prod))
  dgp2dcp <- Dgp2Dcp()
  tmp <- perform(dgp2dcp, dgp)
  dgp2dcp <- tmp[[1]]
  data <- tmp[[2]]
  inverse_data <- tmp[[3]]

  soln <- Solution("solver_error", NA_real_, list(), list(), list())
  dgp_soln <- invert(dgp2dcp, soln, inverse_data)
  expect_equal(dgp_soln@status, "solver_error")
})
anqif/cvxr documentation built on Feb. 1, 2024, 5:42 p.m.