#include <config.h>
#include <distributions/DWish.h>
#include <matrix/lapack.h>
#include <matrix/matrix.h>
#include <sarray/SArray.h>

#include <stdexcept>
#include <cfloat>
#include <cmath>
#include <vector>

#include <Rmath.h>

using std::vector;
using std::logic_error;
using std::runtime_error;

static inline double const *SCALE(vector<SArray const *> const &par)
{
    return par[0]->value();
}

static inline double DF(vector<SArray const *> const &par)
{
    return  *par[1]->value();
}

static inline unsigned long NROW(vector<SArray const *> const &par)
{
    return par[0]->dim(true)[0];
}

static inline unsigned long LENGTH(vector<SArray const *> const &par)
{
    return par[0]->length();
}

DWish::DWish()
  : Distribution("dwish", 2, false, false) 
{}

DWish::~DWish()
{}

double DWish::logLikelihood(SArray const &x,
			    vector<SArray const *> const &par) const
{
    double const *y = x.value();
    double const *scale = SCALE(par);
    long p = NROW(par);

    double loglik = 0;
    long length = LENGTH(par);
    for (int i = 0; i < length; ++i) {
	loglik += scale[i] * y[i];
    }
    loglik += DF(par) * logdet(scale, p) + (DF(par) - p - 1) * logdet(y, p);
    return loglik/2;
}


void DWish::randomSample(SArray &x,
			 vector<SArray const *> const &par) const
{
    long length = LENGTH(par);
    double *y = new double[length];
    randomSample(y, length, SCALE(par), DF(par), NROW(par));
    x.setValue(y, length);
    delete [] y;
}

void DWish::randomSample(double *x, long length,
			 double const *R, double k, int nrow)
{
  /* 
     Generate random Wishart variable, using an algorithm proposed
     by Bill Venables and originally implemented in S.
  */
  if (length != nrow*nrow) {
    throw logic_error("invalid length in DWish::randomSample");
  }

  /* 
     Get inverse of R. Venables' algorithm was implemented in
     terms of the inverse of R, but we use a different parameterization
     to preserve conjugacy.
  */
  double * C = new double[length];
  inverse(C, R, nrow, true);

  /* Get Choleskly decomposition of C */
  int info = 0;
  F77_DPOTRF("U", &nrow, C, &nrow, &info);
  if (info != 0) {
    throw runtime_error("Failed to get Cholesky decomposition of R in dwish");
  }

  /* Set lower triangle of C to zero */
  for (int j = 0; j < nrow; j++) {
    double * C_j = &C[j*nrow]; //column j of matrix C
    for (int i = j + 1; i < nrow; i++) {
      C_j[i] = 0;
    }
  }

  /* Generate square root of Wishart random variable:
     - diagonal elements are square root of Chi square
     - upper off-diagonal elements are normal
     - lower off-diagonal elements are zero
  */
  double *Z = new double[length];
  for (int j = 0; j < nrow; j++) {
    double *Z_j = &Z[j*nrow]; //jth column of Z
    for (int i = 0; i < j; i++) {
      Z_j[i] = rnorm(0,1);
    }
    Z_j[j] = sqrt(rchisq(k - j));    
    for (int i = j + 1; i < nrow; i++) {
      Z_j[i] = 0;
    }
  }
  
  /* Transform Z with Cholesky decomposition */
  double *Ztrans = new double[length];
  for (int i = 0; i < nrow; i++) {
    for (int j = 0; j < nrow; j++) {
      double zz = 0;
      for (int l = 0; l < nrow; l++) {
	zz += Z[nrow * l + i] * C[nrow * j + l];
      }
      Ztrans[nrow * j + i] = zz;
    }
  }
  delete [] C;
  delete [] Z;

  /* Now put cross-product into x */
  for (int i = 0; i < nrow; i++) {
    double const *Ztrans_i = &Ztrans[nrow * i];
    for (int j = 0; j <= i; j++) {
      double const *Ztrans_j = &Ztrans[nrow * j];
      double xx = 0;
      for (int l = 0; l < nrow; l++) {
	xx += Ztrans_i[l] * Ztrans_j[l];
      }
      x[nrow * j + i] = x[nrow * i + j] = xx;
    }
  }
  delete [] Ztrans;
}

bool DWish::checkParameterDim (vector<SArray const *> const &par) const
{
  Index const &dim0 = par[0]->dim(true);

  if (dim0.size() != 2)
    return false;
  if (dim0[0] != dim0[1])
    return false;
  if (par[1]->length() != 1)
    return false;

  return true;
}

Index const &DWish::dim(vector<SArray const *> const &par) const
{
  return par[0]->dim(true);
}

bool DWish::checkParameterValue (vector<SArray const *> const &par) const
{
    /* Check that we have sufficient degrees of freedom */
    if (DF(par) < NROW(par))
	return false;
    /* Check symmetry of scale matrix */
    double const *scale = SCALE(par);
    long nrow = NROW(par);
    for (int i = 0; i < nrow; ++i) {
	for (int j = 0; j < i; ++i) {
	    if (fabs(scale[i + nrow*j] - scale[j + nrow*i]) > DBL_EPSILON)
		return false;
	}
    }
    /* Skipping check of positive definiteness of scale matrix */
    return true;
}

unsigned long DWish::df(std::vector<SArray const *> const &par) const
{
    return LENGTH(par);
}

double 
DWish::lowerSupport(unsigned long i,
		    std::vector<SArray const *> const &par) const
{
    if (i % NROW(par) == i / NROW(par)) {
	//Diagonal elements
	return 0;
    }
    else {
	return -DBL_MAX;
    }
}

double 
DWish::upperSupport(unsigned long i,
		    std::vector<SArray const *> const &par) const
{
    return DBL_MAX;
}


syntax highlighted by Code2HTML, v. 0.9.1