Merge branch 'master' of github.com:sdcTools/sdcMicro

R/mafast.R

@@ -134,6 +134,6 @@ mafastWORK <- function(x, variables=colnames(x), by=NULL, aggr=3, measure=mean)
   eval(parse(text=cmd))
   x <- x[, !colnames(x) %in% c("BYVARIABLEFORSPLIT", "idvariableforresorting"), drop=FALSE]
   setkey(erg, "idvariableforresorting")
-  x[, variables] <- data.frame(erg[, by=idvariableforresorting])[, variables]
+  x[, variables] <- data.frame(erg)[, variables]
   return(x)
 }

R/mvTopCoding.R

@@ -8,7 +8,7 @@
 #' @param x object of class matrix with numeric entries
 #' @param maha squared mahalanobis distance of each observation
 #' @param center center of data, needed for calcualtion of mahalanobis distance (if not provide)
-#' @param sigma covariance matrix of data, needed for calcualtion of mahalanobis distance (if not provide)
+#' @param cov covariance matrix of data, needed for calcualtion of mahalanobis distance (if not provide)
 #' @param alpha significance level, determining the ellipsoide to which outliers should be placed upon
 #' @return the imputed winsorized data
 #' @importFrom robustbase covMcd
@@ -50,13 +50,12 @@
 #' 
 mvTopCoding <- function(x, maha=NULL,center=NULL,
                         cov=NULL, alpha=0.025){
-  stopifnot(is.numeric(x) || is.logical(x), is.atomic(x))
-
-  if(is.data.frame(x) | is.data.table(x)){
-    stop("x must be of class matrix")
-  }
-  #  if(!is.data.table(x))x <- as.data.table(x)
+  # stopifnot(is.numeric(x) || is.logical(x), is.atomic(x))
 
+  # if(is.data.frame(x) | is.data.table(x)){
+  #   stop("x must be of class matrix")
+  # }
+  if(!is.data.table(x)) x <- as.data.table(x)
   p <- ncol(x)
   d <- qchisq(1-alpha,df=p)
 

tests/testthat/microaggregation_test.R

@@ -0,0 +1,27 @@
+require(sdcMicro)
+### for a data.frame
+test_that("pram on a factor", {
+  dat <- data.frame(x = rnorm(100))
+  datout <- microaggregation(obj = dat, variables = "x", method = "mdav", aggr = 3, measure = "mean")
+  expect_identical(dat,datout$x)
+  expect_identical(dim(dat),dim(datout$mx))
+
+  dat <- data.frame(x = rnorm(100), y = rnorm(100))
+  datout <- microaggregation(obj = dat, variables = "x", method = "mdav", aggr = 3, measure = "mean")
+  expect_identical(dat,datout$x)
+  expect_identical(dim(dat),dim(datout$mx))
+
+  datout <- microaggregation(obj = dat, variables = c("x", "y"), method = "mdav", aggr = 3, measure = "mean")
+  expect_identical(dat,datout$x)
+  expect_identical(dim(dat),dim(datout$mx))
+
+  # for a sdcObj
+  set.seed(199723)
+  activedataset <- testdata
+  sdcObject <- createSdcObj(activedataset, keyVars = c("urbrur", "roof", "sex", "age"),
+                            numVars = c("expend", "income", "savings"),
+                            weightVar = c("sampling_weight"), hhId = c("ori_hid"))
+  expect_message(microaggregation(sdcObject, aggr = c(3), method = c("mdav"),
+                                variables = c("expend"), strata_variables = c("sex")))
+
+})