Nothing
R/revealPref.R
In ramchoice: Revealed Preference and Attention Analysis in Random Limited Attention Models
Defines functions
print.ramchoiceRevealPref
summary.ramchoiceRevealPref
revealPref
Documented in
print.ramchoiceRevealPref
revealPref
summary.ramchoiceRevealPref
################################################################################
#' @title Revealed Preference Analysis in Random Limited Attention Models
#'
#' @description Given a random sample of choice problems and choices, \code{revealPref}
#' returns test statistics, critical values and p-values against a collection of preferences.
#' Five methods for choosing critical values are available:
#' (i) \code{GMS}: generalized moment selection (plug-in (estimated) moment conditions with shrinkage);
#' (ii) \code{PI}: critical values based on plug-in estimated moment conditions (this is not uniformly valid);
#' (iii) \code{LF}: critical values based on the least favorable model (plug-in 0 for the moment conditions);
#' (iv) \code{2MS}: two-step moment selection;
#' and (v) \code{2UB}: refined moment selection (plug-in upper bound of moment inequalities).
#'
#' \code{\link{sumData}} is a low-level function that generates summary statistics, and
#' \code{\link{genMat}} can be used to construct the constraint matrices. The simulated dataset
#' \code{\link{ramdata}} is also provided for illustration. For revealed attention analysis, see \code{\link{revealAtte}}.
#'
#' @param menu Numeric matrix of 0s and 1s, the collection of choice problems.
#' @param choice Numeric matrix of 0s and 1s, the collection of choices.
#' @param pref_list Numeric matrix, each row corresponds to one preference. For example, \code{c(2, 3, 1)} means
#' 2 is preferred to 3 and to 1. When set to \code{NULL}, the default, \code{c(1, 2, 3, ...)},
#' will be used.
#' @param method String, the method for constructing critical values. Default is \code{GMS} (generalized moment selection).
#' Other available options are \code{LF} (least favorable model), \code{PI} (plug-in method), \code{2MS} (two-step moment selection),
#' \code{2UB} (two-step moment upper bound), or \code{ALL} (report all critical values).
#' @param nCritSimu Integer, number of simulations used to construct the critical value. Default is \code{2000}.
#' @param BARatio2MS Numeric, beta-to-alpha ratio for two-step moment selection method. Default is \code{0.1}.
#' @param BARatio2UB Numeric, beta-to-alpha ratio for two-step moment upper bound method. Default is \code{0.1}.
#' @param MNRatioGMS Numeric, shrinkage parameter. Default is \code{sqrt(1/log(N))}, where N is the sample size.
#' @param RAM Boolean, whether the restrictions implied by the RAM of
#' \href{https://arxiv.org/abs/1712.03448}{Cattaneo et al. (2020)} should be incorporated, that is, their monotonic attention assumption (default is \code{TRUE}).
#' @param AOM Boolean, whether the restrictions implied by the AOM of
#' \href{https://arxiv.org/abs/2110.10650}{Cattaneo et al. (2022)} should be incorporated, that is, their attention overload assumption (default is \code{TRUE}).
#' @param limDataCorr Boolean, whether assuming limited data (default is \code{TRUE}). When set to
#' \code{FALSE}, will assume all choice problems are observed. This option only applies when \code{RAM} is set to \code{TRUE}.
#' @param attBinary Numeric, between 1/2 and 1 (default is \code{1}), whether additional restrictions (on the attention rule)
#' should be imposed for binary choice problems (i.e., attentive at binaries).
#'
#' @return
#' \item{sumStats}{Summary statistics, generated by \code{\link{sumData}}.}
#' \item{constraints}{Matrices of constraints, generated by \code{\link{genMat}}.}
#' \item{Tstat}{Test statistic.}
#' \item{critVal}{Critical values.}
#' \item{pVal}{P-values (only available for \code{GMS}, \code{LF} and \code{PI}).}
#' \item{method}{Method for constructing critical value.}
#'
#' @references
#' M. D. Cattaneo, X. Ma, Y. Masatlioglu, and E. Suleymanov (2020). \href{https://arxiv.org/abs/1712.03448}{A Random Attention Model}. \emph{Journal of Political Economy} 128(7): 2796-2836. \doi{10.1086/706861}
#'
#' M. D. Cattaneo, P. Cheung, X. Ma, and Y. Masatlioglu (2022). \href{https://arxiv.org/abs/2110.10650}{Attention Overload}. Working paper.
#'
#' @author
#' Matias D. Cattaneo, Princeton University. \email{cattaneo@princeton.edu}.
#'
#' Paul Cheung, University of Maryland. \email{hycheung@umd.edu}
#'
#' Xinwei Ma (maintainer), University of California San Diego. \email{x1ma@ucsd.edu}
#'
#' Yusufcan Masatlioglu, University of Maryland. \email{yusufcan@umd.edu}
#'
#' Elchin Suleymanov, Purdue University. \email{esuleyma@purdue.edu}
#'
#' @examples
#' # Load data
#' data(ramdata)
#'
#' # Set seed, to replicate simulated critical values
#' set.seed(42)
#'
#' # list of preferences
#' pref_list <- matrix(c(1, 2, 3, 4, 5,
#' 2, 1, 3, 4, 5,
#' 2, 3, 4, 5, 1,
#' 5, 4, 3, 2, 1), ncol=5, byrow=TRUE)
#'
#' # revealed preference using only RAM restrictions
#' result1 <- revealPref(menu = ramdata$menu, choice = ramdata$choice, method = "GMS",
#' pref_list = pref_list, RAM = TRUE, AOM = FALSE)
#' summary(result1)
#'
#' # revealed preference using only AOM restrictions
#' result2 <- revealPref(menu = ramdata$menu, choice = ramdata$choice, method = "GMS",
#' pref_list = pref_list, RAM = FALSE, AOM = TRUE)
#' summary(result2)
#'
#' # revealed preference using both RAM and AOM restrictions
#' result3 <- revealPref(menu = ramdata$menu, choice = ramdata$choice, method = "GMS",
#' pref_list = pref_list, RAM = TRUE, AOM = TRUE)
#' summary(result3)
#'
#' # revealed preference employing additional restrictions for binary choice problems
#' result4 <- revealPref(menu = ramdata$menu, choice = ramdata$choice, method = "GMS",
#' pref_list = pref_list, RAM = TRUE, AOM = TRUE, attBinary = 2/3)
#' summary(result4)
#'
#' @export
revealPref <- function(menu, choice, pref_list = NULL, method = "GMS",
nCritSimu = 2000,
BARatio2MS = 0.1, BARatio2UB = 0.1, MNRatioGMS = NULL,
RAM = TRUE, AOM = TRUE,
limDataCorr = TRUE,
attBinary = 1) {
################################################################################
# Error Check
################################################################################
# menu
if (!is.matrix(menu)) {
stop("Input 'menu' has to be a matrix.\n")
} else if (min(dim(menu)) == 0) {
stop("Input 'menu' has at least one dimension 0.\n")
} else if (!all((menu == 0) | (menu == 1))) {
stop("Input 'menu' can only contain 0 (FALSE) and 1 (TRUE).\n")
} else {
# nothing
}
# choice
if (!is.matrix(choice)) {
stop("Input 'choice' has to be a matrix.\n")
} else if (min(dim(choice)) == 0) {
stop("Input 'choice' has at least one dimension 0.\n")
} else if (!all((choice == 0) | (choice == 1))) {
stop("Input 'choice' can only contain 0 (FALSE) and 1 (TRUE).\n")
} else if (!all(rowSums(choice) == 1)) {
stop("Input 'choice' should contain one and only one 1 (TRUE) in each row.\n")
} else {
# nothing
}
# menu and choice
if (!all(dim(menu) == dim(choice))) {
stop("Input 'menu' and 'choice' have to have the same dimensions.\n")
}
else if (!all(as.integer(rowSums((menu == 1) & (choice == 1))))) {
stop("Input 'menu' and 'choice' should contain one and only one common 1 (TRUE) in each row.\n")
} else {
# nothing
}
# preference
if (length(as.vector(pref_list)) == 0) {
pref_list <- matrix(1:ncol(menu), nrow=1)
} else if (!is.matrix(pref_list)) {
stop("Input 'pref_list' has to be a matrix.\n")
} else if (min(dim(pref_list)) == 0) {
stop("Input 'pref_list' has at least one dimension 0.\n")
} else if (ncol(pref_list) != ncol(menu)) {
stop("Input 'pref_list' has to have the same number of columns as 'menu'.\n")
} else if (!all(apply(pref_list, MARGIN=1, FUN=function(x) all(sort(x)==1:ncol(menu))))) {
stop("Input 'pref_list' incorrectly specified.\n")
} else {
# nothing
}
# method
if (length(method) == 0) {
method <- "GMS"
}
else if(!is.character("method")) {
stop("Input 'method' has to be a character string.\n")
} else {
method <- tolower(method)
if (!(method %in% c("gms", "lf", "pi", "2ms", "2ub", "all"))) {
stop("Input 'method' incorrectly specified.\n")
} else {
# nothing
}
}
if (length(MNRatioGMS) == 0) {
MNRatioGMS <- 1 / log(nrow(menu))
} else {
# nothing
}
level <- c(0.9, 0.95, 0.99)
################################################################################
# Initialization
################################################################################
# maximum statistic
Tstat <- rep(NA, nrow(pref_list))
# PI: plugin critical value
if (method %in% c("all", "pi")) {
CritValPI <- matrix(NA, nrow=nrow(pref_list), ncol=length(level))
colnames(CritValPI) <- 1 - level
rownames(CritValPI) <- 1:nrow(pref_list)
pValPI <- matrix(NA, nrow=nrow(pref_list), ncol=1)
colnames(pValPI) <- "pval"
rownames(pValPI) <- 1:nrow(pref_list)
} else {CritValPI <- pValPI <- NULL}
# LF: critical value, least favorable
if (method %in% c("all", "lf")) {
CritValLF <- matrix(NA, nrow=nrow(pref_list), ncol=length(level))
colnames(CritValLF) <- 1 - level
rownames(CritValLF) <- 1:nrow(pref_list)
pValLF <- matrix(NA, nrow=nrow(pref_list), ncol=1)
colnames(pValLF) <- "pval"
rownames(pValLF) <- 1:nrow(pref_list)
} else {CritValLF <- pValLF <- NULL}
# MS: critical value, 2 step moment selection
if (method %in% c("all", "2ms")) {
CritVal2MS <- matrix(NA, nrow=nrow(pref_list), ncol=length(level))
colnames(CritVal2MS) <- 1 - level
rownames(CritVal2MS) <- 1:nrow(pref_list)
} else {CritVal2MS <- NULL}
# UB: critical value, 2 step upper bound
if (method %in% c("all", "2ub")) {
CritVal2UB <- matrix(NA, nrow=nrow(pref_list), ncol=length(level))
colnames(CritVal2UB) <- 1 - level
rownames(CritVal2UB) <- 1:nrow(pref_list)
} else {CritVal2UB <- NULL}
# GMS: critical value, shrinkage
if (method %in% c("all", "gms")) {
CritValGMS <- matrix(NA, nrow=nrow(pref_list), ncol=length(level))
colnames(CritValGMS) <- 1 - level
rownames(CritValGMS) <- 1:nrow(pref_list)
pValGMS <- matrix(NA, nrow=nrow(pref_list), ncol=1)
colnames(pValGMS) <- "pval"
rownames(pValGMS) <- 1:nrow(pref_list)
} else {CritValGMS <- pValGMS <- NULL}
# first obtain point estimates
# summary statistics
sumStats <- sumData(menu, choice)
n <- sum(sumStats$sumN) # sample size
# generate matrices
constraints <- genMat(sumStats$sumMenu, sumStats$sumMsize, pref_list, RAM, AOM, limDataCorr, attBinary)
# simulate normal distributions, scale by sample size since Sigma is asymptotically stable.
normSimu <- t(mvrnorm(n=nCritSimu, mu=rep(0, nrow(sumStats$Sigma)), Sigma=sumStats$Sigma) / sqrt(n))
normSimu[diag(sumStats$Sigma) == 0, ] <- 0;
# find test statistics and critical values
temp <- matrix(0, nrow=5, ncol=nCritSimu)
j <- 0
for (i in 1:nrow(pref_list)) {
if (constraints$ConstN[i] == 0) {# if there are no constraints
Tstat[i] <- 0
if (method %in% c("all", "pi")) {CritValPI[i, ] <- 0}
if (method %in% c("all", "lf")) {CritValLF[i, ] <- 0}
if (method %in% c("all", "2ms")) {CritVal2MS[i, ] <- 0}
if (method %in% c("all", "2ub")) {CritVal2UB[i, ] <- 0}
if (method %in% c("all", "gms")) {CritValGMS[i, ] <- 0}
} else {# if there are constraints
R_temp <- constraints$R[(j+1):(j+constraints$ConstN[i]), ]
RSigma <- R_temp %*% sumStats$Sigma %*% t(R_temp)
tempTstat <- (R_temp %*% sumStats$sumProbVec) / sqrt(abs(diag(RSigma)))
tempTstat[is.na(tempTstat)] <- 0
tempTstat <- sqrt(n) * tempTstat
Tstat[i] = max(max(tempTstat), 0) # maximum statistic
# plug-in center
if (method %in% c("all", "pi")) {
centerPI <- R_temp %*% sumStats$sumProbVec
centerPI[centerPI > 0] <- 0
}
# generalized moment selection center
if (method %in% c("all", "gms")) {
centerGMS <- R_temp %*% sumStats$sumProbVec * sqrt(MNRatioGMS)
centerGMS[centerGMS > 0] <- 0
}
# to store simulated moment inequalities
tempTstatSimu <- matrix(0, nrow=constraints$ConstN[i], ncol=nCritSimu)
for (k in 1:nCritSimu) {
# least favorable (also used for two-step methods)
if (method %in% c("all", "lf", "2ms", "2ub")) {
temptemp <- (R_temp %*% normSimu[, k]) / sqrt(abs(diag(RSigma)))
temptemp[is.na(temptemp)] <- 0
temp[1, k] <- sqrt(n) * max(max(temptemp), 0)
tempTstatSimu[, k] = sqrt(n) * temptemp
}
# generalized moment selection recentering
if (method %in% c("all", "gms")) {
temptemp <- (R_temp %*% normSimu[, k] + centerGMS) / sqrt(abs(diag(RSigma)))
temptemp[is.na(temptemp)] <- 0
temp[3, k] <- sqrt(n) * max(max(temptemp), 0)
}
# plug-in center
if (method %in% c("all", "pi")) {
temptemp <- (R_temp %*% normSimu[, k] + centerPI) / sqrt(abs(diag(RSigma)))
temptemp[is.na(temptemp)] <- 0
temp[4, k] = sqrt(n) * max(max(temptemp), 0)
}
}
# plug-in center critical value
if (method %in% c("all", "pi")) {
CritValPI[i, ] <- quantile(temp[4, ], level)
pValPI[i] <- mean(temp[4, ] > Tstat[i])
}
# least favorable critical value
if (method %in% c("all", "lf")) {
CritValLF[i, ] <- quantile(temp[1, ], level)
pValLF[i] <- mean(temp[1, ] > Tstat[i])
}
# generalized moment selection recentering
if (method %in% c("all", "gms")) {
CritValGMS[i, ] <- quantile(temp[3, ], level)
pValGMS[i] <- mean(temp[3, ] > Tstat[i])
}
# 2 step methods
if (method %in% c("all", "2ms", "2ub")) {
for (i_level in 1:length(level)) {# enumerate all levels
# refined moment selection / moment inequality upper-bounding
if (method %in% c("all", "2ub")) {
centerUpper <- R_temp %*% sumStats$sumProbVec + sqrt(abs(diag(RSigma))) / sqrt(n) *
quantile(temp[1, ], 1 - ((1-level[i_level]) * BARatio2UB))
centerUpper[centerUpper > 0] <- 0
for (k in 1:nCritSimu) {
temptemp <- (R_temp %*% normSimu[, k] + centerUpper) / sqrt(abs(diag(RSigma)))
temptemp[is.na(temptemp)] <- 0
temp[5, k] <- sqrt(n) * max(max(temptemp), 0)
}
CritVal2UB[i, i_level] <- quantile(temp[5, ],
level[i_level] + (1-level[i_level]) * BARatio2UB)
}
# critical value with moment selection
if (method %in% c("all", "2ms")) {
tempCritBeta <- quantile(temp[1, ],
1 - ((1-level[i_level]) * BARatio2MS))
eff_moment <- (tempTstat > -2 * tempCritBeta)
if (sum(eff_moment) == 0) {# no effective moment
CritVal2MS[i, i_level] <- 0
} else{
CritVal2MS[i, i_level] <-
quantile(
apply(tempTstatSimu[eff_moment, ], MARGIN=2, FUN=function(x) max(max(x), 0)),
level[i_level] + (1 - level[i_level]) * BARatio2MS * 2)
}
}
}
}
}
j = j + constraints$ConstN[i];
}
Result <- list(sumStats=sumStats, constraints=constraints, Tstat=Tstat,
critVal=list(GMS=CritValGMS,
PI =CritValPI,
LF =CritValLF,
MS =CritVal2MS,
UB =CritVal2UB),
pVal=list(GMS=pValGMS,
PI =pValPI,
LF =pValLF),
pref=pref_list,
method=method,
opt=list(RAM=RAM, AOM=AOM, limDataCorr=limDataCorr, attBinary=attBinary))
class(Result) <- "ramchoiceRevealPref"
return(Result)
}
################################################################################
#' @title Revealed Preference Analysis in Random Limited Attention Models
#'
#' @description This has been replaced by \code{\link{revealPref}}.
#'
#' @param menu Numeric matrix of 0s and 1s, the collection of choice problems.
#' @param choice Numeric matrix of 0s and 1s, the collection of choices.
#' @param pref_list Numeric matrix, each row corresponds to one preference. For example, \code{c(2, 3, 1)} means
#' 2 is preferred to 3 and to 1. When set to \code{NULL}, the default, \code{c(1, 2, 3, ...)},
#' will be used.
#' @param method String, the method for constructing critical values. Default is \code{GMS} (generalized moment selection).
#' Other available options are \code{LF} (least favorable model), \code{PI} (plug-in method), \code{2MS} (two-step moment selection),
#' \code{2UB} (two-step moment upper bound), or \code{ALL} (report all critical values).
#' @param nCritSimu Integer, number of simulations used to construct the critical value. Default is \code{2000}.
#' @param BARatio2MS Numeric, beta-to-alpha ratio for two-step moment selection method. Default is \code{0.1}.
#' @param BARatio2UB Numeric, beta-to-alpha ratio for two-step moment upper bound method. Default is \code{0.1}.
#' @param MNRatioGMS Numeric, shrinkage parameter. Default is \code{sqrt(1/log(N))}, where N is the sample size.
#' @param RAM Boolean, whether the restrictions implied by the RAM of
#' \href{https://arxiv.org/abs/1712.03448}{Cattaneo et al. (2020)} should be incorporated, that is, their monotonic attention assumption (default is \code{TRUE}).
#' @param AOM Boolean, whether the restrictions implied by the AOM of
#' \href{https://arxiv.org/abs/2110.10650}{Cattaneo et al. (2022)} should be incorporated, that is, their attention overload assumption (default is \code{TRUE}).
#' @param limDataCorr Boolean, whether assuming limited data (default is \code{TRUE}). When set to
#' \code{FALSE}, will assume all choice problems are observed. This option only applies when \code{RAM} is set to \code{TRUE}.
#' @param attBinary Numeric, between 1/2 and 1 (default is \code{1}), whether additional restrictions (on the attention rule)
#' should be imposed for binary choice problems (i.e., attentive at binaries).
#'
#' @return
#' \item{sumStats}{Summary statistics, generated by \code{\link{sumData}}.}
#' \item{constraints}{Matrices of constraints, generated by \code{\link{genMat}}.}
#' \item{Tstat}{Test statistic.}
#' \item{critVal}{Critical values.}
#' \item{pVal}{P-values (only available for \code{GMS}, \code{LF} and \code{PI}).}
#' \item{method}{Method for constructing critical value.}
#'
#' @references
#' M. D. Cattaneo, X. Ma, Y. Masatlioglu, and E. Suleymanov (2020). \href{https://arxiv.org/abs/1712.03448}{A Random Attention Model}. \emph{Journal of Political Economy} 128(7): 2796-2836. \doi{10.1086/706861}
#'
#' M. D. Cattaneo, P. Cheung, X. Ma, and Y. Masatlioglu (2022). \href{https://arxiv.org/abs/2110.10650}{Attention Overload}. Working paper.
#'
#' @author
#' Matias D. Cattaneo, Princeton University. \email{cattaneo@princeton.edu}.
#'
#' Paul Cheung, University of Maryland. \email{hycheung@umd.edu}
#'
#' Xinwei Ma (maintainer), University of California San Diego. \email{x1ma@ucsd.edu}
#'
#' Yusufcan Masatlioglu, University of Maryland. \email{yusufcan@umd.edu}
#'
#' Elchin Suleymanov, Purdue University. \email{esuleyma@purdue.edu}
#'
#' @export
rAtte <- revealPref
################################################################################
#' Internal function.
#'
#' @param object Class \code{ramchoiceRevealPref} objects.
#'
#' @keywords internal
#' @export
summary.ramchoiceRevealPref <- function(object, ...) {
x <- object
cat("\n Revealed Preference Analysis in Random Limited Attention Models.\n")
cat("\n")
cat(paste(format("# of observations", width=25), toString(sum(x$sumStats$sumN)), sep="")); cat("\n")
cat(paste(format("# of alternatives", width=25), toString(ncol(x$sumStats$sumMenu)), sep="")); cat("\n")
cat(paste(format("# of choice problems", width=25), toString(nrow(x$sumStats$sumMenu)), sep="")); cat("\n")
cat("\n")
cat(paste(format("Min # of alternatives", width=25), toString(min(x$sumStats$sumMsize)), sep="")); cat("\n")
cat(paste(format("Max # of alternatives", width=25), toString(max(x$sumStats$sumMsize)), sep="")); cat("\n")
cat("\n")
cat(paste(format("Min eff. observations", width=25), toString(min(x$sumStats$sumN)), sep="")); cat("\n")
cat(paste(format("Max eff. observations", width=25), toString(max(x$sumStats$sumN)), sep="")); cat("\n")
cat("\n")
if (x$opt$RAM) {
if (x$opt$limDataCorr) {
cat(format("RAM restrictions from Cattaneo, Ma, Masatlioglu, and Suleymanov (2020) employed.", width=100)); cat("\n")
} else {
cat(format("RAM restrictions from Cattaneo, Ma, Masatlioglu, and Suleymanov (2020) employed.", width=100)); cat("\n")
}
}
if (x$opt$AOM) {
cat(format("AOM restrictions from Cattaneo, Cheung, Ma, and Masatlioglu (2021) employed.", width=100)); cat("\n")
}
if (x$opt$attBinary < 1) {
cat(paste(format("Attentive-at-binaries restrictions employed with threshold ", width=59), toString(round(x$opt$attBinary, 3)), sep="")); cat("\n")
}
cat("\n")
if (x$method %in% c("all")) {
# nothing here
} else if (x$method %in% c("gms")) {
cat(paste(format("Critical Value Method", width=25), "Generalized Moment Selection", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("pi")) {
cat(paste(format("Critical Value Method", width=25), "Plug-in Method", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("lf")) {
cat(paste(format("Critical Value Method", width=25), "Least Favorable Method", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("2ms")) {
cat(paste(format("Critical Value Method", width=25), "Two-step Moment Selection", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("2ub")) {
cat(paste(format("Critical Value Method", width=25), "Two-step Upper Bound", sep="")); cat("\n")
cat("\n")
} else {
# nothing, should not be here
}
for (i in 1:nrow(x$pref)) {
cat(paste(rep("=", 60), collapse="")); cat("\n")
cat(paste("Preference[", toString(i), "]",": ", sep=""))
cat(x$pref[i, ]); cat("\n")
if (x$method %in% c("all", "gms")) {
if (sum(x$Tstat[i] > x$critVal$GMS[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$GMS[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$GMS[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("lf")) {
if (sum(x$Tstat[i] > x$critVal$LF[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$LF[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$LF[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("pi")) {
if (sum(x$Tstat[i] > x$critVal$PI[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$PI[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$PI[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("2ms")) {
if (sum(x$Tstat[i] > x$critVal$MS[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$MS[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$MS[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("2ub")) {
if (sum(x$Tstat[i] > x$critVal$UB[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$UB[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$UB[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else {
# ??? should not be here
stars <- ""
}
if (x$method %in% c("all")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (GMS p-val: ", toString(round(x$pVal$GMS[i], 3)), stars, ")", sep="")); cat("\n")
} else if (x$method %in% c("gms")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (p-val: ", toString(round(x$pVal$GMS[i], 3)), stars, ")", sep="")); cat("\n")
} else if (x$method %in% c("lf")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (p-val: ", toString(round(x$pVal$LF[i], 3)), stars, ")", sep="")); cat("\n")
} else if (x$method %in% c("pi")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (p-val: ", toString(round(x$pVal$PI[i], 3)), stars, ")", sep="")); cat("\n")
} else {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), stars, sep="")); cat("\n")
}
if (x$method %in% c("all")) {cat(paste(rep("-", 60), collapse="")); cat("\n")}
cat(paste(format("Crit Val", width=15), format("0.10", width=15), format("0.05", width=15), format("0.01", width=15), sep="")); cat("\n")
if (x$method %in% c("all")) {cat(paste(rep("-", 60), collapse="")); cat("\n")}
if (x$method %in% c("all", "gms")) {
cat(paste(format("GMS" , width=15),
format(toString(round(x$critVal$GMS[i, 1], 4)), width=15),
format(toString(round(x$critVal$GMS[i, 2], 4)), width=15),
format(toString(round(x$critVal$GMS[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "pi")) {
cat(paste(format("PI" , width=15),
format(toString(round(x$critVal$PI[i, 1], 4)), width=15),
format(toString(round(x$critVal$PI[i, 2], 4)), width=15),
format(toString(round(x$critVal$PI[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "lf")) {
cat(paste(format("LF" , width=15),
format(toString(round(x$critVal$LF[i, 1], 4)), width=15),
format(toString(round(x$critVal$LF[i, 2], 4)), width=15),
format(toString(round(x$critVal$LF[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "2ms")) {
cat(paste(format("2MS" , width=15),
format(toString(round(x$critVal$MS[i, 1], 4)), width=15),
format(toString(round(x$critVal$MS[i, 2], 4)), width=15),
format(toString(round(x$critVal$MS[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "2ub")) {
cat(paste(format("2UB" , width=15),
format(toString(round(x$critVal$UB[i, 1], 4)), width=15),
format(toString(round(x$critVal$UB[i, 2], 4)), width=15),
format(toString(round(x$critVal$UB[i, 3], 4)), width=15), sep="")); cat("\n")}
}
cat(paste(rep("=", 60), collapse="")); cat("\n")
cat("\n")
if (x$method %in% c("pi")) {
warning("Plugging-in the estimated moment conditions (setting 'method=PI') leads to inference that is not uniformly valid.\n")
}
}
################################################################################
#' Internal function.
#'
#' @param object Class \code{ramchoiceRevealPref} objects.
#'
#' @keywords internal
#' @export
print.ramchoiceRevealPref <- function(x, ...) {
cat("\n Revealed Preference Analysis in Random Limited Attention Models.\n")
cat("\n")
cat(paste(format("# of observations", width=25), toString(sum(x$sumStats$sumN)), sep="")); cat("\n")
cat(paste(format("# of alternatives", width=25), toString(ncol(x$sumStats$sumMenu)), sep="")); cat("\n")
cat(paste(format("# of choice problems", width=25), toString(nrow(x$sumStats$sumMenu)), sep="")); cat("\n")
cat("\n")
cat(paste(format("Min # of alternatives", width=25), toString(min(x$sumStats$sumMsize)), sep="")); cat("\n")
cat(paste(format("Max # of alternatives", width=25), toString(max(x$sumStats$sumMsize)), sep="")); cat("\n")
cat("\n")
cat(paste(format("Min eff. observations", width=25), toString(min(x$sumStats$sumN)), sep="")); cat("\n")
cat(paste(format("Max eff. observations", width=25), toString(max(x$sumStats$sumN)), sep="")); cat("\n")
cat("\n")
if (x$opt$RAM) {
if (x$opt$limDataCorr) {
cat(format("RAM restrictions employed.", width=100)); cat("\n")
} else {
cat(format("RAM restrictions employed.", width=100)); cat("\n")
}
}
if (x$opt$AOM) {
cat(format("AOM restrictions employed.", width=100)); cat("\n")
}
if (x$opt$attBinary < 1) {
cat(paste(format("Attentive-at-binaries restrictions employed with threshold ", width=59), toString(round(x$opt$attBinary, 3)), sep="")); cat("\n")
}
cat("\n")
if (x$method %in% c("all")) {
# nothing here
} else if (x$method %in% c("gms")) {
cat(paste(format("Critical Value Method", width=25), "Generalized Moment Selection", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("pi")) {
cat(paste(format("Critical Value Method", width=25), "Plug-in Method", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("lf")) {
cat(paste(format("Critical Value Method", width=25), "Least Favorable Method", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("2ms")) {
cat(paste(format("Critical Value Method", width=25), "Two-step Moment Selection", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("2ub")) {
cat(paste(format("Critical Value Method", width=25), "Two-step Upper Bound", sep="")); cat("\n")
cat("\n")
} else {
# nothing, should not be here
}
for (i in 1:nrow(x$pref)) {
cat(paste(rep("=", 60), collapse="")); cat("\n")
cat(paste("Preference[", toString(i), "]",": ", sep=""))
cat(x$pref[i, ]); cat("\n")
if (x$method %in% c("all", "gms")) {
if (sum(x$Tstat[i] > x$critVal$GMS[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$GMS[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$GMS[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("lf")) {
if (sum(x$Tstat[i] > x$critVal$LF[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$LF[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$LF[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("pi")) {
if (sum(x$Tstat[i] > x$critVal$PI[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$PI[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$PI[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("2ms")) {
if (sum(x$Tstat[i] > x$critVal$MS[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$MS[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$MS[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("2ub")) {
if (sum(x$Tstat[i] > x$critVal$UB[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$UB[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$UB[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else {
# ??? should not be here
stars <- ""
}
if (x$method %in% c("all")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (GMS p-val: ", toString(round(x$pVal$GMS[i], 3)), stars, ")", sep="")); cat("\n")
} else if (x$method %in% c("gms")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (p-val: ", toString(round(x$pVal$GMS[i], 3)), stars, ")", sep="")); cat("\n")
} else if (x$method %in% c("lf")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (p-val: ", toString(round(x$pVal$LF[i], 3)), stars, ")", sep="")); cat("\n")
} else if (x$method %in% c("pi")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (p-val: ", toString(round(x$pVal$PI[i], 3)), stars, ")", sep="")); cat("\n")
} else {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), stars, sep="")); cat("\n")
}
if (x$method %in% c("all")) {cat(paste(rep("-", 60), collapse="")); cat("\n")}
cat(paste(format("Crit Val", width=15), format("0.10", width=15), format("0.05", width=15), format("0.01", width=15), sep="")); cat("\n")
if (x$method %in% c("all")) {cat(paste(rep("-", 60), collapse="")); cat("\n")}
if (x$method %in% c("all", "gms")) {
cat(paste(format("GMS" , width=15),
format(toString(round(x$critVal$GMS[i, 1], 4)), width=15),
format(toString(round(x$critVal$GMS[i, 2], 4)), width=15),
format(toString(round(x$critVal$GMS[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "pi")) {
cat(paste(format("PI" , width=15),
format(toString(round(x$critVal$PI[i, 1], 4)), width=15),
format(toString(round(x$critVal$PI[i, 2], 4)), width=15),
format(toString(round(x$critVal$PI[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "lf")) {
cat(paste(format("LF" , width=15),
format(toString(round(x$critVal$LF[i, 1], 4)), width=15),
format(toString(round(x$critVal$LF[i, 2], 4)), width=15),
format(toString(round(x$critVal$LF[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "2ms")) {
cat(paste(format("2MS" , width=15),
format(toString(round(x$critVal$MS[i, 1], 4)), width=15),
format(toString(round(x$critVal$MS[i, 2], 4)), width=15),
format(toString(round(x$critVal$MS[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "2ub")) {
cat(paste(format("2UB" , width=15),
format(toString(round(x$critVal$UB[i, 1], 4)), width=15),
format(toString(round(x$critVal$UB[i, 2], 4)), width=15),
format(toString(round(x$critVal$UB[i, 3], 4)), width=15), sep="")); cat("\n")}
}
cat(paste(rep("=", 60), collapse="")); cat("\n")
cat("\n")
if (x$method %in% c("pi")) {
warning("Plugging-in the estimated moment conditions (setting 'method=PI') leads to inference that is not uniformly valid.\n")
}
}
Try the ramchoice package in your browser
Any scripts or data that you put into this service are public.
ramchoice documentation built on May 24, 2022, 1:06 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions print.ramchoiceRevealPref summary.ramchoiceRevealPref revealPref
Documented in print.ramchoiceRevealPref revealPref summary.ramchoiceRevealPref
################################################################################
#' @title Revealed Preference Analysis in Random Limited Attention Models
#'
#' @description Given a random sample of choice problems and choices, \code{revealPref}
#' returns test statistics, critical values and p-values against a collection of preferences.
#' Five methods for choosing critical values are available:
#' (i) \code{GMS}: generalized moment selection (plug-in (estimated) moment conditions with shrinkage);
#' (ii) \code{PI}: critical values based on plug-in estimated moment conditions (this is not uniformly valid);
#' (iii) \code{LF}: critical values based on the least favorable model (plug-in 0 for the moment conditions);
#' (iv) \code{2MS}: two-step moment selection;
#' and (v) \code{2UB}: refined moment selection (plug-in upper bound of moment inequalities).
#'
#' \code{\link{sumData}} is a low-level function that generates summary statistics, and
#' \code{\link{genMat}} can be used to construct the constraint matrices. The simulated dataset
#' \code{\link{ramdata}} is also provided for illustration. For revealed attention analysis, see \code{\link{revealAtte}}.
#'
#' @param menu Numeric matrix of 0s and 1s, the collection of choice problems.
#' @param choice Numeric matrix of 0s and 1s, the collection of choices.
#' @param pref_list Numeric matrix, each row corresponds to one preference. For example, \code{c(2, 3, 1)} means
#' 2 is preferred to 3 and to 1. When set to \code{NULL}, the default, \code{c(1, 2, 3, ...)},
#' will be used.
#' @param method String, the method for constructing critical values. Default is \code{GMS} (generalized moment selection).
#' Other available options are \code{LF} (least favorable model), \code{PI} (plug-in method), \code{2MS} (two-step moment selection),
#' \code{2UB} (two-step moment upper bound), or \code{ALL} (report all critical values).
#' @param nCritSimu Integer, number of simulations used to construct the critical value. Default is \code{2000}.
#' @param BARatio2MS Numeric, beta-to-alpha ratio for two-step moment selection method. Default is \code{0.1}.
#' @param BARatio2UB Numeric, beta-to-alpha ratio for two-step moment upper bound method. Default is \code{0.1}.
#' @param MNRatioGMS Numeric, shrinkage parameter. Default is \code{sqrt(1/log(N))}, where N is the sample size.
#' @param RAM Boolean, whether the restrictions implied by the RAM of
#' \href{https://arxiv.org/abs/1712.03448}{Cattaneo et al. (2020)} should be incorporated, that is, their monotonic attention assumption (default is \code{TRUE}).
#' @param AOM Boolean, whether the restrictions implied by the AOM of
#' \href{https://arxiv.org/abs/2110.10650}{Cattaneo et al. (2022)} should be incorporated, that is, their attention overload assumption (default is \code{TRUE}).
#' @param limDataCorr Boolean, whether assuming limited data (default is \code{TRUE}). When set to
#' \code{FALSE}, will assume all choice problems are observed. This option only applies when \code{RAM} is set to \code{TRUE}.
#' @param attBinary Numeric, between 1/2 and 1 (default is \code{1}), whether additional restrictions (on the attention rule)
#' should be imposed for binary choice problems (i.e., attentive at binaries).
#'
#' @return
#' \item{sumStats}{Summary statistics, generated by \code{\link{sumData}}.}
#' \item{constraints}{Matrices of constraints, generated by \code{\link{genMat}}.}
#' \item{Tstat}{Test statistic.}
#' \item{critVal}{Critical values.}
#' \item{pVal}{P-values (only available for \code{GMS}, \code{LF} and \code{PI}).}
#' \item{method}{Method for constructing critical value.}
#'
#' @references
#' M. D. Cattaneo, X. Ma, Y. Masatlioglu, and E. Suleymanov (2020). \href{https://arxiv.org/abs/1712.03448}{A Random Attention Model}. \emph{Journal of Political Economy} 128(7): 2796-2836. \doi{10.1086/706861}
#'
#' M. D. Cattaneo, P. Cheung, X. Ma, and Y. Masatlioglu (2022). \href{https://arxiv.org/abs/2110.10650}{Attention Overload}. Working paper.
#'
#' @author
#' Matias D. Cattaneo, Princeton University. \email{cattaneo@princeton.edu}.
#'
#' Paul Cheung, University of Maryland. \email{hycheung@umd.edu}
#'
#' Xinwei Ma (maintainer), University of California San Diego. \email{x1ma@ucsd.edu}
#'
#' Yusufcan Masatlioglu, University of Maryland. \email{yusufcan@umd.edu}
#'
#' Elchin Suleymanov, Purdue University. \email{esuleyma@purdue.edu}
#'
#' @examples
#' # Load data
#' data(ramdata)
#'
#' # Set seed, to replicate simulated critical values
#' set.seed(42)
#'
#' # list of preferences
#' pref_list <- matrix(c(1, 2, 3, 4, 5,
#' 2, 1, 3, 4, 5,
#' 2, 3, 4, 5, 1,
#' 5, 4, 3, 2, 1), ncol=5, byrow=TRUE)
#'
#' # revealed preference using only RAM restrictions
#' result1 <- revealPref(menu = ramdata$menu, choice = ramdata$choice, method = "GMS",
#' pref_list = pref_list, RAM = TRUE, AOM = FALSE)
#' summary(result1)
#'
#' # revealed preference using only AOM restrictions
#' result2 <- revealPref(menu = ramdata$menu, choice = ramdata$choice, method = "GMS",
#' pref_list = pref_list, RAM = FALSE, AOM = TRUE)
#' summary(result2)
#'
#' # revealed preference using both RAM and AOM restrictions
#' result3 <- revealPref(menu = ramdata$menu, choice = ramdata$choice, method = "GMS",
#' pref_list = pref_list, RAM = TRUE, AOM = TRUE)
#' summary(result3)
#'
#' # revealed preference employing additional restrictions for binary choice problems
#' result4 <- revealPref(menu = ramdata$menu, choice = ramdata$choice, method = "GMS",
#' pref_list = pref_list, RAM = TRUE, AOM = TRUE, attBinary = 2/3)
#' summary(result4)
#'
#' @export
revealPref <- function(menu, choice, pref_list = NULL, method = "GMS",
nCritSimu = 2000,
BARatio2MS = 0.1, BARatio2UB = 0.1, MNRatioGMS = NULL,
RAM = TRUE, AOM = TRUE,
limDataCorr = TRUE,
attBinary = 1) {
################################################################################
# Error Check
################################################################################
# menu
if (!is.matrix(menu)) {
stop("Input 'menu' has to be a matrix.\n")
} else if (min(dim(menu)) == 0) {
stop("Input 'menu' has at least one dimension 0.\n")
} else if (!all((menu == 0) | (menu == 1))) {
stop("Input 'menu' can only contain 0 (FALSE) and 1 (TRUE).\n")
} else {
# nothing
}
# choice
if (!is.matrix(choice)) {
stop("Input 'choice' has to be a matrix.\n")
} else if (min(dim(choice)) == 0) {
stop("Input 'choice' has at least one dimension 0.\n")
} else if (!all((choice == 0) | (choice == 1))) {
stop("Input 'choice' can only contain 0 (FALSE) and 1 (TRUE).\n")
} else if (!all(rowSums(choice) == 1)) {
stop("Input 'choice' should contain one and only one 1 (TRUE) in each row.\n")
} else {
# nothing
}
# menu and choice
if (!all(dim(menu) == dim(choice))) {
stop("Input 'menu' and 'choice' have to have the same dimensions.\n")
}
else if (!all(as.integer(rowSums((menu == 1) & (choice == 1))))) {
stop("Input 'menu' and 'choice' should contain one and only one common 1 (TRUE) in each row.\n")
} else {
# nothing
}
# preference
if (length(as.vector(pref_list)) == 0) {
pref_list <- matrix(1:ncol(menu), nrow=1)
} else if (!is.matrix(pref_list)) {
stop("Input 'pref_list' has to be a matrix.\n")
} else if (min(dim(pref_list)) == 0) {
stop("Input 'pref_list' has at least one dimension 0.\n")
} else if (ncol(pref_list) != ncol(menu)) {
stop("Input 'pref_list' has to have the same number of columns as 'menu'.\n")
} else if (!all(apply(pref_list, MARGIN=1, FUN=function(x) all(sort(x)==1:ncol(menu))))) {
stop("Input 'pref_list' incorrectly specified.\n")
} else {
# nothing
}
# method
if (length(method) == 0) {
method <- "GMS"
}
else if(!is.character("method")) {
stop("Input 'method' has to be a character string.\n")
} else {
method <- tolower(method)
if (!(method %in% c("gms", "lf", "pi", "2ms", "2ub", "all"))) {
stop("Input 'method' incorrectly specified.\n")
} else {
# nothing
}
}
if (length(MNRatioGMS) == 0) {
MNRatioGMS <- 1 / log(nrow(menu))
} else {
# nothing
}
level <- c(0.9, 0.95, 0.99)
################################################################################
# Initialization
################################################################################
# maximum statistic
Tstat <- rep(NA, nrow(pref_list))
# PI: plugin critical value
if (method %in% c("all", "pi")) {
CritValPI <- matrix(NA, nrow=nrow(pref_list), ncol=length(level))
colnames(CritValPI) <- 1 - level
rownames(CritValPI) <- 1:nrow(pref_list)
pValPI <- matrix(NA, nrow=nrow(pref_list), ncol=1)
colnames(pValPI) <- "pval"
rownames(pValPI) <- 1:nrow(pref_list)
} else {CritValPI <- pValPI <- NULL}
# LF: critical value, least favorable
if (method %in% c("all", "lf")) {
CritValLF <- matrix(NA, nrow=nrow(pref_list), ncol=length(level))
colnames(CritValLF) <- 1 - level
rownames(CritValLF) <- 1:nrow(pref_list)
pValLF <- matrix(NA, nrow=nrow(pref_list), ncol=1)
colnames(pValLF) <- "pval"
rownames(pValLF) <- 1:nrow(pref_list)
} else {CritValLF <- pValLF <- NULL}
# MS: critical value, 2 step moment selection
if (method %in% c("all", "2ms")) {
CritVal2MS <- matrix(NA, nrow=nrow(pref_list), ncol=length(level))
colnames(CritVal2MS) <- 1 - level
rownames(CritVal2MS) <- 1:nrow(pref_list)
} else {CritVal2MS <- NULL}
# UB: critical value, 2 step upper bound
if (method %in% c("all", "2ub")) {
CritVal2UB <- matrix(NA, nrow=nrow(pref_list), ncol=length(level))
colnames(CritVal2UB) <- 1 - level
rownames(CritVal2UB) <- 1:nrow(pref_list)
} else {CritVal2UB <- NULL}
# GMS: critical value, shrinkage
if (method %in% c("all", "gms")) {
CritValGMS <- matrix(NA, nrow=nrow(pref_list), ncol=length(level))
colnames(CritValGMS) <- 1 - level
rownames(CritValGMS) <- 1:nrow(pref_list)
pValGMS <- matrix(NA, nrow=nrow(pref_list), ncol=1)
colnames(pValGMS) <- "pval"
rownames(pValGMS) <- 1:nrow(pref_list)
} else {CritValGMS <- pValGMS <- NULL}
# first obtain point estimates
# summary statistics
sumStats <- sumData(menu, choice)
n <- sum(sumStats$sumN) # sample size
# generate matrices
constraints <- genMat(sumStats$sumMenu, sumStats$sumMsize, pref_list, RAM, AOM, limDataCorr, attBinary)
# simulate normal distributions, scale by sample size since Sigma is asymptotically stable.
normSimu <- t(mvrnorm(n=nCritSimu, mu=rep(0, nrow(sumStats$Sigma)), Sigma=sumStats$Sigma) / sqrt(n))
normSimu[diag(sumStats$Sigma) == 0, ] <- 0;
# find test statistics and critical values
temp <- matrix(0, nrow=5, ncol=nCritSimu)
j <- 0
for (i in 1:nrow(pref_list)) {
if (constraints$ConstN[i] == 0) {# if there are no constraints
Tstat[i] <- 0
if (method %in% c("all", "pi")) {CritValPI[i, ] <- 0}
if (method %in% c("all", "lf")) {CritValLF[i, ] <- 0}
if (method %in% c("all", "2ms")) {CritVal2MS[i, ] <- 0}
if (method %in% c("all", "2ub")) {CritVal2UB[i, ] <- 0}
if (method %in% c("all", "gms")) {CritValGMS[i, ] <- 0}
} else {# if there are constraints
R_temp <- constraints$R[(j+1):(j+constraints$ConstN[i]), ]
RSigma <- R_temp %*% sumStats$Sigma %*% t(R_temp)
tempTstat <- (R_temp %*% sumStats$sumProbVec) / sqrt(abs(diag(RSigma)))
tempTstat[is.na(tempTstat)] <- 0
tempTstat <- sqrt(n) * tempTstat
Tstat[i] = max(max(tempTstat), 0) # maximum statistic
# plug-in center
if (method %in% c("all", "pi")) {
centerPI <- R_temp %*% sumStats$sumProbVec
centerPI[centerPI > 0] <- 0
}
# generalized moment selection center
if (method %in% c("all", "gms")) {
centerGMS <- R_temp %*% sumStats$sumProbVec * sqrt(MNRatioGMS)
centerGMS[centerGMS > 0] <- 0
}
# to store simulated moment inequalities
tempTstatSimu <- matrix(0, nrow=constraints$ConstN[i], ncol=nCritSimu)
for (k in 1:nCritSimu) {
# least favorable (also used for two-step methods)
if (method %in% c("all", "lf", "2ms", "2ub")) {
temptemp <- (R_temp %*% normSimu[, k]) / sqrt(abs(diag(RSigma)))
temptemp[is.na(temptemp)] <- 0
temp[1, k] <- sqrt(n) * max(max(temptemp), 0)
tempTstatSimu[, k] = sqrt(n) * temptemp
}
# generalized moment selection recentering
if (method %in% c("all", "gms")) {
temptemp <- (R_temp %*% normSimu[, k] + centerGMS) / sqrt(abs(diag(RSigma)))
temptemp[is.na(temptemp)] <- 0
temp[3, k] <- sqrt(n) * max(max(temptemp), 0)
}
# plug-in center
if (method %in% c("all", "pi")) {
temptemp <- (R_temp %*% normSimu[, k] + centerPI) / sqrt(abs(diag(RSigma)))
temptemp[is.na(temptemp)] <- 0
temp[4, k] = sqrt(n) * max(max(temptemp), 0)
}
}
# plug-in center critical value
if (method %in% c("all", "pi")) {
CritValPI[i, ] <- quantile(temp[4, ], level)
pValPI[i] <- mean(temp[4, ] > Tstat[i])
}
# least favorable critical value
if (method %in% c("all", "lf")) {
CritValLF[i, ] <- quantile(temp[1, ], level)
pValLF[i] <- mean(temp[1, ] > Tstat[i])
}
# generalized moment selection recentering
if (method %in% c("all", "gms")) {
CritValGMS[i, ] <- quantile(temp[3, ], level)
pValGMS[i] <- mean(temp[3, ] > Tstat[i])
}
# 2 step methods
if (method %in% c("all", "2ms", "2ub")) {
for (i_level in 1:length(level)) {# enumerate all levels
# refined moment selection / moment inequality upper-bounding
if (method %in% c("all", "2ub")) {
centerUpper <- R_temp %*% sumStats$sumProbVec + sqrt(abs(diag(RSigma))) / sqrt(n) *
quantile(temp[1, ], 1 - ((1-level[i_level]) * BARatio2UB))
centerUpper[centerUpper > 0] <- 0
for (k in 1:nCritSimu) {
temptemp <- (R_temp %*% normSimu[, k] + centerUpper) / sqrt(abs(diag(RSigma)))
temptemp[is.na(temptemp)] <- 0
temp[5, k] <- sqrt(n) * max(max(temptemp), 0)
}
CritVal2UB[i, i_level] <- quantile(temp[5, ],
level[i_level] + (1-level[i_level]) * BARatio2UB)
}
# critical value with moment selection
if (method %in% c("all", "2ms")) {
tempCritBeta <- quantile(temp[1, ],
1 - ((1-level[i_level]) * BARatio2MS))
eff_moment <- (tempTstat > -2 * tempCritBeta)
if (sum(eff_moment) == 0) {# no effective moment
CritVal2MS[i, i_level] <- 0
} else{
CritVal2MS[i, i_level] <-
quantile(
apply(tempTstatSimu[eff_moment, ], MARGIN=2, FUN=function(x) max(max(x), 0)),
level[i_level] + (1 - level[i_level]) * BARatio2MS * 2)
}
}
}
}
}
j = j + constraints$ConstN[i];
}
Result <- list(sumStats=sumStats, constraints=constraints, Tstat=Tstat,
critVal=list(GMS=CritValGMS,
PI =CritValPI,
LF =CritValLF,
MS =CritVal2MS,
UB =CritVal2UB),
pVal=list(GMS=pValGMS,
PI =pValPI,
LF =pValLF),
pref=pref_list,
method=method,
opt=list(RAM=RAM, AOM=AOM, limDataCorr=limDataCorr, attBinary=attBinary))
class(Result) <- "ramchoiceRevealPref"
return(Result)
}
################################################################################
#' @title Revealed Preference Analysis in Random Limited Attention Models
#'
#' @description This has been replaced by \code{\link{revealPref}}.
#'
#' @param menu Numeric matrix of 0s and 1s, the collection of choice problems.
#' @param choice Numeric matrix of 0s and 1s, the collection of choices.
#' @param pref_list Numeric matrix, each row corresponds to one preference. For example, \code{c(2, 3, 1)} means
#' 2 is preferred to 3 and to 1. When set to \code{NULL}, the default, \code{c(1, 2, 3, ...)},
#' will be used.
#' @param method String, the method for constructing critical values. Default is \code{GMS} (generalized moment selection).
#' Other available options are \code{LF} (least favorable model), \code{PI} (plug-in method), \code{2MS} (two-step moment selection),
#' \code{2UB} (two-step moment upper bound), or \code{ALL} (report all critical values).
#' @param nCritSimu Integer, number of simulations used to construct the critical value. Default is \code{2000}.
#' @param BARatio2MS Numeric, beta-to-alpha ratio for two-step moment selection method. Default is \code{0.1}.
#' @param BARatio2UB Numeric, beta-to-alpha ratio for two-step moment upper bound method. Default is \code{0.1}.
#' @param MNRatioGMS Numeric, shrinkage parameter. Default is \code{sqrt(1/log(N))}, where N is the sample size.
#' @param RAM Boolean, whether the restrictions implied by the RAM of
#' \href{https://arxiv.org/abs/1712.03448}{Cattaneo et al. (2020)} should be incorporated, that is, their monotonic attention assumption (default is \code{TRUE}).
#' @param AOM Boolean, whether the restrictions implied by the AOM of
#' \href{https://arxiv.org/abs/2110.10650}{Cattaneo et al. (2022)} should be incorporated, that is, their attention overload assumption (default is \code{TRUE}).
#' @param limDataCorr Boolean, whether assuming limited data (default is \code{TRUE}). When set to
#' \code{FALSE}, will assume all choice problems are observed. This option only applies when \code{RAM} is set to \code{TRUE}.
#' @param attBinary Numeric, between 1/2 and 1 (default is \code{1}), whether additional restrictions (on the attention rule)
#' should be imposed for binary choice problems (i.e., attentive at binaries).
#'
#' @return
#' \item{sumStats}{Summary statistics, generated by \code{\link{sumData}}.}
#' \item{constraints}{Matrices of constraints, generated by \code{\link{genMat}}.}
#' \item{Tstat}{Test statistic.}
#' \item{critVal}{Critical values.}
#' \item{pVal}{P-values (only available for \code{GMS}, \code{LF} and \code{PI}).}
#' \item{method}{Method for constructing critical value.}
#'
#' @references
#' M. D. Cattaneo, X. Ma, Y. Masatlioglu, and E. Suleymanov (2020). \href{https://arxiv.org/abs/1712.03448}{A Random Attention Model}. \emph{Journal of Political Economy} 128(7): 2796-2836. \doi{10.1086/706861}
#'
#' M. D. Cattaneo, P. Cheung, X. Ma, and Y. Masatlioglu (2022). \href{https://arxiv.org/abs/2110.10650}{Attention Overload}. Working paper.
#'
#' @author
#' Matias D. Cattaneo, Princeton University. \email{cattaneo@princeton.edu}.
#'
#' Paul Cheung, University of Maryland. \email{hycheung@umd.edu}
#'
#' Xinwei Ma (maintainer), University of California San Diego. \email{x1ma@ucsd.edu}
#'
#' Yusufcan Masatlioglu, University of Maryland. \email{yusufcan@umd.edu}
#'
#' Elchin Suleymanov, Purdue University. \email{esuleyma@purdue.edu}
#'
#' @export
rAtte <- revealPref
################################################################################
#' Internal function.
#'
#' @param object Class \code{ramchoiceRevealPref} objects.
#'
#' @keywords internal
#' @export
summary.ramchoiceRevealPref <- function(object, ...) {
x <- object
cat("\n Revealed Preference Analysis in Random Limited Attention Models.\n")
cat("\n")
cat(paste(format("# of observations", width=25), toString(sum(x$sumStats$sumN)), sep="")); cat("\n")
cat(paste(format("# of alternatives", width=25), toString(ncol(x$sumStats$sumMenu)), sep="")); cat("\n")
cat(paste(format("# of choice problems", width=25), toString(nrow(x$sumStats$sumMenu)), sep="")); cat("\n")
cat("\n")
cat(paste(format("Min # of alternatives", width=25), toString(min(x$sumStats$sumMsize)), sep="")); cat("\n")
cat(paste(format("Max # of alternatives", width=25), toString(max(x$sumStats$sumMsize)), sep="")); cat("\n")
cat("\n")
cat(paste(format("Min eff. observations", width=25), toString(min(x$sumStats$sumN)), sep="")); cat("\n")
cat(paste(format("Max eff. observations", width=25), toString(max(x$sumStats$sumN)), sep="")); cat("\n")
cat("\n")
if (x$opt$RAM) {
if (x$opt$limDataCorr) {
cat(format("RAM restrictions from Cattaneo, Ma, Masatlioglu, and Suleymanov (2020) employed.", width=100)); cat("\n")
} else {
cat(format("RAM restrictions from Cattaneo, Ma, Masatlioglu, and Suleymanov (2020) employed.", width=100)); cat("\n")
}
}
if (x$opt$AOM) {
cat(format("AOM restrictions from Cattaneo, Cheung, Ma, and Masatlioglu (2021) employed.", width=100)); cat("\n")
}
if (x$opt$attBinary < 1) {
cat(paste(format("Attentive-at-binaries restrictions employed with threshold ", width=59), toString(round(x$opt$attBinary, 3)), sep="")); cat("\n")
}
cat("\n")
if (x$method %in% c("all")) {
# nothing here
} else if (x$method %in% c("gms")) {
cat(paste(format("Critical Value Method", width=25), "Generalized Moment Selection", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("pi")) {
cat(paste(format("Critical Value Method", width=25), "Plug-in Method", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("lf")) {
cat(paste(format("Critical Value Method", width=25), "Least Favorable Method", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("2ms")) {
cat(paste(format("Critical Value Method", width=25), "Two-step Moment Selection", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("2ub")) {
cat(paste(format("Critical Value Method", width=25), "Two-step Upper Bound", sep="")); cat("\n")
cat("\n")
} else {
# nothing, should not be here
}
for (i in 1:nrow(x$pref)) {
cat(paste(rep("=", 60), collapse="")); cat("\n")
cat(paste("Preference[", toString(i), "]",": ", sep=""))
cat(x$pref[i, ]); cat("\n")
if (x$method %in% c("all", "gms")) {
if (sum(x$Tstat[i] > x$critVal$GMS[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$GMS[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$GMS[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("lf")) {
if (sum(x$Tstat[i] > x$critVal$LF[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$LF[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$LF[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("pi")) {
if (sum(x$Tstat[i] > x$critVal$PI[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$PI[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$PI[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("2ms")) {
if (sum(x$Tstat[i] > x$critVal$MS[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$MS[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$MS[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("2ub")) {
if (sum(x$Tstat[i] > x$critVal$UB[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$UB[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$UB[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else {
# ??? should not be here
stars <- ""
}
if (x$method %in% c("all")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (GMS p-val: ", toString(round(x$pVal$GMS[i], 3)), stars, ")", sep="")); cat("\n")
} else if (x$method %in% c("gms")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (p-val: ", toString(round(x$pVal$GMS[i], 3)), stars, ")", sep="")); cat("\n")
} else if (x$method %in% c("lf")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (p-val: ", toString(round(x$pVal$LF[i], 3)), stars, ")", sep="")); cat("\n")
} else if (x$method %in% c("pi")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (p-val: ", toString(round(x$pVal$PI[i], 3)), stars, ")", sep="")); cat("\n")
} else {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), stars, sep="")); cat("\n")
}
if (x$method %in% c("all")) {cat(paste(rep("-", 60), collapse="")); cat("\n")}
cat(paste(format("Crit Val", width=15), format("0.10", width=15), format("0.05", width=15), format("0.01", width=15), sep="")); cat("\n")
if (x$method %in% c("all")) {cat(paste(rep("-", 60), collapse="")); cat("\n")}
if (x$method %in% c("all", "gms")) {
cat(paste(format("GMS" , width=15),
format(toString(round(x$critVal$GMS[i, 1], 4)), width=15),
format(toString(round(x$critVal$GMS[i, 2], 4)), width=15),
format(toString(round(x$critVal$GMS[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "pi")) {
cat(paste(format("PI" , width=15),
format(toString(round(x$critVal$PI[i, 1], 4)), width=15),
format(toString(round(x$critVal$PI[i, 2], 4)), width=15),
format(toString(round(x$critVal$PI[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "lf")) {
cat(paste(format("LF" , width=15),
format(toString(round(x$critVal$LF[i, 1], 4)), width=15),
format(toString(round(x$critVal$LF[i, 2], 4)), width=15),
format(toString(round(x$critVal$LF[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "2ms")) {
cat(paste(format("2MS" , width=15),
format(toString(round(x$critVal$MS[i, 1], 4)), width=15),
format(toString(round(x$critVal$MS[i, 2], 4)), width=15),
format(toString(round(x$critVal$MS[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "2ub")) {
cat(paste(format("2UB" , width=15),
format(toString(round(x$critVal$UB[i, 1], 4)), width=15),
format(toString(round(x$critVal$UB[i, 2], 4)), width=15),
format(toString(round(x$critVal$UB[i, 3], 4)), width=15), sep="")); cat("\n")}
}
cat(paste(rep("=", 60), collapse="")); cat("\n")
cat("\n")
if (x$method %in% c("pi")) {
warning("Plugging-in the estimated moment conditions (setting 'method=PI') leads to inference that is not uniformly valid.\n")
}
}
################################################################################
#' Internal function.
#'
#' @param object Class \code{ramchoiceRevealPref} objects.
#'
#' @keywords internal
#' @export
print.ramchoiceRevealPref <- function(x, ...) {
cat("\n Revealed Preference Analysis in Random Limited Attention Models.\n")
cat("\n")
cat(paste(format("# of observations", width=25), toString(sum(x$sumStats$sumN)), sep="")); cat("\n")
cat(paste(format("# of alternatives", width=25), toString(ncol(x$sumStats$sumMenu)), sep="")); cat("\n")
cat(paste(format("# of choice problems", width=25), toString(nrow(x$sumStats$sumMenu)), sep="")); cat("\n")
cat("\n")
cat(paste(format("Min # of alternatives", width=25), toString(min(x$sumStats$sumMsize)), sep="")); cat("\n")
cat(paste(format("Max # of alternatives", width=25), toString(max(x$sumStats$sumMsize)), sep="")); cat("\n")
cat("\n")
cat(paste(format("Min eff. observations", width=25), toString(min(x$sumStats$sumN)), sep="")); cat("\n")
cat(paste(format("Max eff. observations", width=25), toString(max(x$sumStats$sumN)), sep="")); cat("\n")
cat("\n")
if (x$opt$RAM) {
if (x$opt$limDataCorr) {
cat(format("RAM restrictions employed.", width=100)); cat("\n")
} else {
cat(format("RAM restrictions employed.", width=100)); cat("\n")
}
}
if (x$opt$AOM) {
cat(format("AOM restrictions employed.", width=100)); cat("\n")
}
if (x$opt$attBinary < 1) {
cat(paste(format("Attentive-at-binaries restrictions employed with threshold ", width=59), toString(round(x$opt$attBinary, 3)), sep="")); cat("\n")
}
cat("\n")
if (x$method %in% c("all")) {
# nothing here
} else if (x$method %in% c("gms")) {
cat(paste(format("Critical Value Method", width=25), "Generalized Moment Selection", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("pi")) {
cat(paste(format("Critical Value Method", width=25), "Plug-in Method", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("lf")) {
cat(paste(format("Critical Value Method", width=25), "Least Favorable Method", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("2ms")) {
cat(paste(format("Critical Value Method", width=25), "Two-step Moment Selection", sep="")); cat("\n")
cat("\n")
} else if (x$method %in% c("2ub")) {
cat(paste(format("Critical Value Method", width=25), "Two-step Upper Bound", sep="")); cat("\n")
cat("\n")
} else {
# nothing, should not be here
}
for (i in 1:nrow(x$pref)) {
cat(paste(rep("=", 60), collapse="")); cat("\n")
cat(paste("Preference[", toString(i), "]",": ", sep=""))
cat(x$pref[i, ]); cat("\n")
if (x$method %in% c("all", "gms")) {
if (sum(x$Tstat[i] > x$critVal$GMS[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$GMS[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$GMS[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("lf")) {
if (sum(x$Tstat[i] > x$critVal$LF[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$LF[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$LF[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("pi")) {
if (sum(x$Tstat[i] > x$critVal$PI[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$PI[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$PI[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("2ms")) {
if (sum(x$Tstat[i] > x$critVal$MS[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$MS[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$MS[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else if (x$method %in% c("2ub")) {
if (sum(x$Tstat[i] > x$critVal$UB[i, ]) == 3) {
stars <- " ***"
} else if (sum(x$Tstat[i] > x$critVal$UB[i, ]) == 2) {
stars <- " **"
} else if (sum(x$Tstat[i] > x$critVal$UB[i, ]) == 1) {
stars <- " *"
} else {
stars <- ""
}
} else {
# ??? should not be here
stars <- ""
}
if (x$method %in% c("all")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (GMS p-val: ", toString(round(x$pVal$GMS[i], 3)), stars, ")", sep="")); cat("\n")
} else if (x$method %in% c("gms")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (p-val: ", toString(round(x$pVal$GMS[i], 3)), stars, ")", sep="")); cat("\n")
} else if (x$method %in% c("lf")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (p-val: ", toString(round(x$pVal$LF[i], 3)), stars, ")", sep="")); cat("\n")
} else if (x$method %in% c("pi")) {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), " (p-val: ", toString(round(x$pVal$PI[i], 3)), stars, ")", sep="")); cat("\n")
} else {
cat(paste("Statistic: ", toString(round(x$Tstat[i], 4)), stars, sep="")); cat("\n")
}
if (x$method %in% c("all")) {cat(paste(rep("-", 60), collapse="")); cat("\n")}
cat(paste(format("Crit Val", width=15), format("0.10", width=15), format("0.05", width=15), format("0.01", width=15), sep="")); cat("\n")
if (x$method %in% c("all")) {cat(paste(rep("-", 60), collapse="")); cat("\n")}
if (x$method %in% c("all", "gms")) {
cat(paste(format("GMS" , width=15),
format(toString(round(x$critVal$GMS[i, 1], 4)), width=15),
format(toString(round(x$critVal$GMS[i, 2], 4)), width=15),
format(toString(round(x$critVal$GMS[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "pi")) {
cat(paste(format("PI" , width=15),
format(toString(round(x$critVal$PI[i, 1], 4)), width=15),
format(toString(round(x$critVal$PI[i, 2], 4)), width=15),
format(toString(round(x$critVal$PI[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "lf")) {
cat(paste(format("LF" , width=15),
format(toString(round(x$critVal$LF[i, 1], 4)), width=15),
format(toString(round(x$critVal$LF[i, 2], 4)), width=15),
format(toString(round(x$critVal$LF[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "2ms")) {
cat(paste(format("2MS" , width=15),
format(toString(round(x$critVal$MS[i, 1], 4)), width=15),
format(toString(round(x$critVal$MS[i, 2], 4)), width=15),
format(toString(round(x$critVal$MS[i, 3], 4)), width=15), sep="")); cat("\n")}
if (x$method %in% c("all", "2ub")) {
cat(paste(format("2UB" , width=15),
format(toString(round(x$critVal$UB[i, 1], 4)), width=15),
format(toString(round(x$critVal$UB[i, 2], 4)), width=15),
format(toString(round(x$critVal$UB[i, 3], 4)), width=15), sep="")); cat("\n")}
}
cat(paste(rep("=", 60), collapse="")); cat("\n")
cat("\n")
if (x$method %in% c("pi")) {
warning("Plugging-in the estimated moment conditions (setting 'method=PI') leads to inference that is not uniformly valid.\n")
}
}
Try the ramchoice package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.