/*
 * Copyright (C) 1996-2011 Daniel Waggoner and Tao Zha
 *
 * This free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * It is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * If you did not received a copy of the GNU General Public License
 * with this software, see <http://www.gnu.org/licenses/>.
 */

#include "dw_mdd_switch.h"
#include "dw_matrix.h"
#include "dw_array.h"
#include "dw_matrix_rand.h"
#include "dw_ascii.h"
#include "dw_rand.h"
#include "dw_math.h"
#include "dw_matrix_sort.h"
#include "dw_switch.h"
#include "dw_switchio.h"
#include "dw_dirichlet_restrictions.h"
#include "dw_elliptical.h"
#include "dw_parse_cmd.h"
#include "dw_metropolis_simulation.h"
#include "dw_std.h"

#include <math.h>
#include <string.h>
#include <time.h>

static PRECISION ComputeLinear(TMatrix proposal, PRECISION log_c, int *intercept);
static PRECISION ComputeInverseLinear(TMatrix posterior, PRECISION log_c, int *intercept);
static int sv_NumberDirichletDistributions(TMarkovStateVariable *sv);
static int* sv_DirichletDimensions(int *DirichletDim, TMarkovStateVariable *sv);

#define USE_MODE 0x01
#define USE_MEAN 0x02

#define SORTED_LEVEL_CUTS  1
#define LINEAR_LEVEL_CUTS  2
#define EXP_LEVEL_CUTS     3

#define USE_GAUSSIAN           1
#define USE_POWER              2
#define USE_TRUNCATED_POWER    3
#define USE_STEP               4
#define USE_TRUNCATED_GAUSSIAN 5
#define USE_UNIFORM            6

/*******************************************************************************/
/*********** Waggoner/Zha method for computing marginal data density ***********/  
/*******************************************************************************/
/*
   Let h(x) and f(x) be properly scaled probability density functions and let c 
   be an unknown constant.  We use the following notation.

      x      - parameters
      y      - data
      f(x)   - posterior distribution = p(x|y)
      h(x)   - proposal distribution
      c      - marginal data distribution = p(y)
      c*f(x) - likelihood*prior = p(y|x)*p(x)

   Assumes:
     proposal  : N x 2 matrix with proposal[i][0] = ln(h(x(i))) and 
                 proposal[i][1] = ln(c*f(x(i))) where x(i) is sampled from h(x).
     posterior : M x 2 matrix with posterior[i][0] = ln(h(x(i))) and 
                 posterior[i][1] = ln(c*f(x(i))) where x(i) is sampled from f(x).
     L1        : cutoff value (c*f(x) > L1)
     L2        : cutoff value for (h(x) < L2)

   Returns:
     Estimate of c or MINUS_INFINITY if no proposal draws satisfied the
     restriction given by the cutoff values of L1 and L2.

   Notes:
     Let S be the set of all x such that c*f(x) > exp(L1) and h(x) < exp(L2).  
     Then c = p(L1,L2)/I(L1,L2) where p(L1,L2) is the probability that x, sampled 
     from h(x), is in S and I(L1,L2) is the integral with respect to x over the 
     set S of

                                h(x)/(c*f(x)) * f(x) 

     p(L1,L2) can be approximated from the proposal draws by

                    (number of draws in S) / (total number of draws)

     I(L1,L2) can be approximated from the posterior draws by summing 

                                    h(x)/(c*f(x)) 
   
     over all posterior draws with x in S and then dividing by the total number 
     of posterior draws.       
*/
PRECISION ComputeLogMarginalDensity_WaggonerZha(TMatrix proposal, TMatrix posterior, PRECISION L1, PRECISION L2, int *in_proposal, int *in_posterior, PRECISION *I)
{
  int i;

  if (L1 == MINUS_INFINITY)
    if (L2 == PLUS_INFINITY)
      {
    	*in_proposal=RowM(proposal);

	*in_posterior=RowM(posterior);
	(*I)=MINUS_INFINITY;
	for (i=RowM(posterior)-1; i >= 0; i--)
	  (*I)=AddLogs(*I,ElementM(posterior,i,0) - ElementM(posterior,i,1));
      }
    else
      {
	for (*in_proposal=0, i=RowM(proposal)-1; i >= 0; i--)
	  if (ElementM(proposal,i,0) <= L2)
	    (*in_proposal)++;

	(*I)=MINUS_INFINITY;
	for (*in_posterior=0, i=RowM(posterior)-1; i >= 0; i--)
	  if (ElementM(posterior,i,0) <= L2)
	    {
	      (*in_posterior)++;
	      (*I)=AddLogs(*I,ElementM(posterior,i,0) - ElementM(posterior,i,1));
	    }
      }
  else
    if (L2 == PLUS_INFINITY)
      {
	for (*in_proposal=0, i=RowM(proposal)-1; i >= 0; i--)
	  if (ElementM(proposal,i,1) >= L1)
	    (*in_proposal)++;

	(*I)=MINUS_INFINITY;
	for (*in_posterior=0, i=RowM(posterior)-1; i >= 0; i--)
	  if (ElementM(posterior,i,1) >= L1)
	    {
	      (*in_posterior)++;
	      (*I)=AddLogs(*I,ElementM(posterior,i,0) - ElementM(posterior,i,1));
	    }
      }
    else
      {
	for (*in_proposal=0, i=RowM(proposal)-1; i >= 0; i--)
	  if ((ElementM(proposal,i,1) >= L1) && (ElementM(proposal,i,0) <= L2))
	    (*in_proposal)++;

	(*I)=MINUS_INFINITY;
	for (*in_posterior=0, i=RowM(posterior)-1; i >= 0; i--)
	  if ((ElementM(posterior,i,1) >= L1) && (ElementM(posterior,i,0) <= L2))
	    {
	      (*in_posterior)++;
	      (*I)=AddLogs(*I,ElementM(posterior,i,0) - ElementM(posterior,i,1));
	    }
      }

  if ((*in_posterior) > 0) (*I)-=log((PRECISION)RowM(posterior));

  return ((*in_proposal) == 0) ? MINUS_INFINITY : log((PRECISION)(*in_proposal)/(PRECISION)RowM(proposal)) - (*I);
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/

/*******************************************************************************/
/************************** Bridge Method Alternative **************************/
/*******************************************************************************/
static PRECISION BridgeDifference(TMatrix proposal, TMatrix posterior, PRECISION logr)
{
  int i;
  PRECISION x, r, sum1=MINUS_INFINITY, sum2=MINUS_INFINITY, n1=RowM(posterior), n2=RowM(proposal);

  for (r=n2/n1, i=RowM(proposal)-1; i >= 0; i--)
    if ((x=ElementM(proposal,i,0)+logr-ElementM(proposal,i,1)) < 0)
      sum2=AddLogs(sum2,-log(1+r*exp(x)));
    else
      sum2=AddLogs(sum2,-x-log(exp(-x)+r));

  for (r=n1/n2, i=RowM(posterior)-1; i >= 0; i--)
    if ((x=ElementM(posterior,i,1)-ElementM(posterior,i,0)-logr) < 0)
      sum1=AddLogs(sum1,-log(1+r*exp(x)));
    else
      sum1=AddLogs(sum1,-x-log(exp(-x)+r));
    
  return sum2 - sum1;
}
#define MAX_C 1.0E50
#define TOL   1.0E-7
PRECISION ComputeLogMarginalDensity_Bridge(TMatrix proposal, TMatrix posterior)
{
  PRECISION min_c, max_c, mid_c=0.0, diff;
  int i;

  // Bracket the zero
  if ((diff=BridgeDifference(proposal,posterior,mid_c)) < 0.0)
    {
      max_c=mid_c;
      for (min_c=-1.0; min_c > -MAX_C; max_c=min_c, min_c*=10)
	if ((diff=BridgeDifference(proposal,posterior,min_c)) > 0) break;
      if (min_c <= -MAX_C) return min_c;
    }
  else
    {
      min_c=mid_c;
      for (max_c=1.0; max_c < MAX_C; min_c=max_c, max_c*=10)
	if ((diff=BridgeDifference(proposal,posterior,max_c)) < 0) break;
      if (max_c >= MAX_C) return max_c;
    }

  // Divide and conququer
  diff=BridgeDifference(proposal,posterior,mid_c=(min_c + max_c)/2.0);
  for (i=0; i < 50; i++)
    {
      if (diff > 0)
	min_c=mid_c;
      else
	max_c=mid_c;
      if ((fabs(diff=BridgeDifference(proposal,posterior,mid_c=(min_c + max_c)/2.0)) < TOL)) break;
    }
  return mid_c;
}
#undef MAX_C
#undef TOL
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/

/*******************************************************************************/
/************ Mueller's method for computing marginal data density *************/
/*******************************************************************************/
#define MAX_C 1E50
static PRECISION ComputeLinear(TMatrix proposal, PRECISION log_c, int *intercept)
{
  int i;
  PRECISION slope=0.0, tmp;
  for (*intercept=0, i=RowM(proposal)-1; i >= 0; i--)
    if (log_c <= (tmp=ElementM(proposal,i,0) - ElementM(proposal,i,1)))
      {
	(*intercept)++;
	slope+=exp(log_c-tmp);
      }
  return slope;
}
static PRECISION ComputeInverseLinear(TMatrix posterior, PRECISION log_c, int *intercept)
{
  int i;
  PRECISION slope=0.0, tmp;
  for (*intercept=0, i=RowM(posterior)-1; i >= 0; i--)
    if (log_c >= (tmp=ElementM(posterior,i,0)-ElementM(posterior,i,1)))
      {
	(*intercept)++;
	slope+=exp(tmp-log_c);
      }
  return slope;
}
PRECISION ComputeLogMarginalDensity_Mueller(TMatrix proposal, TMatrix posterior,int *in1, int *in2)
{
  PRECISION log_c=0.0, slope1, slope2, N1=1.0/(PRECISION)RowM(proposal), N2=1.0/(PRECISION)RowM(posterior),
    intercept1, intercept2, max_log_c, min_log_c, diff, tmp;
  int min_in1, max_in1, min_in2, max_in2;

  slope1=ComputeLinear(proposal,log_c,in1);
  slope2=ComputeInverseLinear(posterior,log_c,in2);
  diff=N1*((PRECISION)(*in1) - slope1) - N2*((PRECISION)(*in2) - slope2);

  // Bracket the intersection
  if (diff < 0.0)
    {
      do
	if (log_c < -MAX_C) 
	  return log_c;
	else
	  {
	    max_in1=*in1;
	    max_in2=*in2;
	    max_log_c=log_c;
	    log_c=10*(log_c-1);
	    slope1=ComputeLinear(proposal,log_c,in1);
	    slope2=ComputeInverseLinear(posterior,log_c,in2);
	    diff=N1*((PRECISION)(*in1) - slope1) - N2*((PRECISION)(*in2) - slope2);
	  }
      while (diff < 0.0);
      min_in1=*in1;
      min_in2=*in2;
      min_log_c=log_c;
    }
  else
    {
      do
	if (log_c > MAX_C) 
	  return log_c;
	else
	  {
	    min_in1=*in1;
	    min_in2=*in2;
	    min_log_c=log_c;
	    log_c=10*(log_c+1);
	    slope1=ComputeLinear(proposal,log_c,in1);
	    slope2=ComputeInverseLinear(posterior,log_c,in2);
	    diff=N1*((PRECISION)(*in1) - slope1) - N2*((PRECISION)(*in2) - slope2);
	  }
      while (diff >= 0.0);
      max_in1=*in1;
      max_in2=*in2;
      max_log_c=log_c;
    }

  // At this point diff(min_log_c) >= 0 and diff(max_log_c) < 0.
  while ((min_in1 != max_in1) || (min_in2 != max_in2))
    {
      log_c=(min_log_c + max_log_c)/2.0;
      slope1=ComputeLinear(proposal,log_c,in1);
      slope2=ComputeInverseLinear(posterior,log_c,in2);
      diff=N1*((PRECISION)(*in1) - slope1) - N2*((PRECISION)(*in2) - slope2);
      if (diff > 0)
	{
	  min_in1=*in1;
	  min_in2=*in2;
	  min_log_c=log_c;
	}
      else
	{
	  max_in1=*in1;
	  max_in2=*in2;
	  max_log_c=log_c;
	}
    }

  slope1=N1*ComputeLinear(proposal,min_log_c,in1);
  intercept1=N1*(PRECISION)(*in1);
  slope2=N2*ComputeInverseLinear(posterior,min_log_c,in2);
  intercept2=N2*(PRECISION)(*in2);

  tmp=intercept1-intercept2;
  if (slope1 > 0)
    {
      tmp+=sqrt(tmp*tmp + 4*slope1*slope2);
      if (tmp >= 2.0*slope1)
	tmp=min_log_c + log(tmp) - log(2.0*slope1);
      else
	return -min_log_c;
    }
  else
    {
      if (tmp > 0)
	if (slope2 > tmp)
	  tmp=min_log_c + log(slope2) - log(tmp);
	else
	  return -min_log_c;
      else
	return -max_log_c;
    }
  return (tmp > max_log_c) ? -max_log_c : -tmp;
}
#undef MAX_C
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/


/*******************************************************************************/
/* Read/interpret posterior draws and setup elliptical/Dirichlet distributions */
/*******************************************************************************/
/*
   Assumes the file has 2 + ntheta + nq columns.  The data is arranged as:

                     posterior  likelihood  theta  q

   (1) Loops through posterior draws computing first and second moments of theta, 
       the mode of the posterior and the first and second moments of each 
       individual element of q

   (2) Sets the value of the center and scale dependent on the value of flag.
       The center will be either the mode or mean of theta and the scale will 
       satisfy scale*scale'=E[(theta-center)(theta-center)'].

   (3) Sets the values of alpha.

   The vector center, the matrix scale, and array alpha must be properly allocated of 
   the proper size.  

   If 0 < percentage_draws < 1 then the first percentage_draws of the posterior draws 
   are used to the center, the scale, and alpha.  If -1 < percentage_draws < 0, then 
   the last (1 - percentage_draws) are used to compute the center, the scale and alpha.  
   Otherwise, all the draws are used.
*/
void PosteriorDistributionInfo(FILE *f_in, int flag, TVector center, TMatrix scale, 
			       PRECISION *alpha, int *dirichlet_dims, PRECISION alpha_scale, int ndraws)
{
  int i, j, k, n, p, ntheta, nq, n_dirichlet, ntotal;
  TVector theta=(TVector)NULL, theta_sum=(TVector)NULL, b=(TVector)NULL, b_sum=(TVector)NULL, 
    b_square=(TVector)NULL, theta_mode=(TVector)NULL;
  TMatrix theta_square=(TMatrix)NULL, theta_square_tmp=(TMatrix)NULL, quadratic_form=(TMatrix)NULL;
  PRECISION max=MINUS_INFINITY, inc, tmp, sum, *x;

  // set dimensions and allocate memory
  ntheta=center ? DimV(center) : 0;
  n_dirichlet=dirichlet_dims ? dw_DimA(dirichlet_dims) : 0;
  for (i=nq=0; i < n_dirichlet; i++) nq+=dirichlet_dims[i]-1;
  ntotal=2+ntheta+nq;

  if (ntheta > 0)
    {
      theta=CreateVector(ntheta);
      InitializeVector(theta_sum=CreateVector(ntheta),0.0);
      InitializeMatrix(theta_square=CreateMatrix(ntheta,ntheta),0.0);
      theta_square_tmp=CreateMatrix(ntheta,ntheta);
      theta_mode=CreateVector(ntheta);
      quadratic_form=CreateMatrix(ntheta,ntheta);
    }

  if (nq > 0)
    {
      b=CreateVector(nq+n_dirichlet);
      b_sum=InitializeVector(CreateVector(nq+n_dirichlet),0.0);
      b_square=InitializeVector(CreateVector(nq+n_dirichlet),0.0);
    }

  // loop and accumulate 1st and 2nd non-central moments and posterior mode
  for (i=0; i < ndraws; i++)
    {
      x=dw_ReadDelimitedLine_floating(f_in,' ',REMOVE_EMPTY_FIELDS,MINUS_INFINITY);
      if (!x || (dw_DimA(x) != ntotal)) 
	{
	  printf("Error reading posterior file\n");
	  dw_exit(0);
	}
      if (ntheta > 0)
	{
	  memcpy(pElementV(theta),x+2,ntheta*sizeof(PRECISION));
	  if (x[0] > max)
	    {
	      max=x[0];
	      EquateVector(theta_mode,theta);
	    }
	  AddVV(theta_sum,theta_sum,theta);
	  OuterProduct(theta_square_tmp,theta,theta);
	  AddMM(theta_square,theta_square,theta_square_tmp);
	}

      if (nq > 0)
	{
	  for (n=2+ntheta, j=k=0; j < n_dirichlet; k+=dirichlet_dims[j], n+=dirichlet_dims[j]-1, j++)
	    {
	      memcpy(pElementV(b)+k,x+n,(dirichlet_dims[j]-1)*sizeof(PRECISION));
	      for (sum=1.0, p=dirichlet_dims[j]-2; p >= 0; p--) 
		sum-=ElementV(b,k+p);
	      ElementV(b,k+dirichlet_dims[j]-1)=(sum > 0.0) ? sum : 0.0;
	    }
	  AddVV(b_sum,b_sum,b);
	  for (p=DimV(b)-1; p >= 0; p--) 
	    ElementV(b_square,p)+=ElementV(b,p)*ElementV(b,p);
	}

      dw_FreeArray(x);
    }

  if (ntheta > 0)
    {
      // scale 1st and 2nd non-central moments
      ProductVS(theta_sum,theta_sum,1.0/(PRECISION)ndraws);
      ProductMS(theta_square,theta_square,1.0/(PRECISION)ndraws);

      // set center and scale using flag
      if (flag & USE_MODE)
	{
	  EquateVector(center,theta_mode);
	  OuterProduct(theta_square_tmp,theta_mode,theta_mode);
	  AddMM(theta_square,theta_square,theta_square_tmp);
	  OuterProduct(theta_square_tmp,theta_sum,theta_mode);
	  SubtractMM(theta_square,theta_square,theta_square_tmp);
	  OuterProduct(theta_square_tmp,theta_mode,theta_sum);
	  SubtractMM(theta_square,theta_square,theta_square_tmp);
	  CholeskyLT(scale,theta_square);
	  Transpose(scale,scale);
	}
      else
	{
	  EquateVector(center,theta_sum);
	  OuterProduct(theta_square_tmp,theta_sum,theta_sum);
	  SubtractMM(theta_square,theta_square,theta_square_tmp);
	  CholeskyLT(scale,theta_square);
	  Transpose(scale,scale);
	}
    }

  // compute alpha
  if (nq > 0)
    {
      // scale 1st and 2nd non-central moments
      ProductVS(b_sum,b_sum,1.0/(PRECISION)ndraws);
      ProductVS(b_square,b,1.0/(PRECISION)ndraws);

      // compute alpha
      for (k=i=0; k < n_dirichlet; i+=dirichlet_dims[k], k++)
	{
	  for (max=0.0, j=dirichlet_dims[k]-1; j >= 0; j--)
	    if ((tmp=ElementV(b_sum,i+j)*(1.0-ElementV(b_sum,i+j))
		 /(ElementV(b_square,i+j) - ElementV(b_sum,i+j)*ElementV(b_sum,i+j))) > max) max=tmp;
	  max-=1.0;
	  for (inc=0.0, j=dirichlet_dims[k]-1; j >= 0; j--)
	    if ((tmp=1.1 - max*ElementV(b_sum,i+j)) > inc) inc=tmp;
	  for (j=dirichlet_dims[k]-1; j >= 0; j--)
	    alpha[i+j]=alpha_scale*max*ElementV(b_sum,i+j)+inc;
	}
    }
  else
    if (n_dirichlet > 0)
      for (i=0; i < n_dirichlet; i++) alpha[i]=0.0;

  if (ntheta > 0)
    {
      FreeVector(theta);
      FreeVector(theta_sum);
      FreeMatrix(theta_square);
      FreeMatrix(theta_square_tmp);
      FreeVector(theta_mode);
      FreeMatrix(quadratic_form);
    }
  if (nq > 0)
    {
      FreeVector(b);
      FreeVector(b_sum);
      FreeVector(b_square);
    }
}

/*
   Assumes the file has 2 + ntheta + nq columns.  The data is arranged as:

                     posterior  likelihood  theta  q

   Creates and returns a vector containing the radius of each draw of theta,
   computed used the center and scale.
*/
TVector PosteriorRadius(FILE *f_in, TVector center, TMatrix scale, int ndraws)
{
  int i, ntheta, ntotal;
  TVector  theta, Radii=(TVector)NULL;
  TMatrix quadratic_form;
  PRECISION *x;

  ntheta=center ? DimV(center) : 0;
  ntotal=ntheta+2;

  if (ntheta > 0)
    {
      theta=CreateVector(ntheta);
      quadratic_form=CreateMatrix(ntheta,ntheta);

      Radii=CreateVector(ndraws);
      quadratic_form=ProductTransposeMM((TMatrix)NULL,scale,scale);
      Inverse_LU(quadratic_form,quadratic_form);
      ForceSymmetric(quadratic_form);
     
      for (i=0; i < ndraws; i++)
	{
	  x=dw_ReadDelimitedLine_floating(f_in,' ',REMOVE_EMPTY_FIELDS,MINUS_INFINITY);
	  if (!x || (dw_DimA(x) < ntotal)) 
	    {
	      printf("Error reading posterior file\n");
	      dw_exit(0);
	    }
	  memcpy(pElementV(theta),x+2,ntheta*sizeof(PRECISION));
	  SubtractVV(theta,theta,center);
	  ElementV(Radii,i)=sqrt(InnerProduct(theta,theta,quadratic_form));
	  dw_FreeArray(x);
	}

      FreeVector(theta);
      FreeMatrix(quadratic_form);
    }

  return Radii;
}

TElliptical* CreateEllipticalFromPosterior_TruncatedGaussian(TVector R, int dim, TVector center, TMatrix scale, 
							     PRECISION p_lo, PRECISION p_hi)
{
  TElliptical *elliptical=(TElliptical*)NULL;
  PRECISION a, b;
  TMatrix V;
  int i;

  if (dim > 0)
    {
      SortVectorAscending(R,R);

      i=floor(p_lo*(PRECISION)(DimV(R)-1));
      a=(i < DimV(R)-1) ? 0.5*(ElementV(R,i+1) + ElementV(R,i)) : ElementV(R,i);
      i=floor(p_hi*(PRECISION)(DimV(R)-1));
      b=(i < DimV(R)-1) ? 0.5*(ElementV(R,i+1) + ElementV(R,i)) : ElementV(R,i);

      V=ProductTransposeMM((TMatrix)NULL,scale,scale);
      elliptical=CreateElliptical_TruncatedGaussian(dim,center,V,a,b);
      FreeMatrix(V);
    }

  return elliptical;
}

TElliptical* CreateEllipticalFromPosterior_Gaussian(TVector R, int dim, TVector center, TMatrix scale)
{
  TElliptical *elliptical=(TElliptical*)NULL;
  TMatrix variance;
  if (dim > 0)
    {
      elliptical=CreateElliptical_Gaussian(dim,center,variance=ProductTransposeMM((TMatrix)NULL,scale,scale));
      FreeMatrix(variance);
    }
  return elliptical;
}

static PRECISION GetPower_truncatedpower(int dim, PRECISION lower_bound, PRECISION upper_bound)
{
  PRECISION lo=0.0001, hi=1.0, mid;
  int i;
  if (VarianceScale_TruncatedPower(dim,lower_bound,upper_bound,lo) > 1.0)
    return lo;
  for (i=0; i < 20; i++)
    if (VarianceScale_TruncatedPower(dim,lower_bound,upper_bound,hi) < 1.0)
      {
	lo=hi;
	hi*=2.0;
      }
    else
      {
	for (i=0; i < 30; i++)
	  {
	    mid=0.5*(lo+hi);
	    if (VarianceScale_TruncatedPower(dim,lower_bound,upper_bound,mid) < 1.0)
	      lo=mid;
	    else
	      hi=mid;
	  }
	return mid;
      }
  return hi;
}

TElliptical* CreateEllipticalFromPosterior_TruncatedPower(TVector R, int dim, TVector center, TMatrix scale, 
							  PRECISION p_lo, PRECISION p_hi)
{
  TElliptical *elliptical=(TElliptical*)NULL;
  PRECISION a, b, power;
  int i;

  if (dim > 0)
    {
      SortVectorAscending(R,R);

      i=floor(p_lo*(PRECISION)(DimV(R)-1));
      a=(i < DimV(R)-1) ? 0.5*(ElementV(R,i+1) + ElementV(R,i)) : ElementV(R,i);
      i=floor(p_hi*(PRECISION)(DimV(R)-1));
      b=(i < DimV(R)-1) ? 0.5*(ElementV(R,i+1) + ElementV(R,i)) : ElementV(R,i);
      power=GetPower_truncatedpower(dim,a,b);
      
      // The code below uses the old method to choosing the power and b.  The new 
      // method chooses the power by trying to match the scale of the variance.
      /* i=floor(0.10*(PRECISION)DimV(R)); */
      /* a=(i > 0) ? 0.5*(sqrt(ElementV(R,i-1)) + sqrt(ElementV(R,i))) : sqrt(ElementV(R,i)); */
      /* i=floor(0.90*(PRECISION)DimV(R)); */
      /* b=(i > 0) ? 0.5*(sqrt(ElementV(R,i-1)) + sqrt(ElementV(R,i))) : sqrt(ElementV(R,i)); */
      /* power=log(0.10/0.90)/log(a/b); */
      /* b/=pow(0.90,1/power); */
      /* i=floor(0.10*(PRECISION)DimV(R)); */
      /* a=(i > 0) ? 0.5*(ElementV(R,i-1) + ElementV(R,i)) : ElementV(R,i); */
      /* i=floor(0.90*(PRECISION)DimV(R)); */
      /* b=(i > 0) ? 0.5*(ElementV(R,i-1) + ElementV(R,i)) : ElementV(R,i); */
      /* power=log(0.10/0.90)/log(a/b); */
      /* b/=pow(0.90,1/power); */

      elliptical=CreateElliptical_TruncatedPower(dim,center,scale,a,b,power);
    }

  return elliptical;
}

TElliptical* CreateEllipticalFromPosterior_Power(TVector R, int dim, TVector center, TMatrix scale, PRECISION p_hi)
{
  TElliptical *elliptical=(TElliptical*)NULL;
  PRECISION b, power;
  int i;

  if (dim > 0)
    {
      SortVectorAscending(R,R);

      i=floor(p_hi*(PRECISION)(DimV(R)-1));
      b=(i < DimV(R)-1) ? 0.5*(ElementV(R,i+1) + ElementV(R,i)) : ElementV(R,i);
      power=GetPower_truncatedpower(dim,0.0,b);

      // The code below uses the old method to choosing the power and b.  The new 
      // method chooses the power by trying to match the scale of the variance.
      /* i=floor(0.20*(PRECISION)DimV(R)); */
      /* PRECISION a = (i > 0) ? 0.5*(sqrt(ElementV(R,i-1)) + sqrt(ElementV(R,i))) : sqrt(ElementV(R,i)); */
      /* i=floor(0.80*(PRECISION)DimV(R)); */
      /* b=(i > 0) ? 0.5*(sqrt(ElementV(R,i-1)) + sqrt(ElementV(R,i))) : sqrt(ElementV(R,i)); */
      /* power=log(0.20/0.80)/log(a/b); */
      /* b/=pow(0.80,1/power); */
      /* i=floor(0.20*(PRECISION)DimV(R)); */
      /* PRECISION a = (i > 0) ? 0.5*(ElementV(R,i-1) + ElementV(R,i)) : ElementV(R,i); */
      /* i=floor(0.80*(PRECISION)DimV(R)); */
      /* b=(i > 0) ? 0.5*(ElementV(R,i-1) + ElementV(R,i)) : ElementV(R,i); */
      /* power=log(0.20/0.80)/log(a/b); */
      /* b/=pow(0.80,1/power); */

      elliptical=CreateElliptical_Power(dim,center,scale,b,power);
    }

  return elliptical;
}

TElliptical* CreateEllipticalFromPosterior_Uniform(TVector R, int dim, TVector center, TMatrix scale, PRECISION p_lo, PRECISION p_hi)
{
  TElliptical *elliptical=(TElliptical*)NULL;
  PRECISION a, b;
  int i;

  if (dim > 0)
    {
      SortVectorAscending(R,R);

      i=floor(p_lo*(PRECISION)(DimV(R)-1));
      a=(i < DimV(R)-1) ? 0.5*(ElementV(R,i+1) + ElementV(R,i)) : ElementV(R,i);
      i=floor(p_hi*(PRECISION)(DimV(R)-1));
      b=(i < DimV(R)-1) ? 0.5*(ElementV(R,i+1) + ElementV(R,i)) : ElementV(R,i);

      elliptical=CreateElliptical_Uniform(dim,center,scale,a,b);
    }

  return elliptical;
}

TElliptical* CreateEllipticalFromPosterior_Step(TVector R, int dim, TVector center, TMatrix scale, PRECISION p_lo, PRECISION p_hi)
{
  TElliptical *elliptical=(TElliptical*)NULL;
  PRECISION *table, inc, x, y;
  int i, j, k, m=30;

  if (dim > 0)
    {
      table=(PRECISION*)dw_malloc((m+1)*sizeof(PRECISION));

      SortVectorAscending(R,R);

      for (k=m; k >= 1; k--)
	{
	  inc=(p_hi-p_lo)/(PRECISION)k;
	  for (x=p_lo, j=0; j <= k; x+=inc, j++)
	    {
	      i=floor(y=x*(PRECISION)(DimV(R)-1));
	      if (i >= DimV(R)-1)
		table[j]=ElementV(R,DimV(R)-1);
	      else
		table[j]=(1.0-y+i)*ElementV(R,i) + (y-i)*ElementV(R,i+1);
	      //table[j]=(i > 0) ? 0.5*(ElementV(R,i-1) + ElementV(R,i)) : ElementV(R,i);
	    }
	  for (j=1; j <= k; j++)
	    if (table[j] <= table[j-1]) break;
	  if (j > k) break;
	}

      if (k <= 0)
	{
	  dw_free(table);
	  printf("Not enough variation in the posterior draws to form proposal\n");
	  dw_exit(0);
	}

      elliptical=CreateElliptical_Step(dim,center,scale,table,k);
      dw_free(table);
    }

  return elliptical;
}
/*******************************************************************************/
/*******************************************************************************/


/*******************************************************************************/
/*********** Create proposal and posterior matrices of log densities ***********/
/*******************************************************************************/
/*
   Assumes:
     ndraws         : Number of draws from proposal to create
     model          : Valid pointer to TStateModel structure
     elliptical     : Valid pointer to TElliptical structure
     alpha          : Array of parameters for the independent Dirichlet 
                      distributions.
     dirichlet_dims : integer array of dimensions of the independent Dirichlet
                      distributions.

   Results:
     Draws theta from the elliptical distribution and q from independent 
     Dirichlet distributions.  Computes the log density, properly scaled, of the 
     proposal distribution and stores this in the first column of proposal.  
     Computes the log posterior (likelihood times prior) with the states 
     integerated out, and stores this in the second column of proposal.

   Notes:
     The integer array dirichlet_dims should be created with the routine
     CreateDirichletDimensions().
*/
TMatrix CreateProposal(int ndraws, TStateModel* model, TElliptical *elliptical, PRECISION* alpha, int *dirichlet_dims)
{
  TMatrix proposal;
  PRECISION logdensity, *q=(PRECISION*)NULL, *theta=(PRECISION*)NULL;
  int i, ntheta, nq, n_dirichlet, period, count;

  if (ndraws <= 0) return (TMatrix)NULL;

  // create proposal
  proposal=CreateMatrix(ndraws,2);

  // set dimensions and allocate memory
  ntheta=elliptical ? elliptical->dim : 0;
  n_dirichlet=dirichlet_dims ? dw_DimA(dirichlet_dims) : 0;
  for (i=nq=0; i < n_dirichlet; i++) nq+=dirichlet_dims[i]-1;
  if (ntheta) theta=(PRECISION*)dw_malloc(ntheta*sizeof(PRECISION));  
  if (nq) q=(PRECISION*)dw_malloc(nq*sizeof(PRECISION));

  period=ndraws/50;
  for (count=period, i=0;  i < ndraws; i++)
    {
      // draw theta from elliptical and compute log density
      logdensity=(theta) ? LogDensityElliptical_Radius(DrawElliptical(theta,elliptical),elliptical) : 0.0;

      // draw q from Dirichet and compute log density
      if (q)
	{
	  DrawIndependentDirichlet_free(q,alpha,dirichlet_dims,n_dirichlet);
	  logdensity+=LogIndependentDirichlet_pdf(q,alpha,dirichlet_dims,n_dirichlet);
	}

      // store log density of proposal
      ElementM(proposal,i,0)=logdensity;

      // force free parameters into model and store log density of posterior
      if (theta) ConvertFreeParametersToTheta(model,theta);
      if (q) ConvertFreeParametersToQ(model,q);
      ElementM(proposal,i,1)=LogPosterior_StatesIntegratedOut(model); //printf("%le\n",ElementM(proposal,i,1));

      // Output status
      if (i == count)
	{
	  printf("%d draws out of %d\n",count,ndraws);
	  count+=period;
#ifdef OCTAVE_MEX_FILE
      OCTAVE_QUIT;
#elif defined(MATLAB_MEX_FILE)
      if (utIsInterruptPending())
        {
          mexPrintf("\n\n** Ctrl-C detected, quitting...\n");
          dw_exit(0);
        }
#endif
	}
    }

  // clean up
  if (theta) dw_free(theta);
  if (q) dw_free(q);

  return proposal;
}

/*
    Assumes:
      Posterior file has at least ndraws rows and 2+ntheta+nq columns
        Column  0                      = log posterior density of (theta,q).
        Column  1                      = log likelihood of (theta,q).
        Columns 2 : 1+ntheta           = theta.
        Columns 2+ntheta : 1+ntheta+nq = q.

    Returns:
      ndraws x 2 matrix.  The first column is the log of the proposal density of the
      posterior draw and the second column is the log of the posterior density of
      the posterior draw.

    Notes:
      The parameters are theta and q.  The proposal density is independent across
      these with independent Dirichlet distributions on q and an elliptical 
      density on theta.
*/
TMatrix CreatePosterior(FILE *f_in, TElliptical *elliptical, PRECISION* alpha, int *dirichlet_dims, int ndraws)
{
  int i, ntheta, nq, n_dirichlet, ntotal;
  PRECISION logdensity, *x;
  TMatrix posterior;

  // set dimensions and allocate memory
  posterior=CreateMatrix(ndraws,2);
  ntheta=elliptical ? elliptical->dim : 0;
  n_dirichlet=dirichlet_dims ? dw_DimA(dirichlet_dims) : 0;
  for (i=nq=0; i < n_dirichlet; i++) nq+=dirichlet_dims[i]-1;
  ntotal=2+ntheta+nq;

  for (i=0; i < ndraws; i++)
    {
      x=dw_ReadDelimitedLine_floating(f_in,' ',REMOVE_EMPTY_FIELDS,MINUS_INFINITY);
      if (!x || (dw_DimA(x) < ntotal)) 
	{
	  printf("Error reading posterior file\n");
	  dw_exit(0);
	}
      logdensity=(ntheta > 0) ? LogDensityElliptical_Draw(x+2,elliptical) : 0.0; 
      if (nq > 0) logdensity+=LogIndependentDirichlet_pdf(x+2+ntheta,alpha,dirichlet_dims,n_dirichlet);
      ElementM(posterior,i,0)=logdensity;
      ElementM(posterior,i,1)=x[0];
      dw_FreeArray(x);
    } 

  return posterior;
}

int ModifyUsingSWZ(TMatrix *modified_proposal, TMatrix *modified_posterior, TMatrix proposal, TMatrix posterior, PRECISION cut)
{
  int i, j, count;
  PRECISION log_p;

  // Number proposal satisfying cut
  for (count=0, i=RowM(proposal)-1; i >= 0; i--)
    if (ElementM(proposal,i,1) >= cut) count++;

  // Abort if none satisfy
  if (count == 0) return 0;

  // Compute log probability of proposal satisfying cut
  log_p=log((PRECISION)count/(PRECISION)RowM(proposal));

  // Create matrices if necessary
  if (!(*modified_proposal) || (RowM(*modified_proposal) != count))
    {
      if (*modified_proposal) FreeMatrix(*modified_proposal);
      *modified_proposal=CreateMatrix(count,2);
    }
  if (!(*modified_posterior) || (RowM(*modified_posterior) != RowM(posterior)))
    {
      if (*modified_posterior) FreeMatrix(*modified_posterior);
      *modified_posterior=CreateMatrix(RowM(posterior),2);
    }

  // Set modified posterior
  for (i=RowM(posterior)-1; i >= 0; i--)
    {
      if (ElementM(posterior,i,1) > cut)
	ElementM(*modified_posterior,i,0)=ElementM(posterior,i,0)-log_p;
      else
	ElementM(*modified_posterior,i,0)=MINUS_INFINITY;
      ElementM(*modified_posterior,i,1)=ElementM(posterior,i,1);
    }

  // Set modified proposal
  for (i=j=0; i < RowM(proposal); i++)
    if (ElementM(proposal,i,1) >= cut)
      {
	ElementM(*modified_proposal,j,0)=ElementM(proposal,i,0)-log_p;
	ElementM(*modified_proposal,j,1)=ElementM(proposal,i,1);
      }

  // Return number satisfing cut
  return count;
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/


/*******************************************************************************/
/************************ Setup Dirichlet distributions ************************/
/*******************************************************************************/
/*
   Creates integer array that give the size of the Dirichet random variables 
   in q.
*/
static int sv_NumberDirichletDistributions(TMarkovStateVariable *sv)
{
  int i, n_dirichlet;
  if (sv->n_state_variables > 0)
    {
      for (i=n_dirichlet=0; i < sv->n_state_variables; i++)
	n_dirichlet+=sv_NumberDirichletDistributions(sv->state_variable[i]);
      return n_dirichlet;
    }
  else
    return dw_DimA(((TDirichletRestrictions*)(sv->info))->DirichletDim);
}
static int* sv_DirichletDimensions(int *dirichlet_dims, TMarkovStateVariable *sv)
{
  int i, n;
  if (sv->n_state_variables > 0)
    for (i=0; i < sv->n_state_variables; i++)
      dirichlet_dims=sv_DirichletDimensions(dirichlet_dims,sv->state_variable[i]);
  else
    {
      n=dw_DimA(((TDirichletRestrictions*)(sv->info))->DirichletDim);
      memcpy(dirichlet_dims,((TDirichletRestrictions*)(sv->info))->DirichletDim,n*sizeof(int));
      dirichlet_dims+=n;
    }
  return dirichlet_dims;
}
int* CreateDirichletDimensions(TStateModel* model)
{
  int n_dirichlet=sv_NumberDirichletDistributions(model->sv);
  int *dirichlet_dims=(n_dirichlet > 0) ? dw_CreateArray_int(n_dirichlet) : (int*)NULL;
  sv_DirichletDimensions(dirichlet_dims,model->sv);
  return dirichlet_dims;
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/


/*******************************************************************************/
/****************************** Elliptical plots *******************************/
/*******************************************************************************/
void GraphCummulativeDensities(FILE *f, char* filename, TVector R, TElliptical *elliptical)
{
  PRECISION min, max, inc, r;
  int d=100, i, j, k=DimV(R), count=50000, n;
  TVector v;
  FILE *f_out;

  if (f_out=f ? f : fopen(filename,"wt"))
    {
      SortVectorAscending(R,R);
      min=ElementV(R,0);
      max=ElementV(R,k-1);
      inc=(max-min)/(PRECISION)(d-1);

      fprintf(f_out,"radius,posterior,proposal\n");
      if (elliptical->cummulative_radius)
	for (r=min, i=j=0; j < d; r+=inc, j++)
	  {
	    for ( ; i < k; i++) 
	      if (ElementV(R,i) >= r) break;
	    fprintf(f_out,"%lf,%lf,%lf\n",r,(double)i/(double)k,CummulativeDensityElliptical_Radius(r,elliptical));
	  }
      else
	{
	  // Simulate from elliptical
	  v=CreateVector(count);
	  for (i=0; i < count; i++) ElementV(v,i)=DrawElliptical((PRECISION*)NULL,elliptical);
	  SortVectorAscending(v,v);

	  for (r=min, n=i=j=0; j < d; r+=inc, j++)
	    {
	      for ( ; i < k; i++) 
		if (ElementV(R,i) >= r) break;
	      for ( ; n < count; n++)
		if (ElementV(v,n) >= r) break;
	      fprintf(f_out,"%lf,%lf,%lf\n",r,(double)i/(double)k,(double)n/(double)count);
	    }

	  FreeVector(v);
	}

      if (!f) fclose(f_out);
    }
  else
    printf("Unable to open %s\n",filename);
}

/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*
   Computes marginal data density from posterior draws.  Returns one upon success
   zero upon failure.

   Command line parameters
     -t  
        filename tag
     -ft 
        filename tag -- supersedes -t
     -outtag
        filename tag -- supersedes -t and -ft
     -pf  
        posterior draws filename (default = simulation_<tag>.out)
     -pt 
        proposal type (1=gaussian, 2=power, 3=truncated power (default), 4=step, 5=truncated gaussian, 6=uniform)
     -d 
        number proposal draws (default = 100,000)
     -ndraws
        number proposal draws. Superseeds -d. (default = 100,000)
     -mode 
        use posterior mode as center (default = mode)
     -mean
        use posterior mean as center (default = mode)
     -of 
        output filename (default = mdd_t<proposal type>_<tag>.out)
     -l  
        Lower cutoff for in terms of probability. Used by truncated power, truncated gaussian, step, 
        and uniform. (default=0.1)
     -h 
        Upper cutoff for in terms of probability. Used by power, truncated power, truncated gaussian
        step, and uniform. (default=0.9)
     -graph 
        Produce output suitable for graphing the marginal cummulative densities of the radius of the
        posterior and elliptical distributions.  The marginal data density is not computed.
     -print 
        Prints the matrices posterior and proposal
     -append
        Appends proposal draws to those previously made.  If the posterior draws have changed in any
        way, then this option must not be used.  The filename for the proposal draws is
        proposal_t<proposal type>_<tag>.out.
     -percentage_draws 
        If between 0 and 1, the first percentage_draws of the posterior draws are used to compute the 
        center, scale and alpha and the last (1-percentage_draws) of the posterior draws are used to
        compute the marginal data density. (default=0.20)
*/
int dw_marginal_data_density_command_line(int nargs, char **args, TStateModel *model, int generator_init)
{
  TMatrix scale=(TMatrix)NULL, proposal=(TMatrix)NULL, posterior=(TMatrix)NULL, new_proposal, s_proposal, s_posterior;
  TVector center=(TVector)NULL, R=(TVector)NULL; /*cuts=(TVector)NULL, cuts1=(TVector)NULL;*/
  char *filename=(char*)NULL, *tag, *out_filename, *fmt;
  int i, j, ntheta=NumberFreeParametersTheta(model), nq=NumberFreeParametersQ(model), flag, *dirichlet_dims=(int*)NULL, 
    proposal_type, ndraws_proposal, /*n_cuts=10,*/ in_P1, in_P2, rtrn=0, ndraws_posterior, ndraws_info,
    begin_time, end_time, cuts[9]={1000,500,100,50,40,30,20,10,1};
  PRECISION alpha_scale=1.5, *alpha=(PRECISION*)NULL, mdd, p_lo, p_hi, **proposal_previous, I, percentage_draws, x;
  TElliptical *elliptical=(TElliptical*)NULL;
  FILE *f_out, *f_in;

  // Initial generator - pass 0 to initialize from clock
  dw_initialize_generator(generator_init);

  // Get tag from command line
  tag=dw_ParseString(nargs,args,'t',"notag");
  tag=dw_ParseString_String(nargs,args,"ft",tag);
  tag=dw_ParseString_String(nargs,args,"outtag",tag);

  // timings
  begin_time=time((time_t*)NULL);

  // Posterior draws file
  printf("Processing posterior draws\n");
  if (filename=dw_ParseString_String(nargs,args,"pf",(char*)NULL))
    {
      if (!(f_in=fopen(filename,"rt"))) 
	{
	  printf("ComputeMarginalDataDensity_command_line(): Unable to open %s\n",filename);
	  return 0;
	}
    }
  else
    {
      fmt="simulation_%s.out";
      sprintf(filename=(char*)dw_malloc(strlen(fmt) + strlen(tag) - 1),fmt,tag);
      if (!(f_in=fopen(filename,"rt"))) 
	{
	  printf("ComputeMarginalDataDensity_command_line(): Unable to open %s\n",filename);
	  dw_free(filename);
	  return 0;
	}
      dw_free(filename);
    }

  // Number of posterior draws
  ndraws_posterior=dw_NumberLines(f_in,(char*)NULL);

  // Get center, scale, and alpha from posterior
  flag=(dw_FindArgument_String(nargs,args,"mean") != -1) ? USE_MEAN : USE_MODE;
  center=CreateVector(ntheta);
  scale=CreateMatrix(ntheta,ntheta);
  dirichlet_dims=CreateDirichletDimensions(model);
  alpha=(PRECISION*)dw_malloc((nq+dw_DimA(dirichlet_dims))*sizeof(PRECISION));
  percentage_draws=dw_ParseFloating_String(nargs,args,"percentage_draws",0.20);
  ndraws_info=percentage_draws*ndraws_posterior;
  if (ndraws_info > ndraws_posterior) ndraws_info=ndraws_posterior;

  // Use first percentage draws of posterior draws to form center and scale
  PosteriorDistributionInfo(f_in,flag,center,scale,alpha,dirichlet_dims,alpha_scale,ndraws_info); 

  // Use first percentage draws of posterior draws to form center and scale
  fseek(f_in,0,SEEK_SET);
  R=PosteriorRadius(f_in,center,scale,ndraws_info);                                                

  // Create proposal distribution
  //ProductMS(scale,scale.2.0);
  proposal_type=dw_ParseInteger_String(nargs,args,"pt",3);
  p_lo=dw_ParseFloating_String(nargs,args,"l",0.1);
  p_hi=dw_ParseFloating_String(nargs,args,"h",0.9);
  switch (proposal_type)
    {
    case USE_GAUSSIAN:
      printf("Using gaussian proposal\n");
      elliptical=CreateEllipticalFromPosterior_Gaussian(R,ntheta,center,scale);
      break;
    case USE_POWER:
      printf("Using power proposal\n");
      elliptical=CreateEllipticalFromPosterior_Power(R,ntheta,center,scale,p_hi);
      break;
    case USE_TRUNCATED_POWER:
      printf("Using truncated power proposal\n");
      elliptical=CreateEllipticalFromPosterior_TruncatedPower(R,ntheta,center,scale,p_lo,p_hi);
      break;
    case USE_STEP:
      printf("Using step proposal\n");
      elliptical=CreateEllipticalFromPosterior_Step(R,ntheta,center,scale,p_lo,p_hi);
      break;
    case USE_TRUNCATED_GAUSSIAN:
      printf("Using truncated proposal\n");
      elliptical=CreateEllipticalFromPosterior_TruncatedGaussian(R,ntheta,center,scale,p_lo,p_hi);
      break;
    case USE_UNIFORM:
      printf("Using uniform proposal\n");
      elliptical=CreateEllipticalFromPosterior_Uniform(R,ntheta,center,scale,p_lo,p_hi);
      break;
    default:
      printf("\nComputeMarginalDataDensity_command_line(): Unknown proposal density."
	     "\n  Usage: -pt <proposal type>"
	     "\n              1: gaussian"
	     "\n              2: power              (-h high probability cutoff)"
	     "\n              3: truncated power    (-l or -h low or high probability cutoff)"
	     "\n              4: step               (-l or -h low or high probability cutoff)"
	     "\n              5: truncated gaussian (-l or -h low or high probability cutoff)"
             "\n              6: uniform            (-l or -h low or high probability cutoff)"
	     "\n\n");
      goto CLEAN_UP;
      break;
    }

  // Print full elliptical type info and stop
  /* PrintEllipticalInfo_full(stdout,elliptical); */
  /* dw_exit(0); */

  // Open output file
  if (tag)
    {
      fmt="mdd_t%d_%s.out";
      sprintf(filename=(char*)dw_malloc(strlen(fmt) + strlen(tag) - 1),fmt,proposal_type,tag);
    }
  else 
    {
      fmt="mdd_t%d.out";
      sprintf(filename=(char*)dw_malloc(strlen(fmt) + 1),fmt,proposal_type);
    }
  out_filename=dw_ParseString_String(nargs,args,"of",filename);
  f_out=fopen(out_filename,"wt");
  if (filename) dw_free(filename);

  // Plot marginal radius cummulative distribution
  if (dw_FindArgument_String(nargs,args,"graph") != -1)
    {
      printf("Computing cumulative densities\n");
      GraphCummulativeDensities(f_out,(char*)NULL,R,elliptical);
      fclose(f_out);
      rtrn=1;
      goto CLEAN_UP;
    }

  // Compute Proposal and Posterior matrices

  // Use last (1.0 - percentage draws) of posterior draws to form posterior matrix, unless percentage_draws == 1, in which case all draws are used
  if (ndraws_info == ndraws_posterior)
    fseek(f_in,0,SEEK_SET);
  else
    ndraws_posterior-=ndraws_info;
  posterior=CreatePosterior(f_in,elliptical,alpha,dirichlet_dims,ndraws_posterior);

  // done with posterior file
  fclose(f_in);

  // timings
  end_time=time((time_t*)NULL);
  printf("Elapsed Time: %d seconds\n",end_time - begin_time);
                       
  printf("Creating proposal draws\n");
  ndraws_proposal=dw_ParseInteger_String(nargs,args,"d",100000);
  proposal=CreateProposal(ndraws_proposal,model,elliptical,alpha,dirichlet_dims);
  if (dw_FindArgument_String(nargs,args,"append") != -1)
    {
      if (tag)
	{
	  fmt="proposal_t%d_%s.out";
	  sprintf(filename=(char*)dw_malloc(strlen(fmt) + strlen(tag) - 1),fmt,proposal_type,tag);
	}
      else 
	{
	  fmt="proposal_t%d.out";
	  sprintf(filename=(char*)dw_malloc(strlen(fmt) + 1),fmt,proposal_type);
	}
      proposal_previous=dw_ReadDelimitedFile_floating((FILE*)NULL,filename,' ',REMOVE_EMPTY_FIELDS,-1.0e300);
      dw_free(filename);
      if (proposal_previous)
	{
	  new_proposal=CreateMatrix((proposal ? RowM(proposal) : 0)+dw_DimA(proposal_previous),2);
	  for (i=dw_DimA(proposal_previous)-1; i >= 0; i--)
	    { ElementM(new_proposal,i,0)=proposal_previous[i][0]; ElementM(new_proposal,i,1)=proposal_previous[i][1]; }
	  if (proposal) InsertSubMatrix(new_proposal,proposal,dw_DimA(proposal_previous),0,0,0,RowM(proposal),2);
	  dw_FreeArray(proposal_previous);
	  FreeMatrix(proposal);
	  proposal=new_proposal;
	}
    }

  // timings
  end_time=time((time_t*)NULL);
  printf("Elapsed Time: %d seconds\n",end_time - begin_time);

  if (!proposal  || ! posterior)
    {
      printf("No proposal or posterior draws\n");
      fclose(f_out);
      goto CLEAN_UP;
    }

  // Write proposal information
  if (tag) fprintf(f_out,"tag: %s\n",tag);
  PrintEllipticalInfo(f_out,elliptical);
  fprintf(f_out,"\n");
  printf("nproposal = %d  nposterior = %d\n",RowM(proposal),RowM(posterior));
  fprintf(f_out,"nproposal = %d  nposterior = %d\n",RowM(proposal),RowM(posterior));
 
  // Waggoner-Zha
  printf("\nWaggoner-Zha\n");
  fprintf(f_out,"\nWaggoner-Zha\n");

  // No cuts
  mdd=ComputeLogMarginalDensity_WaggonerZha(proposal,posterior,MINUS_INFINITY,PLUS_INFINITY,&in_P1,&in_P2,&I);
  printf("log(mdd) = %le   log(cut) = minus infinity  in_proposal = %d   in_posterior = %d\n",mdd,in_P1,in_P2);
  fprintf(f_out,"log(mdd) = %le   log(cut) = minus infinity in_proposal = %d   in_posterior = %d\n",mdd,in_P1,in_P2);

  s_proposal=SortMatrixRowsDescending((TMatrix)NULL,proposal,1);
  s_posterior=SortMatrixRowsDescending((TMatrix)NULL,posterior,1);
  if (ElementM(s_proposal,0,1) > ElementM(s_posterior,RowM(s_posterior)-1,1))
    if (ElementM(s_proposal,(RowM(s_proposal) > 29) ? 29 : RowM(s_proposal)-1,1) > ElementM(s_posterior,(5*(RowM(s_posterior)-1))/100,1))
      {
	for (j=40; j >= 5; j-=1)
	  {
	    x=ElementM(s_posterior,(j*(RowM(s_posterior)-1))/100,1);
	    mdd=ComputeLogMarginalDensity_WaggonerZha(proposal,posterior,x,PLUS_INFINITY,&in_P1,&in_P2,&I);
	    printf("log(mdd) = %le   log(cut) = %le  in_proposal = %d   in_posterior = %d\n",mdd,x,in_P1,in_P2);
	    fprintf(f_out,"log(mdd) = %le   log(cut) = %le  in_proposal = %d   in_posterior = %d\n",mdd,x,in_P1,in_P2);
	  }
      }
    else
      {	  
	for (i=0; (i+1 < RowM(s_proposal)) && (ElementM(s_proposal,i+1,1) >= ElementM(s_posterior,RowM(s_posterior)-1,1)); i++);

	x=ElementM(s_proposal,i,1);
	mdd=ComputeLogMarginalDensity_WaggonerZha(proposal,posterior,x,PLUS_INFINITY,&in_P1,&in_P2,&I);
	printf("log(mdd) = %le   log(cut) = %le  in_proposal = %d   in_posterior = %d\n",mdd,x,in_P1,in_P2);
	fprintf(f_out,"log(mdd) = %le   log(cut) = %le  in_proposal = %d   in_posterior = %d\n",mdd,x,in_P1,in_P2);
	for (j=0; j < 9; j++)
	  if (i >= cuts[j])
	    {
	      x=0.5*(ElementM(s_proposal,cuts[j]-1,1)+ElementM(s_proposal,cuts[j],1));
	      if (x <= ElementM(s_posterior,0,1))
		{
		  mdd=ComputeLogMarginalDensity_WaggonerZha(proposal,posterior,x,PLUS_INFINITY,&in_P1,&in_P2,&I);
		  printf("log(mdd) = %le   log(cut) = %le  in_proposal = %d   in_posterior = %d\n",mdd,x,in_P1,in_P2);
		  fprintf(f_out,"log(mdd) = %le   log(cut) = %le  in_proposal = %d   in_posterior = %d\n",mdd,x,in_P1,in_P2);
		}
	    }
      }
  else
    printf("Unable to compute Waggoner-Zha method for any cutoff value.  Try increasing number of proposal draws.\n");

  // Compute marginal data density - Muller's method
  mdd=ComputeLogMarginalDensity_Mueller(proposal,posterior,&in_P1,&in_P2);
  printf("\nMuller log(mdd) = %le\nnproposal = %d  nposterior = %d   in_P1 = %d   in_P2 = %d\n",mdd,RowM(proposal),RowM(posterior),in_P1,in_P2);
  fprintf(f_out,"\nMuller log(mdd) = %le\nnproposal = %d  nposterior = %d   in_P1 = %d   in_P2 = %d\n",mdd,RowM(proposal),RowM(posterior),in_P1,in_P2);

  // Print explanation of in_P1 and in_P2.  
  printf("\n  in_P1 is the number of proposal draws such that the density of the proposal is greater than"
	 "\n  or equal to the density (properly scaled!) of the posterior.  in_P2 is the number of"
	 "\n  posterior draws such that the density (properly scaled!) of the posterior is greater than"
	 "\n  or equal to the density of the proposal.  Both numbers should somewhat larger than zero."
         "\n  Ideally both should also be somewhat less than the maximum possible value, though in"
         "\n  practice this rarely happens.\n");
  fprintf(f_out,"\n  in_P1 is the number of proposal draws such that the density of the proposal is greater than"
	  "\n  or equal to the density (properly scaled!) of the posterior.  in_P2 is the number of"
	  "\n  posterior draws such that the density (properly scaled!) of the posterior is greater than"
	  "\n  or equal to the density of the proposal.  Both numbers should be somewhat larger than zero."
          "\n  Ideally both should also be somewhat less than the maximum possible value, though in"
          "\n  practice this rarely happens.\n");

  // Compute marginal data density - Bridge method
  mdd=ComputeLogMarginalDensity_Bridge(proposal,posterior);
  printf("\nBridge log(mdd) = %le\n",mdd);
  fprintf(f_out,"\nBridge log(mdd) = %le\n",mdd);

  /* // Use Sims, Waggoner, Zha proposal for Mueller and bridge */
  /* TMatrix modified_proposal=(TMatrix)NULL, modified_posterior=(TMatrix)NULL; */
  /* for (i=0; i < 3*n_cuts; i++) */
  /*   { */
  /*     if (!ModifyUsingSWZ(&modified_proposal,&modified_posterior,proposal,posterior,ElementV(cuts,i))) break; */

  /*     mdd=ComputeLogMarginalDensity_Mueller(modified_proposal,modified_posterior,&in_P1,&in_P2); */
  /*     printf("\nMuller log(mdd) = %le\nnproposal = %d  nposterior = %d   in_P1 = %d   in_P2 = %d\n",mdd,RowM(modified_proposal),RowM(modified_posterior),in_P1,in_P2); */
  /*     fprintf(f_out,"\nMuller log(mdd) = %le\nnproposal = %d  nposterior = %d   in_P1 = %d   in_P2 = %d\n",mdd,RowM(modified_proposal),RowM(modified_posterior),in_P1,in_P2); */

  /*     mdd=ComputeLogMarginalDensity_Bridge(modified_proposal,modified_posterior); */
  /*     printf("\nBridge log(mdd) = %le\n",mdd); */
  /*     fprintf(f_out,"\nBridge log(mdd) = %le\n",mdd); */
     
  /*     while ((i < 3*n_cuts-1) && (ElementV(cuts,i+1) == ElementV(cuts,i))) i++; */
  /*   } */
  /* FreeMatrix(modified_proposal); */
  /* FreeMatrix(modified_posterior); */
  /* // clean up */
  /* FreeVector(cuts); */

  // Close main output file
  fclose(f_out);

  // Print posterior and proposal
  if (dw_FindArgument_String(nargs,args,"print") != -1)
    { 
     if (tag)
	{
	  fmt="posterior_t%d_%s.out";
	  sprintf(filename=(char*)dw_malloc(strlen(fmt) + strlen(tag) - 1),fmt,proposal_type,tag);
	}
      else 
	{
	  fmt="posterior_t%d.out";
	  sprintf(filename=(char*)dw_malloc(strlen(fmt) + 1),fmt,proposal_type);
	}
      f_out=fopen(filename,"wt");
      dw_free(filename);
      dw_PrintMatrix(f_out,posterior,"%le ");
      fclose(f_out);

      if (tag)
	{
	  fmt="proposal_t%d_%s.out";
	  sprintf(filename=(char*)dw_malloc(strlen(fmt) + strlen(tag) - 1),fmt,proposal_type,tag);
	}
      else 
	{
	  fmt="proposal_t%d.out";
	  sprintf(filename=(char*)dw_malloc(strlen(fmt) + 1),fmt,proposal_type);
	}
      f_out=fopen(filename,"wt");
      dw_free(filename);
      dw_PrintMatrix(f_out,proposal,"%le ");
      fclose(f_out);
    }
  else
    {
      if (tag)
	{
	  fmt="proposal_t%d_%s.out";
	  sprintf(filename=(char*)dw_malloc(strlen(fmt) + strlen(tag) - 1),fmt,proposal_type,tag);
	}
      else 
	{
	  fmt="proposal_t%d.out";
	  sprintf(filename=(char*)dw_malloc(strlen(fmt) + 1),fmt,proposal_type);
	}
      f_out=fopen(filename,"wt");
      dw_free(filename);
      dw_PrintMatrix(f_out,proposal,"%le ");
      fclose(f_out);
    }

  rtrn=1;

  // Cleanup
 CLEAN_UP:
  FreeMatrix(scale);
  FreeMatrix(proposal);
  FreeMatrix(posterior);
  FreeVector(center);
  FreeVector(R);
  dw_FreeArray(dirichlet_dims);
  if (alpha) dw_free(alpha);
  FreeElliptical(elliptical);

  // timings
  end_time=time((time_t*)NULL);
  printf("Elapsed Time: %d seconds\n",end_time - begin_time);

  return rtrn;
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/


#undef SORTED_LEVEL_CUTS  
#undef LINEAR_LEVEL_CUTS  
#undef EXP_LEVEL_CUTS  
#undef USE_MODE
#undef USE_MEAN 

#undef USE_GAUSSIAN            
#undef USE_POWER           
#undef USE_TRUNCATED_POWER 
#undef USE_STEP 
#undef USE_TRUNCATED_POWER
#undef USE_UNIFORM                
