adding function to persist sparse matrices to postgres

use Cdo,
    LinearAlgebra,
    LinearAlgebra.Sparse;

/*
  :arg con: A CDO Connection to Postgres
  :arg edgeTable: The table in PG of edges
  :arg fromField: The field of edgeTable containing the id of the head vertex
  :arg toField: the field of edgeTable containing the id of the tail vertex
  :arg wField: The field of edgeTable containing the weight of the edge
  :arg n: number of distinct vertices. In practice, this may be gives and the number of names
  :arg weights: Boolean on whether to use the weights in the table or a 1 (indicator)
 */
proc wFromPG(con: Connection, edgeTable: string
    , fromField: string, toField: string, wField: string, n: int, weights=true) {
  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);
    if weights {
      W[row[fromField]:int, row[toField]:int] = row[wField]: real;
    } else {
      W[row[fromField]:int, row[toField]:int] = 1;
    }
  }
   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;
}

/*
 */
proc persistSparseMatrix(con:Connection, aTable: string, fromField: string
  , toField: string, weightField: string, A) {
  const q = "INSERT INTO %s (%s, %s, %s) VALUES (%s, %s, %s);";
  var cur = con.cursor();
  for (i,j) in A.domain {
    //writeln(" i, j ", ij[1], ", ", ij[2]);
    const d = (aTable, fromField, toField, weightField, i, j, A[i,j]);
    cur.execute(q, d);
  }
}

use Cdo,
    LinearAlgebra,
    LinearAlgebra.Sparse;

/*
  :arg con: A CDO Connection to Postgres
  :arg edgeTable: The table in PG of edges
  :arg fromField: The field of edgeTable containing the id of the head vertex
  :arg toField: the field of edgeTable containing the id of the tail vertex
  :arg wField: The field of edgeTable containing the weight of the edge
  :arg n: number of distinct vertices. In practice, this may be gives and the number of names
  :arg weights: Boolean on whether to use the weights in the table or a 1 (indicator)
 */
proc wFromPG(con: Connection, edgeTable: string
    , fromField: string, toField: string, wField: string, n: int, weights=true) {
  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);
    if weights {
      W[row[fromField]:int, row[toField]:int] = row[wField]: real;
    } else {
      W[row[fromField]:int, row[toField]:int] = 1;
    }
  }
   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;
}

/*
 */
proc persistSparseMatrix(con:Connection, aTable: string, fromField: string
  , toField: string, weightField: string, A) {
  const q = "INSERT INTO %s (%s, %s, %s) VALUES (%s, %s, %s);";
  var cur = con.cursor();
  for (i,j) in A.domain {
    const d = (aTable, fromField, toField, weightField, i, j, A[i,j]);
    cur.execute(q, d);
  }
}


Minor mods to kernel 4 for not so minor performance improvements

- Always use on clauses in the forward pass.  There are a significant
  number of remote gets in the inner loop if we don't use the on
  clause, and the improved performance of the remote atomics does not
  (yet) make up for it.  In the future, we should be able to get rid
  of some (most) of these gets.

- Mark the entire inner loop body of the forward pass with the don't
  disable remote value forwarding pragma.

- Import Rachel's new barrier implementation, and make the barrier a
  task private variable because it now contains a distributed array.

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@20441 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;
  // 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);
        }

        const barrier = tpv.barrier;

        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, current_distance_c, Active_Level, Lcl_Sum_Min_Dist) {

                  // --------------------------------------------
                  // add any unmarked neighbors to the next level
                  // --------------------------------------------

                  if  BCaux[v].min_distance.compareExchangeStrong(-1, current_distance_c) {
                    Active_Level[here.id].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$.add(BCaux[u].path_count$.read());
                    //f3(BCaux, v, u);
                    BCaux[u].children_list.add_child (v);
                  }

            }

            forall u in Active_Level[here.id].Members do {
              forall v in G.FilteredNeighbors(u) do on vertex_domain.dist.idxToLocale(v) {
                      f3(BCaux, v, u, current_distance_c, Active_Level, Lcl_Sum_Min_Dist);
                }
            };

            // 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];
          delete tpv.barrier;
          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_int64; // used only on home locale
    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 barrier = new Barrier(numLocales);
    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
  //
  class Barrier {
    param reusable = true;
    var n: int;
    var count: atomic int;
    var tasksFinished: [PrivateSpace] atomic bool;

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

    inline proc reset(_n: int) {
      on this {
        n = _n;
        count.write(n);
        for loc in tasksFinished {
          loc.write(false);
        }
      }
    }

    inline proc barrier() {
      const myc = count.fetchSub(1);
      if myc <= 1 {
        if tasksFinished[here.id].read() {
          halt("too many callers to barrier()");
        }
        for loc in tasksFinished {
          loc.write(true);
        }
        if reusable {
          count.waitFor(n-1);
          count.add(1);
          for loc in tasksFinished {
            loc.clear();
          }
        }
      } else {
        tasksFinished[here.id].waitFor(true);
        if reusable {
          count.add(1);
          tasksFinished[here.id].waitFor(false);
        }
      }
    }

    inline proc notify() {
      const myc = count.fetchSub(1);
      if myc <= 1 {
        if tasksFinished[here.id].read() {
          halt("too many callers to notify()");
        }
        for loc in tasksFinished {
          loc.write(true);
        }
      }
   }

    inline proc wait() {
      tasksFinished[here.id].waitFor(true);
      if reusable {
        var sum = count.fetchAdd(1);
        if sum == n-1 then tasksFinished.clear();
        else tasksFinished[here.id].waitFor(false);
      }
    }

    inline proc try() {
      return tasksFinished[here.id].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);
          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();
    }
  }

}


minor rearrangement of and renaming in quicksort example made while cleaning it up for use in the tutorial

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

//
// An example of a parallel quick sort implementation that uses
// "cobegin" to make each recursive call in parallel and "serial" to
// limit the number of threads.
//

use Random, Time; // for random number generation and the Timer class

var timer: Timer; // to time the sort

config var n: int = 2**15;      // the size of the array to be sorted
config var thresh: int = 1;     // the recursive depth to serialize
                                //  use --thresh=-1 for unlimited threads
config var verbose: int = 0;    // print out this many elements in array
config var timing: bool = true; // set timing to false to disable timer

var A: [1..n] real; // array of real numbers

//
// initialize array with random numbers
//
fillRandom(A);

//
// print out front of array if verbose flag is set
//
if verbose > 0 then
  writeln("A[1..", verbose, "] = ", A[1..verbose]);

//
// start timer, call parallel quick sort routine, stop timer
//
if timing then timer.start();
pqsort(A, thresh);
if timing then timer.stop();

//
// report sort time
//
if timing then writeln("sorted in ", timer.elapsed(), " seconds");

//
// print out front of array if verbose flag is set
//   values should now be in sorted order
//
if verbose > 0 then
  writeln("A[1..", verbose, "] = ", A[1..verbose]);

//
// verify that array is sorted or halt
//
for i in 2..n do
  if A(i) < A(i-1) then
    halt("A(", i-1, ") == ", A(i-1), " > A(", i, ") == ", A(i));

writeln("verification success");

//
// pqsort -- parallel quick sort
//
//   arr: generic 1D array of values (real, int, ...)
//   thresh: number of recursive calls to make before serializing
//   low: lower bound of array to start sort at, defaults to whole array
//   high: upper bound of array to stop sort at, defaults to whole array
//
def pqsort(arr: [],
           thresh: int,
           low: int = arr.domain.low,
           high: int = arr.domain.high) where arr.rank == 1 {

  //
  // base case: arr[low..high] is small enough to bubble sort
  //
  if high - low < 8 {
    bubbleSort(arr, low, high);
    return;
  }

  //
  // determine pivot and partition arr[low..high]
  //
  const pivotVal = findPivot();
  const pivotLoc = partition(pivotVal);

  //
  // make recursive calls to parallel quick sort each unsorted half of
  // the array; if thresh is 0, start serializing; note: once
  // serialization is turned on, it is never turned off
  //
  serial thresh == 0 do cobegin {
    pqsort(arr, thresh-1, low, pivotLoc-1);
    pqsort(arr, thresh-1, pivotLoc+1, high);
  }

  //
  // findPivot -- helper routine to find pivot value using simple
  //              median-of-3 method, returns pivot value
  //
  def findPivot() {
    const mid = low + (high-low+1) / 2;

    if arr(mid) < arr(low) then arr(mid) <=> arr(low);
    if arr(high) < arr(low) then arr(high) <=> arr(low);
    if arr(high) < arr(mid) then arr(high) <=> arr(mid);

    const pivotVal = arr(mid);
    arr(mid) = arr(high-1);
    arr(high-1) = pivotVal;

    return pivotVal;
  }

  //
  // partition -- helper routine to partition array such that all
  //              values less than pivot are to its left and all
  //              values greater than pivot are to its right, returns
  //              pivot location
  //
  def partition(pivotVal) {
    var ilo = low, ihi = high-1;
    while (ilo < ihi) {
      do { ilo += 1; } while arr(ilo) < pivotVal;
      do { ihi -= 1; } while pivotVal < arr(ihi);
      if (ilo < ihi) {
        arr(ilo) <=> arr(ihi);
      }
    }
    arr(high-1) = arr(ilo);
    arr(ilo) = pivotVal;
    return ilo;
  }
}

//
// bubbleSort -- bubble sort for base case of quick sort
//
//   arr: generic 1D array of values (real, int, ...)
//   low: lower bound of array to start sort at
//   high: upper bound of array to stop sort at
//
def bubbleSort(arr: [], low: int, high: int) where arr.rank == 1 {
  for i in low..high do
    for j in low..high-1 do
      if arr(j) > arr(j+1) then
        arr(j) <=> arr(j+1);
}

//
// An example of a parallel quick sort implementation that uses
// "cobegin" to make each recursive call in parallel and "serial" to
// limit the number of threads.
//

use Random, Time; // for random number generation and the Timer class

var timer: Timer; // to time the sort

config var n: int = 2**15;      // the size of the array to be sorted
config var pdepth: int = 1;     // the recursive depth to serialize
                                //  use --pdepth=-1 for unlimited threads
config var verbose: int = 0;    // print out this many elements in array
config var timing: bool = true; // set timing to false to disable timer

var A: [1..n] real; // array of real numbers

//
// initialize array with random numbers
//
fillRandom(A);

//
// print out front of array if verbose flag is set
//
if verbose > 0 then
  writeln("A[1..", verbose, "] = ", A[1..verbose]);

//
// start timer, call parallel quick sort routine, stop timer
//
if timing then timer.start();
pqsort(pdepth, A);
if timing then timer.stop();

//
// report sort time
//
if timing then writeln("sorted in ", timer.elapsed(), " seconds");

//
// print out front of array if verbose flag is set
//   values should now be in sorted order
//
if verbose > 0 then
  writeln("A[1..", verbose, "] = ", A[1..verbose]);

//
// verify that array is sorted or halt
//
for i in 2..n do
  if A(i) < A(i-1) then
    halt("A(", i-1, ") == ", A(i-1), " > A(", i, ") == ", A(i));

writeln("verification success");

//
// pqsort -- parallel quick sort
//
//   pdepth: number of recursive calls to make before serializing
//   arr: generic 1D array of values (real, int, ...)
//   low: lower bound of array to start sort at, defaults to whole array
//   high: upper bound of array to stop sort at, defaults to whole array
//
def pqsort(pdepth: int,
           arr: [],
           low: int = arr.domain.low,
           high: int = arr.domain.high) where arr.rank == 1 {

  //
  // base case: arr[low..high] is small enough to bubble sort
  //
  if high - low < 8 {
    bubbleSort(arr, low, high);
    return;
  }

  //
  // determine pivot and partition arr[low..high]
  //
  const pivotVal = findPivot();
  const pivotLoc = partition(pivotVal);

  //
  // make recursive calls to parallel quick sort each unsorted half of
  // the array; if pdepth is 0, start serializing; note: once
  // serialization is turned on, it is never turned off
  //
  serial pdepth == 0 do cobegin {
    pqsort(pdepth-1, arr, low, pivotLoc-1);
    pqsort(pdepth-1, arr, pivotLoc+1, high);
  }

  //
  // findPivot -- helper routine to find pivot value using simple
  //              median-of-3 method, returns pivot value
  //
  def findPivot() {
    const mid = low + (high-low+1) / 2;

    if arr(mid) < arr(low) then arr(mid) <=> arr(low);
    if arr(high) < arr(low) then arr(high) <=> arr(low);
    if arr(high) < arr(mid) then arr(high) <=> arr(mid);

    const pivotVal = arr(mid);
    arr(mid) = arr(high-1);
    arr(high-1) = pivotVal;

    return pivotVal;
  }

  //
  // partition -- helper routine to partition array such that all
  //              values less than pivot are to its left and all
  //              values greater than pivot are to its right, returns
  //              pivot location
  //
  def partition(pivotVal) {
    var ilo = low, ihi = high-1;
    while (ilo < ihi) {
      do { ilo += 1; } while arr(ilo) < pivotVal;
      do { ihi -= 1; } while pivotVal < arr(ihi);
      if (ilo < ihi) {
        arr(ilo) <=> arr(ihi);
      }
    }
    arr(high-1) = arr(ilo);
    arr(ilo) = pivotVal;
    return ilo;
  }
}

//
// bubbleSort -- bubble sort for base case of quick sort
//
//   arr: generic 1D array of values (real, int, ...)
//   low: lower bound of array to start sort at
//   high: upper bound of array to stop sort at
//
def bubbleSort(arr: [], low: int, high: int) where arr.rank == 1 {
  for i in low..high do
    for j in low..high-1 do
      if arr(j) > arr(j+1) then
        arr(j) <=> arr(j+1);
}


Added a space for formatting.

Added a space for formatting.

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

//
// Use standard modules for Block distributions and Timing routines
//
use BlockDist, Time;

//
// Use the user modules for computing HPCC problem sizes and for
// defining RA's random stream of values
//
use HPCCProblemSize, RARandomStream;

//
// The number of tables as well as the element and index types of
// that table
//
const numTables = 1;
type elemType = randType,
     indexType = randType;

//
// Configuration constants defining log2(problem size) -- n -- and
// the number of updates -- N_U
//
config const n = computeProblemSize(numTables, elemType,
                                    returnLog2=true): indexType,
             N_U = 2**(n+2);

//
// Constants defining the problem size (m) and a bit mask for table
// indexing
//
const m = 2**n,
      indexMask = m-1;

//
// Configuration constant defining the number of errors to allow (as a
// fraction of the number of updates, N_U)
//
config const errorTolerance = 1e-2;

//
// Configuration constants to control what's printed -- benchmark
// parameters, input and output arrays, and/or statistics
//
config const printParams = true,
             printArrays = false,
             printStats = true;

//
// TableDist is a 1D block distribution for domains storing indices
// of type "indexType", and it is computed by blocking the bounding
// box 0..m-1 across the set of locales.  UpdateDist is a similar
// distribution that is computed by blocking the indices 0..N_U-1
// across the locales.
//
const TableDist = new Block1D(indexType, bbox=[0..m-1]),
      UpdateDist = new Block1D(indexType, bbox=[0..N_U-1]);

//
// TableSpace describes the index set for the table.  It is a 1D
// domain storing indices of type indexType, it is distributed
// according to TableDist, and it contains the indices 0..m-1.
// Updates is an index set describing the set of updates to be made.
// It is distributed according to UpdateDist and contains the
// indices 0..N_U-1.
//
const TableSpace: domain(1, indexType) distributed TableDist = [0..m-1],
      Updates: domain(1, indexType) distributed UpdateDist = [0..N_U-1];

//
// T is the distributed table itself, storing a variable of type
// elemType for each index in TableSpace.
//
var T: [TableSpace] elemType;

//
// The program entry point
//
def main() {
  printConfiguration();   // print the problem size, number of trials, etc.

  //
  // In parallel, initialize the table such that each position
  // contains its index.  "[i in TableSpace]" is shorthand for "forall
  // i in TableSpace"
  //
  [i in TableSpace] T(i) = i;

  const startTime = getCurrentTime();              // capture the start time

  //
  // The main computation: Iterate over the set of updates and the
  // stream of random values in a parallel, zippered manner, dropping
  // the update index on the ground ("_") and storing the random value
  // in r.  Use r both to index into the table and as the update
  // value.
  //
  forall (_, r) in (Updates, RAStream()) do
    on T.domain.dist.ind2loc(r&indexMask) do  // TODO: rewrite this
      T(r & indexMask) ^= r;

  const execTime = getCurrentTime() - startTime;   // capture the elapsed time

  const validAnswer = verifyResults(T, Updates);   // verify the updates
  printResults(validAnswer, execTime);             // print the results
}

//
// Print the problem size and number of updates
//
def printConfiguration() {
  if (printParams) {
    printProblemSize(elemType, numTables, m);
    writeln("Number of updates = ", N_U, "\n");
  }
}

//
// Verify that the computation is correct
//
def verifyResults(T: [?TDom], Updates) {
  //
  // Print the table, if requested
  //
  if (printArrays) then writeln("After updates, T is: ", T, "\n");

  //
  // Reverse the updates by recomputing them, this time using an
  // atomic statement to ensure no conflicting updates
  //
  // TODO: atomic isn't implemented
  //
  forall (_, r) in (Updates, RAStream()) do
    atomic T(r & indexMask) ^= r;

  //
  // Print the table again after the updates have been reversed
  //
  if (printArrays) then writeln("After verification, T is: ", T, "\n");

  //
  // Compute the number of table positions that weren't reverted
  // correctly.  This is an indication of the number of conflicting
  // updates.
  //
  const numErrors = + reduce [i in TDom] (T(i) != i);
  if (printStats) then writeln("Number of errors is: ", numErrors, "\n");

  //
  // Return whether or not the number of errors was within the benchmark's
  // tolerance.
  //
  return numErrors <= (errorTolerance * N_U);
}

//
// Print out success/failure, the execution time, and the GUPS value
//
def printResults(successful, execTime) {
  writeln("Validation: ", if successful then "SUCCESS" else "FAILURE");
  if (printStats) {
    writeln("Execution time = ", execTime);
    writeln("Performance (GUPS) = ", (N_U / execTime) * 1e-9);
  }
}

//
// Use standard modules for Block distributions and Timing routines
//
use BlockDist, Time;

//
// Use the user modules for computing HPCC problem sizes and for
// defining RA's random stream of values
//
use HPCCProblemSize, RARandomStream;

//
// The number of tables as well as the element and index types of
// that table
//
const numTables = 1;
type elemType = randType,
     indexType = randType;

//
// Configuration constants defining log2(problem size) -- n -- and
// the number of updates -- N_U
//
config const n = computeProblemSize(numTables, elemType,
                                    returnLog2=true): indexType,
             N_U = 2**(n+2);

//
// Constants defining the problem size (m) and a bit mask for table
// indexing
//
const m = 2**n,
      indexMask = m-1;

//
// Configuration constant defining the number of errors to allow (as a
// fraction of the number of updates, N_U)
//
config const errorTolerance = 1e-2;

//
// Configuration constants to control what's printed -- benchmark
// parameters, input and output arrays, and/or statistics
//
config const printParams = true,
             printArrays = false,
             printStats = true;

//
// TableDist is a 1D block distribution for domains storing indices
// of type "indexType", and it is computed by blocking the bounding
// box 0..m-1 across the set of locales.  UpdateDist is a similar
// distribution that is computed by blocking the indices 0..N_U-1
// across the locales.
//
const TableDist = new Block1D(indexType, bbox=[0..m-1]),
      UpdateDist = new Block1D(indexType, bbox=[0..N_U-1]);

//
// TableSpace describes the index set for the table.  It is a 1D
// domain storing indices of type indexType, it is distributed
// according to TableDist, and it contains the indices 0..m-1.
// Updates is an index set describing the set of updates to be made.
// It is distributed according to UpdateDist and contains the
// indices 0..N_U-1.
//
const TableSpace: domain(1, indexType) distributed TableDist = [0..m-1],
      Updates: domain(1, indexType) distributed UpdateDist = [0..N_U-1];

//
// T is the distributed table itself, storing a variable of type
// elemType for each index in TableSpace.
//
var T: [TableSpace] elemType;

//
// The program entry point
//
def main() {
  printConfiguration();   // print the problem size, number of trials, etc.

  //
  // In parallel, initialize the table such that each position
  // contains its index.  "[i in TableSpace]" is shorthand for "forall
  // i in TableSpace"
  //
  [i in TableSpace] T(i) = i;

  const startTime = getCurrentTime();              // capture the start time

  //
  // The main computation: Iterate over the set of updates and the
  // stream of random values in a parallel, zippered manner, dropping
  // the update index on the ground ("_") and storing the random value
  // in r.  Use r both to index into the table and as the update
  // value.
  //
  forall (_, r) in (Updates, RAStream()) do
    on T.domain.dist.ind2loc(r&indexMask) do  // TODO: rewrite this
      T(r & indexMask) ^= r;

  const execTime = getCurrentTime() - startTime;   // capture the elapsed time

  const validAnswer = verifyResults(T, Updates);   // verify the updates
  printResults(validAnswer, execTime);             // print the results
}

//
// Print the problem size and number of updates
//
def printConfiguration() {
  if (printParams) {
    printProblemSize(elemType, numTables, m);
    writeln("Number of updates = ", N_U, "\n");
  }
}

//
// Verify that the computation is correct
//
def verifyResults(T: [?TDom], Updates) {
  //
  // Print the table, if requested
  //
  if (printArrays) then writeln("After updates, T is: ", T, "\n");

  //
  // Reverse the updates by recomputing them, this time using an
  // atomic statement to ensure no conflicting updates
  //
  // TODO: atomic isn't implemented
  //
  forall (_,r) in (Updates, RAStream()) do
    atomic T(r & indexMask) ^= r;

  //
  // Print the table again after the updates have been reversed
  //
  if (printArrays) then writeln("After verification, T is: ", T, "\n");

  //
  // Compute the number of table positions that weren't reverted
  // correctly.  This is an indication of the number of conflicting
  // updates.
  //
  const numErrors = + reduce [i in TDom] (T(i) != i);
  if (printStats) then writeln("Number of errors is: ", numErrors, "\n");

  //
  // Return whether or not the number of errors was within the benchmark's
  // tolerance.
  //
  return numErrors <= (errorTolerance * N_U);
}

//
// Print out success/failure, the execution time, and the GUPS value
//
def printResults(successful, execTime) {
  writeln("Validation: ", if successful then "SUCCESS" else "FAILURE");
  if (printStats) {
    writeln("Execution time = ", execTime);
    writeln("Performance (GUPS) = ", (N_U / execTime) * 1e-9);
  }
}