forked from ProjectMOSAIC/mosaic
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathas.xtabs.R
66 lines (59 loc) · 1.94 KB
/
as.xtabs.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
#' Convert objects to xtabs format
#'
#' Convert a data frame or a matrix into an `xtabs` object.
#'
#' The intended use is to convert a two-way contingency table stored in a data
#' frame or a matrix into an `xtabs` object.
#'
#' @aliases as.xtabs as.xtabs.data.frame as.xtabs.matrix
#' @param x object (typically a data frame) to be converted to `xtabs`
#' format
#' @param ... additional arguments to be passed to or from methods.
#' @return An `xtabs` object.
#' @keywords manipulate
#' @rdname as-xtabs
#' @examples
#' # example from example(fisher.test)
#' df <- data.frame( X=c('Tea','Milk'), Tea=c(3,1), Milk=c(1,3) )
#' xt <- as.xtabs(df, rowvar="Guess", colvar="Truth"); xt
#' if (require(vcd)) { mosaic(xt) }
#' @export
as.xtabs <- function(x, ...) { UseMethod('as.xtabs') }
#' @rdname as-xtabs
#' @param rowvar name of the row variable as character string
#' @param colvar name of the column variable as character string
#' @param labels column of data frame that contains the labels of the row
#' variable.
#' @export
as.xtabs.data.frame <- function(x, rowvar=NULL, colvar=NULL, labels=1, ...) {
if (labels >= 1) {
cnames <- names(x)[-1]
m <- as.matrix(x[,-c(labels)])
} else {
cnames <- names(x)
m <- as.matrix(x)
}
rnames <- x[,labels]
rownames(m) <- rnames
if (! is.character(rowvar) ) { rowvar <- "variable.1" }
if (! is.character(colvar) ) { colvar <- "variable.2" }
dn <- list( rnames, cnames)
names(dn) <- c(rowvar, colvar)
attr(m,'dimnames') <- dn
class(m) <- c('xtabs', 'table')
return(m)
}
#' @rdname as-xtabs
#' @export
as.xtabs.matrix <- function(x, rowvar=NULL, colvar=NULL, ...) {
rnames <- rownames(x)
cnames <- colnames(x)
rownames(m) <- rnames
if (! is.character(rowvar) ) { rowvar <- "variable.1" }
if (! is.character(colvar) ) { colvar <- "variable.2" }
dn <- list( rnames, cnames)
names(dn) <- c(rowvar, colvar)
attr(m,'dimnames') <- dn
class(m) <- c('xtabs', 'table')
return(m)
}