Nothing
#modified March 4, 2009 for matrix output
#and yet again August 1 to make it actually work!
#modified May 26, 2014 to add the ability to specify group by name or location
"describe.by" <-
function (x,group=NULL,mat=FALSE,type=3,...) { #data are x, grouping variable is group
.Deprecated("describeBy", msg = "describe.by is deprecated. Please use the describeBy function")
if(inherits(x,"formula")) {ps <- fparse(x)
x <- ps$y
group <- ps$x}
answer <- describeBy(x=x,group=group,mat=mat,type=type,...)
return(answer)}
#July 9, 2020 added the ability to do formula input
"describeBy" <-
function (x,group=NULL,mat=FALSE,type=3,digits=15,data=NULL,...) { #data are x, grouping variable is group
cl <- match.call()
if(inherits(x,"formula")) {ps <- fparse(x)
if(missing(data)) {x <- get(ps$y)
group <- x[ps$x]} else {x <- data[ps$y]
group <- data[ps$x]}
}
if(is.null(group)) {answer <- describe(x,type=type)
warning("no grouping variable requested")} else {
x <- char2numeric(x) #do this before doing by groups 4/16/23
if(!is.data.frame(group) && !is.list(group) && (length(group) < NROW(x))) group <- x[,group ,drop=FALSE]
answer <- by(x,group,describe,type=type,...)
answer <- fix.is.null(answer)
class(answer) <- c("psych","describeBy") #probably better not to make of class psych (at least not yet)
}
if (mat) { ncol <- length(answer[[1]]) #the more complicated case. How to reorder a list of data.frames
#the interesting problem is treating the case of multiple grouping variables.
n.var <- NROW(answer[[1]])
n.col <- NCOL(answer[[1]])
n.grouping <- length(dim(answer)) #this is the case of multiple grouping variables
n.groups <- prod(dim(answer))
names <- names(answer[[1]])
row.names <-attr(answer[[1]],"row.names")
dim.names <- attr(answer,"dimnames")
mat.ans <- matrix(NA,ncol=ncol,nrow=n.var*n.groups) #NA or NaN
labels.ans <- matrix(NA,ncol = n.grouping+1,nrow= n.var*n.groups) #CHANGE TO NA
colnames(labels.ans) <- c("item",paste("group",1:n.grouping,sep=""))
colnames(mat.ans) <- colnames(answer[[1]])
rn <- 1:(n.var*n.groups)
k <- 1
labels.ans[,1] <- seq(1,(n.var*n.groups))
# for (grouping in 1:n.grouping) { labels.ans[,grouping+1] <- attr(answer,"dimnames")[[grouping]] }#no
group.scale <- cumprod(c(1,dim(answer)))
for (var in 1:(n.var*n.groups)) {
for (group in 1:n.grouping) {
groupi <- ((trunc((var-1)/group.scale[group]) ) %% dim(answer)[group] ) +1
labels.ans[var,group+1] <- dim.names[[group]][[groupi]]}
}
k <- 1
for (var in 1:n.var) {
for (group in 1:n.groups) {
rn[k] <- paste(row.names[var],group,sep="")
#mat.ans[k,1] <- group
for (stat in 1:n.col) {if(!is.null(answer[[group]][[stat]][var])) {
mat.ans[k,stat] <- round(answer[[group]][[stat]][var],digits)} else { mat.ans[k,stat] <- NA }
}
k <- k + 1}
}
answer <- data.frame( labels.ans,mat.ans)
rownames(answer) <- rn
}
#class(answer) <- c("psych","describe","list")
#answer$Call <- cl
return(answer)}
#added 11/05/20 to fix the problem of NULL values for certain combinations
#doesn't work for 3 way or more classifications 1/5/20 (reported by Nicholas Stefaniak)
#fixed 1/5/20
fix.is.null <- function(x ) {
fix <- data.frame(vars=NA,n=NA,mean=NA,sd=NA,median=NA,trimmed=NA,mad=NA,min=NA,max=NA,range=NA,skew=NA,kurtosis=NA,se=NA)
fix <- char2numeric(fix)
n.obs <- NROW(x)
n.var <- NCOL(x)
n.cells <- length(x)
if(n.cells > n.obs * n.var) {
for (cells in (1:n.cells))
if(is.null(x[cells])) {x[cells] <- fix
}
} else {
if(n.var > 1) {
for (i in 1:n.obs) {
for (j in 1 :n.var) {
if(is.null(x[[i,j]])) x[[i,j]] <- fix}
}
}}
return(x)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.