#' Check if the Partial Match is correct.
#'
#' @param fargs1 as sys.call() formal arguments
#' @param fargs2 as match.call()  result of the matching
#' @param print = 1 or 2 to print the details.
#'
#' @details
#' This function checks if the arguments listed in ... are correctly
#' matched to the formal arguments of teh called function. \cr
#' The error may occur when ... contains single-lettered arguments.
#' \cr
#' This function should be called at the beginning of any function
#' which has ... as its formal argument.
#'
#' @examples
#' test1 <- function( alpha=0, beta=0, gamma=0, ... ){
#'  #
#'  cat("\nTop of test1\n")
#'
#'  check_partial_match( sys.call(), match.call() )
#'
#'  cat("\n Back to test1\n")
#'  Print(alpha,beta,gamma)
#'  val=list(...)
#'  cat("\n ... contains below:\n")
#'  print(val)
#'  cat("\nBottom of test1\n")
#'
#' } # end of test1
#'
#'
#' test2 <- function(a){
#'   res=test1( alpha=1, b=rep(9,3), d=2,xx=4, g=8, print=1 )
#' } # end of test2
#'
#'
#' test3 <- function(a){
#'   res=test1( alpha=1, beta=2, gamma=3, b=rep(9,3), d=2,xx=4, g=8, print=1 )
#' } # end of test2
#'
#'
#' test3()
#'
#' # If run, below caues error.
#' # test2()
#'
#' @export
#'

check_partial_match <- function( fargs1, fargs2, print=0 ){
  # check if the formal args match the ones in three dots
  # Shin-ichi Mayekawa
  # 20220624,25
  #
  #
  
  fargs11=deparse(fargs1)
  fargs22=deparse(fargs2)
  
  fargs111=names(as.list(fargs1))[-1]
  fargs222=names(as.list(fargs2))[-1]
  
  
  callingfunc1 = as.list(sys.call(-1))[[1]]
  callingfunc2 = as.list(sys.call(-2))
  if( length(callingfunc2) == 0 ) callingfunc2="global env."
  else callingfunc2=callingfunc2[[1]]
  calledfunc = as.list(sys.call())[[1]]
  parent_formals <- formals(sys.function(sys.parent(n = 1)))
  pfargs <- names(parent_formals)
 
  if( print >= 2 ){
    Print("\n\nin check_partial_match")
    Print(callingfunc1,callingfunc2,calledfunc)
    print(paste(callingfunc1, "  was calling  ", calledfunc, sep=""))
    print(paste(callingfunc2, "  was calling  ", callingfunc1, sep=""))
    parent_formals <- formals(sys.function(sys.parent(n = 1)))
    Print(pfargs, fargs1, fargs2)
  }
  
  if( print >= 1 ){
    cat("\nThe Formal Argument of ", callingfunc1, " is "
        , paste(pfargs, collapse=", "),"\n")
    cat("From ", callingfunc2,", ", callingfunc1, " was called as:\n"
        , fargs11,"\n" )
    cat("In ", callingfunc1, " formal arguments are matched as\n"
        , fargs22, "\n")
  }
  
  # Print(fargs111,fargs222, pfargs)
  
  # remove positional arguments at the begining
  if( any(fargs111 == "") ) fargs111=fargs111[-which(fargs111 == "")]
  locname=which(!(fargs111 %in% fargs222))
  # Print(locname)
  
  if( length(locname) > 0 ){
    locname2=which( substr(pfargs,1,1) %in% fargs111[locname] )
    cat("\nerror1:(check_partial_match)\n")
    cat(" When ", callingfunc1," was called from ", callingfunc2, "as\n")
    cat("  ", fargs11,"\n")
    cat(" the partial matching of the arguments in ... listed below failed!!")
    cat("\n ", fargs111[locname], "\n" )
    cat(" Specify the formal arguments whose first character matches"
        , "the above, namely,\n  ", paste(pfargs[locname2], collapse=", ")
        , "\n by their name explicitly when calling ", callingfunc1, ".\n")
    stop()
  }
  
  
} # end of check_partial_match


