#' Frequency distribution of univariate numeric data with case weight
#'
#' @param x numeric vector or column vector
#' @param weights case weight
#' Can be a scalar, vector of size length(x) or matrix of length(x) x nf.\cr
#' If nf > 1, frequency for each column of weights will be calculated.
#' @param npoints # of mid-points
#' @param min minimum value of mid-points
#' @param max maximum value of mid-points
#' @param prob = 1 to return relative frequency in stead of frequency
#' @param midpoints vector of predefied mid-point values
#' @param title tile to be used in plot
#' @param maxf max value of frequency for plot
#' @param wid Format of mid-point value (wid.dig)
#' @param dig Format of mid-point value (wid.dig)
#' @param digits Format for mid-points
#' @param print = 1 to print result
#' @param plot = 1 to plot historgam
#' @return A list consisting of\cr
#'   midpoints =  midpoints \cr
#'   freq =       column vector of frequency at midpoints \cr
#'   breaks =     breaks associated with the midpoints \cr
#'   class =      classification of each obs into the midpoints \cr
#'   nobs =       sum of case weights \cr
#'   error =      error flag
#' @details
#'   (npoints, min, max)  defines the mid-points. \cr
#'    If min or max is NULL, min(x) and max(x) will be used. \cr
#'    midpoints has priority over (npoints, min, max).\cr
#' The out of range observations,  that is, those x satisfying \cr
#'  x < midpoints[1]     or   midpoints[npoints] < x \cr
#'  will be be included in midpoints[1] and midpoints[npoints], resp. \cr
#' \cr
#' Try this to see how the obs on the border are classified. \cr
#'    xx=c(1,2,3,4,5,6,7) \cr
#'    brks=c(0,2,4,6,8) \cr
#'    cc=cut(xx,brks) \cr
#' @examples
#' set.seed(1701)
#' n <- 10000
#' npoints <- 21
#' x <- rnorm(n)
#' res <- freqdist1( x, npoints=npoints,min=-3,max=3, print=1, plot=1 )
#' res1 <- freqdist1( x, midpoints=res$midpoints, print=1 )
#' weight=c(0,1,3,4,2,2,1)
#' freqdist1(seq(-3,3,1),weight, min=-3,max=3,npoints=7, print=1,plot=1)
#' rm(x)
#'
#' @export
#'

freqdist1 <- function( x, weights=1, npoints=7, min=NULL, max=NULL, prob=0
                       , midpoints=NULL, wid=6, dig=1, maxf=NULL
                       , title=NULL, digits=3, print=0, plot=0 ){
 # univariate freq dist of x using midpoints or (npoints, min, max)
 # Shin-ichi Mayekawa
 # 20121026
 # out-of-range observations: 121219
 # return freq: 130218
 # weights with xtabs: 130218
 # title as an arg: 20140417
 # formatC midpoints, maxf: 20140418
 # bugfix for the min/max of breaks: 20140418
 # print categorization: 20140418
 # print # of obs: 20140424
 # prob: 20140424
 # bug fix: 20140523
 # new print method for categorization: 20140524
 # return classification: 20140524
 # order of the arguments: 20140525
 # matrix weights: 20140813,14
 # bug fix for weights: 20150605
 # nobs added to return list: 20150608
 #
 # Args:
 #
 #    x           a variable to be tabulated
 #    weights     assosiated weight vector or 1
 #                can be a matrix of multiple columns
 #
 #    (npoints, min, max)    definition of midpoints
 #               If min or max is NULL, min(x) and max(x) will be used.
 #
 #    midpoints   midpoints of x
 #                If midpoints is NULL, (npoints, min, max) will be used.
 #
 #     prob      = 1 to plot probability, not frequency
 #     maxf      = maximum value of the vertical axis
 #
 #     (wid, dig) formatC for the midpoints in plot
 #
 #    title      plot title
 #
 # Values:
 #
 #   midpoints   midpoints
 #   freq        column vector of frequency at midpoints
 #   breaks      breaks associated with the midpoints
 #   class       classification of each obs into the midpoints
 #   nobs        sum of weights
 #
 #
 # Note:
 #  The out of range observations,  that is, those x satisfying
 #     x < midpoints[1]     or   midpoints[npoints] < x
 #  will be be included in midpoints[1] and midpoints[npoints], resp.
 #
 #
 ##
 # try this to see how the obs on the border are classified.
 # xx=c(1,2,3,4,5,6,7)
 # brks=c(0,2,4,6,8)
 #  cc=cut(xx,brks)
 ##
 #

 # x must be a vector
 if( !is.vector(x) ){
  if( ncol(x) > 1 ){
   cat("\nerror1:(freqdist1) Input must be a vector. Use freqdist.\n")
   return()
  }
  else x=c(x)
 }

 # length
 n=length(c(x))

 # midpoints
 if( is.null(min) ) min=min(x)
 if( is.null(max) ) max=max(x)
 if( is.null(midpoints) ){
  midpoints=seq(min,max,length.out=npoints)
  width=midpoints[2]-midpoints[1]
 }
 else{
  npoints=length(c(midpoints))
  width=NA
 }


 # breaks
 breaks=c(midpoints[2:npoints],midpoints[npoints]+1)
 breaks=(breaks+midpoints)/2
 breaks[npoints]=max(max(breaks),max(x))+0.5
 breaks=c(min(min(breaks),min(x))-0.5,breaks)


 # weights
 if( is.null(weights) ) weights=matrix(1,n,1)
 else if( length(weights) == 1 ) weights=matrix(weights,n,1)
 else if( is.matrix(weights) ){
  if( nrow(weights) != n ){
   cat("\nerror(freqdist1): invalid weight matrix.","\n")
   return()
  }
 }
 else if( is.vector(weights) ){
  if( length(weights) != n ){
   cat("\nerror(freqdist1): invalid weight vector.","\n")
   return()
  }
  else{
   weights=matrix(weights,,1)
  }
 }
 nobs=colSums(weights)
 nf=ncol(weights)

 # categorize the observations  by cutting them at the break points
 ccc=cut( x, breaks=breaks, labels=format(midpoints,digits=digits)
          , include.lowest=1)

 # freq dist with weights
 f=xtabs( weights ~ ccc )

 # convert factors to level labels
 ccc=as.numeric( levels(ccc)[ccc] )
 # Print(ccc)

 #Print("***",weights,ccc,f)

 # f=table(cut(x, breaks=breaks, labels=format(midpoints,digits=digits)
 #           , include.lowest=1))

 freq=as.matrix(f); colnames(freq)=paste("freq",1:nf,sep="")
 # colnames(f)="freq"

 # if( sum(f) == length(c(x)) ) error=0
 if( sum(f) == sum(weights) ) error=0
 else{
  error=1
  cat("\n\nerror1(freqdist1): Sum of freq does not equal to n. \n\n")
 }

 if( print > 0 ){
  cat("\nFrequency Distribution\n")
  if( !is.null(title) ) print(title)
  Print(n,nobs,"/",npoints,min,max,width)

  left=breaks[-npoints]
  left[1]=NA
  left[npoints]=breaks[npoints]
  right=breaks[-1]
  right[npoints]=NA
  left=formatC(left, width=wid, digits=dig, format="f")
  right=formatC(right, width=wid, digits=dig, format="f")
  mp=formatC(midpoints, width=wid, digits=dig, format="f")
  #  char=paste(left, "  <  ", mp, "  <=  ", right, "       ", freq, sep="")
  char=cbind(left, "  <  ", mp, "  <=  ", right, "       ", freq)
  char=rbind(
   c("left brk","   "," middp","    ","right brk", "   ", colnames(freq))
   , char)
  char=matrix(apply(char,1,paste,collapse="  "),,1)
  char=format(char,justify="left")  # centre

  cat("\nCategorization of Variable:\n")
  write.table(char, row.names=FALSE, col.names=FALSE, quote=FALSE)
  #  if( print >= 4 )  Print(x,as.matrix(c),weights)
 }

 if( plot > 0 ){
  if( is.null(title) ) title="Data"
  mp=midpoints
  if( prob == 1 ) f=f/nobs
  if( !is.null(wid) ) mp=formatC(midpoints, width=wid, digits=dig, format="f")
  for( j in 1:nf ){
   ff=freq[,j]
   if( is.null(maxf) ) maxf=max(ff)
   par(new=FALSE)
   barplot(height=ff, names.arg=mp, ylim=c(0,maxf)
     , main=paste("Histogram of ", title, ":   # of obs = ", nobs[j], sep="")
     , sub=paste( "# of midpoints = ", npoints
     , ",  min = ", midpoints[1], ",   max = ", midpoints[npoints]
                        , ",   width =", width
                        , sep="")
           , offset=0  )
  }

 }
 return( list( midpoints=midpoints, freq=freq, breaks=breaks
               , class=ccc, nobs=nobs, error=error ) )

} # end of freqdist1






