public code v1
This commit is contained in:
Francisco Jesús Martínez Mimbrera
@@ -0,0 +1,7 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<classpath>
|
||||
<classpathentry kind="con" path="org.eclipse.jdt.launching.JRE_CONTAINER/org.eclipse.jdt.internal.debug.ui.launcher.StandardVMType/JavaSE-1.8"/>
|
||||
<classpathentry kind="con" path="org.eclipse.pde.core.requiredPlugins"/>
|
||||
<classpathentry kind="src" path="src"/>
|
||||
<classpathentry kind="output" path="bin"/>
|
||||
</classpath>
|
||||
@@ -0,0 +1,14 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<project xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 https://maven.apache.org/xsd/maven-4.0.0.xsd" xmlns="http://maven.apache.org/POM/4.0.0"
|
||||
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
|
||||
<modelVersion>4.0.0</modelVersion>
|
||||
<parent>
|
||||
<groupId>flintstones.group</groupId>
|
||||
<artifactId>flintstones.bundles</artifactId>
|
||||
<version>1.0.0-SNAPSHOT</version>
|
||||
</parent>
|
||||
<artifactId>flintstones.method.common.phase.collectweights.bestworst</artifactId>
|
||||
<version>1.0.0-SNAPSHOT</version>
|
||||
<packaging>eclipse-plugin</packaging>
|
||||
<name>[bundle] Bestworst</name>
|
||||
</project>
|
||||
@@ -0,0 +1,45 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<projectDescription>
|
||||
<name>flintstones.method.common.phase.collectweights.bestworst</name>
|
||||
<comment></comment>
|
||||
<projects>
|
||||
</projects>
|
||||
<buildSpec>
|
||||
<buildCommand>
|
||||
<name>org.eclipse.jdt.core.javabuilder</name>
|
||||
<arguments>
|
||||
</arguments>
|
||||
</buildCommand>
|
||||
<buildCommand>
|
||||
<name>org.eclipse.pde.ManifestBuilder</name>
|
||||
<arguments>
|
||||
</arguments>
|
||||
</buildCommand>
|
||||
<buildCommand>
|
||||
<name>org.eclipse.pde.SchemaBuilder</name>
|
||||
<arguments>
|
||||
</arguments>
|
||||
</buildCommand>
|
||||
<buildCommand>
|
||||
<name>org.eclipse.m2e.core.maven2Builder</name>
|
||||
<arguments>
|
||||
</arguments>
|
||||
</buildCommand>
|
||||
</buildSpec>
|
||||
<natures>
|
||||
<nature>org.eclipse.m2e.core.maven2Nature</nature>
|
||||
<nature>org.eclipse.pde.PluginNature</nature>
|
||||
<nature>org.eclipse.jdt.core.javanature</nature>
|
||||
</natures>
|
||||
<filteredResources>
|
||||
<filter>
|
||||
<id>1779484362643</id>
|
||||
<name></name>
|
||||
<type>30</type>
|
||||
<matcher>
|
||||
<id>org.eclipse.core.resources.regexFilterMatcher</id>
|
||||
<arguments>node_modules|\.git|__CREATED_BY_JAVA_LANGUAGE_SERVER__</arguments>
|
||||
</matcher>
|
||||
</filter>
|
||||
</filteredResources>
|
||||
</projectDescription>
|
||||
+2
@@ -0,0 +1,2 @@
|
||||
eclipse.preferences.version=1
|
||||
encoding/<project>=UTF-8
|
||||
+7
@@ -0,0 +1,7 @@
|
||||
eclipse.preferences.version=1
|
||||
org.eclipse.jdt.core.compiler.codegen.inlineJsrBytecode=enabled
|
||||
org.eclipse.jdt.core.compiler.codegen.targetPlatform=1.8
|
||||
org.eclipse.jdt.core.compiler.compliance=1.8
|
||||
org.eclipse.jdt.core.compiler.problem.assertIdentifier=error
|
||||
org.eclipse.jdt.core.compiler.problem.enumIdentifier=error
|
||||
org.eclipse.jdt.core.compiler.source=1.8
|
||||
+4
@@ -0,0 +1,4 @@
|
||||
activeProfiles=
|
||||
eclipse.preferences.version=1
|
||||
resolveWorkspaceProjects=true
|
||||
version=1
|
||||
@@ -0,0 +1,18 @@
|
||||
Manifest-Version: 1.0
|
||||
Bundle-ManifestVersion: 2
|
||||
Bundle-Name: Bestworst
|
||||
Bundle-SymbolicName: flintstones.method.common.phase.collectweights.bestworst;singleton:=true
|
||||
Bundle-Version: 1.0.0.qualifier
|
||||
Automatic-Module-Name: flintstones.method.common.phase.collectweights.bestworst
|
||||
Bundle-RequiredExecutionEnvironment: JavaSE-1.8
|
||||
Require-Bundle: flintstones.entity.method.phase,
|
||||
flintstones.method.common.phase.collectweights,
|
||||
flintstones.model.problemelement.service,
|
||||
flintstones.entity.problemelement,
|
||||
flintstones.engine.R,
|
||||
javax.inject,
|
||||
org.eclipse.osgi,
|
||||
org.eclipse.equinox.common,
|
||||
org.eclipse.core.runtime,
|
||||
flintstones.helper.data
|
||||
Export-Package: flintstones.method.common.phase.collectweights.bestworst
|
||||
@@ -0,0 +1,5 @@
|
||||
source.. = src/
|
||||
output.. = bin/
|
||||
bin.includes = META-INF/,\
|
||||
.,\
|
||||
plugin.xml
|
||||
@@ -0,0 +1,18 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<?eclipse version="3.4"?>
|
||||
<plugin>
|
||||
<extension
|
||||
point="flintstones.phasemethod.extensionpoint">
|
||||
<phase
|
||||
uid="flintstones.method.common.phase.collectweights.bestworst"
|
||||
implementation="flintstones.method.common.phase.collectweights.bestworst.BestWorstModel">
|
||||
</phase>
|
||||
</extension>
|
||||
<extension
|
||||
point="flintstones.method.phase.collectWeights">
|
||||
<phase
|
||||
uid="flintstones.method.common.phase.collectweights.bestworst">
|
||||
</phase>
|
||||
</extension>
|
||||
|
||||
</plugin>
|
||||
@@ -0,0 +1,7 @@
|
||||
assert <- function(expression, message)
|
||||
{
|
||||
if(!all(expression))
|
||||
{
|
||||
stop(if(is.null(message)) "Error" else message)
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,181 @@
|
||||
validateData <- function(bestToOthers, othersToWorst, criteriaNames){
|
||||
assert(length(bestToOthers) > 1, "Length of the best-to-others or others-to-worst vector should have at least 2 elements.")
|
||||
assert(length(bestToOthers) == length(othersToWorst), "Lengths of best-to-others and others-to-worst vectors must be the same.")
|
||||
assert(length(bestToOthers) == length(criteriaNames), "Lengths of best-to-others and criteriaNames must be the same.")
|
||||
assert(1 %in% bestToOthers, "best-to-others vector should contain number 1.")
|
||||
assert(1 %in% othersToWorst, "others-to-worst vector should contain number 1.")
|
||||
assert(all(bestToOthers >= 1) && all(bestToOthers <= 9), "Numbers in best-to-others vector should be in range <1, 9>.")
|
||||
assert(all(othersToWorst >= 1) && all(othersToWorst <= 9), "Numbers in others-to-worst vector should be in range <1, 9>.")
|
||||
bestToOthersOneIndex <- match(1, bestToOthers)
|
||||
othersToWorstOneIndex <- match(1, othersToWorst)
|
||||
assert(!is.na(bestToOthersOneIndex) && !is.na(othersToWorstOneIndex), "best-to-others and others-to-worst vectors must contain number `1`.")
|
||||
list(bestToOthers = bestToOthers, othersToWorst = othersToWorst, criteriaNames = criteriaNames)
|
||||
}
|
||||
|
||||
isConsistent <- function(model){
|
||||
worstCriterionIndex <- match(1, model$othersToWorst)
|
||||
bestOverWorstPreferenceValue <- model$bestToOthers[worstCriterionIndex]
|
||||
|
||||
# a_bj x a_jw = a_bw for all j
|
||||
list(isConsistent = all(model$bestToOthers*model$othersToWorst == bestOverWorstPreferenceValue), a_bw = bestOverWorstPreferenceValue)
|
||||
}
|
||||
# tries to combine constraint, if constraint already belongs to the constraints set then
|
||||
# it resturns constraints and a flag that indicates that constraints' state hasn't been changed
|
||||
combineConstraints <- function(constraints, constraint){
|
||||
assert(!is.null(constraint$lhs), "Constraint should contain lhs vector")
|
||||
assert(!is.null(constraint$rhs), "Constraint should contain rhs vector")
|
||||
assert(!is.null(constraint$dir), "Constraint should contain direction sign")
|
||||
assert(constraint$dir %in% c("<=", "==", ">="), "Constraint should be one of the following `<=, ==, >=`")
|
||||
index <- length(constraints)+1
|
||||
#return when such constraint is already in constraints list
|
||||
for(x in constraints){
|
||||
if( length(setdiff(x, constraint)) == 0 ){
|
||||
return(list(constraints = constraints, added = FALSE))
|
||||
}
|
||||
}
|
||||
|
||||
constraints[[index]] <- constraint
|
||||
list(constraints = constraints, added = TRUE)
|
||||
}
|
||||
|
||||
# complementary constraint that should be added in case of abs
|
||||
absConstraint <- function(constraint){
|
||||
lhs <- constraint$lhs
|
||||
lhs[length(lhs)] <- lhs[length(lhs)] * -1
|
||||
abs <- list(lhs = lhs,
|
||||
dir = ifelse(constraint$dir == "<=", ">=", ifelse(constraint$dir == ">=", "<=", "==")),
|
||||
rhs = constraint$rhs * (-1))
|
||||
}
|
||||
|
||||
# creates constraints, for each j, for w_b - a_bj*w_j or for w_j-a_jw*w_w
|
||||
# first equation referes to the best-to-others vector, the second one to the others-to-worst vector
|
||||
createBaseModelConstraints <- function(model, constraints, vectorType, dir, rhs = 0, ksiIndexValue = 0){
|
||||
assert(vectorType %in% c("best", "worst"), "vectorType should be either 'best' or 'worst'.")
|
||||
vector <- if(vectorType == "best") model$bestToOthers else model$othersToWorst
|
||||
|
||||
# weight that has a number 1 on its index in the vector
|
||||
# should be ommited
|
||||
weightWithOneIndex <- match(1, vector)
|
||||
|
||||
# number of added constraints is
|
||||
# useful for creating constraints opposite to these ones
|
||||
numberOfAddedConstraints <-0
|
||||
|
||||
for(j in seq(length(vector))){
|
||||
if(j != weightWithOneIndex){
|
||||
lhs <- rep(0, length(vector) + 1)
|
||||
|
||||
if(vectorType == "best"){
|
||||
# add w_b - a_bj*w_j = 0
|
||||
lhs[weightWithOneIndex] <- 1
|
||||
lhs[j] <- -vector[j]
|
||||
} else {
|
||||
# add w_j - a_jw*w_w = 0
|
||||
lhs[weightWithOneIndex] <- -vector[j]
|
||||
lhs[j] <- 1
|
||||
}
|
||||
|
||||
|
||||
lhs[model$ksiIndex] <- ksiIndexValue
|
||||
result <- combineConstraints(constraints, list(lhs = lhs, dir = dir, rhs = rhs))
|
||||
if(result$added){
|
||||
constraints <- result$constraints
|
||||
numberOfAddedConstraints <- numberOfAddedConstraints + 1
|
||||
}
|
||||
}
|
||||
}
|
||||
list(constraints = constraints, numberOfAddedConstraints = numberOfAddedConstraints)
|
||||
}
|
||||
|
||||
#constraints for weights' sum and their minimal value (w >= 0)
|
||||
buildBasicConstraints <- function(model){
|
||||
# n variables for weights, 1 for ksi index
|
||||
numberOfVariables <- length(model$bestToOthers) + 1
|
||||
|
||||
lhs <- rep(0, numberOfVariables)
|
||||
# sum up all weights to 1
|
||||
lhs[1:length(lhs)-1] <- 1
|
||||
dir <- "=="
|
||||
rhs <- 1
|
||||
|
||||
constraints <- list()
|
||||
constraints <- combineConstraints(constraints, list(lhs = lhs, dir = dir, rhs = rhs))$constraints
|
||||
# all weights must be >= 0
|
||||
for(j in seq(length(model$bestToOthers))){
|
||||
lhs <- rep(0, numberOfVariables)
|
||||
lhs[j] <- 1
|
||||
constraints <- combineConstraints(constraints, list(lhs = lhs, direction = ">=", rhs = 0))$constraints
|
||||
}
|
||||
constraints
|
||||
}
|
||||
|
||||
addConstraintsFromResult <- function(constraints, result){
|
||||
if(result$numberOfAddedConstraints > 0){
|
||||
constraints <- result$constraints
|
||||
# add constraints that stem from removing abs
|
||||
# take only result$numberOfAddedConstraints constraints that has just been added (there may have been some duplicates)
|
||||
# and multiply them by -1
|
||||
constraintsToScale <- tail(constraints, n=result$numberOfAddedConstraints)
|
||||
lapply(constraintsToScale, function(x){
|
||||
constraints <<- combineConstraints(constraints, absConstraint(x))$constraints # '<<-' refers to outer scope
|
||||
})
|
||||
}
|
||||
constraints
|
||||
}
|
||||
|
||||
constraintsListToMatrix <- function(constraints){
|
||||
result <- list()
|
||||
#format constraints
|
||||
result$lhs <- t(sapply(constraints, function(x){
|
||||
x$lhs
|
||||
}))
|
||||
result$dir <- sapply(constraints, function(x){
|
||||
x$dir
|
||||
})
|
||||
result$rhs <- unlist(sapply(constraints, function(x){
|
||||
x$rhs
|
||||
}))
|
||||
result
|
||||
}
|
||||
|
||||
createModelsObjective <- function(model, objectiveIndex, objectiveValue = 1){
|
||||
objective <- rep(0, length(model$bestToOthers) + 1)
|
||||
objective[objectiveIndex] <- objectiveValue
|
||||
objective
|
||||
}
|
||||
|
||||
buildModel <- function(bestToOthers, othersToWorst, criteriaNames){
|
||||
model <- validateData(bestToOthers, othersToWorst, criteriaNames)
|
||||
consistency <- isConsistent(model)
|
||||
model$isConsistent <- consistency$isConsistent
|
||||
model$a_bw <- consistency$a_bw
|
||||
|
||||
#weights' sum and weights' limit value (w >= 0)
|
||||
constraints <- buildBasicConstraints(model)
|
||||
|
||||
# ksi index
|
||||
model$ksiIndex <- length(model$bestToOthers)+1
|
||||
|
||||
if(model$isConsistent){
|
||||
#add best-to-others constraints
|
||||
result <- createBaseModelConstraints(model, constraints, vectorType = "best", dir = "==")
|
||||
if(result$numberOfAddedConstraints > 0){
|
||||
constraints <- result$constraints
|
||||
}
|
||||
} else {
|
||||
#add best-to-others constraints
|
||||
result <- createBaseModelConstraints(model, constraints, vectorType = "best", dir = "<=", ksiIndexValue = -1)
|
||||
constraints <- addConstraintsFromResult(constraints, result)
|
||||
|
||||
#add others-to-worst constraints
|
||||
result <- createBaseModelConstraints(model, constraints, vectorType = "worst", dir = "<=", ksiIndexValue = -1)
|
||||
constraints <- addConstraintsFromResult(constraints, result)
|
||||
}
|
||||
|
||||
model$constraints = constraintsListToMatrix(constraints)
|
||||
model$objective <- createModelsObjective(model, model$ksiIndex)
|
||||
#minimize objective's value by default
|
||||
model$maximize <- FALSE
|
||||
|
||||
model
|
||||
}
|
||||
@@ -0,0 +1,38 @@
|
||||
#' calculateWeights
|
||||
#'
|
||||
#' Implementation based on https://doi.org/10.1016/j.omega.2015.12.001.
|
||||
#' Calculates weights of the criteria using a linear model.
|
||||
#' Steps:
|
||||
#' 1. Build model (consists of validating model and constructing necessary constraints for LP problem).
|
||||
#' 2. Solve LP problem.
|
||||
#' 3. Calculate consistency ratio.
|
||||
#'
|
||||
#' @name calculateWeights
|
||||
#' @param criteriaNames Names of the criteria
|
||||
#' @param bestToOthers Vector of pairwise comparisons. Best criterion should be 1, others <2, 9>.
|
||||
#' @param othersToWorst Vector of pairwise comparisons. Worst criterion should be 1, others <2, 9>.
|
||||
#' @return Result that consist of \code{criteriaNames}, \code{criteriaWeights}, \code{consistencyRatio} and a model that was used to calculate weights.
|
||||
#' @examples
|
||||
#' criteriaNames <- c("quality", "price", "comfort", "safety", "style")
|
||||
#' bestToOthers <- c(2, 1, 4, 2, 8)
|
||||
#' othersToWorst <- c(4, 8, 2, 4, 1)
|
||||
#' calculateWeights(criteriaNames, bestToOthers, othersToWorst)
|
||||
#' @import Rglpk
|
||||
#' @export
|
||||
calculateWeights <- function(criteriaNames, bestToOthers, othersToWorst){
|
||||
model <- buildModel(bestToOthers, othersToWorst, criteriaNames)
|
||||
#const values that are listed in the article
|
||||
consistencyIndex <- c(0, .44, 1.0, 1.63, 2.3, 3., 3.73, 4.47, 5.23)
|
||||
|
||||
#unique optimal solution
|
||||
result <- solveLP(model)
|
||||
weights <- result$solution[1:model$ksiIndex-1]
|
||||
consistencyRatio <- result$solution[model$ksiIndex] / consistencyIndex[as.integer(model$a_bw)]
|
||||
|
||||
result <- list(criteriaNames = criteriaNames, criteriaWeights = weights, consistencyRatio = consistencyRatio)
|
||||
list(result = result, model = model)
|
||||
}
|
||||
|
||||
solveLP <- function(model){
|
||||
Rglpk_solve_LP(model$objective, model$constraints$lhs, model$constraints$dir, model$constraints$rhs, max = model$maximize)
|
||||
}
|
||||
+170
@@ -0,0 +1,170 @@
|
||||
package flintstones.method.common.phase.collectweights.bestworst;
|
||||
|
||||
import java.util.ArrayList;
|
||||
import java.util.Arrays;
|
||||
import java.util.HashMap;
|
||||
|
||||
import javax.inject.Inject;
|
||||
|
||||
import org.rosuda.JRI.REXP;
|
||||
import org.rosuda.JRI.Rengine;
|
||||
|
||||
import flintstones.entity.method.phase.PhaseMethod;
|
||||
import flintstones.entity.problemelement.entities.Criterion;
|
||||
import flintstones.entity.problemelement.entities.Expert;
|
||||
import flintstones.entity.problemelement.entities.ProblemElement;
|
||||
import flintstones.helper.data.Pair;
|
||||
import flintstones.method.common.phase.collectweights.bestworst.code.RFunctions;
|
||||
import flintstones.method.common.phase.collectweights.bestworst.exception.ExecutionException;
|
||||
import flintstones.model.problemelement.service.IProblemElementService;
|
||||
|
||||
public class BestWorstModel extends PhaseMethod {
|
||||
|
||||
Rengine rengine;
|
||||
|
||||
@Inject
|
||||
IProblemElementService problemService;
|
||||
|
||||
HashMap<String, ProblemElement> criterionMap = new HashMap<>();
|
||||
HashMap<Pair<ProblemElement, ProblemElement>, String> bestMap = new HashMap<>();
|
||||
HashMap<Pair<ProblemElement, ProblemElement>, String> worstMap = new HashMap<>();
|
||||
HashMap<ProblemElement, Double[]> criteriaWeights = new HashMap<>();
|
||||
HashMap<ProblemElement, Double> consistencyRatios = new HashMap<>();
|
||||
|
||||
@Override
|
||||
public String getName() {
|
||||
return "Best Worst";
|
||||
}
|
||||
|
||||
@Override
|
||||
public boolean canBeExecuted() {
|
||||
return true;
|
||||
}
|
||||
|
||||
public void execute() {
|
||||
if(rengine == null)
|
||||
rengine = new Rengine(new String[] { "--no-save" }, false, null);
|
||||
|
||||
evaluateFunctions();
|
||||
|
||||
//load library
|
||||
rengine.eval("library(Rglpk)");
|
||||
rengine.eval("criteriaNames <- " + formatCriteriaNames());
|
||||
|
||||
for(ProblemElement exp: this.getExperts()) {
|
||||
evalBestWorstVectors(exp);
|
||||
evalResult();
|
||||
computeCriteriaWeights(exp);
|
||||
computeConsistencyRatio(exp);
|
||||
}
|
||||
|
||||
rengine.end();
|
||||
rengine.rniStop(0);
|
||||
}
|
||||
|
||||
private void evalResult() {
|
||||
REXP result = rengine.eval("solution <- try(calculateWeights(criteriaNames, bestToOthers, worstToOthers))");
|
||||
REXP rengineSolution = rengine.eval("class(solution)");
|
||||
if ((rengineSolution.asString()).equals("try-error"))
|
||||
new ExecutionException(result.asString()).getMessage();
|
||||
}
|
||||
|
||||
private String formatCriteriaNames() {
|
||||
StringBuilder sb = new StringBuilder("c(");
|
||||
|
||||
String[] criteriaNames = getCriteriaNames();
|
||||
for(String name: criteriaNames)
|
||||
sb.append("'" + name + "'" + ",");
|
||||
|
||||
sb.deleteCharAt(sb.length() - 1);
|
||||
sb.append(")");
|
||||
|
||||
return sb.toString();
|
||||
}
|
||||
|
||||
private void evalBestWorstVectors(ProblemElement exp) {
|
||||
StringBuilder sbBest = new StringBuilder("bestToOthers <- c(");
|
||||
StringBuilder sbWorst = new StringBuilder("worstToOthers <- c(");
|
||||
|
||||
for(ProblemElement crit: getCriteria()) {
|
||||
sbBest.append(bestMap.get(new Pair<ProblemElement, ProblemElement>(exp, crit))).append(",");
|
||||
sbWorst.append(worstMap.get(new Pair<ProblemElement, ProblemElement>(exp, crit))).append(",");
|
||||
}
|
||||
|
||||
sbBest.deleteCharAt(sbBest.length() - 1).append(")");
|
||||
sbWorst.deleteCharAt(sbWorst.length() - 1).append(")");
|
||||
|
||||
rengine.eval(sbBest.toString());
|
||||
rengine.eval(sbWorst.toString());
|
||||
}
|
||||
|
||||
private void computeCriteriaWeights(ProblemElement expert) {
|
||||
String weights = rengine.eval("print(solution$result$criteriaWeights)").toString();
|
||||
weights = weights.substring(weights.indexOf("(") + 1, weights.length() - 2);
|
||||
String[] splitWeights = weights.split(",");
|
||||
|
||||
ArrayList<Double> criteriaWeights = new ArrayList<>();
|
||||
for(String weight: splitWeights)
|
||||
criteriaWeights.add(Double.parseDouble(weight));
|
||||
|
||||
this.criteriaWeights.put(expert, criteriaWeights.toArray(new Double[criteriaWeights.size()]));
|
||||
}
|
||||
|
||||
private void computeConsistencyRatio(ProblemElement exp) {
|
||||
Double consistency_ratio = rengine.eval("print(solution$result$consistencyRatio)").asDouble();
|
||||
consistencyRatios.put(exp, consistency_ratio);
|
||||
}
|
||||
|
||||
public String[] getCriteriaNames() {
|
||||
ProblemElement[] criteria = problemService.getAll(Criterion.Type);
|
||||
Arrays.stream(criteria).forEach(k -> criterionMap.put(k.getName(),k));
|
||||
String[] arr = criterionMap.keySet().toArray(new String[0]);
|
||||
Arrays.sort(arr);
|
||||
return arr;
|
||||
}
|
||||
|
||||
public ProblemElement[] getCriteria() {
|
||||
return problemService.getAll(Criterion.Type);
|
||||
}
|
||||
|
||||
public ProblemElement[] getExperts() {
|
||||
return problemService.getAll(Expert.Type);
|
||||
}
|
||||
|
||||
public void setBestComparison(ProblemElement expert, ProblemElement criterion, String assessment) {
|
||||
bestMap.put(new Pair<ProblemElement, ProblemElement>(expert, criterion), assessment);
|
||||
}
|
||||
|
||||
public String getBerstComparison(ProblemElement expert, ProblemElement criterion) {
|
||||
return bestMap.get(new Pair<ProblemElement, ProblemElement>(expert, criterion));
|
||||
}
|
||||
|
||||
public void setWorstComparison(ProblemElement expert, ProblemElement criterion, String assessment) {
|
||||
worstMap.put(new Pair<ProblemElement, ProblemElement>(expert, criterion), assessment);
|
||||
}
|
||||
|
||||
public String getWorstComparison(ProblemElement expert, ProblemElement criterion) {
|
||||
return worstMap.get(new Pair<ProblemElement, ProblemElement>(expert, criterion));
|
||||
}
|
||||
|
||||
public Double getConsistencyRation(ProblemElement expert) {
|
||||
return consistencyRatios.get(expert);
|
||||
}
|
||||
|
||||
private void evaluateFunctions() {
|
||||
|
||||
rengine.eval(RFunctions.VALIDATE_DATA);
|
||||
rengine.eval(RFunctions.IS_CONSISTENT);
|
||||
rengine.eval(RFunctions.COMBINE_CONSTRAINTS);
|
||||
rengine.eval(RFunctions.ABS_CONSTRAINT);
|
||||
rengine.eval(RFunctions.CREATE_BASE_MODEL_CONSTRAINTS);
|
||||
rengine.eval(RFunctions.BUILD_BASIC_CONSTRAINTS);
|
||||
rengine.eval(RFunctions.ADD_CONSTRAINTS_FROM_RESULT);
|
||||
rengine.eval(RFunctions.CONSTRAINTS_LIST_TO_MATRIX);
|
||||
rengine.eval(RFunctions.CREATE_MODELS_OBJECTIVE);
|
||||
rengine.eval(RFunctions.BUILD_MODEL);
|
||||
|
||||
rengine.eval(RFunctions.CALCULATE_WEIGHTS);
|
||||
rengine.eval(RFunctions.SOLVE_LP);
|
||||
}
|
||||
}
|
||||
+164
@@ -0,0 +1,164 @@
|
||||
package flintstones.method.common.phase.collectweights.bestworst.code;
|
||||
|
||||
public class RFunctions {
|
||||
|
||||
public static final String VALIDATE_DATA = "validateData <- function(bestToOthers, othersToWorst, criteriaNames){\n" +
|
||||
"bestToOthersOneIndex <- match(1, bestToOthers)\n" +
|
||||
"othersToWorstOneIndex <- match(1, othersToWorst)\n" +
|
||||
"list(bestToOthers = bestToOthers, othersToWorst = othersToWorst, criteriaNames = criteriaNames)\n" +
|
||||
"}";
|
||||
|
||||
public static final String IS_CONSISTENT = "isConsistent <- function(model){\n" +
|
||||
"worstCriterionIndex <- match(1, model$othersToWorst)\n" +
|
||||
"bestOverWorstPreferenceValue <- model$bestToOthers[worstCriterionIndex]\n" +
|
||||
"\n" +
|
||||
"list(isConsistent = all(model$bestToOthers*model$othersToWorst == bestOverWorstPreferenceValue), a_bw = bestOverWorstPreferenceValue)\n" +
|
||||
"}";
|
||||
|
||||
public static final String COMBINE_CONSTRAINTS = "combineConstraints <- function(constraints, constraint){\n" +
|
||||
"index <- length(constraints)+1\n" +
|
||||
"for(x in constraints){\n" +
|
||||
"if(length(setdiff(x, constraint)) == 0 ){\n" +
|
||||
"return(list(constraints = constraints, added = FALSE))\n" +
|
||||
"}\n" +
|
||||
"}\n" +
|
||||
"\n" +
|
||||
"constraints[[index]] <- constraint\n" +
|
||||
"list(constraints = constraints, added = TRUE)\n" +
|
||||
"}";
|
||||
|
||||
public static final String ABS_CONSTRAINT = "absConstraint <- function(constraint){\n" +
|
||||
"lhs <- constraint$lhs\n" +
|
||||
"lhs[length(lhs)] <- lhs[length(lhs)] * -1\n" +
|
||||
"abs <- list(lhs = lhs,\n" +
|
||||
"dir = ifelse(constraint$dir == \"<=\", \">=\", ifelse(constraint$dir == \">=\", \"<=\", \"==\")),\n" +
|
||||
" rhs = constraint$rhs * (-1))\n" +
|
||||
"}";
|
||||
|
||||
public static final String CREATE_BASE_MODEL_CONSTRAINTS = "createBaseModelConstraints <- function(model, constraints, vectorType, dir, rhs = 0, ksiIndexValue = 0){\n" +
|
||||
"vector <- if(vectorType == \"best\") model$bestToOthers else model$othersToWorst\n" +
|
||||
"\n" +
|
||||
"weightWithOneIndex <- match(1, vector)\n" +
|
||||
"\n" +
|
||||
"numberOfAddedConstraints <-0\n" +
|
||||
"\n" +
|
||||
"for(j in seq(length(vector))){\n" +
|
||||
"if(j != weightWithOneIndex){\n" +
|
||||
"lhs <- rep(0, length(vector) + 1)\n" +
|
||||
"\n" +
|
||||
"if(vectorType == \"best\"){\n" +
|
||||
"lhs[weightWithOneIndex] <- 1\n" +
|
||||
"lhs[j] <- -vector[j]\n" +
|
||||
"} else {\n" +
|
||||
"lhs[weightWithOneIndex] <- -vector[j]\n" +
|
||||
"lhs[j] <- 1\n" +
|
||||
"}\n" +
|
||||
"\n" +
|
||||
"\n" +
|
||||
"lhs[model$ksiIndex] <- ksiIndexValue\n" +
|
||||
"result <- combineConstraints(constraints, list(lhs = lhs, dir = dir, rhs = rhs))\n" +
|
||||
"if(result$added){\n" +
|
||||
"constraints <- result$constraints\n" +
|
||||
"numberOfAddedConstraints <- numberOfAddedConstraints + 1\n" +
|
||||
"}\n" +
|
||||
"}\n" +
|
||||
"}\n" +
|
||||
"list(constraints = constraints, numberOfAddedConstraints = numberOfAddedConstraints)\n" +
|
||||
"}\n";
|
||||
|
||||
public static final String BUILD_BASIC_CONSTRAINTS = "buildBasicConstraints <- function(model){\n" +
|
||||
"numberOfVariables <- length(model$bestToOthers) + 1\n" +
|
||||
"\n" +
|
||||
"lhs <- rep(0, numberOfVariables)\n" +
|
||||
"lhs[1:length(lhs)-1] <- 1\n" +
|
||||
"dir <- \"==\"\n" +
|
||||
"rhs <- 1\n" +
|
||||
"\n" +
|
||||
"constraints <- list()\n" +
|
||||
"constraints <- combineConstraints(constraints, list(lhs = lhs, dir = dir, rhs = rhs))$constraints\n" +
|
||||
"for(j in seq(length(model$bestToOthers))){\n" +
|
||||
"lhs <- rep(0, numberOfVariables)\n" +
|
||||
"lhs[j] <- 1\n" +
|
||||
"constraints <- combineConstraints(constraints, list(lhs = lhs, direction = \">=\", rhs = 0))$constraints\n" +
|
||||
"}\n" +
|
||||
"constraints\n" +
|
||||
"}";
|
||||
|
||||
public static final String ADD_CONSTRAINTS_FROM_RESULT = "addConstraintsFromResult <- function(constraints, result){\n" +
|
||||
"if(result$numberOfAddedConstraints > 0){\n" +
|
||||
"constraints <- result$constraints\n" +
|
||||
"constraintsToScale <- tail(constraints, n=result$numberOfAddedConstraints)\n" +
|
||||
"lapply(constraintsToScale, function(x){\n" +
|
||||
"constraints <<- combineConstraints(constraints, absConstraint(x))$constraints # '<<-' refers to outer scope\n" +
|
||||
"})\n" +
|
||||
"}\n" +
|
||||
"constraints\n" +
|
||||
"}";
|
||||
|
||||
public static final String CONSTRAINTS_LIST_TO_MATRIX = "constraintsListToMatrix <- function(constraints){\n" +
|
||||
"result <- list()\n" +
|
||||
"result$lhs <- t(sapply(constraints, function(x){\n" +
|
||||
"x$lhs\n" +
|
||||
"}))\n" +
|
||||
"result$dir <- sapply(constraints, function(x){\n" +
|
||||
"x$dir\n" +
|
||||
"})\n" +
|
||||
"result$rhs <- unlist(sapply(constraints, function(x){\n" +
|
||||
"x$rhs\n" +
|
||||
"}))\n" +
|
||||
"result\n" +
|
||||
"}";
|
||||
|
||||
public static final String CREATE_MODELS_OBJECTIVE = "createModelsObjective <- function(model, objectiveIndex, objectiveValue = 1){\n" +
|
||||
"objective <- rep(0, length(model$bestToOthers) + 1)\n" +
|
||||
"objective[objectiveIndex] <- objectiveValue\n" +
|
||||
"objective\n" +
|
||||
"}";
|
||||
|
||||
public static final String BUILD_MODEL = "buildModel <- function(bestToOthers, othersToWorst, criteriaNames){\n" +
|
||||
"model <- validateData(bestToOthers, othersToWorst, criteriaNames)\n" +
|
||||
"consistency <- isConsistent(model)\n" +
|
||||
"model$isConsistent <- consistency$isConsistent\n" +
|
||||
"model$a_bw <- consistency$a_bw\n" +
|
||||
"\n" +
|
||||
"constraints <- buildBasicConstraints(model)\n" +
|
||||
"\n" +
|
||||
"model$ksiIndex <- length(model$bestToOthers)+1\n" +
|
||||
"\n" +
|
||||
"if(model$isConsistent){\n" +
|
||||
"result <- createBaseModelConstraints(model, constraints, vectorType = \"best\", dir = \"==\")\n" +
|
||||
"if(result$numberOfAddedConstraints > 0){\n" +
|
||||
"constraints <- result$constraints\n" +
|
||||
"}\n" +
|
||||
"} else {\n" +
|
||||
"result <- createBaseModelConstraints(model, constraints, vectorType = \"best\", dir = \"<=\", ksiIndexValue = -1)\n" +
|
||||
"constraints <- addConstraintsFromResult(constraints, result)\n" +
|
||||
"\n" +
|
||||
"result <- createBaseModelConstraints(model, constraints, vectorType = \"worst\", dir = \"<=\", ksiIndexValue = -1)\n" +
|
||||
"constraints <- addConstraintsFromResult(constraints, result)\n" +
|
||||
"}\n" +
|
||||
"\n" +
|
||||
"model$constraints = constraintsListToMatrix(constraints)\n" +
|
||||
"model$objective <- createModelsObjective(model, model$ksiIndex)\n" +
|
||||
"model$maximize <- FALSE\n" +
|
||||
"\n" +
|
||||
"model\n" +
|
||||
"}";
|
||||
|
||||
public static final String CALCULATE_WEIGHTS = "calculateWeights <- function(criteriaNames, bestToOthers, othersToWorst){\n" +
|
||||
"model <- buildModel(bestToOthers, othersToWorst, criteriaNames)\n" +
|
||||
"consistencyIndex <- c(0, .44, 1.0, 1.63, 2.3, 3., 3.73, 4.47, 5.23)\n" +
|
||||
"\n" +
|
||||
"result <- solveLP(model)\n" +
|
||||
"weights <- result$solution[1:model$ksiIndex-1]\n" +
|
||||
"consistencyRatio <- result$solution[model$ksiIndex] / consistencyIndex[as.integer(model$a_bw)]\n" +
|
||||
"\n" +
|
||||
"result <- list(criteriaNames = criteriaNames, criteriaWeights = weights, consistencyRatio = consistencyRatio)\n" +
|
||||
"list(result = result, model = model)\n" +
|
||||
"}";
|
||||
|
||||
public static final String SOLVE_LP = "solveLP <- function(model){\n" +
|
||||
"Rglpk_solve_LP(model$objective, model$constraints$lhs, model$constraints$dir, model$constraints$rhs, max = model$maximize)\n" +
|
||||
"}";
|
||||
|
||||
}
|
||||
+20
@@ -0,0 +1,20 @@
|
||||
package flintstones.method.common.phase.collectweights.bestworst.exception;
|
||||
|
||||
public class ExecutionException extends Exception {
|
||||
|
||||
/**
|
||||
*
|
||||
*/
|
||||
private static final long serialVersionUID = 1L;
|
||||
|
||||
private String message;
|
||||
|
||||
public ExecutionException(String message) {
|
||||
this.message = message;
|
||||
}
|
||||
|
||||
@Override
|
||||
public String getMessage() {
|
||||
return "Execution failed: " + this.message;
|
||||
}
|
||||
}
|
||||
Reference in New Issue
Block a user