R/garp.R

In revpref: Tools for Computational Revealed Preference Analysis

#' Tests consistency with the Generalized Axiom of Revealed Preference at efficiency \eqn{e}
#'
#' This function allows the user to check whether a given data set is consistent with the Generalized Axiom of Revealed Preference
#' at efficiency \eqn{e} (\eqn{e}GARP) and computes the number of \eqn{e}GARP violations. We say that a data set
#' satisfies GARP at efficiency level \eqn{e} if \eqn{q_t R_e q_s} implies \eqn{ep_s'q_s \le p_s'q_t}.
#' It is clear that by setting \eqn{e = 1}, we obtain the standard version of GARP as defined in Varian (1982).
#' While if \eqn{e < 1}, we allow for some optimization error in the choices to make the data set consistent with GARP.
#' The smaller the \eqn{e} is, the larger will be the optimization error allowed in the test.
#' It is well known that GARP is a necessary and sufficient condition for a data set to be rationalized
#' by a continuous, strictly increasing, and concave preference function (see Afriat (1967) and Varian (1982)).
#'
#' @param p A \eqn{T X N} matrix of observed prices where each row corresponds to an observation
#' and each column corresponds to a consumption category. \eqn{T} is the number of observations
#' and \eqn{N} is the number of consumption categories.
#'
#' @param q A \eqn{T X N} matrix of observed quantities where each row corresponds to an observation
#' and each column corresponds to a consumption category.\eqn{T} is the number of observations
#' and \eqn{N} is the number of consumption categories.
#'
#' @param efficiency The efficiency level \eqn{e}, is a real number between 0 and 1, which allows for a
#' small margin of error when checking for consistency with the axiom. The default value is 1, which corresponds to the
#' test of consistency with the exact GARP.
#'
#' @return The function returns two elements. The first element (\code{passgarp}) is a binary indicator telling us whether
#' the data set is consistent with GARP at efficiency level \eqn{e}. It takes a value 1 if the data set is \eqn{e}GARP
#' consistent and a value 0 if the data set is \eqn{e}GARP inconsistent. The second element (\code{nviol}) reports the
#' number of \eqn{e}GARP violations. If the data set is \eqn{e}GARP consistent, \code{nviol} is 0. Note that the maximum
#' number of violations in an \eqn{e}GARP inconsistent data is \eqn{T(T-1)}.
#'
#'
#' @section Definitions:
#' For a given efficiency level \eqn{0 \le e \le 1}, we say that:
#'
#' \itemize{
#'
#' \item bundle \eqn{q_t} is directly revealed preferred to bundle \eqn{q_s} at efficiency level \eqn{e} (denoted as
#' \eqn{q_t R^D_e q_s}) if \eqn{ep_t'q_t \ge p_t'q_s}.
#'
#' \item bundle \eqn{q_t} is strictly directly revealed preferred to bundle \eqn{q_s} at efficiency level \eqn{e}
#' (denoted as \eqn{q_t P^D_e q_s}) if \eqn{ep_t'q_t > p_t'q_s}.
#'
#' \item bundle \eqn{q_t} is revealed preferred to bundle \eqn{q_s} at efficiency level \eqn{e} (denoted as
#' \eqn{q_t R_e q_s}) if there exists a (possibly empty) sequence of observations (\eqn{t,u,v,\cdots,w,s}) such that
#' \eqn{q_t R^D_e q_u}, \eqn{q_u R^D_e q_v}, \eqn{\cdots, q_w R^D_e q_s}.
#' }
#'
#' @section References:
#' \itemize{
#' \item Afriat, Sydney N. "The construction of utility functions from expenditure data."
#' International economic review 8, no. 1 (1967): 67-77.
#' \item Varian, Hal R. "The nonparametric approach to demand analysis." Econometrica:
#' Journal of the Econometric Society (1982): 945-973.
#' }
#'
#' @examples
#' # define a price matrix
#' p = matrix(c(4,4,4,1,9,3,2,8,3,1,
#' 8,4,3,1,9,3,2,8,8,4,
#' 1,4,1,8,9,3,1,8,3,2),
#' nrow = 10, ncol = 3, byrow = TRUE)
#'
#' # define a quantity matrix
#' q = matrix(c( 1.81,0.19,10.51,17.28,2.26,4.13,12.33,2.05,2.99,6.06,
#' 5.19,0.62,11.34,10.33,0.63,4.33,8.08,2.61,4.36,1.34,
#' 9.76,1.37,36.35, 1.02,3.21,4.97,6.20,0.32,8.53,10.92),
#' nrow = 10, ncol = 3, byrow = TRUE)
#'
#' # Test consistency with GARP and compute the number of GARP violations
#' garp(p,q)
#'
#' # Test consistency with GARP and compute the number of GARP violations at e = 0.95
#' garp(p,q, efficiency = 0.95)
#'
#' @seealso \code{\link{sarp}} for the Strong Axiom of Revealed Preference and \code{\link{warp}} for
#' the Weak Axiom of Revealed Preference.
#'
#' @export
#'
garp <- function(p,q,efficiency=1)
{
  if (nrow(p)!=nrow(q)) stop("Number of observations must be the same for both price and quanity matrices")
  if (ncol(p)!=ncol(q)) stop("Number of consumption categories must be the same for both price and quanity matrices")
  if (!(0 <= efficiency & efficiency <= 1)) stop("Efficiency index must be between 0 and 1")

  passgarp <- 1
  t <- dim(p)[1]
  DRP <- diag(t)
  PO <- matrix(0, nrow = t, ncol = t)

  for(i in 1:t)
  {
    for(j in 1:t)
    {
      if(sum(p[i,]*q[j,]) <= efficiency*sum(p[i,]*q[i,])) {DRP[i,j] = 1}
      if(sum(p[i,]*q[j,]) < efficiency*sum(p[i,]*q[i,]))  {PO[i,j] = 1}
    }
  }

  RP <- warshall(DRP)
  nviol <- 0
  for(i in 1:t)
  {
    for(j in 1:t)
    {
      if(i != j & !identical(q[i,],q[j,]))
      {if(RP[i,j] == 1 & PO[j,i] == 1)
      {passgarp = 0
      nviol = nviol + 1
      }
      }
    }
  }
  return(c(passgarp,nviol))
}