> After you copy stat.table to stat.table2 and modify stat.table2
> try:
>
>> environment(stat.table2) <- environment(stat.table)
>
> (you should only need to do that 1 time after creating/editing
> stat.table2).
>
> hope this helps,
>
> Greg Snow, Ph.D.
> Statistical Data Center, LDS Hospital
> Intermountain Health Care
> greg.snow@ihc.com
> (801) 408-8111
>
>>>> <rab45+@pitt.edu> 08/09/05 11:16AM >>>
> The stat.table function in the Epi package won't do standard
> deviations.
> It didn't seem that it would be difficult to add an "sd" function to
> the
> stat.table function. Following the example for the mean, I set up a
> similar function for the sd (and included it as an options) but it
> just
> won't work. (I tried sending messages to the Epi mailing list after
> subscribing but my mail is always returned. I don't have the exact
> error
> messages at the moment or I would post them.)
>
> Even if I just copy stat.table to stat.table2 and try to run
> stat.table2,
> I get:
>
>>
> stat.table2(index=list(race,gender),list(count(),percent(race)),margins=TRUE)
> Error: couldn't find function "array.subset"
>
> I can't find any "array.subset" function, yet the original stat.table
> works just fine.
>
> I've copied other functions and made changes to them and they would
> work
> just fine. I must be missing something here.
>
> Any insights would be appreciated.
>
> Rick B.
>
> ______________________________________________
> R-help@stat.math.ethz.ch mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide!
> http://www.R-project.org/posting-guide.html
>
> ______________________________________________
> R-help@stat.math.ethz.ch mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide!
> http://www.R-project.org/posting-guide.html
>
Thanks Greg. That helps but I still get the following error message:
> stat.table2(index=list(race),list(count(),sd(age.at.scanning)),margins=TRUE)
Error in if (digits < 0) digits <- 6 : missing value where TRUE/FALSE needed
Rick
Below is the code (sorry it's kind of long). The mean function works but the sd function produces the error message:
stat.table2 <- function (index, contents = count(), data, margins = FALSE) {
index.sub <- substitute(index)
index <- if (missing(data))
eval(index)
else eval(index.sub, data)
deparse.name <- function(x) if (is.symbol(x))
as.character(x)
else ""
if (is.list(index)) {
if (is.call(index.sub)) { index.names <- names(index.sub) fixup <- if (is.null(index.names)) seq(along = index.sub) else index.names == "" dep <- sapply(index.sub[fixup], deparse.name) if (is.null(index.names)) index.labels <- dep else { index.labels <- index.names index.labels[fixup] <- dep } index.labels <- index.labels[-1] } else { index.labels <- if (!is.null(names(index))) { names(index) } else { rep("", length(index)) } }
index.labels <- deparse.name(index.sub)
}
if (!is.list(index))
index <- list(index)
index <- lapply(index, as.factor)
contents <- substitute(contents)
if (!identical(deparse(contents[[1]]), "list")) {
contents <- call("list", contents)
}
valid.functions <- c("count", "mean", "sd","weighted.mean", "sum",
"quantile", "median", "IQR", "max", "min", "ratio", "percent") table.fun <- character(length(contents) - 1) for (i in 2:length(contents)) {
if (!is.call(contents[[i]])) stop("contents must be a list of function calls") FUN <- deparse(contents[[i]][[1]]) if (!FUN %in% valid.functions) stop(paste("Function", FUN, "not permitted in stat.table")) else table.fun[i - 1] <- FUN
for (i in 2:length(content.names)) { if (nchar(content.names[i]) > 0) stat.labels[i - 1] <- content.names[i] }
if (missing(id)) { id <- seq(along = index[[1]]) } y <- tapply(id, INDEX = subindex, FUN = function(x) length(unique(x))) y[is.na(y)] <- 0 return(y)
tapply(x, INDEX = subindex, FUN = base::mean, trim = trim, na.rm = na.rm)
tapply(x, INDEX = subindex, FUN = stats::sd, na.rm = na.rm)
weighted.mean <- function(x, w, na.rm = TRUE) {
tapply(x, INDEX = subindex, FUN = stats::weighted.mean, w = w, na.rm = na.rm)
tapply(..., INDEX = subindex, FUN = base::sum, na.rm = na.rm)
}
quantile <- function(x, probs, na.rm = TRUE, names = TRUE,
type = 7, ...) { if (length(probs > 1)) stop("The quantile function only accepts scalar prob values within stat.table") tapply(x, INDEX = subindex, FUN = stats::quantile, probs = prob, na.rm = na.rm, names = names, type = type, ...)}
tapply(x, INDEX = subindex, FUN = stats::median, na.rm = na.rm)
}
IQR <- function(x, na.rm = TRUE) {
tapply(x, INDEX = subindex, FUN = stats::IQR, na.rm = na.rm)
}
max <- function(..., na.rm = TRUE) {
tapply(..., INDEX = subindex, FUN = base::max, na.rm = na.rm)
}
min <- function(..., na.rm = TRUE) {
tapply(..., INDEX = subindex, FUN = base::min, na.rm = na.rm)
}
ratio <- function(d, y, scale = 1, na.rm = TRUE) {
if (length(scale) != 1) stop("Scale parameter must be a scalar") if (na.rm) { w <- (!is.na(d) & !is.na(y)) tab1 <- tapply(d * w, INDEX = subindex, FUN = base::sum, na.rm = TRUE) tab2 <- tapply(y * w, INDEX = subindex, FUN = base::sum, na.rm = TRUE) } else { tab1 <- tapply(d, INDEX = subindex, FUN = base::sum, na.rm = FALSE) tab2 <- tapply(y, INDEX = subindex, FUN = base::sum, na.rm = FALSE) } return(scale * tab1/tab2)
x <- list(...) if (length(x) == 0) stop("No variables to calculate percent") n <- count() sweep.index <- logical(length(subindex)) for (i in seq(along = subindex)) { sweep.index[i] <- !any(sapply(x, identical, subindex[[i]])) } if (!any(sweep.index)) { return(100 * n/base::sum(n, na.rm = TRUE)) } else { margin <- apply(n, which(sweep.index), base::sum, na.rm = TRUE) margin[margin == 0] <- NA return(100 * sweep(n, which(sweep.index), margin, "/")) }
margins <- rep(margins, n.dim)
else if (length(margins) != n.dim)
stop("Incorrect length for margins argument")
fac.list <- vector("list", n.dim)
for (i in 1:n.dim) {
fac.list[[i]] <- if (margins[i]) c(0, 1) else 1
in.subtable <- as.logical(subtable.grid[i, ]) llim <- rep(1, n.dim) + ifelse(in.subtable, rep(0, n.dim), tab.dim) ulim <- tab.dim + ifelse(in.subtable, rep(0, n.dim), rep(1, n.dim)) subindex <- index[in.subtable] subtable.list <- if (missing(data)) eval(contents) else eval(as.expression(contents), data) for (j in 1:length(subtable.list)) { ans[array.subset(ans.dim, c(j, llim), c(j, ulim))] <- subtable.list[[j]] }
if (margins[i]) ans.dimnames[[i]] <- c(ans.dimnames[[i]], "Total")}
stat.table2(index=list(race),list(count(),mean(age.at.scanning)),margins=TRUE)
stat.table2(index=list(race),list(count(),sd(age.at.scanning)),margins=TRUE)
This archive was generated by hypermail 2.1.8 : Sun 23 Oct 2005 - 15:11:47 EST