https://github.com/cran/GAS
Raw File
Tip revision: e588e3a10bf22cb7dff4a49a848baac63d743c3f authored by Leopoldo Catania on 04 February 2022, 09:30:12 UTC
version 0.3.4
Tip revision: e588e3a
snorm.cpp
#include <RcppArmadillo.h>
#include "ber.h"
#include "Utils.h"

using namespace arma;
using namespace Rcpp;

//// These functions are taken principally from the rugarch package of Ghalanos (2016) and have been slightly
//// modified to fit the GAS package

double dnormstd(const double x)
{
  double pdf;
  pdf = exp ( -0.5 * x * x ) / sqrt ( 2.0 * M_PI );
  if(pdf == 0.0) pdf = 0.0 + 2.22507e-24;
  return pdf;
}

double rsnorm(const double xi)
{
  double weight, z, rr, m1, mu, sigma, xx, ans;
  weight = xi / (xi + 1.0/xi);
  z =  Rf_runif(-weight, 1.0 - weight);
  xx = (z < 0)? 1.0/xi : xi;
  rr = -1.0 * abs3(Rf_rnorm(0.0, 1.0))/xx * sign_C(z);
  m1 = 2.0/sqrt(2.0 * M_PI);
  mu = m1 * (xi - 1.0/xi);
  sigma = sqrt((1 - (m1 * m1)) * ( (xi * xi) + 1.0/(xi* xi) ) + 2 * (m1 * m1) - 1.0);
  ans = (rr - mu ) / sigma;
  return(ans);
}

double dsnormstd(const double x, const double xi)
{
  double pdf;
  double mu, sigma,z, xxi, g;
  double m1 = 2.0/sqrt(2.0*M_PI);
  double m12 = m1*m1;
  double xi2 = xi*xi;
  mu = m1*(xi-1.0/xi);
  sigma = sqrt((1.0-m12)*(xi2+1.0/xi2)+2.0*m12-1.0);
  z = x*sigma+mu;
  xxi = (z<0)? 1.0/xi : xi;
  g = 2.0/(xi + 1.0/xi);
  pdf = g * dnormstd(z/xxi)*sigma;
  return pdf;
}

double psnorm(const double q, const double mu, const double sigma, const double xi)
{
  double qx = (q-mu)/sigma;
  double m1 = 2.0/sqrt(2*M_PI);
  double mux = m1 * (xi - 1.0/xi);
  double sig = sqrt((1.0-m1*m1)*(xi*xi+1.0/(xi*xi)) + 2.0*m1*m1 - 1.0);
  double z = qx*sig + mux;
  double Xi = (z<0)?1.0/xi:xi;
  double g = 2.0/(xi + 1.0/xi);
  double p = Heaviside(z, 0) - signum(z) * g * Xi * Rf_pnorm5(-abs3(z)/Xi, 0, 1, 1, 0);
  return( p );
}

double qsnorm(const double p, const double xi)
{
  double m1 = 2.0/sqrt(2*M_PI);
  double mu = m1 * (xi - 1.0/xi);
  double sigma = sqrt((1.0-m1*m1)*(xi*xi+1.0/(xi*xi)) + 2.0*m1*m1 - 1.0);
  double g = 2.0/(xi + 1.0/xi);
  double z = p-0.5;
  double Xi = (z<0)?1.0/xi:xi;
  double tmp = (Heaviside(z, 0) - signum(z) * p)/ (g* Xi);
  double q = (-1.0*signum(z)* Rf_qnorm5(tmp, 0, Xi, 1, 0) - mu)/sigma;
  return( q );
}


double snormskew( double dXi )
{
  double m1 = 2.0/sqrt(2.0 * M_PI);
  double m2 = 1.0;
  double m3 = 4/sqrt(2.0 * M_PI);

  double dSkew = (dXi - 1.0/dXi) * ( ( m3 + 2.0 * pow(m1, 3.0) - 3.0 * m1 * m2 ) * ( pow(dXi,2.0) + (1.0/pow(dXi, 2.0) ) ) + 3.0 * m1 * m2 - 4.0 * pow(m1,3.0) )/
    ( pow(( (m2 - pow(m1, 2.0)) * ( pow(dXi,2.0) + 1.0/pow(dXi, 2.0) ) + 2.0 * pow(m1, 2.0) - m2), 1.5)  );

  return dSkew;
}

double dSNORM(double dY, double dMu, double dSigma, double dXi, bool bLog = false){

  double dZ = (dY - dMu)/dSigma;
  double dPDF = dsnormstd(dZ, dXi)/dSigma;

  if(bLog) dPDF = log(dPDF);

  return dPDF;

}

double pSNORM(double dY, double dMu, double dSigma, double dXi){

  double dP = psnorm(dY, dMu, dSigma, dXi);
  return dP;

}

double rSNORM(double dMu, double dSigma, double dXi){

  double dY = dMu + rsnorm(dXi)*dSigma;
  return dY;

}

double qSNORM(double dP, double dMu, double dSigma, double dXi) {

  double dQ = qsnorm(dP, dXi)*dSigma + dMu;

  return dQ;
}

arma::vec mSNORM(double dMu, double dSigma, double dXi){

  arma::vec vMoments(4);

  vMoments(0) = dMu;
  vMoments(1) = pow(dSigma, 2.0);
  vMoments(2) = snormskew(dXi);
  vMoments(3) = 0.0;

  return vMoments;

}

arma::vec snorm_Score(double dY, arma::vec vTheta){

  double dMu    = vTheta(0);
  double dSigma = vTheta(1);
  double dXi     = vTheta(2);

  arma::vec vScore(3);

  double dK = (dY - dMu)/dSigma;

  double ddK_mu = -1.0/dSigma;
  double ddK_sigma = -dK/dSigma;

  double m1 = 2.0/sqrt(2.0*M_PI);
  double m12 = m1*m1;
  double xi2 = dXi * dXi;

  double dMu_tilde = m1 * (dXi - 1.0/dXi);
  double dSigma_tilde = sqrt((1.0-m12)*(xi2+1.0/xi2)+2.0*m12-1.0);

  double dZ = dK * dSigma_tilde + dMu_tilde;

  double dXi_star = (dZ<0)? 1.0/dXi : dXi;

  //derivative log dsnormstd wrt dK
  double dA = - dZ * dSigma_tilde / pow(dXi_star, 2.0);

  double ddMu = ddK_mu * dA;
  double ddSigma = ddK_sigma * dA - 1.0/dSigma;

  // derivative wrt dXi

  double dG = 2.0/(dXi + 1.0/dXi);
  double dH = dZ/dXi_star;

  double ddG_xi = -2.0*(1.0 - 1.0/pow(dXi, 2.0))/pow(dXi + 1.0/dXi, 2.0);
  double ddXi_Star_xi = (dZ<0)? -1.0/pow(dXi, 2.0) : 1.0;
  double ddSigma_tilde_xi = -(1.0 - m12)*(dXi - 1.0/pow(dXi, 3.0))/dSigma_tilde;
  double ddMu_tilde_xi = m1 * (1.0 + 1.0/pow(dXi, 2.0));

  double ddZ_xi = dK * ddSigma_tilde_xi + ddMu_tilde_xi;

  double ddH_xi = (ddZ_xi * dXi_star - dZ * ddXi_Star_xi )/pow(dXi_star, 2.0);

  double ddXi = ddG_xi/dG - dH*ddH_xi +  ddSigma_tilde_xi/dSigma_tilde;

  vScore(0) = ddMu;
  vScore(1) = ddSigma;
  vScore(2) = ddXi;

  return vScore;
}

arma::mat snorm_IM(arma::vec vTheta){

  arma::mat mIM = eye(3,3);

  return mIM;

}
back to top