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