R/RcppExports.R

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

#' C++ module for computation of V = max_s U + b*EV(s)
#'
#' computes value functions for \code{m} discrete labor supply choices. no time separability assumed, i.e. labor supply is not implied by current resources. computes V on \code{n} states. 
#' The current implementation computes the following functional form for the utility function:
#' \deqn{\begin{array}{ll}
#' u(c,l_j,h) &= \frac{\left(c \exp( \alpha l_j ) \right)^{1-\gamma}}{1-\gamma} \exp( \theta \phi(h) ) + \mu \phi(h) \\
#' \phi(h) &= \left\{
#' 	\begin{array}{ll}
#' 	0                       &   h=0 \\
#' 	\mbox{phival} \in (0,1) &   h=1 \\
#' 	1                       &   h=2 
#' 	\end{array}
#' 	\right. \\
#' \mbox{params} &= \left( \gamma, \alpha, \theta, \mbox{phival}, \mu \right)\\
#'  & \hspace{1em}j = 1,2,\dots,m \\
#'  & \hspace{1em}l_1 = 0, l_m=1, l_j < l_{j+1} 
#' \end{array}}{ u(c,l,h) = (c * exp(alpha * l) )^1-gamma / (1-gamma) * exp( theta * phi(h) ) + mu * phi(h), phi(h) = 0 if h=0, phi(h) = phival if h=1, phi(h) = 1 if h=2 }
#'
#' @param cashR numeric matrix \code{(n,m)} of cash holdings conditional on labor supply (that's why \code{m} columns)
#' @param saveR numeric matrix \code{(n,k)} of savings options. k < n.
#' @param EVR numeric matrix \code{(n,k)} representing expected future value at each state,choice combination
#' @param hsizeR vector \code{(n,1)}
#' @param laborR vector \code{(m,1)}, basically \code{seq(from=0,to=1,length=m)}
#' @param theta elasticity of substitution between c and h
#' @param phival value of relative utility difference flat vs house
#' @param mu weight on additive utility premium
#' @param gamma coefficient of relative risk aversion
#' @param cutoff minimum level of consumption. below cutoff, u(c) is quadratically approximated.
#' @param alpha coefficient on labor
#' @param myNA numerical value to be assigned to values with negative consumption (if quad == FALSE)
#' @param tau numerical value of proportional consumption scaling. a value in [0,infty). used in welfare experiments
#' @return list with elements
#' \item{values}{\code{(n,m)} matrix of conditional value functions. column i is V_i.}
#' \item{saving}{\code{(n,m)} matrix of conditional savings functions. column i is save_i.}
#' \item{cons}{\code{(n,m)} matrix of conditional value functions. column i is cons_i.}
#' \item{dchoiceL}{\code{(n,1)} vector indexing discrete choice at each state.}
#' \item{maxL}{\code{(n,1)} vector of maximal value. maxL = max_d V_d.}
#' @author Florian Oswald <florian.oswald@@gmail.com>
#' @examples
#' n = 25000    # number of states
#' k = 50       # number of savings choices by state
#' m = 3    # number of discrete labor choices by state
#' cash   <- matrix(1:n,n,m)
#' cash   <- cash + matrix(0:2,n,m,byrow=TRUE)
#' labo   <- seq(from=0,to=1,length=m)
#' saving <- matrix(seq(from=0,to=8,length=k),n,k,byrow=TRUE)
#' EV     <- log(outer(1:n,1:k))
#' hsize  <- sample(0:2,size=n,replace=TRUE)
#' pars   <- list(theta=0.2,phival=0.9,mu=0.6,gamma=1.4,cutoff=0.1,alpha=-0.6,myNA=-1e9,tau=1)
#' res <- util_module(cashR=cash, saveR=saving, EVR=EV, hsizeR=hsize, laborR=labo, par=pars)
util_module <- function(cashR, saveR, EVR, hsizeR, laborR, par) {
    .Call('umod_util_module', PACKAGE = 'umod', cashR, saveR, EVR, hsizeR, laborR, par)
}

#' C++ module for computation of V = U + b*EV(0)
#'
#' computes value functions for \code{m} discrete labor supply choices when there is no savings choice.
#' The current implementation computes the following functional form for the utility function:
#' \deqn{\begin{array}{ll}
#' u(c,l_j,h) &= \frac{\left(c \exp( \alpha l_j ) \right)^{1-\gamma}}{1-\gamma} \exp( \theta \phi(h) ) + \mu \phi(h) \\
#' \phi(h) &= \left\{
#' 	\begin{array}{ll}
#' 	0                       &   h=0 \\
#' 	\mbox{phival} \in (0,1) &   h=1 \\
#' 	1                       &   h=2 
#' 	\end{array}
#' 	\right. \\
#' \mbox{params} &= \left( \gamma, \alpha, \theta, \mbox{phival}, \mu \right)\\
#'  & \hspace{1em}j = 1,2,\dots,m \\
#'  & \hspace{1em}l_1 = 0, l_m=1, l_j < l_{j+1} 
#' \end{array}}{ u(c,l,h) = (c * exp(alpha * l) )^1-gamma / (1-gamma) * exp( theta * phi(h) ) + mu * phi(h), phi(h) = 0 if h=0, phi(h) = phival if h=1, phi(h) = 1 if h=2 }
#'
#' @param cashR numeric matrix \code{(n,m)} of cash holdings conditional on labor supply (that's why \code{m} columns)
#' @param EVR numeric matrix \code{(n,1)} representing expected future value at tomorrow's assets = 0
#' @param hsizeR vector \code{(n,1)}
#' @param laborR vector \code{(m,1)}, basically \code{seq(from=0,to=1,length=m)}
#' @param theta elasticity of substitution between c and h
#' @param phival value of relative utility difference flat vs house
#' @param mu weight on additive utility premium
#' @param gamma coefficient of relative risk aversion
#' @param cutoff minimum level of consumption. below cutoff, u(c) is quadratically approximated.
#' @param alpha coefficient on labor
#' @param quad boolean of whether neg cons quadratically approximated or not
#' @param borrconst boolean of whether there are borrowing constraints built into the savings matrix
#' @param myNA numerical value to be assigned to values with negative consumption (if quad == FALSE)
#' @param tau numerical value of proportional consumption scaling. a value in [0,infty). used in welfare experiments
#' @return list with elements
#' \item{values}{\code{(n,m)} matrix of conditional value functions. column i is V_i.}
#' \item{dchoiceL}{\code{(n,1)} vector indexing discrete choice at each state.}
#' \item{maxL}{\code{(n,1)} vector of maximal value. maxL = max_d V_d.}
#' @author Florian Oswald <florian.oswald@@gmail.com>
#' @examples
#' n = 5    # number of states
#' m = 3    # number of discrete labor choices by state
#' cash   <- matrix(1:n,n,m)
#' cash   <- cash + matrix(0:2,n,m,byrow=TRUE)
#' labo   <- seq(from=0,to=1,length=m)
#' EV     <- log(1:n)
#' hsize  <- sample(0:2,size=n,replace=TRUE)
#' pars   <- list(theta=0.2,phival=0.9,mu=0.6,gamma=1.4,cutoff=0.1,alpha=-0.6,quad=FALSE,borrconst=FALSE,myNA=-1e9,tau=1)
#' res <- util_module_file(cashR=cash, EVR=EV, hsizeR=hsize, laborR=labo, par=pars)
util_module_file <- function(cashR, EVR, hsizeR, laborR, par) {
    .Call('umod_util_module_file', PACKAGE = 'umod', cashR, EVR, hsizeR, laborR, par)
}

#' Utility Function from Attanasio et al
#'
#' computes utility over consumption and housing 
#' @param Res resources aka consumption
#' @param s vector of house sizes
#' @param par list of parameters
#' @examples
#' n = 5    # number of states
#' m = 7    # number of savings choices
#' cash   <- matrix(1:(n*m),n,m)
#' hsize  <- sample(0:2,size=n,replace=TRUE)
#' pars   <- list(theta=0.2,phival=0.9,mu=0.6,gamma=1.4,cutoff=0.1,alpha=-0.6)
#' res <- ufun_Attanasio(ResR=cash, sR=hsize, par=pars)
ufun_Attanasio <- function(ResR, sR, par) {
    .Call('umod_ufun_Attanasio', PACKAGE = 'umod', ResR, sR, par)
}

#' Segfault Test Function boom
#'
#' test function produces a C++ segfault. Calls function baz which
#' allocates a wrong pointer. If you compiled this code with 
#' \code{CXXFLAGS=-g3 -rdynamic} the installed function \code{handler}
#' will print a traceback of the stack that contains the name of the offending function.
#' Without this compiler flag, you miss the function name.
#' you should place a call to \code{signal(SIGSEGV, handler);} at the beginning of each
#' function you want to check for segfaults.
#' @return R will crash with a segfault but you will see a traceback. ONLY run in console.
boom <- function() {
    invisible(.Call('umod_boom', PACKAGE = 'umod'))
}
floswald/umod documentation built on May 16, 2019, 1:24 p.m.