Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ntypes <- length(unique(dat[,"type"])) # number of types
- typemap <- setNames(seq.int(ntypes), unique(dat[,"type"])) # map typename to 1,...,ntypes
- solve_one <- function(subdat, capdat) {
- # create object
- lprec <- make.lp(0, ncol=3*ntypes) # for each type, two decision variables, one for even-ness
- # By convention, we assume that the first ntypes variables are physics for type 1, ..., ntypes
- # and the second ntypes variables are maths
- # add objective and type
- set.objfn(lprec, obj=c(rep(100, ntypes), rep(65, ntypes), rep(1, ntypes)))
- # add capacity constraints
- idx <- which(capdat[,"mon"]==subdat[1,"mon"] & capdat[,"region"]==subdat[1,"region"]) # lookup the right cap
- add.constraint(lprec, rep(1, ntypes), type="<=", rhs=capdat[idx,"regutil"], indices=seq.int(ntypes))
- add.constraint(lprec, rep(1, ntypes), type="<=", rhs=capdat[idx,"nonregutil"], indices=seq.int(ntypes+1, 2*ntypes))
- # add allsub equality constraints and minimum constraints
- for (typ in subdat[,"type"]) {
- add.constraint(lprec, c(1,1), type="=", rhs=subdat[typemap[typ], "effort_calculated"], indices=c(typemap[typ], ntypes+typemap[typ]))
- add.constraint(lprec, 1, type=">=", rhs=subdat[typemap[typ],"regmin"], indices=typemap[typ])
- add.constraint(lprec, 1, type=">=", rhs=subdat[typemap[typ],"nonregmin"], indices=ntypes+typemap[typ])
- }
- # set last decision vars as absolute difference between nonreg and reg for each type
- # see here for an explanation of the trick: http://lpsolve.sourceforge.net/5.1/absolute.htm
- for (i in seq.int(ntypes)) {
- add.constraint(lprec, c(1,-1,-1), type="<=", rhs=0, indices=c(i, ntypes+i, 2*ntypes+i))
- add.constraint(lprec, c(-1,1,-1), type="<=", rhs=0, indices=c(i, ntypes+i, 2*ntypes+i))
- }
- # solution data.frame
- ans <- subdat[, c("mon", "region", "type")]
- # solve
- if(solve(lprec)==0) {
- sol <- get.variables(lprec)
- for (i in seq.int(nrow(subdat))) {
- ans[i, "regval"] <- sol[typemap[subdat[i,"type"]]]
- ans[i, "nonregval"] <- sol[typemap[subdat[i,"type"]]+ntypes]
- }
- } else ans[,c("regval", "nonregval")] <- NA # no solution found
- return(ans)
- }
- sp <- split(dat, list(dat[,"mon"], dat[,"region"]))
- # browser()x
- results <- lapply(sp, solve_one, capdat=capdat)
- results <- do.call(rbind, results)
- rownames(results) <- NULL
- results
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement