Nothing
#' Build (standard) DEA problem using ROI infraestructure
#'
#' For the given input and output build and solve standard DEA problem.
#'
#' Unlike the dea function, this function expects input and output to be arrays or data.frames, not vectors.
#'
#' Note: As this function is mainly for internal use, to avoid unnecessary overload, it does not do an extensive check of the input parameters. Use the higher level dea function instead.
#'
#' @name roi_solve_dea
#' @aliases roi_solve_dea
#' @keywords internal
#' @inheritParams adea
#' @param solver a solver to be used by ROI to solve the DEA optimization problem. Use <code>ROI_installed_solvers()</code> to list them.
#' @return list(lp, solver, ux, vy)
roi_solve_dea <- function(input, output, orientation = c('input', 'output'), solver = 'auto', lp)
{
## Check input and output
## err <- adea_check(input, output)
## if (err != TRUE) stop(err)
orientation <- match.arg(orientation)
## Canonize input and output format
## data <- adea_setup(input, output)
## input <- data$input
## output <- data$output
## Paranoid check
## cat("roi_solve_dea:roi_solve_dea.R:27: debug: test result", attr(lp, 'adea', exact = TRUE)$lp == 'roi_dea', '\n')
## Check for solver
if (solver != 'auto') {
ROIsolver <- paste0('ROI.plugin.', solver)
if (!(ROIsolver %in% ROI_available_solvers()[, 1])) stop(solver, ' (', ROIsolver, ')', gettext(' is not available.'))
if (!(ROIsolver %in% ROI_installed_solvers())) stop(solver, ' (', ROIsolver, ')', gettext(' is not installed.'))
} else {
## To ensure that there is at least one solver available
ROIsolver <- 'ROI.plugin.glpk'
}
require(ROIsolver, character.only = TRUE)
## Initialize values
ndmu <- nrow(input)
ni <- ncol(input)
no <- ncol(output)
nio <- ni + no
## Solve the model
## Check for solver
## if ((solver != 'auto') && !(ROIsolver %in% ROI_installed_solvers())) stop(solver, gettext(' is not installed.'))
if (length(ROI_applicable_solvers(lp)) == 0) stop(gettext('There is no an applicable solver installed to solve the DEA problem.'))
if ((solver != 'auto') && !(solver %in% ROI_applicable_solvers(lp))) stop(solver, gettext(' is not in applicable solver list for DEA problem. Applicable and available solvers are: '), ROI_applicable_solvers(lp))
## Call to solver
ROIsol <- ROI_solve(lp, solver = solver)
status <- ROI_plugin_solution_status_code(ROIsol)
solver <- attr(ROIsol, "meta")$solver
## Check return status
if (status != 0) stop(paste0(gettext('Unable to solve DEA model. Solver status is '), status, ' (', ROIsol$status$msg$message, ')'))
## Get u and v values
sol <- ROIsol$solution
sol <- matrix(sol[seq(1, ndmu * nio)], nrow = ndmu, ncol = nio, byrow = TRUE)
rownames(sol) <- rownames(input)
## Get weights for outputs, named vy for compatibility with Benchmarking package
vy <- sol[, 1:no, drop = FALSE]
colnames(vy) <- colnames(output)
rownames(vy) <- rownames(output)
## Get weights for inputs, named ux for compatibility with Benchmarking package
ux = sol[, (no+1):nio, drop = FALSE]
colnames(ux) <- colnames(input)
rownames(ux) <- rownames(input)
## Return the list values
list(solver = solver, ux = ux, vy = vy)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.