refactor: Small refactor to use "profiles" rather than old-reginst

Basically pass in a raw DataFrame and parse column numbers rather than
an inst that is pre-set as a List
This commit is contained in:
Brian Albert Monroe 2020-01-27 19:06:49 +02:00
parent c0470b3fc7
commit 250a49c430
Signed by: bam
GPG Key ID: ACB52939BF87F222
13 changed files with 164 additions and 230 deletions

1
.gitignore vendored
View File

@ -3,3 +3,4 @@
.RData
tags
*.log
src/.ccls

View File

@ -1,6 +1,6 @@
Package: rcguts
Title: Backend Functions for R Choice Packages
Version: 0.15.0
Version: 0.16.0
Authors@R: person('Brian Albert', 'Monroe', email = 'brianalbertmonroe@gmail.com', role = c('aut', 'cre'))
Description: This package provides some backend functions that are shared by the R Choice family of pacakes. In particular, likelihood functions written in c++.
Depends: R (>= 3.4.1)

View File

@ -2,7 +2,6 @@
export(calc_likelihood)
export(calc_utility)
export(list2_cube)
export(mlgeneral)
export(set_uparsers)
export(slike)

View File

@ -11,13 +11,6 @@ vpow <- function(base, exp) {
.Call('_rcguts_vpow', PACKAGE = 'rcguts', base, exp)
}
#' Turn list to cube object
#'
#' @export list2_cube
list2_cube <- function(Inst, out_prob) {
.Call('_rcguts_list2_cube', PACKAGE = 'rcguts', Inst, out_prob)
}
gslikelihood <- function(dfun, Utilities) {
.Call('_rcguts_gslikelihood', PACKAGE = 'rcguts', dfun, Utilities)
}
@ -25,34 +18,35 @@ gslikelihood <- function(dfun, Utilities) {
#' Generic Utility calculation
#'
#' @param pmat the parameter vector
#' @param Inst the insrument as a list of its components
#' @param fun_types List of the utility, probability weighting, and stochstic function types
#' @param par_index fun_types List of giving the index in the par vector of the parameters for each fun_type
#' @param inst the insrument as a list of its components
#' @param profile the profile of the instrument
#' @param ftypes List of the utility, probability weighting, and stochstic function types
#' @param ft_index ftypes List of giving the index in the par vector of the parameters for each fun_type
#' @export calc_utility
calc_utility <- function(pmat, Inst, fun_types, par_index) {
.Call('_rcguts_calc_utility', PACKAGE = 'rcguts', pmat, Inst, fun_types, par_index)
calc_utility <- function(pmat, inst, profile, ftypes, ft_index) {
.Call('_rcguts_calc_utility', PACKAGE = 'rcguts', pmat, inst, profile, ftypes, ft_index)
}
#' Generic Likelihood calculation
#'
#' @param pmat the parameter vector
#' @param Inst the insrument as a list of its components
#' @param fun_types List of the utility, probability weighting, and stochstic function types
#' @param par_index fun_types List of giving the index in the par vector of the parameters for each fun_type
#' @param inst the insrument as a list of its components
#' @param ftypes List of the utility, probability weighting, and stochstic function types
#' @param ft_index ftypes List of giving the index in the par vector of the parameters for each fun_type
#' @export calc_likelihood
calc_likelihood <- function(pmat, Inst, fun_types, par_index) {
.Call('_rcguts_calc_likelihood', PACKAGE = 'rcguts', pmat, Inst, fun_types, par_index)
calc_likelihood <- function(pmat, inst, profile, ftypes, ft_index) {
.Call('_rcguts_calc_likelihood', PACKAGE = 'rcguts', pmat, inst, profile, ftypes, ft_index)
}
#' Return a likelihood vector for choices
#'
#' @param par the parameter vector
#' @param Inst the insrument as a list of its components
#' @param fun_types List of the utility, probability weighting, and stochstic function types
#' @param par_index fun_types List of giving the index in the par vector of the parameters for each fun_type
#' @param inst the insrument as a list of its components
#' @param ftypes List of the utility, probability weighting, and stochstic function types
#' @param ft_index ftypes List of giving the index in the par vector of the parameters for each fun_type
#' @export mlgeneral
mlgeneral <- function(pmat, inst, fun_types, par_index) {
.Call('_rcguts_mlgeneral', PACKAGE = 'rcguts', pmat, inst, fun_types, par_index)
mlgeneral <- function(pmat, inst, profile, ftypes, ft_index) {
.Call('_rcguts_mlgeneral', PACKAGE = 'rcguts', pmat, inst, profile, ftypes, ft_index)
}
gsutility <- function(pars, ufun, outcomes) {

View File

@ -46,27 +46,6 @@ namespace rcguts {
return Rcpp::as<arma::mat >(rcpp_result_gen);
}
inline arma::cube list2_cube(List Inst, int out_prob) {
typedef SEXP(*Ptr_list2_cube)(SEXP,SEXP);
static Ptr_list2_cube p_list2_cube = NULL;
if (p_list2_cube == NULL) {
validateSignature("arma::cube(*list2_cube)(List,int)");
p_list2_cube = (Ptr_list2_cube)R_GetCCallable("rcguts", "_rcguts_list2_cube");
}
RObject rcpp_result_gen;
{
RNGScope RCPP_rngScope_gen;
rcpp_result_gen = p_list2_cube(Shield<SEXP>(Rcpp::wrap(Inst)), Shield<SEXP>(Rcpp::wrap(out_prob)));
}
if (rcpp_result_gen.inherits("interrupted-error"))
throw Rcpp::internal::InterruptedException();
if (Rcpp::internal::isLongjumpSentinel(rcpp_result_gen))
throw Rcpp::LongjumpException(rcpp_result_gen);
if (rcpp_result_gen.inherits("try-error"))
throw Rcpp::exception(Rcpp::as<std::string>(rcpp_result_gen).c_str());
return Rcpp::as<arma::cube >(rcpp_result_gen);
}
inline arma::vec gslikelihood(std::string dfun, arma::vec Utilities) {
typedef SEXP(*Ptr_gslikelihood)(SEXP,SEXP);
static Ptr_gslikelihood p_gslikelihood = NULL;
@ -88,17 +67,17 @@ namespace rcguts {
return Rcpp::as<arma::vec >(rcpp_result_gen);
}
inline arma::mat calc_utility(arma::mat pmat, List Inst, List fun_types, List par_index) {
typedef SEXP(*Ptr_calc_utility)(SEXP,SEXP,SEXP,SEXP);
inline arma::mat calc_utility(arma::mat pmat, DataFrame inst, List profile, List ftypes, List ft_index) {
typedef SEXP(*Ptr_calc_utility)(SEXP,SEXP,SEXP,SEXP,SEXP);
static Ptr_calc_utility p_calc_utility = NULL;
if (p_calc_utility == NULL) {
validateSignature("arma::mat(*calc_utility)(arma::mat,List,List,List)");
validateSignature("arma::mat(*calc_utility)(arma::mat,DataFrame,List,List,List)");
p_calc_utility = (Ptr_calc_utility)R_GetCCallable("rcguts", "_rcguts_calc_utility");
}
RObject rcpp_result_gen;
{
RNGScope RCPP_rngScope_gen;
rcpp_result_gen = p_calc_utility(Shield<SEXP>(Rcpp::wrap(pmat)), Shield<SEXP>(Rcpp::wrap(Inst)), Shield<SEXP>(Rcpp::wrap(fun_types)), Shield<SEXP>(Rcpp::wrap(par_index)));
rcpp_result_gen = p_calc_utility(Shield<SEXP>(Rcpp::wrap(pmat)), Shield<SEXP>(Rcpp::wrap(inst)), Shield<SEXP>(Rcpp::wrap(profile)), Shield<SEXP>(Rcpp::wrap(ftypes)), Shield<SEXP>(Rcpp::wrap(ft_index)));
}
if (rcpp_result_gen.inherits("interrupted-error"))
throw Rcpp::internal::InterruptedException();
@ -109,17 +88,17 @@ namespace rcguts {
return Rcpp::as<arma::mat >(rcpp_result_gen);
}
inline arma::mat calc_likelihood(arma::mat pmat, List Inst, List fun_types, List par_index) {
typedef SEXP(*Ptr_calc_likelihood)(SEXP,SEXP,SEXP,SEXP);
inline arma::mat calc_likelihood(arma::mat pmat, DataFrame inst, List profile, List ftypes, List ft_index) {
typedef SEXP(*Ptr_calc_likelihood)(SEXP,SEXP,SEXP,SEXP,SEXP);
static Ptr_calc_likelihood p_calc_likelihood = NULL;
if (p_calc_likelihood == NULL) {
validateSignature("arma::mat(*calc_likelihood)(arma::mat,List,List,List)");
validateSignature("arma::mat(*calc_likelihood)(arma::mat,DataFrame,List,List,List)");
p_calc_likelihood = (Ptr_calc_likelihood)R_GetCCallable("rcguts", "_rcguts_calc_likelihood");
}
RObject rcpp_result_gen;
{
RNGScope RCPP_rngScope_gen;
rcpp_result_gen = p_calc_likelihood(Shield<SEXP>(Rcpp::wrap(pmat)), Shield<SEXP>(Rcpp::wrap(Inst)), Shield<SEXP>(Rcpp::wrap(fun_types)), Shield<SEXP>(Rcpp::wrap(par_index)));
rcpp_result_gen = p_calc_likelihood(Shield<SEXP>(Rcpp::wrap(pmat)), Shield<SEXP>(Rcpp::wrap(inst)), Shield<SEXP>(Rcpp::wrap(profile)), Shield<SEXP>(Rcpp::wrap(ftypes)), Shield<SEXP>(Rcpp::wrap(ft_index)));
}
if (rcpp_result_gen.inherits("interrupted-error"))
throw Rcpp::internal::InterruptedException();
@ -130,17 +109,17 @@ namespace rcguts {
return Rcpp::as<arma::mat >(rcpp_result_gen);
}
inline arma::vec mlgeneral(arma::mat pmat, List inst, List fun_types, List par_index) {
typedef SEXP(*Ptr_mlgeneral)(SEXP,SEXP,SEXP,SEXP);
inline arma::vec mlgeneral(arma::mat pmat, DataFrame inst, List profile, List ftypes, List ft_index) {
typedef SEXP(*Ptr_mlgeneral)(SEXP,SEXP,SEXP,SEXP,SEXP);
static Ptr_mlgeneral p_mlgeneral = NULL;
if (p_mlgeneral == NULL) {
validateSignature("arma::vec(*mlgeneral)(arma::mat,List,List,List)");
validateSignature("arma::vec(*mlgeneral)(arma::mat,DataFrame,List,List,List)");
p_mlgeneral = (Ptr_mlgeneral)R_GetCCallable("rcguts", "_rcguts_mlgeneral");
}
RObject rcpp_result_gen;
{
RNGScope RCPP_rngScope_gen;
rcpp_result_gen = p_mlgeneral(Shield<SEXP>(Rcpp::wrap(pmat)), Shield<SEXP>(Rcpp::wrap(inst)), Shield<SEXP>(Rcpp::wrap(fun_types)), Shield<SEXP>(Rcpp::wrap(par_index)));
rcpp_result_gen = p_mlgeneral(Shield<SEXP>(Rcpp::wrap(pmat)), Shield<SEXP>(Rcpp::wrap(inst)), Shield<SEXP>(Rcpp::wrap(profile)), Shield<SEXP>(Rcpp::wrap(ftypes)), Shield<SEXP>(Rcpp::wrap(ft_index)));
}
if (rcpp_result_gen.inherits("interrupted-error"))
throw Rcpp::internal::InterruptedException();

View File

@ -4,16 +4,16 @@
\alias{calc_likelihood}
\title{Generic Likelihood calculation}
\usage{
calc_likelihood(pmat, Inst, fun_types, par_index)
calc_likelihood(pmat, inst, profile, ftypes, ft_index)
}
\arguments{
\item{pmat}{the parameter vector}
\item{Inst}{the insrument as a list of its components}
\item{inst}{the insrument as a list of its components}
\item{fun_types}{List of the utility, probability weighting, and stochstic function types}
\item{ftypes}{List of the utility, probability weighting, and stochstic function types}
\item{par_index}{fun_types List of giving the index in the par vector of the parameters for each fun_type}
\item{ft_index}{ftypes List of giving the index in the par vector of the parameters for each fun_type}
}
\description{
Generic Likelihood calculation

View File

@ -4,16 +4,18 @@
\alias{calc_utility}
\title{Generic Utility calculation}
\usage{
calc_utility(pmat, Inst, fun_types, par_index)
calc_utility(pmat, inst, profile, ftypes, ft_index)
}
\arguments{
\item{pmat}{the parameter vector}
\item{Inst}{the insrument as a list of its components}
\item{inst}{the insrument as a list of its components}
\item{fun_types}{List of the utility, probability weighting, and stochstic function types}
\item{profile}{the profile of the instrument}
\item{par_index}{fun_types List of giving the index in the par vector of the parameters for each fun_type}
\item{ftypes}{List of the utility, probability weighting, and stochstic function types}
\item{ft_index}{ftypes List of giving the index in the par vector of the parameters for each fun_type}
}
\description{
Generic Utility calculation

View File

@ -1,11 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/RcppExports.R
\name{list2_cube}
\alias{list2_cube}
\title{Turn list to cube object}
\usage{
list2_cube(Inst, out_prob)
}
\description{
Turn list to cube object
}

View File

@ -4,16 +4,16 @@
\alias{mlgeneral}
\title{Return a likelihood vector for choices}
\usage{
mlgeneral(pmat, inst, fun_types, par_index)
mlgeneral(pmat, inst, profile, ftypes, ft_index)
}
\arguments{
\item{fun_types}{List of the utility, probability weighting, and stochstic function types}
\item{inst}{the insrument as a list of its components}
\item{par_index}{fun_types List of giving the index in the par vector of the parameters for each fun_type}
\item{ftypes}{List of the utility, probability weighting, and stochstic function types}
\item{ft_index}{ftypes List of giving the index in the par vector of the parameters for each fun_type}
\item{par}{the parameter vector}
\item{Inst}{the insrument as a list of its components}
}
\description{
Return a likelihood vector for choices

View File

@ -44,41 +44,6 @@ RcppExport SEXP _rcguts_vpow(SEXP baseSEXP, SEXP expSEXP) {
UNPROTECT(1);
return rcpp_result_gen;
}
// list2_cube
arma::cube list2_cube(List Inst, int out_prob);
static SEXP _rcguts_list2_cube_try(SEXP InstSEXP, SEXP out_probSEXP) {
BEGIN_RCPP
Rcpp::RObject rcpp_result_gen;
Rcpp::traits::input_parameter< List >::type Inst(InstSEXP);
Rcpp::traits::input_parameter< int >::type out_prob(out_probSEXP);
rcpp_result_gen = Rcpp::wrap(list2_cube(Inst, out_prob));
return rcpp_result_gen;
END_RCPP_RETURN_ERROR
}
RcppExport SEXP _rcguts_list2_cube(SEXP InstSEXP, SEXP out_probSEXP) {
SEXP rcpp_result_gen;
{
Rcpp::RNGScope rcpp_rngScope_gen;
rcpp_result_gen = PROTECT(_rcguts_list2_cube_try(InstSEXP, out_probSEXP));
}
Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
if (rcpp_isInterrupt_gen) {
UNPROTECT(1);
Rf_onintr();
}
bool rcpp_isLongjump_gen = Rcpp::internal::isLongjumpSentinel(rcpp_result_gen);
if (rcpp_isLongjump_gen) {
Rcpp::internal::resumeJump(rcpp_result_gen);
}
Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error");
if (rcpp_isError_gen) {
SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen);
UNPROTECT(1);
Rf_error(CHAR(rcpp_msgSEXP_gen));
}
UNPROTECT(1);
return rcpp_result_gen;
}
// gslikelihood
arma::vec gslikelihood(std::string dfun, arma::vec Utilities);
static SEXP _rcguts_gslikelihood_try(SEXP dfunSEXP, SEXP UtilitiesSEXP) {
@ -115,23 +80,24 @@ RcppExport SEXP _rcguts_gslikelihood(SEXP dfunSEXP, SEXP UtilitiesSEXP) {
return rcpp_result_gen;
}
// calc_utility
arma::mat calc_utility(arma::mat pmat, List Inst, List fun_types, List par_index);
static SEXP _rcguts_calc_utility_try(SEXP pmatSEXP, SEXP InstSEXP, SEXP fun_typesSEXP, SEXP par_indexSEXP) {
arma::mat calc_utility(arma::mat pmat, DataFrame inst, List profile, List ftypes, List ft_index);
static SEXP _rcguts_calc_utility_try(SEXP pmatSEXP, SEXP instSEXP, SEXP profileSEXP, SEXP ftypesSEXP, SEXP ft_indexSEXP) {
BEGIN_RCPP
Rcpp::RObject rcpp_result_gen;
Rcpp::traits::input_parameter< arma::mat >::type pmat(pmatSEXP);
Rcpp::traits::input_parameter< List >::type Inst(InstSEXP);
Rcpp::traits::input_parameter< List >::type fun_types(fun_typesSEXP);
Rcpp::traits::input_parameter< List >::type par_index(par_indexSEXP);
rcpp_result_gen = Rcpp::wrap(calc_utility(pmat, Inst, fun_types, par_index));
Rcpp::traits::input_parameter< DataFrame >::type inst(instSEXP);
Rcpp::traits::input_parameter< List >::type profile(profileSEXP);
Rcpp::traits::input_parameter< List >::type ftypes(ftypesSEXP);
Rcpp::traits::input_parameter< List >::type ft_index(ft_indexSEXP);
rcpp_result_gen = Rcpp::wrap(calc_utility(pmat, inst, profile, ftypes, ft_index));
return rcpp_result_gen;
END_RCPP_RETURN_ERROR
}
RcppExport SEXP _rcguts_calc_utility(SEXP pmatSEXP, SEXP InstSEXP, SEXP fun_typesSEXP, SEXP par_indexSEXP) {
RcppExport SEXP _rcguts_calc_utility(SEXP pmatSEXP, SEXP instSEXP, SEXP profileSEXP, SEXP ftypesSEXP, SEXP ft_indexSEXP) {
SEXP rcpp_result_gen;
{
Rcpp::RNGScope rcpp_rngScope_gen;
rcpp_result_gen = PROTECT(_rcguts_calc_utility_try(pmatSEXP, InstSEXP, fun_typesSEXP, par_indexSEXP));
rcpp_result_gen = PROTECT(_rcguts_calc_utility_try(pmatSEXP, instSEXP, profileSEXP, ftypesSEXP, ft_indexSEXP));
}
Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
if (rcpp_isInterrupt_gen) {
@ -152,23 +118,24 @@ RcppExport SEXP _rcguts_calc_utility(SEXP pmatSEXP, SEXP InstSEXP, SEXP fun_type
return rcpp_result_gen;
}
// calc_likelihood
arma::mat calc_likelihood(arma::mat pmat, List Inst, List fun_types, List par_index);
static SEXP _rcguts_calc_likelihood_try(SEXP pmatSEXP, SEXP InstSEXP, SEXP fun_typesSEXP, SEXP par_indexSEXP) {
arma::mat calc_likelihood(arma::mat pmat, DataFrame inst, List profile, List ftypes, List ft_index);
static SEXP _rcguts_calc_likelihood_try(SEXP pmatSEXP, SEXP instSEXP, SEXP profileSEXP, SEXP ftypesSEXP, SEXP ft_indexSEXP) {
BEGIN_RCPP
Rcpp::RObject rcpp_result_gen;
Rcpp::traits::input_parameter< arma::mat >::type pmat(pmatSEXP);
Rcpp::traits::input_parameter< List >::type Inst(InstSEXP);
Rcpp::traits::input_parameter< List >::type fun_types(fun_typesSEXP);
Rcpp::traits::input_parameter< List >::type par_index(par_indexSEXP);
rcpp_result_gen = Rcpp::wrap(calc_likelihood(pmat, Inst, fun_types, par_index));
Rcpp::traits::input_parameter< DataFrame >::type inst(instSEXP);
Rcpp::traits::input_parameter< List >::type profile(profileSEXP);
Rcpp::traits::input_parameter< List >::type ftypes(ftypesSEXP);
Rcpp::traits::input_parameter< List >::type ft_index(ft_indexSEXP);
rcpp_result_gen = Rcpp::wrap(calc_likelihood(pmat, inst, profile, ftypes, ft_index));
return rcpp_result_gen;
END_RCPP_RETURN_ERROR
}
RcppExport SEXP _rcguts_calc_likelihood(SEXP pmatSEXP, SEXP InstSEXP, SEXP fun_typesSEXP, SEXP par_indexSEXP) {
RcppExport SEXP _rcguts_calc_likelihood(SEXP pmatSEXP, SEXP instSEXP, SEXP profileSEXP, SEXP ftypesSEXP, SEXP ft_indexSEXP) {
SEXP rcpp_result_gen;
{
Rcpp::RNGScope rcpp_rngScope_gen;
rcpp_result_gen = PROTECT(_rcguts_calc_likelihood_try(pmatSEXP, InstSEXP, fun_typesSEXP, par_indexSEXP));
rcpp_result_gen = PROTECT(_rcguts_calc_likelihood_try(pmatSEXP, instSEXP, profileSEXP, ftypesSEXP, ft_indexSEXP));
}
Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
if (rcpp_isInterrupt_gen) {
@ -189,23 +156,24 @@ RcppExport SEXP _rcguts_calc_likelihood(SEXP pmatSEXP, SEXP InstSEXP, SEXP fun_t
return rcpp_result_gen;
}
// mlgeneral
arma::vec mlgeneral(arma::mat pmat, List inst, List fun_types, List par_index);
static SEXP _rcguts_mlgeneral_try(SEXP pmatSEXP, SEXP instSEXP, SEXP fun_typesSEXP, SEXP par_indexSEXP) {
arma::vec mlgeneral(arma::mat pmat, DataFrame inst, List profile, List ftypes, List ft_index);
static SEXP _rcguts_mlgeneral_try(SEXP pmatSEXP, SEXP instSEXP, SEXP profileSEXP, SEXP ftypesSEXP, SEXP ft_indexSEXP) {
BEGIN_RCPP
Rcpp::RObject rcpp_result_gen;
Rcpp::traits::input_parameter< arma::mat >::type pmat(pmatSEXP);
Rcpp::traits::input_parameter< List >::type inst(instSEXP);
Rcpp::traits::input_parameter< List >::type fun_types(fun_typesSEXP);
Rcpp::traits::input_parameter< List >::type par_index(par_indexSEXP);
rcpp_result_gen = Rcpp::wrap(mlgeneral(pmat, inst, fun_types, par_index));
Rcpp::traits::input_parameter< DataFrame >::type inst(instSEXP);
Rcpp::traits::input_parameter< List >::type profile(profileSEXP);
Rcpp::traits::input_parameter< List >::type ftypes(ftypesSEXP);
Rcpp::traits::input_parameter< List >::type ft_index(ft_indexSEXP);
rcpp_result_gen = Rcpp::wrap(mlgeneral(pmat, inst, profile, ftypes, ft_index));
return rcpp_result_gen;
END_RCPP_RETURN_ERROR
}
RcppExport SEXP _rcguts_mlgeneral(SEXP pmatSEXP, SEXP instSEXP, SEXP fun_typesSEXP, SEXP par_indexSEXP) {
RcppExport SEXP _rcguts_mlgeneral(SEXP pmatSEXP, SEXP instSEXP, SEXP profileSEXP, SEXP ftypesSEXP, SEXP ft_indexSEXP) {
SEXP rcpp_result_gen;
{
Rcpp::RNGScope rcpp_rngScope_gen;
rcpp_result_gen = PROTECT(_rcguts_mlgeneral_try(pmatSEXP, instSEXP, fun_typesSEXP, par_indexSEXP));
rcpp_result_gen = PROTECT(_rcguts_mlgeneral_try(pmatSEXP, instSEXP, profileSEXP, ftypesSEXP, ft_indexSEXP));
}
Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
if (rcpp_isInterrupt_gen) {
@ -376,11 +344,10 @@ static int _rcguts_RcppExport_validate(const char* sig) {
static std::set<std::string> signatures;
if (signatures.empty()) {
signatures.insert("arma::mat(*vpow)(const arma::vec,const arma::vec)");
signatures.insert("arma::cube(*list2_cube)(List,int)");
signatures.insert("arma::vec(*gslikelihood)(std::string,arma::vec)");
signatures.insert("arma::mat(*calc_utility)(arma::mat,List,List,List)");
signatures.insert("arma::mat(*calc_likelihood)(arma::mat,List,List,List)");
signatures.insert("arma::vec(*mlgeneral)(arma::mat,List,List,List)");
signatures.insert("arma::mat(*calc_utility)(arma::mat,DataFrame,List,List,List)");
signatures.insert("arma::mat(*calc_likelihood)(arma::mat,DataFrame,List,List,List)");
signatures.insert("arma::vec(*mlgeneral)(arma::mat,DataFrame,List,List,List)");
signatures.insert("arma::vec(*gsutility)(arma::vec,std::string,arma::vec)");
signatures.insert("arma::vec(*gsdiscount)(arma::vec,std::string,arma::vec)");
signatures.insert("arma::vec(*gsstochastic)(arma::vec,std::string,arma::vec,arma::vec)");
@ -392,7 +359,6 @@ static int _rcguts_RcppExport_validate(const char* sig) {
// registerCCallable (register entry points for exported C++ functions)
RcppExport SEXP _rcguts_RcppExport_registerCCallable() {
R_RegisterCCallable("rcguts", "_rcguts_vpow", (DL_FUNC)_rcguts_vpow_try);
R_RegisterCCallable("rcguts", "_rcguts_list2_cube", (DL_FUNC)_rcguts_list2_cube_try);
R_RegisterCCallable("rcguts", "_rcguts_gslikelihood", (DL_FUNC)_rcguts_gslikelihood_try);
R_RegisterCCallable("rcguts", "_rcguts_calc_utility", (DL_FUNC)_rcguts_calc_utility_try);
R_RegisterCCallable("rcguts", "_rcguts_calc_likelihood", (DL_FUNC)_rcguts_calc_likelihood_try);
@ -407,11 +373,10 @@ RcppExport SEXP _rcguts_RcppExport_registerCCallable() {
static const R_CallMethodDef CallEntries[] = {
{"_rcguts_vpow", (DL_FUNC) &_rcguts_vpow, 2},
{"_rcguts_list2_cube", (DL_FUNC) &_rcguts_list2_cube, 2},
{"_rcguts_gslikelihood", (DL_FUNC) &_rcguts_gslikelihood, 2},
{"_rcguts_calc_utility", (DL_FUNC) &_rcguts_calc_utility, 4},
{"_rcguts_calc_likelihood", (DL_FUNC) &_rcguts_calc_likelihood, 4},
{"_rcguts_mlgeneral", (DL_FUNC) &_rcguts_mlgeneral, 4},
{"_rcguts_calc_utility", (DL_FUNC) &_rcguts_calc_utility, 5},
{"_rcguts_calc_likelihood", (DL_FUNC) &_rcguts_calc_likelihood, 5},
{"_rcguts_mlgeneral", (DL_FUNC) &_rcguts_mlgeneral, 5},
{"_rcguts_gsutility", (DL_FUNC) &_rcguts_gsutility, 3},
{"_rcguts_gsdiscount", (DL_FUNC) &_rcguts_gsdiscount, 3},
{"_rcguts_gsstochastic", (DL_FUNC) &_rcguts_gsstochastic, 4},

View File

@ -19,42 +19,33 @@ arma::mat vpow(const arma::vec base, const arma::vec exp) {
return out;
}
//' Turn list to cube object
//'
//' @export list2_cube
// [[Rcpp::export]]
arma::cube list2_cube(List Inst, int out_prob) {
// out_prob 0 is outcomes, 1 is probs
List outcomes_list = Inst["outcomes"];
List probabilities_list = Inst["probabilities"];
List times_list = Inst["times"];
arma::cube inst_cube(DataFrame inst, List profile, std::string prof_val) {
// Get the list for this profile value
List val_prof = profile[prof_val];
// The number of options
arma::uword nopt = val_prof.length();
// First outcome to determine dimensions for cube
arma::vec prof_element = val_prof[0];
// The number of columns for each option is the number of elements in this profile
arma::uword ncol = prof_element.n_elem;
// The number of rows for each option is the number of rows in the inst
arma::uword nrow = inst.nrows();
// The number of outcomes - MUST BE THE SAME AS PROBABILITIES AND TIMES
int noutcomes = outcomes_list.length();
// Cube for this prof_val
arma::cube out_cube(nrow, ncol, nopt);
// Matrix for each slice
arma::mat out_mat(nrow, ncol);
// First outcome
arma::mat first = outcomes_list[0];
int nrow = first.n_rows;
int ncol = first.n_cols;
// Outcomes cube
arma::cube outcomes(nrow, ncol, noutcomes);
arma::cube probabilities(nrow, ncol, noutcomes);
arma::cube times(nrow, ncol, noutcomes);
for (int s = 0 ; s < noutcomes ; s++) {
outcomes.slice(s) = Rcpp::as<arma::mat>(outcomes_list[s]);
probabilities.slice(s) = Rcpp::as<arma::mat>(probabilities_list[s]);
times.slice(s) = Rcpp::as<arma::mat>(times_list[s]);
}
if (out_prob == 0) {
return(outcomes);
}
else if (out_prob == 1) {
return(probabilities);
}
else {
return(times);
for (arma::uword s = 0 ; s < nopt ; s++) {
// R indexes from 1, C++ from 0, so subtract 1 from the profile index
prof_element = Rcpp::as<arma::colvec>(val_prof[s]) - 1;
// Loop through the prof_element and add the corresponding column from
// inst to the matrix for this option's value
for (arma::uword i = 0; i < ncol; i ++) {
out_mat.col(i) = Rcpp::as<arma::colvec>(inst[prof_element[i]]);
}
// Add in the matrix to this slice
out_cube.slice(s) = out_mat;
}
return(out_cube);
}

View File

@ -4,22 +4,29 @@
#include "main.hpp"
using namespace Rcpp;
//' Generic Utility calculation
//'
//' @param pmat the parameter vector
//' @param Inst the insrument as a list of its components
//' @param fun_types List of the utility, probability weighting, and stochstic function types
//' @param par_index fun_types List of giving the index in the par vector of the parameters for each fun_type
//' @param inst the insrument as a list of its components
//' @param profile the profile of the instrument
//' @param ftypes List of the utility, probability weighting, and stochstic function types
//' @param ft_index ftypes List of giving the index in the par vector of the parameters for each fun_type
//' @export calc_utility
// [[Rcpp::export]]
arma::mat calc_utility(arma::mat pmat, List Inst, List fun_types, List par_index) {
arma::mat calc_utility(arma::mat pmat, DataFrame inst, List profile, List ftypes, List ft_index) {
// First put everything into cubes
arma::cube outcomes = list2_cube(Inst, 0);
arma::cube probs = list2_cube(Inst, 1);
arma::cube times = list2_cube(Inst, 2);
arma::mat Max_Min = Inst["Max_Min"];
arma::cube outcomes = inst_cube(inst, profile, "outcomes");
arma::cube probs = inst_cube(inst, profile, "probabilities");
arma::cube times = inst_cube(inst, profile, "times");
// Max and Min outcomes get a matrix
arma::uword maxi = profile["Max"];
arma::uword mini = profile["Min"];
arma::mat Max_Min(inst.rows(), 2);
Max_Min.col(1) = Rcpp::as<arma::colvec>(inst[maxi]);
Max_Min.col(2) = Rcpp::as<arma::colvec>(inst[mini]);
// To reconstruct the pointers we need some more info
int nslice = outcomes.n_slices;
@ -43,17 +50,17 @@ arma::mat calc_utility(arma::mat pmat, List Inst, List fun_types, List par_index
double *likemat_mem = likemat.memptr();
// Get the function types
std::string ufun = fun_types["ufun"];
std::string pfun = fun_types["pfun"];
std::string tfun = fun_types["tfun"];
std::string sfun = fun_types["sfun"];
std::string dfun = fun_types["dfun"];
std::string ufun = ftypes["ufun"];
std::string pfun = ftypes["pfun"];
std::string tfun = ftypes["tfun"];
std::string sfun = ftypes["sfun"];
std::string dfun = ftypes["dfun"];
// Get the indicies of the parameters that need to be passed to each piece
arma::uvec uind = par_index["ufun"];
arma::uvec pind = par_index["pfun"];
arma::uvec tind = par_index["tfun"];
arma::uvec sind = par_index["sfun"];
arma::uvec uind = ft_index["ufun"];
arma::uvec pind = ft_index["pfun"];
arma::uvec tind = ft_index["tfun"];
arma::uvec sind = ft_index["sfun"];
// R indexes from 1, Rcpp from 0, so adjust each index down one.
uind -= 1;
@ -67,7 +74,7 @@ arma::mat calc_utility(arma::mat pmat, List Inst, List fun_types, List par_index
arma::mat tpar = pmat.cols(tind);
arma::mat spar = pmat.cols(sind);
// Just like with the about matricies, we need more info to reconstruct pointers
// Just like with the above matricies, we need more info to reconstruct pointers
int upar_num = upar.n_cols;
int ppar_num = ppar.n_cols;
int tpar_num = tpar.n_cols;
@ -98,42 +105,44 @@ arma::mat calc_utility(arma::mat pmat, List Inst, List fun_types, List par_index
stochastic(sfun, spar_mem, spar_num, U_mem, Max_Min_mem, nrow, nslice);
return(Utility);
}
//' Generic Likelihood calculation
//'
//' @param pmat the parameter vector
//' @param Inst the insrument as a list of its components
//' @param fun_types List of the utility, probability weighting, and stochstic function types
//' @param par_index fun_types List of giving the index in the par vector of the parameters for each fun_type
//' @param inst the insrument as a list of its components
//' @param ftypes List of the utility, probability weighting, and stochstic function types
//' @param ft_index ftypes List of giving the index in the par vector of the parameters for each fun_type
//' @export calc_likelihood
// [[Rcpp::export]]
arma::mat calc_likelihood(arma::mat pmat, List Inst, List fun_types, List par_index) {
arma::mat calc_likelihood(arma::mat pmat, DataFrame inst, List profile, List ftypes, List ft_index) {
// We need some information here
List outcomes_list = Inst["outcomes"];
// Get the list for this profile value
List val_prof = profile["outcomes"];
// The number of options
int nslice = outcomes_list.length();
// The number of rows and columns for each option
arma::mat first_option = outcomes_list[0];
int nrow = first_option.n_rows;
int ncol = first_option.n_cols;
arma::uword nopt = val_prof.length();
// First outcome to determine dimensions for cube
arma::vec prof_element = val_prof[0];
// The number of columns for each option is the number of elements in this profile
arma::uword ncol = prof_element.n_elem;
// The number of rows for each option is the number of rows in the inst
arma::uword nrow = inst.nrows();
// The Utility of each option
arma::mat Utility = calc_utility(pmat, Inst, fun_types, par_index);
arma::mat Utility = calc_utility(pmat, inst, profile, ftypes, ft_index);
// Pointer for utility
double *U_mem = Utility.memptr();
// The likelihood of each option
arma::mat likemat(nrow, nslice);
arma::mat likemat(nrow, nopt);
// Get the function types
std::string dfun = fun_types["dfun"];
std::string dfun = ftypes["dfun"];
// Pointer for likelihood
double *likemat_mem = likemat.memptr();
// Generate the likelihoods
likelihood(dfun, likemat_mem, U_mem, nrow, nslice);
likelihood(dfun, likemat_mem, U_mem, nrow, nopt);
return(likemat);
}
@ -141,18 +150,21 @@ arma::mat calc_likelihood(arma::mat pmat, List Inst, List fun_types, List par_in
//' Return a likelihood vector for choices
//'
//' @param par the parameter vector
//' @param Inst the insrument as a list of its components
//' @param fun_types List of the utility, probability weighting, and stochstic function types
//' @param par_index fun_types List of giving the index in the par vector of the parameters for each fun_type
//' @param inst the insrument as a list of its components
//' @param ftypes List of the utility, probability weighting, and stochstic function types
//' @param ft_index ftypes List of giving the index in the par vector of the parameters for each fun_type
//' @export mlgeneral
// [[Rcpp::export]]
arma::vec mlgeneral(arma::mat pmat, List inst, List fun_types, List par_index) {
arma::vec mlgeneral(arma::mat pmat, DataFrame inst, List profile, List ftypes, List ft_index) {
// Get the likelihoods for the options
arma::mat likelihoods = calc_likelihood(pmat, inst, profile, ftypes, ft_index);
// Grab the choice vector
arma::vec choice = inst["choice"];
arma::mat likelihoods = calc_likelihood(pmat, inst, fun_types, par_index);
// Generate the final likelihood vector
arma::vec like(likelihoods.n_rows);
for (int r = 0; r < likelihoods.n_rows ; r++) {
like(r) = likelihoods(r, choice(r));
}
return(like);
}

View File

@ -2,6 +2,14 @@
#include <RcppArmadillo.h>
using namespace Rcpp;
// Functions actually in the main file
arma::mat calc_utility(arma::mat pmat, DataFrame inst, List profile, List ftypes, List ft_index);
arma::vec gslikelihood(std::string sfun, arma::vec Utilities);
// Helper functions
arma::mat vpow(const arma::vec base, const arma::vec exp);
arma::cube inst_cube(DataFrame inst, List profile, std::string prof_val);
// Utility Functions
void utility (std::string ufun, double* par_mem, int par_num, double* outs_mem, double* Max_Min_mem, int nrow, int ncol, int nslice);
void ufx_ev (double* par_mem, int par_num, double *outs_mem, double *Max_Min_mem, int nrow, int ncol, int nslice);
@ -43,9 +51,3 @@ arma::vec gsstochastic(arma::vec pars, std::string sfun, arma::vec Utilities, ar
// Distribution functions for likelihoods
void likelihood (std::string dfun, double* likemat_mem, double* U_mem, int nrow, int ncol);
void like_logit (double* likemat_mem, double* U_mem, int nrow, int ncol);
// Get the likelihood of each option given the adjusted utilities
arma::vec gslikelihood(std::string sfun, arma::vec Utilities);
// Helper functions
arma::mat vpow(const arma::vec base, const arma::vec exp);
arma::cube list2_cube(List Inst, int out_prob);