#' Calculates mean vector and dispersion matrix with case weight
#'
#' @param data data matrix or data frame.
#' @param weight case weight vector of length nrow(data) or 1.
#' @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 nocov = 1 to skip the calculation of the variance/covariance matrix.
#' \cr \code{mands} function will be used.
#' @param cor = 1 to return the correlation matrix as well.
#' @param print = 1 to print the result
#' @param simplify = 1 to simplify the rewult when by= is given
#'
#' @details
#' When the dispersion matrix is not needed (nocov=1) use \code{mands} function.
#' \cr
#' When simplified=0 is given, the result is a list consisting of \cr
#' vectors: mean, var, std, nobs \cr
#' matrix: cov, nobspair \cr
#' scalars: n, vardef \cr
#' where nobspair is a matrix of the same size as cov containing
#' the weighted # of observations used to calculate cov. \cr
#' When cor=1 is given, correlation matrix will also be returned.
#'
#' When by is specified, the result is a class by list if simplify=0,
#' Otherwise, it is a list consisting of \cr
#' matrices: mean, var, std, nobs \cr
#' lists: cov, nobspair \cr
#' scalars: n, vardef \cr
#' \cr
#' To convert the list of covariance matrices to an array or stacked matrix,
#'  use:
#'  \cr
#'  \code{ library(lazy.mat) } \cr
#'  \code{ cov_array=l2a(res1$cov) } \cr
#'  \code{ cov_mat=a2m(cov_array,method=2) } \cr
#'
#' @return list of: \cr
#' mean vector, var vector, std vector, nobs vector, \cr
#' where nobs is sum(weights) for nonmissing obs and n=nrow(data). \cr
#' cov matrix,  nobspair matrix which contains # of obs. per pair
#' , or NULL, \cr
#' n (# of rows), and vardef.
#'
#' @examples
#' ##################################
#' # data matrix with by group
#' ##################################
#' nobs <- 1000
#' ndims <- 2
#'
#' # covariance matrix
#' cov <- 0.2
#' C1 <- matrix(cov,ndims,ndims)+(1-cov)*diag(ndims)
#' C1[1,1] <- .5
#' C2 <- -C1; diag(C2) <- diag(C1)
#' C3 <- diag(ndims)
#' Printm(C1,C2,C3)
#'
#' # random numbers
#' seed=1701
#' set.seed(seed)
#'
#' # X1 ~ N(0,C1),  X2 ~ N(0,C2),   X3 ~ N(0,C3)
#' X1=matrix(rnorm(nobs*ndims),nobs)
#' ev <- eigen(C1); eva <- diag(ev$values); eve <- ev$vectors
#' X1 <- X1%*%diag(sqrt(ev$values))%*%t(ev$vectors)
#' X2 <- matrix(rnorm(nobs*ndims),nobs)
#' ev <- eigen(C2); eva <- diag(ev$values); eve <- ev$vectors
#' X2 <- X2%*%diag(sqrt(ev$values))%*%t(ev$vectors)
#' X3 <- matrix(rnorm(nobs*ndims),nobs)
#'
#' X <- rbind(X1,X2,X3)
#' byvar <- rep(c("pos","neg","zero"), each=nobs)
#'
#' # missing values
#' locmiss <- sample(1:length(X), 0.2*length(X))
#' X[locmiss]=NA
#'
#' # statistics w/o by-group
#' res0 <- mandd( X )
#' # statistics by by-group
#' res1 <- mandd( X, 1, byvar, simplify=1 )
#' Printm(res1$mean, res1$std, res1$cov)
#'
#'
#' #############################
#' # grid points and weight
#' #############################
#' # C1, C2, C3 are defined above.
#' npoints <- 11; thmin <- -3; thmax <- 3; nobs2 <- 10000
#' theta <- seq(thmin,thmax,length.out=npoints)
#' theta <- cprod(theta,theta)
#' if( ndims > 2 )
#'  for( i in 2:ndims )
#'   theta <- cprod(theta,theta)
#'
#' # weight:  pdf of N(0,C1)
#' thdist1 <- exp( -0.5*diag( theta%*%solve(C1)%*%t(theta) ) )
#' thdist1 <- thdist1/sum(thdist1)
#' n1 <- round(nobs2*thdist1+.5)
#'
#' # statistics
#' res20 <- mandd( theta, n1 )
#' res200 <- mandd( theta )
#' Printm(res20$mean, res200$mean)
#' Printm(res20$var, res200$var)
#' Printm(C1, res20$cov, res200$cov)
#'
#'
#' # missing values
#' seed <- 1701
#' set.seed(seed)
#' locmiss1 <- sample( 1:(npoints^ndims), max(1,(npoints^ndims)/10) )
#' theta[locmiss1] <- NA
#'
#' # statistics
#' res2 <- mandd( theta, n1 )
#' Printm(res2$mean, res2$std, res2$cov)
#'
#'
#' # grid points and weight with by group
#' # theta, nobs2, C1, C2, C3 are defined above.
#' # weight:  pdf of N(0,C2)
#' thdist2 <- exp( -0.5*diag( theta%*%solve(C2)%*%t(theta) ) )
#' thdist2[is.na(thdist2)] <- 0
#' thdist2 <- thdist2/sum(thdist2)
#' n2 <- round(nobs2*thdist2+.5)
#' # weight:  pdf of N(0,C3)
#' thdist3 <- exp( -0.5*diag( theta%*%solve(C3)%*%t(theta) ) )
#' thdist3[is.na(thdist3)] <- 0
#' thdist3 <- thdist3/sum(thdist3)
#' n3 <- round(nobs2*thdist3+.5)
#'
#' Theta=rbind(theta,theta,theta)
#' n=c(n1,n2,n3)
#' byvar2=rep(c("pos","neg","zero"),each=nrow(theta))
#'
#' # statistics
#' res3 <- mandd( Theta, n, byvar2, simplify=1 )
#' Printm(res3$mean, res3$std, res3$cov)
#'
#' @export
#'

mandd <- function( data, weight=1, by=NULL, byvarname=NULL
                   , vardef="n", nocov=0, cor=0, print=0, simplify=0 ){
 # weighted statistics: mean and dispersion matrix
 # Shin-ichi Mayekawa
 # 20140725 at Madison
 # n added: 20150605
 # nocov: 20171024dnc, 20180227dnc
 # nobs and pick up numeric vars: 20180227dnc
 # missing values: 20180227dnc,28
 # nobspair: 20190603
 # by: 20190603,04
 # cor: 20190604,05dnc
 # NaN -> NA: 20190606dn
 # nrow(data) == 1: 20200830cot ???????????????????????????????
 # n=rep(nrow(data),ncol(data)) <--- stack_df side effect: 20200922
 # all NA: 20210209
 # weight=rep(1,n) removed: 20250115
 # Print --> Printm in @examples: 20250115
 #

 #
 # Args:
 #   data     data frame or matrix or vector
 #   weight   weight vector or 1
 #   vardef   "n" or "n-1"
 #
 #
 # Value:
 #   list of mean, var, std, nobs, cov, n, vardef
 #  where
 #   nobs is the sum of weights
 #

 # use mands if cov is not requested
 if( nocov ){
  return( mands( data=data, weight=weight, by=by, byvarname=byvarname
                 , vardef=vardef, print=print, simplify=simplify ) )
 }


 # # 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))
  data=matrix(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
 locallna=which(apply(data,2,function(x) all(is.na(x))))
 locnonnum=which(vartype(data) != "numeric")
 locdel=union(locallna,locnonnum)
 # Print(locallna,locnonnum,locdel)
 if( length(locdel) > 0 ) data=data[,-locdel, drop=FALSE]
 nvar=ncol(data)
 if( nvar <= 0 ){
  cat("\nerror1:(mands) Must have numeric variables.\n")
  retun(NULL)
 }


 ##################################
 # 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) ){

  byvalues=unique(by)
  byvarname=deparse(substitute(by))

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

  if( nby == 1 ){
   if( simplify ){
    names=dimnames(res[[1]])
    mean=get_valLL(res,"mean")
    std=get_valLL(res,"std")
    var=get_valLL(res,"var")
    nobs=get_valLL(res,"nobs")
    n=get_valLL(res,"n")
    cov=get_valLL(res,"cov")
    nobspair=get_valLL(res,"nobspair")
    if( cor ) cor=get_valLL(res,"cor")
    else cor=NULL

    res=list( mean=mean, std=std, var=var, nobs=nobs, n=n, cov=cov
              , nobspair=nobspair, cor=cor, n=n, vardef=vardef )

   }
  }

  if( print ) print(res)

  return( res )

 }



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

 Rmat=NULL
 if( is.vector(data) ) data=matrix(data,,1)
 data=data[, vartype(data)=="numeric", drop=FALSE]
 nvar=ncol(data)
 if( nvar == 0 ){
  cat("\nerror1:(mandd) Must have numeric variables.\n")
  retun(NULL)
 }
 vname=colnames(data)
 n=rep(nrow(data), ncol(data))

 # Print(n,ncol(data),colnames(data))
 # Print(length(weight))
 # stop()

 # if( length(weight) == 1 ) weight=rep(1,n)   # 20250115

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

 if( all(!is.na(data)) ){
  # No Missing Elements
  # use native cov.wt function
  res=cov.wt( data, weight, cor=cor, method=method )
  if( cor ){
   Rmat=res$cor
  }
  cov=res$cov
  mean=res$center
  var=diag(cov)
  std=sqrt(var)
  nobs=rep(sum(weight),nvar)
  nobspair=matrix(sum(weight),nvar,nvar)
  dimnames(nobspair)=dimnames(cov)
  rm(res)
 }
 else{
  # With Missing Elements
  cov=matrix(NA,nvar,nvar)
  if( cor ) Rmat=cov
  nobspair=cov
  for( i in 1:nvar ){
   locobsi=!is.na(data[,i])
   if( nrow(data[,i,drop=0]) == 1 ){       # 20200830
    locobsi=!is.na(data[,i])
   }
   for( j in 1:i ){
    locobs=locobsi & !is.na(data[,j])
    if( sum(locobs) > 0 ){
     nobspair[i,j]=sum(weight[locobs])
     temp=cov.wt( data[locobs,c(i,j)], weight[locobs], cor=cor
                  , method=method )
     cov[i,j]=temp$cov[1,2]
     if( cor ){
      Rmat[i,j]=temp$cor[1,2]
     }
    }
    else{
     nobspair[i,j]=0
    }
    nobspair[j,i]=nobspair[i,j]
    cov[j,i]=cov[i,j]
    if( cor ) Rmat[j,i]=Rmat[i,j]
   }
  }
  res=mands( data, weight=weight, vardef=vardef )
  mean=res[1,]
  std=res[2,]
  var=res[3,]
  nobs=res[4,]
 }
 # var=diag(cov)
 # std=sqrt(var)
 names(mean)=vname
 names(var)=vname
 names(std)=vname
 names(n)=vname
 dimnames(cov)=list(vname,vname)
 dimnames(nobspair)=dimnames(cov)
 if( cor ) dimnames(Rmat)=dimnames(cov)

 if( print> 0 )
  Print( n,nobs,mean,var, std, cov )

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

 res=list( mean=mean, var=var, std=std, nobs=nobs, cov=cov, nobspair=nobspair
           ,  cor=Rmat, n=n, vardef=vardef)
 return(res)

} # end of mandd


