Example #1
0
    public static void dream_algm(int chain_num, int cr_num, double[] fit, int gen_num,
                                  double[] gr, ref bool gr_conv, ref int gr_count, int gr_num, double gr_threshold,
                                  double[] jumprate_table, int jumpstep, double[] limits, int pair_num,
                                  int par_num, int printstep,
                                  Func <int, double[], int, DensityResult> prior_density,
                                  Func <int, double[], double> sample_likelihood,
                                  ref double[] z)

    //****************************************************************************80
    //
    //  Purpose:
    //
    //    DREAM_ALGM gets a candidate parameter sample.
    //
    // Licensing:
    //
    //    This code is distributed under the GNU LGPL license.
    //
    //  Modified:
    //
    //    25 May 2013
    //
    //  Author:
    //
    //    Original FORTRAN90 version by Guannan Zhang.
    //    C++ version by John Burkardt.
    //
    //  Reference:
    //
    //    Jasper Vrugt, CJF ter Braak, CGH Diks, Bruce Robinson, James Hyman,
    //    Dave Higdon,
    //    Accelerating Markov Chain Monte Carlo Simulation by Differential
    //    Evolution with Self-Adaptive Randomized Subspace Sampling,
    //    International Journal of Nonlinear Sciences and Numerical Simulation,
    //    Volume 10, Number 3, March 2009, pages 271-288.
    //
    //  Parameters:
    //
    //    Input, int CHAIN_NUM, the total number of chains.
    //    3 <= CHAIN_NUM.
    //
    //    Input, int CR_NUM, the total number of CR values.
    //    1 <= CR_NUM.
    //
    //    Input, double FIT[CHAIN_NUM*GEN_NUM], the likelihood of
    //    each sample.
    //
    //    Input, int GEN_NUM, the total number of generations.
    //    2 <= GEN_NUM.
    //
    //    Input, double GR[PAR_NUM*GR_NUM],
    //    the Gelman-Rubin R statistic.
    //
    //    Input/output, int &GR_CONV, the Gelman-Rubin convergence flag.
    //
    //    Input/output, int &GR_COUNT, counts the number of generations
    //    at which the Gelman-Rubin statistic has been computed.
    //
    //    Input, int GR_NUM, the number of times the Gelman-Rubin
    //    statistic may be computed.
    //
    //    Input, double GR_THRESHOLD, the convergence tolerance for
    //    the Gelman-Rubin statistic.
    //
    //    Input, double JUMPRATE_TABLE[PAR_NUM], the jumprate table.
    //
    //    Input, int JUMPSTEP, forces a "long jump" every
    //    JUMPSTEP generations.
    //
    //    Input, double LIMITS[2*PAR_NUM], lower and upper bounds
    //    for each parameter.
    //
    //    Input, int PAIR_NUM, the number of pairs of
    //    crossover chains.
    //    0 <= PAIR_NUM.
    //
    //    Input, int PAR_NUM, the total number of parameters.
    //    1 <= PAR_NUM.
    //
    //    Input, int PRINTSTEP, the interval between generations on
    //    which the Gelman-Rubin statistic will be computed and written to a file.
    //
    //    Input/output, double Z[PAR_NUM*CHAIN_NUM*GEN_NUM], the Markov chain
    //    sample data.
    //
    //  Local parameters:
    //
    //    Local, int CHAIN_INDEX, the index of the current chain.
    //    1 <= CHAIN_INDEX <= CHAIN_NUM.
    //
    //    Local, double CR[CR_NUM], the CR values.
    //
    //    Local, double CR_DIS[CR_NUM], the CR distances.
    //
    //    Local, int CR_INDEX, the index of the selected CR value.
    //    1 <= CR_INDEX <= CR_NUM.
    //
    //    Local, double CR_PROB[CR_NUM], the probability of each CR.
    //
    //    Local, double CR_UPS[CR_NUM], the number of updates for each CR.
    //
    //    Local, int GEN_INDEX, the index of the current generation.
    //    1 <= GEN_INDEX <= GEN_NUM.
    //
    //    Local, double ZP[PAR_NUM], a candidate sample.
    //
    //    Local, int ZP_ACCEPT, the number of candidates accepted.
    //
    //    Local, double ZP_ACCEPT_RATE, the rate at which generated
    //    candidates were accepted.
    //
    //    Local, int ZP_COUNT, the number of candidates generated.
    //
    //    Local, double ZP_RATIO, the Metropolis ratio for a candidate.
    //
    {
        int gen_index;

        double[] zp_old    = new double[par_num];
        int      zp_count  = 0;
        int      zp_accept = 0;

        //
        //  Initialize the CR values.
        //
        double[] cr      = new double[cr_num];
        double[] cr_dis  = new double[cr_num];
        double[] cr_prob = new double[cr_num];
        int[]    cr_ups  = new int[cr_num];

        CR.cr_init(ref cr, ref cr_dis, cr_num, ref cr_prob, ref cr_ups);

        for (gen_index = 1; gen_index < gen_num; gen_index++)
        {
            int chain_index;
            for (chain_index = 0; chain_index < chain_num; chain_index++)
            {
                //
                //  Choose CR_INDEX, the index of a CR.
                //
                int cr_index = CR.cr_index_choose(cr_num, cr_prob);
                //
                //  Generate a sample candidate ZP.
                //
                double[] zp = Sample.sample_candidate(chain_index, chain_num, cr, cr_index, cr_num,
                                                      gen_index, gen_num, jumprate_table, jumpstep, limits, pair_num,
                                                      par_num, z);

                zp_count += 1;
                //
                //  Compute the log likelihood function for ZP.
                //
                double zp_fit = sample_likelihood(par_num, zp);

                int i;
                for (i = 0; i < par_num; i++)
                {
                    zp_old[i] = z[i + chain_index * par_num + (gen_index - 1) * par_num * chain_num];
                }

                double zp_old_fit = fit[chain_index + (gen_index - 1) * chain_num];
                //
                //  Compute the Metropolis ratio for ZP.
                //
                double pd1 = prior_density(par_num, zp, 0).result;

                double pd2 = prior_density(par_num,
                                           z, +0 + chain_index * par_num + (gen_index - 1) * par_num * chain_num).result;

                double zp_ratio = Math.Exp(
                    zp_fit + Math.Log(pd1) -
                    (zp_old_fit + Math.Log(pd2)));

                zp_ratio = Math.Min(zp_ratio, 1.0);
                //
                //  Accept the candidate, or copy the value from the previous generation.
                //
                double r = PDF.r8_uniform_01_sample();

                if (r <= zp_ratio)
                {
                    for (i = 0; i < par_num; i++)
                    {
                        z[i + chain_index * par_num + gen_index * par_num * chain_num] = zp[i];
                    }

                    zp_accept += 1;
                    fit[chain_index + gen_index * chain_num] = zp_fit;
                }
                else
                {
                    for (i = 0; i < par_num; i++)
                    {
                        z[i + chain_index * par_num + gen_index * par_num * chain_num] = zp_old[i];
                    }

                    fit[chain_index + gen_index * chain_num] = zp_old_fit;
                }

                switch (gr_conv)
                {
                //
                //  Update the CR distance.
                //
                case false:
                {
                    switch (cr_num)
                    {
                    case > 1:
                        CR.cr_dis_update(chain_index, chain_num, ref cr_dis, cr_index,
                                         cr_num, ref cr_ups, gen_index, gen_num, par_num, z);
                        break;
                    }

                    break;
                }
                }
            }

            switch (gr_conv)
            {
            //
            //  Update the multinomial distribution of CR.
            //
            case false:
            {
                switch (cr_num)
                {
                case > 1:
                {
                    switch ((gen_index + 1) % 10)
                    {
                    case 0:
                        CR.cr_prob_update(cr_dis, cr_num, ref cr_prob, cr_ups);
                        break;
                    }

                    break;
                }
                }

                break;
            }
            }

            switch ((gen_index + 1) % printstep)
            {
            //
            //  Every PRINTSTEP interval,
            //  * compute the Gelman Rubin R statistic for this generation,
            //    and determine if convergence has occurred.
            //
            case 0:
                GelmanRubin.gr_compute(chain_num, gen_index, gen_num, ref gr, ref gr_conv, ref gr_count,
                                       gr_num, gr_threshold, par_num, z);
                break;
            }

            switch (gr_conv)
            {
            //
            //  Check for outlier chains.
            //
            case false:
            {
                switch ((gen_index + 1) % 10)
                {
                case 0:
                    Chain.chain_outliers(chain_num, gen_index, gen_num, par_num, fit, z);
                    break;
                }

                break;
            }
            }
        }

        //
        //  Compute the acceptance rate.
        //
        double zp_accept_rate = zp_accept / (double)zp_count;

        Console.WriteLine("");
        Console.WriteLine("  The acceptance rate is " + zp_accept_rate + "");
    }