/* This program simulates a rating experiment. It uses parameters that may
    include signal means, signal standard deviations, criterion means,criterion standard deviations,
    the probability PR1 of choosing decision Rule 1 (Rosner & Kochanski, 2010),
    the probability PR2 of choosing decision Rule 2 (Klauer & Kellen, 2011)
    and the probability PR3 of choosing decision Rule 3 (Klauer & Kellen, 2011).
    Parameters are chosen by random sampling of Gaussian densities. Given the parameters, the program
    simulates a rating experiment on a trial-by-trial basis. From the resulting frequency
    matrix, it gets a matrix of proportions. It computes a probability
    matrix from the parameters and obtains measures of goodness of fit (MGF) between that
    matrix and the proportion matrix. Parameters, frequency matrix, and MGFs are written to
    the input file.

    The program first reads sname, the name of an input/output file sname.rsa where sname has up
    to 50 characters. The file is organized as follows:

    Main header
    nums  number of stimuli
    numr  number of responses
    t_p_s  trials per stimulus,
    numsets  number of parameter sets and S-R matrices desired
    no_cx  1 if criterion position interchanges forbidden in csdt or fsdt, 0 otherwise
    sdtev  1 if equal-variance SDT model, 0 otherwise; no_cx must be 1
    sdtuv  1 if unequal-variance SDT model, 0 otherwise; no_cx must be 1
    csdev   1 if equal-variance CSDT model, 0 otherwise
    csduv   1 if unequal-variance CSDT model, 0 otherwise
    fsdt   1 if FSDT model, 0 otherwise
    dec_r  decision rule for simulation
    DECISION RULE   PR1   PR2    PR3
	  11         1     0      0
	  12         0     1      0
	  13         0     0      1
	  14         f    -1      0
	  15         f     0     -1
	  16         0     f     -1
	  17         f     f     -1
	  (f=free; -1 means probability determined by free PR)
    liseed  random number seed
    qracc integration accuracy
    if numsets=1, a single set of parameters

    If numsets>1, Parameters are determined as follows, where (2*random)
    is a random value between 0 and 2.
        Sm 0,0 then N-1 successive intervals of size (2*random)>=0.5
	Ssd N values with (2*random)>=0.1; all 0 for CSDT
	Cm M-1 successive intervals, with (2*random)>0.75
	Csd M-1 fabs(random 2z) values with (2*random)>0.1; all 0 for SDT
	PR1, PR2, P3 are chosen  in accordance with dec_r.

    Each set of parameters is used to simulate a rating experiment with t_p_s trials per stimulus. 
    If dec_r = 14, one matrix is generated through Rule 1 and a second by  Rule 2. They are combined 
    in accordance with PR1 and its complement. Other decision rules are treated similarly. If dec_r
    is 17, three matrices are generaterd and combined via PR1, PR2, and (1-PR1-PR2). Parameters, 
    dec_r, frequency matrxix, and measures of goodness of fit are written to the .rsa file.
  
    To get the simulated rating frequencies, for each trial the program randomly draws a 
    signal sample and numr-1 criterion samples, subject to any conditions. Under rule 1, it 
    arrives at a rating by finding the minimum positive difference (cj - s) over criterion 
    samples cj between the signal sample s. The rating is j. Under rule 2, the program 
    finds the minimum positive difference (s - cj) over the cj and s. The rating is j+1. 
    Under Rule 3, the smallest value of |cj - s| is first found. Then, if cj >= s, 
    the response is j; if cj < s, the response is j+1. For SDT, the rules are equivalent so 
    Rule 1 is used.

    If noccx is true, the first sample Csd c0 is randomly chosen. Then each successive ci 
    is chosen from the appropriate Gaussian GCi from GCi(c_i-1) upwards.
    Each ci must exceed c(i-1).                                                           */

// Includes    
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include <assert.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_cdf.h>
#include <gsl/gsl_sort_double.h>
#include <gpklib.h>
#include <gpklib/romberg.h>
#include <gpklib/ieee754.h>
#include "gpklib/NaN.h"
#include "ransim_a.h"
#include "wsd.h"


C double KMAX = 5;
#define INTALG trapzd
C BOOL RATIONAL_INNER = TRUE;
C BOOL RATIONAL_OUTER = FALSE;


struct info_s {
    double mus;
    double sigmas;
    int n;	// How many criteria
    int j;	// Which criterion are we calculating
    double *mu; // Criterion means
    double *sigma;	// Criterion sigmas
    C struct rsmgff *isp;
    double qracc() C { return isp->qracc; }
    int rule;   // Which RKKK rule, 1, 2, or 3
};

struct infoinner_s : info_s {
	double s;

	infoinner_s( info_s *outer, double ss);
	double qracc()  { return 3.0*isp->qracc; }
	};

infoinner_s::infoinner_s( info_s *outer, double ss)
		: s(ss)
{
 assert(outer);
 assert(outer->sigmas >= 0.0);
 assert(outer->isp);
 mus = outer->mus; sigmas = outer->sigmas;
 n = outer->n; j = outer->j;
 mu = outer->mu; sigma = outer->sigma;
 rule = outer->rule;
 assert(outer->isp);
 isp = outer->isp;
}

static float ReadFloat(FILE* inPtr) {
    char ahold[1024];
    bool ok = fscanf ( inPtr, "%s", ahold ) == 1;
    assert(ok);
    double rv = safe_atof(ahold);
    assert( finite(rv) );
    return rv;
}

static int ReadInt(FILE* inPtr) {
    char ahold[1024];
    bool ok = fscanf ( inPtr, "%s", ahold ) == 1;
    assert(ok);
    int rv = safe_atoi(ahold);
    assert( rv != INT_NAN && rv != INT_Max && rv != INT_Min);
    return rv;
}

gsl_rng *r;

struct rsmgff rs_init;
struct rsmgff *rs_a = &rs_init;

int main( int argc, char *argv[  ] )
{

    if ( argc < 2 ) exit( 1 );
    open_file( argv [ 1 ], rs_a  );
    rsmgff_init ( rs_a ); 
    start_output ( rs_a );
    alloc_mats( rs_a );
    calc_pf_pairs ( rs_a );
    free_dm( rs_a );
    return 0;
}

void open_file( char gen_name [ 50 ],  struct rsmgff *isp )
{
    char sf_name [ 50 ];
    short open_indic = 0;

    while ( open_indic == 0 ) {
	strcpy( sf_name, gen_name );
	strcat( sf_name, ".rsa" );
	isp->inPtr = fopen( sf_name, "r+t" );
	if ( isp->inPtr == NULL ) {
	    printf( "\n Error opening .rsa file %s\n", sf_name );
	    printf( " get another name.\n" );
	    printf( "\n Program quitting." );
	    exit( 0 );
        }
	else  open_indic = 1;
    }
}

void rsmgff_init (  struct rsmgff *isp )
{

    char junk[ 50 ];
    int i;
    // Read initial parameters
    bool ok = fscanf ( isp->inPtr, "%s", isp->header ) == 1;
    assert( ok );
    isp->nums = ReadInt( isp->inPtr ); 
    isp->numr = ReadInt( isp->inPtr );
    isp->numc = isp->numr - 1;
    isp->t_p_s = ReadInt( isp->inPtr );
    isp->numsets = ReadInt( isp->inPtr );
    isp->no_cx = ReadInt( isp->inPtr );
    isp->sdtev = ReadInt( isp->inPtr );
    isp->sdtuv = ReadInt( isp->inPtr );
    isp->csdev = ReadInt( isp->inPtr );
    isp->csduv = ReadInt( isp->inPtr );
    isp->fsdt = ReadInt( isp->inPtr );
    isp->dec_r = ReadInt( isp->inPtr );
    isp->liseed = ReadInt( isp->inPtr );
    isp->qracc = ReadFloat( isp->inPtr );
    if ( isp->no_cx == 1 ) assert ( (isp->csdev == 1 ) || (isp->csduv == 1 ) ||  (isp->fsdt == 1 ) );

    isp->nallparams = 2 * ( isp->nums + isp->numc ) + 3;
    isp->pstart = 2 * ( isp->nums + isp->numc );

    isp->allparameters = double1alloc( isp->nallparams );
    isp->mgf = double1alloc ( 6 );

    if ( isp->numsets == 1 ) {
       // Read generating parameters
       for( i = 0; i < isp->nallparams; i++ ) isp->allparameters [ i ] = ReadFloat( isp->inPtr );
       double psum = 0;
       for( i = 0; i < 3; i++ ) 
            psum += isp->allparameters [ isp->pstart +i ];
  
       for( i = 0; i < 3; i++ )
	  isp->allparameters [ isp->pstart + i] /= psum;
       assert( psum > 0.9995 );
       assert( psum < 1.0005 );
    }

    // Get other needed values
    isp->sm_start = 0;
    isp-> sm_end = isp->nums - 1;
    isp->ssd_start = isp->nums;
    isp->ssd_end = isp->ssd_start + isp->nums - 1;
    isp->cm_start = isp->ssd_end + 1;
    isp->cm_end = isp->cm_start + isp->numc - 1;
    isp->csd_start = isp->cm_end + 1;
    isp->csd_end = isp->csd_start + isp->numc - 1;
    isp->pstart = isp->csd_end + 1;

    // Set random generator
    r = gsl_rng_alloc( gsl_rng_taus );
    gsl_rng_set ( r, isp->liseed );
}

void start_output (  struct rsmgff *isp )
{

    fprintf( isp->inPtr, "\n\n%s\n", isp->header  );
    if  ( isp->csdev ) fprintf( isp->inPtr, "\n  Equal-variance CSDT model " );
    if  ( isp->csduv ) fprintf( isp->inPtr, "\n  Unqual-variance CSDT model " );
    if  ( isp-> sdtev ) fprintf( isp->inPtr, "\n Equal-variance SDT model " );
    if  ( isp-> sdtuv ) fprintf( isp->inPtr, "\n Unequal-variance SDT model " );
    if  ( isp->fsdt ) fprintf( isp->inPtr, "\n  FSDT model " );
    if  ( isp->no_cx ) fprintf( isp->inPtr, "\n  Criteria cannot interchange positions " );

    switch (isp->dec_r )
    {
       case 11: fprintf( isp->inPtr, "\n  Decision rule 1 " );
       break;
       case 12: fprintf( isp->inPtr, "\n  Decision rule 2 " );
       break;
       case 13: fprintf( isp->inPtr, "\n  Decision rule 3" );
       break;
       case 14: fprintf( isp->inPtr, "\n  Decision rules 1 and 2 " );
       break;
       case 15: fprintf( isp->inPtr, "\n  Decision rules 1 and 3 " );
       break;
       case 16: fprintf( isp->inPtr, "\n  Decision rules 2 and 3 " );
       break;
       case 17: fprintf( isp->inPtr, "\n  Decision rules 1, 2, and 3 " );
    }
}

void alloc_mats(  struct rsmgff *isp )
{


    // Allocate matrices
    isp->freq1_mat = int2alloc( isp->nums, isp->numr );
    isp->freq2_mat = int2alloc( isp->nums, isp->numr );
    isp->freq3_mat = int2alloc( isp->nums, isp->numr );
    isp->freq_mat = int2alloc( isp->nums, isp->numr );

    isp->dprob_1_mat = double2alloc( isp->nums, isp->numr );
    isp->dprob_2_mat = double2alloc( isp->nums, isp->numr );
    isp->dprob_3_mat = double2alloc( isp->nums, isp->numr );
    isp->dprob_mat = double2alloc( isp->nums, isp->numr );
    isp->prop_mat = double2alloc( isp->nums, isp->numr );

}

void calc_pf_pairs (  struct rsmgff *isp )
{

    if ( isp->numsets == 1 ) {
        calc_freq_mats( isp );
	wsdo_logp ( isp );
        wsdo_l_f_mgf ( isp );
        write_p_f_pair( isp, -1 );
	exit ( 0 );
    }

    for ( int isim = 0; isim < isp->numsets; isim++ ) {
        calc_sim_params( isp );
	calc_freq_mats( isp );
	wsdo_logp ( isp );
        wsdo_l_f_mgf ( isp );
	write_p_f_pair( isp, isim );
    }
}

// Calculate the parameters 
void calc_sim_params (  struct rsmgff *isp )
{

    double scr = double( isp->numr ) / double( isp->nums );
    double sd, ppsum = 0;
    double parx = 0.0;
    double cmlim = scr * 1.25;
    double cslim = cmlim * 1.25; 

    // Get signal means
    isp->allparameters [ isp->sm_start ] = 0;
    for ( int i = isp->sm_start + 1; i <= isp->sm_end; i++ ) {
      isp->allparameters [ i ] =  get_ran( 0.4, 0.8, 2.0 ) + isp->allparameters [ i - 1 ];
    }

    // Get signal sds
    if ( ( isp->sdtuv == 1 ) || ( isp->fsdt == 1 ) ) for ( int i = isp->ssd_start; i <= isp->ssd_end; i++ )
						       isp->allparameters [ i ] = get_ran( 0.25, 1.0, 1.0 );
    else {
          if ( isp->sdtev == 1 ) sd = 1.0;
          else sd = 0;
          for ( int i = isp->ssd_start; i <= isp->ssd_end; i++ ) isp->allparameters [ i ] = sd;
    }

    // Get criterion means
    // First mean
    parx = get_ran( 0.00001, 0.1, 1.0 );
    isp->allparameters [ isp->cm_start ] = parx;
    parx = get_ran( 0.00001, 0.1, 1.0 );
    if ( parx < 0.05 ) isp->allparameters [ isp->cm_start ] *= -1.0;

    // All of the rest
    for ( int i = ( isp->cm_start + 1); i <= isp->cm_end; i++ )
      isp->allparameters [ i ] = get_ran( 0.00000001, cmlim, 1.0 ) + isp->allparameters [ i - 1 ];

    // Get criterion sds
    if ( ( isp->csduv == 1 ) || ( isp->fsdt == 1 ) ) for ( int i = isp->csd_start; i <= isp->csd_end; i++ ) 
						       isp->allparameters [ i ] = get_ran( 0.0, cslim, 1.0 );
    if ( isp->csdev == 1 )for ( int i = isp->csd_start; i <= isp->csd_end; i++ ) isp->allparameters [ i ] = 1.000;
    if ( ( isp->sdtev == 1 ) || ( isp->sdtuv == 1 ) ) for ( int i = isp->csd_start; i <= isp->csd_end; i++ ) isp->allparameters [ i ] = 0;

    // Get probabilities
    isp->allparameters [ isp->pstart ] = 0.0;
    isp->allparameters [ isp->pstart + 1] = 0.0;
    isp->allparameters [ isp->pstart + 2 ] = 0.0;
    switch ( isp->dec_r )
    {
    case 11: isp->allparameters [ isp->pstart ] = 1.0;
             break;
    case 12: isp->allparameters [ isp->pstart + 1] = 1.0;
             break;
    case 13: isp->allparameters [ isp->pstart + 2 ] = 1.0;
             break;
    case 14: isp->allparameters [ isp->pstart ] = get_ran( 0.1, 0.90, 1.0 );
             isp->allparameters [ isp->pstart + 1] = 1.0 - isp->allparameters [ isp->pstart ];
             break;
    case 15: isp->allparameters [ isp->pstart ] = get_ran( 0.1, 0.90, 1.0 );
             isp->allparameters [ isp->pstart + 2 ] = 1.0 - isp->allparameters [ isp->pstart ];
             break;
    case 16: isp->allparameters [ isp->pstart + 1] = get_ran ( 0.1, 0.90, 1.0 );
             isp->allparameters [ isp->pstart + 2 ] = 1.0 - isp->allparameters [ isp->pstart + 1];
             break;
    case 17: isp->allparameters [ isp->pstart ] = get_ran  ( 0.1, 0.90, 1.0 );
	     ppsum += isp->allparameters [ isp->pstart ];
             isp->allparameters [ isp->pstart + 1 ] = get_ran ( 0.1, 0.90, 1.0 );
	     ppsum += isp->allparameters [ isp->pstart + 1];
             isp->allparameters [ isp->pstart + 2 ] = get_ran ( 0.1, 0.90, 1.0 );
	     ppsum += isp->allparameters [ isp->pstart + 2 ];
	     for ( int j = 0; j < 3; j++ ) 
	       isp->allparameters [ isp->pstart + j ] /= ppsum;
             break;
    }
    ppsum = 0.0;
    for ( int i = 0; i < 3; i++ ) ppsum += isp->allparameters [ isp->pstart + i];
    for ( int i = 0; i < 3; i++ ) isp->allparameters [ isp->pstart + i] /= ppsum;
    assert ( isp->allparameters [ isp->pstart ] >= 0 );
    assert ( isp->allparameters [ isp->pstart + 1 ] >= 0 );
    assert ( isp->allparameters [ isp->pstart + 2 ] >= 0 );
}

double get_ran ( double l_lim, double u_lim, double mltp )
{
    double rvar;

    rvar = 2 * u_lim;
    while ( ( rvar < l_lim ) || ( rvar > u_lim ) ) {
             rvar = gsl_rng_uniform_pos( r );
    }
    return mltp * rvar;
}



void calc_freq_mats (  struct rsmgff *isp )
{
    int cpts, ipts, rpts, spts, r_ratg;
    double c_dev, csdiff, min_pos, s_samp;
    double *c_samps;
    c_samps = double1alloc( isp->numc );


    // Clear frequency matrices
    for ( spts = 0; spts < isp->nums; spts++ )
        for ( rpts = 0; rpts < isp->numr; rpts++ ) {
            isp->freq1_mat [ spts ] [ rpts ] = 0;
	    isp->freq2_mat [ spts ] [ rpts ] = 0;
	    isp->freq3_mat [ spts ] [ rpts ] = 0;
	    isp->freq_mat [ spts ] [ rpts ] = 0;
	}

    // Main loop
    double deva, devb, devc;
    for ( spts = 0; spts < isp->nums; spts++ ) {
        for ( ipts = 0; ipts < isp->t_p_s; ipts++ ) { 
            // Get signal sample
	    s_samp = isp->allparameters [ spts + isp->sm_start ];
	    if ( ( isp->csdev != 1 ) &&  ( isp->csduv != 1 ) )  s_samp += gsl_ran_gaussian ( r, isp->allparameters [ spts + isp->ssd_start ] );

            // Get criterion means unto c_samps              
	    for ( cpts = 0; cpts < isp->numc; cpts++ ) c_samps [ cpts ] = isp->allparameters [ cpts + isp->cm_start ];
	    // Add in any requiredvariance
	    if ( isp->no_cx == 1 ) {
	         deva = gsl_ran_gaussian ( r, isp->allparameters [ isp->csd_start ] );
		 c_samps [ 0 ] +=  deva;
	         for ( cpts = 1; cpts < isp->numc; cpts++ ) {
		     devb = -10;
		     while ( devb <= 0 ) {
		         deva = fabs ( gsl_ran_gaussian ( 0, 1 ) * isp->allparameters [ isp->csd_start + cpts ] );
		         c_samps [ cpts ] += deva;
		         devb = c_samps [ cpts ] - c_samps [ cpts - 1];
	             }
		 }
	    }
	    else
	       if ( ( isp->csdev == 1 ) || ( isp->csduv == 1 ) ||( isp->fsdt == 1 ) ) 
	          for ( cpts = 0; cpts < isp->numc; cpts++ )  
		     c_samps [ cpts ] +=  gsl_ran_gaussian ( r, isp->allparameters [ cpts + isp->csd_start ] );

	    // Get response
	    // Rule 3
	    if ( isp->allparameters [ isp->pstart + 2 ] != 0 ) {
		min_pos = 10000.0;
		for ( cpts = 0; cpts < isp->numc; cpts++ ) {
		    csdiff = s_samp - c_samps [ cpts ];
		    csdiff = fabs ( csdiff );
		    if ( csdiff < min_pos ) {
		        min_pos = csdiff;
		        r_ratg = cpts;
	            }
	        }
	        if ( ( c_samps [ r_ratg ] - s_samp ) < 0 ) r_ratg++;
		isp->freq3_mat [ spts ] [ r_ratg ]++;
	    }
	    // Rule 2
	    if ( isp->allparameters [ isp->pstart + 1] != 0 ) {
	       min_pos = 10000.0;
	       r_ratg = 0;
	       for ( cpts = 0; cpts < isp->numc; cpts++ ) {
		   csdiff = s_samp - c_samps [ cpts ];
		   if ( ( csdiff < min_pos ) && ( csdiff > 0 ) ) {
		       min_pos = csdiff;
		       r_ratg = cpts + 1;
		   }
	       }
	       isp->freq2_mat [ spts ] [ r_ratg ]++;
	    }    
	    //  Rule 1
	    if ( isp->allparameters [ isp->pstart ] != 0 ) {
	       min_pos = 10000.0;
	       r_ratg = isp->numc;
	       for ( cpts = 0; cpts < isp->numc; cpts++ ) {
		   csdiff = c_samps [ cpts ] - s_samp;
		   if ( ( csdiff < min_pos ) && ( csdiff > 0 ) ) {
		       min_pos = csdiff;
		       r_ratg = cpts;
		    }
	       }
	       isp->freq1_mat [ spts ] [ r_ratg ]++;
	    }
	}
    }

    // Combine matrices
	for ( spts = 0; spts < isp->nums; spts++ )
  	    for ( ipts = 0; ipts < isp->numr; ipts++ )  
                isp->freq_mat [ spts ] [ ipts ] = isp->allparameters [ isp->pstart ] *  isp->freq1_mat [ spts ] [ ipts ] +
		                                    isp->allparameters [ isp->pstart + 1] *  isp->freq2_mat [ spts ] [ ipts ] +
		                                    isp->allparameters [ isp->pstart + 2 ] *  isp->freq3_mat [ spts ] [ ipts ];
    double1free( c_samps );

}

/* Compute log likelihood and measures of goodness of fit: */
void wsdo_logp ( struct rsmgff *isp )
{

    int iwf, jwf, wfdum;
    double partprob, wl_f = 0;

    // printf( "\n  wsdo_logp started\n" );

    // Clear probability matrices
    for ( iwf = 0; iwf < isp->nums; iwf++ )
        for ( jwf = 0; jwf < isp->numr; jwf++ ) {
            isp->dprob_1_mat [ iwf ] [ jwf ] = 0;
	    isp->dprob_2_mat [ iwf ] [ jwf ] = 0;
	    isp->dprob_3_mat [ iwf ] [ jwf ] = 0;
	    isp->dprob_mat [ iwf ] [ jwf ] = 0;
	}

    switch ( isp->dec_r ) {
        case 11:
		 assert ( isp->allparameters [ isp->pstart + 1 ] == 0 );
		 assert ( isp->allparameters [ isp->pstart + 2 ] == 0 );
		 break;
        case 12:
		 assert ( isp->allparameters [ isp->pstart ] == 0 );
		 assert ( isp->allparameters [ isp->pstart + 2 ] == 0 );
		 break;
        case 13:
		 assert ( isp->allparameters [ isp->pstart ] == 0 );
		 assert ( isp->allparameters [ isp->pstart + 1 ] == 0 );
		 break;
        case 14: 
		 assert ( isp->allparameters [ isp->pstart + 2 ] == 0 );
		 break;
        case 15: 
		 assert( isp->allparameters [ isp->pstart + 1] == 0 );
		 break;
        case 16: 
		 assert ( isp->allparameters [ isp->pstart ]  == 0 );
		 break;

        default: break;
    }
    // printf( "\nProbabilities set" );


    // printf( "\n Main loop" );
    /* Main loop 1. Get probability matrices required by isp->dec_r. Combine them via  isp->allparameters [ isp->pstart, +1,  + 2 ].
       Get cumulative probability matrix               */
    assert(0<=isp->numc && isp->numc < isp->numr);
    for ( iwf = 0; iwf < isp->nums; iwf++ ) {
      // Check for fsdt  or csdt
      if ( ( isp->csdev == 1 ) ||  ( isp->csduv == 1 ) ||( isp->fsdt == 1 ) ) {
	   for ( jwf = 0; jwf < isp->numc; jwf++ ) {
	      // Check for csdt
	     if ( ( isp->csdev == 1 ) || ( isp->csduv == 1 ) ) {
	        // Rule 1
	        if ( isp->allparameters [ isp->pstart ] != 0 ) 
	              isp->dprob_1_mat [ iwf ] [ jwf ] =  eq3a_wrap ( 1, iwf, jwf, isp->allparameters, isp );
	        else ( isp->dprob_1_mat [ iwf ] [ jwf ] = 0 );
	      	      
	        // Rule 2
	        if ( isp->allparameters [ isp->pstart + 1 ] != 0 ) 
	            isp->dprob_2_mat [ iwf ] [ jwf + 1 ] = eq3a_wrap ( 2, iwf, jwf, isp->allparameters, isp );
	        else ( isp->dprob_2_mat [ iwf ] [ jwf + 1 ] = 0 );

	        // Rule 3
	        if ( isp->allparameters [ isp->pstart + 2 ] == 0 ) ( isp->dprob_3_mat [ iwf ] [ jwf ] = 0 );
	        else isp->dprob_3_mat [ iwf ] [ jwf ] = eq3a_wrap ( 3, iwf, jwf, isp->allparameters, isp );
	      }
	      else {
                 // FSDT
	         // Rule 1
	         if ( isp->allparameters[ isp->pstart ] != 0 ) 
	            isp->dprob_1_mat [ iwf ] [ jwf ] = eq3_wrap ( 1, iwf, jwf, isp->allparameters, isp );
	         else ( isp->dprob_1_mat [ iwf ] [ jwf ] = 0 );
	         // Rule 2
	         if ( isp->allparameters[ isp->pstart + 1 ] != 0 )
	             isp->dprob_2_mat [ iwf ] [ jwf + 1 ] = eq3_wrap ( 2, iwf, jwf, isp->allparameters, isp );
	         else ( isp->dprob_2_mat [ iwf ] [ jwf ] = 0 );
	         // Rule 3
	         if ( isp->allparameters [ isp->pstart + 2 ] == 0 ) ( isp->dprob_3_mat [ iwf ] [ jwf ] = 0 );
	         else isp->dprob_3_mat [ iwf ] [ jwf ] = eq3_wrap ( 3, iwf, jwf, isp->allparameters, isp );
	      }
           }
           // Get last entry in each row of dprob_1_mat and dprob_3_mat 
           // Get first entry in each row of dprob_2_mat 
	   if ( isp->allparameters [isp->pstart ] != 0 )
	     missing_entry ( isp->dprob_1_mat, isp, iwf, 0, isp->numc - 1 );
	   if ( isp->allparameters [isp->pstart + 1 ] != 0 )
	       missing_entry ( isp->dprob_2_mat, isp, iwf, 1, isp->numc );
	   if ( isp->allparameters [ isp->pstart + 2 ] != 0 )
                missing_entry ( isp->dprob_3_mat, isp, iwf, 0, isp->numc - 1 );
           // Combine Rule 1, Rule 2, and Rule 3 results to get dprob_mat
	   double dpsum = 0;
           for ( jwf = 0; jwf < isp->numr; jwf++ ) {  
	     isp->dprob_mat [ iwf ] [ jwf ] =  ( isp->allparameters [isp->pstart ] *  isp->dprob_1_mat [ iwf ] [ jwf ]
                                               + isp->allparameters [ isp->pstart + 1 ] *  isp->dprob_2_mat [ iwf ] [ jwf ]
					       + isp->allparameters [ isp->pstart + 2 ] *  isp->dprob_3_mat [ iwf ] [ jwf ] );
	     if ( isp->dprob_mat [ iwf ] [ jwf ] < 0 ) {
	         printf ( "\n %f  %d  $d \n", 
		  	   isp->dprob_mat [ iwf ] [ jwf ], iwf, jwf );
	         printf ( "\n %f  %f  $f \n", 
		  	      isp->allparameters [isp->pstart ],
			      isp->allparameters [isp->pstart +1 ],
			      isp->allparameters [isp->pstart + 2] );
	         exit( 5 );
             }
	       assert ( isp->dprob_mat [ iwf ] [ jwf ] >= 0 );  
	       dpsum += isp->dprob_mat [ iwf ] [ jwf ];
           }
           for ( jwf = 0; jwf < isp->numr; jwf++ ) {  
	       isp->dprob_mat [ iwf ] [ jwf ] /= dpsum;
               assert ( isp->dprob_mat [ iwf ] [ jwf ] <= 1.0  );
	   }
      }
      // SDT: Rule1, Rule 2, and Rule3 sdt probabilities are identical
      // Function sdt computes p(R=j) over jwf=1, ... , numr
      else wfdum = sdt ( iwf, rs_a );
    }
	   

}

void missing_entry( double **dpmat,  struct rsmgff *isp, int snum, int r_start, int r_end )
{

    int jwf;
    double r_sum = 0;

    for ( jwf = r_start; jwf <= r_end; jwf++ ) {
      dpmat [ snum ] [ jwf ] = fabs ( dpmat [ snum ] [ jwf ] );
      r_sum += dpmat [ snum ] [ jwf ];
    }
    if ( r_sum > 1.0 + EPS ) {
	printf ( "\n r_sum = %7.5f\n", r_sum );
	fflush ( stdout );
    }
    if ( r_sum <= 1.0 ) {
        if ( r_start == 0 ) dpmat [ snum ] [ isp->numc ] = 1.0 - r_sum;
	else dpmat [ snum ] [ 0 ] = 1.0 - r_sum;
    }
    else {	
	  if ( r_start == 0 ) r_sum += dpmat [ snum ] [ isp->numc ];
	  else  r_sum += dpmat [ snum ] [ 0 ];
	  // Normalize row
	  for ( jwf = 0; jwf <= isp->numc; jwf++ ) dpmat [ snum ] [ jwf ] /= r_sum;
    }
    // Final check
    for ( jwf = 0; jwf < isp->numr; jwf++ )
        assert ( ( dpmat [ snum ] [ jwf ] <= 1  ) && ( dpmat [ snum ] [ jwf ] >= 0 ) );
}

double normal ( double x, double mu, double sigma )
{
    assert( sigma > 0 );
    double z = ( x - mu ) / sigma;
    return exp ( -z * z / 2.0 ) / (sqrt ( 2 * M_PI) * sigma );
}


inline double dmax ( double a, double b )
{
    return a>b ? a : b;
}

inline double dmin ( double a, double b )
{
    return a<b ? a : b;
}



double eq3_wrap ( int rk1kk23, int ie3, int je3, double *pp, C struct rsmgff *isp )
{
    // Ssdsum != 0
    int j3w = je3;

    C int nc = isp->numc;
    assert ( j3w >= 0 && j3w <= nc );
    C double mus = pp [ isp->sm_start + ie3 ];
    C double sigmas = pp [ isp->ssd_start + ie3 ];
    double *mu = double1alloc(nc+1);
    double *sigma = double1alloc(nc+1);
    double mumax = mus + 6 * sigmas; 
    double dprob;
    int i3w;
    for( i3w = 0; i3w <nc; i3w++ )	{
	mu [ i3w ] = pp [ isp->cm_start + i3w ];
	sigma [ i3w ] = pp [ isp->csd_start + i3w ];
	if( mumax < mu [ i3w ] + 6 * sigma[ i3w ] )
		mumax = mu[ i3w ] + 6 * sigma[ i3w ];
    }
    mu [ i3w ] = mumax + 6.0 * sigmas;
    sigma [ i3w ] = sigmas;
    // printf ( "mu[%d]=%g sigma[%d]=%g\n", i3w, mu [ i3w ], i3w, sigma [ i3w ] );
    dprob  = eq3( rk1kk23, j3w, nc, mu, sigma, mus, sigmas, isp );
    if ( isnan( dprob ) ) dprob = 1E-50;
    double1free ( mu );
    double1free ( sigma );
    return dprob;
}

double eq3 ( int rk1kk23, int j, int n, double *mu, double *sigma, double mus, double sigmas,
		C struct rsmgff *isp )
{
    assert(isp);
    struct info_s info;
    info.j = j;
    info.sigma = sigma;
    info.n = n;
    info.mu = mu;
    info.mus = mus;
    info.sigmas = sigmas;
    info.isp = isp;
    info.rule = rk1kk23;
    C double minf = mus-sigmas * 6.0;
    C double mbreak = mus-sigmas * 2.0;
    C double pbreak = mus+sigmas * 2.0;
    C double pinf = mus+sigmas * 6.0;
    double sL;
    double sC;
    double sR;
    // printf ( "j=%d minf=%g, pinf=%g\n", j, minf, pinf );
    C double sguess = 0.2;
    C int kmax = 5;

    sC = qromox ( outerkernel, mbreak, pbreak, trapzd, &info, n, info.qracc(), sguess, kmax, RATIONAL_OUTER );
    if(!finite(sC)) return quiet_nan(0);
    sL = qromox ( outerkernel, minf, mbreak, trapzd, &info, n, info.qracc(), 0.1*sguess+sC, kmax, RATIONAL_OUTER );
    if(!finite(sL)) return quiet_nan(0);
    sR = qromox ( outerkernel, pbreak, pinf, trapzd, &info, n, info.qracc(), 0.1*sguess+sC+sL, kmax, RATIONAL_OUTER );
    return sL + sC + sR;
}

double outerkernel ( double s,  void *infoptr, int nc )
{
    // fprintf(stderr, "Outerkernel %g\n", s);
    struct info_s *info = ( struct info_s * )infoptr;
    C int j = info->j;
    assert( info->isp );
    assert( info->sigma[ j ] >= 0.0 );
    infoinner_s  iinner(info, s);
    C double sguess = 0.2;
    C double pinf = dmax( info->mu[ j ], s ) + info->sigma[ j ] * 6.0;
    C double pbreak = dmax( info->mu[j] + info->sigma[ j ]*2.0, s + info->sigma[j]*1.0 );
    C double nbreak = info->mu[j] - info->sigma[ j ]*2.0;
    assert ( info->sigma[j] >= 0.0);
    assert ( pinf >= info->mu[j]);
    assert ( pinf >= s );

    C double qbreak = info->mu[j] + info->sigma[ j ]*2.0;
    C double mbreak = dmin( info->mu[j] - info->sigma[ j ]*2.0, s - info->sigma[ j ] );
    C double pminf = dmin ( s, info->mu[j] ) - info->sigma[ j ]*6.0;
    assert ( info->sigma[j] >= 0.0);
    assert ( pminf <= info->mu[j]);
    assert ( pminf <= s );
    double sC=0.0, sN=0.0, sP=0.0;

    if ( info->rule == 1 ) {
        // EQ (1)
	if ( pinf <= s ) return 0.0;
        assert ( info->sigma[j] >= 0.0);
        assert ( pinf >= info->mu[j]);
        assert ( pinf >= s );
	// printf ( "\ts=%g pinf=%g\n", s, pinf );
	// printf ( "\t*s=%g pinf=%g n=%g ik=%g\n", s, pinf, normal ( s, info->mus, info->sigmas ),
	//  qromox ( innerkernel, s, pinf, INTALG, &iinner, nc, info->qracc(), sguess, KMAX, RATIONAL_INNER ) );

	assert(s < pbreak);
	assert(nbreak < pbreak);
	sC = qromox( innerkernel, dmax(s, nbreak), pbreak, INTALG, &iinner, nc, info->qracc(), sguess, KMAX, RATIONAL_INNER );
	if(!finite(sC))	return quiet_nan(0);
	if(s < nbreak) {
	  sN = qromox ( innerkernel, s, nbreak, INTALG, &iinner, nc, info->qracc(), 0.1*sguess+sC, KMAX, RATIONAL_INNER );
	  if(!finite(sN)) return quiet_nan(0);
    	}
	assert(pbreak < pinf);
	sP = qromox( innerkernel, pbreak, pinf, INTALG, &iinner, nc, info->qracc(), 0.1*sguess+sC+sN, KMAX, RATIONAL_INNER );
    }

    if ( info->rule == 2 ) {
        // EQ (2)
	if ( pminf == s ) return 0.0;
	assert ( pminf <= s );
	// printf ( "\ts=%g pinf=%g\n", s, pminf );
	// printf ( "\t*s=%g pinf=%g n=%g ik=%g\n", pminf, s, normal ( s, info->mus, info->sigmas ),
	//	   qromox ( innerkernel, pminf, s, INTALG, &iinner, nc, info->qracc(), sguess, KMAX, RATIONAL_INNER ) );
	assert(s > mbreak);
	assert(mbreak < qbreak);
        sC = qromox( innerkernel, mbreak, dmin(s, qbreak), INTALG, &iinner, nc, info->qracc(), sguess, KMAX, RATIONAL_INNER );
	if(!finite(sC))	return quiet_nan(0);
	if(s > qbreak) {
	  sN = qromox ( innerkernel, qbreak, s, INTALG, &iinner, nc, info->qracc(), 0.1*sguess+sC, KMAX, RATIONAL_INNER );
	  if(!finite(sN)) return quiet_nan(0);
    	}
	assert(mbreak > pminf);
        sP = qromox( innerkernel, pminf, mbreak, INTALG, &iinner, nc, info->qracc(), 0.1*sguess+sC+sN, KMAX, RATIONAL_INNER );
    }

    if ( info->rule == 3 ) {
       if ( pinf <= s ) return 0.0;
       // First part of Rule 3
       assert ( info->sigma[j] >= 0.0);
       assert ( pinf >= info->mu[j]);
       assert ( pinf >= s );
       // printf ( "\ts=%g pinf=%g\n", s, pinf );
       // printf ( "\t*s=%g pinf=%g n=%g ik=%g\n", s, pinf, normal ( s, info->mus, info->sigmas ),
       //	   qromox ( innerkernel, s, pinf, INTALG, &iinner, nc, info->qracc(), sguess, KMAX, RATIONAL_INNER ) );
       assert(s < pbreak);
       assert(nbreak < pbreak);
       sC = qromox( innerkernel, dmax(s, nbreak), pbreak, INTALG, &iinner, nc, info->qracc(), sguess, KMAX, RATIONAL_INNER );
       if(!finite(sC))	return quiet_nan(0);
       if(s < nbreak) {
	  sN = qromox ( innerkernel, s, nbreak, INTALG, &iinner, nc, info->qracc(), 0.1*sguess+sC, KMAX, RATIONAL_INNER );
	  if(!finite(sN)) return quiet_nan(0);
    	}
	assert(pbreak < pinf);
        sP = qromox( innerkernel, pbreak, pinf, INTALG, &iinner, nc, info->qracc(), 0.1*sguess+sC+sN, KMAX, RATIONAL_INNER );

        if ( info->j != 0 ) {
           // Second part of Rule 3
	   if ( pminf <= s ) {
	     // Set rule to 4 and decrement j for innerkernel
	      info->rule = 4;
              info->j = j -  1;
              struct infoinner_s ii4nner(info, s);
              ii4nner.j = j - 1;
	      // printf ( "\ts=%g pinf=%g\n", s, pminf );
	      // printf ( "\t*s=%g pinf=%g n=%g ik=%g\n", pminf, s, normal ( s, info->mus, info->sigmas ),
	      //	qromox ( innerkernel, pminf, s, INTALG, &iinner, nc, info->qracc(), sguess, KMAX, RATIONAL_INNER ) );
	      assert(s > mbreak);
	      assert(mbreak < qbreak);
	      double sCx = 0.0, sNx = 0.0;
              sCx = qromox( innerkernel, mbreak, dmin(s, qbreak), INTALG, &ii4nner, nc, info->qracc(), sguess, KMAX, RATIONAL_INNER );
	      if(!finite(sCx))return quiet_nan(0);
	      sC +=sCx;
	      if(s > qbreak) {
	        sNx = qromox ( innerkernel, qbreak, s, INTALG, &ii4nner, nc, info->qracc(), 0.1*sguess+sC, KMAX, RATIONAL_INNER );
	        if(!finite(sNx)) return quiet_nan(0);
	        sN += sNx;
              }
	      assert(mbreak > pminf);
              sP += qromox( innerkernel, pminf, mbreak, INTALG, &ii4nner, nc, info->qracc(), 0.1*sguess+sC+sN, KMAX, RATIONAL_INNER );
	      // Reset rule and increment j
              info->rule = 3;
              info->j = j;
              iinner.j = j;
          }
	}
   }
   double xx = normal ( s, info->mus, info->sigmas ) * (sN+sC+sP);
     //   return normal ( s, info->mus, info->sigmas ) * (sN+sC+sP);
   return xx;
}

double innerkernel ( double cj,  void *infoptr, int nc )
{
    int k;
    C struct infoinner_s *info = ( C struct infoinner_s * ) infoptr;
//	    printf ( "cj=%g\n", cj );
//	    printf ( "s=%g\n", info->s );
    C int j = info->j;
    C int rkkkrule=info->rule;
    C double r2 = sqrt ( 2.0 );
    double product = 1.0;
    double term=0.0, z1=0.0, z2=0.0;
    for ( k = 0; k <= info->n; k++ )	{
        assert (info->sigma[k] > 0.0);
	// printf ( "cj=%g k=%d muk=%g sigma[k]=%g\n", cj, k, info->mu[k], info->sigma[k] );
	// printf ( "s=%g k=%d muk=%g sigma[k]=%g\n", info->s, k, info->mu[k], info->sigma[k] );

	switch (rkkkrule )
        {
	  case 1:
	    assert ( info->s <= cj );
	    if (  k == j ) {
		term = 1.0;
	        break;
	    }
            z1 = ( cj - info->mu[ k ] ) / ( r2 * info->sigma[ k ] );
	    z2 = ( info->s - info->mu[ k ] ) / ( r2 * info->sigma[ k ] );
	    assert ( z2 <= z1 );
	    term = 1.0 - ( erf( z1  ) - erf( z2 ) ) / 2.0;
	    // printf ( "z1=%g z2=%g term=%g\n", z1, z2, term );
            break;
         case 2:
	   assert ( info->s >= cj );
	   if ( k == j )  {
		term = 1.0;
	        break;
	    }
	    z1 = (cj - info->mu[ k ] ) / ( r2 * info->sigma[ k ] );
	    z2 = ( info->s - info->mu[ k ] ) / ( r2 * info->sigma[ k ] );
	    assert ( z2 >= z1 );
	    term = 1.0 - ( erf( z2 ) - erf( z1 ) ) / 2.0;
            break;	
	 case 3:
	    if ( cj <= info->s ) {
	       term = 1.0;
	       break;
	    }
	    assert( cj > ( 2 * info->s - cj ) );
	    if ( k == j )  {
		term = 1.0;
	        break;
	    }
	    z1 = ( ( 2 * info->s - cj ) - info->mu[ k ] ) / ( r2 * info->sigma[ k ] );
	    z2 = ( cj - info->mu[ k ] ) / ( r2 * info->sigma[ k ] );
	    assert ( z2 >= z1 );
	    term = 1.0 - ( erf( z2  ) - erf( z1 ) ) / 2.0;
	    // printf ( "z1=%g z2=%g term=%g\n", z1, z2, term );
            break;
	 case 4:   
	     // EQ (3C)
	     assert ( ( 2 * info->s - cj ) >= cj );
	     if ( k == j ) {
		term = 1.0;
	        break;
	     }
	     z1 = ( cj - info->mu[ k ] ) / ( r2 * info->sigma[ k ] );
	     z2 = ( ( 2 * info->s - cj ) - info->mu[ k ] ) / ( r2 * info->sigma[ k ] );
	     assert ( z2 >= z1 );
	     term = 1.0 - ( erf( z2  ) - erf( z1 ) ) / 2.0;
	      // printf ( "z1=%g z2=%g term=%g\n", z1, z2, term );
              break;

        }
	assert ( term >= -EPS );
	assert ( term <= 1.0 + EPS );
	product *= term;
	assert ( product >= 0 );
    }
    double prxt = normal ( cj, info->mu[ j ], info->sigma[ j ] ) * product;
    if ( prxt < 0 ) fprintf(stderr, "Innerkernel %g %g\n", cj, info->s);
    assert ( prxt >= 0 );
    return prxt;

}

double eq3a_wrap ( int rk1kk23, int ie3a, int je3a, double *pp, C struct rsmgff *isp)
{
    // CSDT: ssdsum == 0
    int iq, jq;
    double dprob, mumax, sigmasum = 0.0;

    assert( ( isp->csdev == 1 ) || ( isp->csduv == 1 ) );
    jq = je3a;
    C int nc = isp->numc;
    assert ( jq >= 0 && jq <= nc );
    C double mus = pp [ isp->sm_start + ie3a ];
    C double sigmas = DBL0;
    double *mu = double1alloc(nc + 1);
    double *sigma = double1alloc(nc + 1);
    mumax = mus;
    for( iq = 0; iq <nc; iq++ )	{
	mu [ iq ] = pp [ isp->cm_start + iq ];
	sigma [ iq ] = pp [ isp->csd_start + iq ];
	sigmasum += sigma[ iq ];
	if( mumax < mu [ iq ] + 6 * sigma[ iq ] )
		mumax = mu[ iq ] + 6 * sigma[ iq ];
    }
    mu[ iq ] = mumax;
    sigma[ iq ] = sigmasum / nc;
    // printf ( "mu[%d]=%g sigma[%d]=%g\n", iq, mu [ iq ], iq, sigma [ iq ] );
    dprob = eq3a ( rk1kk23, jq, nc, mu, sigma, mus, sigmas, isp );
    double1free ( mu );
    double1free ( sigma );
    return ( dprob );
}

double eq3a ( int rk1kk23, int j, int n, double *mu, double *sigma, double mus, double sigmas, C struct rsmgff *isp )
{
    assert(isp);
    struct info_s info;
    C double s = mus;
    C int nc = isp->numc;
    info.j = j;
    info.sigma = sigma;
    info.n = n;
    info.mu = mu;
    info.mus = mus;
    info.sigmas = sigmas;
    info.isp = isp;
    info.rule = rk1kk23;
    infoinner_s iinner(&info, s);
    C double pinf = iinner.mu[ j ] + iinner.sigma[ j ] * 6.0;
    C double minf = iinner.mu[ j ] - iinner.sigma[ j ] * 6.0;

    // Check foor no integration
    if ( ( ( info.rule == 1 ) || (  info.rule == 3 ) ) && ( pinf <= s ) ) return 0.0;
    if ( (  info.rule == 2 ) && ( minf >= s ) ) return 0.0;

    // printf ( "\t*s=%g pinf=%g n=%g ik=%g\n", s, pinf, normal ( s, iinner.mus, iinner.sigmas ),
    //      qromox ( innerkernel, s, pinf, INTALG, &iinner, nc, iinner.qracc(), sguess, KMAX, RATIONAL_INNER ) );

    C double sguess = 0.2;
    double qr = 0.0;


    if (  info.rule == 1 ) {
       if ( s < iinner.mu [ j ] ) {
 	    qr = qromox ( innerkernel, s>minf?s:minf, iinner.mu[j], INTALG, &iinner, nc, iinner.qracc(), sguess, KMAX, RATIONAL_INNER );
	    if(!finite(qr)) return quiet_nan(0);
	    qr += qromox ( innerkernel, iinner.mu[j], pinf, INTALG, &iinner, nc, iinner.qracc(), 0.5*(sguess+fabs(qr)), KMAX, RATIONAL_INNER );
       }
       else qr = qromox ( innerkernel, s>minf?s:minf, pinf, INTALG, &iinner, nc, iinner.qracc(), sguess, KMAX, RATIONAL_INNER );
    }
    if (  info.rule == 2 ) {
       double brr2 = (s - minf ) / 3;
       if ( s > brr2 ) {
	    qr = qromox ( innerkernel, brr2, s, INTALG,  &iinner, nc, iinner.qracc(), sguess, KMAX, RATIONAL_INNER );
	 if(!finite(qr)) return quiet_nan(0);
	    qr += qromox ( innerkernel, minf,  brr2, INTALG, &iinner, nc, iinner.qracc(), 0.5*(sguess+fabs(qr)), KMAX, RATIONAL_INNER );
       }
       else  qr = qromox ( innerkernel,  minf, s, INTALG, &iinner, nc, iinner.qracc(), sguess, KMAX, RATIONAL_INNER );
    }
    if (  info.rule == 3 ) {
       // First part of Rule 3
       if ( s < iinner.mu [ j ] ) {
 	    qr = qromox ( innerkernel, s>minf?s:minf, iinner.mu[j], INTALG, &iinner, nc, iinner.qracc(), sguess, KMAX, RATIONAL_INNER );
	    if(!finite(qr)) return quiet_nan(0);
	    qr += qromox ( innerkernel, iinner.mu[j], pinf, INTALG, &iinner, nc, iinner.qracc(), 0.5*(sguess+fabs(qr)), KMAX, RATIONAL_INNER );
       }
       else qr = qromox ( innerkernel, s>minf?s:minf, pinf, INTALG, &iinner, nc, iinner.qracc(), sguess, KMAX, RATIONAL_INNER );
       if ( info.j== 0 ) return qr;

       // Else second part of Rule 3
       info.rule = 4;
       if ( minf >= s ) return 0.0;
       info.j = j - 1;
       iinner.rule = 4;
       iinner.j  = j - 1;
       if ( s > iinner.mu [ j - 1 ] ) {
	  qr += qromox ( innerkernel, minf,  iinner.mu[j - 1], INTALG, &iinner, nc, iinner.qracc(), 0.5*(sguess+fabs(qr)), KMAX, RATIONAL_INNER );
          qr += qromox ( innerkernel, iinner.mu [ j - 1 ], s, INTALG, &iinner, nc, iinner.qracc(), sguess, KMAX, RATIONAL_INNER );
	  if(!finite(qr)) return quiet_nan(0);
       }
       else   qr += qromox ( innerkernel,  minf, s, INTALG, &iinner, nc, iinner.qracc(), sguess, KMAX, RATIONAL_INNER );
    }
    return qr;
}


int sdt ( int isdtx, struct rsmgff *isp )
{
    /* For signal detection theory, this function calculates p( R=j|Si ) for dprob_mat. 
       Rules 1 and 2 give identical results. Parameters are in pp */ 

    assert(isp);
    double ddenom, lastcp = 0, newcp = 0;

    // Get probability matrix value from scale values.
    ddenom = isp->allparameters [ isp->ssd_start + isdtx ];
    if ( ddenom <  DBL0 ) ddenom = DBL0;
    // Get all but last p=jsdt
    for ( int jsdt = 0; jsdt < isp->numr - 1; jsdt++ ) {
        /* Get z value  */
        double z_sdt = ( isp->allparameters [ isp->cm_start + jsdt ] - isp->allparameters [ isdtx ] ) / ddenom;
        newcp = gsl_cdf_ugaussian_P ( z_sdt );
	assert ( newcp >= lastcp );
        isp->dprob_mat [ isdtx ] [ jsdt ] = newcp - lastcp;
	lastcp = newcp;
    }
    // Get last entry for R=numr
    assert ( lastcp <= 1 );
    isp->dprob_mat [ isdtx ] [ isp->numr - 1 ] = 1 - lastcp;
    return ( 0 );
}


double Max(double a, double b) {
    return a > b ? a : b;
}

void wsdo_l_f_mgf (  struct rsmgff *isp )
{
  // This function takes the (pseudo)data matrix to get l_f, log likelihood. It ues the probability
  //     and proportion matrices to get measures of goodness of fit.
  //     isp->mgf [  ]  has the following arrangement:
  //          [ 0 ] : log_P
  //          [ 1 ] : r-sq
  //          [ 2 ] : rmsd
  //          [ 3 ] : b0
  //          [ 4 ] : b1
  //          [ 5 ] : k_l_div 

    assert( isp );
    int iev, jev;
    double l_f = 0.0;
    for ( int iev = 0; iev < isp->nums; iev++ )  {
	for ( int jev = 0; jev < isp->numr; jev++ ) {
//	    assert ( isp->freq_mat [ iev ] [ jev ] >= -EPS );
	    isp->prop_mat [ iev ] [ jev ] = isp->freq_mat [ iev ] [ jev ] / double ( isp->t_p_s );
	    double prby = Max(isp->dprob_mat [ iev ] [ jev ], 1e-20);
	    l_f += log( prby ) * isp->freq_mat [ iev ] [ jev ];
        }
    }
    isp->mgf [ 0 ]  = l_f;

    // Get sums, sumsquares, sumxprod, sumdiffssq    
    double sumd = 0.0, sumsqd = 0.0, sumt = 0.0, sumsqt = 0.0, sumdiffsq = 0.0, sumdt = 0.0;
    for ( iev = 0; iev < isp->nums; iev++ ) {
        for ( jev = 0; jev < isp->numr; jev++ ) {
            sumd += isp->prop_mat [ iev ] [jev ];
            sumsqd += isp->prop_mat [ iev ] [jev ] * isp->prop_mat [ iev ] [jev ];
            sumt += isp->dprob_mat [ iev ] [jev ];
            sumsqt += isp->dprob_mat [ iev ] [jev ] * isp->dprob_mat [ iev ] [jev ];
            sumdt += isp->prop_mat [ iev ] [jev ] * isp->dprob_mat [ iev ] [jev ];
	    double p_d_diff = isp->prop_mat [ iev ] [jev ] - isp->dprob_mat [ iev ] [jev ];
            sumdiffsq += ( p_d_diff * p_d_diff ); 
        }
    }

    int totn = isp->nums * isp->numr;
    int df = totn - isp->nums - 2;
    isp->mgf [ 2 ]  = sqrt( sumdiffsq / totn );
    double md = sumd / totn;
    double mt = sumt / totn;
    double mtsq = mt * mt;
    double mtmd = mt * md;
    double sigd = sqrt( ( sumsqd  - md * md * totn ) / ( totn - 1 ) );
    double sigt = sqrt( ( sumsqt  - mtsq * totn ) / ( totn - 1 ) );
    double pearsr = ( sumdt / totn - mtmd ) / ( sigd * sigt );
    isp->mgf [ 1 ]  = pearsr * pearsr;
    isp->mgf [ 4 ]  = ( sumdt - totn * mtmd )/( sumsqt - totn * mtsq );
    isp->mgf [ 3 ]  = md - isp->mgf [ 4 ]  * mt;

    // Prevent true zeroes in dprob_mat when data >0 before Kullback-Leibler calculation
    isp->mgf [ 5 ]  = 0;
    for ( iev = 0; iev < isp->nums; iev++ ) {
        for ( jev = 0; jev < isp->numr; jev++ ) {
	    if ( isp->prop_mat [ iev ] [jev ] > 0 ) {
		double dprb = isp->dprob_mat [ iev ] [ jev ];
		if (dprb == 0) dprb = 1.0E-15;
		isp->mgf [ 5 ] += isp->prop_mat [ iev ] [ jev ] * log ( ( isp->prop_mat [ iev ] [ jev ] ) / dprb );
	    }
	}
    }
}


void write_p_f_pair ( C struct rsmgff *isp, int nset )
{
 
    int rpts, spts;

    fprintf( isp->inPtr, "\n\n*****************************************************************\n");
    if ( nset < 0 )fprintf( isp->inPtr, "\n   Set 0 only \n" );
    else fprintf( isp->inPtr, "\n   Set %d \n", nset ); 
    fprintf( isp->inPtr, "\n\n*****************************************************************\n\n");
    fprintf( isp->inPtr, "\n\n  Parameters: " );
    fprintf( isp->inPtr, "\n  Signal means\n " );
    for ( spts = 0; spts <= isp->sm_end; spts++ ) fprintf( isp->inPtr, "\t%5.3f", isp->allparameters [ spts ] );
    fprintf( isp->inPtr, "\n  Signal sd's\n " );
    for ( spts = isp->ssd_start; spts <= isp->ssd_end; spts++ ) fprintf( isp->inPtr, "  %5.3f", isp->allparameters [ spts ] );
    fprintf( isp->inPtr, "\n  Criterion means\n" );
    for ( spts = isp->cm_start; spts <= isp->cm_end; spts++ ) fprintf( isp->inPtr, "  %5.3f", isp->allparameters [ spts ] );
    fprintf( isp->inPtr, "\n  Criterion sds's\n" );
    for ( spts = isp->csd_start; spts <= isp->csd_end; spts++ ) fprintf( isp->inPtr, "  %5.3f", isp->allparameters [ spts ] );
    fprintf( isp->inPtr, "\n PR1 = %6.5f, PR2 = %6.5f, PR3 = %6.5f ", isp->allparameters [ isp->pstart ],
	     isp->allparameters [ isp->pstart + 1 ], isp->allparameters [ isp->pstart + 2 ] );

    /*    if ( PR1 !=0 ) {
        fprintf( isp->inPtr, "\n\n  PR1 = %5.3f", PR1 );
	fprintf( isp->inPtr, "\n  Rule 1 frequency matrix\n" );
	mat_out ( isp->freq1_mat );
    }
    if ( PR2 !=0 ) {
        fprintf( isp->inPtr, "\n\n  PR2 = %5.3f", PR2 );
	fprintf( isp->inPtr, "\n  Rule 2 frequency matrix\n" );
	mat_out ( isp->freq2_mat );
    }
    if ( isp->allparameters [ isp->pstart + 2 ] !=0 ) {
        fprintf( isp->inPtr, "\n\n  PR2 = %5.3f", PR2 );
	fprintf( isp->inPtr, "\n  Rule 3 frequency matrix\n" );
	mat_out ( isp->freq3_mat );
	}  */

    fprintf( isp->inPtr, "\n\n  Combined probability matrix\n" );
    for ( spts = 0; spts < isp->nums; spts++ ) {
	for ( rpts = 0; rpts < isp->numr; rpts++ ) fprintf( isp->inPtr, "  %5.3f", isp->dprob_mat [ spts ] [ rpts ] );
	fprintf( isp->inPtr, "\n" );
    }

    fprintf( isp->inPtr, "\n\n  Combined frequency matrix\n" );
    for ( spts = 0; spts < isp->nums; spts++ ) {
	for ( rpts = 0; rpts < isp->numr; rpts++ ) fprintf( isp->inPtr, "  %5d", isp->freq_mat [ spts ] [ rpts ] );
	fprintf( isp->inPtr, "\n" );
    }


    // Write measures of goodness of fit
    fprintf( isp->inPtr, "\n\n" );
    fprintf( isp->inPtr, "\n logP = %f", isp->mgf [ 0 ] );
    fprintf( isp->inPtr, "\n r-squared = %f", isp->mgf [ 1 ] );
    fprintf( isp->inPtr, "\n rmsd = %f", isp->mgf [ 2 ] );
    fprintf( isp->inPtr, "\n b0 = %f", isp->mgf [ 3 ] );
    fprintf( isp->inPtr, "\n b1 = %f", isp->mgf [ 4 ] );
    fprintf( isp->inPtr, "\n K_L = %f", isp->mgf [ 5 ] );
    fprintf( isp->inPtr, "\n\n" );
}

/* void mat_out ( int **fmat, C struct rsmgff *isp ) 
{
    for ( int spts = 0; spts < isp->nums; spts++ ) {
	for ( int rpts = 0; rpts < isp->numr; rpts++ ) fprintf( isp->inPtr, "\t%5d", fmat [ spts ] [ rpts ] );
	fprintf( isp->inPtr, "\n" );
    }
    }                                                                                  */

void free_dm ( C struct rsmgff *isp )
{

    int2free( isp->freq1_mat );
    int2free( isp-> freq2_mat );
    int2free( isp-> freq3_mat );
    int2free( isp-> freq_mat );

    double2free ( isp->dprob_1_mat );
    double2free ( isp->dprob_2_mat );
    double2free ( isp->dprob_3_mat );
    double2free ( isp->dprob_mat );
    double2free ( isp->prop_mat );

    double1free( isp->allparameters );
    double1free( isp->mgf );
    gsl_rng_free( r );
    fclose(  isp->inPtr );
}

