R/lorenzdominance.R

In ClaimsProblems: Analysis of Conflicting Claims

#' @title Lorenz-dominance relation
#' @description This function checks whether or not the awards assigned by two rules to a claims problem are Lorenz-comparable.
#' @param E The endowment.
#' @param d The vector of claims.
#' @param Rules The two rules: AA, APRO, CE, CEA, CEL, AV, DT, MO, PIN, PRO, RA, Talmud, RTalmud.
#' @param Info A logical value.
#' @return If \code{Info = FALSE}, the Lorenz-dominance relation between the awards vectors selected by both rules.
#' If both awards vectors are equal then \code{cod = 2}. If the awards vectors are not Lorenz-comparable then \code{cod = 0}.
#' If the awards vector  selected by the first rule Lorenz-dominates the awards vector  selected by the second rule then \code{cod = 1}; otherwise \code{cod = -1}.
#' If \code{Info = TRUE}, it also gives the corresponding cumulative sums.
#' @details Let \eqn{N=\{1,\ldots,n\}} be the set of claimants, \eqn{E\ge 0} the endowment to be divided and \eqn{d\in \mathbb{R}_+^N} the vector of claims
#' such that \eqn{\sum_{i \in N} d_i\ge E}.
#'
#' A vector \eqn{x=(x_1,\dots,x_n)} is an awards vector for the claims problem \eqn{(E,d)} if \eqn{0\le x \le d}
#' and satisfies the balance requirement, that is, \eqn{\sum_{i=1}^{n}x_i=E}.
#' A rule is a function that assigns to each claims problem \eqn{(E,d)} an awards vector.
#'
#' Given a claims problem \eqn{(E,d)}, in order to compare a pair of awards vectors \eqn{x,y\in X(E,d)} with the Lorenz criterion,
#' first one has to rearrange the coordinates of each allocation in a non-decreasing order. Then we say that \eqn{x} Lorenz-dominates \eqn{y} (or, that \eqn{y} is Lorenz-dominated by \eqn{x})
#' if all the cumulative sums of the rearranged coordinates are greater with \eqn{x} than with \eqn{y}. That is,
#' \eqn{x} Lorenz-dominates \eqn{y} if for each \eqn{k=1,\dots,n-1},
#' \deqn{\sum_{j=1}^{k}x_j \geq \sum_{j=1}^{k}y_j.}
#'
#' Let \eqn{\mathcal{R}} and \eqn{\mathcal{S}} be two rules, we say that \eqn{\mathcal{R}} Lorenz-dominates \eqn{\mathcal{S}} if \eqn{\mathcal{R}(E,d)} Lorenz-dominates \eqn{\mathcal{S}(E,d)} for all \eqn{(E,d)}.
#'
#' @seealso \link{cumawardscurve}, \link{deviationindex}, \link{giniindex}, \link{indexgpath}, \link{lorenzcurve}.
#' @examples
#' E=10
#' d=c(2,4,7,8)
#' Rules=c(AA,CEA)
#' lorenzdominance(E,d,Rules)
#' @references  Lorenz, M. O. (1905). Methods of measuring the concentration of wealth. Publications of the American statistical association 9(70), 209-219.
#' @references Mirás Calvo, M.Á., Núñez Lugilde, I., Quinteiro Sandomingo, C., and Sánchez Rodríguez, E. (2023a). Deviation from proportionality and Lorenz-domination for claims problems. Review of Economic Design 27, 439-467.
#' @references Mirás Calvo, M.Á., Núñez Lugilde, I., Quinteiro Sandomingo, C., and Sánchez-Rodríguez, E. (2023b). Refining the Lorenz‐ranking of rules for
#' claims problems on restricted domains. International Journal of Economic Theory 19(3), 526-558
#' @export

lorenzdominance = function(E, d, Rules, Info = FALSE) {
  ########################################
  # Required: (E,d) must be a claims problem, i.e., E >=0, d >=0, E <= sum(d)
  ########################################
  n = length (d)
  D = sum(d) #The number of claims and the total claim
  if (E < 0 || sum((d < 0)) > 0 || E > D)
    stop('(E,d) is not a claims problem.',call.=F)

  if(length(Rules)>2)
    warning('We check if the first two rules are Lorenz-comparable. \n',call.=F,immediate.=T)

  #####################
  do = sort(d)
  if (sum(do == d) < n){
    message('The result is computed for the rearranged vector of claims.\n')
  }
  Rule1char = Rules[[1]](0, 0, name=TRUE)
  Rule2char = Rules[[2]](0, 0, name=TRUE)
  rule1 = Rules[[1]](E, do)
  rule2 = Rules[[2]](E, do) #Award of Rule 1 and Rule2
  sum1 = cumsum(rule1)
  sum2 = cumsum(rule2)
  dom1 = sum(sum1 >= sum2)
  dom2 = sum(sum2 >= sum1)

  if (dom1 == n & dom2 < n) {
    cod=1
  if (Info == TRUE){
    message('The awards vector selected by the ',
        Rule1char,
        ' rule Lorenz dominates the awards vector selected by the ',
        Rule2char,
        ' rule.\n')
                  }
  } else if (dom2 == n & dom1 < n) {
    cod=-1
    if (Info == TRUE){
    message('The awards vector selected by the ',
        Rule1char,
        ' rule is Lorenz-dominated by the awards vector selected by the ',
        Rule2char,
        ' rule. \n')
                  }
  } else if (dom1 == n & dom2 == n) {
    cod=2
    if (Info == TRUE){
    message('The awards vectors selected by the ',
        Rule1char,
        ' and the ',
        Rule2char,
        ' rules are equal.\n')
                    }
    }else{
      cod=0
      if (Info == TRUE){
    message('The awards vectors selected by the',
        Rule1char,
        'and the',
        Rule2char,
        'rules are not Lorenz-comparable.\n')
                      }
    }
  if (Info == TRUE){
  message('The cumulative sums for both awards vectors are:\n')
  message(paste(
    format(Rule1char, width = 17, justify = c("right")),
    format(Rule2char, width = 17, justify = c("right")),
    '\n'
  ))
  for (i in 1:n) {
    message(paste(
      format(
        round(sum1[i], 3),
        nsmall = 3,
        width = 17,
        justify = c("right")
      ),
      format(
        round(sum2[i], 3),
        nsmall = 3,
        width = 17,
        justify = c("right")
      ),
      '\n'
    ))
              }
  }
return(list(cod=cod))
}