The final version with the help of Gabor Grotendieck (thanks Gabor, very much!)
####################### # EasieR - Package # ####################### # Common function er.make.table <- function(x, start, end, h, right) { # Absolut frequency f <- table(cut(x, br=seq(start, end, h), right=right)) # Relative frequency fr <- f/length(x) # Relative frequency, % frP <- 100*(f/length(x)) # Cumulative frequency fac <- cumsum(f) # Cumulative frequency, % facP <<- 100*(cumsum(f/length(x))) fi <- round(f, 2) fr <- round(as.numeric(fr), 2) frP <- round(as.numeric(frP), 2) fac <- round(as.numeric(fac), 2) facP <- round(as.numeric(facP),2) # Make final table res <- data.frame(fi, fr, frP, fac, facP) names(res) <- c('Class limits', 'fi', 'fr', 'fr(%)', 'fac', 'fac(%)') return(res) } #With Gabor Grotendieck suggestions (thanks Gabor, very much!) er.table <- function(x, ...) UseMethod("er.table") er.table.default <- function(x, k, start, end, h, breaks=c('Sturges', 'Scott', 'FD'), right=FALSE) { #User define nothing or not 'x' isn't numeric -> stop stopifnot(is.numeric(x)) #User define only 'x' #(x, {k, start, end, h}, [breaks, right]) if (missing(k) && missing(start) && missing(end) && missing(h) ){ x <- na.omit(x) brk <- match.arg(breaks) switch(brk, Sturges = k <- nclass.Sturges(x), Scott = k <- nclass.scott(x), FD = k <- nclass.FD(x)) tmp <- range(x) start <- tmp[1] - abs(tmp[2])/100 end <- tmp[2] + abs(tmp[2])/100 R <- end-start h <- R/k } #User define 'x' and 'k' #(x, k, {start, end, h}, [breaks, right]) else if (missing(start) && missing(end) && missing(h)) { stopifnot(length(k) >= 1) x <- na.omit(x) tmp <- range(x) start <- tmp[1] - abs(tmp[2])/100 end <- tmp[2] + abs(tmp[2])/100 R <- end-start h <- R/abs(k) } #User define 'x', 'start' and 'end' #(x, {k,} start, end, {h,} [breaks, right]) else if (missing(k) && missing(h)) { stopifnot(length(start) >= 1, length(end) >=1) x <- na.omit(x) tmp <- range(x) R <- end-start k <- sqrt(abs(R)) if (k < 5) k <- 5 #min value of k h <- R/k } #User define 'x', 'start', 'end' and 'h' #(x, {k,} start, end, h, [breaks, right]) else if (missing(k)) { stopifnot(length(start) >= 1, length(end) >= 1, length(h) >= 1) x <- na.omit(x) } else stop('Error, please, see the function sintax!') tbl <- er.make.table(x, start, end, h, right) return(tbl) } er.table.data.frame <- function(df, k, breaks=c('Sturges', 'Scott', 'FD'), right=FALSE) { stopifnot(is.data.frame(df)) tmpList <- list() logCol <- sapply(df, is.numeric) for (i in 1:ncol(df)) { if (logCol[i]) { x <- as.matrix(df[ ,i]) x <- na.omit(x) #User define only x and/or 'breaks' #(x, {k,}[breaks, right]) if (missing(k)) { brk <- match.arg(breaks) switch(brk, Sturges = k <- nclass.Sturges(x), Scott = k <- nclass.scott(x), FD = k <- nclass.FD(x)) tmp <- range(x) start <- tmp[1] - abs(tmp[2])/100 end <- tmp[2] + abs(tmp[2])/100 R <- end-start h <- R/k } #User define 'x' and 'k' #(x, k,[breaks, right]) else { tmp <- range(x) start <- tmp[1] - abs(tmp[2])/100 end <- tmp[2] + abs(tmp[2])/100 R <- end-start h <- R/abs(k) } tbl <- er.make.table(x, start, end, h, right) tmpList <- c(tmpList, list(tbl)) } } valCol <- logCol[logCol] names(tmpList) <- names(valCol) return(tmpList) } Best, -- Jose Claudio Faria Brasil/Bahia/UESC/DCET Estatistica Experimental/Prof. Adjunto mails: [EMAIL PROTECTED] [EMAIL PROTECTED] [EMAIL PROTECTED] tel: 73-3634.2779 ______________________________________________ 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