#' Calculates mean, std, variance and n with case weight
#'
#' @param data data vector, matrix or data frame.
#' @param weight case weight vector of length nrow(data) or 1.
#' @param probs vector of probabilities to calculate quantiles
#' @param sandk = 1 to calculate skewness and kurtosis
#' @param by a factor or a list of factors, each of length nrow(data) \cr
#' to be used as the INDICES of by function.
#' @param byvarname vector containing the names of by varialbes to be used.
#'  (Not Yet Implemented.)
#' @param vardef = "n-1" to use n-1 as denominator for variance.
#' @param print = 1 to print the result
#' @param simplify = 0 to return class by object when by= is given.
#'
#' @details
#' The means and vars will be calculated using native weighted.mean function.
#' \cr
#' The kurtosis = weigted.mean( scale(data, scale=FALSE)^4 ) / std^4 - 3
#' The quantiles will be calculated using wquantile function. \cr
#'
#'
#' @return A matrix of statistics(mean, std, var, nobs, n)  x  variables \cr
#' where nobs is sum(weights) for nonmissing obs, and n is nrow(data). \cr
#' In addition, if \code{probs} is given, quantiles will be appended to
#' the above. \cr
#' \cr
#' When by is present, this function returns a class by object
#' consisting of above for each subgroup if simplify=0. \cr
#' If by is not a list and simplify=1,
#' the result is a statistics x variables x subgroups array. \cr
#' If by is a list of several factors, simplify=1 does not affet the result.
#' \cr
#' When X is univariate, the result is a statistics x subgroup matrix.
#' \cr
#' \cr
#' When data is NULL, NULL will be returned.
#'
#' @examples
#' # univariate example
#' y <- 1:9
#' pdf <- exp( -0.5*(y-5)^2/(1.3^2) )
#' pdf <- pdf/sum(pdf)
#' group <- c(1,1,1,1,1,2,2,2,2)
#' mands( y )
#' mands( y, pdf, sandk=1 )
#' mands( y, by=group, sandk=1 )
#'
#' # bivariate example
#' ndims <- 2; npoints <- 11; xmin <- -3; xmax <- 3; corrmat <- 0.2
#' nobs <- 100000
#'
#' # dispersion matrix
#' Dmat <- matrix(corrmat,ndims,ndims)+(1-corrmat)*diag(ndims)
#' Dmat[1,1] <- .5
#'
#' # grid X
#' X <- seq(xmin,xmax,length.out=npoints)
#' if( ndims >= 2 ){
#'  for( i in 2:ndims )
#'   X <- cprod(X,seq(xmin,xmax,length.out=npoints))
#' }
#'
#' # weight
#' pdf <- exp( -0.5*diag( X%*%solve(Dmat)%*%t(X)) )
#' pdf <- pdf/sum(pdf)
#' freq <- round(nobs*pdf+.5)
#'
#' # all data
#' mands( X )
#' mands( X, freq )
#' mands( X, freq, probs=c(0.25,0.5,0.75,0.975) )
#'
#' # grouping variable
#' set.seed(1701)
#' if( is.matrix(X) ) n <- nrow(X) else n <- length(X)
#' byvar <- sample(1:3, n, replace=1)
#' byvar <- sort(byvar)
#'
#' # for each subgroup
#' mands( X, by=byvar )
#' mands( X, freq, by=byvar )
#' mands( X, freq, by=byvar, probs=c(0.25,0.75) )
#'
#' @export
#'

mands <- function( data, weight=1, sandk=0, probs=NULL
                   , by=NULL, byvarname=NULL
                   , vardef="n", print=0, simplify=1 ){
  # weighted statistics: mean, std, variance and n
  # Shin-ichi Mayekawa
  # 20140725 at Madison
  # n added: 20150605
  # no covariance version named mands: 20170906dnc
  # by: 20170919dnc
  # simplify: 20170919,20
  # byvarname: 20170920
  # is.null(data): 20171004
  # var name when x is a vector: 20171025
  # probs: 20171027,29
  # bugfix: 20171110
  # nobs=sum(weight[nomiss]): 20180227dnc,28
  # NaN -> NA: 20190606dnc
  # nrow(data) == 1: 20200830cot
  # all NA: 20210208,10
  # sandk: 20220303
  # bugfix for one-row data: 20230117dnc
  # 
  #
  # Args:
  #   data     data frame or matrix or vector
  #   weight   weight vector or 1
  #   vardef   "n" or "n-1"
  #
  #
  # Value:
  #   A matrix of mean, std, var, nobs, n
  #  where
  #   nobs is the sum of weights
  #

  # error
  if( is.null(data) ){
    return( NULL )
  }

  # # of by variables
  nby=0
  if( is.null(by) ) nby=0
  else if( is.list(by) ) nby=length(by)
  else if( is.vector(by) ) nby=1
  else if( is.matrix(by) && ncol(by) == 1 ){
    nby=1
    by=c(by)
  }
  else if( is.matrix(by) && ncol(by) == 1 ){
    nby=1
    by=as.vector(by)
  }
  else{
    cat("\nerror1:(mands) by must be a vector or list of variables.\n")
    return(NULL)
  }

  # make data a data frame so that, when by is cbinded, the name "by"
  # is used instead of "INDICES".
  if( is.vector(data) ){
    vname=as.character(substitute(data))
    if( all(is.na(vname)) ) vname="V1"
    if( length(vname) >= 2 ) vname=vname[2]   # mands(c(1,2))  20210208
    data=matrix(data,length(data),1)
    if( all(regexpr("^[[:alpha:]][[:alnum:]]*$",vname) > 0 ) )
      colnames(data)=vname
  }

  if( is.matrix(data) ) data=as.data.frame(data, stringsAsFactors=0 )
  vname=colnames(data)
  n=nrow(data)
  if( length(weight) == 1 ) weight=rep(1,n)
  

  # numeric only
  # Note that all NA variable will be classified as logical!! 20210208
  locallna=which(apply(data,2,function(x) all(is.na(x))))
  locnonnum=which(vartype(data) != "numeric")
  # locdel=union(locallna,locnonnum)
  # if( length(locdel) > 0 ) data=data[,-locdel, drop=FALSE]
  if( length(locnonnum) > 0 ) data=data[,-locnonnum, drop=FALSE]
  nvar=ncol(data)
# Print(locnonnum,nvar,data, is.na(X))
  if( (n==1 && all(is.na(data))) || nvar <= 0 ){
    cat("\nerror1:(mands) Must have numeric variables.\n")
    res=matrix(NA,5,ncol(data))
    rownames(res)=c("maen","std","var","nobs","n")
    res[4,]=0; res[5,]=nrow(data)
    return(res)
  }



  ##################################
  # analysis of byvar
  #
  # See matReplace.R in lazy.symbolic.
  # See also test_parent.R in lay.tools directory
  #####################################


  ############## recursive call when by is present #############
  if( !is.null(by) ){

    res=by( cbind(data, weight), by, FUN=function(x){
      mands( x[,-ncol(x)],  weight=x[,ncol(x)], by=NULL, probs=probs
             , sandk=sandk, vardef=vardef, print=print-8 )
    } )

    if( nby == 1 ){
      if( simplify ){
        names=dimnames(res[[1]])
        # names[[3]]=paste(1:length(res),sep="")
        names[[3]]=names(res)
        res=array( unlist(res), dim = c(dim(res[[1]]), length(res)) )
        dimnames(res)=names
        if( ncol(data) == 1 ){
          names=dimnames(res)
          dim(res)=dim(res)[c(1,3)]
          dimnames(res)=names[c(1,3)]
        }
      }
    }

    if( print ) print(res)

    return( res )

  }



  ############# simple call when by is  not present ############


  if( tolower(vardef) == "n" ) method="ML"
  else method="unbiased"

  # use native weighted.mean function
  nvar=ncol(data)
  vname=colnames(data)
  locobs=!apply(data,2,is.na)  # result is the same size as data 20210208
# Print(data,locobs)
  if( nrow(data) == 1 ){       # 20200830
    locobs=!is.na(data)
  }
  nobs=numeric(nvar)
  for( j in 1:nvar ){
    nobs[j]=sum(weight[locobs[,j]])
  }

  mean=apply( data, 2, weighted.mean, w=weight, na.rm=1 )
  mean2=apply( data^2, 2, weighted.mean, w=weight, na.rm=1 )
  var=mean2-mean^2
  if( vardef != "n" ){
    var=(nobs/(nobs-1))*var
  }
  std=sqrt(var)

  # NaN to NA
  mean[is.nan(mean)]=NA
  std[is.nan(std)]=NA
  var[is.nan(var)]=NA


  stat=rbind(mean,std,var,nobs,n)
  rownames(stat)=c("mean","std","var","nobs","n")
  colnames(stat)=vname

  if( !is.null(probs) ){
    qt=apply( data, 2, wquantile, weight, probs )
    qt=matrix(qt,,nvar)
    rownames(qt)=
      paste("Q",formatC(100*probs, width=3,digits=1,format="f",flag="0")
            ,sep="")
    stat=rbind(stat,qt)
  }


  if( sandk == 1 ){
    skew=apply(scale(data,scale=FALSE)^3, 2
               ,  weighted.mean, w=weight, na.rm=1 ) / std^3
    kurt=apply(scale(data,scale=FALSE)^4, 2
               ,  weighted.mean, w=weight, na.rm=1 ) / std^4 - 3
    skew[is.nan(skew)]=NA
    kurt[is.nan(kurt)]=NA
    sk=rbind(skew,kurt)
    rownames(sk)=c("skew","kurt3")
    stat=rbind(stat,sk)
  }

  if( print> 0 ) Print( stat )

  return( stat )

} # end of mands



