#' Print multiple objects together with their names \cr
#' (Compact and better version of Print)
#'
#' @param ... objects to be printed
#' @param .delim. delimiter string
#' @param .NAchar. a character to indicate NA
#' (One or two single characters, a double byte character, or "" for "na".)
#' @param .FILL. not used.
#' @param fmt a string containing format specification in the form: wid.dig
#' @param .fmt. same as fmt (high precedence)
#' @param .flag. flag options for formatC
#' @param .printrownum. = 0 not to print row numbers for a vector
#' @param .lj. = 1 to left justify character vectors
#' @param .debug. = 1 to print debugging info
#'
#' @details
#' This function can print data.frames and list objects together
#' with other objects.
#' In contrast, \code{lazy.tools::Print} prints data.frames or lists
#' separately.
#'
#' Object named \code{fmt} cannot be printed unless  \code{.fmt.} is given.
#'
#' List objects cannot be formatted. \cr
#' Data.frames can only be formatted by digits= option which
#' specifies the length of the field.
#' Better use \code{Hmisc::format.df} to format data.frames.
#'
#' When the actual arguments consist of string literals or numbers,
#' they will be printed without names.
#'
#' The string literals will be printed without names.
#'
#' The string literals "/" or "\\n" indicate new line when they are not
#' the first object of ... .
#'
#' The native vectors will be printed as column vectors.
#' If a vector has a name, it will be printed as row names.
#' If a vector does not have name, numeric numbers will be printed as
#' row names unless \code{.printrownum.=0} is given.
#'
#' If the objects contain UTF-8 characters, the result may be misleading
#' due to the bug of \code{print.data.frame} method.
#'
#' \code{fmt} or \code{.fmt.} contain, if any,
#'  formats to be used separated by blanks: \cr
#'  \code{fmt="Width.Digits"} will use the following formatC function \cr
#'  \code{formatC( object, format="f", width=Width, digits=Digits )} \cr
#'  to format the object.
#'
#'  The first element, separated by blanks, will be applied to the first
#'  object of ..., the 2nd element to the 2nd object, and so on. \cr
#'  However, when the first object of ... is a string literal, the first
#'  format element will be applied to the 2nd object in ... .
#'
#'  If there are more objects in ... than length(fmt),
#'  the last fmt value will be used to fill.
#'

#'
#'
#' This function can be used with pipe operator.\cr
#'
#' Use \code{capture.output} function, not the return value,
#' to utilize the printed output of this function.
#'
#' @examples
#' df1 <- data.frame(x=1:3, y=11:13, row.names=paste("rn",1:3,sep=""))
#' df1[1,1] <- NA
#' df2 <- data.frame(x=21:24, y=31:34)
#' df2[2,2] <- NA
#' df3 <- data.frame(aa=31:34+.12345, bb=51:54)
#' df3[2,3] <- NA
#' mat <- matrix(1:6,3,2, dimnames=list(NULL,c("c1","C2")))
#' mat[3,2] <- NA
#' array <- array(1:12, dim=c(3,2,2))
#' array[1,1,1] <- NA
#' list <- list(df1,df2)
#' df <- as.data.frame(rbind(df1,df2))
#' df[,2] <- as.character(df[,2])
#' let <- letters[1:4]
#' names(let) <- toupper(let)
#' let[2] <- NA
#' printm( "title",1:3, df1, df2, df3, "/", list, df2+df2, mat, array
#'         , "newline", "\n", let, letters[1:2], letters[2] )
#'
#' # vector, matrix and array with format
#' printm( mat[1,], mat, array, fmt="5.0 5.2 6.3")
#' # data frame with format: wid part of wid.dig will be used as digits=wid.
#' printm( df1+0.12345, df1+0.12345, df1+0.12345, fmt="3 4 7")
#'
#' # no blank line before but a blank line after.
#' cat("No blank lines.\n")
#' printm(mat)
#' cat("One blank line above.\n")
#' cat("To insert a blank line, use below.\n")
#' printm("","/", mat+mat)
#'
#' @export
#'

printm <- function( ...,   .delim.=" ", .NAchar.=".", .FILL.=".^"
                    , fmt="", .fmt.="", .flag.=" "
                    , .printrownum.=1,  .lj.=0, .debug.=0 ){
 # print many objects with name
 # Shin-ichi Mayekawa
 # 20220822
 # colname for df: 20220906dnc,08
 # FILL and NAchar: 20220906dnc
 # string literal: 20220906dnc,07
 # avoid printing list and NULL: 20220910cot
 # some stringsAsFactors missing: 20220914dnc
 # printm as an alias: 20240626
 # return the first element of ... invisibly: 20240626
 # print rownames: 20250121
 # new colnames: 20250122
 # format: 20250122
 # .fmt --> fmt: 20250122
 # examples: 20250131
 # print fmt: 20250131
 # flag: 20250131
 # printrownum: 20250201
 # use capture.output for all the ...: 20250202,05,11,12,13,14,17,18
 # "/" and "\n": 20250218,19,20
 # do not add rownames to a scalar: 20250221
 # printm(NA): 20250223
 # MASS:fractions: 20250301
 # justify left string vector and data frame: 20250306
 # .lj.: 20250307
 # locatt[1]: 20250308
 # when NULL is the first of ...: 20250415
 # \\\\\\\\ -> \\\\: 20250417toyota
 # format when the 1st obj is a string literal: 20250417toyota
 # function, expression etc: 20250722
 # do not remove attributes from list: 20250727
 # valtype as mode, not typeof: 20250820
 #

 # analyze ...
 name=as.character(substitute(list(...)))[-1L]
 val <- list(...)

 if( .debug.){
  cat("name\n")
  print(name)
  cat("val\n")
  print(val)
 }

 # remove NULL objects
 locnull=which(unlist(lapply(val,is.null)))
 if( length(locnull) > 0 ){
  name=name[-locnull]
  val=val[-locnull]
  .fmt.=.fmt.[-locnull]
  .flag.=.flag.[-locnull]
 }
 nvar=length(val)
 if( nvar == 0 ) return( NULL )

 valtype=sapply(val,mode)
 if( .debug. ) print(valtype)

 # functions and expressions
 is_str=numeric(nvar)
 for( i in 1:nvar ){
   if( valtype[i] == "call" ){
   val[[i]]=deparse(val[[i]], width.cutoff=500)
   # print(valtype[i])
  }
  else if( valtype[i] == "function" )
   val[[i]]=deparse(val[[i]], width.cutoff=500)

  if( valtype[i] == "character" ) is_str[i]=1
 }


 # string literals etc
 is_strlit=numeric(nvar)
 for( i in 1:nvar ){
  if( any(class(val[[i]]) == "fractions") )
   val[[i]]=attributes(val[[i]])$fracs
  if( valtype[i] != "function" &&
   all(!is.na(val[[i]]))  &&  all(name[i] == val[[i]]) ) is_strlit[i]=1
 }


 # choose fmt or .fmt.
 if( fmt != ""  && .fmt. != "" ){
  name=c(name,"fmt")
  val=append(val,list(fmt))
  nvar=length(val)
  is_strlit=c(is_strlit,0)
  # names(val)[nvar]="fmt"
 }
 else if( fmt != "" ) .fmt.=fmt

 # decompose format string into a character vector  # 20250415
 if( is.null(.fmt.) || identical(.fmt.,character(0)) || is.na(.fmt.) )
  .fmt.=rep("", nvar)
 else{
  if( length(.fmt.) == 1  && .fmt. != "" ){
   temp=strsplit(.fmt.,split="[\\, ]", fixed=0)[[1]]
   temp=temp[temp != ""]
   .fmt.=temp
  }
 }

 # fill
 if( length(.flag.) == 1 ) .flag.=rep(.flag., nvar)
 if( length(.fmt.) == 1 ) .fmt.=rep(.fmt., nvar)

 # fill the missing format
 if( length(.fmt.) < nvar )
  .fmt.[(length(.fmt.)+1):nvar]=.fmt.[length(.fmt.)]
 if( length(.flag.) < nvar )
  .flag.[(length(.flag.)+1):nvar]=.flag.[length(.flag.)]  # 20250415

 # when the first object is a string literal, add dummy format at the top.
 if( is_strlit[1] == 1 ){
  .fmt.=c("",.fmt.)
 }

 # decompose .fmt. vector into width and digits vectors
 fwid=numeric(nvar)
 fdig=numeric(nvar)
 for( i in 1:length(.fmt.) ){
  fi=.fmt.[i]
  if( fi == "" ){
   fwid[i]=NA
   fdig[i]=NA
  }
  else if( substr(fi,1,1) == "." ){
   fwid[i]=NA
   fdig[i]=as.numeric(substring(fi,2))
  }
  else if( substring(fi,nchar(fi)) == "." ){
   fwid[i]=as.numeric(strsplit(fi,".",fixed=TRUE)[[1]])
   fdig[i]=NA
  }
  else if( regexpr(".", fi, fixed=TRUE) > 0 ){
   fwid[i]=as.numeric(strsplit(fi,".",fixed=TRUE)[[1]][1])
   fdig[i]=as.numeric(strsplit(fi,".",fixed=TRUE)[[1]][2])
  }
  else{
   fwid[i]=fi
   fdig[i]=0
  }
 }


 if( .debug. ){
  print(cbind(.fmt.,fwid,fdig))
 }


 # new lines
 locnl=c(which( name %in% c("/","\n") ),length(name))
 if( length(locnl) > 1 )
  rangenl=range=cbind(c(1,locnl[-length(locnl)]+1)
                      , c(locnl[-length(locnl)]-1,locnl[length(locnl)]))
 else rangenl=matrix(c(1,length(name)),1,2)
 if( length(locnl) > 1  &&  locnl[1] == 1 ) rangenl=rangenl[-1,,drop=FALSE]

 if( .debug. ){
  cat("locnl")
  print(locnl)
  print(rangenl)
  cat("is.null\n")
  print(which(unlist(lapply(val,is.null))))
 }



 # location of the list objects
 loclist=which(unlist(lapply(val,function(x)is.list(x) && !is.data.frame(x))))
 nlist=length(loclist)

 # format each val[[i]] and mark numeric missing values as ","!.!" .
 for( i in 1:nvar ){
  if( !(i %in% loclist) ){
   if( is.numeric(val[[i]]) ){
    if( is.na(fwid[i]) & !is.na(fdig[i]) )
     val[[i]]=formatC(val[[i]], format="f", digits=fdig[i], flag=.flag.[i])
    else if( !is.na(fwid[i]) & is.na(fdig[i]) )
     val[[i]]=formatC(val[[i]], format="f", width=fwid[i], flag=.flag.[i])
    else if( !is.na(fwid[i]) & !is.na(fdig[i]) )
     val[[i]]=formatC(val[[i]], format="f", width=fwid[i], digits=fdig[i]
                      , flag=.flag.[i])
    val[[i]][]=gsub("^ *NA","!.!",val[[i]])
   }
   else if(  .lj. == 1  &&  is.character(val[[i]]) ){
    val[[i]]=format(val[[i]], justify="left")
   }
  }
 }

 if( .debug. ){
  cat("format\n")
  print(cbind(.fmt.,  fwid,  fdig))
  cat("\nafter format val\n")
  print(val)
  str(lazy.tools::was(val))
  print(val[[1]])
 }


 # capture the output of print function to string vector Lines.
 # Lines[[i]] contains a string vector of nrow(val[[i]]) x 1
 # which is the captured output of print(val[[i]]).
 #
 Lines=NULL
 for( i in 1:nvar ){

  if( is.vector(val[[i]]) && !is.matrix(val[[i]]) && !is.list(val[[i]]) ){
   if( .debug. ){
    cat("i=",i,"vec not mat or lst\n")
    print(val[[i]])
    }
   # vector: make it a column vector
   vi=t(t(val[[i]]))
   if( is.null(names(val[[i]])) ){
    if( .printrownum.==1  && is_strlit[i] == 0  && nrow(vi) > 1 )
     rownames(vi)=1:length(vi)
    else rownames(vi)=rep("",length(vi))
   }
   colnames(vi)=""
   Lines[[i]]=capture.output( cat(name[i],"\n")
                    , print(vi, quote=FALSE, right=TRUE, na.print="!.!") )
   if( .debug. ){
    cat(i,"vector\n"); print(val[[i]]); print(Lines[[i]])
   }
  }
  else if( is.data.frame(val[[i]]) ){
   # data.frame: format by ddig which may not work as expected.
   if( .debug. ){
    cat("i=",i,"df\n")
    print(val[[i]])
   }
   ddig=NULL
   if( !is.na(fwid[i]) ) ddig=fwid[i]
   Lines[[i]]=capture.output( cat(name[i],"\n")
        , print.data.frame(val[[i]]
                   , quote=FALSE, right=0, na.print="!.!", digits=ddig) )
   if( .debug. ){
    cat(i,"data.frame\n"); print(Lines[[i]])
   }
  }
  else{
   # other: matrix, arrays and lists
   if( .debug. ){
    cat("i=",i,"other\n")
    print(val[[i]])
   }
   Lines[[i]]=capture.output( cat(name[i],"\n")
         , print(val[[i]], quote=FALSE, right=TRUE, na.print="!.!") )
   if( .debug. ){
    cat(i,"other\n"); print(Lines[[i]])
   }
  }

  if( !is.list(val[[i]]) ){   # 20250727
  # remove attributes (arrays)
  locatt=which( regexpr("attr(", Lines[[i]], fixed=TRUE) > 0 )
  if( length(locatt) > 0 ) Lines[[i]]=Lines[[i]][1:(locatt[1]-1)]
  }

  # replace \\\\ by \\
  Lines[[i]]=gsub("\\\\\\\\", "\\\\", Lines[[i]])

  # missing values: 1st gsub for formatted val and character data frame vars,
  # 2nd gsub for numeric data frame vars.
  if( nchar(.NAchar., type="byte") == 1 ){
   Lines[[i]]=gsub("!.!", paste("  ", .NAchar., sep=""), Lines[[i]], fixed=1)
   Lines[[i]]=gsub("NA", paste(" ", .NAchar., sep=""), Lines[[i]], fixed=1)
  }
  else if( nchar(.NAchar., type="byte") >= 2 ){
   Lines[[i]]=gsub("!.!",  paste(" ", .NAchar., sep="") ,Lines[[i]], fixed=1)
   Lines[[i]]=gsub("NA",  paste("", .NAchar., sep="") ,Lines[[i]], fixed=1)
  }
  else{
   Lines[[i]]=gsub("!.!", " na", Lines[[i]], fixed=1)
   #  Lines[[i]]=gsub("NA", .NAchar. ,Lines[[i]], fixed=1)
  }

  # remove object name from string lietral
  if( is.character(val[[i]]) && length(val[[i]]) == 1
                             && is_strlit[i] == 1 ){
    Lines[[i]]=Lines[[i]][-(1:2)]
  }

 } # end of i loop

 if( .debug. ){
  cat("\nLLLLL\n")
  print(Lines)
 }
 # Horizontally stack (merge) the string vectors with the key and
 # with or w/o delimiter strings (root=".") to create Df data frame.
 # Each string will have the column name whose root is "._" .
 # These are the shortest column names.
 if( .delim. == "" ){
  Df=data.frame(key__=1:length(Lines[[1]]), Lines[[1]])
  colnames(Df)[2]="._1"
  if( nvar > 1 )
   for( i in 2:nvar ){
    temp=data.frame(key__=1:length(Lines[[i]]), Lines[[i]])
    colnames(temp)[2]=paste("._",i,sep="")
    Df=merge( Df, temp
              , by="key__", all=TRUE, no.dups=FALSE)
   }
 }
 else{
  Df=data.frame(key__=1:length(Lines[[1]]), Lines[[1]])
  colnames(Df)[2]="._1"
  if( nvar > 1 )
   for( i in 2:nvar ){
    temp=data.frame(key__=1:length(Lines[[i]]), .delim., Lines[[i]])
    colnames(temp)[2:3]=c(paste(".",i,sep="")
                          , paste("._",i,sep=""))
    Df=merge( Df, temp
              , by="key__", all=TRUE, no.dups=FALSE)
   }
 }

 # remove key
 Df=Df[,-1, drop=FALSE]

 if( .debug. ){
  cat("\nLines\n")
  print(Lines)
  cat("\nDf\n")
  print.data.frame(Df, row.names=FALSE)
  cat("\n\n***\n")
 }

 # for each newline group
 for( k in 1:nrow(rangenl)){

  # Capture the output of print(Df) in out.
  # Here, nchar(colnames(Df)) must be as small as possible so that
  # .delim. is meaningful.
  # Note that if there are too many objects to print in a line,
  # the out may have multiple vertical groups.

  f=2*(rangenl[k,1]-1)+1
  t=2*rangenl[k,2]-1

  if( .debug. ){
   cat("rangenl\n")
   print(rangenl)
   cat("Df[rangenl]\n")
   print(Df[,f:t])
  }

  out=capture.output( print.data.frame(Df[,f:t, drop=FALSE]
                                       , right=0, print.gap=1
                                       , na.print="NA", row.names=FALSE) )

  # Find the location of the column names of Df and replace them by blank.
  locdots=which( regexpr("._", out, fixed=TRUE) > 0 )
  out[locdots]=" "
  #
  out=out[-1]

  # location of the object names which follow the column names of Df.
  # Find how many blocks (created by print.data.frame function) are there,
  locnames=locdots
  nblock=length(locnames)
  range=matrix(0,nblock,2)
  range[1,]=c(1,length(out))
  if( nblock >= 2 ){
   for( i in 1:(nblock-1) ){
    range[i,]=c(locnames[i],locnames[i+1]-1)
   }
   range[nblock,]=c(locnames[nblock],length(out))
  }

  if( .debug. ){
   print(locnames)
   print(out[locnames])
   print(range)
   cat("\n\n+++\n")
  }

  # replace blank space
  # out=gsub("NA", paste(.NAchar.," ",sep=""), out, fixed=TRUE)
  out=gsub("NA", "  ", out, fixed=TRUE)


  # for each block
  for( i in 1:nblock ){
   for( j in range[i,1]:range[i,2]){
    # remove all blank lines
    if( regexpr("^ +$", out[j]) != 1 ) cat(out[j],"\n")
   }
   cat("\n")
  }

 } # end of k loop

 return( invisible( val[[1]] ) )

} # end of printm



#'
#' @rdname printm
#' @export
#'

Printm <- printm

# end of Printm



