#' Print arguments with their names and formats
#'
#' @param ... objects to be printed with name.
#' @param fmt A vector of formatC to be used
#' @param NAchar a character to represent NA.
#' @param removeatt = 1 to remove the attributes from each of ... .
#' @param printrowname = 0 not to print rownames when printing vector.
#' @param printrownames Same as printrowname.
#' @param fuzz Those elements which satisfy abs(X) < fuzz will be printed.
#' @param fuzzchar Replacement character(s) for those abs(X) < fuzz.
#' @param sep character to be used as the delimiter.
#' @param debug = 1 to dump intermediate result.
#'
#' @return The first element of ... invisibly.
#'
#' @details
#'
#' If ... contains lists or data.frames, they will be printed separetely.#'
#' \cr
#'   Except for the case when ... consists of a single vector,
#'   vectors will be printed as column vectors without row/col names. \cr
#'   To add rownames to vectors, specify printrowname=1. \cr
#'   "/" or "\\n" can be used as the line break. \cr
#' \cr
#'   If any of the input matrices does not have row/col names
#'   they will be generated using "r" and "c" as the roots.
#'\cr
#'   If the first argument is a number or a quoted string, it will be printed
#'   as it is (without name.) \cr
#'\cr
#'   When there are only two objects to be printed,
#'   and the first one is a constant and the second one is not a matrix,
#'   there will be no line breaks  between the first and the second objects
#'   unless the first one has "\\n". \cr
#'    compare:  \cr
#' \preformatted{
#'     Print("first", pi)
#'     Print("first\n", pi )
#'     Print("first", pi, pi )
#' }
#' \cr
#'
#' fmt  contains formats to be used separated by commas or blanks: \cr
#'  \code{fmt="FNameWid.Digits"} will use the following formatC function \cr
#'  \code{formatC( object, format="FName", width=Wid, digits=Digits )} \cr
#'  to format the object. \cr
#'  If there are more objects in ... than length(fmt),
#'  the last fmt value will be used to fill.
#'  \cr
#'
#' When fmt is given, the attributes of the object may be printed together.\cr
#' Use removeatt=1 to remove all the attributes except dimnames and dim.
#'
#'
#' The first element of ... will be returned invisibly so that
#' 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
#' bool <- TRUE; num <- 1; cpl <- 1+1i; str <- "Hello."
#' vec <- 1:10; mat <- matrix(c(1, 2, 3), 3, 2)
#' lis <- list(a=1:3, b="abc",NA); df <- data.frame(a=1:2,b=2:3,c="cc")
#' Print(bool, num, cpl, str, lis, vec, df, mat, plot, sin(0))
#'
#' A=demomat(3,2)
#' Print("This is what I need.", A)
#' Print(A/22)
#' Print(A/22, A/22, fmt="6.2, 8.4")
#' Print(A/22, fuzz=0.6)
#'
#' Print(diag(5),1:3)
#' Print(diag(5), diag(2))
#' Print(diag(5), "/", diag(5))
#' char_vec <- "This is a character vector."
#' Print("string", char_vec, t(1:2))
#'
#' B <- demomat(3,3,2,supermat=2)
#' Print(B,fmt="6.3")
#' Print(B,fmt="6.3", removeatt=1)
#'
#' # with pipe
#' C <- demomat(2,2, root="c")  |> Print(A)
#' print(C)
#' C <- demomat(2,2, root="c")  |> Print(A, .=_)
#' print(C)
#'
#' @export
#'

Print <- function( ...
                   , fmt=NULL, NAchar=".", fuzz=-1, fuzzchar="..", sep=","
                   , removeatt=0, printrowname=0, printrownames=0, debug=0 ){
 #
 # Print objects with names
 # Shin-ichi Mayekawa
 # The orginal version: 080208,11,0512, 0621
 # New versio with Mr. Takekatsu Hiramura
 #  (2010.08.09, 2011.10.28,29,30,1117,20120102,07,26)
 # table, numeric(0) etc: 20120205,08
 # fuzz: 120210
 # fmt: 120211
 # args with length 0: 120302
 # first quoted arg: 120302
 # str( ) : 120302,03
 # bugfix for the first missing: 121020
 # pass debug to printm: 121220
 # Printf: 121223c,24c
 # renamed as Print: 121225(Mitsubishi Motor Company)
 # renamed back to Print: 121227
 # name and val as arguments from Printf: 121228
 # digits as fmt=".digits": 121229
 # key -> name: 121230
 # data frame by Printdf: 121230
 # comments: 130102
 # Printdf removed, mapply modified: 130103
 # fmt in one string: 130103,04
 # new method for NAchar: 130107
 # name w/o as.character is passed to printm: 130107
 # "\n" as a line break: 130108
 # type argument from Printf: no name for all the constants: 130109
 # do not add "\n" to the first constant: 130110
 # omit line break from type: 130111
 # bug fix for the first constant: 130111
 # line break after first const and array: 130130
 # printrownames as alias: 20140809
 # bugfix: 20150526, 20150604dnc
 # remove fraction class: 20150809cot
 # aname: 20151127
 # fuzzchar: 20151215
 # name, val, type, digits removed: 20151215
 # removeat: 20151215
 # print fraction class: 20151215
 # NAchar error in print: 20160705dnc
 # printm -> mprint: 20220822
 # return the first element of ... invisibly: 20240626,27
 #
 #
 #
 # Args:
 #   ...     Objects to be printed
 #           The printing order may be different from the order in ...
 #           Vectors, matrices and arrays will be printed first.
 #
 #   fmt     A vector of formats to be used separated by commas or blanks:
 #           fmt="NameWid.Digits" will use the following formatC function
 #             formatC( object, format="Name", width=Wid, digits=Digits )
 #           to format the object
 #           If there are more objects in ... than length(fmt),
 #           the last fmt value will be used to fill.
 #           If fmt is "", format (not formatC) will be used
 #           for those objects witout format specs.
 #
 #   digits  an integer to specifity the # of digits to the right
 #           of dec point
 #           This will be used as fmt=".digits" when all the fmt are empty.
 #
 #   NAchar  a character to be used to print NA
 #   sep     a character to be used to separate printed objects
 #
 #
 #   Except for the case when ... consists of a single vector,
 #   vectors will be printed as column vectors without row/col names.
 #   To add rownames to vectors, specify printrowname=1.
 #   "/" can be used as the line break.
 #
 #   If any of the input matrices does not have row/col names
 #   they will be generated using "r" and "c" as the roots.
 #
 #   Those elements which satisfy abs(X) < fuzz will be printed
 #   using fuzzchar.
 #
 #   If the first argument is a number or a quoted string, it will be printed
 #   as it is (without name)
 #
 #   When there are only two objects to be printed,
 #   and the first one is a constant and the second one is not a matrix,
 #   there will be no line breaks  between the first and the second objects
 #   unless the first one has \n.
 #    compare:  Print("first", pi)
 #              Print("first\n", pi )
 #              Print("first", pi, pi )
 #
 #
 # Usage:
 #
 #     Print( i, A, B, C,  fmt=c("d1 f5 f5.0 f9.3") )
 #
 #
 # Needs:
 #  mprint.R,  ccbind2c, arraytomatc.R
 #  decomp_fmt.R,  gen_formatC.R
 #

 # old arguments: 20151215
 name=NULL; val=NULL; type=NULL; digits=NULL

 if( is.null(name) ){
  # store ...
  name <- as.list(substitute(list(...)))[-1L]
  val <- list(...)
 }


 # fraction class of MASS
 for( i in 1:length(val) ){
  if( "fractions" %in% class(val[[i]])  ){
   vali=val[[i]]
   clv=class(vali)
   loc=which(clv == "fractions")
   if( length(clv) > 1 ) clv=clv[-1]
   else clv=NULL
   class(val[[i]])=clv
   # Only this may be sufficient
   val[[i]]=format( matrix(attributes(vali)$fracs,nrow(vali)),justify="right")
  }
 }

 # remove zero-length objects
 lenval=lapply(val,length)
 if( debug ){ ##################################
  cat("\n\n**** Top of Print ****")
  cat("\n name:\n"); print(name)
  cat("\n val:\n"); print(val)
  cat("\n lenval:\n"); print(lenval)
  cat("\n fmt:"); print(fmt) ;cat("\n")
 } #############################################

 # initialize format
 if( is.null(fmt) ) fmt=rep("",length(name))
 else{
  if( length(fmt) == 1  && fmt != "" ){
   temp=strsplit(fmt,split="[\\, ]", fixed=0)[[1]]
   temp=temp[temp != ""]
   fmt=temp
  }
 }
 if( length(fmt) < length(name) )
  fmt[(length(fmt)+1):length(name)]=fmt[length(fmt)]

 # convert digits to fmt
 if( !is.null(digits)  && all(fmt == "") ){
  fmt=paste(".", digits,sep="")
  fmt=rep(fmt,length(name))
 }
 if( debug > 0 ){ ###########################################
  cat(" initial fmt =", fmt, " length =", length(fmt), "\n")
 } ##########################################################



 # remove zero-length objects
 loc=which( lenval == 0 )
 if( length(loc) > 0 ){
  cat("\nThe lengths of the following areguments are zero.\n")
  print(name[loc])
  if( length(grep("str\\(",name)) > 0 ){
   cat(" str function cannot be printed by Print.\n")
  }
  name=name[-loc]
  val=val[-loc]
  fmt=fmt[-loc]
 }
 if( length(name) == 0 ){
  return()
 }
 nname=length(name)

 # type of arguments: 130109
 # logical, double, integer, complex, character, symbol, language, etc
 # Printf and Print are the only functions to define type
 if( is.null(type) )
  type=sapply( name, typeof )


 # remove the type of line break (which is 'character')
 loc=which( name == "/"  |  name == "\n" )
 if( length(loc) > 0 ) type=type[-loc]

 # check if all are vector or matrix or array class
 morvora=( sapply( val, is.array ) + sapply( val, is.matrix )
           + sapply( val, is.vector )*!sapply( val, is.list ) )
 morvora=morvora*!sapply( val, is.table )
 locmorvora=which(morvora >= 1)
 locother=which(morvora == 0)

 # extract data frames
 # locdf=which( sapply( val, is.data.frame ) )
 # locother=setdiff( locother, locdf )

 # In this version, locdf is NOT used.
 locdf=NULL

 # alias
 if( printrownames != 0 ) printrowname=printrownames

 if( debug ){ ############################
  cat("\n(Print) after removing NULL objects\n")
  cat("\n nname = ",nname,"\n")
  cat("\n name = \n")
  print(name)
  cat("\n loc = ")
  print(loc)
  cat("\n type = ")
  print(type)
  cat("\n morvora = ")
  print(morvora)
  cat("\n locmorvora = ")
  print(locmorvora)
  cat("\n locother = ")
  print(locother)
  if( !is.null(locdf) ){
   cat("\n locdf = ")
   print(locdf)
  }
 } #######################################


 if( any(morvora >= 1 ) ){
  # use mprint.R

  # print the first constant w/o name and remove it from the list
  # name1=as.character(name)[locmorvora]
  name1=name[locmorvora]
  # name1=as.character(name[locmorvora])
  val1=val[locmorvora] # This is how to subset a list:  not [[ loc ]]
  fmt1=fmt[locmorvora]
  if( debug ){ #######################################################
   cat("\n name1 is as.character(name)[locmorvora]:\n")
   cat("name1[[1]]=", name1[[1]],":\n")
   cat("val1[[1]][[1]]=", val1[[1]][[1]],":\n")
   cat("fmt1=", fmt1[1],":\n")
  } ##################################################################

  # remove attributes if requested: 20151215
  if( removeatt ){
   for( i in 1:length(name1) ){
    att=attributes(val1[[i]])
    attributes(val1[[i]])=att[names(att) %in% c("dimnames","dim")]
   }
  }

  if( type[1] %in% c("character", "double", "integer"
                     , "complex", "logical") ){
   if( debug > 0 ) cat("\n(Print): First arg. is a constant.\n")

   # print it
   cat(val1[[1]]   ,"\n") # \n added 20150604

   if( nname == 1 ){
    cat("\n")
    return(invisible(val1[[1]]))
   }

   # remove the printed
   name1=name1[-1]
   val1=val1[-1]
   fmt1=fmt1[-1]
   type=type[-1]

   if( debug > 0 ){ ################################################
    cat("\nval1[1][[1]]=", val1[1][[1]],"\n")
    cat("type[1]=", type[1],"\n")
    cat("typeof(val1[1][[1])=\n", typeof(val1[1][[1]]),"\n")
    cat("is.matrix(val1[1][[1])=\n", is.matrix(val1[1][[1]]),"\n")
   } ###############################################################
   # If the object next to the first constant is matrix or array, NEWLINE.
   if( is.matrix(val1[1][[1]]) || is.array(val1[1][[1]]) ) cat("\n")
  }

  nname1=length(name1)



  if( nname1 > 0 ){
   if( debug > 0 ){ ###################################
    cat("\n nname1 = ", nname1, "\n")
   } ##################################################

   # subsets defined by line breaks
   loc=NULL
   loc0=which( val1 == "/" | val1 == "\n" ) # the locations of line breaks
   if( debug ){ #################################################
    cat("\n location of line breaks \n")
    print(loc0)
   } ############################################################
   if( length(loc0) > 0 ){
    # remove consecutive line breaks
    if( length(loc0) >= 2 ){
     loc=loc0[1]
     for( i in 2:length(loc0)){
      if( loc0[i] != loc0[i-1]+1 ) loc=c(loc,loc0[i])
     }
    }
    else loc=loc0

    # index of subsets
    loc=unique( c(1,loc,nname) )
    from=loc[1]; to=loc[2];
    if( length(loc) > 2 ){
     for( i in 2:(length(loc)-1) ){
      from=c(from,loc[i]); to=c(to,loc[i+1])
     }
    }
   }
   else{
    # no line breaks
    from=1; to=nname1;
   }
   nsub=length(from)

   if( debug ){ #################################################
    cat("\n # of subsets to be passed to mprint =", nsub
        , " with the following 'from' and 'to':\n")
    print(from); print(to)
   } ############################################################

   # when input consists of "\n" only. 20150604dnc
   if( is.na(to[1]) ) return(invisible())


   # for each subset, use mprint
   for( i in 1:nsub ){
    loc1=setdiff(from[i]:to[i],loc0)
    if( length(loc1) > 0 ){
     # remove NA or NULL elements (don't know where they come from!)
     name11=name1[loc1]
     loc11=!is.na(name11) & (1-unlist(lapply(name11,is.null)))
     name11=name11[loc11]
     val11=val1[loc1][loc11]
     fmt11=fmt1[loc1][loc11]
     if( debug ){ #######################################################
      cat("\n the following arguments are passed to mprint (",i,")\n")
      cat(" loc1 = ", loc1,  ", loc11 = ", loc11, "\n")
      cat(" name11 = ")
      print( name11 )
      cat(" val11 = ")
      print( val11 )
      cat(" fmt11 = ", fmt11, "length(fmt11)="
          , length(fmt11), "\n")
     } ##################################################################
     # use mprint
     if( length(name11) > 0 )  # 20150526
      mprint( name=name11, value=val11, fuzz=fuzz, fuzzchar=fuzzchar, fmt=fmt11
              , digits=digits, sep=sep, NAchar=NAchar
              , novecrname=1-printrowname, debug=debug, type=type )
    }
   } # end of i loop
  } # end of nname1 > 0

  # return(val1[[1])

 } # end of matrix etc


 # data frame: Not used
 #  if( length(locdf) > 0 ){
 #   name1=name[locdf]
 #   val1=val[locdf]
 #   fmt1=fmt[locdf]
 #   if( debug > 0 ){ ###################################################
 #    cat("\n**The following objects will be handled by Printdf\n")
 #    cat("name1\n"); print(name1)
 #    cat("val1\n"); print(val1)
 #   } ##################################################################
 #   for( i in 1:length(locdf) ){
 #    Printdf( name=name1[[1]], val1[[1]], fmt=fmt1[[1]], debug=debug
 #           , NAchar=".", digits=NULL, printrowname=0, fuzz=-1, sep="," )
 #   }
 #   # return()
 #  }


 if( length(locother) > 0 ){
  if( any(morvora >= 1 ) ) cat("\n")
  # original method by Mr. Hiramura
  if( debug > 0 ){ ###########################################
   cat("\n****HHHH**** locother=\n")
   print(locother)
  } ##########################################################
  name1=as.character(name[locother])
  val1=val[locother]
  mapply(
   function(k, v){
    cat(k, "= ")
    cat("\n"); print(v); cat("\n")
   }
   ,  # end of funcion
   name1, val1) # end of mapply
  cat("\n")
 }  # end of list etc

 return( invisible(val1[[1]]) )
 # temp=gc()

} # end of Print



mprint <-  function( ..., sep=",", nsep=2, matname=1, digits=NULL, type=NULL
                     , NAchar=".", novecrname=1, fuzz=0, fuzzchar=".."
                     , fmt=NULL, debug=0
                     , name=NULL, value=NULL){
 # print several matrices in a row
 # Shin-ichi Mayekawa
 # 20111202,
 # rn1, cn1, ets as args to ccbin2c: 111203
 # matprint renamed as printm: 111203
 # trim all removed to cope with negative elements: 111205
 # array print: 120102
 # (name,value) as input: 120102
 # NAchar: 120102
 # 120116
 # no col name for a vector: 120125,26,28,30
 # use format when nmat==1: 120210
 # fuzz: 120210,0303
 # bugfix (nmat): 121220
 # new fmt definition for formatC from Printf: 121223c
 # digits option disabled: 121225(Mitsubishi Mortor Company)
 # comments: 130102
 # name w/o as.character is passed from Print: 130109
 # type argument: 130109
 # quote=F -> quote=0: 130110
 # vec names: 20140809
 # fuzzchar: 20151215
 # NAchar error: 20160705dnc
 # printm -> mprint: 20220822
 #
 #
 # Args:
 #   ...      matrices to be printed
 #   sep      a character to be used to separate matrices (first row only)
 #   nsep     # of blanks to separate matrices
 #   matname  not used
 #   digits   # of digits to be used in format function
 #   NAchar   characters to represent NA
 #   novecrname = 1 to omit the rownames for vector arguments
 #
 #   Below two are not usually used.
 #     name     matrix names as a vector
 #     value    matrices as a list
 #
 #
 # Needs:
 #   ccbind2c, arraytomatc,    decomp_fmt, get_formatC
 #
 #
 #  Except for the case of single vector input,
 #  vectors will be printed as column vectors without row/col names.
 #  To add rownames to vectors, specify novecrname=0.
 #
 #  If an input matrix does not have row/col names
 #  they will be generated using "r" and "c" as the roots.
 #
 #  NA  will be printed using NAchar
 #
 #


 arraytomatc <- function( A, fwd="", debug=0 ){
  # convert an array to a character matrix for smart printing
  # to be used in Print
  # Shin-ichi Mayekawa
  # 120102
  # matrix as an array: 130115
  # aname: 20151127,1221
  #

  if( debug  > 0 ){
   cat("\n Top of arraytomatc\n")
   cat(" input = ")
   print(A)
  }
  n3=dim(A)[3]
  nr=dim(A)[1]
  nc=dim(A)[2]

  if( debug  > 0 ){
   cat("nr =",nr,"\n")
   cat("nc =",nc,"\n")
   cat("n3 =",n3,"\n")
  }


  # cannot handle NULL dimnames:
  if( is.null(dimnames(A))){
   dimnames(A)=
    list(paste("r",1:dim(A)[1],sep=""), paste("c",1:dim(A)[2],sep="")
         , paste("a",1:dim(A)[3],sep=""))
  }

  cname=dimnames(A)[[2]]; aname=dimnames(A)[[3]]
  blanks=matrix(rep("",nc),1)    # code=gen_formatC(fX2, X2, fwd2)
  # fA=formatC(A, format=fwd[1]
  #         , width=as.integer(fwd[2]), digits=as.integer(fwd[3]) )
  code=gen_formatC(fA, A, fwd)
  eval(parse(text=code))
  if( debug > 0 ){ ########################################
   cat("\n arraytomatc: code = >>", code, "<<\n")
  } #######################################################

  if( is.matrix(fA) ) fA=array(fA,dim(nr,nc,1))
  if( debug > 0 ){
   cat(" fA =")
   print(fA)
  }

  # Print(cname,blanks,fA)

  # row bind all the sub matrices
  if( is.null(aname) )
   aname=1:n3

  an=aname[1]
  mat=rbind(
   matrix(c(paste(", ,", an),rep("",nc-1)),1), blanks, cname, fA[,,1]
   )
  if( n3 >= 2 )
   for( i in 2:n3 ){
    an=aname[i]
    mat=rbind( mat, blanks,
      matrix(c(paste(", ,", an), rep("",nc-1)),1), blanks, cname, fA[,,i]
    )
   }

  #print(mat, quote=F)

  # remove cname, which was created when rbinded
  rnm=rownames(mat)
  rnm=sub("cname","",rnm)
  rownames(mat)=rnm

  # delete col names
  colnames(mat)=rep("",nc)

  # print(mat, quote=F)

  return( mat )

 } # end of arraytomatc



 ccbind2c <- function( fX1, fX2, name1, name2, rn1, cn1, rn2, cn2
                       , nsep=1, sep=",", matname=1, debug=0
                       , noX1name=0, noX2name=0 ){
  # cbind two character matrices fX1 and fX2 to form matrix big
  # Shin-ichi Mayekawa
  # 20111202
  # tuned to mprint.R: 111203
  # sep=sep -> sep=",": 120102
  # comments: 120102
  # noX2name: 130108
  #
  # Args:
  #  fX1, fX2      Two character matrices to be printed
  #  name1, name2  names for the input matrices
  #  rn1, cn1      row/col names for the first mat
  #  rn2, cn2      row/col names for the 2nd mat
  #  nsep          # of blanks to separate matrices
  #  sep           a character to be used to separate matrices at first row
  #  matname   = 1 to print the matrix name to the left of the body
  #            = 2 to print the matrix name to the left of the column names
  #            = 3 to print the matrix name above the body
  #                method 2 and 3 are not yet available
  #  noX1name    = 1 to skip printing the first matrix name and rownames
  #  noX2name    = 1 to skip printing the second matrix name and rownames
  #

  r1=nrow(fX1); r2=nrow(fX2); c1=ncol(fX1); c2=ncol(fX2);

  if( debug ){
   cat("\nIn ccbind2c:  fX1 and fX2\n")
   cat("fx1="); print(fX1)
   cat("rn1="); print(rn1);
   cat("cn1="); print(cn1);
   cat("noX1name="); print(noX1name)
   cat("fx2="); print(fX2)
   cat("rn2="); print(rn2);
   cat("cn2="); print(cn2);
   cat("noX2name="); print(noX2name)
  }

  # offset = 1 if there are no matrix name for the first one
  offset=0; if( noX1name == 1 ) offset=2;    # 2 for name and rownames
  offset2=0; if( noX2name == 1 ) offset2=2;  # 2 for name and rownames

  # big is the space where X1 and X2 will be stored
  # X1 consists of name1, rowname1, fX1, nsep
  rb=max(r1,r2); cb=c1+c2+nsep+2+2-offset-offset2;
  big=matrix(" ",rb,cb) # fill all the cells with blanks

  # first matrix name and rownames
  if( noX1name == 0 ){
   # first matrix name
   big[1,1]=paste(name1," =")
   # first matrix row names
   big[1:r1,2]=rn1;
  }
  # first matrix body
  big[1:r1,(3-offset):(c1+2-offset)]=fX1;
  # separator: use "?" which will be replaced by blank when printed.
  big[,(c1+3-offset):(c1+3+nsep-1-offset)]="?";
  # comma at row one to separate matrices
  big[1,(c1+3-offset)]=sep

  # second matrix name
  if( noX2name == 0 ){
   big[1,c1+nsep+3-offset]=paste(name2, " =")
   # second matrix row names
   big[1:r2,(c1+nsep+4-offset)]=rn2
  }
  # second matrix body
  big[1:r2,(c1+nsep+5-offset-offset2):cb]=fX2

  if( noX1name == 1 ){
   if( noX2name == 1 )
    colnames(big)=c(cn1,rep(" ",nsep), cn2)
   else
    colnames(big)=c(cn1,rep(" ",nsep), " ", " ", cn2)
  }
  else{
   if( noX2name == 1 )
    colnames(big)=c(" ", " ", cn1,rep(" ",nsep), cn2)
   else
    colnames(big)=c(" ", " ", cn1,rep(" ",nsep), " ", " ", cn2)
  }
  rownames(big)=rep("",rb)

  #  if( matname == 2 ){
  #   if( length(attributes(X1)$title) == 0 ){
  #    title=paste(name1
  #        , paste(unlist(rep(" ",lenfX1-nchar(name1)+1)), sep="",collapse="")
  #        , sep="",collapse="")
  #   }
  #   title=paste(title
  #        , paste(unlist(rep(" ",2*nsep)), sep="",collapse="")
  #        , name2
  #        , paste(unlist(rep(" ",lenfX2-nchar(name2)+1)), sep="",collapse="")
  #        , sep="",collapse="")
  #
  #   attributes(big)$title=title
  #   cat(title,"\n")
  #   print(big[1:rb,1:cb],na.print="",quote=F)
  #  }

  if( debug ) print(big, na.print="",quote=0)

  return(big)

 } # end of ccbind2c



 ############## main body of mprint starts here. ####################

 # blanks
 BLK="                                                                  "

 if( debug > 0 ){ ###############################
  cat("\n\n*** Top of mprint ***\n\n")
  cat("name ="); print(name)
  cat("value ="); print(value)
  cat("typeof(name) ="); print(typeof(name))
 } ###############################################

 # type of arguments: 130109
 # logical, double, integer, complex, character, symbol, language, etc
 if( is.null(type) )
  type=sapply( name, typeof )

 # make name character
 name=as.character(name)


 if( debug > 0 ){ ###############################
  cat("type ="); print(type)
  cat("name ="); print(name)
 } ###############################################


 # decompose fmt:   resulting fwd is 3 x length(fmt)
 fwd=sapply(fmt, decomp_fmt, debug=debug)
 if( debug > 0 ){
  cat("\nfwd\n")
  print(fwd)
 }

 # process ... args  if name and value are not given
 if( is.null(name) ){
  name=as.character( as.list(substitute(list(...)))[-1L] )
  value=list(...)
 }
 nmat=0
 for( i in 1:length(name) ){
  if( !is.na(name[[i]]) ) nmat=nmat+1
 }
 name=name[1:nmat]; value=value[1:nmat]; type=type[1:nmat];
 fwd=fwd[,1:nmat,drop=0]

 if( debug ){ ########################################################
  cat("(mprint): # of arguments =", nmat, "\n")
  for( i in 1:nmat ){
   cat(i, " name =", name[[i]], ", value =", value[[i]]
       , ", fmt =", fmt[i], ", type =", type[i], "\n")
  }
 } ###################################################################

 if( nmat == 1 ){

  # constant or not
  if( type[1] %in%  c("character", "double", "integer"
                      , "complex", "logical") ){
   cat(value[[1]],"\n")
   return()
  }

  temp0=value[[1]]
  # cat("value[[1]]=",value[[1]],"::")
  if( is.vector(temp0) ){
   # row vectrize
   temp=matrix(temp0,1)
   colnames(temp)=names(temp0)  # 20140809
   rownames(temp)=""
   if( length(temp0) > 0   &&  is.null(colnames(temp)) )
    dimnames(temp)=list(rep("",1),paste("cx",1:ncol(temp),sep=""))
  }
  else temp=temp0

  if( debug > 0 ){ ########################################################
   cat("\n  matrix to be printed stored in temp =", temp,"\n")
  } #######################################################################

  # Here, temp is matrix or array
  if( nrow(temp) == 1  &&  ncol(temp) == 1 ){
   # temp is a scalar
   if( debug > 0 ){ ####################################
    cat("\n temp is a scalar.\n")
   } ###################################################
   code=gen_formatC(temp, temp, fwd)
   eval(parse(text=code))
   colnames(temp)=""
   #### 20130105
   # if( name == temp ) cat(temp)
   # else cat(name, "= ",temp )
   cat(name, "= ",temp )
  }
  else{
   # temp is a matrix or array
   if( debug > 0 ){ ####################################
    cat("\n temp is not a scalar.\n")
   } ###################################################
   rn1=rownames(temp);
   if( length(rn1) == 0 ) rownames(temp)=paste("r",1:nrow(temp),sep="")
   cn1=colnames(temp);
   if( length(cn1) == 0 ) colnames(temp)=paste("c",1:ncol(temp),sep="")

   if( is.numeric(temp) ){
    #temp[abs(temp) <= fuzz]=fuzzchar
    locfz=which(abs(temp) <= fuzz)
    code=gen_formatC(temp, temp, fwd)
    eval(parse(text=code))
    fzc=paste(substr(BLK,1,max(nchar(temp))-nchar(fuzzchar)-1),fuzzchar
              ,collapse=""); temp[locfz]=fzc
    if( debug  > 0 ){ ##################################################
     cat("\n NAchar =:", NAchar,":  temp before NAchar=\n")
     print(temp)
    } #################################################################
    #    temp[grep("NA*",temp)]=NAchar
    #temp=sub("NA",NAchar,temp)
    temp=sub("^NA$",NAchar,temp)
    if( debug  > 0 ){ ##################################################
     cat("\n fwd=", fwd, " with length(fwd)=", length(fwd),"****\n")
     cat(" result of gen_formatC is >>", code, "<< ***********\n")
    } #################################################################
   }
   cat(name, "= ");  cat("\n");
   print(temp, quote=0);
  }
  cat("\n")
  return(invisible())

 } # end of nmat == 1.   returned


 # check if all are vector or matrix class
 morvora=(sapply( value, is.array )) +
  (sapply( value, is.matrix ) + sapply( value, is.vector ) ) *
  !sapply( value, is.list )
 if( any(morvora == 0 ) ){
  locnmorvora=which(morvora == 0)
  nn=name[locnmorvora]
  cat("\nerror:(mprint) Input must be vectors,  matrices or array.\n")
  cat("The following argument(s)  are not vector, matrix nor array.\n")
  cat("    ", nn, "\n")
  return(invisible())
 }

 if( debug ){ #####################################################
  cat("\nTop of nmat >= 2\n")
  for( i in 1:nmat ){
   cat(i, " name =", name[[i]], ", value =", value[[i]]
       , ", fmt =", fmt[i], "\n")
  }
 } ################################################################

 # first two matrices
 X1=value[[1]]; X2=value[[2]];
 nam1=names(X1); nam2=names(X2)    # 20140809
 fwd1=fwd[,1]; fwd2=fwd[,2]
 if( is.array(X1) == 1 && length(dim(X1)) >= 3 )
  X1=arraytomatc( X1, fwd=fwd1, debug=debug )
 if( is.array(X2) == 1 && length(dim(X2)) >= 3 )
  X2=arraytomatc( X2, fwd=fwd2, debug=debug )
 if( is.vector(X1) ){
  # column vectorization
  X1=matrix(X1,,1); rownames(X1)=nam1   # 20140809
  if( nrow(X1) == 1 ) rownames(X1)=""
 }
 if( is.vector(X2) ){
  X2=matrix(X2,,1); rownames(X2)=nam2
  if( nrow(X2) == 1 ) rownames(X2)=""
 }
 name1=sub("^ +", "", name[1]); name1=sub(" +$", "", name1)
 name2=sub("^ +", "", name[2]); name2=sub(" +$", "", name2)

 # small values
 locfz1=integer(0); locfz2=integer(0)
 if( is.numeric(X1) ){
  # X1[which(abs(X1)<=fuzz)]=fuzzchar
  locfz1=which(abs(X1) <= fuzz)
 }
 if( is.numeric(X2) ){
  # X2[which(abs(X2)<=fuzz)]=fuzzchar
  locfz2=which(abs(X2) <= fuzz)
 }
 # matrices 1 and 2 to be column combined
 if( debug ) cat("2.1**************\n")
 # fX1=formatC(X1, format=fwd1[1]
 #           , width=as.integer(fwd1[2]), digits=as.integer(fwd1[3]) )

 code=gen_formatC(fX1, X1, fwd1)
 eval(parse(text=code))
 fzc=paste(substr(BLK,1,max(nchar(fX1))-nchar(fuzzchar)-1),fuzzchar
           ,collapse=""); fX1[locfz1]=fzc
 if( debug ){ ###############################################
  cat("2.2***********", code, "**********\n")
  print(fwd1)
  cat("2.3**************\n")
  print(X1)
  print(fX1)
 } ##########################################################

 # fX2=formatC(X2, format=fwd2[1]
 #            , width=as.integer(fwd2[2]), digits=as.integer(fwd2[3]) )
 code=gen_formatC(fX2, X2, fwd2)
 eval(parse(text=code))
 fzc=paste(substr(BLK,1,max(nchar(fX2))-nchar(fuzzchar)-1),fuzzchar
           ,collapse=""); fX2[locfz2]=fzc
 if( debug ){ #######################################################
  cat("3.2***********", code, "**********\n")
  print(fwd2)
  cat("3.3**************\n")
  print(X2)
  print(fX2)
 } #################################################################
 r1=nrow(fX1); r2=nrow(fX2); c1=ncol(fX1); c2=ncol(fX2);

 # row/col names;
 rn1=rownames(fX1); if( length(rn1) == 0 ) rn1=paste("r",1:r1,sep="")
 cn1=colnames(fX1); if( length(cn1) == 0 ) cn1=paste("c",1:c1,sep="")
 rn2=rownames(fX2); if( length(rn2) == 0 ) rn2=paste("r",1:r2,sep="")
 cn2=colnames(fX2); if( length(cn2) == 0 ) cn2=paste("c",1:c2,sep="")
 if( r1*c1 == 1 || is.vector(value[[1]]) ){ if(novecrname) rn1=""; cn1="" }
 if( r2*c2 == 1 || is.vector(value[[2]]) ){ if(novecrname) rn2=""; cn2="" }


 # replace character NA by DOT
 # fX1[grep("NA *",fX1)]=NAchar
 fX1=gsub("^NA$",NAchar,fX1)
 # fX1=trim(fX1,all=1)
 #fX2[grep("NA *",fX2)]=NAchar
 fX2=gsub("^NA$",NAchar,fX2)
 # fX2=trim(fX2,all=1)

 lenfX1=max(nchar(apply(fX1,1,function(x){paste(x,sep="",collapse="")})))
 lenfX2=max(nchar(apply(fX2,1,function(x){paste(x,sep="",collapse="")})))
 lenfX1=lenfX1+c1+max(nchar(rn1))+1+1
 lenfX2=lenfX2+c2+max(nchar(rn2))+1

 if( type[1] %in%  c("character", "double", "integer"
                     , "complex", "logical") ) nX1n=1
 else nX1n=0
 if( type[2] %in%  c("character", "double", "integer"
                     , "complex", "logical") ) nX2n=1
 else nX2n=0

 # combine first two
 res=ccbind2c( fX1, fX2, name1, name2, rn1, cn1, rn2, cn2, nsep=nsep, sep=sep
               , noX1name=nX1n, noX2name=nX2n)

 if( nmat == 2 ){
  # replace separator mark by blanks
  res=chartr("?", " ", res)
  print( res, quote=0 )
  return( invisible() )
 }

 # add third matrix and later
 for( i in 3:nmat ){

  if( debug > 0 ){ #########################################
   cat("\n\nTop of nmat >= 3\n")
  } ########################################################
  # matrices to be column combined
  fX1=res;
  X2=value[[i]];   if( is.vector(X2) ) X2=matrix(X2,,1)
  fwd1=fwd[,i]
  if( debug ){ ################################################
   cat("\n in the i loop \n")
   cat(" i=", i, " X2 =", X2, ", fwd1 =", fwd1,"\n")
  } ###########################################################

  if( is.array(X2) == 1 && length(dim(X2)) >= 3 )
   X2=arraytomatc( X2, fwd=fwd1, debug=debug )
  if( is.numeric(X2) ){
   # X2[which(abs(X2)<=fuzz)]=fuzzchar
   locfz2=which(abs(X2) <= fuzz)
  }

  # fX2=formatC(X2, format=fwd1[1]
  #          , width=as.integer(fwd1[2]), digits=as.integer(fwd1[3]) )
  code=gen_formatC(fX2, X2, fwd1)
  eval(parse(text=code))
  fzc=paste(substr(BLK,1,max(nchar(fX2))-nchar(fuzzchar)-1),fuzzchar
            ,collapse=""); fX2[locfz2]=fzc
  if( debug ){ #############################################################
   cat("5***********", code, "**********\n")
   print(fwd1)
  } ########################################################################

  name2=name[i]
  r1=nrow(fX1); r2=nrow(fX2); c1=ncol(fX1); c2=ncol(fX2);

  # replace character NA
  #fX1[grep("NA *",fX1)]=NAchar
  fX1=gsub("^NA$",NAchar,fX1)
  # fX1=trim(fX1,all=1)
  #fX2[grep("NA *",fX2)]=NAchar
  fX2=gsub("^NA$",NAchar,fX2)
  # fX2=trim(fX2,all=1)

  # row/col names;
  rn1=rownames(fX1); if( length(rn1) == 0 ) rn1=paste("r",1:r1,sep="")
  cn1=colnames(fX1); if( length(cn1) == 0 ) cn1=paste("c",1:c1,sep="")
  rn2=rownames(fX2); if( length(rn2) == 0 ) rn2=paste("r",1:r2,sep="")
  cn2=colnames(fX2); if( length(cn2) == 0 ) cn2=paste("c",1:c2,sep="")
  if( r1*c1 == 1 ){ rn1=""; cn1="" }
  if( r2*c2 == 1 || is.vector(value[[i]]) ){ if(novecrname) rn2=""; cn2="" }
  if( r2 == 1 ) rn2=""   # 20140809

  # character length: to be used to check if the final result is short enough
  # in the later version.
  lenfX1=max(nchar(apply(fX1,1,function(x){paste(x,sep="",collapse="")})))
  lenfX2=max(nchar(apply(fX2,1,function(x){paste(x,sep="",collapse="")})))
  lenfX1=lenfX1+c1+max(nchar(rn1))+1+1
  lenfX2=lenfX2+c2+max(nchar(rn2))+1

  if( type[i] %in%  c("character", "double", "integer"
                      , "complex", "logical") ) nX2n=1
  else nX2n=0


  res=ccbind2c( fX1, fX2, "", name2, rn1, cn1, rn2, cn2
                , nsep=nsep, debug=debug, noX1name=1, noX2name=nX2n, sep=sep )
  if( debug ){ ##############################################################
   cat("\nafter ccbind2c\n")
   print(res)
  } #########################################################################

 } # end of i loop

 # replace separator mark by blanks
 res=chartr("?", " ", res)

 print(res, quote=0)
 return( invisible( ) )


} # end of mprint




decomp_fmt <- function( fmt, debug=1 ){
 # decompose format string of type:  NameWidth.Digits
 # Shin-ichi Mayekawa
 # 121223c
 # 130103
 #
 # Assuming fmt has a structure: name + width + dot + digits,
 # return the vector consisting of name, width, and digits
 #
 # The default name is "f".
 #   If fmt = ".5",  name="f", width="", digits="5".
 #
 #  fmt is a scalar, not a vector.
 #
 # We could execute formatC from here if we check all the 2^3 possible
 # combinations of fmt[1] -- fmt[3]
 #


 digits=""
 format=""    # defailt format name when nothing is given.
 width=""
 fwd=c("","","")
 if( fmt != "" ){

  # remove digits, if any.
  res=strsplit( fmt, split="\\." )[[1]]
  if( debug > 0 )
   cat("\n decomp_fmt:1", "length(res)=", length(res), " res=", res, "\n")
  if( length(res) >= 1 ){
   digits=res[2]
   res=res[-2]
  }
  if( debug > 0 )
   cat(" decomp_fmt:1", "res=", res, "\n")

  # if there are no name, use "f" as default and return
  if( length(grep("[[:alpha:]]", res)) == 0 ){
   format="f"
   width=res
   if( debug > 0 )
    cat(1.5, res, format,width,digits,"\n")
   fwd[1]=format; fwd[2]=width; fwd[3]=digits
   return( fwd )
  }

  # If res contains "fg", return
  res=strsplit( res, split="fg", fixed=1 )[[1]]
  if( debug > 0 )
   cat(" decomp_fmt:2", "length(res)=", length(res), " res=", res, "\n")
  if( length(res) >= 1  & res[1] == "" ){
   # the first element of strsplit("fg5","fg")[[1]] is NA.
   format="fg"
   width=res[2]
   fwd[1]=format; fwd[2]=width; fwd[3]=digits
   if( debug > 0 )
    cat(" decomp_fmt:2", "res=", res, "fwd=", fwd, "\n")
   return( fwd )
  }

  # Other format type than "fg".
  format=substr(res[1],1,1)
  res=strsplit( res, split="[defgisEG]", fixed=0 )[[1]]
  if( debug > 0 )
   cat(" decomp_fmt:3", "length(res)=", length(res), " res=", res, "\n")
  if( length(res) >= 1 ){
   if( res[1] != "" ) format="f"
   width=res[2]
  }
 }

 # old fortran I format.
 if( toupper(format) == "I" ) format="d"
 if( toupper(format) == "A" ) format="s"
 fwd[1]=format; fwd[2]=width; fwd[3]=digits

 if( debug > 0 )
  cat(" decomp_fmt:final", "fwd=", fwd, "\n")
 return( fwd )

} # end of decomp_fmt



gen_formatC <- function( res, arg, fwd ){
 # generate
 #  code="res=formatC(, arg, format=fwd[1], width=fwd[2], digits=fws[3]) )"
 # and execute it.
 # Shin-ichi Mayekawa
 # 121223c,24c,25
 # suppressWarnings: 20151215
 #
 #  If typeof(arg) is either complex or logical, or
 #  if fwd is empty, format will be used instead of formatC.
 #
 #
 # This module causes error if called as: gen_formatC( A )
 #

 fwdname=as.character(substitute(fwd))
 type=typeof(arg)
 # cat("\n in gen_formatC: typeof(arg) = ", typeof(arg), "\n")
 # cat("\n fwdname=",fwdname,"\n")
 # cat('all(fwd == "") =', all(fwd == ""), "\n")
 if( !(type %in% c("logical", "complex"))  &  !all(fwd == "") ){
  # type is not logical or complex: use formatC
  fwd[is.na(fwd)]=""    #  somewhere fwd[2] may become NA!!
  code=paste( substitute(res)
              , "=suppressWarnings(formatC( ", substitute(arg), sep="" )
  if( fwd[1] != "" )
   code=paste(code, ", format='",fwd[1], "'", sep="")
  if( fwd[2] != "" )
   code=paste( code, ", width=as.integer(", fwdname, "[2])", sep="" )
  if( fwd[3] != "" )
   code=paste( code, ", digits=as.integer(", fwdname, "[3])", sep="" )
  code=paste( code, " ))", sep="" )
 }
 else{
  # use format if type is logical or complex.
  code=paste( substitute(res)
              , "=suppressWarnings(format( ", substitute(arg), " ))", sep="" )
 }
 return( code )

} # gen_formatC



