#'
#'   uniquemap.R
#'
#'   Copyright (C) Adrian Baddeley, Ege Rubak and Rolf Turner 2001-2019
#'   Licence: GNU Public Licence >= 2
#'
#'   $Revision: 1.21 $  $Date: 2025/12/29 06:07:10 $

uniquemap <- function(x) { UseMethod("uniquemap") }

uniquemap.default <- function(x) {
  result <- seqn <- seq_along(x)
  if(length(x) <= 1) return(result)
  if(is.atomic(x) && (is.factor(x) || (is.vector(x) && is.numeric(x)))) {
    if(is.factor(x)) x <- as.integer(x)
    o <- order(x, seqn)
    xo <- x[o]
    isfirst <- c(TRUE, as.logical(difflong(xo)))
    omap <- cumsum(isfirst)
    result <- seqn
    result[o] <- o[isfirst][omap]
    return(result)
  }
  dup <- duplicated(x)
  ux <- x[!dup]
  mapdup <- match(x[dup], ux)
  result[dup] <- which(!dup)[mapdup]
  return(result)
}

uniquemap.matrix <- function(x) {
  n <- nrow(x)
  result <- seqn <- seq_len(n)
  if(n <= 1)
    return(result)
  #' faster algorithms for special cases
  nc <- ncol(x)
  if(nc == 1L) return(uniquemap(x[,1]))
  if(is.numeric(x)) {
    if(nc == 2L) {
      oo <- order(x[,1], x[,2], seqn)
      xx <- x[oo, , drop=FALSE]
      isfirst <- c(TRUE, (difflong(xx[,1]) != 0) | (difflong(xx[,2]) != 0))
    } else {
      ## y <- asplit(x, 2) would require R 3.6.0
      y <- split(as.vector(x), factor(as.vector(col(x)), levels=1:nc))
      oo <- do.call(order, append(unname(y), list(seqn)))
      xx <- x[oo, , drop=FALSE]
      isfirst <- c(TRUE, matrowany(apply(xx, 2, difflong) != 0))
    }
    uniqueids <- seqn[oo][isfirst]
    lastunique <- cumsum(isfirst)
    result[oo] <- uniqueids[lastunique]
    return(result)
  }
  #' non-numeric matrix e.g. character
  if(!anyDuplicated(x))
    return(result)
  dup <- duplicated(x)
  uni <- which(!dup)
  for(j in which(dup)) {
    for(i in uni[uni < j]) {
      if(IdenticalRowPair(i, j, x)) {
        result[j] <- i
        break
      }
    }
  }
  return(result)
}

uniquemap.data.frame <- function(x) {
  n <- nrow(x)
  result <- seqn <- seq_len(n)
  if(n <= 1)
    return(result)
  #' faster algorithms for special cases
  nc <- ncol(x)
  if(nc == 1L) return(uniquemap(x[,1]))
  if(all(sapply(x, is.numeric))) {
    if(nc == 2L) {
      oo <- order(x[,1], x[,2], seqn)
      xx <- x[oo, , drop=FALSE]
      isfirst <- c(TRUE, (difflong(xx[,1]) != 0) | (difflong(xx[,2]) != 0))
    } else {
      oo <- do.call(order, append(unname(as.list(x)), list(seqn)))
      xx <- x[oo, , drop=FALSE]
      isfirst <- c(TRUE, matrowany(apply(xx, 2, difflong) != 0))
    }
    uniqueids <- seqn[oo][isfirst]
    lastunique <- cumsum(isfirst)
    result[oo] <- uniqueids[lastunique]
    return(result)
  }
  #' general case
  if(!anyDuplicated(x))
    return(result)
  dup <- duplicated(x)
  uni <- which(!dup)
  for(j in which(dup)) {
    for(i in uni[uni < j]) {
      if(IdenticalRowPair(i, j, x)) {
        result[j] <- i
        break
      }
    }
  }
  return(result)
}

## utility to check whether two rows are identical

IdenticalRowPair <- function(i,j, a, b=a) {
  #' i and j are row indices (single integers)
  ai <- a[i,]
  bj <- b[j,]
  row.names(ai) <- row.names(bj) <- NULL
  identical(ai, bj)
}

## vectorised

IdenticalRows <- function(i, j, a, b=a) {
  #' i and j are row index vectors of equal length
  #' result[k] = identical( a[i[k],]  , b[j[k],] )
  Mo <- if(missing(b)) list(a=a) else list(a=a, b=b)
  mapply(IdenticalRowPair, i=i, j=j, MoreArgs=Mo,
         SIMPLIFY=TRUE, USE.NAMES=FALSE)
}

