Guest User

Untitled

a guest
Jan 23rd, 2018
67
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.03 KB | None | 0 0
  1. nrow=16;
  2. ncol = 24;
  3. lambda = matrix(sample.int(100, size = ncol*nrow, replace = T),nrow,ncol);
  4. lambda = lambda - diag(lambda)*diag(x=1, nrow, ncol);
  5. y = rpois(ncol,lambda) + rtruncnorm(ncol,0,1,mean = 0, sd = 1);
  6.  
  7. x = matrix (0, nrow, 1);
  8. x_A1 = y[1]+y[2]+y[3];
  9. x_A2 = y[4]+y[7]+y[3];
  10. x_B1 = y[4]+y[5]+y[6];
  11. x_B2 = y[11]+y[1];
  12. x_C1 = y[7]+y[8]+y[9];
  13. x_C2 = y[2]+y[5]+y[12];
  14. x_D1 = y[10]+y[11]+y[12];
  15. x_D2 = y[3]+y[6]+y[9];
  16. x_E1 = y[13]+y[14]+y[15];
  17. x_E2 = y[18]+y[19]+y[23];
  18. x_F1 = y[20]+y[21]+y[19];
  19. x_F2 = y[22]+y[16]+y[13];
  20. x_G1 = y[23]+y[22]+y[24];
  21. x_G2 = y[14]+y[17]+y[20];
  22. x_H1 = y[16]+y[17]+y[18];
  23. x_H2 = y[15]+y[21]+y[24];
  24.  
  25. d <- c(x_A1, x_A2,x_B1, x_B2,x_C1, x_C2,x_D1, x_D2,x_E1,
  26. x_E2,x_F1, x_F2,x_G1, x_G2,x_H1, x_H2)
  27. x <- matrix(d, nrow, byrow=TRUE)
  28.  
  29. A = matrix(c(1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, #x_A^1
  30. 0,0,0,1,0,0,1,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0, #x_A^2
  31. 0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, #x_B^1
  32. 1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0, #x_B^2
  33. 0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, #x_C^1
  34. 0,1,0,0,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0, #x_C^2
  35. 0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0, #x_D^1
  36. 0,0,1,0,0,1,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, #x_D^2
  37. 0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0, #x_E^1
  38. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,1,0, #x_E^2
  39. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0, #x_F^1
  40. 0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,0,0,0,1,0,0, #x_F^2
  41. 0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,1,0,0,0,0, #x_G^2
  42. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1, #x_G^1
  43. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0, #x_H^1
  44. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,1), #x_H^2
  45. nrow, ncol, byrow= TRUE)
  46.  
  47. eval_f <- function( yhat ) {
  48. return( list( "objective" = norm((mean(yhat-y))^2, type = "2")))
  49. }
  50.  
  51. # inequality constraint
  52. eval_g_ineq <- function( yhat ) {
  53. constr <- c(0 - yhat)
  54. return( list( "constraints"=constr ))
  55. }
  56.  
  57. # equalities constraint
  58. eval_g_eq <- function( yhat ) {
  59. constr <- c( x-A%*%yhat )
  60. return( list( "constraints"=constr ))
  61. }
  62.  
  63. x0 <- y
  64.  
  65. #lower bound of control variable
  66. lb <- c(matrix (0, ncol, 1))
  67.  
  68. local_opts <- list( "algorithm" = "NLOPT_LD_MMA",
  69. "xtol_rel" = 1.0e-7 )
  70. opts <- list( "algorithm" = "NLOPT_LD_AUGLAG",
  71. "xtol_rel" = 1.0e-7,
  72. "maxeval" = 1000,
  73. "local_opts" = local_opts )
  74. res <- nloptr( x0=x0,
  75. eval_f=eval_f,
  76. eval_grad_f = NULL,
  77. lb=lb,
  78. eval_g_ineq = eval_g_ineq,
  79. eval_g_eq=eval_g_eq,
  80. opts=opts)
  81. print(res)
  82.  
  83. **#model <- list()
  84. #model$B <- A
  85. #model$obj <- norm((y-yhat)^2, type = "2")
  86. #model$modelsense <- "min"
  87. #model$rhs <- c(x,0)
  88. #model$sense <- c('=', '>=')
  89. #model$vtype <- 'C'
  90. #result <- gurobi(model, params)
  91. #print('Solution:')
  92. #print(result$objval)
  93. #print(result$yhat)**
Add Comment
Please, Sign In to add comment