#' Get Values from a List Consisting of Data Frames
#'
#' @param L A list of data frames
#' @param s1 Vector consisting of the subscripts for the 1st dimension
#' @param s2 Vector consisting of the subscripts for the 2nd dimension
#' @param s3 Vector consisting of the subscripts for the 3rd dimension
#' @param simplify = 0 to leave the result of get_valL unsimplified (list)
#'
#' @param value The value to be assigned. Either a vector or a matrix.
#'
#' @details
#' It is assumed that \code{L} is a list consisting of several data frames.
#' and the third subscript, \code{s3} is for the list.\cr
#' Therefore, \code{get_valL(L,,,s3)} with scalar s3 is
#' equivalent to \code{L[[s3]]} \cr
#' and  \code{get_valL(L,,,2:3)} returns the 2nd and the 3rd data frames
#' in a list. \cr
#'
#' \code{s1,s2,s3} can be a set of vectors consisting of row/col/list names.
#'
#' \cr
#' When some of the subscripts are out of range, only the valid ones
#' will be used.
#'
#' \cr
#' The result will be simplified to a matrix or vector if possible. \cr
#' When \code{length(s1)==1}, the result will be
#' a \code{length(L)} x \code{ncol(L[[1]])} matrix. \cr
#' When \code{length(s2)==1}, the result will be
#' a \code{ncol(L[[1]])} x \code{length(L)} matrix. \cr
#'
#' @examples
#' L0 <- list( A=data.frame(demomat(3,2)*10+1)
#'           , B=data.frame(demomat(4,3)*10+2)
#'           , C=data.frame(demomat(5,4)*10+3)
#'          )
#' L <- L0
#' get_valL( L, ,,2 ) # should be equal to get_valL( L, ,,"B" )
#' get_valL( L, 2, )  # should be equal to get_valL( L, "r2",, )
#' get_valL( L, ,2 )  # should be equal to get_valL( L, , "c2", )
#' get_valL( L, c(1,3),,3:2 )
#' get_valL( L, c(1,3),, c("B","A") )
#'
#' L <- L0; put_valL(L, 1:2,1:2,3) <- 0;                  Print(L)
#' L <- L0; put_valL(L, 1:2,1:2,c("C","A")) <- 0;         Print(L)
#' L <- L0; put_valL(L, 3:5,2:4,) <- 0;                   Print(L)
#' L <- L0; put_valL(L, 3:5,2:4,2) <- 0;                  Print(L)
#' L <- L0; put_valL(L, 1:4,1,2:3) <- 1:4;                Print(L)
#' L <- L0; put_valL(L, 1:2,2:3,2:3) <- demomat(2,2)*100; Print(L)
#'
#' # effect of simplify
#' L0 <- list( A=data.frame(demomat(3,4)*10+1)
#'           , B=data.frame(demomat(3,4)*10+2)
#'           , C=data.frame(demomat(3,4)*10+3)
#'          )
#' L <- L0
#' get_valL( L, ,,2 )
#' get_valL( L, ,,2, simplify=0 )
#' get_valL( L, 2, )
#' get_valL( L, 2,, simplify=0 )
#' get_valL( L, ,2 )
#' get_valL( L, ,2, simplify=0 )
#'
#' # When the selected elements are scalars, the result is a column vector.
#' get_valL(L0,1:2,1) # matrix
#' get_valL(L0,1,1)   # col vector
#' get_valL(L0,1,1:2) # matrix
#'
#' # mixed type variables in a data frame
#' A <- data.frame(demomat(3,4)*10+1)
#' A[,2] <- paste("c",as.character(A[,2]),sep="")
#' B <- data.frame(demomat(3,4)*10+2)
#' B[,2] <- paste("c",as.character(B[,2]),sep="")
#' C <- data.frame(demomat(3,4)*10+3)
#' C[,2] <- paste("c",as.character(C[,2]),sep="")
#' L <- list(A=A,B=B,C=C)
#'
#' get_valL( L, 2, )
#' get_valL( L, , 2 )
#'
#'
#' @return
#'  \code{get_valL(L, s1,s2,s3)} returns
#'  \code{(s1,s2)} element(s) of the s3-th data frame(s). \cr
#'  \code{put_valL(L, s1,s2,s3) <- value} replaces the \code{s1,s2}
#'  element(s) of the data frame(s) specified by \code{s3}
#'  with \code{value}.
#'
#' @export
#'

get_valL <- function( L, s1=NULL, s2=NULL, s3=NULL, simplify=1 ){
 # list version of get_val
 # Shin-ichi Mayekawa
 # 20171030,31
 # roxgen example added: 20171111
 # when #s of obs are not equal: 20201008
 # A removed from  @param: 20230328cato
 #
 # s3 is the list subscript
 # L is a list of K data frames
 #

 if( !is.list(L) ){
  cat("\nerror1:(get_valL) The first argument must be a list.\n")
  stop()
 }

 lenL=length(L)
 dims=lapply(L,dim)
 namL=names(L)

 # Print(s1,s2,s3,lenL,dims)

 # s3 given as names
 if( is.null(s3) ) s3=1:lenL
 else if( is.character(s3) ){
  s3=loceq(names(L),s3)
 }

 L=L[s3]
 lenL=length(L)
 dims=lapply(L,dim)

 # Print(s1,s2,s3,lenL,dims)

 for( k in 1:lenL ){

  Lk=L[[k]]
  if( is.null(s1) ){
   s01=1:nrow(Lk)
  }
  else if( is.character(s1) ){
   s01=loceq(rownames(Lk),s1)
  }
  else s01=s1

  if( is.null(s2) ){
   s02=1:ncol(Lk)
  }
  else if( is.character(s2) ){
   s02=loceq(colnames(Lk),s2)
  }
  else s02=s2
  ss1=s01[which(s01 %in% 1:nrow(Lk))]
  ss2=s02[which(s02 %in% 1:ncol(Lk))]
  # Print(s1,s01,s2,s02)
  # Print(k,ss1,ss2)
  if( length(ss1)*length(ss2) == 0 ){
   L[[k]]="____NULL____"     # 20201008
  }
  else{
   # Print(k,dim(Lk),s1,ss1,s2,ss2)
   L[[k]]=Lk[ss1,ss2,drop=0]
  }

 }

 # print(L)
 locnull=which(unlist(lapply(L,function(x){x[[1]]=="____NULL____"})))
 # Print(locnull)
 if(length(locnull) == length(s3) ){
  cat("\nerror1:(get_valL) Subscript out of range.\n")
  return( NULL )
 }
 else if( length(locnull) > 0 ){
  L=L[-locnull]
  namL=namL[-locnull]
 }

 if( simplify ){

  if( length(L) == 1 ){
   L=L[[1]]
  }
  else if(  all( sapply(L,nrow) == 1 )
            && all( sapply(L,ncol) == ncol(L[[1]])) ){
   cn=colnames(L[[1]])
   L=do.call( rbind, L )
   #L=matrix(unlist(L),length(L), byrow=1)
   rownames(L)=namL
   colnames(L)=cn
  }
  else if( all( sapply(L,ncol) == 1 )
           && all( sapply(L,nrow) == nrow(L[[1]])) ){
   rn=rownames(L[[1]])
   L=matrix(unlist(L),,length(L))
   colnames(L)=namL
   rownames(L)=rn
  }
 }
 return( L )

} # end of get_valL







#' @rdname get_valL
#' @export
#'

`put_valL<-` <- function( L, s1=NULL, s2=NULL, s3=NULL, value ){
 # modify the value of L at subs
 # Shin-ichi Mayekawa
 # 20171030
 # bugfix A in arg list -> L: 20180203
 #
 
 if( !is.list(L) ){
  cat("\nerror1:(put_valL) The first argument must be a list.\n")
  stop()
 }
 
 if( is.list(value) ){
  cat("\nerror1:(put_valL) The value cannot be a list.\n")
  stop()
 }
 
 lenL=length(L)
 dims=lapply(L,dim)
 
 
 if( is.null(s3) ) s3=1:lenL
 else if( is.character(s3) ){
  s3=loceq(names(L),s3)
 }
 
 # Print(s1,s2,s3)
 
 for( k in s3 ){
  if( is.null(s1) ){
   s01=1:nrow(Lk)
  }
  else if( is.character(s1) ){
   s01=loceq(rownames(Lk),s1)
  }
  else s01=s1
  
  if( is.null(s2) ){
   s02=1:ncol(Lk)
  }
  else if( is.character(s2) ){
   s02=loceq(colnames(Lk),s2)
  }
  else s02=s2
  
  ss1=s01[which(s01 %in% 1:nrow(L[[k]]))]
  ss2=s02[which(s02 %in% 1:ncol(L[[k]]))]
  
  # Print(ss1,ss2)
  if( length(ss1)*length(ss2) == 0 ){
   cat("\nerror1:(put_valL) Subscript out of range.\n")
   return( L )
  }
  # Print(k,s1,s01,ss1,s2,s02,ss2)
  if( is.matrix(value) && (length(ss1) != nrow(value) |
                           length(ss2) != ncol(value) ) ){
   cat("\nerror1:(put_valL) The replacement does not comform.\n")
   stop()
  }
  L[[k]][ss1,ss2]=value
 }
 
 return( L )
 
 
} # endof `put_valL<-`



