Skip to content

Commit

Permalink
remove support for survey.design objects (#36)
Browse files Browse the repository at this point in the history 
* remove survey support for imputation functions
* remove survey support for dataviz functions
* remove survey support for prepare and aggr
* rename kNNfaster.R -> kNN.R
* type-check for survey.design
* update documentation
  • Loading branch information
@GregorDeCillia
GregorDeCillia committed Apr 19, 2020
1 parent 0cac771 commit b7227f0
Show file tree
Hide file tree
Showing 40 changed files with 159 additions and 1,950 deletions.
57 changes: 0 additions & 57 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
@@ -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)
Expand Down
27 changes: 2 additions & 25 deletions R/aggr.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
54 changes: 4 additions & 50 deletions R/barMiss.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
61 changes: 3 additions & 58 deletions R/colormapMiss.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -111,71 +111,16 @@
#' 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"),
gamma = 2.2, fixup = TRUE, coords = 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)) {
Expand Down
65 changes: 4 additions & 61 deletions R/growdotMiss.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -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
Expand Down
57 changes: 3 additions & 54 deletions R/histMiss.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -108,67 +108,16 @@
#' 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"),
border = NULL, main = NULL, sub = NULL,
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
Expand Down
Loading

0 comments on commit b7227f0

Please sign in to comment.