#' Returns a permutation which rearranges its first argument in the order
#'  specified by the second argument.
#'
#' @param x a vector to be sorted according to order
#' @param order a vector containing the definition of the sort order \cr
#' If order is not given, this function returns the same as the native order.
#' @param descending = 1 to sort descendingly
#'
#' @details
#' The returning value, od, will be calculated as: \cr\cr
#' \code{  df1 <- data.frame( id1=1:length(x), x ) } \cr
#' \code{  df2 <- data.frame( id2=1:length(order), order ) } \cr
#' \code{  temp <- merge( df1, df2, by.x="x", by.y="order", all=1 ) } \cr
#' \code{  temp <- temp[order(temp$id2),] } \cr
#' \code{  od <- (temp$id1)[1:length(x)] } \cr
#'
#'
#' @examples
#' order <- c("B", "D", "A", "C", "E","X")
#' x <- c( "A", "D", "B", "E", "C", "D", "A" )
#' od <- order2( x, order )
#' Print( x, order, od, x[od] )
#'
#' @return
#' The permutation vector, \code{od}, to be used as:\cr
#' \code{ x_sorted <- x[od] }
#'
#' @export
#'

order2 <- function( x, order=NULL, descending=0 ){
 # sort x using the order given by order.
 # Shin-ichi Mayekawa
 # 20170926,27
 # trim order: 20190207rc
 #

 # error
 if( !is.vector(x) ){
  cat("\nerror1:(order2) x must be a vector.\n")
  stop()
 }

 if( any(is.na(x)) ){
  cat("\nerror1:(order2) x cannot have missing values.\n")
  stop()
 }

 if( is.null(order) ){
  # default order = same as native order
  order=sort(unique(x))
 }
 else if( !is.vector(order) ){
  cat("\nerror1:(order2) order must be a vector.\n")
  stop()
 }
 if( any(is.na(order)) ){
  cat("\nerror1:(order2)"
      , " order cannot have missing values.\n")
  stop()
 }


 # There are too many elements in x than order.
 if( !all( unique(x) %in% order ) ){
  cat("\nerror1:(order2) Given order is not complete.\n")
  Print(order)
  stop()
 }

 # trim too may orders
 order=order[order %in% unique(x)]


 # The core part
 df1=data.frame( id1=1:length(x), x )
 df2=data.frame( id2=1:length(order), order )
 temp=merge( df1, df2, by.x="x", by.y="order", all=1 )
 if( descending == 0 ) temp=temp[order(temp$id2),]
 else  temp=temp[order(-temp$id2),]
 od=(temp$id1)[1:length(x)]

 return( od )

} # end of order2


