Very simple, not robust, CE calculation

This commit is contained in:
Brian Albert Monroe 2018-07-23 17:20:41 +02:00
parent f13a6492db
commit 7992ae6a11
5 changed files with 104 additions and 5 deletions

View File

@ -1,13 +1,19 @@
Package: rcwelfare
Title: What the Package Does (one line, title case)
Title: Calculate The Certainty Equivalents of a Risk Instrument
Version: 0.0.0.9000
Authors@R: person('Brian Albert', 'Monroe', email = 'brianalbertmonroe@gmail.com', role = c('aut', 'cre'))
Description: What the package does (one paragraph).
Description: Does estimation in reverse.
Depends: R (>= 3.5.1)
License: What license is it under?
License: MIT
Encoding: UTF-8
LazyData: true
maintainer: 'Brian Albert Monroe' <brianalbertmonroe@gmail.com>
LinkingTo: Rcpp
Imports: Rcpp
LinkingTo:
Rcpp,
RcppArmadillo,
rcguts,
rcmle
Imports:
Rcpp,
RcppArmadillo
RoxygenNote: 6.0.1

View File

@ -1,4 +1,5 @@
# Generated by roxygen2: do not edit by hand
export(certeq)
importFrom(Rcpp,sourceCpp)
useDynLib(rcwelfare)

68
R/main.R Normal file
View File

@ -0,0 +1,68 @@
#' @title Return Certainty Equivalents
#'
#' @description
#' This function calculates the certainty equivalents given an instrument and an estimation object from rcmle
#' @param est the estimation object from rcmle
#' @param inst the instrument that the certainty equivalents are being generated for
#' @param boot if numeric, bootstrap the certainty equivalents using the vcov matrix in est and "boot" number of draws
#' @examples
#'
#' @export certeq
certeq <- function(est, inst, layout = "AB", boot = F) {
estimates <- est$estimates
covar <- est$vcov
trans <- est$trans_pari$transforms
inst <- rcguts::reginst(inst, layout = layout)
if (is.numeric(boot)) {
pmat <- MASS::mvrnorm(n = boot, mu = est$estimates, Sigma = est$vcov)
for (tp in 1:length(trans)) {
if (trans[tp] == 1) {
pmat[, tp] <- exp(pmat[, tp])
}
}
} else {
pmat <- as.numeric(est$parsed[, 1])
pmat <- matrix(pmat, nrow = 1)
}
CE <- lapply(1:nrow(pmat), function(pmi) {
pmrow <- matrix(pmat[pmi, ], nrow = 1)
CE <- lapply(1:length(inst$outcomes), function(oind) {
uu <- rcguts::sutility(inst$outcomes[[oind]], pars = pmrow, ufun = est$ftypes$ufun)
pp <- inst$probabilities[[oind]]
if (est$ftypes$pfun == "pre") {
pars <- pmat[1, 2:3]
pp <- t(apply(pp, 1, function(prow) {
rcguts::spweight(prow, pars = pars, pfun = "pre")
}))
}
UU <- rowSums(uu * pp)
if (est$ftypes$ufun == "crra") {
CE <- (UU * (1 - pmrow[1]))^(1 / (1 - pmrow[1]))
} else if(est$ftypes$ufun == "pow") {
CE <- UU ^ (1 / pmrow[1])
}
CE
})
CE <- do.call(cbind, CE)
CE
})
CE <- Reduce("+", CE) / length(CE)
chosen <- cbind(1:length(inst$choice), inst$choice + 1)
chosen <- CE[chosen]
unchosen <- cbind(1:length(inst$choice), ifelse(inst$choice == 0, 2, 1))
unchosen <- CE[unchosen]
maxCE <- apply(CE, 1, max)
minCE <- apply(CE, 1, min)
data.frame(chosen = chosen, unchosen = unchosen, maxCE = maxCE, minCE = minCE, choice = inst$choice)
}

21
man/certeq.Rd Normal file
View File

@ -0,0 +1,21 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/main.R
\name{certeq}
\alias{certeq}
\title{Return Certainty Equivalents}
\usage{
certeq(est, inst, layout = "AB", boot = F)
}
\arguments{
\item{est}{the estimation object from rcmle}
\item{inst}{the instrument that the certainty equivalents are being generated for}
\item{boot}{if numeric, bootstrap the certainty equivalents using the vcov matrix in est and "boot" number of draws}
}
\description{
This function calculates the certainty equivalents given an instrument and an estimation object from rcmle
}
\examples{
}

3
src/main.cpp Normal file
View File

@ -0,0 +1,3 @@
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp;