#######################################################################
# seriation - Infrastructure for seriation
# Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
#' @include seriate_TSP.R
.bea_tsp_contr <- .tsp_control
seriate_matrix_bea_tsp <-
function(x, control, margin = seq_along(dim(x))) {
if (any(x < 0))
stop("Requires a nonnegative matrix.")
if (1L %in% margin) {
criterion <- as.dist(tcrossprod(x))
row <- seriate(max(criterion) - criterion,
method = "TSP",
control = control)[[1]]
attr(row, "method") <- "BEA_TSP"
} else
row <- NA
if (2L %in% margin) {
criterion <- as.dist(crossprod(x))
col <- seriate(max(criterion) - criterion,
method = "TSP",
control = control)[[1]]
attr(col, "method") <- "BEA_TSP"
} else
col <- NA
list(row = row, col = col)
}
## Bond Energy Algorithm (McCormick 1972)
.bea_contr <- list(istart = 0,
jstart = 0
)
attr(.bea_contr, "help") <- list(istart = "index of 1st row to be placed (0 = random)",
jstart = "index of 1st column to be placed (0 = random)"
)
# BEA always does rows and columns so margin is ignored
seriate_matrix_bea <- function(x, control = NULL, margin = NULL) {
control <- .get_parameters(control, .bea_contr)
if (any(x < 0))
stop("Requires a nonnegative matrix.")
istart <- control$istart
jstart <- control$jstart
#rep <- control$rep
rep <- 1L
res <- replicate(rep, bea(x, istart = istart, jstart = jstart),
simplify = FALSE)
best <- which.max(sapply(res, "[[", "e"))
res <- res[[best]]
row <- res$ib
col <- res$jb
names(row) <- rownames(x)[row]
names(col) <- colnames(x)[col]
list(row = row, col = col)
}
## register methods
set_seriation_method(
"matrix",
"BEA",
seriate_matrix_bea,
"Bond Energy Algorithm (BEA; McCormick 1972) to maximize the Measure of Effectiveness of a non-negative matrix.",
.bea_contr,
optimizes = .opt("ME", "Measure of effectiveness"),
randomized = TRUE
)
set_seriation_method(
"matrix",
"BEA_TSP",
seriate_matrix_bea_tsp,
"Use a TSP to optimize the Measure of Effectiveness (Lenstra 1974).",
.bea_tsp_contr,
optimizes = .opt("ME", "Measure of effectiveness"),
randomized = TRUE
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.