Advertisement
karstenw

lpSolve with absolute values

Aug 16th, 2016
342
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
R 2.55 KB | None | 0 0
  1.     ntypes <- length(unique(dat[,"type"])) # number of types
  2.     typemap <- setNames(seq.int(ntypes), unique(dat[,"type"])) # map typename to 1,...,ntypes
  3.  
  4.     solve_one <- function(subdat, capdat) {
  5.      
  6.       # create object
  7.       lprec <- make.lp(0, ncol=3*ntypes) # for each type, two decision variables, one for even-ness
  8.      
  9.       # By convention, we assume that the first ntypes variables are physics for type 1, ..., ntypes
  10.       # and the second ntypes variables are maths
  11.      
  12.       # add objective and type
  13.       set.objfn(lprec, obj=c(rep(100, ntypes), rep(65, ntypes), rep(1, ntypes)))
  14.      
  15.       # add capacity constraints
  16.       idx <- which(capdat[,"mon"]==subdat[1,"mon"] & capdat[,"region"]==subdat[1,"region"]) # lookup the right cap
  17.       add.constraint(lprec, rep(1, ntypes), type="<=", rhs=capdat[idx,"regutil"], indices=seq.int(ntypes))
  18.       add.constraint(lprec, rep(1, ntypes), type="<=", rhs=capdat[idx,"nonregutil"], indices=seq.int(ntypes+1, 2*ntypes))
  19.      
  20.       # add allsub equality constraints and minimum constraints
  21.       for (typ in subdat[,"type"]) {
  22.         add.constraint(lprec, c(1,1), type="=", rhs=subdat[typemap[typ], "effort_calculated"], indices=c(typemap[typ], ntypes+typemap[typ]))
  23.         add.constraint(lprec, 1, type=">=", rhs=subdat[typemap[typ],"regmin"], indices=typemap[typ])
  24.         add.constraint(lprec, 1, type=">=", rhs=subdat[typemap[typ],"nonregmin"], indices=ntypes+typemap[typ])
  25.       }
  26.      
  27.       # set last decision vars as absolute difference between nonreg and reg for each type
  28.       # see here for an explanation of the trick: http://lpsolve.sourceforge.net/5.1/absolute.htm
  29.       for (i in seq.int(ntypes)) {
  30.         add.constraint(lprec, c(1,-1,-1), type="<=", rhs=0, indices=c(i, ntypes+i, 2*ntypes+i))
  31.         add.constraint(lprec, c(-1,1,-1), type="<=", rhs=0, indices=c(i, ntypes+i, 2*ntypes+i))
  32.       }
  33.      
  34.       # solution data.frame
  35.       ans <- subdat[, c("mon", "region", "type")]
  36.      
  37.       # solve      
  38.       if(solve(lprec)==0) {
  39.         sol <- get.variables(lprec)
  40.         for (i in seq.int(nrow(subdat))) {
  41.           ans[i, "regval"] <- sol[typemap[subdat[i,"type"]]]
  42.           ans[i, "nonregval"] <- sol[typemap[subdat[i,"type"]]+ntypes]
  43.         }
  44.       } else ans[,c("regval", "nonregval")] <- NA # no solution found
  45.      
  46.       return(ans)
  47.     }
  48.  
  49.     sp <- split(dat, list(dat[,"mon"], dat[,"region"]))
  50.     # browser()x
  51.     results <- lapply(sp, solve_one, capdat=capdat)
  52.     results <- do.call(rbind, results)
  53.     rownames(results) <- NULL
  54.     results
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement