diff --git a/NAMESPACE b/NAMESPACE index 903ec8e..fd31aca 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,67 +1,10 @@ # Generated by roxygen2: do not edit by hand -S3method(aggr,data.frame) -S3method(aggr,default) -S3method(aggr,survey.design) -S3method(barMiss,data.frame) -S3method(barMiss,default) -S3method(barMiss,survey.design) -S3method(colormapMiss,data.frame) -S3method(colormapMiss,default) -S3method(colormapMiss,survey.design) -S3method(growdotMiss,data.frame) -S3method(growdotMiss,default) -S3method(growdotMiss,survey.design) -S3method(histMiss,data.frame) -S3method(histMiss,default) -S3method(histMiss,survey.design) -S3method(hotdeck,data.frame) -S3method(hotdeck,default) -S3method(hotdeck,survey.design) -S3method(irmi,data.frame) -S3method(irmi,default) -S3method(irmi,survey.design) -S3method(kNN,data.frame) -S3method(kNN,data.table) -S3method(kNN,default) -S3method(kNN,survey.design) -S3method(mapMiss,data.frame) -S3method(mapMiss,default) -S3method(mapMiss,survey.design) -S3method(marginmatrix,data.frame) -S3method(marginmatrix,default) -S3method(marginmatrix,survey.design) -S3method(matchImpute,data.frame) -S3method(matchImpute,data.table) -S3method(matchImpute,default) -S3method(matchImpute,survey.design) -S3method(matrixplot,data.frame) -S3method(matrixplot,default) -S3method(matrixplot,survey.design) -S3method(mosaicMiss,data.frame) -S3method(mosaicMiss,default) -S3method(mosaicMiss,survey.design) -S3method(parcoordMiss,data.frame) -S3method(parcoordMiss,default) -S3method(parcoordMiss,survey.design) -S3method(pbox,data.frame) -S3method(pbox,default) -S3method(pbox,survey.design) S3method(plot,aggr) -S3method(prepare,data.frame) -S3method(prepare,default) -S3method(prepare,survey.design) S3method(print,aggr) S3method(print,summary.aggr) -S3method(regressionImp,data.frame) -S3method(regressionImp,default) -S3method(regressionImp,survey.design) -S3method(scattmatrixMiss,data.frame) -S3method(scattmatrixMiss,default) -S3method(scattmatrixMiss,survey.design) S3method(summary,aggr) export(aggr) -export(aggr_work) export(alphablend) export(barMiss) export(bgmap) diff --git a/R/aggr.R b/R/aggr.R index 0ebac1c..575b8f7 100644 --- a/R/aggr.R +++ b/R/aggr.R @@ -88,31 +88,8 @@ #' #' @export aggr <- function(x, delimiter = NULL, plot = TRUE, ...) { - UseMethod("aggr", x) -} - -#' @rdname aggr -#' @export -aggr.data.frame <- function(x, delimiter = NULL, plot = TRUE, ...) { - aggr_work(x, delimiter, plot, ...) -} - -#' @rdname aggr -#' @export -aggr.survey.design <- function(x, delimiter = NULL, plot = TRUE, ...) { - aggr_work(x$variables, delimiter, plot, ...) -} - -#' @rdname aggr -#' @export -aggr.default <- function(x, delimiter = NULL, plot = TRUE, ...) { - aggr_work(as.data.frame(x), delimiter, plot, ...) -} - -#' @rdname aggr -#' @export -aggr_work <- function(x, delimiter = NULL, plot = TRUE, ...) { - + check_data(x) + x <- as.data.frame(x) imputed <- FALSE # indicates if there are Variables with missing-index if(is.null(dim(x))) { n <- length(x) diff --git a/R/barMiss.R b/R/barMiss.R index b0c586c..f15ee07 100644 --- a/R/barMiss.R +++ b/R/barMiss.R @@ -105,62 +105,16 @@ #' barMiss(x_IMPUTED, delimiter = "_imp", only.miss = FALSE) #' #' -#' @export barMiss +#' @export barMiss <- function(x, delimiter = NULL, pos = 1, selection = c("any","all"), col = c("skyblue","red","skyblue4","red4","orange","orange4"), border = NULL, main = NULL, sub = NULL, xlab = NULL, ylab = NULL, axes = TRUE, labels = axes, only.miss = TRUE, miss.labels = axes, interactive = TRUE, ...) { - UseMethod("barMiss", x) -} - -#' @rdname barMiss -#' @export -barMiss.data.frame <- function(x, delimiter = NULL, pos = 1, selection = c("any","all"), - col = c("skyblue","red","skyblue4","red4","orange","orange4"), - border = NULL, main = NULL, sub = NULL, - xlab = NULL, ylab = NULL, axes = TRUE, - labels = axes, only.miss = TRUE, - miss.labels = axes, interactive = TRUE, ...) { - barMiss_work(x, delimiter, pos, selection, col, border, main, sub, xlab, ylab, axes, labels, only.miss, - miss.labels, interactive, ...) -} - -#' @rdname barMiss -#' @export - -barMiss.survey.design <- function(x, delimiter = NULL, pos = 1, selection = c("any","all"), - col = c("skyblue","red","skyblue4","red4","orange","orange4"), - border = NULL, main = NULL, sub = NULL, - xlab = NULL, ylab = NULL, axes = TRUE, - labels = axes, only.miss = TRUE, - miss.labels = axes, interactive = TRUE, ...) { - barMiss_work(x$variables, delimiter, pos, selection, col, border, main, sub, xlab, ylab, axes, labels, only.miss, - miss.labels, interactive, ...) -} - -#' @rdname barMiss -#' @export - -barMiss.default <- function(x, delimiter = NULL, pos = 1, selection = c("any","all"), - col = c("skyblue","red","skyblue4","red4","orange","orange4"), - border = NULL, main = NULL, sub = NULL, - xlab = NULL, ylab = NULL, axes = TRUE, - labels = axes, only.miss = TRUE, - miss.labels = axes, interactive = TRUE, ...) { - barMiss_work(as.data.frame(x), delimiter, pos, selection, col, border, main, sub, xlab, ylab, axes, labels, only.miss, - miss.labels, interactive, ...) -} - -barMiss_work <- function(x, delimiter = NULL, pos = 1, selection = c("any","all"), - col = c("skyblue","red","skyblue4","red4","orange","orange4"), - border = NULL, main = NULL, sub = NULL, - xlab = NULL, ylab = NULL, axes = TRUE, - labels = axes, only.miss = TRUE, - miss.labels = axes, interactive = TRUE, ...) { - - imputed <- FALSE # indicates if there are Variables with missing-index + check_data(x) + x <- as.data.frame(x) + imputed <- FALSE # indicates if there are Variables with missing-index # initializations and error messages if(is.null(dim(x))) { # vector # call histMiss if the plot variable is continuous diff --git a/R/colormapMiss.R b/R/colormapMiss.R index 605437d..c800ac7 100644 --- a/R/colormapMiss.R +++ b/R/colormapMiss.R @@ -111,7 +111,7 @@ #' data using visualization tools. *Journal of Advances in Data Analysis #' and Classification*, Online first. DOI: 10.1007/s11634-011-0102-y. #' @keywords hplot -#' @export colormapMiss +#' @export colormapMiss <- function(x, region, map, imp_index = NULL, prop = TRUE, polysRegion = 1:length(x), range = NULL, n = NULL, col = c("red","orange"), @@ -119,63 +119,8 @@ colormapMiss <- function(x, region, map, imp_index = NULL, numbers = TRUE, digits = 2, cex.numbers = 0.8, col.numbers = par("fg"), legend = TRUE, interactive = TRUE, ...) { - UseMethod("colormapMiss", x) -} - -#' @rdname colormapMiss -#' @export - -colormapMiss.data.frame <- function(x, region, map, imp_index = NULL, - prop = TRUE, polysRegion = 1:length(x), range = NULL, - n = NULL, col = c("red","orange"), - gamma = 2.2, fixup = TRUE, coords = NULL, - numbers = TRUE, digits = 2, cex.numbers = 0.8, - col.numbers = par("fg"), legend = TRUE, - interactive = TRUE, ...) { - colormapMiss_work(x, region, map,imp_index, prop, polysRegion, range, n, col, - gamma, fixup, coords, numbers, digits, cex.numbers, col.numbers, - legend, interactive, ...) -} - -#' @rdname colormapMiss -#' @export - -colormapMiss.survey.design <- function(x, region, map, imp_index = NULL, - prop = TRUE, polysRegion = 1:length(x), range = NULL, - n = NULL, col = c("red","orange"), - gamma = 2.2, fixup = TRUE, coords = NULL, - numbers = TRUE, digits = 2, cex.numbers = 0.8, - col.numbers = par("fg"), legend = TRUE, - interactive = TRUE, ...) { - colormapMiss_work(x$variables, region, map,imp_index, prop, polysRegion, range, n, col, - gamma, fixup, coords, numbers, digits, cex.numbers, col.numbers, - legend, interactive, ...) -} - -#' @rdname colormapMiss -#' @export - -colormapMiss.default <- function(x, region, map, imp_index = NULL, - prop = TRUE, polysRegion = 1:length(x), range = NULL, - n = NULL, col = c("red","orange"), - gamma = 2.2, fixup = TRUE, coords = NULL, - numbers = TRUE, digits = 2, cex.numbers = 0.8, - col.numbers = par("fg"), legend = TRUE, - interactive = TRUE, ...) { - colormapMiss_work(as.data.frame(x), region, map,imp_index, prop, polysRegion, range, n, col, - gamma, fixup, coords, numbers, digits, cex.numbers, col.numbers, - legend, interactive, ...) -} - -colormapMiss_work <- function(x, region, map, imp_index = NULL, - prop = TRUE, polysRegion = 1:length(x), range = NULL, - n = NULL, col = c("red","orange"), - #space = c("rgb", "hcl"), - gamma = 2.2, fixup = TRUE, coords = NULL, - numbers = TRUE, digits = 2, cex.numbers = 0.8, - col.numbers = par("fg"), legend = TRUE, - interactive = TRUE, ...) { - + check_data(x) + x <- as.data.frame(x) # back compatibility dots <- list(...) if(missing(cex.numbers) && "cex.text" %in% names(dots)) { diff --git a/R/growdotMiss.R b/R/growdotMiss.R index b834e19..c43236e 100644 --- a/R/growdotMiss.R +++ b/R/growdotMiss.R @@ -97,7 +97,7 @@ #' x_imp <- kNN(chorizonDL[,c("Ca","As","Bi" )]) #' growdotMiss(x_imp, coo, kola.background, delimiter = "_imp", border = "white") #' -#' @export growdotMiss +#' @export growdotMiss <- function(x, coords, map, pos=1, delimiter = NULL, selection = c("any","all"), log = FALSE, col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), border = par("bg"), alpha = NULL, scale = NULL, @@ -106,67 +106,10 @@ growdotMiss <- function(x, coords, map, pos=1, delimiter = NULL, selection = c(" legtitle = "Legend", cex.legtitle = par("cex"), cex.legtext = par("cex"), ncircles = 6, ndigits = 1, interactive = TRUE, ...) { - UseMethod("growdotMiss", x) -} - -#' @rdname growdotMiss -#' @export - -growdotMiss.data.frame <- function(x, coords, map, pos=1, delimiter = NULL, selection = c("any","all"), - log = FALSE, col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - border = par("bg"), alpha = NULL, scale = NULL, - size = NULL, exp = c(0, 0.95, 0.05), - col.map = grey(0.5), legend = TRUE, - legtitle = "Legend", cex.legtitle = par("cex"), - cex.legtext = par("cex"), ncircles = 6, ndigits = 1, - interactive = TRUE, ...) { - growdotMiss_work(x, coords, map, pos, delimiter, selection, log, col, border, alpha, scale, size, - exp, col.map, legend, legtitle, cex.legtitle, cex.legtext, ncircles, - ndigits, interactive,...) -} - -#' @rdname growdotMiss -#' @export - -growdotMiss.survey.design <- function(x, coords, map, pos=1, delimiter = NULL, selection = c("any","all"), - log = FALSE, col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - border = par("bg"), alpha = NULL, scale = NULL, - size = NULL, exp = c(0, 0.95, 0.05), - col.map = grey(0.5), legend = TRUE, - legtitle = "Legend", cex.legtitle = par("cex"), - cex.legtext = par("cex"), ncircles = 6, ndigits = 1, - interactive = TRUE, ...) { - growdotMiss_work(x$variables, coords, map, pos, delimiter, selection, log, col, border, alpha, scale, size, - exp, col.map, legend, legtitle, cex.legtitle, cex.legtext, ncircles, - ndigits, interactive,...) -} - -#' @rdname growdotMiss -#' @export - -growdotMiss.default <- function(x, coords, map, pos=1, delimiter = NULL, selection = c("any","all"), - log = FALSE, col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - border = par("bg"), alpha = NULL, scale = NULL, - size = NULL, exp = c(0, 0.95, 0.05), - col.map = grey(0.5), legend = TRUE, - legtitle = "Legend", cex.legtitle = par("cex"), - cex.legtext = par("cex"), ncircles = 6, ndigits = 1, - interactive = TRUE, ...) { - growdotMiss_work(as.data.frame(x), coords, map, pos, delimiter, selection, log, col, border, alpha, scale, size, - exp, col.map, legend, legtitle, cex.legtitle, cex.legtext, ncircles, - ndigits, interactive,...) -} - -# code is based on Peter Filzmoser's function 'bubbleFIN' in package 'StatDA' + check_data(x) + x <- as.data.frame(x) # FIXME: infinite values -growdotMiss_work <- function(x, coords, map, pos=1, delimiter = NULL, selection = c("any","all"), - log = FALSE, col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - border = par("bg"), alpha = NULL, scale = NULL, - size = NULL, exp = c(0, 0.95, 0.05), - col.map = grey(0.5), legend = TRUE, - legtitle = "Legend", cex.legtitle = par("cex"), - cex.legtext = par("cex"), ncircles = 6, ndigits = 1, - interactive = TRUE, ...) { + # code is based on StatDA::bubbleFIN() # ncircles ... number of circles for the legend # ndigits ... number of digits for the legend # error messages diff --git a/R/histMiss.R b/R/histMiss.R index 15ba28b..1e4bb0d 100644 --- a/R/histMiss.R +++ b/R/histMiss.R @@ -108,7 +108,7 @@ #' histMiss(x_IMPUTED, delimiter = "_imp") #' histMiss(x_IMPUTED, delimiter = "_imp", only.miss = FALSE) #' -#' @export histMiss +#' @export histMiss <- function(x, delimiter = NULL, pos = 1, selection = c("any","all"), breaks = "Sturges", right = TRUE, col = c("skyblue","red","skyblue4","red4","orange","orange4"), @@ -116,59 +116,8 @@ histMiss <- function(x, delimiter = NULL, pos = 1, selection = c("any","all"), xlab = NULL, ylab = NULL, axes = TRUE, only.miss = TRUE, miss.labels = axes, interactive = TRUE, ...) { - UseMethod("histMiss", x) -} - -#' @rdname histMiss -#' @export - -histMiss.data.frame <- function(x, delimiter = NULL, pos = 1, selection = c("any","all"), - breaks = "Sturges", right = TRUE, - col = c("skyblue","red","skyblue4","red4","orange","orange4"), - border = NULL, main = NULL, sub = NULL, - xlab = NULL, ylab = NULL, axes = TRUE, - only.miss = TRUE, miss.labels = axes, - interactive = TRUE, ...) { - histMiss_work(x, delimiter, pos, selection, breaks, right, col, border, main, sub, - xlab, ylab, axes, only.miss, miss.labels, interactive, ...) -} - -#' @rdname histMiss -#' @export - -histMiss.survey.design <- function(x, delimiter = NULL, pos = 1, selection = c("any","all"), - breaks = "Sturges", right = TRUE, - col = c("skyblue","red","skyblue4","red4","orange","orange4"), - border = NULL, main = NULL, sub = NULL, - xlab = NULL, ylab = NULL, axes = TRUE, - only.miss = TRUE, miss.labels = axes, - interactive = TRUE, ...) { - histMiss_work(x$variables, delimiter, pos, selection, breaks, right, col, border, main, sub, - xlab, ylab, axes, only.miss, miss.labels, interactive, ...) -} - -#' @rdname histMiss -#' @export - -histMiss.default <- function(x, delimiter = NULL, pos = 1, selection = c("any","all"), - breaks = "Sturges", right = TRUE, - col = c("skyblue","red","skyblue4","red4","orange","orange4"), - border = NULL, main = NULL, sub = NULL, - xlab = NULL, ylab = NULL, axes = TRUE, - only.miss = TRUE, miss.labels = axes, - interactive = TRUE, ...) { - histMiss_work(as.data.frame(x), delimiter, pos, selection, breaks, right, col, border, main, sub, - xlab, ylab, axes, only.miss, miss.labels, interactive, ...) -} - -histMiss_work <- function(x, delimiter = NULL, pos = 1, selection = c("any","all"), - breaks = "Sturges", right = TRUE, - col = c("skyblue","red","skyblue4","red4","orange","orange4"), - border = NULL, main = NULL, sub = NULL, - xlab = NULL, ylab = NULL, axes = TRUE, - only.miss = TRUE, miss.labels = axes, - interactive = TRUE, ...) { - + check_data(x) + x <- as.data.frame(x) imputed <- FALSE # indicates if there are Variables with missing-index # initializations and error messages diff --git a/R/hotdeck.R b/R/hotdeck.R index 04e07d1..4a62843 100644 --- a/R/hotdeck.R +++ b/R/hotdeck.R @@ -67,64 +67,27 @@ #' xImp <- hotdeck(x,ord_var = c("o1","o2","o3"),domain_var="d2") #' #' -#' @export hotdeck -hotdeck <- function(data, variable=NULL, ord_var=NULL,domain_var=NULL, - makeNA=NULL,NAcond=NULL,impNA=TRUE,donorcond=NULL, - imp_var=TRUE,imp_suffix="imp") { - UseMethod("hotdeck", data) -} - -#' @rdname hotdeck #' @export - -hotdeck.data.frame <- function(data, variable=NULL, ord_var=NULL,domain_var=NULL, - makeNA=NULL,NAcond=NULL,impNA=TRUE,donorcond=NULL, - imp_var=TRUE,imp_suffix="imp") { - hotdeck_work(data, variable, ord_var, domain_var, makeNA, NAcond, impNA, donorcond, - imp_var, imp_suffix) -} - -#' @rdname hotdeck -#' @export - -hotdeck.survey.design <- function(data, variable=NULL, ord_var=NULL,domain_var=NULL, - makeNA=NULL,NAcond=NULL,impNA=TRUE,donorcond=NULL, - imp_var=TRUE,imp_suffix="imp") { - data$variables <- hotdeck_work(data$variables, variable, ord_var, domain_var, makeNA, NAcond, impNA, donorcond, - imp_var, imp_suffix) - data$call <- sys.call(-1) - data -} - -#' @rdname hotdeck -#' @export - -hotdeck.default <- function(data, variable=NULL, ord_var=NULL,domain_var=NULL, - makeNA=NULL,NAcond=NULL,impNA=TRUE,donorcond=NULL, - imp_var=TRUE,imp_suffix="imp") { - hotdeck_work(as.data.frame(data), variable, ord_var, domain_var, makeNA, NAcond, impNA, donorcond, - imp_var, imp_suffix) -} - -hotdeck_work <- function(x , variable=NULL, ord_var=NULL,domain_var=NULL, +hotdeck <- function(data , variable=NULL, ord_var=NULL,domain_var=NULL, makeNA=NULL,NAcond=NULL,impNA=TRUE,donorcond=NULL, imp_var=TRUE,imp_suffix="imp" ){ + check_data(data) OriginalSortingVariable <- impvar <- NULL #empty init if(is.null(variable)){ - variable <- colnames(x) + variable <- colnames(data) variable<-variable[!variable%in%c(ord_var,domain_var)] } if(!is.null(makeNA)){ if(!is.list(makeNA)||!length(makeNA)==length(variable)) stop("makeNA is not defined correctly. \n It should be a list of length equal to the length of the argument 'variable'.") } - classx <- class(x) - VariableSorting <- colnames(x) - x$OriginalSortingVariable <- 1:nrow(x) - x <- data.table(x) + classx <- class(data) + VariableSorting <- colnames(data) + data$OriginalSortingVariable <- 1:nrow(data) + data <- data.table(data) if(is.null(variable)){ - variable <- colnames(x)[apply(is.na(x),2,any)] + variable <- colnames(data)[apply(is.na(data),2,any)] } if(!is.null(NAcond)) warning("NAcond is not implemented yet and will be ignored.") @@ -228,37 +191,37 @@ hotdeck_work <- function(x , variable=NULL, ord_var=NULL,domain_var=NULL, cl <- class(x) return(cl[cl!="labelled"]) } - varType <- sapply(x,classWithoutLabelled)[variable] + varType <- sapply(data,classWithoutLabelled)[variable] if(imp_var){ for(v in variable){ - x[,impvar:=FALSE] + data[,impvar:=FALSE] impvarname <- paste(v,"_",imp_suffix,sep="") - setnames(x,"impvar",impvarname) + setnames(data,"impvar",impvarname) VariableSorting <- c(VariableSorting,impvarname) } } # If no ord_var is defined, a random ordered will be used if(is.null(ord_var)){ RandomVariableForImputationWithHotdeck <- NULL # Init for CRAN check - nrowXforRunif <- nrow(x) - x[,RandomVariableForImputationWithHotdeck:=runif(nrowXforRunif)] + nrowXforRunif <- nrow(data) + data[,RandomVariableForImputationWithHotdeck:=runif(nrowXforRunif)] ord_var <- "RandomVariableForImputationWithHotdeck" } - setkeyv(x,ord_var) + setkeyv(data,ord_var) # if no domain_var is defined, the imputeHD function is automatically called on the # whole data set - x <- x[,imputeHD(.SD,variableX=variable,varTypeX=varType, + data <- data[,imputeHD(.SD,variableX=variable,varTypeX=varType, imp_varX=imp_var,imp_suffixX=imp_suffix,impNAX=impNA,makeNAX=makeNA), by = domain_var] if(any(ord_var=="RandomVariableForImputationWithHotdeck")){ - x[,RandomVariableForImputationWithHotdeck:=NULL] + data[,RandomVariableForImputationWithHotdeck:=NULL] ord_var <- NULL } - setkey(x,OriginalSortingVariable) - x[,OriginalSortingVariable:=NULL] + setkey(data,OriginalSortingVariable) + data[,OriginalSortingVariable:=NULL] if(all(classx!="data.table")) - return(as.data.frame(x)[,VariableSorting,drop=FALSE]) - return(x[,VariableSorting,with=FALSE]) + return(as.data.frame(data)[,VariableSorting,drop=FALSE]) + return(data[,VariableSorting,with=FALSE]) } #require(data.table) #setwd("/Users/alex") diff --git a/R/irmi.R b/R/irmi.R index ed965b1..46385a4 100644 --- a/R/irmi.R +++ b/R/irmi.R @@ -88,75 +88,17 @@ #' td$c1 <- as.ordered(td$c1) #' irmi(td) #' -#' @export irmi +#' @export irmi <- function(x, eps=5, maxit=100, mixed=NULL,mixed.constant=NULL, count=NULL, step=FALSE, robust=FALSE, takeAll=TRUE, noise=TRUE, noise.factor=1, force=FALSE, robMethod="MM", force.mixed=TRUE, mi=1, addMixedFactors=FALSE, trace=FALSE,init.method="kNN",modelFormulas=NULL,multinom.method="multinom", imp_var=TRUE,imp_suffix="imp") { - UseMethod("irmi", x) -} - -#' @rdname irmi -#' @export - -irmi.data.frame <- function(x, eps=5, maxit=100, mixed=NULL,mixed.constant=NULL, count=NULL, step=FALSE, - robust=FALSE, takeAll=TRUE, - noise=TRUE, noise.factor=1, force=FALSE, - robMethod="MM", force.mixed=TRUE, mi=1, - addMixedFactors=FALSE, trace=FALSE,init.method="kNN",modelFormulas=NULL, - multinom.method="multinom",imp_var=TRUE,imp_suffix="imp") { - irmi_work(x, eps, maxit, mixed, mixed.constant, count, step, - robust, takeAll, noise, noise.factor, force, - robMethod, force.mixed, mi, addMixedFactors, - trace,init.method,modelFormulas=modelFormulas,multinom.method=multinom.method, - imp_var=imp_var,imp_suffix=imp_suffix) -} - -#' @rdname irmi -#' @export - -irmi.survey.design <- function(x, eps=5, maxit=100, mixed=NULL,mixed.constant=NULL, count=NULL, step=FALSE, - robust=FALSE, takeAll=TRUE, - noise=TRUE, noise.factor=1, force=FALSE, - robMethod="MM", force.mixed=TRUE, mi=1, - addMixedFactors=FALSE, trace=FALSE,init.method="kNN",modelFormulas=NULL, - multinom.method="multinom",imp_var=TRUE,imp_suffix="imp") { - x$variables <- irmi_work(x$variables, eps, maxit, mixed, mixed.constant, count, step, - robust, takeAll, noise, noise.factor, force, - robMethod, force.mixed, mi, addMixedFactors, - trace,init.method,modelFormulas=modelFormulas, - multinom.method=multinom.method,imp_var=imp_var,imp_suffix=imp_suffix) - x$call <- sys.call(-1) - x -} - -#' @rdname irmi -#' @export - -irmi.default <- function(x, eps=5, maxit=100, mixed=NULL,mixed.constant=NULL, count=NULL, step=FALSE, - robust=FALSE, takeAll=TRUE, - noise=TRUE, noise.factor=1, force=FALSE, - robMethod="MM", force.mixed=TRUE, mi=1, - addMixedFactors=FALSE, trace=FALSE,init.method="kNN",modelFormulas=NULL, - multinom.method="multinom",imp_var=TRUE,imp_suffix="imp") { - irmi_work(as.data.frame(x), eps, maxit, mixed, mixed.constant, count, step, - robust, takeAll, noise, noise.factor, force, - robMethod, force.mixed, mi, addMixedFactors, - trace,init.method,modelFormulas=modelFormulas, - multinom.method=multinom.method,imp_var=imp_var,imp_suffix=imp_suffix) -} - -`irmi_work` <- function(x, eps=5, maxit=100, mixed=NULL,mixed.constant=NULL, count=NULL, step=FALSE, - robust=FALSE, takeAll=TRUE, - noise=TRUE, noise.factor=1, force=FALSE, - robMethod="MM", force.mixed=TRUE, mi=1, - addMixedFactors=FALSE, trace=FALSE,init.method="kNN",modelFormulas=NULL, - multinom.method="multinom",imp_var=TRUE,imp_suffix="imp"){ #Authors: Alexander Kowarik and Matthias Templ, Statistics Austria, GPL 2 or newer, version: 15. Nov. 2012 #object mixed conversion into the right format (vector of variable names of type mixed) #TODO: Data sets with variables "y" might fail + check_data(x) if(trace){ message("Method for multinomial models:",multinom.method,"\n") } diff --git a/R/kNNFaster.R b/R/kNN.R similarity index 84% rename from R/kNNFaster.R rename to R/kNN.R index c711a03..a8e3bf5 100644 --- a/R/kNNFaster.R +++ b/R/kNN.R @@ -1,3 +1,40 @@ +lengthL <- function(x){ + if(is.list(x)){ + return(sapply(x,length)) + }else{ + return(length(x)) + } +} + +dist_single <- function(don_dist_var,imp_dist_var,numericalX,factorsX,ordersX,mixedX,levOrdersX, + don_index,imp_index,weightsx,k,mixed.constant,provideMins=TRUE){ + #gd <- distance(don_dist_var,imp_dist_var,weights=weightsx) + if(is.null(mixed.constant)) + mixed.constant <- rep(0,length(mixedX)) + + if(provideMins){ + gd <- gowerD(don_dist_var,imp_dist_var,weights=weightsx,numericalX, + factorsX,ordersX,mixedX,levOrdersX,mixed.constant=mixed.constant,returnIndex=TRUE, + nMin=as.integer(k),returnMin=TRUE); + colnames(gd$mins) <- imp_index + erg2 <- as.matrix(gd$mins) + }else{ + gd <- gowerD(don_dist_var,imp_dist_var,weights=weightsx,numericalX, + factorsX,ordersX,mixedX,levOrdersX,mixed.constant=mixed.constant,returnIndex=TRUE, + nMin=as.integer(k)); + erg2 <- NA + } + colnames(gd$ind) <- imp_index + gd$ind[,] <- don_index[gd$ind] + erg <- as.matrix(gd$ind) + + if(k==1){ + erg <- t(erg) + erg2 <- t(erg2) + } + list(erg,erg2) +} + ####Hotdeck in context of kNN-k Nearest Neighbour Imputation #Author: Alexander Kowarik, Statistics Austria ## (k)NN-Imputation @@ -71,106 +108,20 @@ #' library(laeken) #' kNN(sleep, numFun = weightedMean, weightDist=TRUE) #' -#' @export kNN +#' @export kNN <- function(data, variable=colnames(data), metric=NULL, k=5, dist_var=colnames(data),weights=NULL, numFun = median, catFun=maxCat, makeNA=NULL,NAcond=NULL, impNA=TRUE, donorcond=NULL,mixed=vector(),mixed.constant=NULL,trace=FALSE, imp_var=TRUE,imp_suffix="imp", addRF=FALSE, onlyRF=FALSE,addRandom=FALSE,useImputedDist=TRUE,weightDist=FALSE) { - UseMethod("kNN", data) -} - -#' @rdname kNN -#' @export - -kNN.data.table <- function(data, variable=colnames(data), metric=NULL, k=5, dist_var=colnames(data),weights=NULL, - numFun = median, catFun=maxCat, - makeNA=NULL,NAcond=NULL, impNA=TRUE, donorcond=NULL,mixed=vector(),mixed.constant=NULL,trace=FALSE, - imp_var=TRUE,imp_suffix="imp", addRF=FALSE, onlyRF=FALSE, addRandom=FALSE,useImputedDist=TRUE,weightDist=FALSE) { - kNN_work(copy(data), variable, metric, k, dist_var,weights, numFun, catFun, - makeNA, NAcond, impNA, donorcond, mixed, mixed.constant, trace, - imp_var, imp_suffix, addRF, onlyRF, addRandom,useImputedDist,weightDist) -} - -#' @rdname kNN -#' @export - -kNN.data.frame <- function(data, variable=colnames(data), metric=NULL, k=5, dist_var=colnames(data),weights=NULL, - numFun = median, catFun=maxCat, - makeNA=NULL,NAcond=NULL, impNA=TRUE, donorcond=NULL,mixed=vector(),mixed.constant=NULL,trace=FALSE, - imp_var=TRUE,imp_suffix="imp", addRF=FALSE, onlyRF=FALSE, addRandom=FALSE,useImputedDist=TRUE,weightDist=FALSE) { - as.data.frame(kNN_work(as.data.table(data), variable, metric, k, dist_var,weights, numFun, catFun, - makeNA, NAcond, impNA, donorcond, mixed, mixed.constant, trace, - imp_var, imp_suffix, addRF, onlyRF, addRandom,useImputedDist,weightDist)) -} - -#' @rdname kNN -#' @export - -kNN.survey.design <- function(data, variable=colnames(data), metric=NULL, k=5, dist_var=colnames(data),weights=NULL, - numFun = median, catFun=maxCat, - makeNA=NULL,NAcond=NULL, impNA=TRUE, donorcond=NULL,mixed=vector(),mixed.constant=NULL,trace=FALSE, - imp_var=TRUE,imp_suffix="imp", addRF=FALSE, onlyRF=FALSE, addRandom=FALSE,useImputedDist=TRUE,weightDist=FALSE) { - data$variables <- kNN_work(data$variables, variable, metric, k, dist_var,weights, numFun, catFun, - makeNA, NAcond, impNA, donorcond, mixed, mixed.constant, trace, - imp_var, imp_suffix, addRF, onlyRF,addRandom,useImputedDist,weightDist) - data$call <- sys.call(-1) - data -} - -#' @rdname kNN -#' @export - -kNN.default <- function(data, variable=colnames(data), metric=NULL, k=5, dist_var=colnames(data),weights=NULL, - numFun = median, catFun=maxCat, - makeNA=NULL,NAcond=NULL, impNA=TRUE, donorcond=NULL,mixed=vector(),mixed.constant=NULL,trace=FALSE, - imp_var=TRUE,imp_suffix="imp", addRF=FALSE, onlyRF=FALSE, addRandom=FALSE,useImputedDist=TRUE,weightDist=FALSE) { - kNN_work(as.data.table(data), variable, metric, k, dist_var,weights, numFun, catFun, - makeNA, NAcond, impNA, donorcond, mixed, mixed.constant, trace, - imp_var, imp_suffix, addRF, onlyRF, addRandom,useImputedDist,weightDist) -} -lengthL <- function(x){ - if(is.list(x)){ - return(sapply(x,length)) - }else{ - return(length(x)) - } -} - - - -dist_single <- function(don_dist_var,imp_dist_var,numericalX,factorsX,ordersX,mixedX,levOrdersX, - don_index,imp_index,weightsx,k,mixed.constant,provideMins=TRUE){ - #gd <- distance(don_dist_var,imp_dist_var,weights=weightsx) - if(is.null(mixed.constant)) - mixed.constant <- rep(0,length(mixedX)) - - if(provideMins){ - gd <- gowerD(don_dist_var,imp_dist_var,weights=weightsx,numericalX, - factorsX,ordersX,mixedX,levOrdersX,mixed.constant=mixed.constant,returnIndex=TRUE, - nMin=as.integer(k),returnMin=TRUE); - colnames(gd$mins) <- imp_index - erg2 <- as.matrix(gd$mins) - }else{ - gd <- gowerD(don_dist_var,imp_dist_var,weights=weightsx,numericalX, - factorsX,ordersX,mixedX,levOrdersX,mixed.constant=mixed.constant,returnIndex=TRUE, - nMin=as.integer(k)); - erg2 <- NA + check_data(data) + data_df <- !is.data.table(data) + force(variable) + force(dist_var) + if (data_df) { + data <- as.data.table(data) + } else { + data <- data.table::copy(data) } - colnames(gd$ind) <- imp_index - gd$ind[,] <- don_index[gd$ind] - erg <- as.matrix(gd$ind) - - if(k==1){ - erg <- t(erg) - erg2 <- t(erg2) - } - list(erg,erg2) -} -kNN_work <- - function(data, variable=colnames(data), metric=NULL, k=5, dist_var=colnames(data),weights=NULL, - numFun = median, catFun=maxCat, - makeNA=NULL,NAcond=NULL, impNA=TRUE, donorcond=NULL,mixed=vector(),mixed.constant=NULL,trace=FALSE, - imp_var=TRUE,imp_suffix="imp",addRF=FALSE, onlyRF=FALSE ,addRandom=FALSE,useImputedDist=TRUE,weightDist=FALSE){ #basic checks if(!is.null(mixed.constant)){ if(length(mixed.constant)!=length(mixed)) @@ -232,6 +183,8 @@ kNN_work <- } if(length(variable)==0){ warning(paste("Nothing is imputed, because all variables to be imputed only contains missings.")) + if (data_df) + data <- as.data.frame(data) return(data) } orders <- data[,sapply(.SD,is.ordered)] @@ -488,5 +441,7 @@ kNN_work <- if(!is.null(features_added)){ data[,c(features_added):=NULL] } + if (data_df) + data <- as.data.frame(data) data } diff --git a/R/mapMiss.R b/R/mapMiss.R index e69c139..e7241e5 100644 --- a/R/mapMiss.R +++ b/R/mapMiss.R @@ -64,51 +64,13 @@ #' x_imp <- kNN(chorizonDL[, c("As", "Bi")]) #' mapMiss(x_imp, coo, kola.background, delimiter = "_imp") #' -#' @export mapMiss +#' @export mapMiss <- function(x, coords, map, delimiter = NULL, selection = c("any","all"), col = c("skyblue","red","orange"), alpha = NULL, pch = c(19,15), col.map = grey(0.5), legend = TRUE, interactive = TRUE, ...) { - UseMethod("mapMiss", x) -} - -#' @rdname mapMiss -#' @export - -mapMiss.data.frame <- function(x, coords, map, delimiter = NULL, selection = c("any","all"), - col = c("skyblue","red","orange"), alpha = NULL, - pch = c(19,15), col.map = grey(0.5), - legend = TRUE, interactive = TRUE, ...) { - mapMiss_work(x, coords, map, delimiter, selection, col, alpha, pch, col.map, - legend, interactive,...) -} - -#' @rdname mapMiss -#' @export - -mapMiss.survey.design <- function(x, coords, map, delimiter = NULL, selection = c("any","all"), - col = c("skyblue","red","orange"), alpha = NULL, - pch = c(19,15), col.map = grey(0.5), - legend = TRUE, interactive = TRUE, ...) { - mapMiss_work(x$variables, coords, map, delimiter, selection, col, alpha, pch, col.map, - legend, interactive,...) -} - -#' @rdname mapMiss -#' @export - -mapMiss.default <- function(x, coords, map, delimiter = NULL, selection = c("any","all"), - col = c("skyblue","red","orange"), alpha = NULL, - pch = c(19,15), col.map = grey(0.5), - legend = TRUE, interactive = TRUE, ...) { - mapMiss_work(as.data.frame(x), coords, map, delimiter, selection, col, alpha, pch, col.map, - legend, interactive,...) -} - -mapMiss_work <- function(x, coords, map, delimiter = NULL, selection = c("any","all"), - col = c("skyblue","red","orange"), alpha = NULL, - pch = c(19,15), col.map = grey(0.5), - legend = TRUE, interactive = TRUE, ...) { + check_data(x) + x <- as.data.frame(x) # error messages imputed <- FALSE # indicates if there are Variables with missing-index if(is.vector(x)) { diff --git a/R/marginmatrix.R b/R/marginmatrix.R index 5ba84d2..0d170de 100644 --- a/R/marginmatrix.R +++ b/R/marginmatrix.R @@ -62,42 +62,12 @@ #' x_imp[,c(1,2,4)] <- log10(x_imp[,c(1,2,4)]) #' marginmatrix(x_imp, delimiter = "_imp") #' -#' @export marginmatrix +#' @export marginmatrix <- function(x, delimiter = NULL, col = c("skyblue","red","red4","orange","orange4"), alpha = NULL, ...) { - UseMethod("marginmatrix", x) -} - -#' @rdname marginmatrix -#' @export - -marginmatrix.data.frame <- function(x, delimiter = NULL, - col = c("skyblue","red","red4","orange","orange4"), - alpha = NULL, ...) { - marginmatrix_work(x, delimiter, col,alpha, ...) -} - -#' @rdname marginmatrix -#' @export - -marginmatrix.survey.design <- function(x, delimiter = NULL, - col = c("skyblue","red","red4","orange","orange4"), - alpha = NULL, ...) { - marginmatrix_work(x$variables, delimiter, col,alpha, ...) -} - -#' @rdname marginmatrix -#' @export - -marginmatrix.default <- function(x, delimiter = NULL, - col = c("skyblue","red","red4","orange","orange4"), - alpha = NULL, ...) { - marginmatrix_work(as.data.frame(x), delimiter, col,alpha, ...) -} - -marginmatrix_work <- function(x, delimiter = NULL, col = c("skyblue","red","red4","orange","orange4"), - alpha = NULL, ...) { + check_data(x) + x <- as.data.frame(x) panel.marginplot <- function(x, y, ...) { par(new=TRUE) localMarginplot <- function(..., numbers, diff --git a/R/matchImpute.R b/R/matchImpute.R index 3ea601c..e82c6f1 100644 --- a/R/matchImpute.R +++ b/R/matchImpute.R @@ -1,3 +1,21 @@ +primitive.impute <- function(x){ + x.na <- is.na(x) + if(all(!x.na)|all(x.na)){ + return(x) + } + # if(all(x.na)){ + # warning("no donors present in subsample") + # return(x) + # } + n.imp <- sum(x.na) + if(length(x[!x.na])>1){ + x[x.na] <- sample(x[!x.na],n.imp,replace=TRUE) + }else{ + x[x.na] <- x[!x.na] + } + return(x) +} + #' Fast matching/imputation based on categorical variable #' #' Suitable donors are searched based on matching of the categorical variables. @@ -7,7 +25,7 @@ #' The method works by sampling values from the suitable donors. #' #' @aliases matchImpute -#' @param data data.frame, data.table, survey object or matrix +#' @param data data.frame, data.table or matrix #' @param variable variables to be imputed #' @param match_var variables used for matching #' @param imp_var TRUE/FALSE if a TRUE/FALSE variables for each imputed @@ -32,63 +50,15 @@ #' imp_testdata2 <- matchImpute(dt,match_var=c("c1","c2","b1","b2")) # working function -#' @export matchImpute -matchImpute <- function(data,variable=colnames(data)[!colnames(data)%in%match_var],match_var, imp_var=TRUE, - imp_suffix="imp") { - UseMethod("matchImpute", data) -} - -#' @rdname matchImpute -#' @export - -matchImpute.data.frame <- function(data,variable=colnames(data)[!colnames(data)%in%match_var],match_var, imp_var=TRUE, - imp_suffix="imp") { - as.data.frame(matchImpute.default(data.table(data), variable, match_var, imp_var, imp_suffix)) -} - -#' @rdname matchImpute -#' @export - -matchImpute.data.table <- function(data,variable=colnames(data)[!colnames(data)%in%match_var],match_var, imp_var=TRUE, - imp_suffix="imp") { - matchImpute.default(copy(data), variable, match_var, imp_var, imp_suffix) -} - -#' @rdname matchImpute -#' @export - -matchImpute.survey.design <- function(data,variable=colnames(data$variables)[!colnames(data$variables)%in%match_var],match_var, imp_var=TRUE, - imp_suffix="imp") { - data$variables <- matchImpute.default(data.table(data$variables), variable, - match_var, imp_var, imp_suffix) - data$call <- sys.call(-1) - data -} -primitive.impute <- function(x){ - x.na <- is.na(x) - if(all(!x.na)|all(x.na)){ - return(x) - } - # if(all(x.na)){ - # warning("no donors present in subsample") - # return(x) - # } - n.imp <- sum(x.na) - if(length(x[!x.na])>1){ - x[x.na] <- sample(x[!x.na],n.imp,replace=TRUE) - }else{ - x[x.na] <- x[!x.na] - } - return(x) -} -# main function -# imp_var can only be a single collumn (yet) - -#' @rdname matchImpute #' @export - -matchImpute.default <- function(data,variable=colnames(data)[!colnames(data)%in%match_var],match_var, imp_var=TRUE, +matchImpute <- function(data,variable=colnames(data)[!colnames(data)%in%match_var],match_var, imp_var=TRUE, imp_suffix="imp"){ + check_data(data) + is_df <- !is.data.table(data) + if (is_df) + data <- as.data.table(data) + else + data <- data.table::copy(data) na_present <- data[,sum(sapply(lapply(.SD,is.na),sum)),.SDcols=variable] if(imp_var){ @@ -114,6 +84,8 @@ matchImpute.default <- function(data,variable=colnames(data)[!colnames(data)%in% count_missings <- rbind(count_missings,c(j,na_present)) } attr(data,"count_missings") <- count_missings + if (is_df) + data <- as.data.frame(data) return(data) } diff --git a/R/matrixplot.R b/R/matrixplot.R index ba71e61..d99475f 100644 --- a/R/matrixplot.R +++ b/R/matrixplot.R @@ -94,65 +94,16 @@ #' x_imp[,c(1,2,4,6,7)] <- log10(x_imp[,c(1,2,4,6,7)]) #' matrixplot(x_imp, delimiter = "_imp", sortby = "BrainWgt") #' -#' @export matrixplot +#' @export matrixplot <- function(x, delimiter = NULL, sortby = NULL, col = c("red","orange"), fixup = TRUE, xlim = NULL, ylim = NULL, main = NULL, sub = NULL, xlab = NULL, ylab = NULL, axes = TRUE, labels = axes, xpd = NULL, interactive = TRUE, ...) { - UseMethod("matrixplot", x) -} - -#' @rdname matrixplot -#' @export - -matrixplot.data.frame <- function(x, delimiter = NULL, sortby = NULL, - col = c("red","orange"), - fixup = TRUE, xlim = NULL, ylim = NULL, - main = NULL, sub = NULL, xlab = NULL, - ylab = NULL, axes = TRUE, labels = axes, - xpd = NULL, interactive = TRUE, ...) { - matrixplot_work(x, delimiter, sortby, col, fixup, xlim, ylim, - main, sub, xlab, ylab, axes, labels, xpd, interactive, ...) -} - -#' @rdname matrixplot -#' @export - -matrixplot.survey.design <- function(x, delimiter = NULL, sortby = NULL, - col = c("red","orange"), - fixup = TRUE, xlim = NULL, ylim = NULL, - main = NULL, sub = NULL, xlab = NULL, - ylab = NULL, axes = TRUE, labels = axes, - xpd = NULL, interactive = TRUE, ...) { - matrixplot_work(x$variables, delimiter, sortby, col, fixup, xlim, ylim, - main, sub, xlab, ylab, axes, labels, xpd, interactive, ...) -} - -#' @rdname matrixplot -#' @export - -matrixplot.default <- function(x, delimiter = NULL, sortby = NULL, - col = c("red","orange"), - fixup = TRUE, xlim = NULL, ylim = NULL, - main = NULL, sub = NULL, xlab = NULL, - ylab = NULL, axes = TRUE, labels = axes, - xpd = NULL, interactive = TRUE, ...) { - matrixplot_work(as.data.frame(x), delimiter, sortby, col, fixup, xlim, ylim, - main, sub, xlab, ylab, axes, labels, xpd, interactive, ...) -} - -matrixplot_work <- function(x, delimiter = NULL, sortby = NULL, - col = c("red","orange"), - #space = c("rgb", "hcl"), - fixup = TRUE, xlim = NULL, ylim = NULL, - main = NULL, sub = NULL, xlab = NULL, - ylab = NULL, axes = TRUE, labels = axes, - xpd = NULL, interactive = TRUE, ...) { + check_data(x) + x <- as.data.frame(x) # initializations and error messages - if(!(inherits(x, c("data.frame","matrix")))) - stop("'x' must be a data.frame or matrix") imputed <- FALSE # indicates if there are Variables with missing-index ## delimiter ## if(!is.null(delimiter)) { diff --git a/R/mosaicMiss.R b/R/mosaicMiss.R index 4a331bd..a902529 100644 --- a/R/mosaicMiss.R +++ b/R/mosaicMiss.R @@ -69,47 +69,13 @@ #' mosaicMiss(kNN(sleep), highlight = 4, #' plotvars = 8:10, delimiter = "_imp", miss.labels = FALSE) #' -#' @export mosaicMiss +#' @export mosaicMiss <- function(x, delimiter = NULL, highlight = NULL, selection = c("any","all"), plotvars = NULL, col = c("skyblue","red","orange"), labels = NULL, miss.labels = TRUE, ...) { - UseMethod("mosaicMiss", x) -} - -#' @rdname mosaicMiss -#' @export - -mosaicMiss.data.frame <- function(x, delimiter = NULL, highlight = NULL, selection = c("any","all"), - plotvars = NULL, col = c("skyblue","red","orange"), - labels = NULL, miss.labels = TRUE, ...) { - mosaicMiss_work(x, delimiter, highlight, selection, plotvars, col, labels, miss.labels, ...) -} - -#' @rdname mosaicMiss -#' @export - -mosaicMiss.survey.design <- function(x, delimiter = NULL, highlight = NULL, selection = c("any","all"), - plotvars = NULL, col = c("skyblue","red","orange"), - labels = NULL, miss.labels = TRUE, ...) { - mosaicMiss_work(x$variables, delimiter, highlight, selection, plotvars, col, labels, miss.labels, ...) -} - -#' @rdname mosaicMiss -#' @export - -mosaicMiss.default <- function(x, delimiter = NULL, highlight = NULL, selection = c("any","all"), - plotvars = NULL, col = c("skyblue","red","orange"), - labels = NULL, miss.labels = TRUE, ...) { - mosaicMiss_work(as.data.frame(x), delimiter, highlight, selection, plotvars, col, labels, miss.labels, ...) -} - -mosaicMiss_work <- function(x, delimiter = NULL, highlight = NULL, selection = c("any","all"), - plotvars = NULL, col = c("skyblue","red","orange"), - labels = NULL, miss.labels = TRUE, ...) { + check_data(x) + x <- as.data.frame(x) # initializations and error messages - if(!(inherits(x, c("data.frame","matrix")))) { - stop("'x' must be a data.frame or matrix") - } imputed <- FALSE # indicates if there are Variables with missing-index ## delimiter ## if(!is.null(delimiter)) { diff --git a/R/parcoordMiss.R b/R/parcoordMiss.R index 59e7360..dc887ce 100644 --- a/R/parcoordMiss.R +++ b/R/parcoordMiss.R @@ -117,7 +117,7 @@ #' legend("top", col = c("skyblue", "orange"), lwd = c(1,1), #' legend = c("observed in Bi", "imputed in Bi")) #' -#' @export parcoordMiss +#' @export parcoordMiss <- function(x, delimiter = NULL, highlight = NULL, selection = c("any","all"), plotvars = NULL, plotNA = TRUE, col = c("skyblue","red","skyblue4","red4","orange","orange4"), @@ -125,65 +125,9 @@ parcoordMiss <- function(x, delimiter = NULL, highlight = NULL, selection = c("a ylim = NULL, main = NULL, sub = NULL, xlab = NULL, ylab = NULL, labels = TRUE, xpd = NULL, interactive = TRUE, ...) { - UseMethod("parcoordMiss", x) -} - -#' @rdname parcoordMiss -#' @export - -parcoordMiss.data.frame <- function(x, delimiter = NULL, highlight = NULL, selection = c("any","all"), - plotvars = NULL, plotNA = TRUE, - col = c("skyblue","red","skyblue4","red4","orange","orange4"), - alpha = NULL, lty = par("lty"), xlim = NULL, - ylim = NULL, main = NULL, sub = NULL, - xlab = NULL, ylab = NULL, labels = TRUE, - xpd = NULL, interactive = TRUE, ...) { - parcoordMiss_work(x, delimiter, highlight, selection, plotvars, plotNA, col, - alpha, lty, xlim, ylim, main, sub, xlab, ylab, labels, - xpd, interactive, ...) -} - -#' @rdname parcoordMiss -#' @export - -parcoordMiss.survey.design <- function(x, delimiter = NULL, highlight = NULL, selection = c("any","all"), - plotvars = NULL, plotNA = TRUE, - col = c("skyblue","red","skyblue4","red4","orange","orange4"), - alpha = NULL, lty = par("lty"), xlim = NULL, - ylim = NULL, main = NULL, sub = NULL, - xlab = NULL, ylab = NULL, labels = TRUE, - xpd = NULL, interactive = TRUE, ...) { - parcoordMiss_work(x$variables, delimiter, highlight, selection, plotvars, plotNA, col, - alpha, lty, xlim, ylim, main, sub, xlab, ylab, labels, - xpd, interactive, ...) -} - -#' @rdname parcoordMiss -#' @export - -parcoordMiss.default <- function(x, delimiter = NULL, highlight = NULL, selection = c("any","all"), - plotvars = NULL, plotNA = TRUE, - col = c("skyblue","red","skyblue4","red4","orange","orange4"), - alpha = NULL, lty = par("lty"), xlim = NULL, - ylim = NULL, main = NULL, sub = NULL, - xlab = NULL, ylab = NULL, labels = TRUE, - xpd = NULL, interactive = TRUE, ...) { - parcoordMiss_work(as.data.frame(x), delimiter, highlight, selection, plotvars, plotNA, col, - alpha, lty, xlim, ylim, main, sub, xlab, ylab, labels, - xpd, interactive, ...) -} - -parcoordMiss_work <- function(x, delimiter = NULL, highlight = NULL, selection = c("any","all"), - plotvars = NULL, plotNA = TRUE, - col = c("skyblue","red","skyblue4","red4","orange","orange4"), - alpha = NULL, lty = par("lty"), xlim = NULL, - ylim = NULL, main = NULL, sub = NULL, - xlab = NULL, ylab = NULL, labels = TRUE, - xpd = NULL, interactive = TRUE, ...) { + check_data(x) + x <- as.data.frame(x) # initializations and error messages - if(!(inherits(x, c("data.frame","matrix")))) { - stop("'x' must be a data.frame or matrix") - } imputed <- FALSE # indicates if there are Variables with missing-index ## delimiter ## if(!is.null(delimiter)) { diff --git a/R/pbox.R b/R/pbox.R index be2e9af..9fe5240 100644 --- a/R/pbox.R +++ b/R/pbox.R @@ -94,62 +94,15 @@ #' pbox(kNN(log(chorizonDL[, c(4,8,10,11,17,19,25,29,37,38,40)])), #' delimiter = "_imp") #' -#' @export pbox +#' @export pbox <- function(x, delimiter = NULL, pos = 1, selection = c("none","any","all"), col = c("skyblue","red","red4","orange","orange4"), numbers = TRUE, cex.numbers = par("cex"), xlim = NULL, ylim = NULL, main = NULL, sub = NULL, xlab = NULL, ylab = NULL, axes = TRUE, frame.plot = axes, labels = axes, interactive = TRUE, ...) { - UseMethod("pbox", x) -} - -#' @rdname pbox -#' @export - -pbox.data.frame <- function(x, delimiter = NULL, pos = 1, selection = c("none","any","all"), - col = c("skyblue","red","red4","orange","orange4"), numbers = TRUE, - cex.numbers = par("cex"), xlim = NULL, ylim = NULL, - main = NULL, sub = NULL, xlab = NULL, ylab = NULL, - axes = TRUE, frame.plot = axes, labels = axes, - interactive = TRUE, ...) { - pbox_work(x, delimiter, pos, selection, col, numbers, cex.numbers, xlim, ylim, main, sub, - xlab, ylab, axes, frame.plot, labels, interactive, ...) -} - -#' @rdname pbox -#' @export - -pbox.survey.design <- function(x, delimiter = NULL, pos = 1, selection = c("none","any","all"), - col = c("skyblue","red","red4","orange","orange4"), numbers = TRUE, - cex.numbers = par("cex"), xlim = NULL, ylim = NULL, - main = NULL, sub = NULL, xlab = NULL, ylab = NULL, - axes = TRUE, frame.plot = axes, labels = axes, - interactive = TRUE, ...) { - pbox_work(x$variables, delimiter, pos, selection, col, numbers, cex.numbers, xlim, ylim, main, sub, - xlab, ylab, axes, frame.plot, labels, interactive, ...) -} - -#' @rdname pbox -#' @export - -pbox.default <- function(x, delimiter = NULL, pos = 1, selection = c("none","any","all"), - col = c("skyblue","red","red4","orange","orange4"), numbers = TRUE, - cex.numbers = par("cex"), xlim = NULL, ylim = NULL, - main = NULL, sub = NULL, xlab = NULL, ylab = NULL, - axes = TRUE, frame.plot = axes, labels = axes, - interactive = TRUE, ...) { - pbox_work(as.data.frame(x), delimiter, pos, selection, col, numbers, cex.numbers, xlim, ylim, main, sub, - xlab, ylab, axes, frame.plot, labels, interactive, ...) -} - -pbox_work <- function(x, delimiter = NULL, pos = 1, selection = c("none","any","all"), - col = c("skyblue","red","red4","orange","orange4"), numbers = TRUE, - cex.numbers = par("cex"), xlim = NULL, ylim = NULL, - main = NULL, sub = NULL, xlab = NULL, ylab = NULL, - axes = TRUE, frame.plot = axes, labels = axes, - interactive = TRUE, ...) { - + check_data(x) + x <- as.data.frame(x) # initializations and error messages imputed <- FALSE # indicates if there are Variables with missing-index if(is.null(dim(x))) { # vector diff --git a/R/prepare.R b/R/prepare.R index 247a484..430a730 100644 --- a/R/prepare.R +++ b/R/prepare.R @@ -58,56 +58,13 @@ #' x <- sleep[, c("BodyWgt", "BrainWgt")] #' prepare(x, scaling = "robust", transformation = "logarithm") #' -#' @export prepare -#' @usage -#' prepare (x, scaling = c("none","classical","MCD","robust","onestep"), -#' transformation = c("none","minus","reciprocal","logarithm", -#' "exponential","boxcox","clr","ilr","alr"), -#' alpha = NULL, powers = NULL, start = 0, alrVar) +#' @export prepare <- function(x, scaling = c("none","classical","MCD","robust","onestep"), transformation = c("none","minus","reciprocal","logarithm", "exponential","boxcox","clr","ilr","alr"), alpha = NULL, powers = NULL, start = 0, alrVar) { - UseMethod("prepare", x) -} - -#' @rdname prepare -#' @export - -prepare.data.frame <- function(x, scaling = c("none","classical","MCD","robust","onestep"), - transformation = c("none","minus","reciprocal","logarithm", - "exponential","boxcox","clr","ilr","alr"), - alpha = NULL, powers = NULL, start = 0, alrVar) { - as.data.frame(prepare_work(x, scaling, transformation, alpha, powers, start, alrVar)) -} - -#' @rdname prepare -#' @export - -prepare.survey.design <- function(x, scaling = c("none","classical","MCD","robust","onestep"), - transformation = c("none","minus","reciprocal","logarithm", - "exponential","boxcox","clr","ilr","alr"), - alpha = NULL, powers = NULL, start = 0, alrVar) { - x$variables <- as.data.frame(prepare_work(x$variables, scaling, transformation, alpha, powers, start, alrVar)) - x$call <- sys.call(-1) - x -} - -#' @rdname prepare -#' @export - -prepare.default <- function(x, scaling = c("none","classical","MCD","robust","onestep"), - transformation = c("none","minus","reciprocal","logarithm", - "exponential","boxcox","clr","ilr","alr"), - alpha = NULL, powers = NULL, start = 0, alrVar) { - prepare_work(as.data.frame(x), scaling, transformation, alpha, powers, start, alrVar) -} - -prepare_work <- function(x, - scaling = c("none","classical","MCD","robust","onestep"), - transformation = c("none","minus","reciprocal","logarithm", - "exponential","boxcox","clr","ilr","alr"), - alpha = NULL, powers = NULL, start = 0, alrVar) { + check_data(x) + x <- as.data.frame(x) if(is.data.frame(x)) x <- data.matrix(x) transformation <- match.arg(transformation) if(transformation != "none") { diff --git a/R/rangerImpute.R b/R/rangerImpute.R index 957c502..eeb720a 100644 --- a/R/rangerImpute.R +++ b/R/rangerImpute.R @@ -21,6 +21,7 @@ rangerImpute <- function(formula, data, imp_var = TRUE, imp_suffix = "imp", ..., verbose = FALSE, median = FALSE) { + check_data(data) formchar <- as.character(formula) lhs <- gsub(" ", "", strsplit(formchar[2], "\\+")[[1]]) rhs <- formchar[3] diff --git a/R/regressionImp.R b/R/regressionImp.R index 44ae9ff..ae19ad7 100644 --- a/R/regressionImp.R +++ b/R/regressionImp.R @@ -13,7 +13,7 @@ #' (robust=TRUE: [lmrob()], [glmrob()]) #' #' @param formula model formula to impute one variable -#' @param data A data.frame or survey object containing the data +#' @param data A data.frame containing the data #' @param family family argument for [glm()]. `"AUTO"` (the default) tries to choose #' automatically and is the only really tested option!!! #' @param robust `TRUE`/`FALSE` if robust regression should be used. See details. @@ -40,43 +40,10 @@ #' imp_testdata1 <- regressionImp(b1+b2~x1+x2,data=testdata$wna) #' imp_testdata3 <- regressionImp(x1~x2,data=testdata$wna,robust=TRUE) #' -#' @export regressionImp -regressionImp <- function(formula, data, family = "AUTO", robust = FALSE, imp_var = TRUE, - imp_suffix = "imp", mod_cat = FALSE) { - UseMethod("regressionImp", data) -} - -#' @rdname regressionImp -#' @export - -regressionImp.data.frame <- function(formula, data, family = "AUTO", robust = FALSE, imp_var = TRUE, - imp_suffix = "imp", mod_cat = FALSE) { - regressionImp_work(formula = formula, data = data, family = family, robust = robust, - imp_var = imp_var, imp_suffix = imp_suffix, mod_cat = mod_cat) -} - -#' @rdname regressionImp -#' @export - -regressionImp.survey.design <- function(formula, data, family, robust, imp_var = TRUE, - imp_suffix = "imp", mod_cat = FALSE) { - data$variables <- regressionImp_work(formula = formula, data = data$variables, family = family, - robust = robust, imp_var = imp_var, imp_suffix = imp_suffix, mod_cat = mod_cat) - data$call <- sys.call(-1) - data -} - -#' @rdname regressionImp #' @export - -regressionImp.default <- function(formula, data, family = "AUTO", robust = FALSE, imp_var = TRUE, - imp_suffix = "imp", mod_cat = FALSE) { - regressionImp_work(formula = formula, data = as.data.frame(data), family = family, - robust = robust, imp_var = imp_var, imp_suffix = imp_suffix, mod_cat = mod_cat) -} - -regressionImp_work <- function(formula, family, robust, data, imp_var, imp_suffix, mod_cat) { - +regressionImp <- function(formula, data, family = "AUTO", robust = FALSE, imp_var = TRUE, imp_suffix = "imp", mod_cat = FALSE) { + check_data(data) + data <- as.data.frame(data) formchar <- as.character(formula) lhs <- gsub(" ", "", strsplit(formchar[2], "\\+")[[1]]) rhs <- formchar[3] diff --git a/R/scattmatrixMiss.R b/R/scattmatrixMiss.R index 655624c..d4d5670 100644 --- a/R/scattmatrixMiss.R +++ b/R/scattmatrixMiss.R @@ -96,65 +96,16 @@ #' x_imp[,c(1,2,4)] <- log10(x_imp[,c(1,2,4)]) #' scattmatrixMiss(x_imp, delimiter = "_imp", highlight = "Dream") #' -#' @export scattmatrixMiss +#' @export scattmatrixMiss <- function(x, delimiter = NULL, highlight = NULL, selection = c("any","all"), plotvars = NULL, col = c("skyblue","red","orange"), alpha = NULL, pch = c(1,3), lty = par("lty"), diagonal = c("density","none"), interactive = TRUE, ...) { - UseMethod("scattmatrixMiss", x) -} - -#' @rdname scattmatrixMiss -#' @export - -scattmatrixMiss.data.frame <- function(x, delimiter = NULL, highlight = NULL, - selection = c("any","all"), plotvars = NULL, - col = c("skyblue","red","orange"), alpha = NULL, - pch = c(1,3), lty = par("lty"), - diagonal = c("density","none"), - interactive = TRUE, ...) { - scattmatrixMiss_work(x, delimiter, highlight, selection, plotvars, - col, alpha, pch, lty, diagonal, interactive, ...) -} - -#' @rdname scattmatrixMiss -#' @export - -scattmatrixMiss.survey.design <- function(x, delimiter = NULL, highlight = NULL, - selection = c("any","all"), plotvars = NULL, - col = c("skyblue","red","orange"), alpha = NULL, - pch = c(1,3), lty = par("lty"), - diagonal = c("density","none"), - interactive = TRUE, ...) { - scattmatrixMiss_work(x$variables, delimiter, highlight, selection, plotvars, - col, alpha, pch, lty, diagonal, interactive, ...) -} - -#' @rdname scattmatrixMiss -#' @export - -scattmatrixMiss.default <- function(x, delimiter = NULL, highlight = NULL, - selection = c("any","all"), plotvars = NULL, - col = c("skyblue","red","orange"), alpha = NULL, - pch = c(1,3), lty = par("lty"), - diagonal = c("density","none"), - interactive = TRUE, ...) { - scattmatrixMiss_work(as.data.frame(x), delimiter, highlight, selection, plotvars, - col, alpha, pch, lty, diagonal, interactive, ...) -} - -scattmatrixMiss_work <- function(x, delimiter = NULL, highlight = NULL, - selection = c("any","all"), plotvars = NULL, - col = c("skyblue","red","orange"), alpha = NULL, - pch = c(1,3), lty = par("lty"), - diagonal = c("density","none"), - interactive = TRUE, ...) { + check_data(x) + x <- as.data.frame(x) # initializations and error messages - if(!(inherits(x, c("data.frame","matrix")))) { - stop("'x' must be a data.frame or matrix") - } imputed <- FALSE # indicates if there are Variables with missing-index ## delimiter ## if(!is.null(delimiter)) { diff --git a/R/utils.R b/R/utils.R index 6e7b582..41e366a 100644 --- a/R/utils.R +++ b/R/utils.R @@ -19,6 +19,12 @@ # --------------------------------------- +check_data <- function(data) { + if (inherits(data, "survey.design")) + stop("support for survey.design objects was removed in VIM", + " 6.0.0. Use data.frame or data.table instead") +} + ## utilities for data getEscapeChars <- function() { c("", "_", "__", "-", " ", "/", "\\", ",") diff --git a/man/aggr.Rd b/man/aggr.Rd index 57cd20e..c5b8874 100644 --- a/man/aggr.Rd +++ b/man/aggr.Rd @@ -6,22 +6,10 @@ \alias{print.aggr} \alias{summary.aggr} \alias{print.summary.aggr} -\alias{aggr.data.frame} -\alias{aggr.survey.design} -\alias{aggr.default} -\alias{aggr_work} \title{Aggregations for missing/imputed values} \usage{ aggr(x, delimiter = NULL, plot = TRUE, ...) -\method{aggr}{data.frame}(x, delimiter = NULL, plot = TRUE, ...) - -\method{aggr}{survey.design}(x, delimiter = NULL, plot = TRUE, ...) - -\method{aggr}{default}(x, delimiter = NULL, plot = TRUE, ...) - -aggr_work(x, delimiter = NULL, plot = TRUE, ...) - \method{plot}{aggr}( x, col = c("skyblue", "red", "orange"), diff --git a/man/barMiss.Rd b/man/barMiss.Rd index 6178c84..6b235c9 100644 --- a/man/barMiss.Rd +++ b/man/barMiss.Rd @@ -2,9 +2,6 @@ % Please edit documentation in R/barMiss.R \name{barMiss} \alias{barMiss} -\alias{barMiss.data.frame} -\alias{barMiss.survey.design} -\alias{barMiss.default} \title{Barplot with information about missing/imputed values} \usage{ barMiss( @@ -25,63 +22,6 @@ barMiss( interactive = TRUE, ... ) - -\method{barMiss}{data.frame}( - x, - delimiter = NULL, - pos = 1, - selection = c("any", "all"), - col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - border = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - axes = TRUE, - labels = axes, - only.miss = TRUE, - miss.labels = axes, - interactive = TRUE, - ... -) - -\method{barMiss}{survey.design}( - x, - delimiter = NULL, - pos = 1, - selection = c("any", "all"), - col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - border = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - axes = TRUE, - labels = axes, - only.miss = TRUE, - miss.labels = axes, - interactive = TRUE, - ... -) - -\method{barMiss}{default}( - x, - delimiter = NULL, - pos = 1, - selection = c("any", "all"), - col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - border = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - axes = TRUE, - labels = axes, - only.miss = TRUE, - miss.labels = axes, - interactive = TRUE, - ... -) } \arguments{ \item{x}{a vector, matrix or \code{data.frame}.} diff --git a/man/colormapMiss.Rd b/man/colormapMiss.Rd index 89f65c0..ff351b0 100644 --- a/man/colormapMiss.Rd +++ b/man/colormapMiss.Rd @@ -3,9 +3,6 @@ \name{colormapMiss} \alias{colormapMiss} \alias{colormapMissLegend} -\alias{colormapMiss.data.frame} -\alias{colormapMiss.survey.design} -\alias{colormapMiss.default} \title{Colored map with information about missing/imputed values} \usage{ colormapMiss( @@ -30,72 +27,6 @@ colormapMiss( ... ) -\method{colormapMiss}{data.frame}( - x, - region, - map, - imp_index = NULL, - prop = TRUE, - polysRegion = 1:length(x), - range = NULL, - n = NULL, - col = c("red", "orange"), - gamma = 2.2, - fixup = TRUE, - coords = NULL, - numbers = TRUE, - digits = 2, - cex.numbers = 0.8, - col.numbers = par("fg"), - legend = TRUE, - interactive = TRUE, - ... -) - -\method{colormapMiss}{survey.design}( - x, - region, - map, - imp_index = NULL, - prop = TRUE, - polysRegion = 1:length(x), - range = NULL, - n = NULL, - col = c("red", "orange"), - gamma = 2.2, - fixup = TRUE, - coords = NULL, - numbers = TRUE, - digits = 2, - cex.numbers = 0.8, - col.numbers = par("fg"), - legend = TRUE, - interactive = TRUE, - ... -) - -\method{colormapMiss}{default}( - x, - region, - map, - imp_index = NULL, - prop = TRUE, - polysRegion = 1:length(x), - range = NULL, - n = NULL, - col = c("red", "orange"), - gamma = 2.2, - fixup = TRUE, - coords = NULL, - numbers = TRUE, - digits = 2, - cex.numbers = 0.8, - col.numbers = par("fg"), - legend = TRUE, - interactive = TRUE, - ... -) - colormapMissLegend( xleft, ybottom, diff --git a/man/growdotMiss.Rd b/man/growdotMiss.Rd index 7a32dba..b1b1a64 100644 --- a/man/growdotMiss.Rd +++ b/man/growdotMiss.Rd @@ -3,9 +3,6 @@ \name{growdotMiss} \alias{growdotMiss} \alias{bubbleMiss} -\alias{growdotMiss.data.frame} -\alias{growdotMiss.survey.design} -\alias{growdotMiss.default} \title{Growing dot map with information about missing/imputed values} \usage{ growdotMiss( @@ -32,81 +29,6 @@ growdotMiss( interactive = TRUE, ... ) - -\method{growdotMiss}{data.frame}( - x, - coords, - map, - pos = 1, - delimiter = NULL, - selection = c("any", "all"), - log = FALSE, - col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - border = par("bg"), - alpha = NULL, - scale = NULL, - size = NULL, - exp = c(0, 0.95, 0.05), - col.map = grey(0.5), - legend = TRUE, - legtitle = "Legend", - cex.legtitle = par("cex"), - cex.legtext = par("cex"), - ncircles = 6, - ndigits = 1, - interactive = TRUE, - ... -) - -\method{growdotMiss}{survey.design}( - x, - coords, - map, - pos = 1, - delimiter = NULL, - selection = c("any", "all"), - log = FALSE, - col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - border = par("bg"), - alpha = NULL, - scale = NULL, - size = NULL, - exp = c(0, 0.95, 0.05), - col.map = grey(0.5), - legend = TRUE, - legtitle = "Legend", - cex.legtitle = par("cex"), - cex.legtext = par("cex"), - ncircles = 6, - ndigits = 1, - interactive = TRUE, - ... -) - -\method{growdotMiss}{default}( - x, - coords, - map, - pos = 1, - delimiter = NULL, - selection = c("any", "all"), - log = FALSE, - col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - border = par("bg"), - alpha = NULL, - scale = NULL, - size = NULL, - exp = c(0, 0.95, 0.05), - col.map = grey(0.5), - legend = TRUE, - legtitle = "Legend", - cex.legtitle = par("cex"), - cex.legtext = par("cex"), - ncircles = 6, - ndigits = 1, - interactive = TRUE, - ... -) } \arguments{ \item{x}{a vector, matrix or \code{data.frame}.} diff --git a/man/histMiss.Rd b/man/histMiss.Rd index 763895f..5987b74 100644 --- a/man/histMiss.Rd +++ b/man/histMiss.Rd @@ -2,9 +2,6 @@ % Please edit documentation in R/histMiss.R \name{histMiss} \alias{histMiss} -\alias{histMiss.data.frame} -\alias{histMiss.survey.design} -\alias{histMiss.default} \title{Histogram with information about missing/imputed values} \usage{ histMiss( @@ -26,66 +23,6 @@ histMiss( interactive = TRUE, ... ) - -\method{histMiss}{data.frame}( - x, - delimiter = NULL, - pos = 1, - selection = c("any", "all"), - breaks = "Sturges", - right = TRUE, - col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - border = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - axes = TRUE, - only.miss = TRUE, - miss.labels = axes, - interactive = TRUE, - ... -) - -\method{histMiss}{survey.design}( - x, - delimiter = NULL, - pos = 1, - selection = c("any", "all"), - breaks = "Sturges", - right = TRUE, - col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - border = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - axes = TRUE, - only.miss = TRUE, - miss.labels = axes, - interactive = TRUE, - ... -) - -\method{histMiss}{default}( - x, - delimiter = NULL, - pos = 1, - selection = c("any", "all"), - breaks = "Sturges", - right = TRUE, - col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - border = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - axes = TRUE, - only.miss = TRUE, - miss.labels = axes, - interactive = TRUE, - ... -) } \arguments{ \item{x}{a vector, matrix or \code{data.frame}.} diff --git a/man/hotdeck.Rd b/man/hotdeck.Rd index 577cbef..f77f3af 100644 --- a/man/hotdeck.Rd +++ b/man/hotdeck.Rd @@ -2,9 +2,6 @@ % Please edit documentation in R/hotdeck.R \name{hotdeck} \alias{hotdeck} -\alias{hotdeck.data.frame} -\alias{hotdeck.survey.design} -\alias{hotdeck.default} \title{Hot-Deck Imputation} \usage{ hotdeck( @@ -19,45 +16,6 @@ hotdeck( imp_var = TRUE, imp_suffix = "imp" ) - -\method{hotdeck}{data.frame}( - data, - variable = NULL, - ord_var = NULL, - domain_var = NULL, - makeNA = NULL, - NAcond = NULL, - impNA = TRUE, - donorcond = NULL, - imp_var = TRUE, - imp_suffix = "imp" -) - -\method{hotdeck}{survey.design}( - data, - variable = NULL, - ord_var = NULL, - domain_var = NULL, - makeNA = NULL, - NAcond = NULL, - impNA = TRUE, - donorcond = NULL, - imp_var = TRUE, - imp_suffix = "imp" -) - -\method{hotdeck}{default}( - data, - variable = NULL, - ord_var = NULL, - domain_var = NULL, - makeNA = NULL, - NAcond = NULL, - impNA = TRUE, - donorcond = NULL, - imp_var = TRUE, - imp_suffix = "imp" -) } \arguments{ \item{data}{data.frame or matrix} diff --git a/man/irmi.Rd b/man/irmi.Rd index 911590e..96b2ef8 100644 --- a/man/irmi.Rd +++ b/man/irmi.Rd @@ -2,9 +2,6 @@ % Please edit documentation in R/irmi.R \name{irmi} \alias{irmi} -\alias{irmi.data.frame} -\alias{irmi.survey.design} -\alias{irmi.default} \title{Iterative robust model-based imputation (IRMI)} \usage{ irmi( @@ -31,81 +28,6 @@ irmi( imp_var = TRUE, imp_suffix = "imp" ) - -\method{irmi}{data.frame}( - x, - eps = 5, - maxit = 100, - mixed = NULL, - mixed.constant = NULL, - count = NULL, - step = FALSE, - robust = FALSE, - takeAll = TRUE, - noise = TRUE, - noise.factor = 1, - force = FALSE, - robMethod = "MM", - force.mixed = TRUE, - mi = 1, - addMixedFactors = FALSE, - trace = FALSE, - init.method = "kNN", - modelFormulas = NULL, - multinom.method = "multinom", - imp_var = TRUE, - imp_suffix = "imp" -) - -\method{irmi}{survey.design}( - x, - eps = 5, - maxit = 100, - mixed = NULL, - mixed.constant = NULL, - count = NULL, - step = FALSE, - robust = FALSE, - takeAll = TRUE, - noise = TRUE, - noise.factor = 1, - force = FALSE, - robMethod = "MM", - force.mixed = TRUE, - mi = 1, - addMixedFactors = FALSE, - trace = FALSE, - init.method = "kNN", - modelFormulas = NULL, - multinom.method = "multinom", - imp_var = TRUE, - imp_suffix = "imp" -) - -\method{irmi}{default}( - x, - eps = 5, - maxit = 100, - mixed = NULL, - mixed.constant = NULL, - count = NULL, - step = FALSE, - robust = FALSE, - takeAll = TRUE, - noise = TRUE, - noise.factor = 1, - force = FALSE, - robMethod = "MM", - force.mixed = TRUE, - mi = 1, - addMixedFactors = FALSE, - trace = FALSE, - init.method = "kNN", - modelFormulas = NULL, - multinom.method = "multinom", - imp_var = TRUE, - imp_suffix = "imp" -) } \arguments{ \item{x}{data.frame or matrix} diff --git a/man/kNN.Rd b/man/kNN.Rd index bab783a..008c01f 100644 --- a/man/kNN.Rd +++ b/man/kNN.Rd @@ -1,11 +1,7 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/kNNFaster.R +% Please edit documentation in R/kNN.R \name{kNN} \alias{kNN} -\alias{kNN.data.table} -\alias{kNN.data.frame} -\alias{kNN.survey.design} -\alias{kNN.default} \title{k-Nearest Neighbour Imputation} \usage{ kNN( @@ -32,106 +28,6 @@ kNN( useImputedDist = TRUE, weightDist = FALSE ) - -\method{kNN}{data.table}( - data, - variable = colnames(data), - metric = NULL, - k = 5, - dist_var = colnames(data), - weights = NULL, - numFun = median, - catFun = maxCat, - makeNA = NULL, - NAcond = NULL, - impNA = TRUE, - donorcond = NULL, - mixed = vector(), - mixed.constant = NULL, - trace = FALSE, - imp_var = TRUE, - imp_suffix = "imp", - addRF = FALSE, - onlyRF = FALSE, - addRandom = FALSE, - useImputedDist = TRUE, - weightDist = FALSE -) - -\method{kNN}{data.frame}( - data, - variable = colnames(data), - metric = NULL, - k = 5, - dist_var = colnames(data), - weights = NULL, - numFun = median, - catFun = maxCat, - makeNA = NULL, - NAcond = NULL, - impNA = TRUE, - donorcond = NULL, - mixed = vector(), - mixed.constant = NULL, - trace = FALSE, - imp_var = TRUE, - imp_suffix = "imp", - addRF = FALSE, - onlyRF = FALSE, - addRandom = FALSE, - useImputedDist = TRUE, - weightDist = FALSE -) - -\method{kNN}{survey.design}( - data, - variable = colnames(data), - metric = NULL, - k = 5, - dist_var = colnames(data), - weights = NULL, - numFun = median, - catFun = maxCat, - makeNA = NULL, - NAcond = NULL, - impNA = TRUE, - donorcond = NULL, - mixed = vector(), - mixed.constant = NULL, - trace = FALSE, - imp_var = TRUE, - imp_suffix = "imp", - addRF = FALSE, - onlyRF = FALSE, - addRandom = FALSE, - useImputedDist = TRUE, - weightDist = FALSE -) - -\method{kNN}{default}( - data, - variable = colnames(data), - metric = NULL, - k = 5, - dist_var = colnames(data), - weights = NULL, - numFun = median, - catFun = maxCat, - makeNA = NULL, - NAcond = NULL, - impNA = TRUE, - donorcond = NULL, - mixed = vector(), - mixed.constant = NULL, - trace = FALSE, - imp_var = TRUE, - imp_suffix = "imp", - addRF = FALSE, - onlyRF = FALSE, - addRandom = FALSE, - useImputedDist = TRUE, - weightDist = FALSE -) } \arguments{ \item{data}{data.frame or matrix} diff --git a/man/mapMiss.Rd b/man/mapMiss.Rd index e4a5065..2f01f5b 100644 --- a/man/mapMiss.Rd +++ b/man/mapMiss.Rd @@ -2,9 +2,6 @@ % Please edit documentation in R/mapMiss.R \name{mapMiss} \alias{mapMiss} -\alias{mapMiss.data.frame} -\alias{mapMiss.survey.design} -\alias{mapMiss.default} \title{Map with information about missing/imputed values} \usage{ mapMiss( @@ -21,51 +18,6 @@ mapMiss( interactive = TRUE, ... ) - -\method{mapMiss}{data.frame}( - x, - coords, - map, - delimiter = NULL, - selection = c("any", "all"), - col = c("skyblue", "red", "orange"), - alpha = NULL, - pch = c(19, 15), - col.map = grey(0.5), - legend = TRUE, - interactive = TRUE, - ... -) - -\method{mapMiss}{survey.design}( - x, - coords, - map, - delimiter = NULL, - selection = c("any", "all"), - col = c("skyblue", "red", "orange"), - alpha = NULL, - pch = c(19, 15), - col.map = grey(0.5), - legend = TRUE, - interactive = TRUE, - ... -) - -\method{mapMiss}{default}( - x, - coords, - map, - delimiter = NULL, - selection = c("any", "all"), - col = c("skyblue", "red", "orange"), - alpha = NULL, - pch = c(19, 15), - col.map = grey(0.5), - legend = TRUE, - interactive = TRUE, - ... -) } \arguments{ \item{x}{a vector, matrix or \code{data.frame}.} diff --git a/man/marginmatrix.Rd b/man/marginmatrix.Rd index 3ff467f..852f40d 100644 --- a/man/marginmatrix.Rd +++ b/man/marginmatrix.Rd @@ -2,9 +2,6 @@ % Please edit documentation in R/marginmatrix.R \name{marginmatrix} \alias{marginmatrix} -\alias{marginmatrix.data.frame} -\alias{marginmatrix.survey.design} -\alias{marginmatrix.default} \title{Marginplot Matrix} \usage{ marginmatrix( @@ -14,30 +11,6 @@ marginmatrix( alpha = NULL, ... ) - -\method{marginmatrix}{data.frame}( - x, - delimiter = NULL, - col = c("skyblue", "red", "red4", "orange", "orange4"), - alpha = NULL, - ... -) - -\method{marginmatrix}{survey.design}( - x, - delimiter = NULL, - col = c("skyblue", "red", "red4", "orange", "orange4"), - alpha = NULL, - ... -) - -\method{marginmatrix}{default}( - x, - delimiter = NULL, - col = c("skyblue", "red", "red4", "orange", "orange4"), - alpha = NULL, - ... -) } \arguments{ \item{x}{a matrix or \code{data.frame}.} diff --git a/man/matchImpute.Rd b/man/matchImpute.Rd index ad68b70..810d676 100644 --- a/man/matchImpute.Rd +++ b/man/matchImpute.Rd @@ -2,10 +2,6 @@ % Please edit documentation in R/matchImpute.R \name{matchImpute} \alias{matchImpute} -\alias{matchImpute.data.frame} -\alias{matchImpute.data.table} -\alias{matchImpute.survey.design} -\alias{matchImpute.default} \title{Fast matching/imputation based on categorical variable} \usage{ matchImpute( @@ -15,41 +11,9 @@ matchImpute( imp_var = TRUE, imp_suffix = "imp" ) - -\method{matchImpute}{data.frame}( - data, - variable = colnames(data)[!colnames(data) \%in\% match_var], - match_var, - imp_var = TRUE, - imp_suffix = "imp" -) - -\method{matchImpute}{data.table}( - data, - variable = colnames(data)[!colnames(data) \%in\% match_var], - match_var, - imp_var = TRUE, - imp_suffix = "imp" -) - -\method{matchImpute}{survey.design}( - data, - variable = colnames(data$variables)[!colnames(data$variables) \%in\% match_var], - match_var, - imp_var = TRUE, - imp_suffix = "imp" -) - -\method{matchImpute}{default}( - data, - variable = colnames(data)[!colnames(data) \%in\% match_var], - match_var, - imp_var = TRUE, - imp_suffix = "imp" -) } \arguments{ -\item{data}{data.frame, data.table, survey object or matrix} +\item{data}{data.frame, data.table or matrix} \item{variable}{variables to be imputed} diff --git a/man/matrixplot.Rd b/man/matrixplot.Rd index 78b68c9..1a5d7be 100644 --- a/man/matrixplot.Rd +++ b/man/matrixplot.Rd @@ -4,9 +4,6 @@ \alias{matrixplot} \alias{TKRmatrixplot} \alias{iimagMiss} -\alias{matrixplot.data.frame} -\alias{matrixplot.survey.design} -\alias{matrixplot.default} \title{Matrix plot} \usage{ matrixplot( @@ -27,63 +24,6 @@ matrixplot( interactive = TRUE, ... ) - -\method{matrixplot}{data.frame}( - x, - delimiter = NULL, - sortby = NULL, - col = c("red", "orange"), - fixup = TRUE, - xlim = NULL, - ylim = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - axes = TRUE, - labels = axes, - xpd = NULL, - interactive = TRUE, - ... -) - -\method{matrixplot}{survey.design}( - x, - delimiter = NULL, - sortby = NULL, - col = c("red", "orange"), - fixup = TRUE, - xlim = NULL, - ylim = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - axes = TRUE, - labels = axes, - xpd = NULL, - interactive = TRUE, - ... -) - -\method{matrixplot}{default}( - x, - delimiter = NULL, - sortby = NULL, - col = c("red", "orange"), - fixup = TRUE, - xlim = NULL, - ylim = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - axes = TRUE, - labels = axes, - xpd = NULL, - interactive = TRUE, - ... -) } \arguments{ \item{x}{a matrix or \code{data.frame}.} diff --git a/man/mosaicMiss.Rd b/man/mosaicMiss.Rd index 84d09d6..14b834e 100644 --- a/man/mosaicMiss.Rd +++ b/man/mosaicMiss.Rd @@ -2,9 +2,6 @@ % Please edit documentation in R/mosaicMiss.R \name{mosaicMiss} \alias{mosaicMiss} -\alias{mosaicMiss.data.frame} -\alias{mosaicMiss.survey.design} -\alias{mosaicMiss.default} \title{Mosaic plot with information about missing/imputed values} \usage{ mosaicMiss( @@ -18,42 +15,6 @@ mosaicMiss( miss.labels = TRUE, ... ) - -\method{mosaicMiss}{data.frame}( - x, - delimiter = NULL, - highlight = NULL, - selection = c("any", "all"), - plotvars = NULL, - col = c("skyblue", "red", "orange"), - labels = NULL, - miss.labels = TRUE, - ... -) - -\method{mosaicMiss}{survey.design}( - x, - delimiter = NULL, - highlight = NULL, - selection = c("any", "all"), - plotvars = NULL, - col = c("skyblue", "red", "orange"), - labels = NULL, - miss.labels = TRUE, - ... -) - -\method{mosaicMiss}{default}( - x, - delimiter = NULL, - highlight = NULL, - selection = c("any", "all"), - plotvars = NULL, - col = c("skyblue", "red", "orange"), - labels = NULL, - miss.labels = TRUE, - ... -) } \arguments{ \item{x}{a matrix or \code{data.frame}.} diff --git a/man/parcoordMiss.Rd b/man/parcoordMiss.Rd index a8158ef..f2411f2 100644 --- a/man/parcoordMiss.Rd +++ b/man/parcoordMiss.Rd @@ -2,9 +2,6 @@ % Please edit documentation in R/parcoordMiss.R \name{parcoordMiss} \alias{parcoordMiss} -\alias{parcoordMiss.data.frame} -\alias{parcoordMiss.survey.design} -\alias{parcoordMiss.default} \title{Parallel coordinate plot with information about missing/imputed values} \usage{ parcoordMiss( @@ -28,72 +25,6 @@ parcoordMiss( interactive = TRUE, ... ) - -\method{parcoordMiss}{data.frame}( - x, - delimiter = NULL, - highlight = NULL, - selection = c("any", "all"), - plotvars = NULL, - plotNA = TRUE, - col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - alpha = NULL, - lty = par("lty"), - xlim = NULL, - ylim = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - labels = TRUE, - xpd = NULL, - interactive = TRUE, - ... -) - -\method{parcoordMiss}{survey.design}( - x, - delimiter = NULL, - highlight = NULL, - selection = c("any", "all"), - plotvars = NULL, - plotNA = TRUE, - col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - alpha = NULL, - lty = par("lty"), - xlim = NULL, - ylim = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - labels = TRUE, - xpd = NULL, - interactive = TRUE, - ... -) - -\method{parcoordMiss}{default}( - x, - delimiter = NULL, - highlight = NULL, - selection = c("any", "all"), - plotvars = NULL, - plotNA = TRUE, - col = c("skyblue", "red", "skyblue4", "red4", "orange", "orange4"), - alpha = NULL, - lty = par("lty"), - xlim = NULL, - ylim = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - labels = TRUE, - xpd = NULL, - interactive = TRUE, - ... -) } \arguments{ \item{x}{a matrix or \code{data.frame}.} diff --git a/man/pbox.Rd b/man/pbox.Rd index a61aaf9..e27bf6e 100644 --- a/man/pbox.Rd +++ b/man/pbox.Rd @@ -2,9 +2,6 @@ % Please edit documentation in R/pbox.R \name{pbox} \alias{pbox} -\alias{pbox.data.frame} -\alias{pbox.survey.design} -\alias{pbox.default} \title{Parallel boxplots with information about missing/imputed values} \usage{ pbox( @@ -27,69 +24,6 @@ pbox( interactive = TRUE, ... ) - -\method{pbox}{data.frame}( - x, - delimiter = NULL, - pos = 1, - selection = c("none", "any", "all"), - col = c("skyblue", "red", "red4", "orange", "orange4"), - numbers = TRUE, - cex.numbers = par("cex"), - xlim = NULL, - ylim = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - axes = TRUE, - frame.plot = axes, - labels = axes, - interactive = TRUE, - ... -) - -\method{pbox}{survey.design}( - x, - delimiter = NULL, - pos = 1, - selection = c("none", "any", "all"), - col = c("skyblue", "red", "red4", "orange", "orange4"), - numbers = TRUE, - cex.numbers = par("cex"), - xlim = NULL, - ylim = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - axes = TRUE, - frame.plot = axes, - labels = axes, - interactive = TRUE, - ... -) - -\method{pbox}{default}( - x, - delimiter = NULL, - pos = 1, - selection = c("none", "any", "all"), - col = c("skyblue", "red", "red4", "orange", "orange4"), - numbers = TRUE, - cex.numbers = par("cex"), - xlim = NULL, - ylim = NULL, - main = NULL, - sub = NULL, - xlab = NULL, - ylab = NULL, - axes = TRUE, - frame.plot = axes, - labels = axes, - interactive = TRUE, - ... -) } \arguments{ \item{x}{a vector, matrix or \code{data.frame}.} diff --git a/man/prepare.Rd b/man/prepare.Rd index 3d7c978..45fbbd3 100644 --- a/man/prepare.Rd +++ b/man/prepare.Rd @@ -2,39 +2,9 @@ % Please edit documentation in R/prepare.R \name{prepare} \alias{prepare} -\alias{prepare.data.frame} -\alias{prepare.survey.design} -\alias{prepare.default} \title{Transformation and standardization} \usage{ -prepare (x, scaling = c("none","classical","MCD","robust","onestep"), - transformation = c("none","minus","reciprocal","logarithm", - "exponential","boxcox","clr","ilr","alr"), - alpha = NULL, powers = NULL, start = 0, alrVar) - -\method{prepare}{data.frame}( - x, - scaling = c("none", "classical", "MCD", "robust", "onestep"), - transformation = c("none", "minus", "reciprocal", "logarithm", "exponential", - "boxcox", "clr", "ilr", "alr"), - alpha = NULL, - powers = NULL, - start = 0, - alrVar -) - -\method{prepare}{survey.design}( - x, - scaling = c("none", "classical", "MCD", "robust", "onestep"), - transformation = c("none", "minus", "reciprocal", "logarithm", "exponential", - "boxcox", "clr", "ilr", "alr"), - alpha = NULL, - powers = NULL, - start = 0, - alrVar -) - -\method{prepare}{default}( +prepare( x, scaling = c("none", "classical", "MCD", "robust", "onestep"), transformation = c("none", "minus", "reciprocal", "logarithm", "exponential", diff --git a/man/rangerImpute.Rd b/man/rangerImpute.Rd index 4de69e9..0899e21 100644 --- a/man/rangerImpute.Rd +++ b/man/rangerImpute.Rd @@ -15,9 +15,9 @@ rangerImpute( ) } \arguments{ -\item{formula}{model formula to impute one variable} +\item{formula}{model formula for the imputation} -\item{data}{A data.frame or survey object containing the data} +\item{data}{A \code{data.frame} containing the data} \item{imp_var}{\code{TRUE}/\code{FALSE} if a \code{TRUE}/\code{FALSE} variables for each imputed variable should be created show the imputation status} @@ -30,8 +30,8 @@ variable should be created show the imputation status} and evaluating the RF-Model. This parameter is also passed down to \code{\link[ranger:ranger]{ranger::ranger()}} to show computation status.} -\item{median}{Use a median to average the values of individual trees for -a more robust estimate.} +\item{median}{Use the median (rather than the arithmetic mean) to average +the values of individual trees for a more robust estimate.} } \value{ the imputed data set. diff --git a/man/regressionImp.Rd b/man/regressionImp.Rd index 39cb88f..8de2f35 100644 --- a/man/regressionImp.Rd +++ b/man/regressionImp.Rd @@ -2,9 +2,6 @@ % Please edit documentation in R/regressionImp.R \name{regressionImp} \alias{regressionImp} -\alias{regressionImp.data.frame} -\alias{regressionImp.survey.design} -\alias{regressionImp.default} \title{Regression Imputation} \usage{ regressionImp( @@ -16,41 +13,11 @@ regressionImp( imp_suffix = "imp", mod_cat = FALSE ) - -\method{regressionImp}{data.frame}( - formula, - data, - family = "AUTO", - robust = FALSE, - imp_var = TRUE, - imp_suffix = "imp", - mod_cat = FALSE -) - -\method{regressionImp}{survey.design}( - formula, - data, - family, - robust, - imp_var = TRUE, - imp_suffix = "imp", - mod_cat = FALSE -) - -\method{regressionImp}{default}( - formula, - data, - family = "AUTO", - robust = FALSE, - imp_var = TRUE, - imp_suffix = "imp", - mod_cat = FALSE -) } \arguments{ \item{formula}{model formula to impute one variable} -\item{data}{A data.frame or survey object containing the data} +\item{data}{A data.frame containing the data} \item{family}{family argument for \code{\link[=glm]{glm()}}. \code{"AUTO"} (the default) tries to choose automatically and is the only really tested option!!!} diff --git a/man/scattmatrixMiss.Rd b/man/scattmatrixMiss.Rd index 25416bb..66b3d0e 100644 --- a/man/scattmatrixMiss.Rd +++ b/man/scattmatrixMiss.Rd @@ -2,9 +2,6 @@ % Please edit documentation in R/scattmatrixMiss.R \name{scattmatrixMiss} \alias{scattmatrixMiss} -\alias{scattmatrixMiss.data.frame} -\alias{scattmatrixMiss.survey.design} -\alias{scattmatrixMiss.default} \title{Scatterplot matrix with information about missing/imputed values} \usage{ scattmatrixMiss( @@ -21,51 +18,6 @@ scattmatrixMiss( interactive = TRUE, ... ) - -\method{scattmatrixMiss}{data.frame}( - x, - delimiter = NULL, - highlight = NULL, - selection = c("any", "all"), - plotvars = NULL, - col = c("skyblue", "red", "orange"), - alpha = NULL, - pch = c(1, 3), - lty = par("lty"), - diagonal = c("density", "none"), - interactive = TRUE, - ... -) - -\method{scattmatrixMiss}{survey.design}( - x, - delimiter = NULL, - highlight = NULL, - selection = c("any", "all"), - plotvars = NULL, - col = c("skyblue", "red", "orange"), - alpha = NULL, - pch = c(1, 3), - lty = par("lty"), - diagonal = c("density", "none"), - interactive = TRUE, - ... -) - -\method{scattmatrixMiss}{default}( - x, - delimiter = NULL, - highlight = NULL, - selection = c("any", "all"), - plotvars = NULL, - col = c("skyblue", "red", "orange"), - alpha = NULL, - pch = c(1, 3), - lty = par("lty"), - diagonal = c("density", "none"), - interactive = TRUE, - ... -) } \arguments{ \item{x}{a matrix or \code{data.frame}.}