@*
PoissonianRandomVariable.tmpl

Created by Joe Hope on 2009-08-22.

Copyright (c) 2009-2012, Joe Hope

This program is 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 2 of the License, or
(at your option) any later version.

This program 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.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.

*@
@extends xpdeint.ScriptElement

@from xpdeint.CallOnceGuards import callOnceGuard

@def splitNoise($function)
@*doc:
Return the code to generate a new smaller poissonian noise from a previous noise.

The previous noise had a time step of ``_old_smallest_step`` a variable available in the C
code, not in the template itself.
*@
  @#
  @set noiseVector = $parent
// Split a poissonian noise
const real _new_var = 1.0 / (${noiseVector.spatiallyIndependentVolumeElement} * _new_step);
const real _old_volume = (${noiseVector.spatiallyIndependentVolumeElement} * _old_step);

  @capture loopString
    @silent nonUniformDimReps = noiseVector.nonUniformDimReps
    @if nonUniformDimReps
      @set volumeFixup = ' * '.join('%s * (%s)' % (dimRep.stepSize, dimRep.volumePrefactor) for dimRep in nonUniformDimReps)
      @set varFixup = ' / (' + volumeFixup + ')'
      @set volumeFixup = ' * ' + volumeFixup
    @else
      @set volumeFixup = ''
      @set varFixup = ''
    @end if
    @for componentNumber, component in enumerate(noiseVector.components)
${component} = _new_var${varFixup} * _poisplit_${noiseVector.id}(_new_step/_old_step, lrint(_old_array[_${noiseVector.id}_index_pointer + ${componentNumber}] * _old_volume${volumeFixup}));
    @end for
  @end capture
${loopOverFieldInBasisWithVectorsAndInnerContent(noiseVector.field, noiseVector.initialBasis, [noiseVector], loopString)}@slurp

  @#
@end def

@def makeNoises
@*doc:
  Return the code for the contents of the makeNoises function for
  a poissonian random variable, by which we mean a jump process.  
  Much of this is likely to change when we implement triggered filters
  to model jump processes efficiently.
*@
  @#
  @set noiseVector = $parent
  @#
const real _dVdt = ${noiseVector.spatiallyIndependentVolumeElement}@slurp
  @if not noiseVector.static:
 * _step@slurp
  @end if
;
const real _var = 1.0 / _dVdt;
  @capture loopString
    @silent nonUniformDimReps = noiseVector.nonUniformDimReps
    @if nonUniformDimReps
      @set volumeFixup = ' * '.join('%s * (%s)' % (dimRep.stepSize, dimRep.volumePrefactor) for dimRep in nonUniformDimReps)
      @set varFixup = ' / (' + volumeFixup + ')'
      @set volumeFixup = ' * ' + volumeFixup
    @else
      @set volumeFixup = ''
      @set varFixup = ''
    @end if
    @for component in noiseVector.components
${component} = _var${varFixup} * _poidev_${noiseVector.id}(${noiseMeanRate} * _dVdt${volumeFixup});
    @end for
  @end capture
${loopOverFieldInBasisWithVectorsAndInnerContent(noiseVector.field, noiseVector.initialBasis, [noiseVector], loopString)}@slurp
  @#
@end def

@def functionPrototypes
  @#
  @super
  @#
  @set noiseVector = $parent
  @#
real _poidev_${noiseVector.id}(real xm);
real _poisplit_${noiseVector.id}(real pp, int n);
  @#
@end def

@def functionImplementations
  @#
  @super
  @#
  @set noiseVector = $parent
  @#
real _poidev_${noiseVector.id}(real xm)
{
  real sq, alxm, g, em, t, y;

  if (xm < 12.0) {        // Use direct method
    g = exp(-xm);
    em = -1.0;
    t = 1.0;
    // Instead of adding exponential deviates it is equivalent
    // to multiply uniform deviates.  We never actually have to
    // take the log, merely compare to the pre-computed exponential
    do {
      ++em;
      t *= ${generator.zeroToOneRandomNumber()};
    } while (t > g);
  } else {
    // Use rejection method
    sq = sqrt(2.0*xm);
    alxm = log(xm);
    g = xm*alxm - lgamma(xm + 1.0);
    do {
      do {
        // y is a deviate from a Lorenzian comparison function
        y = tan(M_PI*${generator.zeroToOneRandomNumber()});
        // em is y, shifted and scaled
        em = sq*y + xm;
      } while (em < 0.0);  // Reject if in regime of zero probability
      em = floor(em);      // The trick for integer-valued distributions
      t = 0.9*(1.0 + y*y)*exp(em*alxm - lgamma(em + 1.0) - g);
      // The ratio of the desired distribution to the comparison
      // function; we reject by comparing it to another uniform
      // deviate. The factor 0.9 so that t never exceeds 1.
    } while (${generator.zeroToOneRandomNumber()} > t);
  }
  return em;
}

real _poisplit_${noiseVector.id}(real pp, int n)
{
  /*
  Returns as a floating-point number an integer value that is a random deviate drawn from
  a binomial distribution of n trials each of probability pp, using erand48(_generator) as a source of
  uniform random deviates. This is exactly the distribution that must be sampled when a poissonian process is split over two smaller time steps
  */

  long j;
  real am, em, g, p, bnl, sq, t, y;
  static real pc, plog, pclog, en, oldg;

  // The binomial distribution is invariant under changing pp to 1-pp,
  // if we also change the answer to n minus itself; we do this at the end.
  p = (pp <= 0.5 ? pp : 1.0-pp);

  // This is the mean of the deviate to be produced.
  am = n * p;

  if (n < 25) {
    // Use the direct method while n is not too large. This can require up to 25 calls to erand48(_generator).
    bnl = 0.0;
    for (j = 1; j <= n; j++)
      if (${generator.zeroToOneRandomNumber()} < p)
        ++bnl;
  } else if (am < 1.0) {
    // If fewer than one event is expected out of 25 or more trials, then the distribution is quite accurately Poisson. Use direct Poisson method.
    g = exp(-am);
    t = 1.0;
    for (j = 0; j <= n; j++) {
      t *= ${generator.zeroToOneRandomNumber()};
      if (t < g)
        break;
    }
    bnl = (j <= n ? j : n);
  } else {
    en = n;
    oldg = lgamma(en + 1.0);
    pc = 1.0 - p;
    plog = log(p);
    pclog = log(pc);
    sq = sqrt(2.0*am*pc);
    // The following code should by now seem familiar: rejection method with a Lorentzian comparison function.
    do {
      do {
        y = tan(M_PI*${generator.zeroToOneRandomNumber()});
        em = sq*y + am;
      } while (em < 0.0 || em >= (en+1.0)); // Reject.
      em = floor(em); // Trick for integer-valued distribution. 
      t = 1.2 * sq * (1.0 + y*y) * exp(oldg - lgamma(em + 1.0) - lgamma(en - em + 1.0) + em*plog + (en - em)*pclog); 
    } while (${generator.zeroToOneRandomNumber()} > t); // Reject. This happens about 1.5 times per deviate, on average.
    bnl = em;
  }
  if (p != pp) bnl = n - bnl; // Remember to undo the symmetry transformation.
  return bnl;
}

  @#
@end def

