#' Set up a matrix whose elements consist of row and col numbers.
#'
#' This can create either symbolic or numeric matrix.
#'
#' @param nr # of rows of the matrix to be generated
#'    or a vector consisting of the # of rows of each submatrix.
#' @param nc # of columns of the matrix to be generated
#'    or a vector consisting of the # of columns of each submatrix.
#' @param n3 # of the 3d dimension or 0, if any
#' @param root The root character of the elements of the symbolic matrix. \cr
#' If this is present, a character matrix/array will be created.
#' @param vec = 1 to drop the redundant subscript.
#' @param shape Shape of the resulting matrix: \cr
#'        "sym", "symU", "symL", "diag", "uppert", "lowert"
#' @param nodiag = 1 to set the diagonal elements to 0 when either
#'             "upper" or "lower" is specified
#' @param list = 1 to return the array as list when n3 > 2.
#' @param fullsymb = 1 to make the result a fully symbolic matrix
#' @param mul   See below.
#' @param mul3  See below.
#' @param rnroot root of the row names
#' @param cnroot root of the column names
#' @param anroot root of the third dimension names
#' @param supermat = 1 to create horizontally stacked array\cr
#' = 2 to create vertically stacked array\cr
#' = 0 othereize
#'
#' @details The i,j elements of a matrix will be named as mul*i + j\cr
#'  The i,j,k elements of an array will be named as mul3*(mul*i + j) + k\cr
#'  \cr
#'  When a supermatrix is generated, SMdim attributes will be set \cr
#'  where SMdim	is a list of the form \cr
#'  (nrows=nr, ncols=nc, rownames=rn, colnames=cn, anames=an) \cr
#'  where \cr
#'   nr is a vector consisting of the number of rows of each submatrix, \cr
#'   nc is a vector consisting of the number of columns of each submatrix \cr
#'   rn is a vector consisting of the supplemental row names \cr
#'   cn is a vector consisting of the supplemental column names \cr
#'   an is a vector consisting of the names associated with the 3rd dim.\cr
#'   '
#' @return A matrix or an array. \cr
#' Note that even with vec=1 option, thre result is a matrix. \cr
#' Use c() to convert it to a vector.
#'
#' @examples
#' demomat( 11,3 ) # numeric matrix
#' demomat( 11,3,root="a" ) # symbolic matrix
#' demomat( 4,1,root="a", vec=1 ) # symbolic matrix
#'
#' demomat( 4,3,2 ) # numeric array
#' demomat( 4,3,2, supermat=1 ) # numeric supermatrix (horizontally stacked)
#' demomat( 4,3,2, supermat=2 ) # numeric supermatrix (vertically stacked)
#'
#' # Below two creates almost identical super matrices.
#' demomat( 4,3,2, root="a", supermat=1 )
#' demomat( 4,c(3,3), root="a" )
#'
#' # 2 x 2 partitioned matrix
#' A=demomat( c(4,3),c(3,2), root="a" )
#' Printb(A)
#'
#' # various shape
#' demomat(3,3,root="a", shape="sym")
#' demomat(3,3,root="a", shape="diag")
#' demomat(3,3,root="a", shape="lowert")
#'
#' # fully symbolic matrix
#' demomat(4,4, root="S", fullsymb=1)
#' demomat(4,4, root="S", shape="sym", fullsymb=1)
#'
#' @export
#'

demomat <- function( nr, nc, n3=0, root=NULL, vec=0
                   , shape=NULL, nodiag=0, supermat=0, list=0, fullsymb=0
                   , mul=NULL, mul3=NULL
                   , rnroot="r", cnroot="c", anroot="a" ){
 # geneation of a demo matrix or array whose i,j  or  i,j,k element is
 #     mul*i + j   or   mul3*(mul*i + j) + k
 # Shin-ichi Mayekawa: 070701,02
 # dimnames: 111028
 # 3rd dimension: 120107
 # shape, supermat: 120124
 # row/col names for supermat: 120125
 # attributes$dim.array in comment: 120125
 # initialization of list: 120131
 # shape="sym" corrected: 130109
 # super mat with vector nc and nr: 20150531cot,0601,03
 # symbolic mat; 20150725
 # vec: 20150822
 # leading 0: 20150910JR,ShinagawaP
 # ceiling_n removed: 20150911ShinagawaP,11
 # lowert etc with root: 20150924
 # anname: 20151127
 # rowname, colname renamed as rnroot and cnroot: 20151127
 # list names: 20190206rc
 # names attributes of supermat: 20190207rc
 # roxygen2 error fixed: 20191129dnc
 # reverse the subscripts of supermatrix: 20200525,26
 # fullsymb: 20200527
 # sym with fullsymb: 20250513
 # printm(upptert) removed: 20250627
 #
 # Args:
 #   nr       # of rows (first dimension)
 #            or a vector consisting of the number of rows for each of
 #            vertically stacked matrices.
 #   nc       # of columns (second dimension)
 #            or a vector consisting of the number of columns for each of
 #            horizontally stacked matrices.
 #   n3       # of third dimension
 #   shape    = one of "sym", "symU", "symL", "diag", "uppert", "lowert"
 #   nodiag   = 1 to set the diagonal elements equal to 0 when
 #               shape equals "uppert" or "lowert"
 #   supermat = 2 to return the vertically stacked super matrix
 #            = 1 to return the horizontally stacked super matrix
 #            This option will not be used when vector nr or nc are given.
 #   list     = 1 to return the array as a list with anroot
 #                list has precedence to supermat
 #   mul      = a factor to be multiplied to the row index
 #   mul3     = a factor to be multiplied to the row/column index of an array
 #   rowname  the root of the row names
 #   colname  the root of the column names
 #
 #   root     A character string to be used as the root of symbolic mat.
 #
 #
 # Value:
 #  If i and j are scalar,
 #    res[i,j] = mul*i + j,  i=1,2,...,nr, j=1,2,...,nc
 #    res[i,j,k] = mul3*(mul*i + j) + k,  k=1,2,...,n3
 #   or
 #    if supermat = 2, mat[((k-1)*nr+1):(k*nr),] = res[,,k]
 #    if supermat = 1, mat[,((k-1)*nc+1):(k*nc),] = res[,,k]
 #   or
 #    if list = 1, a list of length n3 consisting of res[,,k]
 #
 #  If supermat= is given, SMdim attribute will be added.
 #  Also S3 class supermatrix is set to the result.  -> abandoned 20150602
 #
 #  If i or j are voctor,
 #   The ii-jj element of the i-j submatrix will be
 #    sub[ii,jj] =(10^wid3)*(mul*ii+jj) +  mul3*i+j
 #   where wid3 is the # of digits of mul3*i+j.
 #
 #
 # If nr and nc are both scalar and if n3 > 0,
 # this program first generates an array of the size c(nr,nc,n3)
 # and, if requested, it will convert the array to either
 # a vertically stacked super matrix, a horizontally stacked super matrix,
 # or a list.
 #
 # If nr or nc are vector, the program works recursively.
 #
 #
 #  Note on supermatrix 20150531
 #   If nr=c(2,3,4)  and nc=c(1,2,4), the following supermatrix SM will be
 #   generated with attributes(SM)$SMdim=list(nrows=c(2,3,4), ncols=c(1,2,4))
 #
 #     c1     c1  c2       c1   c2   c3   c4
 # r1 1111    1112 1212    1113 1213 1313 1413
 # r2 2111    2112 2212    2113 2213 2313 2413
 #
 # r3 1121    1122 1222    1123 1223 1323 1423
 # r4 2121    2122 2222    2123 2223 2323 2423
 # r5 3121    3122 3222    3123 3223 3323 3423
 #
 # r6 1131    1122 1222    1123 1233 1333 1433
 # r7 2131    2122 2222    2123 2233 2333 2433
 # r8 3131    3122 3222    3123 3233 3333 3433
 # r9 4131    4132 4232    4123 4233 4333 4433
 #
 #   If nr=5  and nc=c(1,2,4), the following supermatrix SM will be
 #   generated with attributes(SM)$SMdim=list(nrows=1, ncols=c(1,2,4))
 #   This is a horizontally stacked matrix.
 #
 #     c1    c1  c2    c1  c2  c3  c4
 # r1 111   112 122   113 123 133 143
 # r2 211   212 222   213 223 233 243
 # r3 311   312 322   313 323 333 343
 # r4 411   412 422   413 423 433 443
 # r5 511   512 522   513 523 533 543
 #

 # function to set shapes
 setshape <- function( mat, shape, nodiag ){
  square=0; if( nrow(mat) == ncol(mat) ) square=1
  # printm(mat,shape,nodiag)
  if( square && shape == "DIAG"){
   mat=diag(diag(mat))
  }
  else if( square && (shape == "SYM" || shape == "SYML") ){
   mat[upper.tri(mat,diag=0)]=t(mat)[upper.tri(mat,diag=0)]
  }
  else if( square && shape == "SYMU" ){
   mat[lower.tri(mat,diag=0)]=t(mat)[lower.tri(mat,diag=0)]
  }
  else if( shape == "UPPERT" ){
   mat[lower.tri(mat, diag=nodiag)]=0
  }
  else if( shape == "LOWERT" ){
   mat[upper.tri(mat, diag=nodiag)]=0
  }
  return( mat )
 } # end of setshape



 # list or supermat
 if( list > 0 & supermat > 0 ) supermat=0

 rowname=rnroot; colname=cnroot; aname=anroot
 shape=toupper(shape)
 if( length(shape) == 0 ) shape=""


 ############# recursive call for supermatrix #######################
 if( length(nr) > 1  |  length(nc) > 1 ){

  # how may super-rows and columns
  lnr=length(nr); lnc=length(nc)
  mul0=ceiling_n(max(nc))$val
  if( is.null(mul) ) mul=mul0
  mul0=ceiling_n(lnc)$val
  if( is.null(mul3) ) mul3=mul0
  # wid3=ceiling_n(lnr)$power+ceiling_n(lnc)$power

  res=matrix(0,sum(nr),sum(nc))
  rownames(res)=1:sum(nr); colnames(res)=1:sum(nc)

  for( i in 1:lnr ){
   nri=nr[i]  # This works even if nr is a sclar!
   rnam=paste(rowname,i,"-",1:nri,sep="")
   for( j in 1:lnc ){
    ncj=nc[j]
    cnam=paste(colname,j,"-",1:ncj,sep="")
    # basic row and col elements
    row=matrix(rep(1:nri,ncj), nri, ncj)
    col=t(matrix(rep(1:ncj,nri), ncj, nri))
    A=Recall( nri,ncj,n3=0
              , shape=shape, nodiag=nodiag, supermat=0, list=0
              , mul=mul, mul3=mul3, rnroot=rowname, cnroot=colname )
    dimnames(A)=list(rnam,cnam)

    # reverse the order: submatrix-index + element-index      # 20200525
    wid3=ceiling_n(max(A))$power
    if( lnr == 1 ){
     A=(10^wid3)*j+A        # 20200525
    }
    else if( lnc == 1 ){
     A=(10^wid3)*i+A        # 20200525
    }
    else{
     A=(10^(wid3))*(mul3*i+j)+A        # 20200525
    }

    toi=sum(nr[1:i]); fromi=sum(nr)-sum(nr[i:lnr])+1
    toj=sum(nc[1:j]); fromj=sum(nc)-sum(nc[j:lnc])+1
    res[fromi:toi,fromj:toj]=A
    rownames(res)[fromi:toi]=rnam; colnames(res)[fromj:toj]=cnam
    #Print(i,j,A)
   }
  }
  #class(res)="supermat"
  attributes(res)$SMdim=list(nrows=nr, ncols=nc)

  # add root if any
  if( !is.null(root) ){
   dd=attributes(res)
   wid=ceiling_n(max(res))$power
   locdash=wid-wid3
   # Print(wid3,wid,locdash)
   resf=formatC(res,width=wid,format="d",flag="0")
   # res=paste(root,resf,sep="")     # 20200525
   res=paste(root,substr(resf,1,locdash),"_",substr(resf,locdash+1,wid),sep="")
   attributes(res)=dd
  }

  # fullsymb
  if( fullsymb ) attributes(res)$fullsymb=1

  return(res)

 } # end of recursive call for supermatrix



 ########### standard call #########################
 # basic row and col elements
 row=matrix(rep(1:nr,nc), nr, nc)
 col=t(matrix(rep(1:nc,nr), nc, nr))

 mul0=ceiling_n(nc)$val
 if( is.null(mul) ) mul=mul0


 if( n3 == 0 ){

  # simple matrix
  mat=mul*row+col
  dimnames(mat)=list(paste(rowname,1:nr,sep=""), paste(colname,1:nc,sep=""))
  if( length(shape) > 0 ) mat=setshape( mat, shape, nodiag )

  if( vec == 1 ){
   if( nr == 1 ) mat=col
   if( nc == 1 ) mat=row
  }

  if( !is.null(root) ){
   loczero=which(mat==0)
   dd=attributes(mat)
   wid=ceiling_n(max(mat))$power
   resf=formatC(mat,width=wid,format="d",flag="0")
   mat=paste(root,resf,sep="")
   mat[loczero]="0"
   attributes(mat)=dd
  }

  # fullsymb
  if( fullsymb ){
   attributes(mat)$fullsymb=1

   # full symb symmetric matrix
   if( nrow(mat) == ncol(mat) ){
    if( nrow(mat) == ncol(mat) && shape %in% c("SYM","SYML") ){
     mat[upper.tri(mat,diag=0)]=unlist(
     Map( function(x){paste("t(",x,")", sep="")}, mat[lower.tri(mat, diag=0)] )
      )
    }
    else if( shape == "SYMU" ){
     mat[lower.tri(mat,diag=0)]=unlist(
     Map( function(x){paste("t(",x,")", sep="")}, mat[upper.tri(mat, diag=0)] )
     )
    }
   }

  } # end of fullsymb

  return(mat)

 }
 else{

  # 3D array

  mul0=ceiling_n(n3)$val
  if( is.null(mul3) ) mul3=mul0

  res=array( 0, c(nr,nc,n3)
             , dimnames=list(paste(rowname,1:nr,sep="")
                             , paste(colname,1:nc,sep="")
                             , paste(aname,1:n3,sep=""))
  )
  mat0=mul*row+col       # 20200525,26
  wid3=ceiling_n(max(mat0))$power
  # Print(nr,nc,n3,wid3,mul3)
  for( k in 1:n3 ){
   mat=(10^wid3)*k+mat0       # 20200525,26
   if( length(shape) > 0 ) mat=setshape( mat, shape, nodiag )
   res[,,k]=mat
  }
  an=paste(anroot,1:n3, sep="")
  if( supermat == 2 ){
   # array to vertically stacked super matrix conversion
   res=t(matrix(aperm(res,c(2,1,3)),c(nc,nr*n3)))
   colnames(res)=paste(colname,1:nc,sep="")
   rownames(res)=rep(paste(rowname,1:nr,sep=""),n3)
   attributes(res)$SMdim=
    list(nrows=rep(nr,n3), ncols=nc
         , rownames=rep(an,each=nr), colnames=NULL, anames=an )
   #class(res)="supermat"
  }
  else if( supermat == 1 ){
   # array to horizontally stacked super matrix conversion
   res=array(res,c(nr,nc*n3))
   rownames(res)=paste(rowname,1:nr,sep="")
   colnames(res)=rep(paste(colname,1:nc,sep=""),n3)
   attributes(res)$SMdim=
    list(nrows=nr, ncols=rep(nc,n3)
         , rownames=NULL, colnames=rep(an,each=nc), anames=an )
   #class(res)="supermat"
  }
  else if( list > 0 ){
   # convert array to list
   L=list(); length(L)=n3
   for( k in 1:n3 )
    L[[k]]=res[,,k]
   res=L
   names(res)=paste(aname,1:n3,sep="")
  }

  if( !is.null(root) ){
   loczero=which(res==0)
   dd=attributes(res)
   wid=ceiling_n(max(res))$power
   resf=formatC(res,width=wid,format="d",flag="0")
   if( n3 == 0 ){       # 20200525,26
    res=paste(root,resf,sep="")
   }
   else{
    locdash=wid-wid3
    res=paste(root,substr(resf,1,locdash),"_",substr(resf,locdash+1,wid),sep="")
   }
   if( length(loczero) > 0) res[loczero]="0"
   attributes(res)=dd
  }

  # fullsymb:  This may NOT be necessary!!
  if( fullsymb ) attributes(res)$fullsymb=1


  return(res)

  }

} # end of demomat


