Apply private to some symbols in the Math standard module

When chpldoc recognizes private, these symbols will no longer need pragma "no
doc" before them.

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

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

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

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

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

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

*/
module Math {

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

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

  pragma "no doc"
  private extern proc fabs(x: real(64)): real(64);

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

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

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

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

  /* Returns the absolute value of the integer argument.

     :rtype: The type of `i`.
  */
  inline proc abs(i : int(?w)) return if i < 0 then -i else i;

  /* Returns the absolute value of the unsigned integer argument.

     :rtype: The type of `i`.
  */
  inline proc abs(i : uint(?w)) return i;

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

  /* Returns the magnitude of the real argument `r`. */
  inline proc abs(r : real(64)):real(64) return fabs(r);

  /* Returns the magnitude of the real argument `x`. */
  inline proc abs(x : real(32)): real(32) {
    extern proc fabsf(x: real(32)): real(32);
    return fabsf(x);
  }

  /* Returns the real magnitude of the imaginary argument `im`. */
  inline proc abs(im : imag(64)): real(64) return fabs(_i2r(im));

  /* Returns the real magnitude of the imaginary argument `im`. */
  inline proc abs(im: imag(32)): real(32) {
    extern proc fabsf(x: real(32)): real(32);
    return fabsf(_i2r(im));
  }

  /* Returns the real magnitude of the complex argument `x`.

     :rtype: The type of the real component of the argument (== `w`/2).
  */
  inline proc abs(x : complex(?w)) return sqrt(x.re*x.re + x.im*x.im);

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

     It is an error if `x` is less than -1 or greater than 1.
  */
  extern proc acos(x: real(64)): real(64);

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

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc acos(x : real(32)): real(32) {
    extern proc acosf(x: real(32)): real(32);
    return acosf(x);
  }

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

     It is an error if `x` is less than 1.
  */
  extern proc acosh(x: real(64)): real(64);

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

     It is an error if `x` is less than 1.
  */
  inline proc acosh(x : real(32)): real(32) {
    extern proc acoshf(x: real(32)): real(32);
    return acoshf(x);
  }

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

     It is an error if `x` is less than -1 or greater than 1.
  */
  extern proc asin(x: real(64)): real(64);

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

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc asin(x : real(32)): real(32) {
    extern proc asinf(x: real(32)): real(32);
    return asinf(x);
  }

  /* Returns the inverse hyperbolic sine of the argument `x`. */
  extern proc asinh(x: real(64)): real(64);

  /* Returns the inverse hyperbolic sine of the argument `x`. */
  inline proc asinh(x : real(32)): real(32) {
    extern proc asinhf(x: real(32)): real(32);
    return asinhf(x);
  }

  /* Returns the arc tangent of the argument `x`. */
  extern proc atan(x: real(64)): real(64);

  /* Returns the arc tangent of the argument `x`. */
  inline proc atan(x : real(32)): real(32) {
    extern proc atanf(x: real(32)): real(32);
    return atanf(x);
  }

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

     This is equivalent to
     the arc tangent of `y` / `x` except that the signs of `y`
     and `x` are used to determine the quadrant of the result. */
  extern proc atan2(y: real(64), x: real(64)): real(64);

  /* Returns the arc tangent of the two arguments.

     This is equivalent to
     the arc tangent of `y` / `x` except that the signs of `y`
     and `x` are used to determine the quadrant of the result. */
  inline proc atan2(y : real(32), x: real(32)): real(32) {
    extern proc atan2f(y: real(32), x: real(32)): real(32);
    return atan2f(y, x);
  }

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

     It is an error if `x` is less than -1 or greater than 1. */
  extern proc atanh(x: real(64)): real(64);

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

     It is an error if `x` is less than -1 or greater than 1. */
  inline proc atanh(x : real(32)): real(32) {
    extern proc atanhf(x: real(32)): real(32);
    return atanhf(x);
  }

  /* Returns the cube root of the argument `x`. */
  extern proc cbrt(x: real(64)): real(64);

  /* Returns the cube root of the argument `x`. */
  inline proc cbrt(x : real(32)): real(32) {
    extern proc cbrtf(x: real(32)): real(32);
    return cbrtf(x);
  }

  /* Returns the value of the argument `x` rounded up to the nearest integer. */
  extern proc ceil(x: real(64)): real(64);

  /* Returns the value of the argument `x` rounded up to the nearest integer. */
  inline proc ceil(x : real(32)): real(32) {
    extern proc ceilf(x: real(32)): real(32);
    return ceilf(x);
  }

  /* Returns the complex conjugate of the argument `a`.

     :rtype: The type of `a`.
  */
  inline proc conjg(a: complex(?w)) : complex(w) return (a.re, -a.im):complex(w);

  /* Returns the cosine of the argument `x`. */
  extern proc cos(x: real(64)): real(64);

  /* Returns the cosine of the argument `x`. */
  inline proc cos(x : real(32)): real(32) {
    extern proc cosf(x: real(32)): real(32);
    return cosf(x);
  }

  /* Returns the hyperbolic cosine of the argument `x`. */
  extern proc cosh(x: real(64)): real(64);

  /* Returns the hyperbolic cosine of the argument `x`. */
  inline proc cosh(x : real(32)): real(32) {
    extern proc coshf(x: real(32)): real(32);
    return coshf(x);
  }

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

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

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

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

  /*
    A variant of :proc:`divceil` that performs no runtime checks.
    The user must ensure that both arguments are strictly positive
    (not 0) and are of a signed integer type (not `uint`).
  */
  proc divceilpos(m: integral, n: integral) {
    if !isIntType(m.type) || !isIntType(n.type) then
      compilerError("divceilpos() accepts only arguments of signed integer types");
    return (m - 1) / n + 1;
  }

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

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

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

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

  /*
    A variant of :proc:`divfloor` that performs no runtime checks.
    The user must ensure that both arguments are strictly positive
    (not 0) and are of a signed integer type (not `uint`).
  */
  proc divfloorpos(m: integral, n: integral) {
    if !isIntType(m.type) || !isIntType(n.type) then
      compilerError("divfloorpos() accepts only arguments of signed integer types");
    return m / n;
  }

  /* Returns the error function of the argument `x`. */
  extern proc erf(x: real(64)): real(64);

  /* Returns the error function of the argument `x`. */
  inline proc erf(x : real(32)): real(32) {
    extern proc erff(x: real(32)): real(32);
    return erff(x);
  }

  /* Returns the complementary error function of the argument.
     This is equivalent to 1.0 - :proc:`erf`\(`x`).
  */
  extern proc erfc(x: real(64)): real(64);

  /* Returns the complementary error function of the argument.
     This is equivalent to 1.0 - :proc:`erf`\(`x`).
  */
  inline proc erfc(x : real(32)): real(32) {
    extern proc erfcf(x: real(32)): real(32);
    return erfcf(x);
  }

  /* Returns the value of the Napierien `e` raised to the power of the argument `x`. */
  extern proc exp(x: real(64)): real(64);

  /* Returns the value of the Napierien `e` raised to the power of the argument. */
  inline proc exp(x : real(32)): real(32) {
    extern proc expf(x: real(32)): real(32);
    return expf(x);
  }

  /* Returns the value of `2` raised to the power of the argument `x`. */
  extern proc exp2(x: real(64)): real(64);

  /* Returns the value of `2` raised to the power of the argument `x`. */
  inline proc exp2(x : real(32)): real(32) {
    extern proc exp2f(x: real(32)): real(32);
    return exp2f(x);
  }

  /* Returns one less than the value of the Napierien `e` raised to the power
     of the argument `x`. */
  extern proc expm1(x: real(64)): real(64);

  /* Returns one less than the value of the Napierien `e` raised to the power
     of the argument `x`. */
  inline proc expm1(x : real(32)): real(32) {
    extern proc expm1f(x: real(32)): real(32);
    return expm1f(x);
  }

  /* Returns the value of the argument `x` rounded down to the nearest integer. */
  extern proc floor(x: real(64)): real(64);

  /* Returns the value of the argument `x` rounded down to the nearest integer. */
  inline proc floor(x : real(32)): real(32) {
    extern proc floorf(x: real(32)): real(32);
    return floorf(x);
  }

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

  /* Returns `true` if the argument `x` is a representation of a finite value;
     `false` otherwise. */
  inline proc isfinite(x: real(64)): bool return chpl_macro_double_isfinite(x):bool;

  /* Returns `true` if the argument `x` is a representation of a finite value;
     `false` otherwise. */
  inline proc isfinite(x: real(32)): bool return chpl_macro_float_isfinite(x):bool;

  /* Returns `true` if the argument `x` is a representation of *infinity*;
     `false` otherwise. */
  inline proc isinf(x: real(64)): bool return chpl_macro_double_isinf(x):bool;

  /* Returns `true` if the argument `x` is a representation of *infinity*;
     `false` otherwise. */
  inline proc isinf(x: real(32)): bool return chpl_macro_float_isinf(x):bool;

  /* Returns `true` if the argument `x` does not represent a valid number;
     `false` otherwise. */
  inline proc isnan(x: real(64)): bool return chpl_macro_double_isnan(x):bool;

  /* Returns `true` if the argument `x` does not represent a valid number;
     `false` otherwise. */
  inline proc isnan(x: real(32)): bool return chpl_macro_float_isnan(x):bool;

  /* Returns the natural logarithm of the absolute value
     of the gamma function of the argument `x`.
  */
  extern proc lgamma(x: real(64)): real(64);

  /* Returns the natural logarithm of the absolute value
     of the gamma function of the argument `x`.
  */
  inline proc lgamma(x : real(32)): real(32) {
    extern proc lgammaf(x: real(32)): real(32);
    return lgammaf(x);
  }

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

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log(x: real(64)): real(64);

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

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log(x : real(32)): real(32) {
    extern proc logf(x: real(32)): real(32);
    return logf(x);
  }

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

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log10(x: real(64)): real(64);

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

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log10(x : real(32)): real(32) {
    extern proc log10f(x: real(32)): real(32);
    return log10f(x);
  }

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

     It is an error if `x` is less than or equal to -1.
  */
  extern proc log1p(x: real(64)): real(64);

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

     It is an error if `x` is less than or equal to -1.
  */
  inline proc log1p(x : real(32)): real(32) {
    extern proc log1pf(x: real(32)): real(32);
    return log1pf(x);
  }

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

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log2(x: real(64)): real(64);

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

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log2(x : real(32)): real(32) {
    extern proc log2f(x: real(32)): real(32);
    return log2f(x);
  }

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

     :rtype: `int(64)`

     It is an error if `x` is less than or equal to zero.
  */
  proc log2(in val: int(?w)) {
    return logBasePow2(val, 1);
  }

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

     :rtype: `int(64)`

     It is an error if `x` is less than or equal to zero.
  */
  proc log2(in val: uint(?w)) {
    return logBasePow2(val, 1);
  }

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

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

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

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc mod(m: integral, n: integral) {
    const temp = m % n;

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

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

     The return value has the same type as `x`.
  */
  proc mod(x: real(?w), y: real(w)): real(w) {
    // This codes up the standard definition, according to Wikipedia.
    // Is there a more efficient implementation for reals?
    return x - y*floor(x/y);
  }

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

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`nearbyint` will not raise the "inexact"
     floating-point exception.
  */
  extern proc nearbyint(x: real(64)): real(64);

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

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`rint` may raise the "inexact" floating-point
     exception.
  */
  extern proc rint(x: real(64)): real(64);

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`rint` may raise the "inexact" floating-point
     exception.
  */
  inline proc rint(x : real(32)): real(32) {
    extern proc rintf(x: real(32)): real(32);
    return rintf(x);
  }

  /* Returns the rounded integral value of the argument `x`. */
  extern proc round(x: real(64)): real(64);

  /* Returns the rounded integral value of the argument `x`. */
  inline proc round(x : real(32)): real(32) {
    extern proc roundf(x: real(32)): real(32);
    return roundf(x);
  }

  /* Returns the signum function of the integer argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(i : int(?w)): int(8)
    return ((i > 0) : int(8) - (i < 0) : int(8)) : int(8);

  /* Returns the signum function of the unsigned integer argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(i : uint(?w)): uint(8)
    return (i > 0) : uint(8);

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

  /* Returns the signum function of the real argument `x`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(x : real(?w)): int(8)
    return ((x > 0.0) : int(8) - (x < 0.0) : int(8)) : int(8);

  /* Returns the sine of the argument `x`. */
  extern proc sin(x: real(64)): real(64);

  /* Returns the sine of the argument `x`. */
  inline proc sin(x: real(32)): real(32) {
    extern proc sinf(x: real(32)): real(32);
    return sinf(x);
  }

  /* Returns the hyperbolic sine of the argument `x`. */
  extern proc sinh(x: real(64)): real(64);

  /* Returns the hyperbolic sine of the argument `x`. */
  inline proc sinh(x : real(32)): real(32) {
    extern proc sinhf(x: real(32)): real(32);
    return sinhf(x);
  }

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

     It is an error if the `x` is less than zero.
  */
  extern proc sqrt(x: real(64)): real(64);

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

     It is an error if  `x` is less than zero.
  */
  inline proc sqrt(x : real(32)): real(32) {
    extern proc sqrtf(x: real(32)): real(32);
    return sqrtf(x);
  }

  /* Returns the tangent of the argument `x`. */
  extern proc tan(x: real(64)): real(64);

  /* Returns the tangent of the argument `x`. */
  inline proc tan(x : real(32)): real(32) {
    extern proc tanf(x: real(32)): real(32);
    return tanf(x);
  }

  /* Returns the hyperbolic tangent of the argument `x`. */
  extern proc tanh(x: real(64)): real(64);

  /* Returns the hyperbolic tangent of the argument `x`. */
  inline proc tanh(x : real(32)): real(32) {
    extern proc tanhf(x: real(32)): real(32);
    return tanhf(x);
  }

  /* Returns the absolute value of the gamma function of the argument `x`. */
  extern proc tgamma(x: real(64)): real(64);

  /* Returns the absolute value of the gamma function of the argument `x`. */
  inline proc tgamma(x : real(32)): real(32) {
    extern proc tgammaf(x: real(32)): real(32);
    return tgammaf(x);
  }

  /* Returns the nearest integral value to the argument `x` that is not larger
     than `x` in absolute value. */
  extern proc trunc(x: real(64)): real(64);

  /* Returns the nearest integral value to the argument `x` that is not larger
     than `x` in absolute value. */
  inline proc trunc(x : real(32)): real(32) {
    extern proc truncf(x: real(32)): real(32);
    return truncf(x);
  }

  /* e - exp(1) or  the base of the natural logarithm */
  param e = 2.7182818284590452354;
  /* log2(e) */
  param log2_e = 1.4426950408889634074;
  /* log10(e) */
  param log10_e = 0.43429448190325182765;
  /* log(2) (natural logarithm) */
  param ln_2 = 0.69314718055994530942;
  /* log(10) (natural logarithm) */
  param ln_10 = 2.30258509299404568402;
  /* pi - the circumference/the diameter of a circle */
  param pi = 3.14159265358979323846;
  /* pi/2 */
  param half_pi = 1.57079632679489661923;
  /* pi/4 */
  param quarter_pi = 0.78539816339744830962;
  /* 1/pi */
  param recipr_pi = 0.31830988618379067154;
  /* 2/pi */
  param twice_recipr_pi = 0.63661977236758134308;
  /* 2/sqrt(pi) */
  param twice_recipr_sqrt_pi = 1.12837916709551257390;
  /* sqrt(2) */
  param sqrt_2 = 1.41421356237309504880;
  /* 1/sqrt(2) */
  param recipr_sqrt_2 = 0.70710678118654752440;
} // end of module Math

// TODO: Consolidate overloaded signatures, to simplify the documentation.

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

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

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

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

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

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

*/
module Math {

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

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

  pragma "no doc"
  extern proc fabs(x: real(64)): real(64);

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

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

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

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

  /* Returns the absolute value of the integer argument.

     :rtype: The type of `i`.
  */
  inline proc abs(i : int(?w)) return if i < 0 then -i else i;

  /* Returns the absolute value of the unsigned integer argument.

     :rtype: The type of `i`.
  */
  inline proc abs(i : uint(?w)) return i;

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

  /* Returns the magnitude of the real argument `r`. */
  inline proc abs(r : real(64)):real(64) return fabs(r);

  /* Returns the magnitude of the real argument `x`. */
  inline proc abs(x : real(32)): real(32) {
    extern proc fabsf(x: real(32)): real(32);
    return fabsf(x);
  }

  /* Returns the real magnitude of the imaginary argument `im`. */
  inline proc abs(im : imag(64)): real(64) return fabs(_i2r(im));

  /* Returns the real magnitude of the imaginary argument `im`. */
  inline proc abs(im: imag(32)): real(32) {
    extern proc fabsf(x: real(32)): real(32);
    return fabsf(_i2r(im));
  }

  /* Returns the real magnitude of the complex argument `x`.

     :rtype: The type of the real component of the argument (== `w`/2).
  */
  inline proc abs(x : complex(?w)) return sqrt(x.re*x.re + x.im*x.im);

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

     It is an error if `x` is less than -1 or greater than 1.
  */
  extern proc acos(x: real(64)): real(64);

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

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc acos(x : real(32)): real(32) {
    extern proc acosf(x: real(32)): real(32);
    return acosf(x);
  }

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

     It is an error if `x` is less than 1.
  */
  extern proc acosh(x: real(64)): real(64);

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

     It is an error if `x` is less than 1.
  */
  inline proc acosh(x : real(32)): real(32) {
    extern proc acoshf(x: real(32)): real(32);
    return acoshf(x);
  }

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

     It is an error if `x` is less than -1 or greater than 1.
  */
  extern proc asin(x: real(64)): real(64);

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

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc asin(x : real(32)): real(32) {
    extern proc asinf(x: real(32)): real(32);
    return asinf(x);
  }

  /* Returns the inverse hyperbolic sine of the argument `x`. */
  extern proc asinh(x: real(64)): real(64);

  /* Returns the inverse hyperbolic sine of the argument `x`. */
  inline proc asinh(x : real(32)): real(32) {
    extern proc asinhf(x: real(32)): real(32);
    return asinhf(x);
  }

  /* Returns the arc tangent of the argument `x`. */
  extern proc atan(x: real(64)): real(64);

  /* Returns the arc tangent of the argument `x`. */
  inline proc atan(x : real(32)): real(32) {
    extern proc atanf(x: real(32)): real(32);
    return atanf(x);
  }

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

     This is equivalent to
     the arc tangent of `y` / `x` except that the signs of `y`
     and `x` are used to determine the quadrant of the result. */
  extern proc atan2(y: real(64), x: real(64)): real(64);

  /* Returns the arc tangent of the two arguments.

     This is equivalent to
     the arc tangent of `y` / `x` except that the signs of `y`
     and `x` are used to determine the quadrant of the result. */
  inline proc atan2(y : real(32), x: real(32)): real(32) {
    extern proc atan2f(y: real(32), x: real(32)): real(32);
    return atan2f(y, x);
  }

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

     It is an error if `x` is less than -1 or greater than 1. */
  extern proc atanh(x: real(64)): real(64);

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

     It is an error if `x` is less than -1 or greater than 1. */
  inline proc atanh(x : real(32)): real(32) {
    extern proc atanhf(x: real(32)): real(32);
    return atanhf(x);
  }

  /* Returns the cube root of the argument `x`. */
  extern proc cbrt(x: real(64)): real(64);

  /* Returns the cube root of the argument `x`. */
  inline proc cbrt(x : real(32)): real(32) {
    extern proc cbrtf(x: real(32)): real(32);
    return cbrtf(x);
  }

  /* Returns the value of the argument `x` rounded up to the nearest integer. */
  extern proc ceil(x: real(64)): real(64);

  /* Returns the value of the argument `x` rounded up to the nearest integer. */
  inline proc ceil(x : real(32)): real(32) {
    extern proc ceilf(x: real(32)): real(32);
    return ceilf(x);
  }

  /* Returns the complex conjugate of the argument `a`.

     :rtype: The type of `a`.
  */
  inline proc conjg(a: complex(?w)) : complex(w) return (a.re, -a.im):complex(w);

  /* Returns the cosine of the argument `x`. */
  extern proc cos(x: real(64)): real(64);

  /* Returns the cosine of the argument `x`. */
  inline proc cos(x : real(32)): real(32) {
    extern proc cosf(x: real(32)): real(32);
    return cosf(x);
  }

  /* Returns the hyperbolic cosine of the argument `x`. */
  extern proc cosh(x: real(64)): real(64);

  /* Returns the hyperbolic cosine of the argument `x`. */
  inline proc cosh(x : real(32)): real(32) {
    extern proc coshf(x: real(32)): real(32);
    return coshf(x);
  }

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

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

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

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

  /*
    A variant of :proc:`divceil` that performs no runtime checks.
    The user must ensure that both arguments are strictly positive
    (not 0) and are of a signed integer type (not `uint`).
  */
  proc divceilpos(m: integral, n: integral) {
    if !isIntType(m.type) || !isIntType(n.type) then
      compilerError("divceilpos() accepts only arguments of signed integer types");
    return (m - 1) / n + 1;
  }

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

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

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

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

  /*
    A variant of :proc:`divfloor` that performs no runtime checks.
    The user must ensure that both arguments are strictly positive
    (not 0) and are of a signed integer type (not `uint`).
  */
  proc divfloorpos(m: integral, n: integral) {
    if !isIntType(m.type) || !isIntType(n.type) then
      compilerError("divfloorpos() accepts only arguments of signed integer types");
    return m / n;
  }

  /* Returns the error function of the argument `x`. */
  extern proc erf(x: real(64)): real(64);

  /* Returns the error function of the argument `x`. */
  inline proc erf(x : real(32)): real(32) {
    extern proc erff(x: real(32)): real(32);
    return erff(x);
  }

  /* Returns the complementary error function of the argument.
     This is equivalent to 1.0 - :proc:`erf`\(`x`).
  */
  extern proc erfc(x: real(64)): real(64);

  /* Returns the complementary error function of the argument.
     This is equivalent to 1.0 - :proc:`erf`\(`x`).
  */
  inline proc erfc(x : real(32)): real(32) {
    extern proc erfcf(x: real(32)): real(32);
    return erfcf(x);
  }

  /* Returns the value of the Napierien `e` raised to the power of the argument `x`. */
  extern proc exp(x: real(64)): real(64);

  /* Returns the value of the Napierien `e` raised to the power of the argument. */
  inline proc exp(x : real(32)): real(32) {
    extern proc expf(x: real(32)): real(32);
    return expf(x);
  }

  /* Returns the value of `2` raised to the power of the argument `x`. */
  extern proc exp2(x: real(64)): real(64);

  /* Returns the value of `2` raised to the power of the argument `x`. */
  inline proc exp2(x : real(32)): real(32) {
    extern proc exp2f(x: real(32)): real(32);
    return exp2f(x);
  }

  /* Returns one less than the value of the Napierien `e` raised to the power
     of the argument `x`. */
  extern proc expm1(x: real(64)): real(64);

  /* Returns one less than the value of the Napierien `e` raised to the power
     of the argument `x`. */
  inline proc expm1(x : real(32)): real(32) {
    extern proc expm1f(x: real(32)): real(32);
    return expm1f(x);
  }

  /* Returns the value of the argument `x` rounded down to the nearest integer. */
  extern proc floor(x: real(64)): real(64);

  /* Returns the value of the argument `x` rounded down to the nearest integer. */
  inline proc floor(x : real(32)): real(32) {
    extern proc floorf(x: real(32)): real(32);
    return floorf(x);
  }

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

  /* Returns `true` if the argument `x` is a representation of a finite value;
     `false` otherwise. */
  inline proc isfinite(x: real(64)): bool return chpl_macro_double_isfinite(x):bool;

  /* Returns `true` if the argument `x` is a representation of a finite value;
     `false` otherwise. */
  inline proc isfinite(x: real(32)): bool return chpl_macro_float_isfinite(x):bool;

  /* Returns `true` if the argument `x` is a representation of *infinity*;
     `false` otherwise. */
  inline proc isinf(x: real(64)): bool return chpl_macro_double_isinf(x):bool;

  /* Returns `true` if the argument `x` is a representation of *infinity*;
     `false` otherwise. */
  inline proc isinf(x: real(32)): bool return chpl_macro_float_isinf(x):bool;

  /* Returns `true` if the argument `x` does not represent a valid number;
     `false` otherwise. */
  inline proc isnan(x: real(64)): bool return chpl_macro_double_isnan(x):bool;

  /* Returns `true` if the argument `x` does not represent a valid number;
     `false` otherwise. */
  inline proc isnan(x: real(32)): bool return chpl_macro_float_isnan(x):bool;

  /* Returns the natural logarithm of the absolute value
     of the gamma function of the argument `x`.
  */
  extern proc lgamma(x: real(64)): real(64);

  /* Returns the natural logarithm of the absolute value
     of the gamma function of the argument `x`.
  */
  inline proc lgamma(x : real(32)): real(32) {
    extern proc lgammaf(x: real(32)): real(32);
    return lgammaf(x);
  }

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

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log(x: real(64)): real(64);

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

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log(x : real(32)): real(32) {
    extern proc logf(x: real(32)): real(32);
    return logf(x);
  }

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

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log10(x: real(64)): real(64);

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

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log10(x : real(32)): real(32) {
    extern proc log10f(x: real(32)): real(32);
    return log10f(x);
  }

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

     It is an error if `x` is less than or equal to -1.
  */
  extern proc log1p(x: real(64)): real(64);

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

     It is an error if `x` is less than or equal to -1.
  */
  inline proc log1p(x : real(32)): real(32) {
    extern proc log1pf(x: real(32)): real(32);
    return log1pf(x);
  }

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

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log2(x: real(64)): real(64);

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

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log2(x : real(32)): real(32) {
    extern proc log2f(x: real(32)): real(32);
    return log2f(x);
  }

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

     :rtype: `int(64)`

     It is an error if `x` is less than or equal to zero.
  */
  proc log2(in val: int(?w)) {
    return logBasePow2(val, 1);
  }

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

     :rtype: `int(64)`

     It is an error if `x` is less than or equal to zero.
  */
  proc log2(in val: uint(?w)) {
    return logBasePow2(val, 1);
  }

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

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

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

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc mod(m: integral, n: integral) {
    const temp = m % n;

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

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

     The return value has the same type as `x`.
  */
  proc mod(x: real(?w), y: real(w)): real(w) {
    // This codes up the standard definition, according to Wikipedia.
    // Is there a more efficient implementation for reals?
    return x - y*floor(x/y);
  }

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

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`nearbyint` will not raise the "inexact"
     floating-point exception.
  */
  extern proc nearbyint(x: real(64)): real(64);

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

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`rint` may raise the "inexact" floating-point
     exception.
  */
  extern proc rint(x: real(64)): real(64);

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`rint` may raise the "inexact" floating-point
     exception.
  */
  inline proc rint(x : real(32)): real(32) {
    extern proc rintf(x: real(32)): real(32);
    return rintf(x);
  }

  /* Returns the rounded integral value of the argument `x`. */
  extern proc round(x: real(64)): real(64);

  /* Returns the rounded integral value of the argument `x`. */
  inline proc round(x : real(32)): real(32) {
    extern proc roundf(x: real(32)): real(32);
    return roundf(x);
  }

  /* Returns the signum function of the integer argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(i : int(?w)): int(8)
    return ((i > 0) : int(8) - (i < 0) : int(8)) : int(8);

  /* Returns the signum function of the unsigned integer argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(i : uint(?w)): uint(8)
    return (i > 0) : uint(8);

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

  /* Returns the signum function of the real argument `x`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(x : real(?w)): int(8)
    return ((x > 0.0) : int(8) - (x < 0.0) : int(8)) : int(8);

  /* Returns the sine of the argument `x`. */
  extern proc sin(x: real(64)): real(64);

  /* Returns the sine of the argument `x`. */
  inline proc sin(x: real(32)): real(32) {
    extern proc sinf(x: real(32)): real(32);
    return sinf(x);
  }

  /* Returns the hyperbolic sine of the argument `x`. */
  extern proc sinh(x: real(64)): real(64);

  /* Returns the hyperbolic sine of the argument `x`. */
  inline proc sinh(x : real(32)): real(32) {
    extern proc sinhf(x: real(32)): real(32);
    return sinhf(x);
  }

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

     It is an error if the `x` is less than zero.
  */
  extern proc sqrt(x: real(64)): real(64);

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

     It is an error if  `x` is less than zero.
  */
  inline proc sqrt(x : real(32)): real(32) {
    extern proc sqrtf(x: real(32)): real(32);
    return sqrtf(x);
  }

  /* Returns the tangent of the argument `x`. */
  extern proc tan(x: real(64)): real(64);

  /* Returns the tangent of the argument `x`. */
  inline proc tan(x : real(32)): real(32) {
    extern proc tanf(x: real(32)): real(32);
    return tanf(x);
  }

  /* Returns the hyperbolic tangent of the argument `x`. */
  extern proc tanh(x: real(64)): real(64);

  /* Returns the hyperbolic tangent of the argument `x`. */
  inline proc tanh(x : real(32)): real(32) {
    extern proc tanhf(x: real(32)): real(32);
    return tanhf(x);
  }

  /* Returns the absolute value of the gamma function of the argument `x`. */
  extern proc tgamma(x: real(64)): real(64);

  /* Returns the absolute value of the gamma function of the argument `x`. */
  inline proc tgamma(x : real(32)): real(32) {
    extern proc tgammaf(x: real(32)): real(32);
    return tgammaf(x);
  }

  /* Returns the nearest integral value to the argument `x` that is not larger
     than `x` in absolute value. */
  extern proc trunc(x: real(64)): real(64);

  /* Returns the nearest integral value to the argument `x` that is not larger
     than `x` in absolute value. */
  inline proc trunc(x : real(32)): real(32) {
    extern proc truncf(x: real(32)): real(32);
    return truncf(x);
  }

  /* e - exp(1) or  the base of the natural logarithm */
  param e = 2.7182818284590452354;
  /* log2(e) */
  param log2_e = 1.4426950408889634074;
  /* log10(e) */
  param log10_e = 0.43429448190325182765;
  /* log(2) (natural logarithm) */
  param ln_2 = 0.69314718055994530942;
  /* log(10) (natural logarithm) */
  param ln_10 = 2.30258509299404568402;
  /* pi - the circumference/the diameter of a circle */
  param pi = 3.14159265358979323846;
  /* pi/2 */
  param half_pi = 1.57079632679489661923;
  /* pi/4 */
  param quarter_pi = 0.78539816339744830962;
  /* 1/pi */
  param recipr_pi = 0.31830988618379067154;
  /* 2/pi */
  param twice_recipr_pi = 0.63661977236758134308;
  /* 2/sqrt(pi) */
  param twice_recipr_sqrt_pi = 1.12837916709551257390;
  /* sqrt(2) */
  param sqrt_2 = 1.41421356237309504880;
  /* 1/sqrt(2) */
  param recipr_sqrt_2 = 0.70710678118654752440;
} // end of module Math

// TODO: Consolidate overloaded signatures, to simplify the documentation.


Added an unordered iterator over tree indices

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

/** FTree: The tree data structure used to store the numerical representation
    of a function.

    For 1d Madness, an FTree is a binary tree, for 2d it would
    be a quad tree, 3d an octtree, and so on.  The FTree used here uses level
    and index hashing to store the tree rather than storing connectivity
    information.  So, it is important that you do a has_coeffs() before
    indexing into the tree to be sure you don't create coeffs when you don't
    mean to.
 */
config const numLocs = 3;

// FIXME: The Coeff record works around arrays of arrays.  Ideally, nodes
//        should be a mapping from indices onto :[coeffDom] real.
record Coeff {
    var dom  : domain(1);
    var data : [dom] real;
}

// The empty vector, returned when there are no Coeffs.
var None: [0..-1] real;

// Check if we have None.
def isNone(x) {
    return x.numElements == 0;
}

record LocTree {
    const coeffDom : domain(1);
    var idx_t      : 2*int;
    var locIndices : domain(idx_t.type); // Indexed by 2-tuples of integers
    var locNodes   : [locIndices] Coeff; // Associative Mapping: (:int, :int)
                                         // => Coeff

    var zeroes     : [coeffDom] real;    // Return zeroes from this() when
                                         // reading something that has not yet
                                         // been set.

    /** Access an element in the associative domain.  If the element
        doesn't exist it will be created.

        We have to be really careful about creating extra boxes when we don't
        mean to.  The algorithms tend to be really sensitive to the structure
        of the tree.  Scaling coefficients are used to mark the leaves in the
        sum tree, so if you accidentally create scaling coeffs somewhere in the
        middle of the tree you will short circuit a whole subtree!

     */
    def this(lvl: int, idx: int) var {
        if !locIndices.member((lvl, idx)) {
            if setter {
              locIndices += ((lvl, idx));
              locNodes[(lvl, idx)] = Coeff(coeffDom);
            } else {
              // This is a getter so it shouldn't be modifying what
              // we return, should be safe to return the zero vector.
              // FIXME: Zeroes should really be a const, but can'ti
              //        return const from a var fcn.
              return zeroes;
            }
        }

        return locNodes[(lvl, idx)].data;
    }

    /** Access an element in the associative domain.  If it doesn't exist,
        return None.
     */
    def peek(lvl: int, idx: int) var {
        if has_coeffs(lvl, idx) then
            return this(lvl, idx);
        else
            return None;
    }

    /** Unordered iterator over all coefficients
     */
    def these() {
        for n in locNodes yield n.data;
    }

    /** Unordered iterator over all boxes in a particular level.
        This is not a particularly fast way to do this, but for many of the
        Madness levelwise iterators that do all levels from 0..max_level this
        will be much faster when the data is not all the way down at max_level.
        A sparse array or an array of associative arrays may be more conducive
        to this type of iteration vs. the associative domain used here.
     */
    def lvl_iter(lvl: int) {
        // AGS - Why are we doing indices.member(i)?
        for i in locIndices do
            if i(1) == lvl && locIndices.member(i) then yield locNodes[i].data;
    }

    /** Check if there are coefficients in box (lvl, idx)
     */
    def has_coeffs(lvl: int, idx: int) {
        return locIndices.member((lvl, idx));
    }

    /** Remove an element from the associative domain.  If the element
        does not exist, it is ignored.
     */
    def remove(lvl: int, idx: int) {
        if locIndices.member((lvl, idx)) then locIndices.remove((lvl, idx));
    }

    // AGS - new function to compile test_showboxes
    def idx_iter(lvl: int) {
        for idx in locIndices do
            if idx(1) == lvl then yield idx;
    }

    // AGS - new function to compile MB's gaxpy
    def idx_iter() {
        for idx in locIndices do
            yield idx;
    }
}

class FTree {
    const order    : int;
    const coeffDom = [0..order-1];

    const locDom = [0..numLocs);
    var nodes    : [locDom] LocTree;

    def initialize() {
        if order == 0 then
            halt("FTree must be initialized with an order > 0");

        [loc in locDom] nodes[loc] = LocTree(coeffDom);
    }

    def mapNodeToLoc(lvl, idx) {
        return (lvl + idx) % numLocs;
    }

    def this(lvl: int, idx: int) var {
        const n => nodes[mapNodeToLoc(lvl, idx)];
        return n[lvl, idx];
    }

    def this(loc: int) {
        for data in nodes[loc] do
            yield data;
    }

    def these() {
        for n in nodes do
            for data in n do
                yield data;
    }

    def lvl_iter(lvl: int) {
        for n in nodes do
            for data in n.lvl_iter(lvl) do
                yield data;
    }

    def peek(lvl: int, idx: int) var {
        const n => nodes[mapNodeToLoc(lvl, idx)];
        return n.peek(lvl, idx);
    }

    def has_coeffs(lvl: int, idx: int) {
        const n => nodes[mapNodeToLoc(lvl, idx)];
        return n.has_coeffs(lvl, idx);
    }

    def remove(lvl: int, idx: int) {
        const n => nodes[mapNodeToLoc(lvl, idx)];
        n.remove(lvl, idx);
    }

    /** Return a copy of this FTree
     */
    def copy() {
        var t = FTree(order);
        t.nodes = nodes;
        return t;
    }

    // AGS - new function to compile test_showboxes
    def idx_iter(lvl: int) {
        for n in nodes do
            for idx in n.idx_iter(lvl) do
                yield idx;
    }

    // AGS - new function to compile MB's gaxpy
    def idx_iter() {
        for n in nodes do
            for idx in n.idx_iter() do
                yield idx;
    }
}

def main() {
    /*
    var f = FTree(2);

    for (i, j) in [0..2, 0..2] do f[i, j] = (i, j);

    for (i, j) in [1..0, 1..0] do f.remove(i, j);

    for (i, j) in [0..1, 0..1] do f[i, j] = (-(i:real), -(j:real));

    for (i, j) in [2..1, 2..1] do f.remove(i, j);

    for (i, j) in [1..2, 1..2] do f[i, j] = (-(i:real), -(j:real));

    for (i, j) in [0..2, 0..2] do
        writeln("(",i,", ",j,") = ", f.peek(i, j));

    for i in 0..2 do
        for n in f.lvl_iter(i) do
            writeln(i, ": ", n);
    */

    var f = FTree(2);

    for (i, j) in [1..3, 2..4] do f[i, j] = (i, j);

    for loc in 0..numLocs-1 {
        writeln("\n\ntree on loc ", loc, " = ");
        for data in f[loc] do
            writeln(data);
    }

    writeln("\n\nf.has_coeffs(4, 5) = ", f.has_coeffs(4, 5));
    writeln("f.peek(4, 5) = ", f.peek(4, 5));
    writeln("f[4, 5] = ", f[4, 5]);
    writeln("f.remove(4, 5)");
    f.remove(4, 5);

    writeln("\n\nf.has_coeffs(1, 2) = ", f.has_coeffs(1, 2));
    writeln("f.peek(1, 2) = ", f.peek(1, 2));
    writeln("f[1, 2] = ", f[1, 2]);
    writeln("f.remove(1, 2)");
    f.remove(1, 2);

    writeln("\n\nf.remove(3, 4)");
    f.remove(3, 4);

    for loc in 0..numLocs-1 {
        writeln("\n\ntree on loc ", loc, " = ");
        for data in f[loc] do
            writeln(data);
    }

    writeln("\n\nentire tree = ");
    for data in f do
        writeln(data);

    //writeln("norm2 of tree = ",sqrt(+ reduce [data in f] normf(data)**2));

    writeln("\n\nentire tree = ");
    writeln(f);

    var f1 = f.copy();

    writeln("\n\nf.remove(3, 2)");
    f.remove(3, 2);

    writeln("\n\nentire tree = ");
    writeln(f);

    writeln("\n\ntree copy = ");
    writeln(f1);

    for lvl in 1..3 {
        writeln("\n\ndata on lvl ", lvl, " = ");
        for data in f.lvl_iter(lvl) do
            writeln(data);
    }

    for lvl in 1..3 {
        writeln("\n\nindices on lvl ", lvl, " = ");
            for idx in f.idx_iter(lvl) do
                writeln(idx);
    }

    writeln("\n\nall tree indices = ");
    for (n, l) in f.idx_iter() do
        writeln(n,l);
}

/** FTree: The tree data structure used to store the numerical representation
    of a function.

    For 1d Madness, an FTree is a binary tree, for 2d it would
    be a quad tree, 3d an octtree, and so on.  The FTree used here uses level
    and index hashing to store the tree rather than storing connectivity
    information.  So, it is important that you do a has_coeffs() before
    indexing into the tree to be sure you don't create coeffs when you don't
    mean to.
 */
config const numLocs = 3;

// FIXME: The Coeff record works around arrays of arrays.  Ideally, nodes
//        should be a mapping from indices onto :[coeffDom] real.
record Coeff {
    var dom  : domain(1);
    var data : [dom] real;
}

// The empty vector, returned when there are no Coeffs.
var None: [0..-1] real;

// Check if we have None.
def isNone(x) {
    return x.numElements == 0;
}

record LocTree {
    var coeffDom   : domain(1);
    var idx_t      : 2*int;              // FIXME: Can't write domain(2*int)
    var locIndices : domain(idx_t.type); // Indexed by 2-tuples of integers
    var locNodes   : [locIndices] Coeff; // Associative Mapping: (:int, :int)
                                         // => Coeff

    var zeroes     : [coeffDom] real;    // Return zeroes from this() when
                                         // reading something that has not yet
                                         // been set.

    /** Access an element in the associative domain.  If the element
        doesn't exist it will be created.

        We have to be really careful about creating extra boxes when we don't
        mean to.  The algorithms tend to be really sensitive to the structure
        of the tree.  Scaling coefficients are used to mark the leaves in the
        sum tree, so if you accidentally create scaling coeffs somewhere in the
        middle of the tree you will short circuit a whole subtree!

     */
    def this(lvl: int, idx: int) var {
        if !locIndices.member((lvl, idx)) {
            if setter {
              locIndices += ((lvl, idx));
              locNodes[(lvl, idx)] = Coeff(coeffDom);
            } else {
              // This is a getter so it shouldn't be modifying what
              // we return, should be safe to return the zero vector.
              // FIXME: Zeroes should really be a const, but can'ti
              //        return const from a var fcn.
              return zeroes;
            }
        }

        return locNodes[(lvl, idx)].data;
    }

    /** Access an element in the associative domain.  If it doesn't exist,
        return None.
     */
    def peek(lvl: int, idx: int) var {
        if has_coeffs(lvl, idx) then
            return this(lvl, idx);
        else
            return None;
    }

    /** Unordered iterator over all coefficients
     */
    def these() {
        for n in locNodes yield n.data;
    }

    /** Unordered iterator over all boxes in a particular level.
        This is not a particularly fast way to do this, but for many of the
        Madness levelwise iterators that do all levels from 0..max_level this
        will be much faster when the data is not all the way down at max_level.
        A sparse array or an array of associative arrays may be more conducive
        to this type of iteration vs. the associative domain used here.
     */
    def lvl_iter(lvl: int) {
        // AGS - Why are we doing indices.member(i)?
        for i in locIndices do
            if i(1) == lvl && locIndices.member(i) then yield locNodes[i].data;
    }

    /** Check if there are coefficients in box (lvl, idx)
     */
    def has_coeffs(lvl: int, idx: int) {
        return locIndices.member((lvl, idx));
    }

    /** Remove an element from the associative domain.  If the element
        does not exist, it is ignored.
     */
    def remove(lvl: int, idx: int) {
        if locIndices.member((lvl, idx)) then locIndices.remove((lvl, idx));
    }

    // AGS - new function to compile test_showboxes
    def idx_iter(lvl: int) {
        for idx in locIndices do
            if idx(1) == lvl then yield idx;
    }
}

class FTree {
    var order    : int;
    var coeffDom = [0..order-1];

    const locDom = [0..numLocs);
    var nodes    : [locDom] LocTree;

    def initialize() {
        if order == 0 then
            halt("FTree must be initialized with an order > 0");

        [loc in locDom] nodes[loc] = LocTree(coeffDom);
    }

    def mapNodeToLoc(lvl, idx) {
        return (lvl + idx) % numLocs;
    }

    def this(lvl: int, idx: int) var {
        const n => nodes[mapNodeToLoc(lvl, idx)];
        return n[lvl, idx];
    }

    def this(loc: int) {
        for data in nodes[loc] do
            yield data;
    }

    def these() {
        for n in nodes do
            for data in n do
                yield data;
    }

    def lvl_iter(lvl: int) {
        for n in nodes do
            for data in n.lvl_iter(lvl) do
                yield data;
    }

    def peek(lvl: int, idx: int) var {
        const n => nodes[mapNodeToLoc(lvl, idx)];
        return n.peek(lvl, idx);
    }

    def has_coeffs(lvl: int, idx: int) {
        const n => nodes[mapNodeToLoc(lvl, idx)];
        return n.has_coeffs(lvl, idx);
    }

    def remove(lvl: int, idx: int) {
        const n => nodes[mapNodeToLoc(lvl, idx)];
        n.remove(lvl, idx);
    }

    /** Return a copy of this FTree
     */
    def copy() {
        var t = FTree(order);
        t.nodes = nodes;
        return t;
    }

    // AGS - new function to compile test_showboxes
    def idx_iter(lvl: int) {
        for n in nodes do
            for idx in n.idx_iter(lvl) do
                yield idx;
    }
}

def main() {
    /*
    var f = FTree(2);

    for (i, j) in [0..2, 0..2] do f[i, j] = (i, j);

    for (i, j) in [1..0, 1..0] do f.remove(i, j);

    for (i, j) in [0..1, 0..1] do f[i, j] = (-(i:real), -(j:real));

    for (i, j) in [2..1, 2..1] do f.remove(i, j);

    for (i, j) in [1..2, 1..2] do f[i, j] = (-(i:real), -(j:real));

    for (i, j) in [0..2, 0..2] do
        writeln("(",i,", ",j,") = ", f.peek(i, j));

    for i in 0..2 do
        for n in f.lvl_iter(i) do
            writeln(i, ": ", n);
    */

    var f = FTree(2);

    for (i, j) in [1..3, 2..4] do f[i, j] = (i, j);

    for loc in 0..numLocs-1 {
        writeln("\n\ntree on loc ", loc, " = ");
        for data in f[loc] do
            writeln(data);
    }

    writeln("\n\nf.has_coeffs(4, 5) = ", f.has_coeffs(4, 5));
    writeln("f.peek(4, 5) = ", f.peek(4, 5));
    writeln("f[4, 5] = ", f[4, 5]);
    writeln("f.remove(4, 5)");
    f.remove(4, 5);

    writeln("\n\nf.has_coeffs(1, 2) = ", f.has_coeffs(1, 2));
    writeln("f.peek(1, 2) = ", f.peek(1, 2));
    writeln("f[1, 2] = ", f[1, 2]);
    writeln("f.remove(1, 2)");
    f.remove(1, 2);

    writeln("\n\nf.remove(3, 4)");
    f.remove(3, 4);

    for loc in 0..numLocs-1 {
        writeln("\n\ntree on loc ", loc, " = ");
        for data in f[loc] do
            writeln(data);
    }

    writeln("\n\nentire tree = ");
    for data in f do
        writeln(data);

    //writeln("norm2 of tree = ",sqrt(+ reduce [data in f] normf(data)**2));

    writeln("\n\nentire tree = ");
    writeln(f);

    var f1 = f.copy();

    writeln("\n\nf.remove(3, 2)");
    f.remove(3, 2);

    writeln("\n\nentire tree = ");
    writeln(f);

    writeln("\n\ntree copy = ");
    writeln(f1);

    for lvl in 1..3 {
        writeln("\n\ndata on lvl ", lvl, " = ");
        for data in f.lvl_iter(lvl) do
            writeln(data);
    }

    for lvl in 1..3 {
        writeln("\n\nindices on lvl ", lvl, " = ");
            for idx in f.idx_iter(lvl) do
                writeln(idx);
    }
}


Deleted the randomStreams I created

Deleted the randomStreams I created

use Random;

var A: [1..8] real;
var B: [1..8] imag;
var C: [1..4] complex;

//
// Check standalone routines
//
fillRandom(A, seed=314159265);
fillRandom(B, seed=314159265);
fillRandom(C, seed=314159265);
writeln(A);
writeln(B);
writeln(C);

var rs1 = new RandomStream(seed=314159265, eltType=real);
var rs2 = new RandomStream(seed=314159265, eltType=imag);
var rs3 = new RandomStream(seed=314159265, eltType=complex);

//
// Check fillRandom method
//
rs1.fillRandom(A);
rs2.fillRandom(B);
rs3.fillRandom(C);
writeln(A);
writeln(B);
writeln(C);

var rs4 = new RandomStream(seed=314159265, eltType=real);
var rs5 = new RandomStream(seed=314159265, eltType=imag);
var rs6 = new RandomStream(seed=314159265, eltType=complex);

//
// Check consecutive implementations of fillRandom method()
//
rs4.fillRandom(A[1..4]);
rs5.fillRandom(B[1..4]);
rs6.fillRandom(C[1..2]);
rs4.fillRandom(A[5..8]);
rs5.fillRandom(B[5..8]);
rs6.fillRandom(C[3..4]);
writeln(A);
writeln(B);
writeln(C);

//
// Check getNth() method
//
for i in 1..8 {
  A[i] = rs4.getNth(i);
  B[i] = rs5.getNth(i);
}
for i in 1..4 {
  C[i] = rs6.getNth(i);
}
writeln(A);
writeln(B);
writeln(C);

//
// Check skipToNth()/getNext() methods
//
for i in 1..8 {
  rs4.skipToNth(i);
  A[i] = rs4.getNext();
  rs5.skipToNth(i);
  B[i] = rs5.getNext();
}
for i in 1..4 {
  rs6.skipToNth(i);
  C[i] = rs6.getNext();
}
writeln(A);
writeln(B);
writeln(C);

delete rs1;
delete rs2;
delete rs3;
delete rs4;
delete rs5;
delete rs6;


Changed formatting

Changed formatting

In writing my spectralnorm variant, I hadn't understood that %r == %g
and that %dr == %f for Chapel, so was using %.10r where the thing to
do to match other languages is actually %.9dr, so I made that change.
Also made my comments line up properly.

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

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

   Contributed by Lydia Duncan & Albert Sidelnik, based on Sebastien
   Loisel's C version
*/

config const n = 500;

proc main() {
  var tmp, u, v: [0..#n] real;  // Declare three vectors

  u = 1.0;                      // Initialize u to 1.0

  for 1..10 {                   // For 10 iterations...
    multiplyAtAv(u, tmp, v);    // ...compute v = A*u*At
    multiplyAtAv(v, tmp, u);    // ...and     u = A*v*At
  }

  writef("%.9dr\n", sqrt(+ reduce (u*v) / + reduce (v*v)));
}

//
// Multiply vector v by matrix A and then by matrix A transposed
//
proc multiplyAtAv(v, tmp, AtAv) {
  multiplyAv(v, tmp);
  multiplyAtv(tmp, AtAv);
}

//
// Multiply vector v by matrix A
//
proc multiplyAv(v: [?Dv], Av: [?DAv]) {
  forall i in DAv do
    serial (true) do  // TODO: deprecrate need for true
      Av[i] = + reduce [j in Dv] (A[i,j] * v[j]);
}

//
// Multiply vector V by matrix A transposed
//
proc multiplyAtv(v: [?Dv], Atv: [?DAtv]) {
  forall i in DAtv do
    serial (true) do  // TODO: deprecrate need for true
      Atv[i] = + reduce [j in Dv] (A[j,i] * v[j]);
}

//
// return element i,j of infinite matrix A
//
inline proc A(i, j) {
  return 1.0 / ((((i + j) * (i + j + 1)) / 2) + i + 1);
}

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

   Contributed by Lydia Duncan & Albert Sidelnik, based on Sebastien
   Loisel's C version
*/

config const n = 500;

proc main() {
  var tmp, u, v: [0..#n] real;  // Declare three vectors

  u = 1.0;                     // Initialize u to 1.0

  for 1..10 {                  // For 10 iterations...
    multiplyAtAv(u, tmp, v);   // ...compute v = A*u*At
    multiplyAtAv(v, tmp, u);   // ...and     u = A*v*At
  }

  writef("%.10r\n", sqrt(+ reduce (u*v) / + reduce (v*v)));
}

//
// Multiply vector v by matrix A and then by matrix A transposed
//
proc multiplyAtAv(v, tmp, AtAv) {
  multiplyAv(v, tmp);
  multiplyAtv(tmp, AtAv);
}

//
// Multiply vector v by matrix A
//
proc multiplyAv(v: [?Dv], Av: [?DAv]) {
  forall i in DAv do
    serial (true) do  // TODO: deprecrate need for true
      Av[i] = + reduce [j in Dv] (A[i,j] * v[j]);
}

//
// Multiply vector V by matrix A transposed
//
proc multiplyAtv(v: [?Dv], Atv: [?DAtv]) {
  forall i in DAtv do
    serial (true) do  // TODO: deprecrate need for true
      Atv[i] = + reduce [j in Dv] (A[j,i] * v[j]);
}

//
// return element i,j of infinite matrix A
//
inline proc A(i, j) {
  return 1.0 / ((((i + j) * (i + j + 1)) / 2) + i + 1);
}


removing uh-oh coach

removing uh-oh coach

use LinearAlgebra,
    LinearAlgebra.Sparse,
    NumSuch,
    Random;

config param batchsize = 10000;

/*
 A matrix of data with named rows and columns.
 */
class NamedMatrix {
  var D: domain(2),
      SD = CSRDomain(D),
      X: [SD] real,  // the actual data
      rows: BiMap = new BiMap(),
      cols: BiMap = new BiMap();

   proc init() {
     this.initDone(); // NAMEDMATRIX DOESNT EXPLICITLY INHERIT ANYTHING SO IS THIS NECESSARY??
   }

   proc init(X) {
     this.D = {X.domain.dim(1), X.domain.dim(2)};
     this.initDone();
     this.loadX(X);
   }

   proc init(X, names: [] string) {
     this.init(X);
     try! this.setRowNames(names);
     try! this.setColNames(names);
   }

   proc init(X, rownames: [] string, colnames: [] string) {
     this.init(X);
     try! this.setRowNames(rownames);
     try! this.setColNames(colnames);
   }

   proc init(rownames: [] string, colnames: [] string) {
     this.D = {1..rownames.size, 1..colnames.size};
     this.initDone();
     try! this.setRowNames(rownames);
     try! this.setColNames(colnames);
   }

   proc init(N: NamedMatrix) {
     this.init(N.X);
     this.rows = N.rows;
     this.cols = N.cols;
   }

   proc init(X, rows: BiMap, cols: BiMap) {
     this.init(X);
     this.rows = rows;
     this.cols = cols;
   }
}

/*
Returns the number of rows in the matrix frame
 */
proc NamedMatrix.nrows() {
  return X.domain.dim(1).size;
}

/*
Returns the number of columns in the matrix frame
 */
proc NamedMatrix.ncols() {
  return X.domain.dim(2).size;
}

/*
 Finds the max along the row indicated by row number
 */
proc NamedMatrix.rowMax(i: int) {
  var x:[1..0] real;
  for a in this.X.domain.dimIter(2,i) {
    x.push_back(this.get(i,a));
  }
  if x.size < 1 {
    return NAN;
  } else {
    return max reduce x;
  }
}

/*
 Returns the max of each row
 */
proc NamedMatrix.rowMax() {
  var mxs: [1..this.nrows()] real;
  forall i in 1..this.nrows() {
    mxs[i] = this.rowMax(i);
  }
  return mxs;

}

/*
Loads the data from X into the internal array, also called X.  We call them all X to keep it clear.

:arg real[]: Array representing the matrix
 */
proc NamedMatrix.loadX(X:[], shape: 2*int =(-1,-1)) {
  if shape(1) > 0 && shape(2) > 0 {
    this.D = {1..shape(1), 1..shape(2)};
  }
  for (i,j) in X.domain {
    this.SD += (i,j);
    this.X(i,j) = X(i,j);
  }
}

/*
Sets the row names for the matrix X
 */
proc NamedMatrix.setRowNames(rn:[]): string throws {
  //if (X.domain.dim(1).size > 0) && (rn.size != X.domain.dim(1).size) {
  //if (1 > 0) && (rn.size != X.domain.dim(1).size) {
  if rn.size != X.domain.dim(1).size {
    const err = new DimensionMatchError(expected = X.domain.dim(1).size, actual=rn.size);
    throw err;
    return "";
  } else {
    for i in 1..rn.size {
      this.rows.add(rn[i]);
    }
    return this.rows;
  }
}

/*
Sets the column names for the matrix X
*/
proc NamedMatrix.setColNames(cn:[]): string throws {
  if cn.size != X.domain.dim(2).size then throw new Error();
  for i in 1..cn.size {
    this.cols.add(cn[i]);
  }
  return this.cols;
}

/*
 Gets the value of the (i,j) entry of the matrix X in the NamedMatrix
 */
proc NamedMatrix.get(i: int, j: int) {
   return this.X(i,j);
 }

 /*
 Get the values using the named rows and columns
  */
proc NamedMatrix.get(f: string, t: string) {
    return this.X(rows.get(f), cols.get(t));
 }

/*
 Set the value of this.X(i,j) by index row
 */
proc NamedMatrix.set(i: int, j: int, w: real) {
    if this.SD.member((i,j)) {
      this.X(i,j) = w;
    } else {
      this.SD += (i,j);
      this.X(i,j) = w;
    }
    return w;
}

/*
Set the values using the row and column names
*/
proc NamedMatrix.set(f: string, t: string, w: real) {
  return this.set(rows.get(f), cols.get(t), w);
}

/*
Update the value in X(i,j) with `w`
 */
proc NamedMatrix.update(i: int, j: int, w: real) {
  const x = this.get(i,j);
  return this.set(i,j, x + w);
}

/*
Update the value in X(i,j) with `w` using the row column names
 */
proc NamedMatrix.update(f: string, t: string, w: real) {
  const x = this.get(rows.get(f),cols.get(t));
  return this.set(rows.get(f),cols.get(t), x + w);
}

/*
Find the number of non-zeroes in the matrix
 */
proc NamedMatrix.nnz() {
  var i: int = 0;
  for ij in this.X.domain {
    i += 1;
  }
  return i;
}

/*
Calculates the sparsity of the matrix: Number of entries / frame size
 */
proc NamedMatrix.sparsity() {
  const d = this.X.shape[1]:real * this.X.shape[2]: real;
  return this.nnz():real / d;
}

/*
 Multiplies the current NamedMatrix `X` against the argument `Y`, but first it aligns
 the names of `X.cols` with `Y.rows`.  Returns an appropriately named NamedMatrix
 :arg NamedMatrix Y:
 */

proc NamedMatrix.ndot(N: NamedMatrix) {
  var C: NamedMatrix = new NamedMatrix(X = dot(this.X,N.X), this.rows, N.cols);
  return C;
}

proc NamedMatrix.alignAndMultiply(Y: NamedMatrix) {
    var rcOverlap: domain(string) = this.cols.keys & Y.rows.keys;

    var xSD: sparse subdomain(this.D) dmapped CS(),
        ySD: sparse subdomain(Y.D) dmapped CS(),
        xX: [xSD] real,  // the actual data
        yX: [ySD] real,  // the actual data
        xrows: BiMap = new BiMap(),
        yrows: BiMap = new BiMap(),
        xcols: BiMap = new BiMap(),
        ycols: BiMap = new BiMap();

    for (left_row, right_col) in zip(this.D.dim(2), Y.D.dim(1)) {
      for rc in rcOverlap {
        const j = this.cols.get(rc);
        if this.SD.member(left_row, j) {
          xSD += (left_row, j);
          xX[left_row, j] = this.X[left_row, j];
        }
        if Y.SD.member(j, right_col) {
          ySD += (j, right_col);
          yX[j, right_col] = Y.X[j, right_col];
        }
      }
    }
    const z = xX.dot(yX);
    var n = new NamedMatrix(X=z);
    n.rows = this.rows;
    n.cols = Y.cols;
    return n;
}

proc argmaxi(axis:int, id:int , X:[]) {
  var idm: (int,int),
      maximum: real = 0;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) > maximum {
        maximum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) > maximum {
        maximum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) > maximum {
        maximum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return maximum;
}

proc maxiloc(axis:int, id:int , X:[]) {
  var idm: (int,int),
      maximum: real = 0;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) > maximum {
        maximum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) > maximum {
        maximum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) > maximum {
        maximum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return idm;
}

proc argmini(axis:int, id:int , X:[]) {
  var idm: (int,int),
      minimum: real = 0;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) < minimum {
        minimum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) < minimum {
        minimum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) < minimum {
        minimum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return minimum;
}

proc miniloc(axis:int, id:int , X:[]) {
  var idm: (int,int),
      minimum: real = 0;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) < minimum {
        minimum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) < minimum {
        minimum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) < minimum {
        minimum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return idm;
}

proc tropic(A:[],B:[]) { // UNDER CONSTRUCTION
  writeln("Calculating Tropic Product");
  writeln("A is");
  writeln(A);
  writeln("With domain");
  writeln(A.domain);
  var dom: domain(2) = {A.domain.dim(1),B.domain.dim(2)};
  var sps = CSRDomain(dom);
  var BT = transpose(B);
  writeln("BT is");
  writeln(BT);
  writeln("With domain");
  writeln(BT.domain);
  writeln("Tropic will have entries in");
  writeln(dom);
  var T: [sps] real;
  for (i,j) in dom {
    var mini = 100000000: real;
    var wdom: domain(1);
    var wids: [wdom] int;
    for w in A.domain.dimIter(2,i) {
      wids.push_back(w);
      writeln("Witness in A from %n to %n".format(i,w));
    }
    writeln(wids);
    for w in BT.domain.dimIter(2,j) {
      wids.push_back(w);
      writeln("Witness in B from %n to %n".format(w,j));
    }
    writeln(wids);
    var wDom: domain(1);
    var witness: [wDom] real;
    for w in wids {
      if A(i,w) + BT(j,w) > 0 {
        witness.push_back(A(i,w) + BT(j,w));
      }
    }
    writeln("Witnesses are");
    writeln(witness);
    mini = min reduce witness;
    writeln("Minimum among witnesses is");
    writeln(mini);
    if mini < 1000000000 {
      T(i,j) = mini;
    }
  }
  return T;
}

/*
 Build a random sparse matrix.  Good for testing;
 */
proc generateRandomSparseMatrix(size: int, sparsity: real) {
  const D: domain(2) = {1..size, 1..size};
  var SD: sparse subdomain(D) dmapped CS();
  var R: [SD] real;
  var da: domain(1) = {1..size};
  var array: [da] int = 1..size;
  var dom: domain(1) = {1..0};
  var indices: [dom] 2*int;
  var N = floor(size*(1-sparsity)): int;
  forall i in array {
    forall j in array {
      indices.push_back((i,j));
    }
  }
  shuffle(indices);
  var sparseids = indices[1..N];
  SD.bulkAdd(sparseids);
  forall (i,j) in sparseids {
    R(i,j) = 1;
  }
  //ndices = zip(array1, array2)
  return R;
}

proc sparsity(X) {
  const d = X.shape[1]:real * X.shape[2]: real;
  var i: real = 0.0;
  for ij in X.domain {
    i += 1.0;
  }
  return i / d;
}

class NumSuchError : Error {
  proc init() {
    super.init();
    this.initDone();
  }
  proc message() {
    return "Generic NumSuch Error";
  }
}

class DimensionMatchError : NumSuchError {
  var expected: int,
      actual: int;

  proc init(expected: int, actual:int) {
    super.init();
    this.initDone();
    this.expected = expected;
    this.actual = actual;
  }

  proc message() {
    return "Error matching dimensions.  Expected: " + this.expected + " Actual: " + this.actual;
  }
}

use LinearAlgebra,
    LinearAlgebra.Sparse,
    NumSuch,
    Random;

config param batchsize = 10000;

/*
 A matrix of data with named rows and columns.
 */
class NamedMatrix {
  var D: domain(2),
      SD = CSRDomain(D),
      X: [SD] real,  // the actual data
      rows: BiMap = new BiMap(),
      cols: BiMap = new BiMap();

   proc init() {
     this.initDone(); // NAMEDMATRIX DOESNT EXPLICITLY INHERIT ANYTHING SO IS THIS NECESSARY??
   }

   proc init(X) {
     this.D = {X.domain.dim(1), X.domain.dim(2)};
     this.initDone();
     this.loadX(X);
   }

   proc init(X, names: [] string) {
     this.init(X);
     try! this.setRowNames(names);
     try! this.setColNames(names);
   }

   proc init(X, rownames: [] string, colnames: [] string) {
     this.init(X);
     try! this.setRowNames(rownames);
     try! this.setColNames(colnames);
   }

   proc init(rownames: [] string, colnames: [] string) {
     this.D = {1..rownames.size, 1..colnames.size};
     this.initDone();
     try! this.setRowNames(rownames);
     try! this.setColNames(colnames);
   }

   proc init(N: NamedMatrix) {
     this.init(N.X);
     this.rows = N.rows;
     this.cols = N.cols;
   }

   proc init(X, rows: BiMap, cols: BiMap) {
     this.init(X);
     this.rows = rows;
     this.cols = cols;
   }
}

/*
Returns the number of rows in the matrix frame
 */
proc NamedMatrix.nrows() {
  return X.domain.dim(1).size;
}

/*
Returns the number of columns in the matrix frame
 */
proc NamedMatrix.ncols() {
  return X.domain.dim(2).size;
}

/*
 Finds the max along the row indicated by row number
 */
proc NamedMatrix.rowMax(i: int) {
  var x:[1..0] real;
  for a in this.X.domain.dimIter(2,i) {
    x.push_back(this.get(i,a));
  }
  if x.size < 1 {
    writeln("uh-oh coach!");
    return NAN;
  } else {
    return max reduce x;
  }
}

/*
 Returns the max of each row
 */
proc NamedMatrix.rowMax() {
  var mxs: [1..this.nrows()] real;
  forall i in 1..this.nrows() {
    mxs[i] = this.rowMax(i);
  }
  return mxs;

}

/*
Loads the data from X into the internal array, also called X.  We call them all X to keep it clear.

:arg real[]: Array representing the matrix
 */
proc NamedMatrix.loadX(X:[], shape: 2*int =(-1,-1)) {
  if shape(1) > 0 && shape(2) > 0 {
    this.D = {1..shape(1), 1..shape(2)};
  }
  for (i,j) in X.domain {
    this.SD += (i,j);
    this.X(i,j) = X(i,j);
  }
}

/*
Sets the row names for the matrix X
 */
proc NamedMatrix.setRowNames(rn:[]): string throws {
  //if (X.domain.dim(1).size > 0) && (rn.size != X.domain.dim(1).size) {
  //if (1 > 0) && (rn.size != X.domain.dim(1).size) {
  if rn.size != X.domain.dim(1).size {
    const err = new DimensionMatchError(expected = X.domain.dim(1).size, actual=rn.size);
    throw err;
    return "";
  } else {
    for i in 1..rn.size {
      this.rows.add(rn[i]);
    }
    return this.rows;
  }
}

/*
Sets the column names for the matrix X
*/
proc NamedMatrix.setColNames(cn:[]): string throws {
  if cn.size != X.domain.dim(2).size then throw new Error();
  for i in 1..cn.size {
    this.cols.add(cn[i]);
  }
  return this.cols;
}

/*
 Gets the value of the (i,j) entry of the matrix X in the NamedMatrix
 */
proc NamedMatrix.get(i: int, j: int) {
   return this.X(i,j);
 }

 /*
 Get the values using the named rows and columns
  */
proc NamedMatrix.get(f: string, t: string) {
    return this.X(rows.get(f), cols.get(t));
 }

/*
 Set the value of this.X(i,j) by index row
 */
proc NamedMatrix.set(i: int, j: int, w: real) {
    if this.SD.member((i,j)) {
      this.X(i,j) = w;
    } else {
      this.SD += (i,j);
      this.X(i,j) = w;
    }
    return w;
}

/*
Set the values using the row and column names
*/
proc NamedMatrix.set(f: string, t: string, w: real) {
  return this.set(rows.get(f), cols.get(t), w);
}

/*
Update the value in X(i,j) with `w`
 */
proc NamedMatrix.update(i: int, j: int, w: real) {
  const x = this.get(i,j);
  return this.set(i,j, x + w);
}

/*
Update the value in X(i,j) with `w` using the row column names
 */
proc NamedMatrix.update(f: string, t: string, w: real) {
  const x = this.get(rows.get(f),cols.get(t));
  return this.set(rows.get(f),cols.get(t), x + w);
}

/*
Find the number of non-zeroes in the matrix
 */
proc NamedMatrix.nnz() {
  var i: int = 0;
  for ij in this.X.domain {
    i += 1;
  }
  return i;
}

/*
Calculates the sparsity of the matrix: Number of entries / frame size
 */
proc NamedMatrix.sparsity() {
  const d = this.X.shape[1]:real * this.X.shape[2]: real;
  return this.nnz():real / d;
}

/*
 Multiplies the current NamedMatrix `X` against the argument `Y`, but first it aligns
 the names of `X.cols` with `Y.rows`.  Returns an appropriately named NamedMatrix
 :arg NamedMatrix Y:
 */

proc NamedMatrix.ndot(N: NamedMatrix) {
  var C: NamedMatrix = new NamedMatrix(X = dot(this.X,N.X), this.rows, N.cols);
  return C;
}

proc NamedMatrix.alignAndMultiply(Y: NamedMatrix) {
    var rcOverlap: domain(string) = this.cols.keys & Y.rows.keys;

    var xSD: sparse subdomain(this.D) dmapped CS(),
        ySD: sparse subdomain(Y.D) dmapped CS(),
        xX: [xSD] real,  // the actual data
        yX: [ySD] real,  // the actual data
        xrows: BiMap = new BiMap(),
        yrows: BiMap = new BiMap(),
        xcols: BiMap = new BiMap(),
        ycols: BiMap = new BiMap();

    for (left_row, right_col) in zip(this.D.dim(2), Y.D.dim(1)) {
      for rc in rcOverlap {
        const j = this.cols.get(rc);
        if this.SD.member(left_row, j) {
          xSD += (left_row, j);
          xX[left_row, j] = this.X[left_row, j];
        }
        if Y.SD.member(j, right_col) {
          ySD += (j, right_col);
          yX[j, right_col] = Y.X[j, right_col];
        }
      }
    }
    const z = xX.dot(yX);
    var n = new NamedMatrix(X=z);
    n.rows = this.rows;
    n.cols = Y.cols;
    return n;
}

proc argmaxi(axis:int, id:int , X:[]) {
  var idm: (int,int),
      maximum: real = 0;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) > maximum {
        maximum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) > maximum {
        maximum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) > maximum {
        maximum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return maximum;
}

proc maxiloc(axis:int, id:int , X:[]) {
  var idm: (int,int),
      maximum: real = 0;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) > maximum {
        maximum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) > maximum {
        maximum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) > maximum {
        maximum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return idm;
}

proc argmini(axis:int, id:int , X:[]) {
  var idm: (int,int),
      minimum: real = 0;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) < minimum {
        minimum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) < minimum {
        minimum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) < minimum {
        minimum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return minimum;
}

proc miniloc(axis:int, id:int , X:[]) {
  var idm: (int,int),
      minimum: real = 0;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) < minimum {
        minimum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) < minimum {
        minimum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) < minimum {
        minimum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return idm;
}

proc tropic(A:[],B:[]) { // UNDER CONSTRUCTION
  writeln("Calculating Tropic Product");
  writeln("A is");
  writeln(A);
  writeln("With domain");
  writeln(A.domain);
  var dom: domain(2) = {A.domain.dim(1),B.domain.dim(2)};
  var sps = CSRDomain(dom);
  var BT = transpose(B);
  writeln("BT is");
  writeln(BT);
  writeln("With domain");
  writeln(BT.domain);
  writeln("Tropic will have entries in");
  writeln(dom);
  var T: [sps] real;
  for (i,j) in dom {
    var mini = 100000000: real;
    var wdom: domain(1);
    var wids: [wdom] int;
    for w in A.domain.dimIter(2,i) {
      wids.push_back(w);
      writeln("Witness in A from %n to %n".format(i,w));
    }
    writeln(wids);
    for w in BT.domain.dimIter(2,j) {
      wids.push_back(w);
      writeln("Witness in B from %n to %n".format(w,j));
    }
    writeln(wids);
    var wDom: domain(1);
    var witness: [wDom] real;
    for w in wids {
      if A(i,w) + BT(j,w) > 0 {
        witness.push_back(A(i,w) + BT(j,w));
      }
    }
    writeln("Witnesses are");
    writeln(witness);
    mini = min reduce witness;
    writeln("Minimum among witnesses is");
    writeln(mini);
    if mini < 1000000000 {
      T(i,j) = mini;
    }
  }
  return T;
}

/*
 Build a random sparse matrix.  Good for testing;
 */
proc generateRandomSparseMatrix(size: int, sparsity: real) {
  const D: domain(2) = {1..size, 1..size};
  var SD: sparse subdomain(D) dmapped CS();
  var R: [SD] real;
  var da: domain(1) = {1..size};
  var array: [da] int = 1..size;
  var dom: domain(1) = {1..0};
  var indices: [dom] 2*int;
  var N = floor(size*(1-sparsity)): int;
  forall i in array {
    forall j in array {
      indices.push_back((i,j));
    }
  }
  shuffle(indices);
  var sparseids = indices[1..N];
  SD.bulkAdd(sparseids);
  forall (i,j) in sparseids {
    R(i,j) = 1;
  }
  //ndices = zip(array1, array2)
  return R;
}

proc sparsity(X) {
  const d = X.shape[1]:real * X.shape[2]: real;
  var i: real = 0.0;
  for ij in X.domain {
    i += 1.0;
  }
  return i / d;
}

class NumSuchError : Error {
  proc init() {
    super.init();
    this.initDone();
  }
  proc message() {
    return "Generic NumSuch Error";
  }
}

class DimensionMatchError : NumSuchError {
  var expected: int,
      actual: int;

  proc init(expected: int, actual:int) {
    super.init();
    this.initDone();
    this.expected = expected;
    this.actual = actual;
  }

  proc message() {
    return "Error matching dimensions.  Expected: " + this.expected + " Actual: " + this.actual;
  }
}