updating entropy classes

updating entropy classes

/*
Behold, the Graph Entropy Module.  A nice introduction to this idea is
available from `Dr. Cho at Baylor University <http://web.ecs.baylor.edu/faculty/cho/Cho-Entropy.pdf>`_
*/
module GraphEntropy {
  use GraphUtils,
      Core;
  config const v = false;  // verbosity for logging

  class Crystal {
    var id: int,
        initialEntropy: real,
        entropy: real,
        originalElements: [1..0] string,
        crystalElements: [1..0] string;
  }
  /*
    Find the entropy of a given subgraph
   */
  proc subgraphEntropy(G: Graph, verts: domain) {
    var subgraph: [verts] G.Row.eltType,
       adjdom = verts,                         // Will hold the ids of all nodes adjacent to verts
       pints: [adjdom] real = 0,                // Internal edge weights per vertex
       pttls: [adjdom] real = 0,                // Total edge weight per vertex
       entropy: real = 0;

    /*
    Going to need to clean this up to one loop or so
    */
    for s in verts {
     var me = G.Row[s];
     var e = vertexLocalEntropy(me, verts);
     for nv in G.Row[s].neighborList {
       if !verts.member(nv[1]) && !adjdom.member(nv[1]) {
         // Don't calculate it again
         adjdom += nv[1];
         //writeln(" current adjdom: ", adjdom);
         var r = G.Row[nv[1]];
         // Break this out to its own variable for now to see if calcs are right
         var f = vertexLocalEntropy(r, verts);
         //writeln(" Vertex: ", nv[1], " Energy: ", e);
         e += f;
       }
     }
     //writeln(" Vertex: ", s, " Energy: ", e);
     entropy -= e;
    }
    return entropy;
  }

  /*
  Finds the entropy around a specific vertex by calculating the total weight of
  the interior and exterior edges, then applying a log multinomial

.. math::
  e = p_{interior} log (p_{interior}) + p_{exterior} log (p_{exterior})

   */
  proc vertexLocalEntropy(v: VertexData, interior: domain) {
    var interiorWeight:real = 0,
        totalWeight:real = 0;

    for n in v.neighborList {
      if interior.member(n[1]) {
        //writeln(" LOCALS ONLY, BRO! ", n, " -> ", n[1]);
        interiorWeight += n[2];
      }
      totalWeight += n[2];
    }
    return xlog2x(interiorWeight/totalWeight) + xlog2x(1-interiorWeight/totalWeight);
  }

  /*
    Try to find the smallest graph to express this set of nodes, eliminating ones that
    don't add entropy

    :param G: The parent Graph object
    :param interior: The vertex ids for the subgraph in question
   */
  proc minimalSubGraph(G: Graph, interior: domain) {
    var currentEntropy = subgraphEntropy(G, interior);
    var (entropy, minDom) = pruneBoundary(G, interior, currentEntropy);
    if v {
      writeln("  comming back from prune entropy=", entropy, " minDom=", minDom);
    }
    if minDom.size > 0 {
      (entropy, minDom) = growBoundary(G, minDom, entropy);
    }
    if v {
      writeln("  comming back from grow entropy=", entropy, " minDom=", minDom);
    }
    return (entropy, minDom);
  }

  proc pruneBoundary(G: Graph, interior: domain, entropy: real) {
    var currentEntropy = entropy,
        currentDomain = interior,
        minimalDomain = interior,
        initialNode = G.Row[interior.first];

    do {
      if v {
        writeln("   currentDomain, ", currentDomain);
      }
      var topDog = G.Row[currentDomain.first];
      for n in currentDomain {
        //writeln("\tchecking ", n);
        if G.Row[n].numNeighbors() > topDog.numNeighbors() {
          topDog = G.Row[n];
          if v {
            writeln("\tsetting pivot node to ", topDog.nid);
            writeln("\tvertex: ", n, " degree: ", topDog.numNeighbors());
          }
        }
      }

      // Prune only
      for n in topDog.neighborList {
        var d = interior;

        if d.member(n[1]) {
          d -= n[1];
          var e = subgraphEntropy(G, d);
          //writeln("\t\tinterior: ", d, "  energy: ", e);
          if e < currentEntropy {
            if v {
              writeln("\t\tremoving ", n[1], " from interior lowers entropy to ", e);
            }
            minimalDomain -= n[1];
            currentEntropy = e;
          }
        }
      }

      currentDomain -= topDog.nid;
    } while currentDomain.size > 0;
    return (currentEntropy, minimalDomain);
  }

  proc growBoundary(G: Graph, interior: domain, entropy: real) {
    var currentEntropy = entropy,
        currentDomain = interior,
        minimalDomain = interior,
        initialNode = G.Row[interior.first];

    do {
      if v {
        writeln("   currentDomain, ", currentDomain);
      }
      var topDog = G.Row[currentDomain.first];
      for n in currentDomain {
        if G.Row[n].numNeighbors() > topDog.numNeighbors() {
          topDog = G.Row[n];
          if v {
            writeln("\tsetting pivot node to ", topDog.nid);
            writeln("\tvertex: ", n, " degree: ", topDog.numNeighbors());
          }
        }
      }

      // Grow only only
      for n in topDog.neighborList {
        var d = interior;

        if !d.member(n[1]) {
          d += n[1];
          var e = subgraphEntropy(G, d);
          if e < currentEntropy {
            if v {
              writeln("\t\tadding ", n[1], " to interior lowers entropy to ", e);
            }
            minimalDomain += n[1];
            currentEntropy = e;
          }
        }
      }

      currentDomain -= topDog.nid;
    } while currentDomain.size > 0;
    return (currentEntropy, minimalDomain);
  }

}

/*
Behold, the Graph Entropy Module.  A nice introduction to this idea is
available from `Dr. Cho at Baylor University <http://web.ecs.baylor.edu/faculty/cho/Cho-Entropy.pdf>`_
*/
module GraphEntropy {
  use GraphUtils,
      Core;
  config const v = false;  // verbosity for logging

  class Crystal {
    var id: int,
        entropy: real,
        originalElements: [1..0] string,
        crystalElements: [1..0] string;
  }
  /*
    Find the entropy of a given subgraph
   */
  proc subgraphEntropy(G: Graph, verts: domain) {
    var subgraph: [verts] G.Row.eltType,
       adjdom = verts,                         // Will hold the ids of all nodes adjacent to verts
       pints: [adjdom] real = 0,                // Internal edge weights per vertex
       pttls: [adjdom] real = 0,                // Total edge weight per vertex
       entropy: real = 0;

    /*
    Going to need to clean this up to one loop or so
    */
    for s in verts {
     var me = G.Row[s];
     var e = vertexLocalEntropy(me, verts);
     for nv in G.Row[s].neighborList {
       if !verts.member(nv[1]) && !adjdom.member(nv[1]) {
         // Don't calculate it again
         adjdom += nv[1];
         //writeln(" current adjdom: ", adjdom);
         var r = G.Row[nv[1]];
         // Break this out to its own variable for now to see if calcs are right
         var f = vertexLocalEntropy(r, verts);
         //writeln(" Vertex: ", nv[1], " Energy: ", e);
         e += f;
       }
     }
     //writeln(" Vertex: ", s, " Energy: ", e);
     entropy -= e;
    }
    return entropy;
  }

  /*
  Finds the entropy around a specific vertex by calculating the total weight of
  the interior and exterior edges, then applying a log multinomial

.. math::
  e = p_{interior} log (p_{interior}) + p_{exterior} log (p_{exterior})

   */
  proc vertexLocalEntropy(v: VertexData, interior: domain) {
    var interiorWeight:real = 0,
        totalWeight:real = 0;

    for n in v.neighborList {
      if interior.member(n[1]) {
        //writeln(" LOCALS ONLY, BRO! ", n, " -> ", n[1]);
        interiorWeight += n[2];
      }
      totalWeight += n[2];
    }
    return xlog2x(interiorWeight/totalWeight) + xlog2x(1-interiorWeight/totalWeight);
  }

  /*
    Try to find the smallest graph to express this set of nodes, eliminating ones that
    don't add entropy

    :param G: The parent Graph object
    :param interior: The vertex ids for the subgraph in question
   */
  proc minimalSubGraph(G: Graph, interior: domain) {
    var currentEntropy = subgraphEntropy(G, interior);
    var (entropy, minDom) = pruneBoundary(G, interior, currentEntropy);
    if v {
      writeln("  comming back from prune entropy=", entropy, " minDom=", minDom);
    }
    if minDom.size > 0 {
      (entropy, minDom) = growBoundary(G, minDom, entropy);
    }
    if v {
      writeln("  comming back from grow entropy=", entropy, " minDom=", minDom);
    }
    return (entropy, minDom);
  }

  proc pruneBoundary(G: Graph, interior: domain, entropy: real) {
    var currentEntropy = entropy,
        currentDomain = interior,
        minimalDomain = interior,
        initialNode = G.Row[interior.first];

    do {
      if v {
        writeln("   currentDomain, ", currentDomain);
      }
      var topDog = G.Row[currentDomain.first];
      for n in currentDomain {
        //writeln("\tchecking ", n);
        if G.Row[n].numNeighbors() > topDog.numNeighbors() {
          topDog = G.Row[n];
          if v {
            writeln("\tsetting pivot node to ", topDog.nid);
            writeln("\tvertex: ", n, " degree: ", topDog.numNeighbors());
          }
        }
      }

      // Prune only
      for n in topDog.neighborList {
        var d = interior;

        if d.member(n[1]) {
          d -= n[1];
          var e = subgraphEntropy(G, d);
          //writeln("\t\tinterior: ", d, "  energy: ", e);
          if e < currentEntropy {
            if v {
              writeln("\t\tremoving ", n[1], " from interior lowers entropy to ", e);
            }
            minimalDomain -= n[1];
            currentEntropy = e;
          }
        }
      }

      currentDomain -= topDog.nid;
    } while currentDomain.size > 0;
    return (currentEntropy, minimalDomain);
  }

  proc growBoundary(G: Graph, interior: domain, entropy: real) {
    var currentEntropy = entropy,
        currentDomain = interior,
        minimalDomain = interior,
        initialNode = G.Row[interior.first];

    do {
      if v {
        writeln("   currentDomain, ", currentDomain);
      }
      var topDog = G.Row[currentDomain.first];
      for n in currentDomain {
        if G.Row[n].numNeighbors() > topDog.numNeighbors() {
          topDog = G.Row[n];
          if v {
            writeln("\tsetting pivot node to ", topDog.nid);
            writeln("\tvertex: ", n, " degree: ", topDog.numNeighbors());
          }
        }
      }

      // Grow only only
      for n in topDog.neighborList {
        var d = interior;

        if !d.member(n[1]) {
          d += n[1];
          var e = subgraphEntropy(G, d);
          if e < currentEntropy {
            if v {
              writeln("\t\tadding ", n[1], " to interior lowers entropy to ", e);
            }
            minimalDomain += n[1];
            currentEntropy = e;
          }
        }
      }

      currentDomain -= topDog.nid;
    } while currentDomain.size > 0;
    return (currentEntropy, minimalDomain);
  }

}


Converted format() to writef()

Converted format() to writef()

/** MRA -- MultiResolution Analysis Module

    Multiresolution representation of 1-d functions using a multiwavelet
    basis (similar to discontinuous spectral element with a hierarchal
    decomposition).

    Mad Chapel Author: James Dinan <dinan@cray.com>
                 Date: August, 2007

    Modified:  Mary Beth Hribar, September 2007

    This code is an adaptation of 1d Madness, originally written by Robert
    Harrison <harrisonrj@ornl.gov>, et al.
 */

use Math;
use Tensor;
use FTree;
use Quadrature;
use TwoScale;
use AnalyticFcn;

config const verbose = false;
config const debug   = false;

class Function {
    const k             = 5;    // use first k Legendre polynomials as the basis in each box
    const thresh        = 1e-5; // truncation threshold for small wavelet coefficients
    var   f: AFcn       = nil;  // analytic f(x) to project into the numerical represntation
    const initial_level = 2;    // initial level of refinement
    const max_level     = 30;   // maximum level of refinement mostly as a sanity check
    var   autorefine    = true; // automatically refine during multiplication
    var   compressed    = false;// keep track of what basis we are in

    // Sum and Difference coefficients
    var   sumC = new FTree(order=k);
    var   diffC = new FTree(order=k);

    // FIXME: Ideally all of these matrices should be const as well but they
    //        can't be presently since they must be assigned in initialize()

    // Two-Scale relationship matrices
    const hgDom = {0..2*k-1, 0..2*k-1};
    var   hg    : [hgDom] real; // FIXME: hg  =  hg_getCoeffs(k);
    var   hgT   : [hgDom] real; //        hgT => transpose(hg);

    // Quadrature coefficients
    const quadDom   = {0..k-1};
    var   quad_x    : [quadDom] real; // points
    var   quad_w    : [quadDom] real; // weights

    const quad_phiDom = {0..k-1, 0..k-1};
    var   quad_phi    : [quad_phiDom] real; // phi[point,i]
    var   quad_phiT   : [quad_phiDom] real; // phi[point,i] transpose
    var   quad_phiw   : [quad_phiDom] real; // phi[point,i]*weight[point]

    // blocks of the block tridiagonal derivative operator
    const dcDom = {0..k-1, 0..k-1};
    var   rm    : [dcDom] real;
    var   r0    : [dcDom] real;
    var   rp    : [dcDom] real;

    proc ~Function() {
        delete sumC;
        delete diffC;
    }

    proc initialize() {
        if debug then writeln("Creating Function: k=", k, " thresh=", thresh);

        if debug then writeln("  initializing two-scale relation coefficients");
        hg  = hg_getCoeffs(k);
        transposeCopy(hgT, hg);

        if debug then writeln("  initializing quadrature coefficients");
        init_quadrature(k);

        // blocks of the block tridiagonal derivative operator
        if debug then writeln("  initializing tridiagonal derivative operator");
        make_dc_periodic();

        // initial refinement of analytic function f(x)
        if f != nil {
            if debug then writeln("  performing initial refinement of f(x)");
            for l in 0..2**initial_level-1 do
                refine((initial_level, l));
        }

        if debug then writeln("done.");
    }

    /** Initialize the quadrature coefficient matricies.
     */
    proc init_quadrature(order: int) {
        quad_x   = gl_getPoints(k);
        quad_w   = gl_getWeights(k);

        for i in quad_phiDom.dim(1) {
            var p = phi(quad_x[i], k);
            quad_phi [i, ..] = p;
            quad_phiw[i, ..] = quad_w[i] * p;
            quad_phiT[.., i] = p;
        }
    }

    /** Return the level-0 blocks rm, r0, rp of the central
        difference derivative operator with periodic boundary
        conditions on either side.
     */
    proc make_dc_periodic() {
        var iphase = 1.0;
        for i in dcDom.dim(1) {
            var jphase = 1.0;

            for j in dcDom.dim(2) {
                var gammaij = sqrt((2*i+1) * (2*j+1));
                var Kij = if (i-j) > 0 && ((i-j) % 2) == 1 then
                        2.0 else 0.0;
                r0[i,j] = 0.5*(1.0 - iphase*jphase - 2.0*Kij)*gammaij;
                rm[i,j] = 0.5*jphase*gammaij;
                rp[i,j] =-0.5*iphase*gammaij;
                jphase = -jphase;
            }
            iphase = -iphase;
        }
    }

    /** Return a deep copy of this Function
     */
    proc copy() {
        return new Function(k=k, thresh=thresh, f=f, initial_level=initial_level,
                max_level=max_level, autorefine=autorefine, compressed=compressed,
                sumC=sumC.copy(), diffC=diffC.copy());
    }

    /** Return a copy of this function's skeleton
     */
    proc skeletonCopy() {
        // Omit: f, compressed, sumC, diffC
        return new Function(k=k, thresh=thresh, initial_level=initial_level,
                max_level=max_level, autorefine=autorefine);
    }

    /** s[n, l] = integral(phi[n][l](x) * f(x))
        for box (n,l) project f(x) using quadrature rule
        into scaling function basis
     */
    proc project(curNode: 2*int) {
        const (n, l) = curNode;
        var h     = 0.5 ** n;
        var scale = sqrt(h);
        var s  : [quadDom] real;

        for mu in quad_phiDom.dim(1) {
            var x  = (l + quad_x[mu]) * h;
            var fx = f(x);
            for i in quad_phiDom.dim(2) do
                s[i] += scale * fx * quad_phiw[mu, i];
        }

        return s;
    }

    /** Refine numerical representation of f(x) to desired tolerance
     */
    proc refine(curNode: 2*int) {
        // project f(x) at next level
        var sc : [0..2*k-1] real;
        var s0 : [0..k-1] => sc[0..k-1];
        var s1 : [0..k-1] => sc[k..2*k-1];

        const child = sumC.get_children(curNode);
        s0 = project(child(1));
        s1 = project(child(2));

        // apply the two scale relationship to get difference coeff
        // in 1d this is O(k^2) flops
        var dc = sc*hgT;

        // check to see if within tolerance
        // normf() is Frobenius norm == 2-norm for vectors
        var nf = normf(dc[k..2*k-1]);
        const (n, _) = curNode;
        if((nf < thresh) || (n >= (max_level-1))) {
            sumC[child(1)] = s0;
            sumC[child(2)] = s1;
        }
        else {
            // these recursive calls on sub-trees can go in parallel
            // if the HashMap is syncronized
            refine(child(1));
            refine(child(2));
        }
    }

    /** Evaluate numerical representation of f at x.  Performed in scaling
        function basis only.
     */
    proc this(x) {
        if compressed then reconstruct();
        return evaluate( rootNode, x);
    }

    /** eval f(x) using adaptively refined numerical representation of f(x)
        answer should be within tolerance of the analytical f(x)

        Descend tree looking for box (n,l) with scaling function
        coefficients containing the point x.
     */
    proc evaluate(curNode = rootNode, in x): real {
        if sumC.has_coeffs(curNode) {
            const (n,_) = curNode;
            var p = phi(x, k);
            return inner(sumC[curNode], p)*sqrt(2.0**n);

        } else {
            const child = sumC.get_children(curNode);
            if (2*x < 1) then
                return evaluate (child(1), 2*x);
            else
                return evaluate (child(2), 2*x-1);
        }
    }

    /** change from scaling function basis to
        multi-wavelet basis (sumC -> diffC)
        tree is filled out with sumC[0][0] and diffC
        n is level in tree
        l is box index
     */
    proc compress(curNode = rootNode) {
        if compressed then return;

        // sub-trees can be done in parallel
        const child = sumC.get_children(curNode);
        if !sumC.has_coeffs(child(1)) then compress(child(1));
        if !sumC.has_coeffs(child(2)) then compress(child(2));

        var sc: [0..2*k-1] real;
        sc[0..k-1]   = sumC(child(1));
        sc[k..2*k-1] = sumC(child(2));

        // apply the two scale relationship to get difference coeff
        // in 1d this is O(k^2) flops (in 3d this is O(k^4) flops)
        var dc = sc*hgT;

        sumC[curNode] = dc[0..k-1];
        diffC[curNode] = dc[k..2*k-1];

        sumC.remove(child(1));
        sumC.remove(child(2));

        const (n,_) = curNode;
        if n==0 then compressed = true;
    }

    /** change from multi-wavelet basis to scaling function basis (d -> s)
        tree just has s at leaves
        n is level in tree
        l is box index
     */
    proc reconstruct(curNode = rootNode) {
        if !compressed then return;

        if diffC.has_coeffs(curNode) {
            var dc: [0..2*k-1] real;
            dc[0..k-1]   = sumC[curNode];
            dc[k..2*k-1] = diffC[curNode];
            diffC.remove(curNode);
            sumC.remove(curNode);

            // apply the two scale relationship to get difference coeff
            // in 1d this is O(k^2) flops (in 3d this is O(k^4) flops)
            var sc = dc*hg;

            const child = sumC.get_children(curNode);
            sumC[child(1)] = sc[0..k-1];
            sumC[child(2)] = sc[k..2*k-1];

            // sub-trees can be done in parallel
            reconstruct(child(1));
            reconstruct(child(2));
        }

        const (n,_) = curNode;
        if n == 0 then compressed = false;
    }

    /** In s are scaling coefficients for box n,l ... apply twoscale to generate
        the corresponding coefficients on level n+1 and insert the results into
        the tree of scaling function coefficients.
     */
    proc recur_down(curNode: 2*int) {
        if debug then writeln(" + recur_down",curNode);

        var sc : [0..2*k-1] real;
        sc[0..k-1] = sumC[curNode];

        var new_sc = sc*hg;
        const child = sumC.get_children(curNode);
        sumC(child(1)) = new_sc[0..k-1];
        sumC(child(2)) = new_sc[k..2*k-1];
    }

    /** If the scaling coefficients in box n,l exist, return them.
        (allow here for zero boundary conditions for boxes just off
        the ends of the domain)

        Else recur up to the next level looking for a parent.  If a
        parent exists, use two scale to recur those coefficients down
        to make n,l.  Note that this modifies the tree in place and
        you should eventually call sclean to tidy up when finished.

        Else, return None (corresponding child boxes exist at a finer scale)
     */
    proc get_coeffs(curNode: 2*int) {
        if debug then writeln(" @ get_coeffs",curNode);

        // Check to see if curNode is on the boundary.  If so,
        // return zeros for the coefficients.
        if sumC.on_boundary(curNode) {
           var coeffs : [0..k-1] real;
           return coeffs;
        }
        // Walk up the tree to find scaling coeffs
        var foundNode = emptyNode;
        for Node in sumC.path_upwards(curNode,rootNode) {
          if sumC.has_coeffs(Node) {
             foundNode = Node;
             break;
          }
        }

        // Didn't find coeffs, they must be below curNode
        if (foundNode == emptyNode) then return None;

        for Node in sumC.path_downwards(foundNode,curNode) {
            recur_down(Node);
        }
        return sumC[curNode];
    }

    /** Differentiation (also inner and mul) may leave scaling function
        coefficients below their original level.  Recur down to the
        locally first box with scaling function coefficients.
        Delete all children below there.
     */
    proc sclean(curNode = rootNode, in cleaning=false) {
        if cleaning { //then
            if debug then writeln(" + sclean deleting ", curNode);
            sumC.remove(curNode);
        } else
            cleaning = sumC.has_coeffs(curNode);

        // Sub trees can run in parallel
        const (n,_) = curNode;
        if n < max_level {
            const child = sumC.get_children(curNode);
            if !cleaning || sumC.has_coeffs(child(1)) then
                sclean(child(1), cleaning);
            if !cleaning || sumC.has_coeffs(child(2)) then
                sclean(child(2), cleaning);
        }
    }

    /** Differentiate the function, which corresponds to application
        of a block triadiagonal matrix.  For an adaptively refined
        target function we may need to refine boxes down until three
        boxes exist in the same scale.
     */

  proc diff() {
    proc diffHelper(curNode = rootNode, result) {
        const (n,l) = curNode;
        if debug then writeln(" * diff",curNode);
        if !sumC.has_coeffs(curNode) {
            // Sub trees can run in parallel
            // Run down tree until we hit scaling function coefficients
            const child = sumC.get_children(curNode);
            diffHelper((n+1, 2*l), result);
            diffHelper((n+1, 2*l+1), result);
        } else {
            // These can also go in parallel since may involve
            // recurring up & down the tree.
            const neighbor = sumC.get_neighbors(curNode);
            if debug then writeln(" * diff: coeffs at ",curNode);
            var sm = get_coeffs(neighbor(1));
            var sp = get_coeffs(neighbor(2));
            var s0 = sumC[curNode];

            // We have s0, check if we found sm and sp at this level
            if !isNone(sm) && !isNone(sp) {
                var r = rp*sm + r0*s0 + rm*sp;
                result.sumC[curNode] = r * 2.0**n;
            } else {
                recur_down(curNode);
                // Sub trees can run in parallel
                diffHelper((n+1, 2*l), result);
                diffHelper((n+1, 2*l+1), result);
            }
        }
    }

    if compressed then reconstruct();
    var result = skeletonCopy();

    diffHelper(rootNode, result);

    sclean();
    return result;
  }

    /** Return sqrt(integral(f(x)**2))
     */
    proc norm2() {
        if compressed then reconstruct();
        return sqrt(+ reduce [i in sumC] normf(i)**2);
    }

    /** Perform GAXPY in the multi-wavelet (compressed) basis
        this = alpha*this + beta*other (other is not changed).
     */
    proc gaxpy(alpha, other, beta) {
        if !compressed then compress();
        if !other.compressed then other.compress();

        sumC[rootNode] = sumC[rootNode]*alpha + other.sumC[rootNode]*beta; // Do scaling coeffs
	for i in diffC.index_iter() {
            diffC[i] *= alpha;
        }
	for i in other.diffC.index_iter() {
            diffC[i] += other.diffC[i]*beta;
        }

        // return this so operations can be chained
        return this;
    }

    /** Add this function to another and return the result in a new
        function.  This and other are unchanged.
     */
    proc add(other) {
        return copy().gaxpy(1.0, other, 1.0);
    }

    /** Subtract this function from another and return the result in a new
        function.  This and other are unchanged.
     */
    proc subtract(other) {
        return copy().gaxpy(1.0, other, -1.0);
    }

    /** Recursively multiply f1 and f2 put the result into this
     */
    proc multiply(f1, f2, curNode = rootNode) {
        const child = sumC.get_children(curNode);
        if f1.sumC.has_coeffs(curNode) && f2.sumC.has_coeffs(curNode) {
            const (n,_) = curNode;
            if autorefine && n+1 <= max_level {
                // if autorefine is set we are multiplying two polynomials
                // of order k-1 the result could be up to order 2(k-1) so
                // refine one more level to reduce the error and try to
                // keep it within the threshold

                // refine both one more level
                f1.recur_down(curNode);
                f2.recur_down(curNode);

                // scale factor for this level = sqrt((2^d)^(n+1))
                var scale_factor = sqrt(2.0**(n+1));

                // multiply f1.s[n+1][2*l] and f2.s[n+1][2*l]
                var f = f1.sumC[child(1)] * quad_phiT;
                var g = f2.sumC[child(1)] * quad_phiT;
                f *= g; // Note: Element-wise multiplication
                sumC[child(1)] = (f * quad_phiw) * scale_factor;

                // multiply f1.s[n+1][2*l+1] and f2.s[n+1][2*l+1]
                f  =  f1.sumC[child(2)] * quad_phiT;
                g  =  f2.sumC[child(2)] * quad_phiT;
                f *= g;
                sumC[child(2)] = (f * quad_phiw) * scale_factor;

            } else {
                // if autorefine is not set or we are at the max_level
                // live with what you get
                var f = f1.sumC[curNode] * quad_phiT;
                var g = f2.sumC[curNode] * quad_phiT;
                f *= g;

                // scale factor for this level = sqrt((2^d)^(n+1))
                sumC[curNode] = (f * quad_phiw) * sqrt(2.0**(n));
            }

        } else {
            if f1.sumC.has_coeffs(curNode) && !f2.sumC.has_coeffs(curNode) then
                // refine this box down to next level in f1
                f1.recur_down(curNode);
            else if !f1.sumC.has_coeffs(curNode) && f2.sumC.has_coeffs(curNode) then
                // refine this box down to next level in f2
                f2.recur_down(curNode);

            // calls on sub-trees can go in parallel
            multiply(f1, f2, child(1));
            multiply(f1, f2, child(2));
        }
    }

    /** Function Multiplication:
        For multiply, both operands need to be in the scaling function basis
        so possibly call reconstruct on one or both of them first
     */
    proc multiply(other) {
        if compressed then reconstruct();
        if other.compressed then other.reconstruct();

        // Store the result in a new Function
        var result = skeletonCopy();
        result.multiply(this, other);

        sclean();
        other.sclean();

        return result;
    }

    inline proc truncate(x) {
      const eps = 1e-8;
      if abs(x) < eps then return 0.0;
      else return x;
    }

    /** Mostly for debugging, print summary of coefficients,
        optionally printing the norm of each block
     */
    proc summarize() {
        writeln("\n-----------------------------------------------------");
        writeln("k=", k, " thresh=", thresh, " compressed=", compressed);
        writeln("sum coefficients:");
        for n in 0..max_level {
            var sum = 0.0, ncoeffs = 0;
            for box in sumC.lvl_iter(n) {
                sum     += normf(box)**2;
                ncoeffs += 1;
            }
            if ncoeffs != 0 then
	        writef("   level ##   %#boxes=####  norm=%0.2er\n",
		       n, ncoeffs, truncate(sqrt(sum)));
        }

        writeln("difference coefficients:");
        for n in 0..max_level {
            var sum = 0.0, ncoeffs = 0;
            for box in diffC.lvl_iter(n) {
                sum     += normf(box)**2;
                ncoeffs += 1;
            }
            if ncoeffs != 0 then
	        writef("   level ##   %#boxes=####  norm=%0.2er\n",
		       n, ncoeffs, truncate(sqrt(sum)));
        }

        writeln("-----------------------------------------------------\n");
    }

    /** Evaluate the analytic and numerical functions over the given interval
        and print the error.
     */
    proc evalNPT(npt) {
        for i in 0..npt {
            var (fval, Fval) = (f(i/npt:real), this(i/npt:real));
            writef(" -- %.2dr:  F_numeric()=% .8dr  f_analytic()=% .8dr%s\n",
		   i/npt:real, truncate(Fval), truncate(fval),
		   if abs(Fval-fval) > thresh then " err > thresh" else "");
        }
    }
}

/*************************************************************************/
/* Standard operations on Function objects:                              */
/*************************************************************************/

proc +(F: Function, G: Function): Function {
    return F.add(G);
}

proc -(F: Function, G: Function): Function {
    return F.subtract(G);
}

proc *(F: Function, G: Function): Function {
    return F.multiply(G);
}

/** MRA -- MultiResolution Analysis Module

    Multiresolution representation of 1-d functions using a multiwavelet
    basis (similar to discontinuous spectral element with a hierarchal
    decomposition).

    Mad Chapel Author: James Dinan <dinan@cray.com>
                 Date: August, 2007

    Modified:  Mary Beth Hribar, September 2007

    This code is an adaptation of 1d Madness, originally written by Robert
    Harrison <harrisonrj@ornl.gov>, et al.
 */

use Math;
use Tensor;
use FTree;
use Quadrature;
use TwoScale;
use AnalyticFcn;

config const verbose = false;
config const debug   = false;

class Function {
    const k             = 5;    // use first k Legendre polynomials as the basis in each box
    const thresh        = 1e-5; // truncation threshold for small wavelet coefficients
    var   f: AFcn       = nil;  // analytic f(x) to project into the numerical represntation
    const initial_level = 2;    // initial level of refinement
    const max_level     = 30;   // maximum level of refinement mostly as a sanity check
    var   autorefine    = true; // automatically refine during multiplication
    var   compressed    = false;// keep track of what basis we are in

    // Sum and Difference coefficients
    var   sumC = new FTree(order=k);
    var   diffC = new FTree(order=k);

    // FIXME: Ideally all of these matrices should be const as well but they
    //        can't be presently since they must be assigned in initialize()

    // Two-Scale relationship matrices
    const hgDom = {0..2*k-1, 0..2*k-1};
    var   hg    : [hgDom] real; // FIXME: hg  =  hg_getCoeffs(k);
    var   hgT   : [hgDom] real; //        hgT => transpose(hg);

    // Quadrature coefficients
    const quadDom   = {0..k-1};
    var   quad_x    : [quadDom] real; // points
    var   quad_w    : [quadDom] real; // weights

    const quad_phiDom = {0..k-1, 0..k-1};
    var   quad_phi    : [quad_phiDom] real; // phi[point,i]
    var   quad_phiT   : [quad_phiDom] real; // phi[point,i] transpose
    var   quad_phiw   : [quad_phiDom] real; // phi[point,i]*weight[point]

    // blocks of the block tridiagonal derivative operator
    const dcDom = {0..k-1, 0..k-1};
    var   rm    : [dcDom] real;
    var   r0    : [dcDom] real;
    var   rp    : [dcDom] real;

    proc ~Function() {
        delete sumC;
        delete diffC;
    }

    proc initialize() {
        if debug then writeln("Creating Function: k=", k, " thresh=", thresh);

        if debug then writeln("  initializing two-scale relation coefficients");
        hg  = hg_getCoeffs(k);
        transposeCopy(hgT, hg);

        if debug then writeln("  initializing quadrature coefficients");
        init_quadrature(k);

        // blocks of the block tridiagonal derivative operator
        if debug then writeln("  initializing tridiagonal derivative operator");
        make_dc_periodic();

        // initial refinement of analytic function f(x)
        if f != nil {
            if debug then writeln("  performing initial refinement of f(x)");
            for l in 0..2**initial_level-1 do
                refine((initial_level, l));
        }

        if debug then writeln("done.");
    }

    /** Initialize the quadrature coefficient matricies.
     */
    proc init_quadrature(order: int) {
        quad_x   = gl_getPoints(k);
        quad_w   = gl_getWeights(k);

        for i in quad_phiDom.dim(1) {
            var p = phi(quad_x[i], k);
            quad_phi [i, ..] = p;
            quad_phiw[i, ..] = quad_w[i] * p;
            quad_phiT[.., i] = p;
        }
    }

    /** Return the level-0 blocks rm, r0, rp of the central
        difference derivative operator with periodic boundary
        conditions on either side.
     */
    proc make_dc_periodic() {
        var iphase = 1.0;
        for i in dcDom.dim(1) {
            var jphase = 1.0;

            for j in dcDom.dim(2) {
                var gammaij = sqrt((2*i+1) * (2*j+1));
                var Kij = if (i-j) > 0 && ((i-j) % 2) == 1 then
                        2.0 else 0.0;
                r0[i,j] = 0.5*(1.0 - iphase*jphase - 2.0*Kij)*gammaij;
                rm[i,j] = 0.5*jphase*gammaij;
                rp[i,j] =-0.5*iphase*gammaij;
                jphase = -jphase;
            }
            iphase = -iphase;
        }
    }

    /** Return a deep copy of this Function
     */
    proc copy() {
        return new Function(k=k, thresh=thresh, f=f, initial_level=initial_level,
                max_level=max_level, autorefine=autorefine, compressed=compressed,
                sumC=sumC.copy(), diffC=diffC.copy());
    }

    /** Return a copy of this function's skeleton
     */
    proc skeletonCopy() {
        // Omit: f, compressed, sumC, diffC
        return new Function(k=k, thresh=thresh, initial_level=initial_level,
                max_level=max_level, autorefine=autorefine);
    }

    /** s[n, l] = integral(phi[n][l](x) * f(x))
        for box (n,l) project f(x) using quadrature rule
        into scaling function basis
     */
    proc project(curNode: 2*int) {
        const (n, l) = curNode;
        var h     = 0.5 ** n;
        var scale = sqrt(h);
        var s  : [quadDom] real;

        for mu in quad_phiDom.dim(1) {
            var x  = (l + quad_x[mu]) * h;
            var fx = f(x);
            for i in quad_phiDom.dim(2) do
                s[i] += scale * fx * quad_phiw[mu, i];
        }

        return s;
    }

    /** Refine numerical representation of f(x) to desired tolerance
     */
    proc refine(curNode: 2*int) {
        // project f(x) at next level
        var sc : [0..2*k-1] real;
        var s0 : [0..k-1] => sc[0..k-1];
        var s1 : [0..k-1] => sc[k..2*k-1];

        const child = sumC.get_children(curNode);
        s0 = project(child(1));
        s1 = project(child(2));

        // apply the two scale relationship to get difference coeff
        // in 1d this is O(k^2) flops
        var dc = sc*hgT;

        // check to see if within tolerance
        // normf() is Frobenius norm == 2-norm for vectors
        var nf = normf(dc[k..2*k-1]);
        const (n, _) = curNode;
        if((nf < thresh) || (n >= (max_level-1))) {
            sumC[child(1)] = s0;
            sumC[child(2)] = s1;
        }
        else {
            // these recursive calls on sub-trees can go in parallel
            // if the HashMap is syncronized
            refine(child(1));
            refine(child(2));
        }
    }

    /** Evaluate numerical representation of f at x.  Performed in scaling
        function basis only.
     */
    proc this(x) {
        if compressed then reconstruct();
        return evaluate( rootNode, x);
    }

    /** eval f(x) using adaptively refined numerical representation of f(x)
        answer should be within tolerance of the analytical f(x)

        Descend tree looking for box (n,l) with scaling function
        coefficients containing the point x.
     */
    proc evaluate(curNode = rootNode, in x): real {
        if sumC.has_coeffs(curNode) {
            const (n,_) = curNode;
            var p = phi(x, k);
            return inner(sumC[curNode], p)*sqrt(2.0**n);

        } else {
            const child = sumC.get_children(curNode);
            if (2*x < 1) then
                return evaluate (child(1), 2*x);
            else
                return evaluate (child(2), 2*x-1);
        }
    }

    /** change from scaling function basis to
        multi-wavelet basis (sumC -> diffC)
        tree is filled out with sumC[0][0] and diffC
        n is level in tree
        l is box index
     */
    proc compress(curNode = rootNode) {
        if compressed then return;

        // sub-trees can be done in parallel
        const child = sumC.get_children(curNode);
        if !sumC.has_coeffs(child(1)) then compress(child(1));
        if !sumC.has_coeffs(child(2)) then compress(child(2));

        var sc: [0..2*k-1] real;
        sc[0..k-1]   = sumC(child(1));
        sc[k..2*k-1] = sumC(child(2));

        // apply the two scale relationship to get difference coeff
        // in 1d this is O(k^2) flops (in 3d this is O(k^4) flops)
        var dc = sc*hgT;

        sumC[curNode] = dc[0..k-1];
        diffC[curNode] = dc[k..2*k-1];

        sumC.remove(child(1));
        sumC.remove(child(2));

        const (n,_) = curNode;
        if n==0 then compressed = true;
    }

    /** change from multi-wavelet basis to scaling function basis (d -> s)
        tree just has s at leaves
        n is level in tree
        l is box index
     */
    proc reconstruct(curNode = rootNode) {
        if !compressed then return;

        if diffC.has_coeffs(curNode) {
            var dc: [0..2*k-1] real;
            dc[0..k-1]   = sumC[curNode];
            dc[k..2*k-1] = diffC[curNode];
            diffC.remove(curNode);
            sumC.remove(curNode);

            // apply the two scale relationship to get difference coeff
            // in 1d this is O(k^2) flops (in 3d this is O(k^4) flops)
            var sc = dc*hg;

            const child = sumC.get_children(curNode);
            sumC[child(1)] = sc[0..k-1];
            sumC[child(2)] = sc[k..2*k-1];

            // sub-trees can be done in parallel
            reconstruct(child(1));
            reconstruct(child(2));
        }

        const (n,_) = curNode;
        if n == 0 then compressed = false;
    }

    /** In s are scaling coefficients for box n,l ... apply twoscale to generate
        the corresponding coefficients on level n+1 and insert the results into
        the tree of scaling function coefficients.
     */
    proc recur_down(curNode: 2*int) {
        if debug then writeln(" + recur_down",curNode);

        var sc : [0..2*k-1] real;
        sc[0..k-1] = sumC[curNode];

        var new_sc = sc*hg;
        const child = sumC.get_children(curNode);
        sumC(child(1)) = new_sc[0..k-1];
        sumC(child(2)) = new_sc[k..2*k-1];
    }

    /** If the scaling coefficients in box n,l exist, return them.
        (allow here for zero boundary conditions for boxes just off
        the ends of the domain)

        Else recur up to the next level looking for a parent.  If a
        parent exists, use two scale to recur those coefficients down
        to make n,l.  Note that this modifies the tree in place and
        you should eventually call sclean to tidy up when finished.

        Else, return None (corresponding child boxes exist at a finer scale)
     */
    proc get_coeffs(curNode: 2*int) {
        if debug then writeln(" @ get_coeffs",curNode);

        // Check to see if curNode is on the boundary.  If so,
        // return zeros for the coefficients.
        if sumC.on_boundary(curNode) {
           var coeffs : [0..k-1] real;
           return coeffs;
        }
        // Walk up the tree to find scaling coeffs
        var foundNode = emptyNode;
        for Node in sumC.path_upwards(curNode,rootNode) {
          if sumC.has_coeffs(Node) {
             foundNode = Node;
             break;
          }
        }

        // Didn't find coeffs, they must be below curNode
        if (foundNode == emptyNode) then return None;

        for Node in sumC.path_downwards(foundNode,curNode) {
            recur_down(Node);
        }
        return sumC[curNode];
    }

    /** Differentiation (also inner and mul) may leave scaling function
        coefficients below their original level.  Recur down to the
        locally first box with scaling function coefficients.
        Delete all children below there.
     */
    proc sclean(curNode = rootNode, in cleaning=false) {
        if cleaning { //then
            if debug then writeln(" + sclean deleting ", curNode);
            sumC.remove(curNode);
        } else
            cleaning = sumC.has_coeffs(curNode);

        // Sub trees can run in parallel
        const (n,_) = curNode;
        if n < max_level {
            const child = sumC.get_children(curNode);
            if !cleaning || sumC.has_coeffs(child(1)) then
                sclean(child(1), cleaning);
            if !cleaning || sumC.has_coeffs(child(2)) then
                sclean(child(2), cleaning);
        }
    }

    /** Differentiate the function, which corresponds to application
        of a block triadiagonal matrix.  For an adaptively refined
        target function we may need to refine boxes down until three
        boxes exist in the same scale.
     */

  proc diff() {
    proc diffHelper(curNode = rootNode, result) {
        const (n,l) = curNode;
        if debug then writeln(" * diff",curNode);
        if !sumC.has_coeffs(curNode) {
            // Sub trees can run in parallel
            // Run down tree until we hit scaling function coefficients
            const child = sumC.get_children(curNode);
            diffHelper((n+1, 2*l), result);
            diffHelper((n+1, 2*l+1), result);
        } else {
            // These can also go in parallel since may involve
            // recurring up & down the tree.
            const neighbor = sumC.get_neighbors(curNode);
            if debug then writeln(" * diff: coeffs at ",curNode);
            var sm = get_coeffs(neighbor(1));
            var sp = get_coeffs(neighbor(2));
            var s0 = sumC[curNode];

            // We have s0, check if we found sm and sp at this level
            if !isNone(sm) && !isNone(sp) {
                var r = rp*sm + r0*s0 + rm*sp;
                result.sumC[curNode] = r * 2.0**n;
            } else {
                recur_down(curNode);
                // Sub trees can run in parallel
                diffHelper((n+1, 2*l), result);
                diffHelper((n+1, 2*l+1), result);
            }
        }
    }

    if compressed then reconstruct();
    var result = skeletonCopy();

    diffHelper(rootNode, result);

    sclean();
    return result;
  }

    /** Return sqrt(integral(f(x)**2))
     */
    proc norm2() {
        if compressed then reconstruct();
        return sqrt(+ reduce [i in sumC] normf(i)**2);
    }

    /** Perform GAXPY in the multi-wavelet (compressed) basis
        this = alpha*this + beta*other (other is not changed).
     */
    proc gaxpy(alpha, other, beta) {
        if !compressed then compress();
        if !other.compressed then other.compress();

        sumC[rootNode] = sumC[rootNode]*alpha + other.sumC[rootNode]*beta; // Do scaling coeffs
	for i in diffC.index_iter() {
            diffC[i] *= alpha;
        }
	for i in other.diffC.index_iter() {
            diffC[i] += other.diffC[i]*beta;
        }

        // return this so operations can be chained
        return this;
    }

    /** Add this function to another and return the result in a new
        function.  This and other are unchanged.
     */
    proc add(other) {
        return copy().gaxpy(1.0, other, 1.0);
    }

    /** Subtract this function from another and return the result in a new
        function.  This and other are unchanged.
     */
    proc subtract(other) {
        return copy().gaxpy(1.0, other, -1.0);
    }

    /** Recursively multiply f1 and f2 put the result into this
     */
    proc multiply(f1, f2, curNode = rootNode) {
        const child = sumC.get_children(curNode);
        if f1.sumC.has_coeffs(curNode) && f2.sumC.has_coeffs(curNode) {
            const (n,_) = curNode;
            if autorefine && n+1 <= max_level {
                // if autorefine is set we are multiplying two polynomials
                // of order k-1 the result could be up to order 2(k-1) so
                // refine one more level to reduce the error and try to
                // keep it within the threshold

                // refine both one more level
                f1.recur_down(curNode);
                f2.recur_down(curNode);

                // scale factor for this level = sqrt((2^d)^(n+1))
                var scale_factor = sqrt(2.0**(n+1));

                // multiply f1.s[n+1][2*l] and f2.s[n+1][2*l]
                var f = f1.sumC[child(1)] * quad_phiT;
                var g = f2.sumC[child(1)] * quad_phiT;
                f *= g; // Note: Element-wise multiplication
                sumC[child(1)] = (f * quad_phiw) * scale_factor;

                // multiply f1.s[n+1][2*l+1] and f2.s[n+1][2*l+1]
                f  =  f1.sumC[child(2)] * quad_phiT;
                g  =  f2.sumC[child(2)] * quad_phiT;
                f *= g;
                sumC[child(2)] = (f * quad_phiw) * scale_factor;

            } else {
                // if autorefine is not set or we are at the max_level
                // live with what you get
                var f = f1.sumC[curNode] * quad_phiT;
                var g = f2.sumC[curNode] * quad_phiT;
                f *= g;

                // scale factor for this level = sqrt((2^d)^(n+1))
                sumC[curNode] = (f * quad_phiw) * sqrt(2.0**(n));
            }

        } else {
            if f1.sumC.has_coeffs(curNode) && !f2.sumC.has_coeffs(curNode) then
                // refine this box down to next level in f1
                f1.recur_down(curNode);
            else if !f1.sumC.has_coeffs(curNode) && f2.sumC.has_coeffs(curNode) then
                // refine this box down to next level in f2
                f2.recur_down(curNode);

            // calls on sub-trees can go in parallel
            multiply(f1, f2, child(1));
            multiply(f1, f2, child(2));
        }
    }

    /** Function Multiplication:
        For multiply, both operands need to be in the scaling function basis
        so possibly call reconstruct on one or both of them first
     */
    proc multiply(other) {
        if compressed then reconstruct();
        if other.compressed then other.reconstruct();

        // Store the result in a new Function
        var result = skeletonCopy();
        result.multiply(this, other);

        sclean();
        other.sclean();

        return result;
    }

    inline proc truncate(x) {
      const eps = 1e-8;
      if abs(x) < eps then return 0.0;
      else return x;
    }

    /** Mostly for debugging, print summary of coefficients,
        optionally printing the norm of each block
     */
    proc summarize() {
        writeln("\n-----------------------------------------------------");
        writeln("k=", k, " thresh=", thresh, " compressed=", compressed);
        writeln("sum coefficients:");
        for n in 0..max_level {
            var sum = 0.0, ncoeffs = 0;
            for box in sumC.lvl_iter(n) {
                sum     += normf(box)**2;
                ncoeffs += 1;
            }
            if ncoeffs != 0 then
                writeln("   level ", format("##", n), "   #boxes=",
                        format("####", ncoeffs), "  norm=", format("%0.2e", truncate(sqrt(sum))));
        }

        writeln("difference coefficients:");
        for n in 0..max_level {
            var sum = 0.0, ncoeffs = 0;
            for box in diffC.lvl_iter(n) {
                sum     += normf(box)**2;
                ncoeffs += 1;
            }
            if ncoeffs != 0 then
                writeln("   level ", format("##", n), "   #boxes=",
                        format("####", ncoeffs), "  norm=", format("%0.2e", truncate(sqrt(sum))));
        }

        writeln("-----------------------------------------------------\n");
    }

    /** Evaluate the analytic and numerical functions over the given interval
        and print the error.
     */
    proc evalNPT(npt) {
        for i in 0..npt {
            var (fval, Fval) = (f(i/npt:real), this(i/npt:real));
            //writeln(" -- ", format("%0.2f", i/npt:real), ":  F_numeric()=", format("% 0.5e", Fval),
            //        "  f_analytic()=", format("% 0.5e", fval), " err=", format("% 0.5e", Fval-fval),
            //        if abs(Fval-fval) > thresh then "  > thresh" else "");
            writeln(" -- ", format("%0.2f", i/npt:real), ":  F_numeric()=", format("% 0.8f", truncate(Fval)),
                    "  f_analytic()=", format("% 0.8f", truncate(fval)),
                    if abs(Fval-fval) > thresh then " err > thresh" else "");
        }
    }
}

/*************************************************************************/
/* Standard operations on Function objects:                              */
/*************************************************************************/

proc +(F: Function, G: Function): Function {
    return F.add(G);
}

proc -(F: Function, G: Function): Function {
    return F.subtract(G);
}

proc *(F: Function, G: Function): Function {
    return F.multiply(G);
}


Add const in intent to chpl__scanIterator[Zip]() to let some reduce tests pass.

/*
 * Copyright 2004-2015 Cray Inc.
 * Other additional copyright holders may be indicated within.
 *
 * The entirety of this work is licensed under the Apache License,
 * Version 2.0 (the "License"); you may not use this file except
 * in compliance with the License.
 *
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

// ChapelReduce.chpl
//
module ChapelReduce {

  // The insertion of const in intent here is a workaround for context in which
  // chpl__scanIterator is called passing a data argument that is a temporary.
  // The const in intent forces the data argument to be copied by value into
  // the iterator record representing this iterator, so the problem of a
  // creating a reference to temporary data is avoided.
  // This workaround causes a deep copy of arrays and domains, so it is only temporary!
  iter chpl__scanIteratorZip(op, const in data) {
    for e in zip((...data)) {
      op.accumulate(e);
      yield op.generate();
    }
    delete op;
  }

  // Reason for const in intent the same as above.
  iter chpl__scanIterator(op, const in data) {
    for e in data {
      op.accumulate(e);
      yield op.generate();
    }
    delete op;
  }

  proc chpl__reduceCombine(globalOp, localOp) {
    on globalOp {
      globalOp.lock();
      globalOp.combine(localOp);
      globalOp.unlock();
    }
  }

  inline proc chpl__cleanupLocalOp(globalOp, localOp) {
    // should this be part of chpl__reduceCombine ?
    delete localOp;
  }

  proc chpl__sumType(type eltType) type {
    var x: eltType;
    return (x + x).type;
  }

  pragma "ReduceScanOp"
  class ReduceScanOp {
    var lock$: sync bool;
    proc lock() {
      lock$.writeEF(true);
    }
    proc unlock() {
      lock$.readFE();
    }

    proc ~ReduceScanOp() {
      delete lock$;
    }
  }

  class SumReduceScanOp: ReduceScanOp {
    type eltType;
    var value: chpl__sumType(eltType);

    // Rely on the default value of the desired type.
    // Todo: is this efficnent when that is an array?
    proc identity {
      var x: chpl__sumType(eltType); return x;
    }
    proc accumulate(x) {
      value = value + x;
    }
    proc combine(x) {
      value = value + x.value;
    }
    proc generate() return value;
    proc clone() return new SumReduceScanOp(eltType=eltType);
  }

  class ProductReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _prod_id(eltType);
    proc accumulate(x) {
      value = value * x;
    }
    proc combine(x) {
      value = value * x.value;
    }
    proc generate() return value;
    proc clone() return new ProductReduceScanOp(eltType=eltType);
  }

  class MaxReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return min(eltType);
    proc accumulate(x) {
      value = max(x, value);
    }
    proc combine(x) {
      value = max(value, x.value);
    }
    proc generate() return value;
    proc clone() return new MaxReduceScanOp(eltType=eltType);
  }

  class MinReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return max(eltType);
    proc accumulate(x) {
      value = min(x, value);
    }
    proc combine(x) {
      value = min(value, x.value);
    }
    proc generate() return value;
    proc clone() return new MinReduceScanOp(eltType=eltType);
  }

  class LogicalAndReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _land_id(eltType);
    proc accumulate(x) {
      value = value && x;
    }
    proc combine(x) {
      value = value && x.value;
    }
    proc generate() return value;
    proc clone() return new LogicalAndReduceScanOp(eltType=eltType);
  }

  class LogicalOrReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _lor_id(eltType);
    proc accumulate(x) {
      value = value || x;
    }
    proc combine(x) {
      value = value || x.value;
    }
    proc generate() return value;
    proc clone() return new LogicalOrReduceScanOp(eltType=eltType);
  }

  class BitwiseAndReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _band_id(eltType);
    proc accumulate(x) {
      value = value & x;
    }
    proc combine(x) {
      value = value & x.value;
    }
    proc generate() return value;
    proc clone() return new BitwiseAndReduceScanOp(eltType=eltType);
  }

  class BitwiseOrReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _bor_id(eltType);
    proc accumulate(x) {
      value = value | x;
    }
    proc combine(x) {
      value = value | x.value;
    }
    proc generate() return value;
    proc clone() return new BitwiseOrReduceScanOp(eltType=eltType);
  }

  class BitwiseXorReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _bxor_id(eltType);
    proc accumulate(x) {
      value = value ^ x;
    }
    proc combine(x) {
      value = value ^ x.value;
    }
    proc generate() return value;
    proc clone() return new BitwiseXorReduceScanOp(eltType=eltType);
  }

  class maxloc: ReduceScanOp {
    type eltType;
    var value = identity;
    var uninitialized = true;

    proc identity return min(eltType);
    proc accumulate(x) {
      if uninitialized || (x(1) > value(1)) ||
        ((x(1) == value(1)) && (x(2) < value(2))) then
        value = x;
      uninitialized = false;
    }
    proc combine(x) {
      if uninitialized || (x.value(1) > value(1)) ||
        ((x.value(1) == value(1)) && (x.value(2) < value(2))) {
        if !x.uninitialized {
          value = x.value;
          uninitialized = false;
        }
      }
    }
    proc generate() return value;
    proc clone() return new maxloc(eltType=eltType);
  }

  class minloc: ReduceScanOp {
    type eltType;
    var value = identity;
    var uninitialized = true;

    proc identity return max(eltType);
    proc accumulate(x) {
      if uninitialized || (x(1) < value(1)) ||
        ((x(1) == value(1)) && (x(2) < value(2))) then
        value = x;
      uninitialized = false;
    }
    proc combine(x) {
      if uninitialized || (x.value(1) < value(1)) ||
        ((x.value(1) == value(1)) && (x.value(2) < value(2))) {
        if !x.uninitialized {
          value = x.value;
          uninitialized = false;
        }
      }
    }
    proc generate() return value;
    proc clone() return new minloc(eltType=eltType);
  }

}

/*
 * Copyright 2004-2015 Cray Inc.
 * Other additional copyright holders may be indicated within.
 *
 * The entirety of this work is licensed under the Apache License,
 * Version 2.0 (the "License"); you may not use this file except
 * in compliance with the License.
 *
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

// ChapelReduce.chpl
//
module ChapelReduce {

  iter chpl__scanIteratorZip(op, data) {
    for e in zip((...data)) {
      op.accumulate(e);
      yield op.generate();
    }
    delete op;
  }

  iter chpl__scanIterator(op, data) {
    for e in data {
      op.accumulate(e);
      yield op.generate();
    }
    delete op;
  }

  proc chpl__reduceCombine(globalOp, localOp) {
    on globalOp {
      globalOp.lock();
      globalOp.combine(localOp);
      globalOp.unlock();
    }
  }

  inline proc chpl__cleanupLocalOp(globalOp, localOp) {
    // should this be part of chpl__reduceCombine ?
    delete localOp;
  }

  proc chpl__sumType(type eltType) type {
    var x: eltType;
    return (x + x).type;
  }

  pragma "ReduceScanOp"
  class ReduceScanOp {
    var lock$: sync bool;
    proc lock() {
      lock$.writeEF(true);
    }
    proc unlock() {
      lock$.readFE();
    }

    proc ~ReduceScanOp() {
      delete lock$;
    }
  }

  class SumReduceScanOp: ReduceScanOp {
    type eltType;
    var value: chpl__sumType(eltType);

    // Rely on the default value of the desired type.
    // Todo: is this efficnent when that is an array?
    proc identity {
      var x: chpl__sumType(eltType); return x;
    }
    proc accumulate(x) {
      value = value + x;
    }
    proc combine(x) {
      value = value + x.value;
    }
    proc generate() return value;
    proc clone() return new SumReduceScanOp(eltType=eltType);
  }

  class ProductReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _prod_id(eltType);
    proc accumulate(x) {
      value = value * x;
    }
    proc combine(x) {
      value = value * x.value;
    }
    proc generate() return value;
    proc clone() return new ProductReduceScanOp(eltType=eltType);
  }

  class MaxReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return min(eltType);
    proc accumulate(x) {
      value = max(x, value);
    }
    proc combine(x) {
      value = max(value, x.value);
    }
    proc generate() return value;
    proc clone() return new MaxReduceScanOp(eltType=eltType);
  }

  class MinReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return max(eltType);
    proc accumulate(x) {
      value = min(x, value);
    }
    proc combine(x) {
      value = min(value, x.value);
    }
    proc generate() return value;
    proc clone() return new MinReduceScanOp(eltType=eltType);
  }

  class LogicalAndReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _land_id(eltType);
    proc accumulate(x) {
      value = value && x;
    }
    proc combine(x) {
      value = value && x.value;
    }
    proc generate() return value;
    proc clone() return new LogicalAndReduceScanOp(eltType=eltType);
  }

  class LogicalOrReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _lor_id(eltType);
    proc accumulate(x) {
      value = value || x;
    }
    proc combine(x) {
      value = value || x.value;
    }
    proc generate() return value;
    proc clone() return new LogicalOrReduceScanOp(eltType=eltType);
  }

  class BitwiseAndReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _band_id(eltType);
    proc accumulate(x) {
      value = value & x;
    }
    proc combine(x) {
      value = value & x.value;
    }
    proc generate() return value;
    proc clone() return new BitwiseAndReduceScanOp(eltType=eltType);
  }

  class BitwiseOrReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _bor_id(eltType);
    proc accumulate(x) {
      value = value | x;
    }
    proc combine(x) {
      value = value | x.value;
    }
    proc generate() return value;
    proc clone() return new BitwiseOrReduceScanOp(eltType=eltType);
  }

  class BitwiseXorReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _bxor_id(eltType);
    proc accumulate(x) {
      value = value ^ x;
    }
    proc combine(x) {
      value = value ^ x.value;
    }
    proc generate() return value;
    proc clone() return new BitwiseXorReduceScanOp(eltType=eltType);
  }

  class maxloc: ReduceScanOp {
    type eltType;
    var value = identity;
    var uninitialized = true;

    proc identity return min(eltType);
    proc accumulate(x) {
      if uninitialized || (x(1) > value(1)) ||
        ((x(1) == value(1)) && (x(2) < value(2))) then
        value = x;
      uninitialized = false;
    }
    proc combine(x) {
      if uninitialized || (x.value(1) > value(1)) ||
        ((x.value(1) == value(1)) && (x.value(2) < value(2))) {
        if !x.uninitialized {
          value = x.value;
          uninitialized = false;
        }
      }
    }
    proc generate() return value;
    proc clone() return new maxloc(eltType=eltType);
  }

  class minloc: ReduceScanOp {
    type eltType;
    var value = identity;
    var uninitialized = true;

    proc identity return max(eltType);
    proc accumulate(x) {
      if uninitialized || (x(1) < value(1)) ||
        ((x(1) == value(1)) && (x(2) < value(2))) then
        value = x;
      uninitialized = false;
    }
    proc combine(x) {
      if uninitialized || (x.value(1) < value(1)) ||
        ((x.value(1) == value(1)) && (x.value(2) < value(2))) {
        if !x.uninitialized {
          value = x.value;
          uninitialized = false;
        }
      }
    }
    proc generate() return value;
    proc clone() return new minloc(eltType=eltType);
  }

}


Add permutations iterator to lib/.

Add permutations iterator to lib/.

/*
 * Math helper functions.
 */

use Containers;

// requires CHPL_GMP=gmp or system
use GMP;

// factorial(n) / (factorial(k) * factorial(n - k));
proc choose(n: int, k: int): BigInt {
  var result = factorial(n);
  result.div_q(Round.ZERO, result, factorial(k));
  result.div_q(Round.ZERO, result, factorial(n - k));
  return result;
}

// Yields proper divisors of n. Proper divisors of n are numbers less than n
// which divide evenly into n.
iter divisors(n) {
  var current = 1;

  while current <= n / 2 {
    yield current;

    do {
      current += 1;
    } while n % current != 0;
  }
}

// n!
proc factorial(n: int): BigInt {
  if n < 0 {
    halt("Error! non-positive factorial!?");
  } else if n == 0 {
    return new BigInt(1);
  } else {
    var result = factorial(n - 1);
    result.mul_ui(result, n: c_ulong);
    return result;
  }
}

// Print the Fibonacci number less than and equal to 4 million.
iter fibonacci(): BigInt {
  var current = new BigInt(1),
    next = new BigInt(1),
    tmp: BigInt;
  while true {
    yield current;

    current.add(current, next);
    current <=> next;
  }
}

// This is a fairly optimized version of calculating if a number is prime or
// not.
// See: http://stackoverflow.com/a/15285588
proc isPrime(number) {
  if number == 2 || number == 3 {
    return true;
  } else if number < 2 || number % 2 == 0 {
    return false;
  } else if number < 9 {
    return true;
  } else if number % 3 == 0 {
    return false;
  }

  var r = (number ** 0.5): uint,
    f: uint = 5;
  while (f <= r) {
    if number % f == 0 {
      return false;
    } else if number % (f + 2) == 0 {
      return false;
    }
    f += 6;
  }
  return true;
}

// Yield successive permutations of the elements.
//
// Inspired by: https://docs.python.org/2/library/itertools.html#itertools.permutations
iter permutations(elements: [] string, length=-1): string {
  var n = elements.size;
  var r = length;

  // Default for r is length.
  if r == -1 then
    r = n;

  // If permutations are longer than number of elements, no permutations are
  // possible.
  if r > n then
    return;

  var indices: [{0..n-1}] int = [i in 0..n-1] i,
    cycles: [{0..n-1}] int = [c in n-r+1..n by -1] c;

  var perm = "";
  for i in indices[0.. # r] do
    perm += elements[i+1];
  yield perm;

  while true {
    var done = true;
    for i in 0..r-1 by -1 {
      cycles[i] -= 1;
      if cycles[i] == 0 {
        var rightInd = indices[i+1..],
          leftInd = indices[i..i];
        indices[i.. # rightInd.size] = rightInd;
        indices[(i + rightInd.size)..] = leftInd;
        cycles[i] = n - i;
      } else {
        indices[i] <=> indices[indices.size - cycles[i]];

        perm = "";
        for i in indices[0.. # r] do
          perm += elements[i+1];
        yield perm;

        done = false;
        break;
      }
    }

    // Did not yield a permutation, so we're done.
    if done then
      return;
  }
}

// Sieve of Eratosthenes
// Generates first k prime numbers.
//
// Inspired by: http://stackoverflow.com/a/568618
// And:         http://code.activestate.com/recipes/117119/#c4
iter primes(k: uint, param debug=false): uint {
  if k >= 1 then
    yield 2;

  // If only one prime requested, stop here.
  if k == 1 then
    return;

  var i: uint = 1,
    q: uint = 3;
  var D: domain(uint),
    A: [D] uint;

  while true {
    if ! D.member(q) {
      if debug then
        assert(isPrime(q));

      yield q;

      i += 1;
      if i == k then
        break;

      A[q * q] = 2 * q;
    } else {
      const p = A[q];
      var pq = p + q;
      while D.member(pq) do
        pq += p;
      A[pq] = p;
      D -= q;
    }
    q += 2;
  }
}

// Sieve of Eratosthenes up to max value.
// Generates prime numbers less than or equal to `m`.
iter primesUpTo(m: uint, param debug=false): uint {
  if m < 2 then
    halt("no primes less than 2");

  if m >= 2 then
    yield 2;

  if m == 2 then
    return;

  var q: uint = 3,
    D: domain(uint),
    A: [D] uint;

  while q <= m {
    if ! D.member(q) {
      if debug then
        assert(isPrime(q));

      yield q;

      A[q * q] = 2 * q;
    } else {
      const p = A[q];
      var pq = p + q;
      while D.member(pq) do
        pq += p;
      A[pq] = p;
      D -= q;
    }
    q += 2;
  }
}

/* // Yield the first `k` prime numbers as BigInts. */
/* iter bigPrimes(k: int(64)): BigInt { */
/*   var i = 0, */
/*     q = new BigInt(2); */
/*   var D: domain(BigInt); */
/*   var A: [D] domain(BigInt); */

/*   while true { */
/*     if ! D.member(q) { */
/*       yield q; */
/*       i += 1; */
/*       var qSquared = new BigInt(); */
/*       qSquared.mul(q, q); */
/*       D += qSquared; */
/*       A[qSquared] += q; */
/*     } else { */
/*       for p in A[q] { */
/*         var pq = new BigInt(); */
/*         pq.add(p, q); */
/*         D += pq; */
/*         A[pq] = p; */
/*       } */
/*       D.remove(q); */
/*     } */
/*     if i == k { */
/*       break; */
/*     } */
/*     q += 1; */
/*   } */
/* } */

// Returns sum of individual digits of n. n is serialized as string, then each
// character is cast to an int, and added together.
proc sumDigits(n) {
  var nStr = n: string,
    result = 0;
  for i in 1..nStr.length {
    result += nStr.substring(i): int;
  }
  return result;
}

// Returns sum of all divisors of n.
proc sumDivisors(n) {
  var sum = 0;
  for i in divisors(n) {
    sum += i;
  }
  return sum;
}

/*
 * Math helper functions.
 */

use Containers;

// requires CHPL_GMP=gmp or system
use GMP;

// factorial(n) / (factorial(k) * factorial(n - k));
proc choose(n: int, k: int): BigInt {
  var result = factorial(n);
  result.div_q(Round.ZERO, result, factorial(k));
  result.div_q(Round.ZERO, result, factorial(n - k));
  return result;
}

// Yields proper divisors of n. Proper divisors of n are numbers less than n
// which divide evenly into n.
iter divisors(n) {
  var current = 1;

  while current <= n / 2 {
    yield current;

    do {
      current += 1;
    } while n % current != 0;
  }
}

// n!
proc factorial(n: int): BigInt {
  if n < 0 {
    halt("Error! non-positive factorial!?");
  } else if n == 0 {
    return new BigInt(1);
  } else {
    var result = factorial(n - 1);
    result.mul_ui(result, n: c_ulong);
    return result;
  }
}

// Print the Fibonacci number less than and equal to 4 million.
iter fibonacci(): BigInt {
  var current = new BigInt(1),
    next = new BigInt(1),
    tmp: BigInt;
  while true {
    yield current;

    current.add(current, next);
    current <=> next;
  }
}

// This is a fairly optimized version of calculating if a number is prime or
// not.
// See: http://stackoverflow.com/a/15285588
proc isPrime(number) {
  if number == 2 || number == 3 {
    return true;
  } else if number < 2 || number % 2 == 0 {
    return false;
  } else if number < 9 {
    return true;
  } else if number % 3 == 0 {
    return false;
  }

  var r = (number ** 0.5): uint,
    f: uint = 5;
  while (f <= r) {
    if number % f == 0 {
      return false;
    } else if number % (f + 2) == 0 {
      return false;
    }
    f += 6;
  }
  return true;
}

// Sieve of Eratosthenes
// Generates first k prime numbers.
//
// Inspired by: http://stackoverflow.com/a/568618
// And:         http://code.activestate.com/recipes/117119/#c4
iter primes(k: uint, param debug=false): uint {
  if k >= 1 then
    yield 2;

  // If only one prime requested, stop here.
  if k == 1 then
    return;

  var i: uint = 1,
    q: uint = 3;
  var D: domain(uint),
    A: [D] uint;

  while true {
    if ! D.member(q) {
      if debug then
        assert(isPrime(q));

      yield q;

      i += 1;
      if i == k then
        break;

      A[q * q] = 2 * q;
    } else {
      const p = A[q];
      var pq = p + q;
      while D.member(pq) do
        pq += p;
      A[pq] = p;
      D -= q;
    }
    q += 2;
  }
}

// Sieve of Eratosthenes up to max value.
// Generates prime numbers less than or equal to `m`.
iter primesUpTo(m: uint, param debug=false): uint {
  if m < 2 then
    halt("no primes less than 2");

  if m >= 2 then
    yield 2;

  if m == 2 then
    return;

  var q: uint = 3,
    D: domain(uint),
    A: [D] uint;

  while q <= m {
    if ! D.member(q) {
      if debug then
        assert(isPrime(q));

      yield q;

      A[q * q] = 2 * q;
    } else {
      const p = A[q];
      var pq = p + q;
      while D.member(pq) do
        pq += p;
      A[pq] = p;
      D -= q;
    }
    q += 2;
  }
}

/* // Yield the first `k` prime numbers as BigInts. */
/* iter bigPrimes(k: int(64)): BigInt { */
/*   var i = 0, */
/*     q = new BigInt(2); */
/*   var D: domain(BigInt); */
/*   var A: [D] domain(BigInt); */

/*   while true { */
/*     if ! D.member(q) { */
/*       yield q; */
/*       i += 1; */
/*       var qSquared = new BigInt(); */
/*       qSquared.mul(q, q); */
/*       D += qSquared; */
/*       A[qSquared] += q; */
/*     } else { */
/*       for p in A[q] { */
/*         var pq = new BigInt(); */
/*         pq.add(p, q); */
/*         D += pq; */
/*         A[pq] = p; */
/*       } */
/*       D.remove(q); */
/*     } */
/*     if i == k { */
/*       break; */
/*     } */
/*     q += 1; */
/*   } */
/* } */

// Returns sum of individual digits of n. n is serialized as string, then each
// character is cast to an int, and added together.
proc sumDigits(n) {
  var nStr = n: string,
    result = 0;
  for i in 1..nStr.length {
    result += nStr.substring(i): int;
  }
  return result;
}

// Returns sum of all divisors of n.
proc sumDivisors(n) {
  var sum = 0;
  for i in divisors(n) {
    sum += i;
  }
  return sum;
}


Use a ref instead of an alias operation

Use a ref instead of an alias operation

Aliases are now deprecated.  The preferred strategy is to use a ref variable.

var %(aname)s__defaultRect = pych_to_chpl1D(%(aname)s_pych);
ref %(aname)s = _getArray(%(aname)s__defaultRect);

var %(aname)s__defaultRect = pych_to_chpl1D(%(aname)s_pych);
var %(aname)s => _getArray(%(aname)s__defaultRect);