https://github.com/cran/EMCluster
Raw File
Tip revision: 402bcb69315fa9c0ebffd3364b648523abf2b772 authored by Wei-Chen Chen on 05 September 2023, 10:00:02 UTC
version 0.2-15
Tip revision: 402bcb6
fcn_RRand.r
### This file contains a wrap to call C function in "src/R_RRand.c".
### Written: Wei-Chen Chen on 2008/10/27.


# Call:
#   SEXP R_RRand(SEXP N, SEXP TRUK, SEXP PREDK, SEXP trcl, SEXP prcl)
# Input:
#   N: SEXP[1], number of observations.
#   TRUK: SEXP[1], number of true clusters.
#   PREDK: SEXP[1], number of predicted clusters.
#   trcl: SEXP[N], true cluster ids.
#   prcl: SEXP[N], predicted cluster ids.
# Output in C:
#   ret: a list contains
#      Rand: SEXP[1], Rand index.
#      adjRand: SEXP[1], adjust Rand index.
#      Eindex: SEXP[1], Eindex.
RRand <- function(trcl, prcl, lab = NULL){
  if(! is.null(lab)){
    trcl <- trcl[lab == 0]
    prcl <- prcl[lab == 0]
  }

  N <- length(trcl)

  if(length(trcl) != N || length(prcl) != N){
    stop("Lengths of trcl and prcl do not agree!")
  } 

  tmp.TRUK <- unique(trcl)
  tmp.PREDK <- unique(prcl)
  TRUK <- max(tmp.TRUK)
  PREDK <- max(tmp.PREDK)

  if(min(tmp.TRUK) < 1 || min(tmp.PREDK) < 1){
    stop("The minimum ID is smaller than 1!")
  }
  if(min(tmp.TRUK) != 1 || min(tmp.PREDK) != 1){
    warnings("The minimum ID is not 1!")
  }

  ret <- .Call("R_RRand",
               as.integer(N),
               as.integer(TRUK),
               as.integer(PREDK),
               as.integer(trcl - 1),
               as.integer(prcl - 1))

  class(ret) <- "RRandret"
  ret
}

print.RRandret <- function(x, ...){
  arg <- list(...)
  if(! ("digits" %in% names(arg))){
    digits <- max(4, getOption("digits") - 3)
  }
  my.print(unlist(x), digits = digits)
}
back to top