#' Weighted Quantile
#'
#' This program calculates the cdf of x from the frequency distribution
#'  (x, freq) and reverse interpolates it to calculate quantiles.
#'
#' @param x A vector of the random variable
#' @param freq A vector of probability or frequency associated with x
#' @param probs A vector of percents/100
#' @param interpol Name of interpolation function: approx or spline
#' @param ... additional parameters to interpol function.
#'
#' @details
#' When \code{length(unique(x)) <= 10 }, \code{quantile(x,probs=probs)}
#' will be returned.
#' 
#' Quantile and wquantile differs in the way the interpolate (cdf,x). \cr
#' wquantile modifies (cdf,x) to (cdf, xb ) where xb is the mid point of
#' neighboring unique values of x.
#' 
#'
#' @return
#' A vector containing quantile values with name.
#'
#' @examples
#' seed <- 1701
#' set.seed(seed)
#'
#' # original real random variable
#' n <- 100
#' x0 <- 100+10*rnorm(n)
#' # round to integers
#' x <- round(x0)
#' # (xc, f) summarizes the dist of x
#' f <- table(x)
#' xc <- as.numeric(names(f))
#' # expand (xc, f) to (xxf, 1) : These two contains the same info.
#' xxf <- unlist(mapply( rep,xc,f ))
#'
#' # quantiles
#' qtx0 <- quantile(x0)
#' qtx <- quantile(x)
#' qtxxf <- quantile(xxf)
#' qtxc <- quantile(xc)
#' wqtxc <- wquantile( xc, f )
#'
#' # comparison
#' qt <- cbind(qtx0,qtx,qtxxf,qtxc,wqtxc)
#' Print(qt)
#' # difference from the real quantiles
#' dif <- abs(qt-qt[,1])
#' mad <- matrix(colMeans(dif),,1); rownames(mad)=colnames(dif)
#' Print(dif,mad)
#'
#' @export
#'

wquantile <- function( x, freq=1, probs=c(0, .25, .5, .75, 1)
                     , interpol=approx, ... ){
 # weighted quantile
 # Shin-ichi Mayekawa
 # 20150312,17,18, 19 O'Hare, 20
 # wqtl renamed: 20150616
 # wqtl2.R -> wquantile3.R: 20171027
 # use of native quantile when # of obs is small: 20171027
 # midp2brk instead of int option: 20171027
 # use native quantile when freq=1: 20171027
 # when length(unique(freq))==1: 20171110
 # comments: 20230720
 #
 #
 #  Args:
 #   (x, freq)     freq dist of x:  Pr( X=x[i] ) = freq[i]
 #                 x does not have to be uniqe.
 #   prob          vector of probabilities
 #   int           = 1  to add 1/2 to x
 #   interpol      name of the interpolation function: approx or spline
 #
 #  Values:
 #    quantiles    vector of length(probs)
 #
 #  Needs:
 #    interpol, mid2brk
 #

 # unweighted case
 if( length(unique(freq)) == 1 ){
  return( quantile( x=x, probs=probs, na.rm=TRUE ) )
 }


 # unique value of x
 nux=length(unique(x))
 if( nux <= 10 ){
  return( quantile(x, probs=probs, na.rm=TRUE) )
 }


 # normalize freq to p
 p=freq/sum(freq)

 # weighted frequency distribution of (f,x): This takes care of non unique x.
 f=unclass( xtabs( p~x ) )
 attributes(f)=NULL

 # cdf of x
 cdf=cumsum(f)/sum(f)
 xu=sort(unique(x))
 xu=midp2brk(xu)[-1]

 # get quantile by linear interpolation or ( cdf, xu ) to ( orob, quantile )
 # qt=spline( cdf, xu, xout=probs, method="natural" )$y
 # plot( cdf,xu )
 qt=interpol( cdf, xu, xout=probs, ... )$y
 # Print(cdf,xu,probs, qt)
 qt[is.na(qt)]=min(x)
 qt[which(probs == 0)]=min(x)
 qt[which(probs == 1)]=max(x)
 names(qt)=probs

 return( qt )

} # end of wquantile


