#' @import hitandrun
#' @export
sampleParameters <- function(model, numberOfSamples = 1000) {
stopifnot(numberOfSamples > 0)
stopifnot(all(model$constraints$types == "C"))
if (!isModelConsistent(model)) {
stop("Model infeasible.")
}
nrAlternatives <- nrow(model$perfToModelVariables)
nrCriteria <- ncol(model$perfToModelVariables)
model <- eliminateEpsilon(model)
constraints <- model$constraints
constraints$dir[which(constraints$dir == "==")] <- "="
geq <- which(constraints$dir == ">=")
for (i in geq) {
constraints$rhs[i] <- -1 * constraints$rhs[i]
constraints$lhs[i, ] <- -1 * constraints$lhs[i, ]
}
constraints$dir[geq] <- "<="
names(constraints)[1] <- "constr"
constraints[[4]] <- NULL
return (hitandrun(constraints, n.samples = numberOfSamples, thin.fn = function(n) { n^3 }))
}
#' @export
pwi <- function(model, samples, accuracy = 1e-16) {
stopifnot(nrow(samples) > 0)
nrAlternatives <- nrow(model$perfToModelVariables)
nrCriteria <- ncol(model$perfToModelVariables)
model <- eliminateEpsilon(model)
result <- matrix(data = 0, nrow = nrAlternatives, ncol = nrAlternatives)
for (i in seq_len(nrow(samples))) {
ranks <- getRanksFromF(model, samples[i, ], accuracy)
for (i in seq_len(nrAlternatives)) {
for (j in seq_len(nrAlternatives)) {
if (ranks[i] < ranks[j]) {
result[i, j] <- result[i, j] + 1
}
}
}
}
result <- result / nrow(samples)
return (result)
}
#' @export
rai <- function(model, samples) {
stopifnot(nrow(samples) > 0)
nrAlternatives <- nrow(model$perfToModelVariables)
nrCriteria <- ncol(model$perfToModelVariables)
model <- eliminateEpsilon(model)
result <- matrix(data = 0, nrow = nrAlternatives, ncol = nrAlternatives)
for (i in seq_len(nrow(samples))) {
ranks <- getRanksFromF(model, samples[i, ])
for (i in seq_len(nrAlternatives)) {
result[i, ranks[i]] <- result[i, ranks[i]] + 1
}
}
result <- result / nrow(samples)
return (result)
}
#' @export
cv <- function(model, samples) {
stopifnot(nrow(samples) > 0)
nrAlternatives <- nrow(model$perfToModelVariables)
nrCriteria <- ncol(model$perfToModelVariables)
model <- eliminateEpsilon(model)
weightIndices <- c()
for (j in seq_len(length(model$chPoints))) {
if (model$criterionPreferenceDirection[j] == "g") {
weightIndices <- c(weightIndices,
model$firstChPointVariableIndex[j] + model$chPoints[j] - 2)
} else { # "c"
weightIndices <- c(weightIndices,
model$firstChPointVariableIndex[j])
}
}
selectedColumns <- samples[, weightIndices]
return (mean(apply(selectedColumns, 2, sd) / colMeans(selectedColumns)))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.