Bilateral price index

[sweinand]

Add the Lowe and Young price index, where the base region prices can be defined in the function settings:

If settings$wbase=NULL, the regional average price and quantity for each product are used. If settings$wbase is a specific region, then the prices and quantities of this region are used. To be checked if this can be written in formulas using quantities q and weights w.

Similarly, the Lyod-Moulton index could be implemented where the sigma-parameter could be defined through settings$ces.sigma.

[sweinand]

The formulas for Lowe and Young can be written with quantities and weights. For the Young index, the weights can be defined as explained above or as expenditure shares of a respective region. However, for the Lowe index, the weights are hybrid expenditure shares (and not the required ones w of a respective region). Therefore, an implementation of the Lowe index should only work if quantities q are provided.

young2 <- function(p1, p0, pb, qb, wb){

  # define weights:
  if(!missing(pb) & !missing(qb)) wb <- pb*qb

  # compute index:
  res <- sum(wb/sum(wb)*(p1/p0))

  # return output:
  return(res)

}

lowe2 <- function(p1, p0, pb=NULL, qb, wb=NULL){

  # define weights:
  w <- p0*qb/sum(p0*qb)

  # compute index:
  res <- sum(w/sum(w)*(p1/p0))

  # return output:
  return(res)

}

P <- matrix(data=runif(12), ncol=3, nrow=4)
Q <- matrix(data=runif(12, 100, 200), ncol=3, nrow=4)

young <- function(P, Q, W=NULL, base=1L){

  # compute price ratios:
  R <- P/P[, base]

  # define weights:
  W <- rowSums(P*Q, na.rm=TRUE)/sum(P*Q, na.rm=TRUE)
  W <- matrix(data=W, ncol=ncol(R), nrow=nrow(R))

  # set weights to NA when no intersection of prices:
  W[is.na(R)] <- NA

  # normalize weights:
  W <- W/colSums(x=W, na.rm=TRUE)[col(W)]

  # compute index:
  res <- colSums(x=W*R, na.rm=TRUE)

  # set to NA when no intersecting prices were found:
  res[is.nan(res) | colSums(x=!is.na(W*P), na.rm=FALSE)<=0] <- NA
  # -> colSums()-function returns 0 when everything is NA

  # return output:
  return(res)

}

lowe <- function(P, Q, W=NULL, base=1L){

  # compute price ratios:
  R <- P/P[, base]

  # define weights:
  W <- rowSums(P[, base]*Q, na.rm=TRUE)/sum(P[,base]*Q, na.rm=TRUE)
  W <- matrix(data=W, ncol=ncol(R), nrow=nrow(R))

  # set weights to NA when no intersection of prices:
  W[is.na(R)] <- NA

  # normalize weights:
  W <- W/colSums(x=W, na.rm=TRUE)[col(W)]

  # compute index:
  res <- colSums(x=W*R, na.rm=TRUE)

  # set to NA when no intersecting prices were found:
  res[is.nan(res) | colSums(x=!is.na(W*P), na.rm=FALSE)<=0] <- NA
  # -> colSums()-function returns 0 when everything is NA

  # return output:
  return(res)

}