fmscr:

# This file was generated by Rcpp::compileAttributes
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' Generate draws from a multivariate normal distribution
#'
#' @param n Number of samples.
#' @param mu Mean vector.
#' @param Sigma Covariance matrix.
#' @return Matrix of draws from the normal distribution: each row is a draw.
#' @details This is essentially a stripped-down version of the mvrnorm function
#' from the MASS library in R. Through the magic of Rcpp we're transforming the
#' same standard normal draws as the R version. However, since Armadillo
#' follows a different convention from R in its definition of the
#' eign-decomposition, the output of this function will *not* be the same as
#' that of its R counterpart. Since we access R's function for generating
#' normal draws, we can set the seed from R.
#' @examples
#' mvrnorm(10, c(0,0), diag(1, 2, 2))
mvrnorm <- function(n, mu, Sigma) {
    .Call('fmscr_mvrnorm', PACKAGE = 'fmscr', n, mu, Sigma)
}

#' Calculate a sample quantile
#'
#' @param x Vector of data.
#' @param p Probability for desired quantile (e.g. 0.5 for median)
#' @return Sample quantile
#' @details There are many competing definitions of sample quantiles
#' (see Hyndman & Fan, 1996). Here we simply use the R default definition,
#' which corresponds to Definition 7 in Hyndman & Fan. See ?quantile in R for
#' more details.
#' @examples
#' foo <- rnorm(1000)
#' sample_quantile(foo, 0.16)
sample_quantile <- function(x, p) {
    .Call('fmscr_sample_quantile', PACKAGE = 'fmscr', x, p)
}

#' Calculate (trimmed) mean-squared error.
#'
#' @param x Vector of estimates.
#' @param true True parameter value.
#' @param trim Fraction of estimates to discard (half from each tail) before
#' calculating MSE (defaults to zero)
#' @return (trimmed) mean-squared error
#' @examples
#' x <- rnorm(1000) + 0.5
#' MSE_trim(x, 0)
#' MSE_trim(x, 0, 0.1)
MSE_trim <- function(x, truth, trim = 0.0) {
    .Call('fmscr_MSE_trim', PACKAGE = 'fmscr', x, truth, trim)
}

#' Calculate median absolute deviation
#'
#' @param x Vector of estimates.
#' @param truth True value of the parameter.
#' @return Median absolute deviation.
#' @examples
#' x <- rnorm(1000) + 0.5
#' MAD(x, 0)
MAD <- function(x, truth) {
    .Call('fmscr_MAD', PACKAGE = 'fmscr', x, truth)
}

#' Calculate the empirical coverage probability of a matrix of confidence
#' intervals.
#'
#' @param conf_intervals Matrix of confidence intervals in which each row is a
#' CI, the first column is the lower confidence limit, and the second column is
#' the upper confidence limit.
#' @param truth True value of the parameter for which the CIs were constructed.
#' @return Empirical coverage probability.
#' @examples
#' xbar <- replicate(1000, mean(rnorm(25)))
#' ME <- qnorm(0.975) / 5
#' CIs <- cbind(xbar - ME, xbar + ME)
#' coverage_prob(CIs, 0)
coverage_prob <- function(conf_intervals, truth) {
    .Call('fmscr_coverage_prob', PACKAGE = 'fmscr', conf_intervals, truth)
}

#' Calculate empirical median width of a matrix of confidence intervals.
#'
#' @param conf_intervals Matrix of confidence intervals in which each row is a
#' CI, the first column is the lower confidence limit, and the second column is
#' the upper confidence limit.
#' @return Empirical median width of the confidence intervals.
#' @examples
#' xbar <- replicate(1000, mean(rnorm(25)))
#' ME <- qnorm(0.975) / 5
#' CIs <- cbind(xbar - ME, xbar + ME)
#' median_width(CIs)
median_width <- function(conf_intervals) {
    .Call('fmscr_median_width', PACKAGE = 'fmscr', conf_intervals)
}

#' Calculate shortest two-sided confidence interval
#'
#' @param x Vector of simulations from sampling distribution of an estimator.
#' @param size One minus the desired coverage probability.
#' @param inc Step size for grid over which width is minimized.
#' @return Shortest (1 - size) * 100 percent interval based on the data provided.
#' @examples
#' x <- rnorm(1000)
#' shortest_CI(x)
shortest_CI <- function(x, size = 0.05, inc = 0.001) {
    .Call('fmscr_shortest_CI', PACKAGE = 'fmscr', x, size, inc)
}

myclip <- function(x, a, b) {
    .Call('fmscr_myclip', PACKAGE = 'fmscr', x, a, b)
}

#' Testing interface to limit_sim_OLS_IV class.
#'
#' @param tau Controls degree of endogeneity of OLS.
#' @param pi_sq First-stage R-squared (strengh of instruments).
#' @param n_sim Number of simulation draws.
#' @return List of draws from the limit experiment for OLS, TSLS and the
#' sample estimator of tau, as well as the mean vector and covariance matrix
#' used in the simulation.
#' @details This is a testing interface to the C++ class that is used to draw
#' from the limit experiment in the OLS versus TSLS simulation experiment from
#' section 5.1 of the paper.
#' @examples
#' foo <- OLSvsIV_limit_sim(5, 0.1)
#' cov(data.frame(ols = foo$ols, tsls = foo$tsls, tauhat = foo$tauhat))
OLSvsIV_limit_sim <- function(tau, pi_sq, n_sim = 10000L) {
    .Call('fmscr_OLSvsIV_limit_sim', PACKAGE = 'fmscr', tau, pi_sq, n_sim)
}

#' Coverage and Width of OLS, TSLS and Naive CIs
#'
#' @param tau Controls degree of endogeneity of OLS.
#' @param pi_sq First-stage R-squared (strengh of instruments).
#' @param size One minus the norminal coverage probability of the intervals.
#' @param n_sim Number of simulation draws from the limit experiment.
#' @return List containing empirical coverage probabilities and median width
#' of confidence intervals for the OLS and TSLS estimators and the same for a
#' "naive" confidence interval for the FMSC-selected estimator.
#' @details This function gives results based on simulations from the limit
#' experiment for the OLS versus TSLS example in Section 5.1 of the paper.
#' The confidence intervals computed here are for the non-simulation based
#' procedures: the OLS estimator, the TSLS estimator and a naive interval for
#' the post-FMSC estimator. This naive interval is constructed from the
#' textbook interval for whichever estimator the FMSC selects: if OLS is
#' selected it uses the standard OLS interval, and if TSLS is selected it uses
#' the TSLS interval. This procedure can perform very badly depending on
#' parameter values. Note that the median widths in this example are not
#' particularly interesting: the width of each OLS and TSLS interval is fixed
#' across all simulations and the median width of the naive interval equals
#' that of OLS when OLS is chosen more than 50 percent of the time and equals
#' that of TSLS otherwise. The median widths are provided merely for
#' consistency with other functions for which this quantity is more
#' interesting, namely the simulation-based intervals that try to correct some
#' of the deficiencies of the naive interval.
#' @examples
#' foo <- OLSvsIV_nonsimCI(tau = 3, pi_sq = 0.1)
#' as.data.frame(foo)
OLSvsIV_nonsimCI <- function(tau, pi_sq, size = 0.05, n_sim = 50000L) {
    .Call('fmscr_OLSvsIV_nonsimCI', PACKAGE = 'fmscr', tau, pi_sq, size, n_sim)
}

#' Testing interface to second_step_OLS_IV class.
#'
#' @param tau Controls degree of endogeneity of OLS.
#' @param pi_sq First-stage R-squared (strengh of instruments).
#' @param size One minus the norminal coverage probability of the intervals.
#' @param inc Step size for grid over which width is minimized.
#' @param n_sim Number of simulation draws.
#' @return List with two elements: simulation-based two-sided confidence
#' interval for the post-FMSC estimator evaluated at tau and the same for the
#' moment average estimator.
#' @details This is a testing interface to the C++ class that is use, among
#' other things, as the second-step in the two-step simulation based confidence
#' interval construction from Section 4.3 of the paper, based on drawing from
#' the limit experiment. In this implementation it treats all population
#' parameters that enter the limit as know with the exception of tau. (That is,
#' it abstracts from sampling uncertainty.)
#' @examples
#' as.data.frame(OLSvsIV_second_step(tau = 3, pi_sq = 0.1))
OLSvsIV_second_step <- function(tau, pi_sq, size = 0.05, inc = 0.005, n_sim = 1000L) {
    .Call('fmscr_OLSvsIV_second_step', PACKAGE = 'fmscr', tau, pi_sq, size, inc, n_sim)
}

OLSvsIV_onestepCI <- function(tau, pi_sq, size = 0.05, inc = 0.005, n_sim_outer = 1000L, n_sim_inner = 1000L) {
    .Call('fmscr_OLSvsIV_onestepCI', PACKAGE = 'fmscr', tau, pi_sq, size, inc, n_sim_outer, n_sim_inner)
}

rcpp_hello <- function() {
    .Call('fmscr_rcpp_hello', PACKAGE = 'fmscr')
}

sim_OLSvsIV <- function(rho, pi_sq, N, n_reps = 1000L) {
    .Call('fmscr_sim_OLSvsIV', PACKAGE = 'fmscr', rho, pi_sq, N, n_reps)
}

sim_chooseIVs <- function(rho, gamma, N, n_reps = 1000L) {
    .Call('fmscr_sim_chooseIVs', PACKAGE = 'fmscr', rho, gamma, N, n_reps)
}