R/aggregatecases.R

In WeightedCluster: Clustering of Weighted Data

wcAggregateCases <- function(x, weights = NULL, ...) {
  UseMethod("wcAggregateCases")
}

wcAggregateCasesInternal <- function(x, weights = NULL) {
  x <- as.data.frame(x)
  lx <- nrow(x)
  if (is.null(weights)) {
    weights <- rep(1, lx)
  }
  for (i in 1:ncol(x)) {
    x[, i] <- factor(x[, i])
    levels(x[, i]) <- as.character(1:nlevels(x[, i]))
  }
  ids <- apply(x, 1, paste, collapse = "@@@WC_SEP@@")
  FuncEnv <- environment()
  mcorr <- rep(NA, lx)
  myfunction <- function(x) {
    FuncEnv$mcorr[x] <- x[1]
    return(c(x[1], sum(weights[x])))
  }
  xx <- aggregate(1:lx, list(id = ids), myfunction)$x
  mcorr2 <- match(mcorr, xx[, 1])
  ret <- list(aggIndex = xx[, 1], aggWeights = xx[, 2], disaggIndex = mcorr2, disaggWeights = weights)
  class(ret) <- c("wcAggregateCases", class(ret))
  return(ret)
}

wcAggregateCases.default <- function(x, weights = NULL, ...) {
  xx <- wcAggregateCasesInternal(x, weights = weights)
  return(xx)
}


wcAggregateCases.data.frame <- function(x, weights = NULL, ...) {
  xx <- wcAggregateCasesInternal(x, weights = weights)
  return(xx)
}
wcAggregateCases.matrix <- function(x, weights = NULL, ...) {
  xx <- wcAggregateCasesInternal(x, weights = weights)
  return(xx)
}

wcAggregateCases.stslist <- function(x, weights = NULL, weighted = TRUE, ...) {
  if (is.null(weights) && weighted) {
    weights <- attr(x, "weights")
  }
  xx <- wcAggregateCasesInternal(x, weights = weights)
  return(xx)
}

print.wcAggregateCases <- function(x, ...) {
  cat("Number of disaggregated cases: ", length(x$disaggWeights), "\n")
  cat("Number of aggregated cases: ", length(x$aggWeights), "\n")
  cat("Average aggregated cases: ", format(length(x$disaggWeights) / length(x$aggWeights)), "\n")
  cat("Average (weighted) aggregation: ", mean(x$aggWeights), "\n")
}