#' Retrieve the Elements Contained in the Lists in a List
#'
#' This version is very slow!!
#'
#' @param L A list of lists or data frames
#' @param name The name of the list element, or the element number. \cr
#' Can be a vector.
#' @param removenull = 1 to remove NULL elements.
#' @param simplify = 0 not to simplify the result. \cr
#'  = 1 to simplify the result if possible \cr
#'  = 2 to simplify the result if possible when name is a vector. \cr
#'  Only works with \code{method=1}.
#' @param removeNull = 1 to remove all NULL columns.
#' @param method = 2 to use new method with sapply
#' @param debug = 1 to print the details of \code{method=2}
#'
#' @details
#' It is assumed that \code{L} is a list consisting of several lists
#' which contain the same objects.
#'
#' Specifying \code{method=2} is faster but works only when: \cr
#' 1) \code{name} is a scalar and the elements to be retrieved are
#' scalars or vectors with no missing elements, not matrices or lists. \cr
#' The result will be a vector or matrix.
#' 2) \code{name} is a vector and the elements to be retrieved are
#' scalars. \cr
#' The result will be a matrix.
#'
#' If the above conditions are not met, \code{method=1} will be used.
#'
#' Note that, Specifying \code{method=2} is equivalent to \cr
#'  \code{ res <- sapply( L, function(x) x[[name]] ) } \cr
#'
#'
#' When \code{method=1}: \cr
#'
#' If \code{simplify=1} is given, the result will be converted to a data frame
#' or matrix if possible.
#'
#' If the \code{L} contains lists or arrays, or when \code{name} is a vector,
#' the result will not be simplified.
#'
#' Try \code{l2a( lapply( "get_valLL result", a2m, method=2 ) )} .
#'
#' If \code{removenull=1} is given, and \code{name} is not valid,
#'  NULL or named list() may be returned.
#'
#' If the \code{L} consists of data frames only, better use \code{get_valL}.
#'
#' \code{removeNull=1} may be needed when not all the lists in \code{L}
#' have the same set of elements.
#' It can always be set equal to 1 but not thoroughly tested yet.
#'
#' @examples
#' # case where all the lists consists of the objects of the same size.
#' set.seed(1701)
#' n <- 100; nvar <- 3
#' ngroup <- 3
#' X <- matrix(rnorm(n*nvar)/100,n,nvar)
#' group <- sample(1:ngroup,n,replace=1)
#' X <- group+X
#' group <- letters[group]
#' md <- mandd(X,by=group)
#'
#' get_valLL(md,"mean")
#' get_valLL(md,"mean", simplify=0)
#' get_valLL(md,c("mean","cov"))
#'
#'
#' # univariate case with simplify=2
#' md2 <- lapply(md, function(x){lapply(x,"[",1)})
#' get_valLL(md2,"mean")
#' get_valLL(md2,"mean", simplify=0)
#' get_valLL(md2,c("mean","std"))
#' get_valLL(md2,c("mean","std"), simplify=2)
#'
#'
#' # general case
#' L0 <- list( A=(demomat(3,2)*10+1)
#'             , B=(1:3)*10+2
#'             , C=data.frame(demomat(5,4)*10+3)
#' )
#' L00 <- list( A=(demomat(3,2)*100+1)
#'              , B=(1:3)*100+2
#'              , C=(demomat(5,4, root="c"))
#'              , D=(demomat(5,4, root="d"))
#' )
#' L000 <- list( A=(demomat(3,2)*1000+1)
#'               , B=(1:3)*1000+2
#'               , C2=(demomat(5,4)*1000+3)
#'               , D=(demomat(4,5)*1000+4)
#' )
#' L <- list(L0,L00,L000)
#' names(L) <- c("a","b","c")
#'
#' get_valLL( L, "A" ) #   This is a list of matrices.
#' get_valLL( L, "B" ) #   This is a matrix.
#' get_valLL( L, "B", simplify=0 ) #   This is a list of vectors.
#' get_valLL( L, "C", simplify=0 ) # NULL indicates missing elements.
#' get_valLL( L, "D" )  # same as get_valLL( L, 4 )
#' get_valLL( L, 4, removenull=1  ) # missing elements were removed.
#'
#'
#' # example of removeNull
#' L21 <- list( a=1, b=1, c=1 )
#' L22 <- list( a=2, c=2 )
#' L23 <- list( a=3, b=3, c=3 )
#' L2 <- list( x=L21, y=L22, z=L23 )
#' ( get_valLL( L2, "b" ) )
#' ( get_valLL( L2, "b", removeNull=1 ) )
#'
#'
#'
#'
#'#' # Example of \code{method=2}
#'
#' # mean and std are vectors
#' get_valLL(md,"mean", method=2, debug=1)
#' get_valLL(md,"cov", method=2, debug=1) # --> method=1
#' get_valLL(md,c("mean","std"), method=2, debug=1, simplify=2) # -> method=1
#'
#'
#' # mean and std are scalar
#' md2 <- lapply(md, function(x){lapply(x,"[",1)})
#' get_valLL(md2,"mean", method=2, debug=1)
#' get_valLL(md2,c("mean","std"), method=2, debug=1)
#' get_valLL(md2,c("mean","std"), method=1, debug=1, simplify=2)
#'
#'
#' # general case: B is a scalar
#' L0 <- list( A=(demomat(3,2)*10+1)
#'             , B=(1:3)*10+2
#'             , C=data.frame(demomat(5,4)*10+3)
#' )
#' L00 <- list( A=(demomat(3,2)*100+1)
#'              , B=(1:3)*100+2
#'              , C=(demomat(5,4, root="c"))
#'              , D=(demomat(5,4, root="d"))
#' )
#' L000 <- list( A=(demomat(3,2)*1000+1)
#'               , B=(1:3)*1000+2
#'               , C2=(demomat(5,4)*1000+3)   # C is missing.
#'               , D=(demomat(4,5)*1000+4)
#' )
#' L <- list(L0,L00,L000)
#' names(L) <- c("a1","b2","c3")
#'
#' get_valLL( L, "A", method=2, debug=1 ) # --> method=1
#' get_valLL( L, "B" , method=2, debug=1)
#' get_valLL( L, "C", simplify=0, method=2, debug=1 ) # C is NULL at the 3rd list
#' get_valLL( L, 2, removenull=1, method=2, debug=1  ) # same as "B"
#'
#'
#' # example of missing list elements
#' L21 <- list( A=1, B=1, C=1 )
#' L22 <- list( A=2, C=2 )        # B is missing.
#' L23 <- list( A=3, B=3, C=3 )
#' L2 <- list( x=L21, y=L22, z=L23 )
#' get_valLL( L2, "B", method=2, debug=1 )
#' get_valLL( L2, c("A","B"), method=2, simplify=2, debug=1 )
#'
#'
#' # difference between method=1 and 2
#' get_valLL(md2,"mean", method=1)
#' get_valLL(md2,"mean", method=2)
#'
#' get_valLL(L2,"B", method=1, removeNull=1)
#' get_valLL(L2,"B", method=2)
#'
#'
#' @return
#' A list, data frame, matrix or vector consisting of the specified elements.
#'
#' @export
#'

get_valLL <- function( L, name, removenull=0, simplify=1, removeNull=0
                       , method=1, debug=0 ){
 # get values from a list of lists
 # Shin-ichi Mayekawa
 # 20190204rc,05rc
 # do not simplify arrays: 20190206rc
 # && -> &: 20190605
 # bug fix: 20191106dnc
 # removeNull: 20230919
 # name must be a scalar: 20230927
 # new treatment of vector name: 20231015,17
 # use of sapply in roxygen2: 20240401,15
 # method=2 for vector element: 20240520
 # get_valLL11.R and get_valLL12.R not used as package: 20240521
 # error trap and some bug fix: 20240522
 # names(res1)=names(L)[locobs]: 20240523
 # first version 0.1.6: 20240523
 #
 
 if( !is.list(L) ){
  cat("\nerror1:(get_valLL) The first argument must be a list.\n")
  stop()
 }
 
 # check if name contains valid names. char or num.
 nam=lapply(L,names)
 if( is.character(name) ){
  if( !all(name %in% unique(unlist(nam))) ){
   cat("\nerror1(get_valLL) Invalid character name argument.\n")
   stop()
  }
 }
 else{
  if( !( all( 0 < name )  &&  all( name <= max(sapply(nam,length))) ) ){
   cat("\nerror1(get_valLL) Invalid numeric name argument.\n")
   stop()
  }
  else{
   name=unique(unlist(nam))[name]
  }
 }
 
 #
 # method=2 works if and only if:    20240521
 # 1) all the elements are scalar (with possible missing values)
 # 2) all the elements are vector w/o any missing elements.
 #
 
 if( method == 2 ){
  
  len=sapply(L, function(x) sapply( x[ names(x) %in% name ], length ) )
  locobs=which(sapply(len, length) > 0)
  ll=length(len)
  lenlen=sapply(len,length)
  res0=sapply( L, function(x) x[ names(x) %in% name ] )
  
  if( debug >= 2 ){
   Print(len)
   Print(ll,lenlen,locobs,res0)
  }
  
  if( length(name) == 1 ){
   if( debug ) cat("\nlength(name) == 1.\n")
   
   # vector consisting of the lengths of each element of L$name
   # Print(unlist(len), ll, locobs)
   
   dims=sapply(L, function(x) sapply( x[ names(x) %in% name ], dim ) )
   
   if( all(unlist(len) == 1) ){
    # all the elements of L[[i]][name] are scalars
    if( debug ) cat("\nAll of L[[i]][name] are scalar.\n")
    res=unlist( res0 )
    if( all(is.numeric(res)) ) res1=numeric(ll)
    else res1=character(ll)
    res1=NA
    res1[locobs]=res
    names(res1)=names(L)[locobs]    # 20240523
   }
   else if( all(is.numeric(len))  &&  length(unlist(dims)) == 0 ){
    # all the elements of L[[i]][name] are vectors
    if( debug ) cat("\nAll of L[[i]][name] are vectors.\n")
    # Print(dims, unlist(dims))
    # Print(dims, !all(is.null(dims)))
    #Print("**", res0, sapply(res0,length))
    if( all( (sa <- sapply(res0,length)) == length(res0[[1]])) ){
     # vectors of the same length
     if( debug ) cat("\nAll the vectors are the same length.\n")
     res1=matrix(unlist(res0),length(res0),, byrow=1)
     rownames(res1)=names(L)
     colnames(res1)=names(res0[[1]])
    }
    else{
     # vectors of the different length
     if( debug ) cat("\nAll the vectors are NOT the same length.\n")
     # sa defined in all and if functions are available in the parent env.
     res1=matrix(NA,length(res0),max(sa))
     for( i in 1:length(res0) ){
      if( sa[i] > 0 ) res1[i,1:sa[i]]=res0[[i]]       # 20240523
     }
     rownames(res1)=names(L)
     colnames(res1)=paste("_v_",1:ncol(res1),sep="")
    }
   }
   else{
    # the elements of L[[i]][name] are not scalars or vectors or missing
    if( debug ) cat("\nThe elements of L[[i]][name] are not scalars nor vector"
                    , "or some elements are missing. Use method=1.\n")
    # use method=1
    res1=Recall( L, name, method=1, removenull=removenull
                 , simplify=simplify, removeNull=1, debug=debug )
   }
   
   return( res1 )
   
  } # end of length(name) == 1
  else{
   
   # Print(ll,len,locobs )
   #
   # length(name) > 1
   if( debug ) cat("\nlength(name) > 1.\n")
   #
   #if( all(unlist(len) == 1)  ){
   if( all(unlist(len) == 1) && all(lenlen == lenlen[1]) ){
    # all the elements of L[[i]][name] are scalars
    if( debug ) cat("\nAll the elements of L[[i]][name] are scalars.\n")
    res=unlist( res0 )
    if( all(is.numeric(res)) ) res1=numeric(ll)
    else res1=character(ll)
    res1=NA
    res1[locobs]=res
    res1=matrix(res1,length(L),, byrow=1)
    # printm(res0,len,lenlen,res1,names(L),name)
    rownames(res1)=names(L)
    colnames(res1)=name
   }
   else{
    # vector elements
    if( debug ) cat("\nAll the elements of L[[i]][name] are NOT scalars."
                    , " Use method=1.\n")
    # use method=1
    res1=Recall( L, name, method=1, removenull=removenull
                 , simplify=simplify, removeNull=1, debug=debug )
   }
   
   return( res1 )
   
  } # end of length(name) > 1
  
 } # end of method=2
 
 
 
 #
 # Here, !( method == 2  && length(name) == 1)
 # that is,   method == 1  |  length(name) > 1
 #
 
 
 # new treatment of vector name
 if( length(name) > 1  &&  simplify == 2 ){
  
  # recursive call
  # Cannot use Recall here. Reason is not clear!!!
  res1=lapply( name
             , function(x){ get_valLL( L, x, removeNull=1, removenull=0
             , simplify=1, method=1, debug=debug) } )
  # remove non existent elements
  c0=unlist(lapply(res1,function(x){ncol(x)==0}))
  loc=which(c0)
  if( length(loc) > 0 ){
   res1=res1[-loc]
   name=name[-loc]
  }
  
  c1=unlist(lapply(res1,is.matrix))
  c2=unlist(lapply(res1,ncol))==1
  lenres=all(c1 & c2)
  if( all(lenres) ){
   
   
   res=Reduce( data.frame, res1)
   colnames(res)=name
   return( res )
  }
  else{
   names(res1)=name
   return( res1 )
  }
  
 } # end of recursive call
 
 
 
 
 
 
 #####################################################################
 # main body starts here.
 #####################################################################
 
 lengthname=length(name)
 if( lengthname > 1 ) simplify=0
 
 # list of lists
 df=sapply(L, is.data.frame)
 alllist=as.numeric( all(sapply(L, mode) == "list"  &  all(!df)  ) )
 if( !alllist ){
  cat("\nerror1:(get_valLL) List L is not a list of lists.\n")
  cat(" A list of data frames can be handled by get_valL function.\n")
  stop("***")
 }
 
 # get the element names of each list
 nam=lapply(L,names)
 namlen=sapply(nam,length)
 
 # list with no names
 if( is.null(names(L)) ) names(L)=paste("_",1:length(L),sep="")
 else if( any(is.na(names(L))) ){
  names(L)[is.na(names(L))]=paste("_",1:length(L),sep="")[is.na(names(L))]
 }
 
 # Print(name, nam, namlen)
 # Print(is.character(nam))
 
 # pick up the specified list elements
 # If the element specified by name is not present in the k-th list,
 # the k-th element of the subset below is NULL.
 # subset below is a list of lists even if each element is not a list.
 
 # 20240522 comment out
 # if( is.character(nam) ){
 # subset=lapply( L, function(x){ x[names(x) %in% name] } )
 # } else{
 #  subset=lapply( L, function(x){ x[name] } )
 # }
 subset=lapply( L, function(x){ x[name] } )
 
 # name of the non-null subset
 namsubset=names(subset)[unlist(lapply(subset,length))>0]
 if( length(namsubset) == 0 ){
  subset=NULL
 } else if( lengthname == 1 ){
  # convert subset from a list of lists to a simple list
  subset=unlist( subset, recursive=FALSE )
  names(subset)=namsubset
  # str(subset)
 }
 
 # location of null elements of subset
 locnull=sapply(subset,is.null)
 namessubset=names(subset)
 # Print(name,subset,names(subset), locnull, namessubset)
 
 # remove the null elements from subset
 if( removenull ){
  namessubset=names(subset)[!locnull]
  subset=subset[!locnull]
  if( length(subset) == 0 ) subset=NULL
 }
 
 if( !simplify | is.null(subset) ){
  return( subset )
 }
 
 # simplify the result if possible
 
 # If a list is contained in subset, it cannot be simplified
 mode=sapply(subset,mode)
 df=sapply(subset, is.data.frame)
 array=sapply(subset, function(x) length(dim(x) >= 3))
 if( any(mode=="list" & !df) | any(array) ){
  return( subset )
 }
 
 lensubset=length(subset)
 for( k in 1:lensubset ){
  sk=subset[[k]]
  if( is.null(sk) ){
   # if sk is NULL, subset[[k]]=sk removes the k-th element of subset.
   sk=matrix("n_u_l_l",1)
  } else if( is.vector(sk) ){
   namsk=names(sk)
   sk=matrix(sk,1)
   if( is.null(namsk) ) colnames(sk)=paste("_v_",1:ncol(sk),sep="")
   else colnames(sk)=namsk
  }
  subset[[k]]=sk
 }
 
 # convert a list to a data frame
 res=Reduce( stack_df, subset )
 
 # convert to a matrix or data frame
 len=sapply(subset,nrow)
 names_org=rep(namessubset,len)
 vt=vartype(res)
 if( all( vt == vt[1] ) ){
  # matrix
  # res=matrix(res, nrow(res),ncol(res))
  res=as.matrix(res)
  rownames(res)=names_org
 }
 else{
  # data frame
  # names: No duplicate names allowed in df!!!!!!!!
  res=data.frame( key_key_=names_org, res
                  , stringsAsFactors=FALSE )
 }
 
 if( removeNull ){
  # all missing or n_u_l_l columns
  locnull=which( apply(res,2,function(x){ all( is.na(x)| x=="n_u_l_l" )} ) )
  if(length(locnull) > 0 ) res=res[,-locnull, drop=0]
 }
 
 return( res )
 
 
} # end of get_valLL




