# truecluster/R/tieorder.R
# order() with breaking ties at random
# (C) 2000-2007 Dr. Jens Oehlschlägel
#
# 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
# (at your option) 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
###########################################################################

#! \name{tieorder}
#! \alias{tieorder}
#! \title{ Ordering double breaking ties at random }
#! \description{
#!   This function works very similar to \code{\link[base]{order}} but in case of ties it breaks them by random.
#! }
#! \usage{
#! tieorder(x, decreasing = FALSE, index = seq(along = x), tiebreak = TRUE)
#! }
#! \arguments{
#!   \item{x}{ a vector of double or integer }
#!   \item{decreasing}{ TRUE to order decreasing (default FALSE = increasing) }
#!   \item{index}{ optionally a vector of integer index to be rearranged }
#!   \item{tiebreak}{ FALSE to avoid randomly breaking ties }
#! }
#! \details{
#!   NAs sorted last. Uses internally rsort_index.
#! }
#! \value{
#!   index rearranged
#! }
#! \author{ Jens Oehschlägel }
#! \seealso{ \code{\link[base]{order}}, \code{\link[distutil]{colOrder}}, \code{\link[distutil]{rowOrder}} }
#!
#! \examples{
#!   tieorder(c(NA, NA, 2, 2, 1))
#!   tieorder(c(NA, NA, 2, 2, 1))
#!   tieorder(c(NA, NA, 2, 2, 1))
#!   tieorder(c(NA, NA, 2, 2, 1))
#!   x <- c(NA, NA, 2, 2, 1)
#!   n <- 100
#!   o <- integer(length(x))
#!   for (i in 1:n)
#!   o <- o + tieorder(x)
#!   o/n
#! }
#! \keyword{ utilities }

tieorder <- function(x, decreasing=FALSE, index=seq(along=x), tiebreak=TRUE){
  if (!is.double(x)){
    if(is.integer(x)){
      warning("using tiesort on integer, coercing to double")
    }else{
      stop("neither double nor integer")
    }
  }
  if (tiebreak){
    ret <- .C("R_tc_tieorder"
    , x     = as.double(x)
    , index = as.integer(index)
    , n     = as.integer(length(x))
    , NAOK = TRUE, DUP = FALSE, PACKAGE = "truecluster"
    )
    if (decreasing){
      i <- is.na(ret$x)
      c(rev(ret$index[!i]), ret$index[i])
    }else{
      ret$index
    }
  }else{
    order(as.double(x), decreasing=decreasing)
  }
}

