Advertisement
Guest User

Untitled

a guest
Apr 25th, 2015
190
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.45 KB | None | 0 0
  1. ipoptr_qp <- function(Dmat, dvec, Amat, bvec, ub=100){
  2. # Solve the quadratic program
  3. #
  4. # min -d^T x + 1/2 x^T D x
  5. # s.t. A%*%x>= b
  6. #
  7. # with ipoptr.
  8.  
  9. n <- length(bvec)
  10. # Jacobian structural components
  11. j_vals <- unlist(Amat[Amat!=0])
  12. j_mask <- make.sparse(ifelse(Amat!=0, 1, 0))
  13.  
  14. # Hessian structural components
  15. h_mask <- make.sparse(ifelse(upper.tri(Dmat, diag=TRUE) & Dmat!=0, 1, 0))
  16. h_vals <- do.call(c, sapply(1:length(h_mask), function(i) Dmat[i,h_mask[[i]]]))
  17.  
  18. # build the ipoptr inputs
  19. eval_f <- function(x) return(-t(dvec)%*%x + 0.5*t(x)%*%Dmat%*%x)
  20. eval_grad_f <- function(x) return(-dvec + Dmat%*%x)
  21. eval_h <- function(x, obj_factor, hessian_lambda) return(obj_factor*h_vals)
  22. eval_h_structure <- h_mask
  23. eval_g <- function(x) return(t(Amat)%*%x)
  24. eval_jac_g <- function(x) return(j_vals)
  25. eval_jac_g_structure <- j_mask
  26. constraint_lb <- bvec
  27. constraint_ub <- rep( ub, n)
  28.  
  29. # initialize with the global unconstrained minimum, as done in quadprog package
  30. # NOTE: This will only work if lb <= x0 <= ub. If this is not the case,
  31. # use x0 = lb can be used instead.
  32. x0 <- solve(Dmat, dvec)
  33.  
  34. # call the solver
  35. sol <- ipoptr(x0 = x0,
  36. eval_f = eval_f,
  37. eval_grad_f = eval_grad_f,
  38. eval_g = eval_g,
  39. eval_jac_g = eval_jac_g,
  40. eval_jac_g_structure = eval_jac_g_structure,
  41. constraint_lb = constraint_lb,
  42. constraint_ub = constraint_ub,
  43. eval_h = eval_h,
  44. eval_h_structure = eval_h_structure)
  45. return(sol)
  46. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement