R/robinson.R

In seriation: Infrastructure for Ordering Objects Using Seriation

#######################################################################
# 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.

#' Create and Recognize Robinson and Pre-Robinson Matrices
#'
#' Provides functions to create and recognize (anti) Robinson and pre-Robinson
#' matrices. A (anti) Robinson matrix has strictly decreasing (increasing)
#' values when moving away from the main diagonal. A pre-Robinson matrix is a
#' matrix which can be transformed into a perfect Robinson matrix using
#' simultaneous permutations of rows and columns.
#'
#' Note that the default matrices are anti Robinson matrices. This is done
#' because distance matrices (the default in R) are typically anti Robinson
#' matrices with values increasing when moving away from the diagonal.
#'
#' Robinson matrices are recognized using the fact that they have zero anti
#' Robinson events. For pre-Robinson matrices we use spectral seriation first
#' since spectral seriation is guaranteed to perfectly reorder pre-Robinson
#' matrices (see Laurent and Seminaroti, 2015).
#'
#' Random pre-Robinson matrices are generated by reversing the process of
#' unidimensional scaling. We randomly (uniform distribution with range
#' \eqn{[0,1]}) choose \eqn{x} coordinates for \code{n} points on a straight
#' line and calculate the pairwise distances. For Robinson matrices, the points
#' are sorted first according to \eqn{x}. For noise, \eqn{y} coordinates is
#' added. The coordinates are chosen uniformly between 0 and \code{noise}, with
#' \code{noise} between 0 and 1.
#'
#' @aliases Robinson
#' @param x a symmetric, positive matrix or a dissimilarity matrix (a
#' \code{dist} object).
#' @param anti logical; check for anti Robinson structure? Note that for
#' distances, anti Robinson structure is appropriate.
#' @param pre logical; recognize/create pre-Robinson matrices.
#' @param n number of objects.
#' @param noise noise intensity between 0 and 1. Zero means no noise.  Noise
#' more than zero results in non-Robinson matrices.
#' @return A single logical value.
#' @references M. Laurent, M. Seminaroti (2015): The quadratic assignment
#' problem is easy for Robinsonian matrices with Toeplitz structure,
#' \emph{Operations Research Letters} 43(1), 103--109.
#' @examples
#'
#' ## create a perfect anti Robinson structure
#' m <- random.robinson(10)
#' pimage(m)
#'
#' is.robinson(m)
#'
#' ## permute the structure to make it not Robinsonian. However,
#' ## it is still pre-Robinson.
#' o <- sample(10)
#' m2 <- permute(m, ser_permutation(o,o))
#' pimage(m2)
#'
#' is.robinson(m2)
#' is.robinson(m2, pre = TRUE)
#'
#' ## create a binary random Robinson matrix (not anti Robinson)
#' m3 <- random.robinson(10, anti = FALSE) > .7
#' pimage(m3)
#' is.robinson(m3, anti = FALSE)
#'
#' ## create matrices with noise (as distance matrices)
#' m4 <- as.dist(random.robinson(50, pre = FALSE, noise = .1))
#' pimage(m4)
#' criterion(m4, method = "AR")
#'
#' m5 <- as.dist(random.robinson(50, pre = FALSE, noise = .5))
#' pimage(m5)
#' criterion(m5, method = "AR")
#' @export
is.robinson <- function(x, anti = TRUE, pre = FALSE) {
  if (is.matrix(x) && !isSymmetric(unname(x)))
    stop("x needs to be a symmetric matrix!")

  d <- as.dist(x)
  if (!anti)
    d <- max(d) - d

  ## pre Robinson matrix can be perfectly seriated using
  ## spectral seriation!
  if (pre)
    d <- permute(d, seriate(d, method = "spectral"))

  unname(criterion(d, method = "AR_events") == 0)
}

#' @rdname is.robinson
#' @export
random.robinson <-
  function(n,
    anti = TRUE,
    pre = FALSE,
    noise = 0) {
    if (noise < 0 | noise > 1)
      stop("noise has to be beween 0 and 1.")

    x <- runif(n)
    if (!pre)
      x <- sort(x)

    if (noise)
      x <- cbind(x, runif(n, min = 0, max = noise))

    m <- as.matrix(stats::dist(x))

    if (!anti)
      m <- max(m) - m

    m
  }