https://github.com/cran/GAS
Tip revision: e588e3a10bf22cb7dff4a49a848baac63d743c3f authored by Leopoldo Catania on 04 February 2022, 09:30:12 UTC
version 0.3.4
version 0.3.4
Tip revision: e588e3a
Mapping.cpp
#include <RcppArmadillo.h>
#include "Utils.h"
using namespace Rcpp;
using namespace arma;
const double dLowerShape = 4.00;
const double dUpperShape = 50.0;
const double dLowerSkewFS = 0.50;
const double dUpperSkewFS = 1.50;
const double dNumericalUpperLimit = 1e7;
const double dNumericalLowerLimit = -1e7;
const double dNumericalUnderflow = 1e-7;
double Map(double dX, double dL,double dU) {
double dMap = dL + ( dU - dL ) / (1.0 + exp( - dX ));
return dMap;
}
double Unmap(double dG, double dL,double dU) {
double dUnmap = log((dG-dL)/(dU-dG));
return dUnmap;
}
//[[Rcpp::export]]
arma::vec Map_Vec(arma::vec vX, double dL ,double dU) {
arma::vec vMap = dL + ( dU - dL ) / (1.0 + exp( - vX ));
return vMap;
}
//[[Rcpp::export]]
arma::vec unmapVec_C(arma::vec vG, double dL, double dU) {
arma::vec vUnmap = log((vG-dL)/(dU-vG));
return vUnmap;
}
double MapDeriv(double dX, double dL, double dU){
double dDeriv = -dX + log(dU-dL) - 2.0*log(1.0 + exp(-dX));
return exp(dDeriv);
}
double Logit(double dP) {
if (dP < 1e-10) {
dP = 1e-10;
}
if (dP > 1.0 - 1e-10) {
dP = 1.0 - 1e-10;
}
double dLogit = log(dP) - log(1.0 - dP) ;
return dLogit;
}
double LogitInv(double dLogit) {
double logx = 0.0;
double logy = dLogit;
double dFoo = 0.0;
if (logx > logy) {
dFoo = logx + log(1.0 + exp(logy - logx));
} else {
dFoo = logy + log(1.0 + exp(logx - logy));
}
double dP = exp(dLogit - dFoo);
if (dP < 1e-10) {
dP = 1e-10;
}
if (dP > 1.0 - 1e-10) {
dP = 1.0 - 1e-10;
}
return dP;
}
double Deriv_LogitInv(double dLogit){
double dLogitInv = LogitInv(dLogit);
double dDeriv = dLogitInv * (1.0 - dLogitInv);
return dDeriv;
}
double CheckScale(double dScale) {
if (dScale > dNumericalUpperLimit) {
dScale = dNumericalUpperLimit;
}
if (dScale < dNumericalUnderflow) {
dScale = dNumericalUnderflow;
}
return dScale;
}
double CheckLocation(double dLocation) {
if (dLocation > dNumericalUpperLimit) {
dLocation = dNumericalUpperLimit;
}
if (dLocation < dNumericalLowerLimit) {
dLocation = dNumericalLowerLimit;
}
return dLocation;
}
//######################### UNIVARIATE #####################################
//[[Rcpp::export]]
arma::vec MapParameters_univ(arma::vec vTheta_tilde, std::string Dist, int iK){
arma::vec vTheta(iK);
if(Dist=="ast"){
double dMu_tilde = vTheta_tilde(0);
double dSigma_tilde = vTheta_tilde(1);
double dAlpha_tilde = vTheta_tilde(2);
double dNu1_tilde = vTheta_tilde(3);
double dNu2_tilde = vTheta_tilde(4);
double dMu = dMu_tilde;
double dSigma = exp(dSigma_tilde);
double dAlpha = Map(dAlpha_tilde,0.01, 0.99);
double dNu1 = Map(dNu1_tilde,dLowerShape,dUpperShape);//exp(dNu1_tilde) + dLowerShape;
double dNu2 = Map(dNu2_tilde,dLowerShape,dUpperShape);//exp(dNu2_tilde) + dLowerShape;
vTheta(0) = CheckLocation(dMu);
vTheta(1) = CheckScale(dSigma);
vTheta(2) = dAlpha;
vTheta(3) = dNu1;
vTheta(4) = dNu2;
}
if(Dist=="ast1"){
double dMu_tilde = vTheta_tilde(0);
double dSigma_tilde = vTheta_tilde(1);
double dAlpha_tilde = vTheta_tilde(2);
double dNu1_tilde = vTheta_tilde(3);
double dMu = dMu_tilde;
double dSigma = exp(dSigma_tilde);
double dAlpha = Map(dAlpha_tilde,0.01,0.99);
double dNu1 = Map(dNu1_tilde,dLowerShape,dUpperShape);//exp(dNu1_tilde) + dLowerShape;
vTheta(0) = CheckLocation(dMu);
vTheta(1) = CheckScale(dSigma);
vTheta(2) = dAlpha;
vTheta(3) = dNu1;
}
if(Dist=="std"){
double dMu_tilde = vTheta_tilde(0);
double dPhi_tilde = vTheta_tilde(1);
double dNu_tilde = vTheta_tilde(2);
double dMu = dMu_tilde;
double dPhi = exp(dPhi_tilde);
// double dNu = exp(dNu_tilde) + dLowerShape;
double dNu = Map(dNu_tilde,dLowerShape,dUpperShape);
vTheta(0) = CheckLocation(dMu);
vTheta(1) = CheckScale(dPhi);
vTheta(2) = dNu;
}
if(Dist=="sstd"){
double dMu_tilde = vTheta_tilde(0);
double dSigma_tilde = vTheta_tilde(1);
double dXi_tilde = vTheta_tilde(2);
double dNu_tilde = vTheta_tilde(3);
double dMu = dMu_tilde;
double dSigma = exp(dSigma_tilde);
double dXi = Map(dXi_tilde, dLowerSkewFS, dUpperSkewFS);
// double dNu = exp(dNu_tilde) + dLowerShape;
double dNu = Map(dNu_tilde,dLowerShape,dUpperShape);
vTheta(0) = CheckLocation(dMu);
vTheta(1) = CheckScale(dSigma);
vTheta(2) = dXi;
vTheta(3) = dNu;
}
if(Dist=="norm"){
double dMu_tilde = vTheta_tilde(0);
double dSigma2_tilde = vTheta_tilde(1);
double dMu = dMu_tilde;
double dSigma2 = exp(dSigma2_tilde);
vTheta(0) = CheckLocation(dMu);
vTheta(1) = CheckScale(dSigma2);
}
if(Dist=="snorm"){
double dMu_tilde = vTheta_tilde(0);
double dSigma_tilde = vTheta_tilde(1);
double dXi_tilde = vTheta_tilde(2);
double dMu = dMu_tilde;
double dSigma = exp(dSigma_tilde);
double dXi = Map(dXi_tilde, dLowerSkewFS, dUpperSkewFS);
vTheta(0) = CheckLocation(dMu);
vTheta(1) = CheckScale(dSigma);
vTheta(2) = dXi;
}
if(Dist == "poi"){
double dMu_tilde = vTheta_tilde(0);
double dMu = exp(dMu_tilde);
vTheta(0) = CheckScale(dMu);
}
if(Dist == "ber"){
double dPi_tilde = vTheta_tilde(0);
double dPi = 1.0/(1.0 + exp(-dPi_tilde));
vTheta(0) = dPi;
}
if(Dist == "gamma"){
double dAlpha_tilde = vTheta_tilde(0);
double dBeta_tilde = vTheta_tilde(1);
double dAlpha = exp(dAlpha_tilde);
double dBeta = exp(dBeta_tilde);
vTheta(0) = CheckScale(dAlpha);
vTheta(1) = CheckScale(dBeta);
}
if(Dist == "exp"){
double dMu_tilde = vTheta_tilde(0);
double dMu = exp(dMu_tilde);
vTheta(0) = CheckScale(dMu);
}
if(Dist == "beta"){
double dAlpha_tilde = vTheta_tilde(0);
double dBeta_tilde = vTheta_tilde(1);
double dAlpha = exp(dAlpha_tilde);
double dBeta = exp(dBeta_tilde);
vTheta(0) = CheckScale(dAlpha);
vTheta(1) = CheckScale(dBeta);
}
if(Dist=="ald"){
double dTheta_tilde = vTheta_tilde(0);
double dSigma_tilde = vTheta_tilde(1);
double dKappa_tilde = vTheta_tilde(2);
double dTheta = dTheta_tilde;
double dSigma = exp(dSigma_tilde);
double dKappa = exp(dKappa_tilde);
vTheta(0) = CheckLocation(dTheta);
vTheta(1) = CheckScale(dSigma);
vTheta(2) = CheckScale(dKappa);
}
if(Dist=="ghskt"){
double dMu_tilde = vTheta_tilde(0);
double dSigma_tilde = vTheta_tilde(1);
double dBetaBar_tilde = vTheta_tilde(2);
double dNu_tilde = vTheta_tilde(3);
double dMu = dMu_tilde;
double dSigma = exp(dSigma_tilde);
double dBetaBar = dBetaBar_tilde;
double dNu = Map(dNu_tilde, dLowerShape + 0.01, dUpperShape);
vTheta(0) = CheckLocation(dMu);
vTheta(1) = CheckScale(dSigma);
vTheta(2) = dBetaBar;
vTheta(3) = dNu;
}
if(Dist == "negbin"){
double dPi = LogitInv(vTheta_tilde(0));
double dNu = exp(vTheta_tilde(1));
vTheta(0) = dPi;
vTheta(1) = CheckScale(dNu);
}
if(Dist == "skellam"){
double dMu_tilde = vTheta_tilde(0);
double dSigma2_tilde = vTheta_tilde(1);
double dMu = dMu_tilde;
double dSigma2 = exp(dSigma2_tilde);
vTheta(0) = dMu;
vTheta(1) = CheckScale(dSigma2);
}
return InfRemover_vec(vTheta);
}
//[[Rcpp::export]]
arma::vec UnmapParameters_univ(arma::vec vTheta, std::string Dist, int iK = -9999){
if(iK == -9999) iK = vTheta.size();
arma::vec vTheta_tilde(iK);
if(Dist=="ast"){
double dMu = vTheta(0);
double dSigma = vTheta(1);
double dAlpha = vTheta(2);
double dNu1 = vTheta(3);
double dNu2 = vTheta(4);
double dMu_tilde = dMu;
double dSigma_tilde = log(dSigma);
double dAlpha_tilde = Unmap(dAlpha,0.01,0.99);
double dNu1_tilde = Unmap(dNu1,dLowerShape,dUpperShape);// log(dNu1 - dLowerShape);
double dNu2_tilde = Unmap(dNu2,dLowerShape,dUpperShape);// log(dNu2 - dLowerShape);
vTheta_tilde(0) = dMu_tilde;
vTheta_tilde(1) = dSigma_tilde;
vTheta_tilde(2) = dAlpha_tilde;
vTheta_tilde(3) = dNu1_tilde;
vTheta_tilde(4) = dNu2_tilde;
}
if(Dist=="ast1"){
double dMu = vTheta(0);
double dSigma = vTheta(1);
double dAlpha = vTheta(2);
double dNu1 = vTheta(3);
double dMu_tilde = dMu;
double dSigma_tilde = log(dSigma);
double dAlpha_tilde = Unmap(dAlpha,0.01,0.99);
double dNu1_tilde = Unmap(dNu1,dLowerShape,dUpperShape);// log(dNu1 - dLowerShape);
vTheta_tilde(0) = dMu_tilde;
vTheta_tilde(1) = dSigma_tilde;
vTheta_tilde(2) = dAlpha_tilde;
vTheta_tilde(3) = dNu1_tilde;
}
if(Dist=="std"){
double dMu = vTheta(0);
double dPhi = vTheta(1);
double dNu = vTheta(2);
double dMu_tilde = dMu;
double dPhi_tilde = log(dPhi);
// double dNu_tilde = log(dNu - dLowerShape);
double dNu_tilde = Unmap(dNu,dLowerShape,dUpperShape);
vTheta_tilde(0) = dMu_tilde;
vTheta_tilde(1) = dPhi_tilde;
vTheta_tilde(2) = dNu_tilde;
}
if(Dist=="sstd"){
double dMu = vTheta(0);
double dSigma = vTheta(1);
double dXi = vTheta(2);
double dNu = vTheta(3);
double dMu_tilde = dMu;
double dSigma_tilde = log(dSigma);
double dXi_tilde = Unmap(dXi, dLowerSkewFS, dUpperSkewFS);
// double dNu_tilde = log(dNu - dLowerShape);
double dNu_tilde = Unmap(dNu,dLowerShape,dUpperShape);
vTheta_tilde(0) = dMu_tilde;
vTheta_tilde(1) = dSigma_tilde;
vTheta_tilde(2) = dXi_tilde;
vTheta_tilde(3) = dNu_tilde;
}
if(Dist=="norm"){
double dMu = vTheta(0);
double dSigma2 = vTheta(1);
double dMu_tilde = dMu;
double dSigma2_tilde = log(dSigma2);
vTheta_tilde(0) = dMu_tilde;
vTheta_tilde(1) = dSigma2_tilde;
}
if(Dist=="snorm"){
double dMu = vTheta(0);
double dSigma = vTheta(1);
double dXi = vTheta(2);
double dMu_tilde = dMu;
double dSigma_tilde = log(dSigma);
double dXi_tilde = Unmap(dXi, dLowerSkewFS, dUpperSkewFS);
vTheta_tilde(0) = dMu_tilde;
vTheta_tilde(1) = dSigma_tilde;
vTheta_tilde(2) = dXi_tilde;
}
if(Dist == "poi"){
double dMu = vTheta(0);
double dMu_tilde = log(dMu);
vTheta_tilde(0) = dMu_tilde;
}
if(Dist == "ber"){
double dPi = vTheta(0);
double dPi_tilde = log(dPi / (1.0 - dPi));
vTheta_tilde(0) = dPi_tilde;
}
if(Dist == "gamma"){
double dAlpha = vTheta(0);
double dBeta = vTheta(1);
double dAlpha_tilde = log(dAlpha);
double dBeta_tilde = log(dBeta);
vTheta_tilde(0) = dAlpha_tilde;
vTheta_tilde(1) = dBeta_tilde;
}
if(Dist == "exp"){
double dMu = vTheta(0);
double dMu_tilde = log(dMu);
vTheta_tilde(0) = dMu_tilde;
}
if(Dist == "beta"){
double dAlpha = vTheta(0);
double dBeta = vTheta(1);
double dAlpha_tilde = log(dAlpha);
double dBeta_tilde = log(dBeta);
vTheta_tilde(0) = dAlpha_tilde;
vTheta_tilde(1) = dBeta_tilde;
}
if(Dist=="ald"){
double dTheta = vTheta(0);
double dSigma = vTheta(1);
double dKappa = vTheta(2);
double dTheta_tilde = dTheta;
double dSigma_tilde = log(dSigma);
double dKappa_tilde = log(dKappa);
vTheta_tilde(0) = dTheta_tilde;
vTheta_tilde(1) = dSigma_tilde;
vTheta_tilde(2) = dKappa_tilde;
}
if(Dist=="ghskt"){
double dMu = vTheta(0);
double dSigma = vTheta(1);
double dBetaBar = vTheta(2);
double dNu = vTheta(3);
double dMu_tilde = dMu;
double dSigma_tilde = log(dSigma);
double dBetaBar_tilde = dBetaBar;
double dNu_tilde = Unmap(dNu, dLowerShape + 0.01, dUpperShape);
vTheta_tilde(0) = dMu_tilde;
vTheta_tilde(1) = dSigma_tilde;
vTheta_tilde(2) = dBetaBar_tilde;
vTheta_tilde(3) = dNu_tilde;
}
if(Dist == "skellam"){
double dMu = vTheta(0);
double dSigma2 = vTheta(1);
double dMu_tilde = dMu;
double dSigma2_tilde = log(dSigma2);
vTheta_tilde(0) = dMu_tilde;
vTheta_tilde(1) = CheckScale(dSigma2_tilde);
}
if(Dist == "negbin"){
double dPi_tilde = Logit(vTheta(0));
double dNu_tilde = log(vTheta(1));
vTheta_tilde(0) = dPi_tilde;
vTheta_tilde(1) = dNu_tilde;
}
return vTheta_tilde;
}
arma::mat MapParametersJacobian_univ(arma::vec vTheta_tilde, std::string Dist, int iK){
arma::mat mJ=zeros(iK,iK);
if(Dist=="ast"){
double dSigma_tilde = vTheta_tilde(1);
double dAlpha_tilde = vTheta_tilde(2);
double dNu1_tilde = vTheta_tilde(3);
double dNu2_tilde = vTheta_tilde(4);
mJ(0,0) = 1;
mJ(1,1) = CheckScale(exp(dSigma_tilde));
mJ(2,2) = MapDeriv(dAlpha_tilde,0.01,0.99);;
mJ(3,3) = MapDeriv(dNu1_tilde,dLowerShape,dUpperShape);; //exp(dNu1_tilde);
mJ(4,4) = MapDeriv(dNu2_tilde,dLowerShape,dUpperShape);; //exp(dNu2_tilde);
}
if(Dist=="ast1"){
double dSigma_tilde = vTheta_tilde(1);
double dAlpha_tilde = vTheta_tilde(2);
double dNu1_tilde = vTheta_tilde(3);
mJ(0,0) = 1;
mJ(1,1) = CheckScale(exp(dSigma_tilde));;
mJ(2,2) = MapDeriv(dAlpha_tilde,0.01,0.99);;
mJ(3,3) = MapDeriv(dNu1_tilde,dLowerShape,dUpperShape);; //exp(dNu1_tilde);
}
if(Dist=="std"){
double dPhi_tilde = vTheta_tilde(1);
double dNu_tilde = vTheta_tilde(2);
mJ(0,0) = 1;
mJ(1,1) = CheckScale(exp(dPhi_tilde));
// mJ(2,2) = exp(dNu_tilde);
mJ(2,2) = MapDeriv(dNu_tilde,dLowerShape,dUpperShape);
}
if(Dist=="sstd"){
double dSigma_tilde = vTheta_tilde(1);
double dXi_tilde = vTheta_tilde(2);
double dNu_tilde = vTheta_tilde(3);
mJ(0,0) = 1;
mJ(1,1) = CheckScale(exp(dSigma_tilde));
mJ(2,2) = MapDeriv(dXi_tilde,dLowerSkewFS, dUpperSkewFS);
// mJ(3,3) = exp(dNu_tilde);
mJ(3,3) = MapDeriv(dNu_tilde,dLowerShape,dUpperShape);
}
if(Dist=="norm"){
double dSigma2_tilde = vTheta_tilde(1);
mJ(0,0) = 1;
mJ(1,1) = CheckScale(exp(dSigma2_tilde));
}
if(Dist=="snorm"){
double dSigma_tilde = vTheta_tilde(1);
double dXi_tilde = vTheta_tilde(2);
mJ(0,0) = 1;
mJ(1,1) = CheckScale(exp(dSigma_tilde));
mJ(2,2) = MapDeriv(dXi_tilde, dLowerSkewFS, dUpperSkewFS);;
}
if(Dist=="poi"){
double dMu_tilde = vTheta_tilde(0);
mJ(0,0) = exp(dMu_tilde);
}
if(Dist=="ber"){
double dPi_tilde = vTheta_tilde(0);
mJ(0,0) = exp(-dPi_tilde)/pow(1.0 + exp(-dPi_tilde),2.0);
}
if(Dist=="gamma"){
double dAlpha_tilde = vTheta_tilde(0);
double dBeta_tilde = vTheta_tilde(1);
mJ(0,0) = CheckScale(exp(dAlpha_tilde));
mJ(1,1) = CheckScale(exp(dBeta_tilde));
}
if(Dist=="exp"){
double dMu_tilde = vTheta_tilde(0);
mJ(0,0) = CheckScale(exp(dMu_tilde));
}
if(Dist=="beta"){
double dAlpha_tilde = vTheta_tilde(0);
double dBeta_tilde = vTheta_tilde(1);
mJ(0,0) = CheckScale(exp(dAlpha_tilde));
mJ(1,1) = CheckScale(exp(dBeta_tilde));
}
if(Dist=="ald"){
double dSigma_tilde = vTheta_tilde(1);
double dKappa_tilde = vTheta_tilde(2);
mJ(0,0) = 1.0;
mJ(1,1) = CheckScale(exp(dSigma_tilde));
mJ(2,2) = CheckScale(exp(dKappa_tilde));
}
if(Dist=="ghskt"){
double dSigma_tilde = vTheta_tilde(1);
double dNu_tilde = vTheta_tilde(3);
mJ(0,0) = 1.0;
mJ(1,1) = CheckScale(exp(dSigma_tilde));
mJ(2,2) = 1.0;
mJ(3,3) = MapDeriv(dNu_tilde,dLowerShape + 0.01, dUpperShape);
}
if(Dist == "negbin"){
double dPi_tilde = vTheta_tilde(0);
double dNu_tilde = vTheta_tilde(1);
mJ(0,0) = Deriv_LogitInv(dPi_tilde);
mJ(1,1) = CheckScale(exp(dNu_tilde));
}
if(Dist=="skellam"){
double dSigma2_tilde = vTheta_tilde(1);
mJ(0,0) = 1.0;
mJ(1,1) = CheckScale(exp(dSigma2_tilde));
}
arma::vec vJ_safe = InfRemover_vec(mJ.diag());
// mJ.diag() = vJ_safe;
for (int k = 0; k < iK; k++) {
mJ(k, k) = vJ_safe(k);
}
return mJ;
}
//######################### MULTIVARIATE #####################################
arma::mat HalfR(arma::vec vPhi){
int k = vPhi.size();
int n=(1.0 + sqrt(double(1.0 + 8.0 * k)))/2.0;
arma::mat phi=FillUpperTriangular(vPhi,n);
arma::mat c=cos(phi);
arma::mat s=sin(phi);
arma::mat foo=cumprodMat_removeLastRow(s);
arma::vec baz(n);
baz.fill(1);
arma::mat foo2=Up_rbind_C(foo,baz);
arma::mat X = c % foo2;
return X;
}
//[[Rcpp::export]]
arma::mat MapR_C(arma::vec vPhi, int iN){
arma::mat X = HalfR(vPhi);
arma::mat R = X.t() * X;
return(R);
}
//[[Rcpp::export]]
arma::vec UnMapR_C(arma::vec vRho, int iN){
arma::mat mPhi = zeros(iN,iN);
arma::mat mX = zeros(iN,iN);
arma::mat mR = build_mR(vRho, iN);
mX(0,0) = 1.0;
int i,j,k,l;
double dFoo1 = 0.0;
double dFoo2 = 0.0;
double dFoo3 = 0.0;
for(i=1;i<iN;i++){
mPhi(i,0) = acos(mR(i,0));
mX(i,0) = cos(mPhi(i,0));
}
if(iN>2){
for(j=1;j<iN;j++){
for(i=1;i<=j;i++){
dFoo1 = 1.0;
for(k=0;k<=i-1;k++){
dFoo1 *= sin(mPhi(j,k));
}
if(i==j){
mX(j,j) = dFoo1;
}else{
dFoo2 = 0.0;
if(i>1){
for(k=1;k<=i-1;k++){
dFoo3 = 1.0;
for(l=0;l<=(k-1);l++){
dFoo3 *= sin(mPhi(i,l))*sin(mPhi(j,l));
}
dFoo2 += cos(mPhi(i,k))*cos(mPhi(j,k))*dFoo3;
}
}
dFoo3 = 1.0;
for(l=0;l<=(i-1);l++){
dFoo3 *= sin(mPhi(i,l))*sin(mPhi(j,l));
}
mPhi(j,i) = acos((mR(i,j) - cos(mPhi(i,0))*cos(mPhi(j,0)) - dFoo2)/dFoo3);
mX(i,j) = cos(mPhi(j,i)) * dFoo1;
}
}
}
}
arma::vec vPhi(iN*(iN-1.0)/2.0);
int iC=0;
for(j=0;j<iN-1;j++){
for(i=j+1;i<iN;i++){
vPhi(iC) = mPhi(i,j);
iC++;
}
}
return vPhi;
}
arma::vec mvnormMap(arma::vec vTheta_tilde, int iN, int iK){
arma::vec vTheta(iK);
arma::vec vMu_tilde = vTheta_tilde.subvec(0,iN-1);
arma::vec vSigma_tilde = vTheta_tilde.subvec(iN,2*iN-1);
arma::vec vRho_tilde = vTheta_tilde.subvec(2*iN,iK-1);
arma::vec vSigma = exp(vSigma_tilde);
for(int n = 0; n < iN; n++) {
vSigma(n) = CheckScale(vSigma(n));
}
arma::mat mR = MapR_C(vRho_tilde, iN);
arma::vec vR = build_vR(mR,iN);
vTheta.subvec(0,iN-1) = vMu_tilde;
vTheta.subvec(iN,2*iN-1) = vSigma;
vTheta.subvec(2*iN,iK-1) = vR;
return vTheta;
}
arma::vec mvtMap(arma::vec vTheta_tilde, int iN, int iK){
arma::vec vTheta(iK);
arma::vec vMu_tilde = vTheta_tilde.subvec(0,iN-1);
arma::vec vSigma_tilde = vTheta_tilde.subvec(iN,2*iN-1);
arma::vec vRho_tilde = vTheta_tilde.subvec(2*iN,iK-2);
double dNu_tilde = vTheta_tilde(iK-1);
arma::vec vSigma = exp(vSigma_tilde);
for(int n = 0; n < iN; n++) {
vSigma(n) = CheckScale(vSigma(n));
}
double dNu = Map(dNu_tilde, dLowerShape, dUpperShape);
arma::mat mR = MapR_C(vRho_tilde, iN);
arma::vec vR = build_vR(mR,iN);
vTheta.subvec(0,iN-1) = vMu_tilde;
vTheta.subvec(iN,2*iN-1) = vSigma;
vTheta.subvec(2*iN,iK-2) = vR;
vTheta(iK-1) = dNu;
return vTheta;
}
arma::vec mvnormUnmap(arma::vec vTheta, int iN, int iK){
arma::vec vTheta_tilde(iK);
arma::vec vMu = vTheta.subvec(0,iN-1);
arma::vec vSigma = vTheta.subvec(iN,2*iN-1);
arma::vec vRho = vTheta.subvec(2*iN,iK-1);
arma::vec vSigma_tilde = log(vSigma);
arma::vec vRho_tilde = UnMapR_C(vRho, iN);
vTheta_tilde.subvec(0,iN-1) = vMu;
vTheta_tilde.subvec(iN,2*iN-1) = vSigma_tilde;
vTheta_tilde.subvec(2*iN,iK-1) = vRho_tilde;
return vTheta_tilde;
}
arma::vec mvtUnmap(arma::vec vTheta, int iN, int iK){
arma::vec vTheta_tilde(iK);
arma::vec vMu = vTheta.subvec(0,iN-1);
arma::vec vSigma = vTheta.subvec(iN,2*iN-1);
arma::vec vRho = vTheta.subvec(2*iN,iK-2);
double dNu = vTheta(iK-1);
arma::vec vSigma_tilde = log(vSigma);
double dNu_tilde = Unmap(dNu, dLowerShape, dUpperShape);
arma::vec vRho_tilde = UnMapR_C(vRho, iN);
vTheta_tilde.subvec(0,iN-1) = vMu;
vTheta_tilde.subvec(iN,2*iN-1) = vSigma_tilde;
vTheta_tilde.subvec(2*iN,iK-2) = vRho_tilde;
vTheta_tilde(iK-1) = dNu_tilde;
return vTheta_tilde;
}
//[[Rcpp::export]]
arma::vec MapParameters_multi(arma::vec vTheta_tilde, std::string Dist,int iN, int iK){
arma::vec vTheta(iK);
if(Dist=="mvnorm"){
vTheta = mvnormMap(vTheta_tilde, iN, iK);
}
if(Dist=="mvt"){
vTheta = mvtMap(vTheta_tilde, iN, iK);
}
return InfRemover_vec(vTheta);
}
//[[Rcpp::export]]
arma::vec UnmapParameters_multi(arma::vec vTheta, std::string Dist,int iN, int iK){
arma::vec vTheta_tilde(iK);
if(Dist=="mvnorm"){
vTheta = mvnormUnmap(vTheta, iN, iK);
}
if(Dist=="mvt"){
vTheta = mvtUnmap(vTheta, iN, iK);
}
return InfRemover_vec(vTheta);
}
arma::mat Jacobian_MapR(arma::vec vPhi, int iN){
int i,j,iC=0,iK = iN*(iN-1)/2;
arma::mat mPhi=zeros(iN,iN);
arma::mat mC=zeros(iN,iN);
arma::mat mS=zeros(iN,iN);
for(i = 0;i<iN;i++){
for(j = i;j<iN;j++){
if(i!=j){
mPhi(i,j) = vPhi(iC);
mC(i,j) = cos(vPhi(iC));
mS(i,j) = sin(vPhi(iC));
iC+=1;
}
}
}
//
// int iK = iN*(iN-1)/2;
arma::mat mJ = zeros(iK,iK);
if(iN==2){
mJ(0,0) = -sin(mPhi(0,1));
}
if(iN==3){
mJ(0,0) = -sin(mPhi(0,1));
//
mJ(1,1) = -sin(mPhi(0,2));
mJ(2,0) = -mC(0,2) * sin(mPhi(0,1)) + mS(0,2)*mC(1,2)*cos(mPhi(0,1));
mJ(2,1) = -mC(0,1) * sin(mPhi(0,2)) + mS(0,1)*mC(1,2)*cos(mPhi(0,2));
mJ(2,2) = -mS(0,1)*mS(0,2)*sin(mPhi(1,2));
}
if(iN==4){
mJ(0,0) = -sin(mPhi(0,1));
mJ(1,1) = -sin(mPhi(0,2));
mJ(3,0) = -mC(0,2) * sin(mPhi(0,1)) + mS(0,2)*mC(1,2)*cos(mPhi(0,1));
mJ(3,1) = -mC(0,1) * sin(mPhi(0,2)) + mS(0,1)*mC(1,2)*cos(mPhi(0,2));
mJ(2,2) = -mS(0,1)*mS(0,2)*sin(mPhi(1,2));
//
mJ(3,3) = -sin(mPhi(0,3));
mJ(4,0) = -mC(0,3)*sin(mPhi(0,1)) + mC(1,3)*mS(0,1)*cos(mPhi(0,1));
mJ(4,2) = -sin(mPhi(0,3))*mC(0,1) + mC(1,3)*cos(mPhi(0,3))*mS(0,1);
mJ(4,4) = sin(mPhi(1,3))*mS(0,3)*mS(0,1);
mJ(5,1) = -sin(mPhi(0,2))*mC(0,3) + mC(1,2)*mC(1,3)*cos(mPhi(0,2))*mS(0,3) + mS(1,2)*cos(mPhi(0,2))*mS(0,3)*mS(1,3)*mC(2,3);
mJ(5,3) = -sin(mPhi(1,2))*mC(1,3)*mS(0,2)*mS(0,3) + cos(mPhi(1,2))*mS(0,2)*mS(0,3)*mS(1,3)*mC(2,3);
mJ(5,2) = -sin(mPhi(0,3))*mC(0,2) + cos(mPhi(0,3))*mC(1,2)*mC(1,3)*mS(0,2) + cos(mPhi(0,3))*mS(1,2)*mS(0,2)*mS(1,3)*mC(2,3);
mJ(5,4) = -sin(mPhi(1,3))*mC(1,2)*mS(0,2)*mS(0,3) + cos(mPhi(1,3))*mS(1,2)*mS(0,2)*mS(0,3)*mC(2,3);
mJ(5,5) = -sin(mPhi(2,3))*mS(1,2)*mS(0,2)*mS(0,3)*mS(1,3);
}
if(iN>4) mJ.diag().ones();
// mJ.diag().ones();
return mJ;
}
arma::vec IndexesFinder(int iC, int iN){
int l,m,iC_c = 0;
arma::vec vIndexes(2);
for(l = 0; l<iN; l++){
for(m = 0; m<=l; m++){
if(l!=m){
if(iC_c == iC){
vIndexes(0) = l;
vIndexes(1) = m;
}
iC_c++;
}
}
}
return vIndexes;
}
arma::mat Jacobian_MapD(arma::vec vSigma_tilde, int iN){
arma::mat mJ = zeros(iN,iN);
for(int i=0;i<iN;i++) mJ(i,i) = exp(vSigma_tilde(i));
return mJ;
}
arma::mat Jacobian_mvnormMap(arma::vec vTheta_tilde, int iN, int iK){
arma::vec vSigma_tilde = vTheta_tilde.subvec(iN,2*iN-1);
arma::vec vRho_tilde = vTheta_tilde.subvec(2*iN,iK - 1);
arma::mat mJ=eye(iK,iK);
mJ.submat(iN,iN,2*iN-1,2*iN-1) = Jacobian_MapD(vSigma_tilde, iN);
mJ.submat(2*iN,2*iN,iK-1,iK-1) = Jacobian_MapR(vRho_tilde, iN);
return mJ;
}
arma::mat Jacobian_mvtMap(arma::vec vTheta_tilde, int iN, int iK){
arma::vec vSigma_tilde = vTheta_tilde.subvec(iN,2*iN-1);
arma::vec vRho_tilde = vTheta_tilde.subvec(2*iN,iK - 2);
double dNu_tilde = vTheta_tilde(iK-1);
arma::mat mJ=eye(iK,iK);
mJ.submat(iN,iN,2*iN-1,2*iN-1) = Jacobian_MapD(vSigma_tilde, iN);
mJ.submat(2*iN,2*iN,iK-2,iK-2) = Jacobian_MapR(vRho_tilde, iN);
mJ(iK-1,iK-1) = MapDeriv(dNu_tilde,dLowerShape,dUpperShape);
return mJ;
}
arma::mat MapParametersJacobian_multi(arma::vec vTheta_tilde, std::string Dist, int iN, int iK){
arma::mat mJ(iK,iK);
if(Dist == "mvnorm"){
mJ = Jacobian_mvnormMap(vTheta_tilde, iN,iK);
}
if(Dist == "mvt"){
mJ = Jacobian_mvtMap(vTheta_tilde, iN,iK);
}
return mJ;
}