shuffle data

shuffle data

use Histogram;
use Random;
use Time;

// Test flags
config const isTest=false;

// Input/Output filenames
config const fn1 = "test.dat";
config const fn2 = "test.dat";
config const pairfn = "test-DD.dat";

// Dimension constanst
param NDIM=3;
param NEXT=2; // w, r2
param NTOT=NDIM+NEXT;
const W=NDIM;
const R2=NDIM+1;
const ParticleAttrib = 0.. #NTOT;
const DimSpace = 0.. #NDIM;

// Tree parameters
config const minpart=500;

// Histogram parameters
config const smax=200.0;
config const smax2=smax**2;
config const nmubins=5;
config const nsbins=5;

// Global variables
var gtime1 : Timer;

proc main() {
  if isTest {
    testPairs();
  } else {
    doPairs();
  }
}

class Particle3D {
  var npart : int = 0;
  var Darr : domain(2);
  var Dpart : domain(1);
  var arr : [Darr] real;

  var _tmp : [Dpart] real;
  var _n1, _ndx : [Dpart] int;

  proc Particle3D(npart1 : int) {
    npart = npart1;
    Darr = {ParticleAttrib, 0.. #npart};
    Dpart = {0.. #npart};
  }

  proc this(ii : int) : NTOT*real {
    return (arr[0,ii],arr[1,ii],arr[2,ii],arr[3,ii],arr[4,ii]);
  }

  // Reorder all the arrays according to _ndx (we assume you have set this)
  proc reorder(idom : domain(1)) {

    for kk in ParticleAttrib {
      forall ii in idom {
        _tmp[_ndx[ii]] = arr[kk,ii];
      }
      forall ii in idom {
        arr[kk,ii] = _tmp[ii];
      }
    }
  }

  // Shuffles the elements of the array...
  // Note that the random number generator cannot cover the space
  // of all permutations, but that's fine for what we need.
  proc shuffle() {
    // Fill in _ndx
    forall ii in Dpart {
      _ndx[ii] = ii;
    }

    // Set the random number generator
    var rng = new RandomStream(41);
    var jj : int;
    for ii in 0..(npart-2) {
      jj = (rng.getNext()*(npart-ii)):int + ii;
      _ndx[jj] <=> _ndx[ii];
    }

    reorder(Dpart);
  }

}

proc countLines(fn : string) : int {
  var ff = open(fn, iomode.r);
  var ipart = 0;
  for iff in ff.lines() do ipart +=1;
  ff.close();
  return ipart;
}

proc readFile(fn : string) : Particle3D  {
  var npart = countLines(fn);
  var pp = new Particle3D(npart);

  var ff = openreader(fn);
  var ipart = 0;
  var x,y,z,w,r2 : real;
  while (ff.read(x,y,z,w)) {
    r2 = x**2 + y**2 + z**2;
    pp.arr[..,ipart] = [x,y,z,w,r2];
    ipart += 1;
  }

  return pp;
}

proc splitOn(pp : Particle3D, idom : domain(1), splitDim : int, xsplit : real) : int {
  // Setup for a prefix scan
  forall ii in idom {
    if (pp.arr[splitDim,ii] < xsplit) {
      pp._n1[ii] = 1;
    } else {
      pp._n1[ii] = 0;
    }
  }

  var lnpart : int = 0;
  for ii in idom do lnpart += pp._n1[ii];
  var li = idom.low;
  var ri = li+lnpart;
  for ii in idom {
    if (pp._n1[ii] == 1) {
      pp._ndx[ii] = li;
      li += 1;
    } else {
      pp._ndx[ii] = ri;
      ri += 1;
    }
  }

  pp.reorder(idom);

  return lnpart;
}

class KDNode {
  var lo, hi,npart,id : int;
  var dom : domain(1);
  var xcen : [DimSpace]real;
  var rcell : real;
  var left, right : KDNode;

  proc isLeaf() : bool {
    return (left==nil) && (right==nil);
  }

  proc ~KDNode() {
    if left then delete left;
    if right then delete right;
  }

}

proc BuildTree(pp : Particle3D, lo : int, hi : int, id : int) : KDNode  {
  var me : KDNode = new KDNode();
  me.lo = lo;
  me.hi = hi;
  me.dom = {lo..hi};
  me.id = id;
  me.npart = (me.hi-me.lo)+1;

  //  work out xcen and vantage point radius
  var pmin, pmax : [DimSpace] real;
  for idim in DimSpace {
    pmin[idim] = min reduce pp.arr[idim,lo..hi];
    pmax[idim] = max reduce pp.arr[idim,lo..hi];
  }
  me.xcen = (pmax+pmin)/2.0;
  me.rcell = 0.0;
  var r1 : real;
  for ii in lo..hi {
    r1 = 0.0;
    for idim in DimSpace {
      r1 += (pp.arr[idim,ii]-me.xcen[idim])**2;
    }
    r1 = sqrt(r1);
    if (r1 > me.rcell) then me.rcell = r1;
  }

  // Continue to split
  if (me.npart <= minpart) then return me; // Don't split further.

  // Find dimension to split on
  var dx : [DimSpace] real;
  dx = pmax - pmin;
  var splitDim = 0;
  for idim in DimSpace {
    if (dx[idim] > dx[splitDim]) then splitDim=idim;
  }

  // Split
  var lnpart = splitOn(pp,me.dom,splitDim, me.xcen[splitDim]);
  me.left  = BuildTree(pp, lo, lo+lnpart-1, 2*id+1);
  me.right = BuildTree(pp, lo+lnpart, hi,2*id+2);
  return me;
}

proc TreeAccumulate(hh : UniformBins, p1, p2 : Particle3D, node1, node2 : KDNode) {
  // Compute the distance between node1 and node2
  var rr = sqrt (+ reduce(node1.xcen - node2.xcen)**2);
  var rmin = rr - (node1.rcell+node2.rcell);

  // If distance is greater than all cases
  if (rmin > smax) then return;

  // If both nodes are leaves
  if (node1.isLeaf() & node2.isLeaf()) {
    begin smuAccumulate(hh, p1, p2, node1.dom, node2.dom,1);
    return;
  }

  // If one node is a leaf
  if (node1.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }
  if (node2.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  }

  // Split the larger case;
  if (node1.npart > node2.npart) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  } else {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }

}

// The basic pair counter
proc smuAccumulate(hh : UniformBins, p1,p2 : Particle3D, d1,d2 : domain(1), scale : real) {
  forall ii in d1 { // Loop over first set of particles

    var x1,y1,z1,w1,r2 : real;
    var sl, s2, l1, s1, l2, mu, wprod : real;
    (x1,y1,z1,w1,r2) = p1[ii];

    for jj in d2 { // Second set of particles
      mu=2*(p2.arr[0,jj]*x1 + p2.arr[1,jj]*y1 + p2.arr[2,jj]*z1);
      sl = r2 - p2.arr[R2,jj];
      l1 = r2 + p2.arr[R2,jj];
      s2 = l1 - mu;
      l2 = l1 + mu;
      if ((s2 >= smax2) || (s2 < 1.0e-20)) then continue;
      wprod = scale * w1 * p2.arr[W,jj];
      s1 = sqrt(s2);
      mu = sl/(s1*sqrt(l2));
      if (mu < 0) then mu = -mu;

      hh.add((s1,mu),wprod);
    }
  }
}

proc testPairs() {
  var pp = readFile("test.dat");
  // Put in a shuffle
  pp.shuffle();

  // Set up the histogram
  var hh = new UniformBins(2,(nsbins,nmubins), ((0.0,smax),(0.0,1.0+1.e-10)));

  // Do the paircounts with a tree
  smuAccumulate(hh,pp,pp,pp.Dpart,pp.Dpart,1.0);
  for xx in hh.bins(1) do writef("%12.4dr",xx);
  writeln();
  for xx in hh.bins(2) do writef("%12.4dr",xx);
  writeln("\n##");
  for ii in hh.Dhist.dim(1) {
    for jj in hh.Dhist.dim(2) {
      writef("%20.5er ",hh[(ii,jj)]);
    }
    writeln();
  }

  // Build the tree
  var root1 = BuildTree(pp, 0, pp.npart-1, 0);
  hh.reset();
  sync TreeAccumulate(hh,pp,pp,root1,root1);
  for xx in hh.bins(1) do writef("%12.4dr",xx);
  writeln();
  for xx in hh.bins(2) do writef("%12.4dr",xx);
  writeln("\n##");
  for ii in hh.Dhist.dim(1) {
    for jj in hh.Dhist.dim(2) {
      writef("%20.5er ",hh[(ii,jj)]);
    }
    writeln();
  }

}

proc doPairs() {
  var tt : Timer;

  // Read in the file
  tt.clear(); tt.start();
  var pp1 = readFile(fn1);
  var pp2 = readFile(fn2);
  tt.stop();
  writef("Read in %i lines from file %s \n", pp1.npart, fn1);
  writef("Read in %i lines from file %s \n", pp2.npart, fn2);
  writef("Time to read : %r \n", tt.elapsed());

  // Shuffle the particles -- this is not used here, but will be usef for the multilocale version
  tt.clear(); tt.start();
  pp1.shuffle();
  pp2.shuffle();
  tt.stop();
  writef("Time to shuffle : %r \n",tt.elapsed());

  // Build the tree
  tt.clear(); tt.start(); gtime1.clear();
  var root1 = BuildTree(pp1, 0, pp1.npart-1, 0);
  var root2 = BuildTree(pp2, 0, pp2.npart-1, 0);
  tt.stop();
  writef("Time to build trees : %r \n", tt.elapsed());
  //writef("Time in splitOn : %r \n", gtime1.elapsed());

  // Set up the histogram
  var hh = new UniformBins(2,(nsbins,nmubins), ((0.0,smax),(0.0,1.0+1.e-10)));

  // Do the paircounts with a tree
  hh.reset();
  tt.clear(); tt.start();
  sync TreeAccumulate(hh, pp1,pp2, root1, root2);
  tt.stop();
  writef("Time to tree paircount : %r \n", tt.elapsed());
  //writeHist("%s.tree".format(pairfn),hh);
}

use Histogram;
use Time;

// Test flags
config const isTest=false;

// Input/Output filenames
config const fn1 = "test.dat";
config const fn2 = "test.dat";
config const pairfn = "test-DD.dat";

// Dimension constanst
param NDIM=3;
param NEXT=2; // w, r2
param NTOT=NDIM+NEXT;
const W=NDIM;
const R2=NDIM+1;
const ParticleAttrib = 0.. #NTOT;
const DimSpace = 0.. #NDIM;

// Tree parameters
config const minpart=500;

// Histogram parameters
config const smax=200.0;
config const smax2=smax**2;
config const nmubins=5;
config const nsbins=5;

// Global variables
var gtime1 : Timer;

proc main() {
  if isTest {
    testPairs();
  } else {
    doPairs();
  }
}

class Particle3D {
  var npart : int = 0;
  var Darr : domain(2);
  var Dpart : domain(1);
  var arr : [Darr] real;

  var _tmp : [Dpart] real;
  var _n1, _ndx : [Dpart] int;

  proc Particle3D(npart1 : int) {
    npart = npart1;
    Darr = {ParticleAttrib, 0.. #npart};
    Dpart = {0.. #npart};
  }

  proc this(ii : int) : NTOT*real {
    return (arr[0,ii],arr[1,ii],arr[2,ii],arr[3,ii],arr[4,ii]);
  }

}

proc countLines(fn : string) : int {
  var ff = open(fn, iomode.r);
  var ipart = 0;
  for iff in ff.lines() do ipart +=1;
  ff.close();
  return ipart;
}

proc readFile(fn : string) : Particle3D  {
  var npart = countLines(fn);
  var pp = new Particle3D(npart);

  var ff = openreader(fn);
  var ipart = 0;
  var x,y,z,w,r2 : real;
  while (ff.read(x,y,z,w)) {
    r2 = x**2 + y**2 + z**2;
    pp.arr[..,ipart] = [x,y,z,w,r2];
    ipart += 1;
  }

  return pp;
}

proc splitOn(pp : Particle3D, idom : domain(1), splitDim : int, xsplit : real) : int {
  // Setup for a prefix scan
  forall ii in idom {
    if (pp.arr[splitDim,ii] < xsplit) {
      pp._n1[ii] = 1;
    } else {
      pp._n1[ii] = 0;
    }
  }

  var lnpart : int = 0;
  for ii in idom do lnpart += pp._n1[ii];
  var li = idom.low;
  var ri = li+lnpart;
  for ii in idom {
    if (pp._n1[ii] == 1) {
      pp._ndx[ii] = li;
      li += 1;
    } else {
      pp._ndx[ii] = ri;
      ri += 1;
    }
  }

  for kk in ParticleAttrib {
    forall ii in idom {
      pp._tmp[pp._ndx[ii]] = pp.arr[kk,ii];
    }
    forall ii in idom {
      pp.arr[kk,ii] = pp._tmp[ii];
    }
  }

  return lnpart;
}

class KDNode {
  var lo, hi,npart,id : int;
  var dom : domain(1);
  var xcen : [DimSpace]real;
  var rcell : real;
  var left, right : KDNode;

  proc isLeaf() : bool {
    return (left==nil) && (right==nil);
  }

  proc ~KDNode() {
    if left then delete left;
    if right then delete right;
  }

}

proc BuildTree(pp : Particle3D, lo : int, hi : int, id : int) : KDNode  {
  var me : KDNode = new KDNode();
  me.lo = lo;
  me.hi = hi;
  me.dom = {lo..hi};
  me.id = id;
  me.npart = (me.hi-me.lo)+1;

  //  work out xcen and vantage point radius
  var pmin, pmax : [DimSpace] real;
  for idim in DimSpace {
    pmin[idim] = min reduce pp.arr[idim,lo..hi];
    pmax[idim] = max reduce pp.arr[idim,lo..hi];
  }
  me.xcen = (pmax+pmin)/2.0;
  me.rcell = 0.0;
  var r1 : real;
  for ii in lo..hi {
    r1 = 0.0;
    for idim in DimSpace {
      r1 += (pp.arr[idim,ii]-me.xcen[idim])**2;
    }
    r1 = sqrt(r1);
    if (r1 > me.rcell) then me.rcell = r1;
  }

  // Continue to split
  if (me.npart <= minpart) then return me; // Don't split further.

  // Find dimension to split on
  var dx : [DimSpace] real;
  dx = pmax - pmin;
  var splitDim = 0;
  for idim in DimSpace {
    if (dx[idim] > dx[splitDim]) then splitDim=idim;
  }

  // Split
  var lnpart = splitOn(pp,me.dom,splitDim, me.xcen[splitDim]);
  me.left  = BuildTree(pp, lo, lo+lnpart-1, 2*id+1);
  me.right = BuildTree(pp, lo+lnpart, hi,2*id+2);
  return me;
}

proc TreeAccumulate(hh : UniformBins, p1, p2 : Particle3D, node1, node2 : KDNode) {
  // Compute the distance between node1 and node2
  var rr = sqrt (+ reduce(node1.xcen - node2.xcen)**2);
  var rmin = rr - (node1.rcell+node2.rcell);

  // If distance is greater than all cases
  if (rmin > smax) then return;

  // If both nodes are leaves
  if (node1.isLeaf() & node2.isLeaf()) {
    begin smuAccumulate(hh, p1, p2, node1.dom, node2.dom,1);
    return;
  }

  // If one node is a leaf
  if (node1.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }
  if (node2.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  }

  // Split the larger case;
  if (node1.npart > node2.npart) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  } else {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }

}

// The basic pair counter
proc smuAccumulate(hh : UniformBins, p1,p2 : Particle3D, d1,d2 : domain(1), scale : real) {
  forall ii in d1 { // Loop over first set of particles

    var x1,y1,z1,w1,r2 : real;
    var sl, s2, l1, s1, l2, mu, wprod : real;
    (x1,y1,z1,w1,r2) = p1[ii];

    for jj in d2 { // Second set of particles
      mu=2*(p2.arr[0,jj]*x1 + p2.arr[1,jj]*y1 + p2.arr[2,jj]*z1);
      sl = r2 - p2.arr[R2,jj];
      l1 = r2 + p2.arr[R2,jj];
      s2 = l1 - mu;
      l2 = l1 + mu;
      if ((s2 >= smax2) || (s2 < 1.0e-20)) then continue;
      wprod = scale * w1 * p2.arr[W,jj];
      s1 = sqrt(s2);
      mu = sl/(s1*sqrt(l2));
      if (mu < 0) then mu = -mu;

      hh.add((s1,mu),wprod);
    }
  }
}

proc testPairs() {
  var pp = readFile("test.dat");

  // Set up the histogram
  var hh = new UniformBins(2,(nsbins,nmubins), ((0.0,smax),(0.0,1.0+1.e-10)));

  // Do the paircounts with a tree
  smuAccumulate(hh,pp,pp,pp.Dpart,pp.Dpart,1.0);
  for xx in hh.bins(1) do writef("%12.4dr",xx);
  writeln();
  for xx in hh.bins(2) do writef("%12.4dr",xx);
  writeln("\n##");
  for ii in hh.Dhist.dim(1) {
    for jj in hh.Dhist.dim(2) {
      writef("%20.5er ",hh[(ii,jj)]);
    }
    writeln();
  }

  // Build the tree
  var root1 = BuildTree(pp, 0, pp.npart-1, 0);
  hh.reset();
  sync TreeAccumulate(hh,pp,pp,root1,root1);
  for xx in hh.bins(1) do writef("%12.4dr",xx);
  writeln();
  for xx in hh.bins(2) do writef("%12.4dr",xx);
  writeln("\n##");
  for ii in hh.Dhist.dim(1) {
    for jj in hh.Dhist.dim(2) {
      writef("%20.5er ",hh[(ii,jj)]);
    }
    writeln();
  }

}

proc doPairs() {
  var tt : Timer;

  // Read in the file
  tt.clear(); tt.start();
  var pp1 = readFile(fn1);
  var pp2 = readFile(fn2);
  tt.stop();
  writef("Read in %i lines from file %s \n", pp1.npart, fn1);
  writef("Read in %i lines from file %s \n", pp2.npart, fn2);
  writef("Time to read : %r \n", tt.elapsed());

  // Build the tree
  tt.clear(); tt.start(); gtime1.clear();
  var root1 = BuildTree(pp1, 0, pp1.npart-1, 0);
  var root2 = BuildTree(pp2, 0, pp2.npart-1, 0);
  tt.stop();
  writef("Time to build trees : %r \n", tt.elapsed());
  //writef("Time in splitOn : %r \n", gtime1.elapsed());

  // Set up the histogram
  var hh = new UniformBins(2,(nsbins,nmubins), ((0.0,smax),(0.0,1.0+1.e-10)));

  // Do the paircounts with a tree
  hh.reset();
  tt.clear(); tt.start();
  sync TreeAccumulate(hh, pp1,pp2, root1, root2);
  tt.stop();
  writef("Time to tree paircount : %r \n", tt.elapsed());
  //writeHist("%s.tree".format(pairfn),hh);
}


Fix prgenv-cray portability issue for glob() call

The glob() call takes an optional function pointer as an argument, and
I had just been passing c_nil into it.  However, the Cray compiler
doesn't like this because of the fact that it isn't a literal "NULL"
being passed in, but a Chapel variable of type void* which isn't
of pointer-to-function type.

As an easy workaround for this, I invented an external type to
represent the function pointer type and declared a (local to the
scope in question) extern var named NULL of that type.  This has
the effect of passing the NULL straight through to glob() which
makes the complaint go away.

If this didn't work on some other platform (though I believe it
will), we could always push the glob() into the runtime, wrapping
it as chpl_glob() and have it supply the NULL argument for the
function pointer.  But the current approach feels more lightweight
without seeming crufty to me.

/*
 * Copyright 2004-2014 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.
 */

use Sort;

//
// This module defines several iterators that are designed to help
// support reasoning about directory and file contents.  At present,
// all are serial and single-locale, though the ultimate intention
// is to also support parallel and multi-locale options.
//
// These interfaces should be considered experimental and subject to
// change for the 1.10 release.  For that reason, send in feedback if
// you would like to see changes or additional arguments/features.
// And, as always, send in bug reports if you think we got something
// wrong.
//

/* iter listdir(path: string, dotfiles=false, dirs=true, files=true,
                listlinks=true): string

    listdir() lists the contents of a directory, similar to 'ls'
      * path: the directory whose contents should be listed
      * dotfiles: should files/directories that start with '.' be listed?
      * dirs: should dirs be listed?
      * files: should files be listed?
      * listlinks: should symbolic links be listed?

   By default this routine lists all files and directories in the
   current directory, including symbolic links, as long as they don't
   start with '.'
*/

iter listdir(path: string, dotfiles=false, dirs=true, files=true,
             listlinks=true): string {
  extern type DIRptr;
  extern type direntptr;
  extern proc opendir(name: c_string): DIRptr;
  extern proc readdir(dirp: DIRptr): direntptr;
  extern proc closedir(dirp: DIRptr): c_int;
  extern proc chpl_rt_isDir(pathname: c_string, followLinks: bool): c_int;

  proc direntptr.d_name(): c_string {
    extern proc chpl_rt_direntptr_getname(d: direntptr): c_string;

    return chpl_rt_direntptr_getname(this);
  }

  var dir: DIRptr;
  var ent: direntptr;
  dir = opendir(path:c_string);
  if (!is_c_nil(dir)) {
    ent = readdir(dir);
    while (!is_c_nil(ent)) {
      const filename = ent.d_name();
      if (dotfiles || filename.substring(1) != '.') {
        if (filename != "." && filename != "..") {
          const fullpath = path + "/" + filename;
          //
          // chpl_rt_isDir() returns 'true' if 'fullpath' is a
          // directory.  If we are listing symbolic links
          // (listlinks==true), it will also return symbolic links to
          // directories.
          //
          if (chpl_rt_isDir(fullpath:c_string, listlinks)) {
            if (dirs) then
              yield filename;
          } else {
            if (files) then
              yield filename;
          }
        }
      }
      ent = readdir(dir);
    }
    closedir(dir);
  } else {
    extern proc perror(s: c_string);
    perror("error in listdir(): ");
  }
}

/* iter walkdirs(path: string=".", topdown=true, depth=max(int),
                 dotfiles=false, followlinks=false, sort=false): string

   walkdirs() recursively walks a directory structure, yielding
   directory names.  The strings that are generated will be rooted
   from 'path'.
     * path: the directory to start from
     * topdown: indicates whether to yield the directories using a
       preorder (vs. postorder) traversal
     * depth: indicates the maximal depth of recursion to use
     * dotfiles: indicates whether to enter directories with dotfile names
     * followlinks: indicates whether to follow symbolic links or not
     * sort: indicates whether to consider subdirectories in sorted
       order or not

   by default, walkdirs() will start in the current directory, process
   directories in preorder; recursively traverse subdirectories; and
   neither follow dotfile directories nor symbolic links.  It will not
   sort the directories by default.
*/

iter walkdirs(path: string=".", topdown=true, depth=max(int), dotfiles=false,
              followlinks=false, sort=false): string {

  if (topdown) then
    yield path;

  if (depth) {
    var subdirs = listdir(path, dotfiles=dotfiles, files=false, listlinks=followlinks);
    if (sort) then
      QuickSort(subdirs);
    for subdir in subdirs {
      const fullpath = path + "/" + subdir;
      for subdir in walkdirs(fullpath, topdown, depth-1, dotfiles,
                             followlinks, sort) do
        yield subdir;
    }
  }

  if (!topdown) then
    yield path;
}

/* iter wordexp(pattern="*")

   wordexp() gives a glob-like capability, implemented with C's wordexp()
   (which is, itself a routine that provides a glob-like capability :)
     * pattern: the glob pattern to match against

   By default, it will list all files/directories in the current directory
*/

iter wordexp(pattern="*") {
  extern type wordexp_t;
  extern proc wordexp(pattern:c_string, ref ret_glob: wordexp_t,
                      flags_c_int): c_int;
  extern proc chpl_wordexp_num(x:wordexp_t): size_t;
  extern proc chpl_wordexp_index(x:wordexp_t, idx:size_t): c_string;
  extern proc wordfree(ref glb:wordexp_t);

  var glb : wordexp_t;

  const err = wordexp(pattern:c_string, glb, 0);

  for i in 0..chpl_wordexp_num(glb)-1 {
    yield chpl_wordexp_index(glb, i): string;
  }

  wordfree(glb);
}

/* iter glob(pattern="*")

   glob() gives glob() capabilities and is implemented using C's glob()
     * pattern: the glob pattern to match against

   By default, it will list all files/directories in the current directory
*/

iter glob(pattern="*") {
  extern type glob_t;
  extern type glob_err_fn_t;
  extern const NULL: glob_err_fn_t;
  extern proc glob(pattern:c_string, flags: c_int, errfunc:glob_err_fn_t,
                   ref ret_glob:glob_t):c_int;
  extern proc chpl_glob_num(x:glob_t): size_t;
  extern proc chpl_glob_index(x:glob_t, idx:size_t): c_string;
  extern proc globfree(ref glb:glob_t);

  var glb : glob_t;

  const err = glob(pattern:c_string, 0, NULL, glb);
  const num = chpl_glob_num(glb);
  if (num) then
    for i in 0..num-1 do
      yield chpl_glob_index(glb, i): string;

  globfree(glb);
}

/* iter findfiles(startdir = ".", recursive=false, dotfiles=false)

   findfiles() is a simple find-like utility implemented using the
   above routines
     * startdir: where to start when looking for files
     * recursive: tells whether or not to descend recurisvely
     * dotfiles: tells whether or not to yield dotfiles
*/

iter findfiles(startdir = ".", recursive=false, dotfiles=false) {
  if (recursive) then
    for subdir in walkdirs(startdir, dotfiles=dotfiles) do
      for file in listdir(subdir, dotfiles=dotfiles, dirs=false, files=true, listlinks=true) do
        yield subdir+"/"+file;
  else
    for file in listdir(startdir, dotfiles=dotfiles, dirs=false, files=true, listlinks=false) do
      yield startdir+"/"+file;
}

/*
 * Copyright 2004-2014 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.
 */

use Sort;

//
// This module defines several iterators that are designed to help
// support reasoning about directory and file contents.  At present,
// all are serial and single-locale, though the ultimate intention
// is to also support parallel and multi-locale options.
//
// These interfaces should be considered experimental and subject to
// change for the 1.10 release.  For that reason, send in feedback if
// you would like to see changes or additional arguments/features.
// And, as always, send in bug reports if you think we got something
// wrong.
//

/* iter listdir(path: string, dotfiles=false, dirs=true, files=true,
                listlinks=true): string

    listdir() lists the contents of a directory, similar to 'ls'
      * path: the directory whose contents should be listed
      * dotfiles: should files/directories that start with '.' be listed?
      * dirs: should dirs be listed?
      * files: should files be listed?
      * listlinks: should symbolic links be listed?

   By default this routine lists all files and directories in the
   current directory, including symbolic links, as long as they don't
   start with '.'
*/

iter listdir(path: string, dotfiles=false, dirs=true, files=true,
             listlinks=true): string {
  extern type DIRptr;
  extern type direntptr;
  extern proc opendir(name: c_string): DIRptr;
  extern proc readdir(dirp: DIRptr): direntptr;
  extern proc closedir(dirp: DIRptr): c_int;
  extern proc chpl_rt_isDir(pathname: c_string, followLinks: bool): c_int;

  proc direntptr.d_name(): c_string {
    extern proc chpl_rt_direntptr_getname(d: direntptr): c_string;

    return chpl_rt_direntptr_getname(this);
  }

  var dir: DIRptr;
  var ent: direntptr;
  dir = opendir(path:c_string);
  if (!is_c_nil(dir)) {
    ent = readdir(dir);
    while (!is_c_nil(ent)) {
      const filename = ent.d_name();
      if (dotfiles || filename.substring(1) != '.') {
        if (filename != "." && filename != "..") {
          const fullpath = path + "/" + filename;
          //
          // chpl_rt_isDir() returns 'true' if 'fullpath' is a
          // directory.  If we are listing symbolic links
          // (listlinks==true), it will also return symbolic links to
          // directories.
          //
          if (chpl_rt_isDir(fullpath:c_string, listlinks)) {
            if (dirs) then
              yield filename;
          } else {
            if (files) then
              yield filename;
          }
        }
      }
      ent = readdir(dir);
    }
    closedir(dir);
  } else {
    extern proc perror(s: c_string);
    perror("error in listdir(): ");
  }
}

/* iter walkdirs(path: string=".", topdown=true, depth=max(int),
                 dotfiles=false, followlinks=false, sort=false): string

   walkdirs() recursively walks a directory structure, yielding
   directory names.  The strings that are generated will be rooted
   from 'path'.
     * path: the directory to start from
     * topdown: indicates whether to yield the directories using a
       preorder (vs. postorder) traversal
     * depth: indicates the maximal depth of recursion to use
     * dotfiles: indicates whether to enter directories with dotfile names
     * followlinks: indicates whether to follow symbolic links or not
     * sort: indicates whether to consider subdirectories in sorted
       order or not

   by default, walkdirs() will start in the current directory, process
   directories in preorder; recursively traverse subdirectories; and
   neither follow dotfile directories nor symbolic links.  It will not
   sort the directories by default.
*/

iter walkdirs(path: string=".", topdown=true, depth=max(int), dotfiles=false,
              followlinks=false, sort=false): string {

  if (topdown) then
    yield path;

  if (depth) {
    var subdirs = listdir(path, dotfiles=dotfiles, files=false, listlinks=followlinks);
    if (sort) then
      QuickSort(subdirs);
    for subdir in subdirs {
      const fullpath = path + "/" + subdir;
      for subdir in walkdirs(fullpath, topdown, depth-1, dotfiles,
                             followlinks, sort) do
        yield subdir;
    }
  }

  if (!topdown) then
    yield path;
}

/* iter wordexp(pattern="*")

   wordexp() gives a glob-like capability, implemented with C's wordexp()
   (which is, itself a routine that provides a glob-like capability :)
     * pattern: the glob pattern to match against

   By default, it will list all files/directories in the current directory
*/

iter wordexp(pattern="*") {
  extern type wordexp_t;
  extern proc wordexp(pattern:c_string, ref ret_glob: wordexp_t,
                      flags_c_int): c_int;
  extern proc chpl_wordexp_num(x:wordexp_t): size_t;
  extern proc chpl_wordexp_index(x:wordexp_t, idx:size_t): c_string;
  extern proc wordfree(ref glb:wordexp_t);

  var glb : wordexp_t;

  const err = wordexp(pattern:c_string, glb, 0);

  for i in 0..chpl_wordexp_num(glb)-1 {
    yield chpl_wordexp_index(glb, i): string;
  }

  wordfree(glb);
}

/* iter glob(pattern="*")

   glob() gives glob() capabilities and is implemented using C's glob()
     * pattern: the glob pattern to match against

   By default, it will list all files/directories in the current directory
*/

iter glob(pattern="*") {
  extern type glob_t;
  extern proc glob(pattern:c_string, flags: c_int, errfunc:c_void_ptr,
                   ref ret_glob:glob_t):c_int;
  extern proc chpl_glob_num(x:glob_t): size_t;
  extern proc chpl_glob_index(x:glob_t, idx:size_t): c_string;
  extern proc globfree(ref glb:glob_t);

  var glb : glob_t;

  const err = glob(pattern:c_string, 0, c_nil, glb);
  const num = chpl_glob_num(glb);
  if (num) then
    for i in 0..num-1 do
      yield chpl_glob_index(glb, i): string;

  globfree(glb);
}

/* iter findfiles(startdir = ".", recursive=false, dotfiles=false)

   findfiles() is a simple find-like utility implemented using the
   above routines
     * startdir: where to start when looking for files
     * recursive: tells whether or not to descend recurisvely
     * dotfiles: tells whether or not to yield dotfiles
*/

iter findfiles(startdir = ".", recursive=false, dotfiles=false) {
  if (recursive) then
    for subdir in walkdirs(startdir, dotfiles=dotfiles) do
      for file in listdir(subdir, dotfiles=dotfiles, dirs=false, files=true, listlinks=true) do
        yield subdir+"/"+file;
  else
    for file in listdir(startdir, dotfiles=dotfiles, dirs=false, files=true, listlinks=false) do
      yield startdir+"/"+file;
}


Added reverse function to sequences.

Added reverse function to sequences.

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

function #(s1 : seq2, s2 : seq2) {
  return s1._concat(s2);
}

function write(s : seq2) {
  write("(/");
  var tmp = s._first;
  while tmp != nil {
    write(tmp._element);
    tmp = tmp._next;
    if (tmp != nil) {
      write(", ");
    }
  }
  write("/)");
}

class _seqNode {
  type _elementType;

  var _element : _elementType;
  var _next : _seqNode;
}

class seq2 {
  type _elementType;

  var _length : integer;
  var _first : _seqNode;
  var _last : _seqNode;

  function length : integer
    return _length;

  function reverse : seq2 {
    var new_seq : seq2 = seq2(_elementType);
    var tmp = _first;
    while (tmp != nil) {
      new_seq._prepend(tmp._element);
      tmp  = tmp._next;
    }
    return new_seq;
  }

  function _append(e : _elementType) : seq2 {
    var new : _seqNode = _seqNode(_elementType);
    new._element = e;
    if _length > 0 {
      _last._next = new;
      _last = new;
    } else {
      _first = new;
      _last = new;
    }
    _length += 1;
    return this;
  }

  function _prepend(e : _elementType) : seq2 {
    var new : _seqNode = _seqNode(_elementType);
    new._element = e;
    if _length > 0 {
      new._next = _first;
      _first = new;
    } else {
      _first = new;
      _last = new;
    }
    _length += 1;
    return this;
  }

  function _concat(s : seq2) : seq2 {
    _last._next = s._first;
    _last = s._last;
    _length += s._length;
    return this;
  }

  function _copy() : seq2 {
    var new : seq2 = seq2(_elementType);
    var tmp : _seqNode = _first;
    while tmp != nil {
      new = new._append(tmp._element);
      tmp = tmp._next;
    }
    return new;
  }
}

/*** Need where clauses to get all these working
function #(s : seq2, e : seq2._elementType) {
  return s._append(e);
}

function #(e : seq2._elementType, s : seq2) {
  return s._prepend(e);
}
***/

function #(s1 : seq2, s2 : seq2) {
  return s1._concat(s2);
}

function write(s : seq2) {
  write("(/");
  var tmp = s._first;
  while tmp != nil {
    write(tmp._element);
    tmp = tmp._next;
    if (tmp != nil) {
      write(", ");
    }
  }
  write("/)");
}

class _seqNode {
  type _elementType;

  var _element : _elementType;
  var _next : _seqNode;
}

class seq2 {
  type _elementType;

  var _length : integer;
  var _first : _seqNode;
  var _last : _seqNode;

  function length : integer
    return _length;

  function _append(e : _elementType) : seq2 {
    var new : _seqNode = _seqNode(_elementType);
    new._element = e;
    if _length > 0 {
      _last._next = new;
      _last = new;
    } else {
      _first = new;
      _last = new;
    }
    _length += 1;
    return this;
  }

  function _prepend(e : _elementType) : seq2 {
    var new : _seqNode = _seqNode(_elementType);
    new._element = e;
    if _length > 0 {
      new._next = _first;
      _first = new;
    } else {
      _first = new;
      _last = new;
    }
    _length += 1;
    return this;
  }

  function _concat(s : seq2) : seq2 {
    _last._next = s._first;
    _last = s._last;
    _length += s._length;
    return this;
  }

  function _copy() : seq2 {
    var new : seq2 = seq2(_elementType);
    var tmp : _seqNode = _first;
    while tmp != nil {
      new = new._append(tmp._element);
      tmp = tmp._next;
    }
    return new;
  }
}

/*** Need where clauses to get all these working
function #(s : seq2, e : seq2._elementType) {
  return s._append(e);
}

function #(e : seq2._elementType, s : seq2) {
  return s._prepend(e);
}
***/


Bug fix to binary trees variant

Bug fix to binary trees variant

David pointed out an obvious error in this variant that I just
committed: I tried to free the tree node after returning...
Whoops!  On the plus side, it would've been super fast probably!

This commit fixes that error (with any luck).

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

/* The Computer Language Benchmarks Game
   http://benchmarksgame.alioth.debian.org/

   contributed by Casey Battaglino
   modified by Ben Harshbarger
   modified by Brad Chamberlain
*/

//
// Use this helper module to get the dynamic iterator
//
use AdvancedIters;

//
// The problem size determines the maximum depth of the trees created
//
config const n = 10;

//
// A simple tree class
//
class Tree {
  const item: int;
  const left, right: Tree;
}

proc main() {
  const minDepth = 4,                      // the shallowest tree
        maxDepth = max(minDepth + 2, n),   // the deepest tree
        depths = minDepth..maxDepth by 2;  // the range of depths to create

  //
  // Create the "stretch" tree, checksum it, print its stats, and free it
  //
  const stretchDepth = maxDepth + 1;
  const stretchTree = buildTree(0, stretchDepth);
  writeln("stretch tree of depth ", stretchDepth, "\t check: ",
          checksumAndFree(stretchTree));

  //
  // Build our long-lived tree
  //
  const longLivedTree = buildTree(0, maxDepth);

  //
  // Declare an array for storing stats for the trees
  //
  var results: [depths] 2*int;

  //
  // Iterate over the depths we're exploring, dynamically mapping out a
  // single iteration per task at a time
  //
  forall depth in dynamic(depths, chunkSize=1) {
    const iterations = 1 << (maxDepth - depth + minDepth);
    var check = 0;

    for i in 1..iterations {
      const posT = buildTree( i, depth),
            negT = buildTree(-i, depth);
      check += checksumAndFree(posT) + checksumAndFree(negT);
    }
    results[depth] = (2*iterations, check);
  }

  //
  // Print out the results for the trees of varying depths
  //
  for depth in depths do
    writeln(results[depth](1), "\t trees of depth ", depth, "\t check: ",
            results[depth](2));

  //
  // Checksum the long-lived tree, print its results, and free it
  //
  writeln("long lived tree of depth ", maxDepth, "\t check: ",
          checksumAndFree(longLivedTree));
}

//
// Build a tree
//
proc buildTree(item, depth): Tree {
  if depth <= 0 then
    return new Tree(item);
  else
    return new Tree(item, buildTree(2*item-1, depth-1),
                          buildTree(2*item  , depth-1));
}

//
// Compute a simple checksum on a tree
//
proc checksumAndFree(T): int {
  const sum = if (T.left == nil) then
                T.item
              else
                (T.item + checksumAndFree(T.left) - checksumAndFree(T.right));
  delete T;
  return sum;
}

/* The Computer Language Benchmarks Game
   http://benchmarksgame.alioth.debian.org/

   contributed by Casey Battaglino
   modified by Ben Harshbarger
   modified by Brad Chamberlain
*/

//
// Use this helper module to get the dynamic iterator
//
use AdvancedIters;

//
// The problem size determines the maximum depth of the trees created
//
config const n = 10;

//
// A simple tree class
//
class Tree {
  const item: int;
  const left, right: Tree;
}

proc main() {
  const minDepth = 4,                      // the shallowest tree
        maxDepth = max(minDepth + 2, n),   // the deepest tree
        depths = minDepth..maxDepth by 2;  // the range of depths to create

  //
  // Create the "stretch" tree, checksum it, print its stats, and free it
  //
  const stretchDepth = maxDepth + 1;
  const stretchTree = buildTree(0, stretchDepth);
  writeln("stretch tree of depth ", stretchDepth, "\t check: ",
          checksumAndFree(stretchTree));

  //
  // Build our long-lived tree
  //
  const longLivedTree = buildTree(0, maxDepth);

  //
  // Declare an array for storing stats for the trees
  //
  var results: [depths] 2*int;

  //
  // Iterate over the depths we're exploring, dynamically mapping out a
  // single iteration per task at a time
  //
  forall depth in dynamic(depths, chunkSize=1) {
    const iterations = 1 << (maxDepth - depth + minDepth);
    var check = 0;

    for i in 1..iterations {
      const posT = buildTree( i, depth),
            negT = buildTree(-i, depth);
      check += checksumAndFree(posT) + checksumAndFree(negT);
    }
    results[depth] = (2*iterations, check);
  }

  //
  // Print out the results for the trees of varying depths
  //
  for depth in depths do
    writeln(results[depth](1), "\t trees of depth ", depth, "\t check: ",
            results[depth](2));

  //
  // Checksum the long-lived tree, print its results, and free it
  //
  writeln("long lived tree of depth ", maxDepth, "\t check: ",
          checksumAndFree(longLivedTree));
}

//
// Build a tree
//
proc buildTree(item, depth): Tree {
  if depth <= 0 then
    return new Tree(item);
  else
    return new Tree(item, buildTree(2*item-1, depth-1),
                          buildTree(2*item  , depth-1));
}

//
// Compute a simple checksum on a tree
//
proc checksumAndFree(T): int {
  if (T.left == nil) then
    return T.item;
  else
    return (T.item + checksumAndFree(T.left) - checksumAndFree(T.right));
  delete T;
}