Small touch ups for my SSCA2

Small touch ups for my SSCA2

- Remove old comments
- Move here.id==0 test inside param conditional

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@20429 3a8e244f-b0f2-452b-bcba-4c88e055c3ca

module SSCA2_kernels

//  +==========================================================================+
//  |  Polymorphic Implementation of SSCA #2, Kernels 2-4                      |
//  |                                                                          |
//  |  Each kernel takes a graph argument which provides for each vertex       |
//  |  1.  an iterator for its set of neighbors                                |
//  |  2.  a parallel integer array of edge weights, which can be zipper       |
//  |      iterated with the set of neighbors                                  |
//  |  3.  the number of neighbors                                             |
//  |                                                                          |
//  |  These are the only requirements on the representation of the graph.     |
//  |                                                                          |
//  |  Filtering in Kernel 4 is turned on or off by a compilation time param.  |
//  +==========================================================================+

{
  use SSCA2_compilation_config_params, Time;

  var stopwatch : Timer;

  // ========================================================
  //                           KERNEL 2:
  // ========================================================
  // Find the edges with the largest edges.  Return a list of
  // edges, all of which have the largest weight.
  // ========================================================

  proc largest_edges ( G, heavy_edge_list :domain )

    // edge_weights can be either an array over an associative
    // domain or over a sparse domain.  the output  heavy_edge_list
    // can either kind of domain or something else purpose-built
    // for this task.
    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      // ---------------------------------------------------------
      // find heaviest edge weight in a single pass over all edges
      // ---------------------------------------------------------

      proc maxweight(s) {
	var mymax = 0;
	for w in G.edge_weight[s] do
	  if w > mymax then mymax = w;
	return mymax;
      }

      const heaviest_edge_weight = max reduce [s in G.vertices] maxweight(s);

      // ---------------------------------------------
      // in a second pass over all edges, extract list
      // of all edges  matching the heaviest weight
      // ---------------------------------------------

      forall s in G.vertices do
        forall (t, w) in G.NeighborPairs (s) do

	  if w == heaviest_edge_weight then {
	    heavy_edge_list.add ( (s,t) );
	  };

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 2: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }

      // ------------------------------------------------
      // should be able to write a user-defined "maxlocs"
      // reduction more efficiently than this scheme
      // ------------------------------------------------

      if DEBUG_KERNEL2 then {
	writeln ();
	writeln ( "Heaviest weight      : ", heaviest_edge_weight);
	writeln ( "Number of heavy edges:", heavy_edge_list.numIndices );
	writeln ();
	writeln ( "Edges with largest weight and other neighbors:" );
	for (s,t) in heavy_edge_list do {
	  writeln ("edge   ", (s,t));
	  for (v,w) in G.NeighborPairs (s) do
	    writeln ("      ", v, " ", w);}
      }
    };

  // ===================================================================
  //                              KERNEL 3:
  // ===================================================================
  // For each root (heavy) edge, find the subgraph (vertices and edges)
  // defined by directed paths of length no greater than max_path_length
  // in which the first edge traversed is the root edge
  // ===================================================================

  proc rooted_heavy_subgraphs ( G,
                                Heavy_Edge_List     : domain,
                                Heavy_Edge_Subgraph : [],
                                in max_path_length  : int )

    // -------------------------------------------------------------------------
    // there is a classic space versus time tradeoff.  if the subgraphs expanded
    // by breadth first search are small, it would make sense to use a hash
    // table or an associative domain to represent the search.  If the subgraphs
    // are large, using a full length vector to represent the search is more
    // appropriate.  We expect small diameters for power law graphs, so we
    // expect large subgraphs.
    // -------------------------------------------------------------------------

    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      const vertex_domain = G.vertices;

      forall ( x, y ) in Heavy_Edge_List do {
	var Active_Level, Next_Level : domain ( index (vertex_domain) );
	var min_distance             : [vertex_domain] atomic int;
        forall m in min_distance do m.write(-1);

	if DEBUG_KERNEL3 then
	  writeln ( " Building heavy edge subgraph from pair:", (x,y) );
	Active_Level.add ( y );
	Next_Level.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).nodes.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).edges.clear ();
	min_distance ( y ).write(0);

	Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (x, y) );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( x );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( y );

	for path_length in 1 .. max_path_length do {

	  forall v in Active_Level do {

	    forall w in G.Neighbors (v) do {

              if min_distance(w).compareExchangeStrong(-1, path_length) then {
                Next_Level.add (w);
                Heavy_Edge_Subgraph ( (x, y) ).nodes.add (w);
	      }

	      if min_distance(w).read() == path_length then {
		Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (v, w) );
	      }
	    }
	  }

	  if path_length < max_path_length then {
	    Active_Level = Next_Level;
	    Next_Level.clear ();
	  }
	}
      }

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 3: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }
    } // end of rooted_heavy_subgraphs

  use BlockDist;
  config param useOnClause = CHPL_NETWORK_ATOMICS!="ugni";
  // For task-private temporary variables
  config const defaultNumTPVs = 16;
  config var numTPVs = min(defaultNumTPVs, numLocales);
  // Would be nice to use PriavteDist, but aliasing is not supported (yet)
  const PrivateSpace = {LocaleSpace} dmapped Block(boundingBox={LocaleSpace});

  // ==================================================================
  //                              KERNEL 4
  // ==================================================================
  // Calculate Betweenness Centrality for simple unweighted directed or
  // undirected graphs, using Madduri, et.al.'s modification of
  // Brandes's 2001 algorithm
  // ==================================================================

  proc approximate_betweenness_centrality ( G, starting_vertices,
                                            Between_Cent : [] real,
                                            out Sum_Min_Dist : real )

    // -----------------------------------------------------------------------
    // The betweenness centrality metric for a given node  v  is defined
    // as the double sum over s not equal to v and  t not equal to
    // either s or v of the ratio of the number of shortest paths from s to t
    // passing through v to the number of shortest paths from s to t.
    //
    // Brandes's algorithm decomposes the computation of this metric into,
    // first, separate sums for each vertex s, which can be computed
    // independently in parallel, and
    // two, a recursive, tree-based, calculation of the path counts for
    // any particular s.
    // The complexity of this algorithm is O ( |V||E| ) time for an unweighted
    // graph.  The algorithm requires O ( |V| ) temporary space for each
    // process that executes instances of the outermost loop.
    // -----------------------------------------------------------------------
    {
      const vertex_domain = G.vertices;

      // Considering using a dense 1-d array instead.  This would
      // complicate the Level_Set implementation a little, but would
      // probably be more efficient.
      type Sparse_Vertex_List = domain(index(vertex_domain));

      var Between_Cent$ : [vertex_domain] atomic real;
      var Sum_Min_Dist$ : atomic real;

      //
      // Throughout kernel 4, we use distributed arrays that are
      // private to each iteration of the outer loop.  Because set-up
      // and clean-up of such variables is very expensive, it is
      // desirable to do it at most only once per task versus once
      // per iteration, as a task executes multiple iterations of a
      // forall loop.
      //
      // To avoid this per-iteration overhead, we have implemented
      // an optimization that make certain variables private to each
      // task.  These variables are reinitialized each iteration of
      // the loop, but not reallocated, reprivatized, etc.
      //
      // Note that the Chapel group and collaborators are currently in
      // the process of bringing the idea of task private variable to
      // the language.
      //

      numTPVs = min(numTPVs, starting_vertices.size);
      const TPVSpace = {0..#numTPVs};
      var TPVLocales: [TPVSpace] locale;

      // Here we set up the locales array for our task private temporary
      // variables.  We use _computChunkStartEnd() to distribute the
      // variables approximately evenly across the 1d locales array.
      for t in TPVSpace {
        TPVLocales[t] = Locales[_computeChunkStartEnd(numLocales,
                                                      numTPVs, t+1)[1]-1];
      }
      const TPVLocaleSpace = {TPVSpace} dmapped Block(boundingBox={TPVSpace},
                                                      targetLocales=TPVLocales);

      // There will be numTPVs copies of the temps, thus throttling the
      // number of starting vertices being considered simultaneously.
      var TPV: [TPVLocaleSpace] taskPrivateData(domain(index(vertex_domain)),
                                                vertex_domain.type);

      // Initialize
      coforall (t, i) in (TPVLocaleSpace, TPVSpace) do on TPVLocaleSpace.dist.idxToLocale(t) {
          TPV[i] = new taskPrivateData(domain(index(vertex_domain)), vertex_domain);
          var tpv = TPV[i];
          forall v in vertex_domain do
            tpv.BCaux[v].children_list.nd = {1..G.n_Neighbors[v]};
          for loc in Locales do on loc {
            tpv.Active_Level[here.id] = new Level_Set (Sparse_Vertex_List);
            tpv.Active_Level[here.id].previous = nil;
            tpv.Active_Level[here.id].next = new Level_Set (Sparse_Vertex_List);;
            tpv.Active_Level[here.id].next.previous = tpv.Active_Level[here.id];
            tpv.Active_Level[here.id].next.next = nil;
          }
      }
      var TPVM: TPVManager(TPV.type) = new TPVManager(TPV);

      // ------------------------------------------------------
      // Each iteration of the outer loop of Brandes's algorithm
      // computes the contribution (the "dependency" metric) for
      // one particular vertex  (s)  independently.
      // ------------------------------------------------------

      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      forall s in starting_vertices do on vertex_domain.dist.idxToLocale(s) {

        const shere = here.id;

	if DEBUG_KERNEL4 then writeln ( "expanding from starting node ", s );

        // Initialize task private variables
        const tid = TPVM.gettid();
        const tpv = TPVM.getTPV(tid);
        var BCaux => tpv.BCaux;
        pragma "dont disable remote value forwarding"
        inline proc f1(BCaux, v) {
          BCaux[v].path_count$.write(0.0);
        }
        forall v in vertex_domain do {
          BCaux[v].depend = 0.0;
          BCaux[v].min_distance.write(-1);
          f1(BCaux, v);
          BCaux[v].children_list.child_count.write(0);
        }
	var Lcl_Sum_Min_Dist: atomic real;

	// The structure of the algorithm depends on a breadth-first
	// traversal. Each vertex will be marked by the length of
	// the shortest path (min_distance) from s to it. The array
	// path_count$ will hold a count of the number of shortest
	// paths from s to this node.  The number of paths in moderate
	// sized tori exceeds 2**64.

        //
        // Used to check termination of the forward pass
        //
        // We could use a task-private reduction variable here.  This
        // is yet another concept that the Chapel group is planning to
        // implement.
        //

        var remaining = true;

        //
        // Each locale will have its own level sets.  A locale's level set
        // will only contain nodes that are physically allocated on that
        // particular locale.
        //
        var Active_Level => tpv.Active_Level;
        pragma "dont disable remote value forwarding"
        inline proc f2(BCaux, s) {
          BCaux[s].path_count$.write(1.0);
        }

        var barrier = new Barrier(numLocales);

        coforall loc in Locales do on loc {
          Active_Level[here.id].Members.clear();
          Active_Level[here.id].next.Members.clear();
          if vertex_domain.dist.idxToLocale(s) == here {
            // Establish the initial level sets for the breadth-first
            // traversal from s
            Active_Level[here.id].Members.add(s);
            BCaux[s].min_distance.write(0);
            f2(BCaux, s);
          }
          barrier.barrier();

          var current_distance : int = 0;

          while remaining do {
	    // ------------------------------------------------
	    // expand the neighbor sets for all vertices at the
	    // current distance from the starting vertex  s
	    // ------------------------------------------------

	    current_distance += 1;

            // The Chapel compiler is still a bit conservative when it
            // comes to forwarding read-only variables to remote
            // locales, so we make a const copy here to insure it is
            // forwarded to the remote locale in the following
            // coforall loop.
            const current_distance_c = current_distance;
            pragma "dont disable remote value forwarding"
            inline proc f3(BCaux, v, u) {
              BCaux[v].path_count$.add(BCaux[u].path_count$.read());
            }

            forall u in Active_Level[here.id].Members do {
              forall v in G.FilteredNeighbors(u) do
                on if useOnClause then vertex_domain.dist.idxToLocale(v) else here {
                  // --------------------------------------------
                  // add any unmarked neighbors to the next level
                  // --------------------------------------------

                  if  BCaux[v].min_distance.compareExchangeStrong(-1, current_distance_c) {
                    var aloc = if useOnClause then here.id else vertex_domain.dist.idxToLocale(v).id;
                    Active_Level[aloc].next.Members.add (v);
                    if VALIDATE_BC then
                      Lcl_Sum_Min_Dist.add(current_distance_c);
                  }

                  // ------------------------------------------------
                  // only neighbors of  u  that are in the next level
                  // are on shortest paths from s through v.  Some
                  // task will have set  min_distance (v) by the
                  // time this code is reached, whether  v  lies in
                  // the previous, the current or the next level.
                  // ------------------------------------------------

                  if BCaux[v].min_distance.read() == current_distance_c {
                    f3(BCaux, v, u);
                    BCaux[u].children_list.add_child (v);
                  }

                }
            };

            // This barrier is needed to insure all updates to the next
            // level are completed before updating to use the next level

            // do some work while we wait
            // barrier.notify(); // This is expensive without network atomics
            //  for now, just do a normal barrier

            if Active_Level[here.id].next.next == nil {
              Active_Level[here.id].next.next = new Level_Set (Sparse_Vertex_List);
              Active_Level[here.id].next.next.previous = Active_Level[here.id].next;
              Active_Level[here.id].next.next.next = nil;
            } else {
              Active_Level[here.id].next.next.Members.clear();
            }
            // barrier.wait(); // ditto
            barrier.barrier();
            if here.id==shere {
              remaining = false;
            }

            barrier.barrier();
            Active_Level[here.id] = Active_Level[here.id].next;
            if Active_Level[here.id].Members.numIndices:bool then
              remaining = true;

            barrier.barrier();

          };  // end forward pass

          if VALIDATE_BC then
            if here.id==0 then
              Sum_Min_Dist$.add(Lcl_Sum_Min_Dist);

          // -------------------------------------------------------------
          // compute the dependencies recursively, traversing the vertices
          // of the graph in non-increasing order of distance (reverse
          // ordering from the initial traversal)
          // -------------------------------------------------------------

          const graph_diameter = current_distance - 1;

          if DEBUG_KERNEL4 then
            if here.id==0 then
              writeln ( " graph diameter from starting node ", s,
                        "  is ", graph_diameter );

          pragma "dont disable remote value forwarding"
          inline proc f4(BCaux, Between_Cent$, u) {
            BCaux[u].depend = + reduce [v in BCaux[u].children_list.Row_Children[1..BCaux[u].children_list.child_count.read()]]
              ( BCaux[u].path_count$.read() /
                BCaux[v].path_count$.read() )      *
              ( 1.0 + BCaux[v].depend );
            Between_Cent$(u).add(BCaux[u].depend);
          }

          // back up to last level
          var curr_Level =  Active_Level[here.id].previous;

          for current_distance in 2 .. graph_diameter by -1 {
            curr_Level = curr_Level.previous;

            for u in curr_Level.Members do on vertex_domain.dist.idxToLocale(u) {
                f4(BCaux, Between_Cent$, u);
            }

            barrier.barrier();
          }
        }

        TPVM.releaseTPV(tid);

      }; // closure of outer embarassingly parallel forall

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	var K4_time = stopwatch.elapsed ();
	stopwatch.clear ();
	writeln ( "Elapsed time for Kernel 4: ", K4_time, " seconds");

	const n_edges          = G.num_edges;
	const N_VERTICES       = vertex_domain.numIndices;
	const N_START_VERTICES = if starting_vertices == G.vertices
                                 then N_VERTICES
                                      - + reduce [v in vertex_domain]
                                        (G.n_Neighbors (v) == 0)
                                 else starting_vertices.numIndices;
	const TEPS             = 7.0 * N_VERTICES * N_START_VERTICES / K4_time;
	const Adjusted_TEPS    = n_edges * N_START_VERTICES / K4_time;

	writeln ( "                     TEPS: ", TEPS );
	writeln ( " edge count adjusted TEPS: ", Adjusted_TEPS );
      }

      if VALIDATE_BC then
        Sum_Min_Dist = Sum_Min_Dist$.read();

      Between_Cent = Between_Cent$.read();

      if DELETE_KERNEL4_DS {
        coforall t in TPVSpace do on t {
          var tpv = TPV[t];
          var al = tpv.Active_Level;
          coforall loc in Locales do on loc {
            var level = al[here.id];
            while level != nil {
                var l2 = level.next;
                delete level;
                level = l2;
            }
          }
          delete TPV[t];
        }
        delete TPVM;
      }

    } // end of Brandes' betweenness centrality calculation

  //
  // Addition support data structures for kernel 4
  //

  // ------------------------------------------------------------
  // The set of vertices at a particular distance from s form a
  // level set.  The class allows the full set of vertices to be
  // partitioned into a linked list of level sets.  Each instance
  // of the outer loop in kernel 4 creates such a partitioning.
  // ============================================================

  class Level_Set {
    type Sparse_Vertex_List;
    var Members  : Sparse_Vertex_List;
    var previous : Level_Set (Sparse_Vertex_List);
    var next : Level_Set (Sparse_Vertex_List);
  }

  //
  // Data structure to save Children lists between the forward
  //  and backwards passes
  //
  record child_struct {
    type vertex;
    var nd: domain(1);
    var Row_Children: [nd] vertex;
    var child_count: atomic int;

    // This function should only be called using unique vertices
    proc add_child ( new_child: vertex ) {
      var c = child_count.fetchAdd(1)+1;
      Row_Children[c] = new_child;
    }
  }

  //
  // Implementation of task-private variables for kernel 4
  //
  record taskPrivateArrayData {
    type vertex;
    var min_distance  : atomic int;
    var path_count$   : atomic real;
    var depend        : real;
    var children_list : child_struct(vertex);
  }

  class taskPrivateData {
    type Sparse_Vertex_List;
    const vertex_domain;
    var used  : atomic bool;
    var BCaux : [vertex_domain] taskPrivateArrayData(index(vertex_domain));
    var Active_Level : [PrivateSpace] Level_Set (Sparse_Vertex_List);
  }

  // This is a simple class that hands out task private variables from the
  // array of task private variables, TPV.
  class TPVManager {
    const TPV;
    var currTPV: atomic int;
    proc gettid() {
      const tid = this.currTPV.fetchAdd(1)%numTPVs;
      on this.TPV[tid] do
        while this.TPV[tid].used.testAndSet() do chpl_task_yield();
      return tid;
    }
    proc getTPV(tid) {
      return this.TPV[tid];
    }
    proc releaseTPV(tid) {
      this.TPV[tid].used.clear();
    }
  }

  //
  // reusable barrier implementation
  //
  record Barrier {
    param reusable = true;
    var n: int;
    var count: atomic_int64;
    var done: atomicflag;

    proc Barrier(_n: int) {
      reset(_n);
    }

    inline proc reset(_n: int) {
      on this {
        n = _n;
        count.write(n);
        done.write(false);
      }
    }

    inline proc barrier() {
      on this {
        const myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to barrier()");
          if reusable {
            count.waitFor(n-1);
            count.add(1);
            done.clear();
          }
        } else {
          done.waitFor(true);
          if reusable {
            count.add(1);
            done.waitFor(false);
          }
        }
      }
    }

    inline proc notify() {
      on this {
        const myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to notify()");
        }
      }
    }

    inline proc wait() {
      on this {
        done.waitFor(true);
        if reusable {
          const myc = count.fetchAdd(1);
          if myc == n-1 then
            done.clear();
          done.waitFor(false);
        }
      }
    }

    inline proc try() {
      return done.read();
    }
  }

}

module SSCA2_kernels

//  +==========================================================================+
//  |  Polymorphic Implementation of SSCA #2, Kernels 2-4                      |
//  |                                                                          |
//  |  Each kernel takes a graph argument which provides for each vertex       |
//  |  1.  an iterator for its set of neighbors                                |
//  |  2.  a parallel integer array of edge weights, which can be zipper       |
//  |      iterated with the set of neighbors                                  |
//  |  3.  the number of neighbors                                             |
//  |                                                                          |
//  |  These are the only requirements on the representation of the graph.     |
//  |                                                                          |
//  |  Filtering in Kernel 4 is turned on or off by a compilation time param.  |
//  +==========================================================================+

{
  use SSCA2_compilation_config_params, Time;

  var stopwatch : Timer;

  // ========================================================
  //                           KERNEL 2:
  // ========================================================
  // Find the edges with the largest edges.  Return a list of
  // edges, all of which have the largest weight.
  // ========================================================

  proc largest_edges ( G, heavy_edge_list :domain )

    // edge_weights can be either an array over an associative
    // domain or over a sparse domain.  the output  heavy_edge_list
    // can either kind of domain or something else purpose-built
    // for this task.
    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      // ---------------------------------------------------------
      // find heaviest edge weight in a single pass over all edges
      // ---------------------------------------------------------

      proc maxweight(s) {
	var mymax = 0;
	for w in G.edge_weight[s] do
	  if w > mymax then mymax = w;
	return mymax;
      }

      const heaviest_edge_weight = max reduce [s in G.vertices] maxweight(s);

      // ---------------------------------------------
      // in a second pass over all edges, extract list
      // of all edges  matching the heaviest weight
      // ---------------------------------------------

      forall s in G.vertices do
        forall (t, w) in G.NeighborPairs (s) do

	  if w == heaviest_edge_weight then {
	    heavy_edge_list.add ( (s,t) );
	  };

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 2: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }

      // ------------------------------------------------
      // should be able to write a user-defined "maxlocs"
      // reduction more efficiently than this scheme
      // ------------------------------------------------

      if DEBUG_KERNEL2 then {
	writeln ();
	writeln ( "Heaviest weight      : ", heaviest_edge_weight);
	writeln ( "Number of heavy edges:", heavy_edge_list.numIndices );
	writeln ();
	writeln ( "Edges with largest weight and other neighbors:" );
	for (s,t) in heavy_edge_list do {
	  writeln ("edge   ", (s,t));
	  for (v,w) in G.NeighborPairs (s) do
	    writeln ("      ", v, " ", w);}
      }
    };

  // ===================================================================
  //                              KERNEL 3:
  // ===================================================================
  // For each root (heavy) edge, find the subgraph (vertices and edges)
  // defined by directed paths of length no greater than max_path_length
  // in which the first edge traversed is the root edge
  // ===================================================================

  proc rooted_heavy_subgraphs ( G,
                                Heavy_Edge_List     : domain,
                                Heavy_Edge_Subgraph : [],
                                in max_path_length  : int )

    // -------------------------------------------------------------------------
    // there is a classic space versus time tradeoff.  if the subgraphs expanded
    // by breadth first search are small, it would make sense to use a hash
    // table or an associative domain to represent the search.  If the subgraphs
    // are large, using a full length vector to represent the search is more
    // appropriate.  We expect small diameters for power law graphs, so we
    // expect large subgraphs.
    // -------------------------------------------------------------------------

    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      const vertex_domain = G.vertices;

      forall ( x, y ) in Heavy_Edge_List do {
	var Active_Level, Next_Level : domain ( index (vertex_domain) );
	var min_distance             : [vertex_domain] atomic int;
        forall m in min_distance do m.write(-1);

	if DEBUG_KERNEL3 then
	  writeln ( " Building heavy edge subgraph from pair:", (x,y) );
	Active_Level.add ( y );
	Next_Level.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).nodes.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).edges.clear ();
	min_distance ( y ).write(0);

	Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (x, y) );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( x );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( y );

	for path_length in 1 .. max_path_length do {

	  forall v in Active_Level do {

	    forall w in G.Neighbors (v) do {

              if min_distance(w).compareExchangeStrong(-1, path_length) then {
                Next_Level.add (w);
                Heavy_Edge_Subgraph ( (x, y) ).nodes.add (w);
	      }

	      if min_distance(w).read() == path_length then {
		Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (v, w) );
	      }
	    }
	  }

	  if path_length < max_path_length then {
	    Active_Level = Next_Level;
	    Next_Level.clear ();
	  }
	}
      }

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 3: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }
    } // end of rooted_heavy_subgraphs

  use BlockDist;
  config param useOnClause = CHPL_NETWORK_ATOMICS!="ugni";
  // For task-private temporary variables
  config const defaultNumTPVs = 16;
  config var numTPVs = min(defaultNumTPVs, numLocales);
  // Would be nice to use PriavteDist, but aliasing is not supported (yet)
  const PrivateSpace = {LocaleSpace} dmapped Block(boundingBox={LocaleSpace});

  // ==================================================================
  //                              KERNEL 4
  // ==================================================================
  // Calculate Betweenness Centrality for simple unweighted directed or
  // undirected graphs, using Madduri, et.al.'s modification of
  // Brandes's 2001 algorithm
  // ==================================================================

  proc approximate_betweenness_centrality ( G, starting_vertices,
                                            Between_Cent : [] real,
                                            out Sum_Min_Dist : real )

    // -----------------------------------------------------------------------
    // The betweenness centrality metric for a given node  v  is defined
    // as the double sum over s not equal to v and  t not equal to
    // either s or v of the ratio of the number of shortest paths from s to t
    // passing through v to the number of shortest paths from s to t.
    //
    // Brandes's algorithm decomposes the computation of this metric into,
    // first, separate sums for each vertex s, which can be computed
    // independently in parallel, and
    // two, a recursive, tree-based, calculation of the path counts for
    // any particular s.
    // The complexity of this algorithm is O ( |V||E| ) time for an unweighted
    // graph.  The algorithm requires O ( |V| ) temporary space for each
    // process that executes instances of the outermost loop.
    // -----------------------------------------------------------------------
    {
      const vertex_domain = G.vertices;

      // Considering using a dense 1-d array instead.  This would
      // complicate the Level_Set implementation a little, but would
      // probably be more efficient.
      type Sparse_Vertex_List = domain(index(vertex_domain));

      var Between_Cent$ : [vertex_domain] atomic real;
      var Sum_Min_Dist$ : atomic real;

      //
      // Throughout kernel 4, we use distributed arrays that are
      // private to each iteration of the outer loop.  Because set-up
      // and clean-up of such variables is very expensive, it is
      // desirable to do it at most only once per task versus once
      // per iteration, as a task executes multiple iterations of a
      // forall loop.
      //
      // To avoid this per-iteration overhead, we have implemented
      // an optimization that make certain variables private to each
      // task.  These variables are reinitialized each iteration of
      // the loop, but not reallocated, reprivatized, etc.
      //
      // Note that the Chapel group and collaborators are currently in
      // the process of bringing the idea of task private variable to
      // the language.
      //

      numTPVs = min(numTPVs, starting_vertices.size);
      const TPVSpace = {0..#numTPVs};
      var TPVLocales: [TPVSpace] locale;

      // Here we set up the locales array for our task private temporary
      // variables.  We use _computChunkStartEnd() to distribute the
      // variables approximately evenly across the 1d locales array.
      for t in TPVSpace {
        TPVLocales[t] = Locales[_computeChunkStartEnd(numLocales,
                                                      numTPVs, t+1)[1]-1];
      }
      const TPVLocaleSpace = {TPVSpace} dmapped Block(boundingBox={TPVSpace},
                                                      targetLocales=TPVLocales);

      // There will be numTPVs copies of the temps, thus throttling the
      // number of starting vertices being considered simultaneously.
      var TPV: [TPVLocaleSpace] taskPrivateData(domain(index(vertex_domain)),
                                                vertex_domain.type);

      // Initialize
      coforall (t, i) in (TPVLocaleSpace, TPVSpace) do on TPVLocaleSpace.dist.idxToLocale(t) {
          TPV[i] = new taskPrivateData(domain(index(vertex_domain)), vertex_domain);
          var tpv = TPV[i];
          forall v in vertex_domain do
            tpv.BCaux[v].children_list.nd = {1..G.n_Neighbors[v]};
          for loc in Locales do on loc {
            tpv.Active_Level[here.id] = new Level_Set (Sparse_Vertex_List);
            tpv.Active_Level[here.id].previous = nil;
            tpv.Active_Level[here.id].next = new Level_Set (Sparse_Vertex_List);;
            tpv.Active_Level[here.id].next.previous = tpv.Active_Level[here.id];
            tpv.Active_Level[here.id].next.next = nil;
          }
      }
      var TPVM: TPVManager(TPV.type) = new TPVManager(TPV);

      // ------------------------------------------------------
      // Each iteration of the outer loop of Brandes's algorithm
      // computes the contribution (the "dependency" metric) for
      // one particular vertex  (s)  independently.
      // ------------------------------------------------------

      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      forall s in starting_vertices do on vertex_domain.dist.idxToLocale(s) {

        const shere = here.id;

	if DEBUG_KERNEL4 then writeln ( "expanding from starting node ", s );

        // Initialize task private variables
        const tid = TPVM.gettid();
        const tpv = TPVM.getTPV(tid);
        var BCaux => tpv.BCaux;
        pragma "dont disable remote value forwarding"
        inline proc f1(BCaux, v) {
          BCaux[v].path_count$.write(0.0);
        }
        forall v in vertex_domain do {
          BCaux[v].depend = 0.0;
          BCaux[v].min_distance.write(-1);
          // BCaux[v].path_count$.writeXF(0.0);
          f1(BCaux, v);
          BCaux[v].children_list.child_count.write(0);
        }
	var Lcl_Sum_Min_Dist: atomic real;

	// The structure of the algorithm depends on a breadth-first
	// traversal. Each vertex will be marked by the length of
	// the shortest path (min_distance) from s to it. The array
	// path_count$ will hold a count of the number of shortest
	// paths from s to this node.  The number of paths in moderate
	// sized tori exceeds 2**64.

        //
        // Used to check termination of the forward pass
        //
        // We could use a task-private reduction variable here.  This
        // is yet another concept that the Chapel group is planning to
        // implement.
        //

        var remaining = true;

        //
        // Each locale will have its own level sets.  A locale's level set
        // will only contain nodes that are physically allocated on that
        // particular locale.
        //
        var Active_Level => tpv.Active_Level;
        pragma "dont disable remote value forwarding"
        inline proc f2(BCaux, s) {
          BCaux[s].path_count$.write(1.0);
        }

        var barrier = new Barrier(numLocales);

        coforall loc in Locales do on loc {
          Active_Level[here.id].Members.clear();
          Active_Level[here.id].next.Members.clear();
          if vertex_domain.dist.idxToLocale(s) == here {
            // Establish the initial level sets for the breadth-first
            // traversal from s
            Active_Level[here.id].Members.add(s);
            BCaux[s].min_distance.write(0);
            // BCaux[s].path_count$.writeXF(1);
            f2(BCaux, s);
          }
          barrier.barrier();

          var current_distance : int = 0;

          while remaining do {
	    // ------------------------------------------------
	    // expand the neighbor sets for all vertices at the
	    // current distance from the starting vertex  s
	    // ------------------------------------------------

	    current_distance += 1;

            // The Chapel compiler is still a bit conservative when it
            // comes to forwarding read-only variables to remote
            // locales, so we make a const copy here to insure it is
            // forwarded to the remote locale in the following
            // coforall loop.
            const current_distance_c = current_distance;
            pragma "dont disable remote value forwarding"
            inline proc f3(BCaux, v, u) {
              BCaux[v].path_count$.add(BCaux[u].path_count$.read());
            }

            forall u in Active_Level[here.id].Members do {
              forall v in G.FilteredNeighbors(u) do
                on if useOnClause then vertex_domain.dist.idxToLocale(v) else here {
                  // --------------------------------------------
                  // add any unmarked neighbors to the next level
                  // --------------------------------------------

                  if  BCaux[v].min_distance.compareExchangeStrong(-1, current_distance_c) {
                    var aloc = if useOnClause then here.id else vertex_domain.dist.idxToLocale(v).id;
                    Active_Level[aloc].next.Members.add (v);
                    if VALIDATE_BC then
                      Lcl_Sum_Min_Dist.add(current_distance_c);
                  }

                  // ------------------------------------------------
                  // only neighbors of  u  that are in the next level
                  // are on shortest paths from s through v.  Some
                  // task will have set  min_distance (v) by the
                  // time this code is reached, whether  v  lies in
                  // the previous, the current or the next level.
                  // ------------------------------------------------

                  if BCaux[v].min_distance.read() == current_distance_c {
                    // BCaux[v].path_count$ += BCaux[u].path_count$.readFF();
                    f3(BCaux, v, u);
                    BCaux[u].children_list.add_child (v);
                  }

                }
            };

            // This barrier is needed to insure all updates to the next
            // level are completed before updating to use the next level

            // do some work while we wait
            // barrier.notify(); // This is expensive without network atomics
            //  for now, just do a normal barrier

            if Active_Level[here.id].next.next == nil {
              Active_Level[here.id].next.next = new Level_Set (Sparse_Vertex_List);
              Active_Level[here.id].next.next.previous = Active_Level[here.id].next;
              Active_Level[here.id].next.next.next = nil;
            } else {
              Active_Level[here.id].next.next.Members.clear();
            }
            // barrier.wait(); // ditto
            barrier.barrier();
            if here.id==shere {
              remaining = false;
            }

            barrier.barrier();
            Active_Level[here.id] = Active_Level[here.id].next;
            if Active_Level[here.id].Members.numIndices:bool then
              remaining = true;

            barrier.barrier();

          };  // end forward pass

          if here.id==0 {
            if VALIDATE_BC then
              Sum_Min_Dist$.add(Lcl_Sum_Min_Dist);
          }

          // -------------------------------------------------------------
          // compute the dependencies recursively, traversing the vertices
          // of the graph in non-increasing order of distance (reverse
          // ordering from the initial traversal)
          // -------------------------------------------------------------

          const graph_diameter = current_distance - 1;

          if here.id==0 {
            if DEBUG_KERNEL4 then
              writeln ( " graph diameter from starting node ", s,
                        "  is ", graph_diameter );
          }

          pragma "dont disable remote value forwarding"
          inline proc f4(BCaux, Between_Cent$, u) {
            BCaux[u].depend = + reduce [v in BCaux[u].children_list.Row_Children[1..BCaux[u].children_list.child_count.read()]]
              ( BCaux[u].path_count$.read() /
                BCaux[v].path_count$.read() )      *
              ( 1.0 + BCaux[v].depend );
            Between_Cent$(u).add(BCaux[u].depend);
          }

          // back up to last level
          var curr_Level =  Active_Level[here.id].previous;

          for current_distance in 2 .. graph_diameter by -1 {
            curr_Level = curr_Level.previous;

            for u in curr_Level.Members do on vertex_domain.dist.idxToLocale(u) {
                f4(BCaux, Between_Cent$, u);
                /*
              BCaux[u].depend = + reduce [v in BCaux[u].children_list.Row_Children[1..BCaux[u].children_list.child_count.read()]]
                ( BCaux[u].path_count$.readFF() /
                  BCaux[v].path_count$.readFF() )      *
                ( 1.0 + BCaux[v].depend );
              Between_Cent$ (u) += BCaux[u].depend;
                */
            }

            barrier.barrier();
          }
        }

        TPVM.releaseTPV(tid);

      }; // closure of outer embarassingly parallel forall

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	var K4_time = stopwatch.elapsed ();
	stopwatch.clear ();
	writeln ( "Elapsed time for Kernel 4: ", K4_time, " seconds");

	const n_edges          = G.num_edges;
	const N_VERTICES       = vertex_domain.numIndices;
	const N_START_VERTICES = if starting_vertices == G.vertices
                                 then N_VERTICES
                                      - + reduce [v in vertex_domain]
                                        (G.n_Neighbors (v) == 0)
                                 else starting_vertices.numIndices;
	const TEPS             = 7.0 * N_VERTICES * N_START_VERTICES / K4_time;
	const Adjusted_TEPS    = n_edges * N_START_VERTICES / K4_time;

	writeln ( "                     TEPS: ", TEPS );
	writeln ( " edge count adjusted TEPS: ", Adjusted_TEPS );
      }

      if VALIDATE_BC then
        Sum_Min_Dist = Sum_Min_Dist$.read();

      Between_Cent = Between_Cent$.read();

      if DELETE_KERNEL4_DS {
        coforall t in TPVSpace do on t {
          var tpv = TPV[t];
          var al = tpv.Active_Level;
          coforall loc in Locales do on loc {
            var level = al[here.id];
            while level != nil {
                var l2 = level.next;
                delete level;
                level = l2;
            }
          }
          delete TPV[t];
        }
        delete TPVM;
      }

    } // end of Brandes' betweenness centrality calculation

  //
  // Addition support data structures for kernel 4
  //

  // ------------------------------------------------------------
  // The set of vertices at a particular distance from s form a
  // level set.  The class allows the full set of vertices to be
  // partitioned into a linked list of level sets.  Each instance
  // of the outer loop in kernel 4 creates such a partitioning.
  // ============================================================

  class Level_Set {
    type Sparse_Vertex_List;
    var Members  : Sparse_Vertex_List;
    var previous : Level_Set (Sparse_Vertex_List);
    var next : Level_Set (Sparse_Vertex_List);
  }

  //
  // Data structure to save Children lists between the forward
  //  and backwards passes
  //
  record child_struct {
    type vertex;
    var nd: domain(1);
    var Row_Children: [nd] vertex;
    var child_count: atomic int;

    // This function should only be called using unique vertices
    proc add_child ( new_child: vertex ) {
      var c = child_count.fetchAdd(1)+1;
      Row_Children[c] = new_child;
    }
  }

  //
  // Implementation of task-private variables for kernel 4
  //
  record taskPrivateArrayData {
    type vertex;
    var min_distance  : atomic int;
    var path_count$   : atomic real;
    var depend        : real;
    var children_list : child_struct(vertex);
  }

  class taskPrivateData {
    type Sparse_Vertex_List;
    const vertex_domain;
    var used  : atomic bool;
    var BCaux : [vertex_domain] taskPrivateArrayData(index(vertex_domain));
    var Active_Level : [PrivateSpace] Level_Set (Sparse_Vertex_List);
  }

  // This is a simple class that hands out task private variables from the
  // array of task private variables, TPV.
  class TPVManager {
    const TPV;
    var currTPV: atomic int;
    proc gettid() {
      const tid = this.currTPV.fetchAdd(1)%numTPVs;
      on this.TPV[tid] do
        while this.TPV[tid].used.testAndSet() do chpl_task_yield();
      return tid;
    }
    proc getTPV(tid) {
      return this.TPV[tid];
    }
    proc releaseTPV(tid) {
      this.TPV[tid].used.clear();
    }
  }

  //
  // reusable barrier implementation
  //
  record Barrier {
    param reusable = true;
    var n: int;
    var count: atomic_int64;
    var done: atomicflag;

    proc Barrier(_n: int) {
      reset(_n);
    }

    inline proc reset(_n: int) {
      on this {
        n = _n;
        count.write(n);
        done.write(false);
      }
    }

    inline proc barrier() {
      on this {
        const myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to barrier()");
          if reusable {
            count.waitFor(n-1);
            count.add(1);
            done.clear();
          }
        } else {
          done.waitFor(true);
          if reusable {
            count.add(1);
            done.waitFor(false);
          }
        }
      }
    }

    inline proc notify() {
      on this {
        const myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to notify()");
        }
      }
    }

    inline proc wait() {
      on this {
        done.waitFor(true);
        if reusable {
          const myc = count.fetchAdd(1);
          if myc == n-1 then
            done.clear();
          done.waitFor(false);
        }
      }
    }

    inline proc try() {
      return done.read();
    }
  }

}


Update to new zip() syntax.

Update to new zip() syntax.

This one slipped through the cracks, probably because it is only
tested for gasnet.

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@20700 3a8e244f-b0f2-452b-bcba-4c88e055c3ca

iter foo(n: int) {
  for i in 1..n do
    yield i;
}

iter foo(param tag: iterKind, n: int) where tag == iterKind.leader {
  cobegin {
    on Locales(0) do yield tuple(0..n-1 by 2);
    on Locales(1) do yield tuple(1..n-1 by 2);
  }
}

iter foo(param tag: iterKind, followThis, n: int) where tag == iterKind.follower {
  for i in followThis(1)+1 do
    yield i;
}

config var n: int = 8;

var A: [1..n] int;

forall i in foo(n) do
  A(i) = here.id * 100 + i;

writeln(A);

use Random;

{
  var B: [1..n] real;

  var rs = new RandomStream(seed=315);

  forall (i, r) in zip({1..n}, rs.iterate({1..n})) do
    B(i) = r;

  writeln(B);
}

{
  var B: [1..n] real;

  var rs = new RandomStream(seed=315);

  forall (f, r) in zip(foo(n), rs.iterate({1..n})) do
    B(f) = r;

  writeln(B);
}

iter foo(n: int) {
  for i in 1..n do
    yield i;
}

iter foo(param tag: iterKind, n: int) where tag == iterKind.leader {
  cobegin {
    on Locales(0) do yield tuple(0..n-1 by 2);
    on Locales(1) do yield tuple(1..n-1 by 2);
  }
}

iter foo(param tag: iterKind, followThis, n: int) where tag == iterKind.follower {
  for i in followThis(1)+1 do
    yield i;
}

config var n: int = 8;

var A: [1..n] int;

forall i in foo(n) do
  A(i) = here.id * 100 + i;

writeln(A);

use Random;

{
  var B: [1..n] real;

  var rs = new RandomStream(seed=315);

  forall (i, r) in ({1..n}, rs.iterate({1..n})) do
    B(i) = r;

  writeln(B);
}

{
  var B: [1..n] real;

  var rs = new RandomStream(seed=315);

  forall (f, r) in (foo(n), rs.iterate({1..n})) do
    B(f) = r;

  writeln(B);
}


update to MatrixOps doc

update to MatrixOps doc

use Cdo,
    LinearAlgebra,
    LinearAlgebra.Sparse;

proc verticesFromPG(con: Connection, edgeTable: string, fromField: string, toField: string, wField: string) {
  return 0;
}

/*
 :arg n: number of distinct vertices.  If not provided, it will look into the table for the max of the feature ids.
 */
proc wFromPG(con: Connection, edgeTable: string
    , fromField: string, toField: string, wField: string, n: int) {
  var q = "SELECT %s, %s, %s FROM %s ORDER BY 1, 2;";
  var cursor = con.cursor();
  cursor.query(q,(fromField, toField, wField, edgeTable));
  const D: domain(2) = {1..n, 1..n};
  var SD: sparse subdomain(D) dmapped CS();
  var W: [SD] real;

  for row in cursor {
    SD += (row[fromField]: int, row[toField]:int);
    W[row[fromField]:int, row[toField]:int] = row[wField]: real;
  }
   return W;
}

/*

 :arg con: A connection to a Postgres database containing a table with <ftr_id>, <vertex_name> pairs
 :arg nameTable: The name of the Postgres table containing the pairs
 :arg nameField: The name of the field in the nameTable containing the names
 :arg idField: The name of the field in the nameTable containing the feature ids

 :returns: An array of strings in order of feature id
 */
proc vNamesFromPG(con: Connection, nameTable: string
  , nameField: string, idField: string ) {

  var cursor = con.cursor();
  var q1 = "SELECT max(%s) AS n FROM %s";
  cursor.query(q1, (idField, nameTable));
  var n:int= cursor.fetchone()['n']: int;
  var vertexNames: [1..n] string;

  var q2 = "SELECT %s, %s FROM %s ORDER BY 1";
  cursor.query(q2, (idField, nameField, nameTable));
  for row in cursor {
      vertexNames[row[idField]:int ] = row[nameField];
  }
  return vertexNames;
}

use Cdo,
    LinearAlgebra,
    LinearAlgebra.Sparse;

proc verticesFromPG(con: Connection, edgeTable: string, fromField: string, toField: string, wField: string) {
  return 0;
}

/*
 :arg n: number of distinct vertices.  If not provided, it will look into the table for the max of the feature ids.
 */
proc wFromPG(con: Connection, edgeTable: string
    , fromField: string, toField: string, wField: string, n: int) {
  var q = "SELECT %s, %s, %s FROM %s ORDER BY 1, 2;";
  var cursor = con.cursor();
  cursor.query(q,(fromField, toField, wField, edgeTable));
  const D: domain(2) = {1..n, 1..n};
  var SD: sparse subdomain(D) dmapped CS();
  var W: [SD] real;

  for row in cursor {
    SD += (row[fromField]: int, row[toField]:int);
    W[row[fromField]:int, row[toField]:int] = row[wField]: real;
  }
   return W;
}

proc vNamesFromPG(con: Connection, nameTable: string
  , nameField: string, idField: string ) {

  var cursor = con.cursor();
  var q1 = "SELECT max(%s) AS n FROM %s";
  cursor.query(q1, (idField, nameTable));
  var n:int= cursor.fetchone()['n']: int;
  var vertexNames: [1..n] string;

  var q2 = "SELECT %s, %s FROM %s ORDER BY 1";
  cursor.query(q2, (idField, nameField, nameTable));
  for row in cursor {
      vertexNames[row[idField]:int ] = row[nameField];
  }

  /*
  var q = "SELECT %s, %s, FROM %s ORDER BY 2"
  cursor.query(q, (nameField, idField, nameTable));
  */

  return vertexNames;

}


Fix race condition that was causing valgrind testing non-determinism

Add synchronization to make sure output is printed in the right order
while preserving the intent of the test (main thread continues on
after a begin).

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@20383 3a8e244f-b0f2-452b-bcba-4c88e055c3ca

use Time;

config const numIters = 100000;
var s$: sync bool;

proc main() {
   begin doSomeWork();
   // while original task exits
   writeln("Original task falling out of main");
   s$ = true;
}

proc doSomeWork() {
   s$;
   for i in 1..numIters {
     write("");
     stdout.flush();
   }
   writeln("done working");
}

use Time;

config const numIters = 100000;

proc main() {
   begin doSomeWork();
   // while original task exits
   writeln("Original task falling out of main");
}

proc doSomeWork() {
   for i in 1..numIters {
     write("");
     stdout.flush();
   }
   writeln("done working");
}


incomplete gamma distribution but poisson works for now

module Stats {
  use Sort, BigInteger, Math, Random;

  /*
  Trying to make this as close as possible to the `SciPy Version<http://www.statsmodels.org/stable/_modules/statsmodels/distributions/empirical_distribution.html#ECDF`_
   */
  class ECDF {
    var nobs: int,
        odom = {1..nobs},
        dist: [odom] real,
        mx: real;

    proc init(x:[]) {
      sort(x);
      this.nobs = x.size;
      this.odom = {1..this.nobs};
      this.dist = x;
      this.mx = max reduce x;
    }
    proc this(x:[]) {
      var r: [x.domain] real;
      for i in x.domain {
        var p = findPosition(x[i]);
        r[i] = p;
      }
      return r;
    }

    proc this(x:real) {
      return findPosition(x);
    }

    proc findPosition(y) {
       var idx = 0;
       for i in 1..this.dist.size {
          if y < this.dist[i] {
            break;
          }
          idx = i;
       }
       return 1.0 * idx / this.nobs;
    }
  }

  /*
   Wrapper for BigInt.fac provided by Chapel.
   */

  proc factorial(k: int) {
    var b = new bigint();
    b.fac(k);
    return b;
  }

  /*
   The Poisson distribution.  Designed after https://stat.ethz.ch/R-manual/R-devel/library/stats/html/Poisson.html

   Find the the density of an integer n from a random Poisson X with lambda = l
   */
  proc dpois(n: int, l: real) {
    const f = factorial(n): real;
    var x = exp(-l) * l**n / f;
    return x;
  }

  /*
  Generate n random values from a Poisson rv with intensity lambda = l
  based on the first version here: https://en.wikipedia.org/wiki/Poisson_distribution#Generating_Poisson-distributed_random_variables
   */
  proc rpois(n: int, l: real) {
    var r: [1..n] real;
    for i in 1..n {
      r[i] = rpois(l);
    }
    return r;
  }

  /*
    Generate a single Poisson random variable
   */
  proc rpois(l: real) {
    var L: real = exp(-l),
        k: int = 0,
        p: real = 1;
    do {
      k += 1;
      var u: [1..1] real;
      fillRandom(u);
      p = p * u[1];
    } while p > L;
    return k - 1;
  }

  /*
   The Gamma distribution, density function
   */
   proc dgamma(x: real, shape: real, scale: real) {
     var y = (x**(shape-1) * exp(-x / scale)) / (scale**shape * tgamma(shape));
     return y;
   }

   /*
    The Gamma distribution, random generation.

    From this paper? https://arxiv.org/pdf/1304.3800.pdf
    Or maybe this one, includes C code: http://www.hongliangjie.com/2012/12/19/how-to-generate-gamma-random-variables/

    :TODO: Finish the Gamma distribution
    */
    proc rgamma() {
      return 0;
    }

}

module Stats {
  use Sort, BigInteger, Math, Random;

  /*
  Trying to make this as close as possible to the `SciPy Version<http://www.statsmodels.org/stable/_modules/statsmodels/distributions/empirical_distribution.html#ECDF`_
   */
  class ECDF {
    var nobs: int,
        odom = {1..nobs},
        dist: [odom] real,
        mx: real;

    proc init(x:[]) {
      sort(x);
      this.nobs = x.size;
      this.odom = {1..this.nobs};
      this.dist = x;
      this.mx = max reduce x;
    }
    proc this(x:[]) {
      var r: [x.domain] real;
      for i in x.domain {
        var p = findPosition(x[i]);
        r[i] = p;
      }
      return r;
    }

    proc this(x:real) {
      return findPosition(x);
    }

    proc findPosition(y) {
       var idx = 0;
       for i in 1..this.dist.size {
          if y < this.dist[i] {
            break;
          }
          idx = i;
       }
       return 1.0 * idx / this.nobs;
    }
  }

  /*
   Wrapper for BigInt.fac provided by Chapel.
   */

  proc factorial(k: int) {
    var b = new bigint();
    b.fac(k);
    return b;
  }

  /*
   The Poisson distribution.  Designed after https://stat.ethz.ch/R-manual/R-devel/library/stats/html/Poisson.html

   Find the the density of an integer n from a random Poisson X with lambda = l
   */
  proc dpois(n: int, l: real) {
    const f = factorial(n): real;
    var x = exp(-l) * l**n / f;
    return x;
  }

  /*
  Generate n random values from a Poisson rv with intensity lambda = l
  based on the first version here: https://en.wikipedia.org/wiki/Poisson_distribution#Generating_Poisson-distributed_random_variables
   */
  proc rpois(n: int, l: real) {
    var r: [1..n] real;
    for i in 1..n {
      r[i] = rpois(l);
    }
    return r;
  }

  /*
    Generate a single Poisson random variable
   */
  proc rpois(l: real) {
    var L: real = exp(-l),
        k: int = 0,
        p: real = 1;
    do {
      k += 1;
      var u: [1..1] real;
      fillRandom(u);
      p = p * u[1];
    } while p > L;
    return k - 1;
  }

  /*
   The Gamma distribution
   */
   proc dgamma(x: real, shape: real, scale: real) {
     var y = (x**(shape-1) * exp(-x / scale)) / (scale**shape * tgamma(shape));
     return y;
   }

}


Using a var instead of a refvar

Using a var instead of a refvar

use IO;
use AdvancedIters;

extern proc memcpy(x : [], b, len:int);

// For consistency with the other shootouts, a value is passed to this
// benchmark in the Computer Language Benchmarks Game test suite, even though
// the input set provided is used to determine the problem size.  Store that
// passed value here.
config const n = 0;

config const tableSize = 1 << 16;
config const lineSize = 61;

var tonum : [1..128] int;
tonum[0x41] = 0; // A
tonum[0x43] = 1; // C
tonum[0x54] = 2; // T
tonum[0x47] = 3; // G

var tochar : [0..3] string;
tochar[0] = "A";
tochar[1] = "C";
tochar[2] = "T";
tochar[3] = "G";

class Node {
  var data : uint;
  var count : int;
  var next : Node;
}

class Table {
  var table : [0..tableSize-1] Node;
  var size : int;

  proc this(d : uint) ref {
    const slot :int = (d & (tableSize-1)):int;
    refvar head = table[slot];
    var n = head;
    if n == nil {
      n = new Node(d, 0, nil);
      size += 1;
      head = n;
      return n.count;
    }

    while n != nil {
      if n.data == d then return n.count;
      n = n.next;
    }
    n = new Node(d, 0, head);
    size += 1;
    head = n;
    return n.count;
  }

  iter these() {
    for t in table {
      var n = t;
      while n != nil {
        yield (n.data, n.count);
        n = n.next;
      }
    }
  }

  proc ~Table() {
    for n in table do {
      var cur = n;
      while cur != nil {
        refvar next = cur.next;
        delete cur;
        cur = next;
      }
    }
  }
}

inline proc hash(str : [] uint(8), beg:int, sizeRange:range(?) ) {
  var data : uint = 0;
  for i in sizeRange {
    data <<= 2;
    data |= tonum[str[beg+i]];
  }
  return data;
}

proc decode(data : uint, size : int) {
  var ret : string;
  var d = data;
  for i in 1..size {
    ret = tochar[(d & 3) : uint(8)] + ret;
    d >>= 2;
  }
  return ret;
}

proc calculate(data : [] uint(8), size : int) {
  var freqs = new Table();

  const ntasks = defaultNumTasks(0);
  var lock : sync bool;
  lock = true;
  const sizeRange = 0..size-1;
  coforall tid in 1..ntasks {
    var curArr = new Table();
    for i in tid .. data.size-size by ntasks {
      curArr[hash(data, i, sizeRange)] += 1;
    }
    lock; // acquire lock
    for (k,v) in curArr do freqs[k] += v;
    lock = true; // free lock
    delete curArr;
  }

  return freqs;
}

proc write_frequencies(data : [] uint(8), size : int) {
  var sum = data.size  - size;
  var freqs = calculate(data, size);

  // sort by frequencies
  var arr : [1..freqs.size] (int, uint);
  for (a, (k,v)) in zip(arr, freqs) do
    a = (v,k);
  QuickSort(arr, reverse=true);

  for (f, s) in arr do
    writef("%s %.3dr\n", decode(s, size), (100.0 * f) / sum);
  delete freqs;
}

proc write_count(data : [] uint(8), str : string) {
  var freqs = calculate(data, str.length);
  var d = hash(str.toBytes(), 1, 0..str.length-1);
  writeln(freqs[d], "\t", decode(d, str.length));
  delete freqs;
}

proc string.toBytes() ref {
   var b : [1..this.length] uint(8);
   memcpy(b, this, this.length);
   return b;
}

inline proc startsWithThree(data : []) {
  return data[1] == 0x3E && data[2] == 0x54 && data[3] == 0x48;
}

proc main() {
  // Open stdin and a binary reader channel
  const inFile = openfd(0);
  const fileLen = inFile.length();
  var myin = inFile.reader(kind=ionative,locking=false);

  // Read line-by-line until we see a line beginning with '>TH'
  var tempdata : [1..lineSize] uint(8);
  var numRead = 0;
  var total = 0;
  while myin.readline(tempdata, numRead) && !startsWithThree(tempdata) { total += numRead; }

  // Read in the rest of the file
  var dataDom = {1..fileLen-total};
  var data : [dataDom] uint(8);
  var idx = 1;
  while myin.readline(data, numRead, idx) { idx += numRead - 1; }

  // Resize our array to the amount actually read
  dataDom = {1..idx};

  // Make everything uppercase
  forall d in data do d ^= 0x20;

  write_frequencies(data, 1);
  writeln();
  write_frequencies(data, 2);
  writeln();
  write_count(data, "GGT");
  write_count(data, "GGTA");
  write_count(data, "GGTATT");
  write_count(data, "GGTATTTTAATT");
  write_count(data, "GGTATTTTAATTTATAGT");
}

use IO;
use AdvancedIters;

extern proc memcpy(x : [], b, len:int);

// For consistency with the other shootouts, a value is passed to this
// benchmark in the Computer Language Benchmarks Game test suite, even though
// the input set provided is used to determine the problem size.  Store that
// passed value here.
config const n = 0;

config const tableSize = 1 << 16;
config const lineSize = 61;

var tonum : [1..128] int;
tonum[0x41] = 0; // A
tonum[0x43] = 1; // C
tonum[0x54] = 2; // T
tonum[0x47] = 3; // G

var tochar : [0..3] string;
tochar[0] = "A";
tochar[1] = "C";
tochar[2] = "T";
tochar[3] = "G";

class Node {
  var data : uint;
  var count : int;
  var next : Node;
}

class Table {
  var table : [0..tableSize-1] Node;
  var size : int;

  proc this(d : uint) ref {
    const slot :int = (d & (tableSize-1)):int;
    refvar head = table[slot];
    var n = head;
    if n == nil {
      n = new Node(d, 0, nil);
      size += 1;
      head = n;
      return n.count;
    }

    while n != nil {
      if n.data == d then return n.count;
      n = n.next;
    }
    n = new Node(d, 0, head);
    size += 1;
    head = n;
    return n.count;
  }

  iter these() {
    for t in table {
      var n = t;
      while n != nil {
        yield (n.data, n.count);
        n = n.next;
      }
    }
  }

  proc ~Table() {
    for n in table do {
      refvar cur = n;
      while cur != nil {
        refvar next = cur.next;
        delete cur;
        cur = next;
      }
    }
  }
}

inline proc hash(str : [] uint(8), beg:int, sizeRange:range(?) ) {
  var data : uint = 0;
  for i in sizeRange {
    data <<= 2;
    data |= tonum[str[beg+i]];
  }
  return data;
}

proc decode(data : uint, size : int) {
  var ret : string;
  var d = data;
  for i in 1..size {
    ret = tochar[(d & 3) : uint(8)] + ret;
    d >>= 2;
  }
  return ret;
}

proc calculate(data : [] uint(8), size : int) {
  var freqs = new Table();

  const ntasks = defaultNumTasks(0);
  var lock : sync bool;
  lock = true;
  const sizeRange = 0..size-1;
  coforall tid in 1..ntasks {
    var curArr = new Table();
    for i in tid .. data.size-size by ntasks {
      curArr[hash(data, i, sizeRange)] += 1;
    }
    lock; // acquire lock
    for (k,v) in curArr do freqs[k] += v;
    lock = true; // free lock
    delete curArr;
  }

  return freqs;
}

proc write_frequencies(data : [] uint(8), size : int) {
  var sum = data.size  - size;
  var freqs = calculate(data, size);

  // sort by frequencies
  var arr : [1..freqs.size] (int, uint);
  for (a, (k,v)) in zip(arr, freqs) do
    a = (v,k);
  QuickSort(arr, reverse=true);

  for (f, s) in arr do
    writef("%s %.3dr\n", decode(s, size), (100.0 * f) / sum);
  delete freqs;
}

proc write_count(data : [] uint(8), str : string) {
  var freqs = calculate(data, str.length);
  var d = hash(str.toBytes(), 1, 0..str.length-1);
  writeln(freqs[d], "\t", decode(d, str.length));
  delete freqs;
}

proc string.toBytes() ref {
   var b : [1..this.length] uint(8);
   memcpy(b, this, this.length);
   return b;
}

inline proc startsWithThree(data : []) {
  return data[1] == 0x3E && data[2] == 0x54 && data[3] == 0x48;
}

proc main() {
  // Open stdin and a binary reader channel
  const inFile = openfd(0);
  const fileLen = inFile.length();
  var myin = inFile.reader(kind=ionative,locking=false);

  // Read line-by-line until we see a line beginning with '>TH'
  var tempdata : [1..lineSize] uint(8);
  var numRead = 0;
  var total = 0;
  while myin.readline(tempdata, numRead) && !startsWithThree(tempdata) { total += numRead; }

  // Read in the rest of the file
  var dataDom = {1..fileLen-total};
  var data : [dataDom] uint(8);
  var idx = 1;
  while myin.readline(data, numRead, idx) { idx += numRead - 1; }

  // Resize our array to the amount actually read
  dataDom = {1..idx};

  // Make everything uppercase
  forall d in data do d ^= 0x20;

  write_frequencies(data, 1);
  writeln();
  write_frequencies(data, 2);
  writeln();
  write_count(data, "GGT");
  write_count(data, "GGTA");
  write_count(data, "GGTATT");
  write_count(data, "GGTATTTTAATT");
  write_count(data, "GGTATTTTAATTTATAGT");
}


Adjust white   space.

Adjust white   space.

/*
 * 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.
 */

/*
This module provides wrappers for <cmath> (math.h) numerical constants and
routines.  Its symbols are provided by default; an explicit 'use' statement
is not necessary.

The C Math library is part of the C Language Standard (ISO/IEC 9899), as
described in Section 7.12.  Please consult that standard for an
authoritative description of the expected properties of those constants and
routines.

In general, where the C math library provides a *double* and a *float* version
of a function, the float version has a suffix 'f'.  In the Chapel interface,
the suffix is dropped, and the type of the operand determines which version is
called -- according to the usual function overloading and resolution rules.
Normally, the result has the same precision
as the argument(s).  Please consult the C standard for specifics.

Rounding -- The rounding mode for floating-point addition (subtraction) is
implementation-defined.

Error Handling -- At present, Chapel does not provide control over error
handling in the Math module.  The default behavior is as if the macro
``math_errhandling`` is set to 0: Given erroneous input at run-time,
all math functions will return an implementation-defined value; no
exception will be generated.

*/
module Math {

  //////////////////////////////////////////////////////////////////////////
  // Helper constants and functions (not included in chpldocs).
  //
  pragma "no doc"
  extern proc chpl_macro_INFINITY():real(64);
  pragma "no doc"
  extern proc chpl_macro_NAN():real(64);

  pragma "no doc"
  extern proc chpl_macro_double_isinf(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isinf(x: real(32)): c_int;
  pragma "no doc"
  extern proc chpl_macro_double_isfinite(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isfinite(x: real(32)): c_int;
  pragma "no doc"
  extern proc chpl_macro_double_isnan(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isnan(x: real(32)): c_int;

  pragma "no doc"
  proc _logBasePow2Help(in val, baseLog2) {
    var result = -1;
    while (val != 0) {
      val >>= baseLog2;
      result += 1;
    }
    return result;
  }

  pragma "no doc"
  proc logBasePow2(in val: int(?w), baseLog2) {
    if (val < 1) {
      halt("Can't take the log() of a non-positive integer");
    }
    return _logBasePow2Help(val, baseLog2);
  }

  pragma "no doc"
  proc logBasePow2(in val: uint(?w), baseLog2) {
    if (val < 1) {
      halt("Can't take the log() of a non-positive integer");
    }
    return _logBasePow2Help(val, baseLog2);
  }

  pragma "no doc"
  inline proc mod_help(m: integral, n: integral) {
    const temp = m % n;

    // eliminate some run-time tests if input(s) is(are) unsigned
    return
      if isNonnegative(n) then
        if isUintType(m.type)
        then temp
        else ( if temp >= 0 then temp else temp + n )
      else
        // n < 0
        ( if temp <= 0 then temp else temp + n );
  }

  pragma "no doc"
  inline proc mod_help(x: real(?w), y: real(w)): real(w) {
    // This codes up the standard definition, according to Wikipedia.
    // Is there a more efficient implementation for reals?
    return x - y*floor(x/y);
  }

  pragma "no doc"
  inline proc sgn_help(i : int(?w)): int(8)
    return ((i > 0) : int(8) - (i < 0) : int(8)) : int(8);

  pragma "no doc"
  inline proc sgn_help(i : uint(?w)): uint(8)
    return (i > 0) : uint(8);

  pragma "no doc"
  inline proc sgn_help(x : real(?w)): int(8)
    return ((x > 0.0) : int(8) - (x < 0.0) : int(8)) : int(8);
  //
  //////////////////////////////////////////////////////////////////////////

  //////////////////////////////////////////////////////////////////////////
  //
  // Public interface (included in chpldocs).
  //
  // (The entries below are alphabetized (case-insensitively) because chpldocs
  // presents them in declaration order.)
  //

  /* Returns the absolute value of the integer param argument `i`. */
  proc abs(param i : integral) param return if i < 0 then -i else i;

  /* Returns the magnitude (absolute value) of the argument `x`.

     :rtype: The type of `x`.
  */
  inline proc abs(x) where isNumericalType(x.type) {
    if isComplex(x) {
      return sqrt(x.re * x.re + x.im * -x.im);
    } else if isReal(x) {
      if numBits(x) == 64 {
        extern proc fabs(x: real(64)): real(64);
        return fabs(x);
      } else if numBits(x) == 32 {
        extern proc fabsf(x: real(32)): real(32);
        return fabsf(x);
      } else {
        compilerError("abs() -- Invalid real argument width: ", numBits(x));
      }
    } else if isImaginary(x) {
      if numBits(x) == 64 {
        extern proc fabs(x: real(64)): real(64);
        return fabs(_i2r(x));
      } else if numBits(x) == 32 {
        extern proc fabsf(x: real(32)): real(32);
        return fabsf(_i2r(x));
      } else {
        compilerError("abs() -- Invalid imaginary argument width ", numBits(x));
      }
    } else if isIntegral(x) {
      if (isSigned(x)) then
        return if i < 0 then -i else i;
      else
        return if x == 0 then 0 else i;
    } else{
      compilerError("abs() -- Invalid argument type: ", typeToString(x.type));
    }
  }

  /* Returns the arc cosine of the real argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc acos(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc acos(x: real(64)): real(64);
      return acos(x);
    } else if w == 32 {
      extern proc acosf(x: real(32)): real(32);
      return acosf(x);
    } else {
      compilerError("acos() -- Invalid argument width ", w);
    }
  }

  /* Returns the inverse hyperbolic cosine of the argument `x`.

     It is an error if `x` is less than 1.
  */
  inline proc acosh(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc acosh(x: real(64)): real(64);
      return acosh(x);
    } else if w == 32 {
      extern proc acoshf(x: real(32)): real(32);
      return acoshf(x);
    } else {
      compilerError("acosh() -- Invalid argument width ", w);
    }
  }

  /* Returns the arc sine of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc asin(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc asin(x: real(64)): real(64);
      return asin(x);
    } else if w == 32 {
      extern proc asinf(x: real(32)): real(32);
      return asinf(x);
    } else {
      compilerError("asin() -- Invalid argument width ", w);
    }
  }

  /* Returns the inverse hyperbolic sine of the argument `x`. */
  inline proc asinh(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc asinh(x: real(64)): real(64);
      return asinh(x);
    } else if w == 32 {
      extern proc asinyf(x: real(32)): real(32);
      return asinhf(x);
    } else {
      compilerError("asinh() -- Invalid argument width ", w);
    }
  }

  /* Returns the arc tangent of the argument `x`. */
  inline proc atan(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc atan(x: real(64)): real(64);
      return atan(x);
    } else if w == 32 {
      extern proc atanf(x: real(32)): real(32);
      return atanf(x);
    } else {
      compilerError("atan() -- Invalid argument width ", w);
    }
  }

  /* Returns the arc tangent of the ratio of the two arguments.

     This is equivalent to
     the arc tangent of `y` / `x` except that the signs of `y`
     and `x` are used to determine the quadrant of the result.
  */
  inline proc atan2(y: real(?w), x: real(w)) : real(w) {
    if w == 64 {
      extern proc atan2(y: real(64), x: real(64)): real(64);
      return atan2(y, x);
    } else if w == 32 {
      extern proc atan2f(y: real(32), x: real(32)): real(32);
      return atan2f(y, x);
    } else {
      compilerError("atan2() -- Invalid argument width ", w);
    }
  }

  /* Returns the inverse hyperbolic tangent of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc atanh(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc atanh(x: real(64)): real(64);
      return atanh(x);
    } else if w == 32 {
      extern proc atanhf(x: real(32)): real(32);
      return atanhf(x);
    } else {
      compilerError("atanh() -- Invalid argument width ", w);
    }
  }

  /* Returns the cube root of the argument `x`. */
  inline proc cbrt(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc cbrt(x: real(64)): real(64);
      return cbrt(x);
    } else if w == 32 {
      extern proc cbrtf(x: real(32)): real(32);
      return cbrtf(x);
    } else {
      compilerError("cbrt() -- Invalid argument width ", w);
    }
  }

  /* Returns the value of the argument `x` rounded up to the nearest integer. */
  inline proc ceil(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc ceil(x: real(64)): real(64);
      return ceil(x);
    } else if w == 32 {
      extern proc ceilf(x: real(32)): real(32);
      return ceilf(x);
    } else {
      compilerError("ceil() -- Invalid argument width ", w);
    }
  }

  /* Returns the complex conjugate of the argument `x`. */
  inline proc conjg(x: complex(?w)) : complex(w) return (x.re, -x.im):complex(w);

  /* Returns the cosine of the argument `x`. */
  inline proc cos(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc cos(x: real(64)): real(64);
      return cos(x);
    } else if w == 32 {
      extern proc cosf(x: real(32)): real(32);
      return cosf(x);
    } else {
      compilerError("cos() -- Invalid argument width ", w);
    }
  }

  /* Returns the hyperbolic cosine of the argument `x`. */
  inline proc cosh(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc cosh(x: real(64)): real(64);
      return cosh(x);
    } else if w == 32 {
      extern proc coshf(x: real(32)): real(32);
      return coshf(x);
    } else {
      compilerError("cosh() -- Invalid argument width ", w);
    }
  }

  /* Returns :proc:`ceil`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded up to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divceil(param m: integral, param n: integral)
    param
    return
    if isNonnegative(m) then
      if isNonnegative(n) then (m + n - 1) / n
      else                     m / n
    else
      if isNonnegative(n) then m / n
      else                     (m + n + 1) / n;

  /* Returns :proc:`ceil`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded up to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divceil(m: integral, n: integral) return
    if isNonnegative(m) then
      if isNonnegative(n) then (m + n - 1) / n
      else                     m / n
    else
      if isNonnegative(n) then m / n
      else                     (m + n + 1) / n;

  /* Returns :proc:`floor`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded down to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divfloor(param m: integral, param n: integral) param return
    if isNonnegative(m) then
      if isNonnegative(n) then m / n
      else                     (m - n - 1) / n
    else
      if isNonnegative(n) then (m - n + 1) / n
      else                     m / n;

  /* Returns :proc:`floor`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded down to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divfloor(m: integral, n: integral) return
    if isNonnegative(m) then
      if isNonnegative(n) then m / n
      else                     (m - n - 1) / n
    else
      if isNonnegative(n) then (m - n + 1) / n
      else                     m / n;

  /* Returns the error function of the argument `x`. */
  inline proc erf(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc erf(x: real(64)): real(64);
      return erf(x);
    } else if w == 32 {
      extern proc erff(x: real(32)): real(32);
      return erff(x);
    } else {
      compilerError("erf() -- Invalid argument width ", w);
    }
  }

  /* Returns the complementary error function of the argument.
     This is equivalent to 1.0 - :proc:`erf`\(`x`).
  */
  inline proc erfc(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc erfc(x: real(64)): real(64);
      return erfc(x);
    } else if w == 32 {
      extern proc erfcf(x: real(32)): real(32);
      return erfcf(x);
    } else {
      compilerError("erfc() -- Invalid argument width ", w);
    }
  }

  /* Returns the value of the Napierien `e` raised to the power of the argument `x`. */
  inline proc exp(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc exp(x: real(64)): real(64);
      return exp(x);
    } else if w == 32 {
      extern proc expf(x: real(32)): real(32);
      return expf(x);
    } else {
      compilerError("exp() -- Invalid argument width ", w);
    }
  }

  /* Returns the value of `2` raised to the power of the argument `x`. */
  inline proc exp2(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc exp2(x: real(64)): real(64);
      return exp2(x);
    } else if w == 32 {
      extern proc exp2f(x: real(32)): real(32);
      return exp2f(x);
    } else {
      compilerError("exp2() -- Invalid argument width ", w);
    }
  }

  /* Returns one less than the value of the Napierien `e` raised to the power
     of the argument `x`.
  */
  inline proc expm1(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc expm1(x: real(64)): real(64);
      return expm1(x);
    } else if w == 32 {
      extern proc expm1f(x: real(32)): real(32);
      return expm1f(x);
    } else {
      compilerError("expm1() -- Invalid argument width ", w);
    }
  }

  /* Returns the value of the argument `x` rounded down to the nearest integer. */
  inline proc floor(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc floor(x: real(64)): real(64);
      return floor(x);
    } else if w == 32 {
      extern proc floorf(x: real(32)): real(32);
      return floorf(x);
    } else {
      compilerError("floor() -- Invalid argument width ", w);
    }
  }

  /* Returns a value for which :proc:`isinf` will return `true`. */
  inline proc INFINITY: real(64) return chpl_macro_INFINITY();

  /* Returns `true` if the argument `x` is a representation of a finite value;
     `false` otherwise.
  */
  inline proc isfinite(x: real(?w)) : real(w) {
    if w == 64 {
      return chpl_macro_double_isfinite(x);
    } else if w == 32 {
      return chpl_macro_float_isfinite(x);
    } else {
      compilerError("isfinite() -- Invalid argument width ", w);
    }
  }

  /* Returns `true` if the argument `x` is a representation of *infinity*;
     `false` otherwise. */
  inline proc isinf(x: real(?w)) : real(w) {
    if w == 64 {
      return chpl_macro_double_isinf(x);
    } else if w == 32 {
      return chpl_macro_float_isinf(x);
    } else {
      compilerError("isinf() -- Invalid argument width ", w);
    }
  }

  /* Returns `true` if the argument `x` does not represent a valid number;
     `false` otherwise. */
  inline proc isnan(x: real(?w)) : real(w) {
    if w == 64 {
      return chpl_macro_double_isnan(x);
    } else if w == 32 {
      return chpl_macro_float_isnan(x);
    } else {
      compilerError("isnan() -- Invalid argument width ", w);
    }
  }

  /* Returns the natural logarithm of the absolute value
     of the gamma function of the argument `x`.
  */
  inline proc lgamma(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc lgamma(x: real(64)): real(64);
      return lgamma(x);
    } else if w == 32 {
      extern proc lgammaf(x: real(32)): real(32);
      return lgammaf(x);
    } else {
      compilerError("lgamma() -- Invalid argument width ", w);
    }
  }

  /* Returns the natural logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc log(x: real(64)): real(64);
      return log(x);
    } else if w == 32 {
      extern proc logf(x: real(32)): real(32);
      return logf(x);
    } else {
      compilerError("log() -- Invalid argument width ", w);
    }
  }

  /* Returns the base 10 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log10(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc log10(x: real(64)): real(64);
      return log10(x);
    } else if w == 32 {
      extern proc log10f(x: real(32)): real(32);
      return log10f(x);
    } else {
      compilerError("log10() -- Invalid argument width ", w);
    }
  }

  /* Returns the natural logarithm of `x` + 1.

     It is an error if `x` is less than or equal to -1.
  */
  inline proc log1p(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc log1p(x: real(64)): real(64);
      return log1p(x);
    } else if w == 32 {
      extern proc log1pf(x: real(32)): real(32);
      return log1pf(x);
    } else {
      compilerError("log1p() -- Invalid argument width ", w);
    }
  }

  /* Returns the base 2 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log2(x) : x.type where isNumeric(x) {
    if isReal(x) {
      if w == 64 {
        extern proc log2(x: real(64)): real(64);
        return log2(x);
      } else if w == 32 {
        extern proc log2f(x: real(32)): real(32);
        return log2f(x);
      } else {
        compilerError("log2() -- Invalid real argument width ", w);
      }
    } else if isIntegral(x) {
      return logBasePow2(val, 1);
    } else {
      compilerError("log2() -- Invalid numeric argument type: ",
                    typeToString(x.type));
    }
  }

  /* Computes the mod operator on the two integer param arguments, defined as
     ``mod(x,y) = x - y * floor(x / y)``.
  */
  proc mod(param m: integral, param n: integral) param {
    param temp = m % n;

    // verbatim copy from the other 'mod', to simplify maintenance
    return
      if isNonnegative(n) then
        if isUintType(m.type)
        then temp
        else ( if temp >= 0 then temp else temp + n )
      else
        // n < 0
        ( if temp <= 0 then temp else temp + n );
  }

  /* Computes the mod operator on the two arguments, defined as
     ``mod(x,y) = x - y * floor(x / y)``.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  inline proc mod(m:numeric, n:numeric) {
    return mod_help(m, n);
  }

  /* Returns a value for which :proc:`isnan` will return `true`. */
  inline proc NAN : real(64) return chpl_macro_NAN();

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`nearbyint` will not raise the "inexact"
     floating-point exception.
  */
  inline proc nearbyint(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc nearbyint(x: real(64)): real(64);
      return nearbyint(x);
    } else if w == 32 {
      extern proc nearbyintf(x: real(32)): real(32);
      return nearbyintf(x);
    } else {
      compilerError("nearbyint() -- Invalid argument width ", w);
    }
  }

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`rint` may raise the "inexact" floating-point
     exception.
  */
  inline proc rint(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc rint(x: real(64)): real(64);
      return rint(x);
    } else if w == 32 {
      extern proc rintf(x: real(32)): real(32);
      return rintf(x);
    } else {
      compilerError("rint() -- Invalid argument width ", w);
    }
  }

  /* Returns the rounded integral value of the argument `x`. */
  inline proc round(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc round(x: real(64)): real(64);
      return round(x);
    } else if w == 32 {
      extern proc roundf(x: real(32)): real(32);
      return roundf(x);
    } else {
      compilerError("round() -- Invalid argument width ", w);
    }
  }

  /* Returns the signum function of the integer param argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  proc sgn(param i : integral) param
    return if i > 0 then 1 else if i == 0 then 0 else -1;

  /* Returns the signum function of the argument `x`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(x: numeric) return sgn_help(x);

  /* Returns the sine of the argument `x`. */
  inline proc sin(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc sin(x: real(64)): real(64);
      return sin(x);
    } else if w == 32 {
      extern proc sinf(x: real(32)): real(32);
      return sinf(x);
    } else {
      compilerError("sin() -- Invalid argument width ", w);
    }
  }

  /* Returns the hyperbolic sine of the argument `x`. */
  inline proc sinh(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc sinh(x: real(64)): real(64);
      return sinh(x);
    } else if w == 32 {
      extern proc sinhf(x: real(32)): real(32);
      return sinhf(x);
    } else {
      compilerError("sinh() -- Invalid argument width ", w);
    }
  }

  /* Returns the square root of the argument `x`.

     It is an error if the `x` is less than zero.
  */
  inline proc sqrt(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc sqrt(x: real(64)): real(64);
      return sqrt(x);
    } else if w == 32 {
      extern proc sqrtf(x: real(32)): real(32);
      return sqrtf(x);
    } else {
      compilerError("sqrt() -- Invalid argument width ", w);
    }
  }

  /* Returns the tangent of the argument `x`. */
  inline proc tan(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc tan(x: real(64)): real(64);
      return tan(x);
    } else if w == 32 {
      extern proc tanf(x: real(32)): real(32);
      return tanf(x);
    } else {
      compilerError("tan() -- Invalid argument width ", w);
    }
  }

  /* Returns the hyperbolic tangent of the argument `x`. */
  inline proc tanh(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc tanh(x: real(64)): real(64);
      return tanh(x);
    } else if w == 32 {
      extern proc tanhf(x: real(32)): real(32);
      return tanhf(x);
    } else {
      compilerError("tanh() -- Invalid argument width ", w);
    }
  }

  /* Returns the absolute value of the gamma function of the argument `x`. */
  inline proc tgamma(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc tgamma(x: real(64)): real(64);
      return tgamma(x);
    } else if w == 32 {
      extern proc tgammaf(x: real(32)): real(32);
      return tgammaf(x);
    } else {
      compilerError("tgamma() -- Invalid argument width ", w);
    }
  }

  /* Returns the nearest integral value to the argument `x` that is not larger
     than `x` in absolute value. */
  inline proc trunc(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc trunc(x: real(64)): real(64);
      return trunc(x);
    } else if w == 32 {
      extern proc truncf(x: real(32)): real(32);
      return truncf(x);
    } else {
      compilerError("trunc() -- Invalid argument width ", w);
    }
  }

} // end of module Math


Remove file accidentally checked in.

Remove file accidentally checked in.

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@7008 3a8e244f-b0f2-452b-bcba-4c88e055c3ca