R/stat.freq.R

In myaseen208/agricolae: Statistical Procedures for Agricultural Research

#' Descriptive measures of grouped data
#' 
#' By this process the variance and central measures ar found: average, medium
#' and mode of grouped data.
#' 
#' 
#' @param histogram Object create by function hist()
#' @return Statistics of grouped data.
#' @author Felipe de mendiburu
#' @seealso \code{\link{polygon.freq}}, \code{\link{table.freq}},
#' \code{\link{graph.freq}}, \code{\link{intervals.freq}},
#' \code{\link{sturges.freq}}, \code{\link{join.freq}},
#' \code{\link{ogive.freq}}, \code{\link{normal.freq} }
#' @keywords univar
#' @export
#' @examples
#' 
#' library(agricolae)
#' data(growth)
#' grouped<-with(growth,hist(height,plot=FALSE))
#' measures<-stat.freq(grouped)
#' print(measures)
#' 
#' 
stat.freq <-
function(histogram) {
xx <- histogram$mids
yy <- histogram$counts
media <- sum(yy * xx)/sum(yy)
variancia <- sum(yy * (xx - media)^2)/(sum(yy) - 1)
zz <- histogram$breaks
z <- length(zz)
#Localiza los puntos de un vector
names(yy)<-1:length(yy)
id<-as.numeric(names(yy[max(yy)==yy]))
x1 <- xx[1] - (zz[2] - zz[1])
x2 <- xx[z - 1] + (zz[z] - zz[z - 1])
zz<-c(x1,zz,x2)
yy<-c(0,yy,0)
z<- z+2
names(yy)<-1:length(yy)
# Calculo de la mediana
total<-sum(yy)
suma<-0
i<-0
while (suma<=total/2) {
i<-i+1
suma<-suma+yy[i]
}
tic   <- zz[i+1]-zz[i]
mediana <- zz[i] +(total/2 - suma+yy[i])*tic/yy[i]
mediana<-as.numeric(mediana)
# Calculo de las modas
id<-as.numeric(names(yy[max(yy)==yy]))
modas<-length(id)
clases <- rep(0,2*modas)

for (i in 1:modas) {
j<-id[i]
k<-2*i-1
clases[k] <- zz[j]
clases[k+1]<-zz[j+1]
}
dim(clases)<-c(2,modas)
clases<-t(clases)
colnames(clases)<-c("[-","-]")
mode<-rep(0,modas)
for (i in 1:modas) {
j<-id[i]
delta1<- yy[j]-yy[j-1]
delta2<- yy[j]-yy[j+1]
tic   <- zz[j+1]-zz[j]
mode[i]<-zz[j]+delta1*tic/(delta1+delta2)
}
Moda<-cbind(clases,mode)
lista<-list(variance=variancia,mean=media,median=mediana,mode=Moda)
return(lista)
}