/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 * Copyright 2018 - Matteo Ragni, Matteo Cocetti - University of Trento
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to deal
 * in the Software without restriction, including without limitation the rights
 * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 * copies of the Software, and to permit persons to whom the Software is
 * furnished to do so, subject to the following conditions:
 *
 * The above copyright notice and this permission notice shall be included in
 * all copies or substantial portions of the Software.
 *
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
 * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
 * SOFTWARE.
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

#ifndef LIBNEWTON_H_
#define LIBNEWTON_H_

#include <lapacke.h>
#include <cblas.h>

/**
 * @brief Jacobian Callback for the Newton algorithm
 *
 * The callback receivs the current input, the current control, and the list of
 * parameter vectors. It should store the first argument the Jacobian matrix (stored as an array).
 * To select the ordering in the matrix, you must select the correct ordering in newton_options
 * structure, at the ordering input.
 * @param df output vector (vectorized Jacobian matrix)
 * @param t current time for evaluation
 * @param x current point for evaluation
 * @param u current control for evaluation
 * @param p array of parameter vectors
 * @param data user space input (simply use it as a pointer casted to void)
 */
typedef void (*newton_jacobian)(
    double *df,
    const double t,
    const double *x,
    const double *u,
    const double **p,
    void *data);

/**
 * @brief Vector Field Callback for the Newton algorithm
 *
 * The callback receivs the current input, the current control, and the list of
 * parameter vectors. It should store the first argument the function output vector.
 * @param df output vector (vectorized Jacobian matrix)
 * @param t current time for evaluation
 * @param x current point for evaluation
 * @param u current control for evaluation
 * @param p array of parameter vectors
 * @param data user space input (simply use it as a pointer casted to void)
 */
typedef void (*newton_function)(
    double *f,
    const double t,
    const double *x,
    const double *u,
    const double **p,
    void *data);

/**
 * @brief Options for the Newton Algorithm
 *
 * This structure contains all the options for the Newton algorithm, alongside the callbacks.
 * The structure will be modified by the algorithm with some debug information, such as number
 * of iterations, tolerances and ordering for the jacobian matrix.
 */
typedef struct newton_options {
  lapack_int ordering; /**< Should be LAPACK_ROW_MAJOR or LAPACK_COL_MAJOR */
  lapack_int f_size;   /**< Vector field size */
  lapack_int x_size;   /**< Variable vector size */
  double f_tol;        /**< Stopping tolerance for the zero.
                              At the end will contain the 2 norm of the
                              vector field in the solution */
  double x_tol;        /**< Stopping tolerance for the x vector step.
                              At the end will contain the 2 norm of the last update step */
  lapack_int max_iter; /**< Maximum number of iteration,
                              At the end will contain the number of step executed  */
  newton_function f;   /**< Pointer to vector field callback */
  newton_jacobian df;  /**<  Pointer to Jacobian callback */
} newton_options;

/**
 * @brief Error code returned by the algorithm
 */
typedef enum newton_ret {
  NEWTON_F_TOL = 0,         /**< (0) The solver reached the required tolerance limit for the vector field */
  NEWTON_X_TOL,             /**< (1) The last step for solution update was less than the minimum */
  NEWTON_MAX_ITER,          /**< (2) Maximum number of iterations reached */
  NEWTON_SINGULAR_JACOBIAN, /**< (3 LAPACKE) The jacobian is singular */
  NEWTON_ILLEGAL_JACOBIAN,  /**< (4 LAPACKE) Illegal jacobian */
  NEWTON_MALLOC_ERROR,      /**< (5) Cannot allocate memory */
  NEWTON_GENERIC_ERROR      /**< (6) Generic error in the execution of the algorithm */
} newton_ret;

/**
 * @brief Boolean implementation
 */
typedef enum newton_bool {
  NEWTON_FALSE = 0, /**< False */
  NEWTON_TRUE       /**< True */
} newton_bool;

/**
 * @brief Executes the Newton algorithm for root finding
 *
 * Executes the Newton algorithm for root finding. The step Performed is:
 * \f{
 *   x_{k+1} - x_{k} = -\nabla F^{-1}(x_k, u, p) F(x_k, u, p)
 * \f}
 * and the solution is found by using DGELS defined in LAPACK library.
 * The stopping conditions are:
 *  * Number of iterations bigger than maximum allowed (specified in newton_options)
 *  * \f$ |x_{k+1} - x_k| \leq x_{tol}\f$
 *  * \f$ |f(x_k, u, p)| \leq y_{tol}\f$
 * and the function and jacobian are evaluated through callbacks. On exit, the values
 * inside the option structure are update for debuggin purposes (this is why Newton
 * options is not a const pointer). It returns a status enum.
 * @param opt option structure
 * @param x root position and initial condition. Will be modified
 * @param u control action input. It can be NULL.
 * @param p parameter array of vectors. It can be NULL.
 * @param data space for user data. Will be passed to callbacks. It can be NULL
 * @return a status exit code as described in newton_ret enum.
 */
newton_ret newton_solve(
    newton_options *opt,
    const double t,
    double *x,
    const double *u,
    const double **p,
    void *data);

#endif


// Copyright 2019 John McFarlane
//
// 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.

#ifndef WSS_BOARD_H
#define WSS_BOARD_H

#include "coord.h"
#include "grid.h"
#include "load_buffer.h"

#include <ssize.h>
#include <wss_assert.h>

#include <fmt/printf.h>
#include <gsl/string_span>

#include <array>
#include <optional>
#include <unordered_map>

template<typename T>
class board {
public:
    board(board&&) = default;

    explicit board(int init_edge)
            :edge{init_edge}, cells{std::make_unique<T[]>(edge*edge)} { }

    int size() const
    {
        return edge;
    }

    T const& cell(coord c) const
    {
        WSS_ASSERT(c[0]>=0);
        WSS_ASSERT(c[0]<edge);
        WSS_ASSERT(c[1]>=0);
        WSS_ASSERT(c[1]<edge);

        return cells.get()[c[0]+c[1]*edge];
    }

    T& cell(coord c)
    {
        WSS_ASSERT(c[0]>=0);
        WSS_ASSERT(c[0]<edge);
        WSS_ASSERT(c[1]>=0);
        WSS_ASSERT(c[1]<edge);

        return cells.get()[c[0]+c[1]*edge];
    }

private:
    int edge;
    std::unique_ptr<T[]> cells;
};

template<typename CellType, typename TextToCell>
std::optional<board<CellType>> make_board(
        std::vector<std::vector<char>> const& lines,
        TextToCell const& mapping)
{
    auto edge{ssize(lines)};
    board<CellType> result{int(edge)};

    for (auto row_index{0}; row_index!=edge; ++row_index) {
        auto const& line{lines[row_index]};
        auto const num_fields{ssize(line)};
        if (num_fields!=edge) {
            fmt::print(stderr,
                    "error: input row #{} has {} fields, expected {}.\n",
                    row_index+1, num_fields, edge);
            return std::nullopt;
        }

        for (auto column_index{0}; column_index!=edge; ++column_index) {
            auto const field{line[column_index]};
            auto const cell_found{mapping(field)};
            if (!cell_found) {
                fmt::print(
                        stderr,
                        "Unrecognised field, '{}', in row #{}, column #{}.\n",
						(char)field,
                        row_index+1, column_index+1);
                return std::nullopt;
            }

            result.cell(coord{column_index,row_index}) = *cell_found;
        }
    }

    return result;
}

template<typename CellType, typename TextToCell>
std::optional<board<CellType>> load_board(
        gsl::cstring_span<> filename,
        TextToCell const& mapping)
{
    auto const buffer{load_buffer(filename)};
    if (!buffer) {
        return std::nullopt;
    }

    auto const fields{parse_grid(*buffer)};

    return make_board<CellType>(fields, mapping);
}

template<typename T>
void transpose(board<T>& b)
{
    auto const edge = ssize(b);
    for (auto row = 0; row != edge; ++row)
    {
        for (auto column = 0; column != row; ++ column)
        {
            std::swap(b.cell(coord{column, row}), b.cell(coord{row, column}));
        }
    }
}

#endif //WSS_BOARD_H


/*******************************************************************************
*
*       This file is part of the General Hidden Markov Model Library,
*       GHMM version __VERSION__, see http://ghmm.org
*
*       Filename: ghmm/ghmm/randvar.c
*       Authors:  Bernhard Knab, Benjamin Rich, Janne Grunau
*
*       Copyright (C) 1998-2004 Alexander Schliep
*       Copyright (C) 1998-2001 ZAIK/ZPR, Universitaet zu Koeln
*       Copyright (C) 2002-2004 Max-Planck-Institut fuer Molekulare Genetik,
*                               Berlin
*
*       Contact: schliep@ghmm.org
*
*       This library is free software; you can redistribute it and/or
*       modify it under the terms of the GNU Library General Public
*       License as published by the Free Software Foundation; either
*       version 2 of the License, or (at your option) any later version.
*
*       This library is distributed in the hope that it will be useful,
*       but WITHOUT ANY WARRANTY; without even the implied warranty of
*       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
*       Library General Public License for more details.
*
*       You should have received a copy of the GNU Library General Public
*       License along with this library; if not, write to the Free
*       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*
*
*       This file is version $Revision: 2310 $
*                       from $Date: 2013-06-14 10:36:57 -0400 (Fri, 14 Jun 2013) $
*             last change by $Author: ejb177 $.
*
*******************************************************************************/

#ifdef HAVE_CONFIG_H
#  include "../config.h"
#endif

#include <math.h>
#include <float.h>
#include <string.h>
#ifdef HAVE_LIBPTHREAD
# include <pthread.h>
#endif /* HAVE_LIBPTHREAD */

#include "ghmm.h"
#include "mes.h"
#include "mprintf.h"
#include "randvar.h"
#include "rng.h"

#ifdef DO_WITH_GSL

# include <gsl/gsl_math.h>
# include <gsl/gsl_sf_erf.h>
# include <gsl/gsl_randist.h>

#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_blas.h>

#endif /* DO_WITH_GSL */

#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L)
#else
static double ighmm_erf (double x);
static double ighmm_erfc (double x);
#endif /* check for ISO C99 */

/* A list of already calculated values of the density function of a
   N(0,1)-distribution, with x in [0.00, 19.99] */
#define PDFLEN 2000
#define X_STEP_PDF 0.01         /* step size */
#define X_FAKT_PDF 100          /* equivalent to step size */
static double pdf_stdnormal[PDFLEN];
static int pdf_stdnormal_exists = 0;

/* A list of already calulated values PHI of the Gauss distribution is
   read in, x in [-9.999, 0] */
#define X_STEP_PHI 0.001        /* step size */
#define X_FAKT_PHI 1000         /* equivalent to step size */
static double x_PHI_1 = -1.0;

#ifndef M_SQRT1_2
#define M_SQRT1_2  0.70710678118654752440084436210
#endif

/*============================================================================*/
/* needed by ighmm_gtail_pmue_interpol */

double ighmm_rand_get_xfaktphi ()
{
  return X_FAKT_PHI;
}

double ighmm_rand_get_xstepphi ()
{
  return X_STEP_PHI;
}

double ighmm_rand_get_philen ()
{
#ifdef DO_WITH_GSL
  return 0 /*PHI_len*/;
#else
  return ighmm_rand_get_xPHIless1 () / X_STEP_PHI;
#endif
}

/*============================================================================*/
double ighmm_rand_get_PHI (double x)
{
#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L)
  return (erf (x * M_SQRT1_2) + 1.0) / 2.0;
#else
  return (ighmm_erf (x * M_SQRT1_2) + 1.0) / 2.0;
#endif
}                               /* randvar_get_PHI */

/*============================================================================*/
/* When is PHI[x,0,1] == 1? */
double ighmm_rand_get_xPHIless1 ()
{
# define CUR_PROC "ighmm_rand_get_xPHIless1"

  if (x_PHI_1 == -1) {
    double low, up, half;
    low = 0;
    up = 100;
    while (up - low > 0.001) {
      half = (low + up) / 2.0;
      if (ighmm_rand_get_PHI (half) < 1.0)
        low = half;
      else
        up = half;
    }
    x_PHI_1 = low;
  }
  return (x_PHI_1);

# undef CUR_PROC
}

/*============================================================================*/
double ighmm_rand_get_1overa (double x, double mean, double u)
{
  /* Calulates 1/a(x, mean, u), with a = the integral from x til \infty over
     the Gauss density function */
# define CUR_PROC "ighmm_rand_get_1overa"

  double erfc_value;

  if (u <= 0.0) {
    GHMM_LOG(LCONVERTED, "u <= 0.0 not allowed\n");
    goto STOP;
  }

#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L)
  erfc_value = erfc ((x - mean) / sqrt (u * 2));
#else
  erfc_value = ighmm_erfc ((x - mean) / sqrt (u * 2));
#endif

  if (erfc_value <= DBL_MIN) {
    ighmm_mes (MES_WIN, "a ~= 0.0 critical! (mue = %.2f, u =%.2f)\n", mean, u);
    return (erfc_value);
  }
  else
    return (2.0 / erfc_value);

STOP:
  return (-1.0);
# undef CUR_PROC
}                               /* ighmm_rand_get_1overa */

/*============================================================================*/
/* REMARK:
   The calulation of this density function was testet, by calculating the
   following integral sum for arbitrary mue and u:
     for (x = 0, x < ..., x += step(=0.01/0.001/0.0001))
       isum += step * ighmm_rand_normal_density_pos(x, mue, u);
   In each case, the sum "converged" evidently towards 1!
   (BK, 14.6.99)
   CHANGE:
   Truncate at -EPS_NDT (const.h), so that x = 0 doesn't lead to a problem.
   (BK, 15.3.2000)
*/
double ighmm_rand_normal_density_pos (double x, double mean, double u)
{
# define CUR_PROC "ighmm_rand_normal_density_pos"
  return ighmm_rand_normal_density_trunc (x, mean, u, -GHMM_EPS_NDT);
# undef CUR_PROC
}                               /* double ighmm_rand_normal_density_pos */

/*============================================================================*/
double ighmm_rand_normal_density_trunc(double x, double mean, double u,
                                       double a)
{
# define CUR_PROC "ighmm_rand_normal_density_trunc"
#ifndef DO_WITH_GSL
  double c;
#endif /* DO_WITH_GSL */

  if (u <= 0.0) {
    GHMM_LOG(LERROR, "u <= 0.0 not allowed");
    goto STOP;
  }
  if (x < a)
    return 0.0;

#ifdef DO_WITH_GSL
  /* move mean to the right position */
  return gsl_ran_gaussian_tail_pdf(x - mean, a - mean, sqrt(u));
#else
  if ((c = ighmm_rand_get_1overa(a, mean, u)) == -1) {
    GHMM_LOG_QUEUED(LERROR);
    goto STOP;
  };
  return c * ighmm_rand_normal_density(x, mean, u);
#endif /* DO_WITH_GSL */

STOP:
  return -1.0;
# undef CUR_PROC
}                               /* double ighmm_rand_normal_density_trunc */

/*============================================================================*/
double ighmm_rand_normal_density (double x, double mean, double u)
{
# define CUR_PROC "ighmm_rand_normal_density"
#ifndef DO_WITH_GSL
  double expo;
#endif
  if (u <= 0.0) {
    GHMM_LOG(LCONVERTED, "u <= 0.0 not allowed\n");
    goto STOP;
  }
  /* The denominator is possibly < EPS??? Check that ? */
#ifdef DO_WITH_GSL
  /* double gsl_ran_gaussian_pdf (double x, double sigma) */
  return gsl_ran_gaussian_pdf (x - mean, sqrt (u));
#else
  expo = exp (-1 * m_sqr (mean - x) / (2 * u));
  return (1 / (sqrt (2 * PI * u)) * expo);
#endif

STOP:
  return (-1.0);
# undef CUR_PROC
}                               /* double ighmm_rand_normal_density */

/*============================================================================*/
/* covariance matrix is linearized */
double ighmm_rand_binormal_density(const double *x, double *mean, double *cov)
{
# define CUR_PROC "ighmm_rand_binormal_density"
  double rho;
#ifndef DO_WITH_GSL
  double numerator,part1,part2,part3;
#endif
  if (cov[0] <= 0.0 || cov[2 + 1] <= 0.0) {
    GHMM_LOG(LCONVERTED, "variance <= 0.0 not allowed\n");
    goto STOP;
  }
  rho = cov[1] / ( sqrt (cov[0]) * sqrt (cov[2 + 1]) );
  /* The denominator is possibly < EPS??? Check that ? */
#ifdef DO_WITH_GSL
  /* double gsl_ran_bivariate_gaussian_pdf (double x, double y, double sigma_x,
                                            double sigma_y, double rho) */
  return gsl_ran_bivariate_gaussian_pdf (x[0], x[1], sqrt (cov[0]),
                                         sqrt (cov[2 + 1]), rho);
#else
  part1 = (x[0] - mean[0]) / sqrt (cov[0]);
  part2 = (x[1] - mean[1]) / sqrt (cov[2 + 1]);
  part3 = m_sqr (part1) - 2 * part1 * part2 + m_sqr (part2);
  numerator = exp ( -1 * (part3) / ( 2 * (1 - m_sqr(rho)) ) );
  return (numerator / ( 2 * PI * sqrt(1 - m_sqr(rho)) ));
#endif

STOP:
  return (-1.0);
# undef CUR_PROC
}                               /* double ighmm_rand_binormal_density */

/*============================================================================*/
/* matrices are linearized */
double ighmm_rand_multivariate_normal_density(int length, const double *x, double *mean, double *sigmainv, double det)
{
# define CUR_PROC "ighmm_rand_multivariate_normal_density"
  /* multivariate normal density function    */
  /*
   *       length     dimension of the random vetor
   *       x          point at which to evaluate the pdf
   *       mean       vector of means of size n
   *       sigmainv   inverse variance matrix of dimension n x n
   *       det        determinant of covariance matrix
   */

#ifdef DO_WITH_GSL
  int i, j;
  double ax,ay;
  gsl_vector *ym, *xm, *gmean;
  gsl_matrix *inv = gsl_matrix_alloc(length, length);

  for (i=0; i<length; ++i) {
    for (j=0; j<length; ++j) {
      gsl_matrix_set(inv, i, j, sigmainv[i*length+j]);
    }
  }

  xm = gsl_vector_alloc(length);
  gmean = gsl_vector_alloc(length);
  /*gsl_vector_memcpy(xm, x);*/
  for (i=0; i<length; ++i) {
    gsl_vector_set(xm, i, x[i]);
    gsl_vector_set(gmean, i, mean[i]);
  }

  gsl_vector_sub(xm, gmean);
  ym = gsl_vector_alloc(length);
  gsl_blas_dsymv(CblasUpper, 1.0, inv, xm, 0.0, ym);
  gsl_matrix_free(inv);
  gsl_blas_ddot(xm, ym, &ay);
  gsl_vector_free(xm);
  gsl_vector_free(ym);
  ay = exp(-0.5*ay) / sqrt(pow((2*M_PI), length) * det);

  return ay;
#else
  /* do without GSL */
  int i, j;
  double ay, tempv;

  ay = 0;
  for (i=0; i<length; ++i) {
    tempv = 0;
    for (j=0; j<length; ++j) {
      tempv += (x[j]-mean[j])*sigmainv[j*length+i];
    }
    ay += tempv*(x[i]-mean[i]);
  }
  ay = exp(-0.5*ay) / sqrt(pow((2*PI), length) * det);

  return ay;
#endif
# undef CUR_PROC
}                               /* double ighmm_rand_multivariate_normal_density */

/*============================================================================*/
double ighmm_rand_uniform_density (double x, double max, double min)
{
# define CUR_PROC "ighmm_rand_uniform_density"
  double prob;
  if (max <= min) {
    GHMM_LOG(LCONVERTED, "max <= min not allowed \n");
    goto STOP;
  }
  prob = 1.0/(max-min);

  if ( (x <= max) && (x>=min) ){
    return prob;
  }else{
    return 0.0;
  }
STOP:
  return (-1.0);
# undef CUR_PROC
}                               /* double ighmm_rand_uniform_density */

/*============================================================================*/
/* special ghmm_cmodel pdf need it: smo->density==normal_approx: */
/* generates a table of of aequidistant samples of gaussian pdf */

static int randvar_init_pdf_stdnormal ()
{
# define CUR_PROC "randvar_init_pdf_stdnormal"
  int i;
  double x = 0.00;
  for (i = 0; i < PDFLEN; i++) {
    pdf_stdnormal[i] = 1 / (sqrt (2 * PI)) * exp (-1 * x * x / 2);
    x += (double) X_STEP_PDF;
  }
  pdf_stdnormal_exists = 1;
  /* printf("pdf_stdnormal_exists = %d\n", pdf_stdnormal_exists); */
  return (0);
# undef CUR_PROC
}                               /* randvar_init_pdf_stdnormal */

double ighmm_rand_normal_density_approx (double x, double mean, double u)
{
# define CUR_PROC "ighmm_rand_normal_density_approx"
#ifdef HAVE_LIBPTHREAD
  static pthread_mutex_t lock;
#endif /* HAVE_LIBPTHREAD */
  int i;
  double y, z, pdf_x;
  if (u <= 0.0) {
    GHMM_LOG(LCONVERTED, "u <= 0.0 not allowed\n");
    goto STOP;
  }
  if (!pdf_stdnormal_exists) {
#ifdef HAVE_LIBPTHREAD
    pthread_mutex_lock (&lock); /* Put on a lock, because the clustering is parallel   */
#endif /* HAVE_LIBPTHREAD */
    randvar_init_pdf_stdnormal ();
#ifdef HAVE_LIBPTHREAD
    pthread_mutex_unlock (&lock);       /* Take the lock off */
#endif /* HAVE_LIBPTHREAD */
  }
  y = 1 / sqrt (u);
  z = fabs ((x - mean) * y);
  i = (int) (z * X_FAKT_PDF);
  /* linear interpolation: */
  if (i >= PDFLEN - 1) {
    i = PDFLEN - 1;
    pdf_x = y * pdf_stdnormal[i];
  }
  else
    pdf_x = y * (pdf_stdnormal[i] +
                 (z - i * X_STEP_PDF) *
                 (pdf_stdnormal[i + 1] - pdf_stdnormal[i]) / X_STEP_PDF);
  return (pdf_x);
STOP:
  return (-1.0);
# undef CUR_PROC
}                               /* double ighmm_rand_normal_density_approx */
double ighmm_rand_dirichlet(int seed, int len, double *alpha, double *theta){
  if (seed != 0) {
    GHMM_RNG_SET(RNG, seed);
  }
#ifdef DO_WITH_GSL
   gsl_ran_dirichlet(RNG, len, alpha, theta);
#else
  printf("not implemted without gsl. Compile with gsl to use dirichlet");
#endif
}

/*============================================================================*/
double ighmm_rand_std_normal (int seed)
{
# define CUR_PROC "ighmm_rand_std_normal"
  if (seed != 0) {
    GHMM_RNG_SET (RNG, seed);
  }

#ifdef DO_WITH_GSL
    return (gsl_ran_gaussian (RNG, 1.0));
#else
    /* Use the polar Box-Mueller transform */
    /*
       double x, y, r2;

       do {
       x = 2.0 * GHMM_RNG_UNIFORM(RNG) - 1.0;
       y = 2.0 * GHMM_RNG_UNIFORM(RNG) - 1.0;
       r2 = (x * x) + (y * y);
       } while (r2 >= 1.0);

       return x * sqrt((-2.0 * log(r2)) / r2);
     */

    double r2, theta;

    r2 = -2.0 * log (GHMM_RNG_UNIFORM (RNG));   /* r2 ~ chi-square(2) */
    theta = 2.0 * PI * GHMM_RNG_UNIFORM (RNG);  /* theta ~ uniform(0, 2 \pi) */
    return sqrt (r2) * cos (theta);
#endif

# undef CUR_PROC
}                               /* ighmm_rand_std_normal */

/*============================================================================*/
double ighmm_rand_normal(double mue, double u, int seed)
{
# define CUR_PROC "ighmm_rand_normal"
  if (seed != 0) {
    GHMM_RNG_SET(RNG, seed);
  }

#ifdef DO_WITH_GSL
    return gsl_ran_gaussian(RNG, sqrt (u)) + mue;
#else
    double x;
    x = sqrt(u) * ighmm_rand_std_normal(seed) + mue;
    return x;
#endif

# undef CUR_PROC
}                               /* ighmm_rand_normal */

/*============================================================================*/
int ighmm_rand_multivariate_normal (int dim, double *x, double *mue, double *sigmacd, int seed)
{
# define CUR_PROC "ighmm_rand_multivariate_normal"
  /* generate random vector of multivariate normal
   *
   *     dim     number of dimensions
   *     x       space to store resulting vector in
   *     mue     vector of means
   *     sigmacd linearized cholesky decomposition of cov matrix
   *     seed    RNG seed
   *
   *     see Barr & Slezak, A Comparison of Multivariate Normal Generators */
  int i, j;
#ifdef DO_WITH_GSL
  gsl_vector *y = gsl_vector_alloc(dim);
  gsl_vector *xgsl = gsl_vector_alloc(dim);
  gsl_matrix *cd = gsl_matrix_alloc(dim, dim);
#endif
  if (seed != 0) {
    GHMM_RNG_SET (RNG, seed);
    /* do something here */
    return 0;
  }
  else {
#ifdef DO_WITH_GSL
    /* cholesky decomposition matrix */
    for (i=0;i<dim;i++) {
      for (j=0;j<dim;j++) {
        gsl_matrix_set(cd, i, j, sigmacd[i*dim+j]);
      }
    }
    /* generate a random vector N(O,I) */
    for (i=0;i<dim;i++) {
      gsl_vector_set(y, i, ighmm_rand_std_normal(seed));
    }
    /* multiply cd with y */
    gsl_blas_dgemv(CblasNoTrans, 1.0, cd, y, 0.0, xgsl);
    for (i=0;i<dim;i++) {
      x[i] = gsl_vector_get(xgsl, i) + mue[i];
    }
    gsl_vector_free(y);
    gsl_vector_free(xgsl);
    gsl_matrix_free(cd);
#else
    /* multivariate random numbers without gsl */
    double randuni;
    for (i=0;i<dim;i++) {
      randuni = ighmm_rand_std_normal(seed);
      for (j=0;j<dim;j++) {
        if (i==0)
          x[j] = mue[j];
        x[j] += randuni * sigmacd[j*dim+i];
      }
    }
#endif
    return 0;
  }
# undef CUR_PROC
}                               /* ighmm_rand_multivariate_normal */

/*============================================================================*/
#ifndef DO_WITH_GSL
# define C0 2.515517
# define C1 0.802853
# define C2 0.010328
# define D1 1.432788
# define D2 0.189269
# define D3 0.001308
#endif

double ighmm_rand_normal_right (double a, double mue, double u, int seed)
{
# define CUR_PROC "ighmm_rand_normal_right"
  double x = -1;
  double sigma;
#ifdef DO_WITH_GSL
  double s;
#else
  double U, Us, Us1, Feps, t, T;
#endif

  if (u <= 0.0) {
    GHMM_LOG(LCONVERTED, "u <= 0.0 not allowed\n");
    goto STOP;
  }
  sigma = sqrt(u);

  if (seed != 0) {
    GHMM_RNG_SET (RNG, seed);
  }

#ifdef DO_WITH_GSL
  /* move boundary to lower values in order to achieve maximum at mue
     gsl_ran_gaussian_tail(generator, lower_boundary, sigma)
   */
  return mue + gsl_ran_gaussian_tail(RNG, a - mue, sqrt (u));

#else /* DO_WITH_GSL */

  /* Inverse transformation with restricted sampling by Fishman */
  U = GHMM_RNG_UNIFORM(RNG);
  Feps = ighmm_rand_get_PHI((a-mue) / sigma);

  Us = Feps + (1-Feps) * U;
  Us1 = 1-Us;
  t = m_min (Us, Us1);

  t = sqrt (-log (t * t));

  T =
    sigma * (t - (C0 + t * (C1 + t * C2))
                 / (1 + t * (D1 + t * (D2 + t * D3))));

  if (Us < Us1)
    x = mue - T;
  else
    x = mue + T;
#endif /* DO_WITH_GSL */

STOP:
  return x;
# undef CUR_PROC
}                               /* randvar_normal_pos */

/*============================================================================*/
double ighmm_rand_uniform_int (int seed, int K)
{
# define CUR_PROC "ighmm_rand_uniform_int"
  if (seed != 0) {
    GHMM_RNG_SET (RNG, seed);
  }

#ifdef DO_WITH_GSL
    /* more direct solution than old version ! */
    return (double) gsl_rng_uniform_int (RNG, K);
#else
    return (double) ((int) (((double) K) * GHMM_RNG_UNIFORM (RNG)));
#endif

# undef CUR_PROC
}                               /* ighmm_rand_uniform_int */

/*===========================================================================*/
double ighmm_rand_uniform_cont (int seed, double max, double min)
{
# define CUR_PROC "ighmm_rand_uniform_cont"
  if (max <= min) {
    GHMM_LOG(LCONVERTED, "max <= min not allowed\n");
    goto STOP;
  }
  if (seed != 0) {
    GHMM_RNG_SET (RNG, seed);
  }

#ifdef DO_WITH_GSL
    return (double)(((double)gsl_rng_uniform (RNG)*(max-min)) + min);
#else
    return (double)((GHMM_RNG_UNIFORM (RNG))*(max-min) + min );
#endif

STOP:
  return (-1.0);
# undef CUR_PROC
}                               /* ighmm_rand_uniform_cont */

/*============================================================================*/
/* cumalative distribution function of N(mean, u) */
double ighmm_rand_normal_cdf (double x, double mean, double u)
{
# define CUR_PROC "ighmm_rand_normal_cdf"
  if (u <= 0.0) {
    GHMM_LOG(LCONVERTED, "u <= 0.0 not allowed\n");
    goto STOP;
  }
#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L)
  /* PHI(x)=erf(x/sqrt(2))/2+0.5 */
  return (erf ((x - mean) / sqrt (u * 2.0)) + 1.0) / 2.0;
#else
  return (ighmm_erf ((x - mean) / sqrt (u * 2.0)) + 1.0) / 2.0;
#endif /* Check for ISO C99 */
STOP:
  return (-1.0);
# undef CUR_PROC
}                               /* double ighmm_rand_normal_cdf */

/*============================================================================*/
/* cumalative distribution function of a-truncated N(mean, u) */
double ighmm_rand_normal_right_cdf (double x, double mean, double u, double a)
{
# define CUR_PROC "ighmm_rand_normal_right_cdf"

  if (x <= a)
    return (0.0);
  if (u <= a) {
    GHMM_LOG(LCONVERTED, "u <= a not allowed\n");
    goto STOP;
  }
#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L)
  /*
     Function: int erfc (double x, gsl_sf_result * result)
     These routines compute the complementary error function
     erfc(x) = 1 - erf(x) = 2/\sqrt(\pi) \int_x^\infty \exp(-t^2).
   */
  return 1.0 + (erf ((x - mean) / sqrt (u * 2)) -
                1.0) / erfc ((a - mean) / sqrt (u * 2));
#else
  return 1.0 + (ighmm_erf ((x - mean) / sqrt (u * 2)) -
                1.0) / ighmm_erfc ((a - mean) / sqrt (u * 2));
#endif /* Check for ISO C99 */
STOP:
  return (-1.0);
# undef CUR_PROC
}                               /* double ighmm_rand_normal_cdf */

/*============================================================================*/
/* cumalative distribution function of a uniform distribution in the range [min,max] */
double ighmm_rand_uniform_cdf (double x, double max, double min)
{
# define CUR_PROC "ighmm_rand_uniform_cdf"
  if (max <= min) {
    GHMM_LOG(LCONVERTED, "max <= min not allowed\n");
    goto STOP;
  }
  if (x < min) {
    return 0.0;
  }
  if (x >= max) {
    return 1.0;
  }
  return (x-min)/(max-min);
STOP:
  return (-1.0);
# undef CUR_PROC
}                               /* ighmm_rand_uniform_cdf */

#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L)
#else

/* THIS WILL BE OBSOLETE WHEN WE USE ISO C99 */

/*===========================================================================
 *
 * The following functions for the error function and the complementory
 * error function are taken from
 * http://www.mathematik.uni-bielefeld.de/~sillke/ALGORITHMS/special-functions/erf.c
 * and have following different copyright.

 * ====================================================
 * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
 *
 * Developed at SunPro, a Sun Microsystems, Inc. business.
 * Permission to use, copy, modify, and distribute this
 * software is freely granted, provided that this notice
 * is preserved.
 * ====================================================
 */

/*
 * ====================================================
 *
 * Reference:
 *
 * W. J. Cody,
 *   Rational Chebychev approximations for the
 *   error function.
 *   Mathematics of Computations 23 (1969) 631-637
 *
 * W. J. Cody,
 *   Performance evaluations of programs for the
 *   error and complementary error function.
 *   Transactions of the ACM on Mathematical Software,
 *   16:1 (March 1990) 38-46
 *
 * W. J. Cody,
 *   SPECFUN - A portable special function package,
 *   In: New Computing environments;
 *   Microcomputers in Large-Scale Scientific Computing,
 *   A. Wouk, SIAM, 1987, 1-12
 *
 * W. J. Cody,
 *   http://www.netlib.org/specfun/erf.
 *
 * For calculations with complex arguments see:
 *
 * Walter Gautschi
 *   "Efficient computation of the complex error function"
 *   SIAM J. Numer. Anal.
 *   7:1 (1970), 187-198
 *
 * J.A.C. Weideman
 *   "Computation of the complex error function"
 *   SIAM J. Numer. Anal.
 *   31:5 (1994), 1497-1518
 *
 * ====================================================
 */

/* double erf(double x)
 * double erfc(double x)
 *			     x
 *		      2      |\
 *     erf(x)  =  ---------  | exp(-t*t)dt
 *	 	   sqrt(pi) \|
 *			     0
 *
 *     erfc(x) =  1-erf(x)
 *  Note that
 *		erf(-x) = -erf(x)
 *		erfc(-x) = 2 - erfc(x)
 *
 * Method:
 *	1. For |x| in [0, 0.84375]
 *	    erf(x)  = x + x*R(x^2)
 *          erfc(x) = 1 - erf(x)           if x in [-.84375,0.25]
 *                  = 0.5 + ((0.5-x)-x*R)  if x in [0.25,0.84375]
 *	   where R = P/Q where P is an odd poly of degree 8 and
 *	   Q is an odd poly of degree 10.
 *						 -57.90
 *			| R - (erf(x)-x)/x | <= 2
 *
 *
 *	   Remark. The formula is derived by noting
 *          erf(x) = (2/sqrt(pi))*(x - x^3/3 + x^5/10 - x^7/42 + ....)
 *	   and that
 *          2/sqrt(pi) = 1.128379167095512573896158903121545171688
 *	   is close to one. The interval is chosen because the fix
 *	   point of erf(x) is near 0.6174 (i.e., erf(x)=x when x is
 *	   near 0.6174), and by some experiment, 0.84375 is chosen to
 * 	   guarantee the error is less than one ulp for erf.
 *
 *      2. For |x| in [0.84375,1.25], let s = |x| - 1, and
 *         c = 0.84506291151 rounded to single (24 bits)
 *         	erf(x)  = sign(x) * (c  + P1(s)/Q1(s))
 *         	erfc(x) = (1-c)  - P1(s)/Q1(s) if x > 0
 *			  1+(c+P1(s)/Q1(s))    if x < 0
 *         	|P1/Q1 - (erf(|x|)-c)| <= 2**-59.06
 *	   Remark: here we use the taylor series expansion at x=1.
 *		erf(1+s) = erf(1) + s*Poly(s)
 *			 = 0.845.. + P1(s)/Q1(s)
 *	   That is, we use rational approximation to approximate
 *			erf(1+s) - (c = (single)0.84506291151)
 *	   Note that |P1/Q1|< 0.078 for x in [0.84375,1.25]
 *	   where
 *		P1(s) = degree 6 poly in s
 *		Q1(s) = degree 6 poly in s
 *
 *      3. For x in [1.25,1/0.35(~2.857143)],
 *         	erfc(x) = (1/x)*exp(-x*x-0.5625+R1/S1)
 *         	erf(x)  = 1 - erfc(x)
 *	   where
 *		R1(z) = degree 7 poly in z, (z=1/x^2)
 *		S1(z) = degree 8 poly in z
 *
 *      4. For x in [1/0.35,28]
 *         	erfc(x) = (1/x)*exp(-x*x-0.5625+R2/S2) if x > 0
 *			= 2.0 - (1/x)*exp(-x*x-0.5625+R2/S2) if -6<x<0
 *			= 2.0 - tiny		(if x <= -6)
 *         	erf(x)  = sign(x)*(1.0 - erfc(x)) if x < 6, else
 *         	erf(x)  = sign(x)*(1.0 - tiny)
 *	   where
 *		R2(z) = degree 6 poly in z, (z=1/x^2)
 *		S2(z) = degree 7 poly in z
 *
 *      Note1:
 *	   To compute exp(-x*x-0.5625+R/S), let s be a single
 *	   precision number and s := x; then
 *		-x*x = -s*s + (s-x)*(s+x)
 *	        exp(-x*x-0.5626+R/S) =
 *			exp(-s*s-0.5625)*exp((s-x)*(s+x)+R/S);
 *      Note2:
 *	   Here 4 and 5 make use of the asymptotic series
 *			  exp(-x*x)
 *		erfc(x) ~ ---------- * ( 1 + Poly(1/x^2) )
 *			  x*sqrt(pi)
 *	   We use rational approximation to approximate
 *      	g(s)=f(1/x^2) = log(erfc(x)*x) - x*x + 0.5625
 *	   Here is the error bound for R1/S1 and R2/S2
 *      	|R1/S1 - f(x)|  < 2**(-62.57)
 *      	|R2/S2 - f(x)|  < 2**(-61.52)
 *
 *      5. For inf > x >= 28
 *         	erf(x)  = sign(x) *(1 - tiny)  (raise inexact)
 *         	erfc(x) = tiny*tiny (raise underflow) if x > 0
 *			= 2 - tiny if x<0
 *
 *      7. Special case:
 *         	erf(0)  = 0, erf(inf)  = 1, erf(-inf) = -1,
 *         	erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2,
 *	   	erfc/erf(NaN) is NaN
 */

static const double

tiny =  1e-300,
half =  5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
one  =  1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
two  =  2.00000000000000000000e+00, /* 0x40000000, 0x00000000 */

erx  =  8.45062911510467529297e-01, /* 0x3FEB0AC1, 0x60000000 */
/*
 * Coefficients for approximation to  erf on [0,0.84375]
 */
efx  =  1.28379167095512586316e-01, /* 0x3FC06EBA, 0x8214DB69 */
efx8 =  1.02703333676410069053e+00, /* 0x3FF06EBA, 0x8214DB69 */
pp0  =  1.28379167095512558561e-01, /* 0x3FC06EBA, 0x8214DB68 */
pp1  = -3.25042107247001499370e-01, /* 0xBFD4CD7D, 0x691CB913 */
pp2  = -2.84817495755985104766e-02, /* 0xBF9D2A51, 0xDBD7194F */
pp3  = -5.77027029648944159157e-03, /* 0xBF77A291, 0x236668E4 */
pp4  = -2.37630166566501626084e-05, /* 0xBEF8EAD6, 0x120016AC */
qq1  =  3.97917223959155352819e-01, /* 0x3FD97779, 0xCDDADC09 */
qq2  =  6.50222499887672944485e-02, /* 0x3FB0A54C, 0x5536CEBA */
qq3  =  5.08130628187576562776e-03, /* 0x3F74D022, 0xC4D36B0F */
qq4  =  1.32494738004321644526e-04, /* 0x3F215DC9, 0x221C1A10 */
qq5  = -3.96022827877536812320e-06, /* 0xBED09C43, 0x42A26120 */
/*
 * Coefficients for approximation to  erf  in [0.84375,1.25]
 */
pa0  = -2.36211856075265944077e-03, /* 0xBF6359B8, 0xBEF77538 */
pa1  =  4.14856118683748331666e-01, /* 0x3FDA8D00, 0xAD92B34D */
pa2  = -3.72207876035701323847e-01, /* 0xBFD7D240, 0xFBB8C3F1 */
pa3  =  3.18346619901161753674e-01, /* 0x3FD45FCA, 0x805120E4 */
pa4  = -1.10894694282396677476e-01, /* 0xBFBC6398, 0x3D3E28EC */
pa5  =  3.54783043256182359371e-02, /* 0x3FA22A36, 0x599795EB */
pa6  = -2.16637559486879084300e-03, /* 0xBF61BF38, 0x0A96073F */
qa1  =  1.06420880400844228286e-01, /* 0x3FBB3E66, 0x18EEE323 */
qa2  =  5.40397917702171048937e-01, /* 0x3FE14AF0, 0x92EB6F33 */
qa3  =  7.18286544141962662868e-02, /* 0x3FB2635C, 0xD99FE9A7 */
qa4  =  1.26171219808761642112e-01, /* 0x3FC02660, 0xE763351F */
qa5  =  1.36370839120290507362e-02, /* 0x3F8BEDC2, 0x6B51DD1C */
qa6  =  1.19844998467991074170e-02, /* 0x3F888B54, 0x5735151D */
/*
 * Coefficients for approximation to  erfc in [1.25,1/0.35]
 */
ra0  = -9.86494403484714822705e-03, /* 0xBF843412, 0x600D6435 */
ra1  = -6.93858572707181764372e-01, /* 0xBFE63416, 0xE4BA7360 */
ra2  = -1.05586262253232909814e+01, /* 0xC0251E04, 0x41B0E726 */
ra3  = -6.23753324503260060396e+01, /* 0xC04F300A, 0xE4CBA38D */
ra4  = -1.62396669462573470355e+02, /* 0xC0644CB1, 0x84282266 */
ra5  = -1.84605092906711035994e+02, /* 0xC067135C, 0xEBCCABB2 */
ra6  = -8.12874355063065934246e+01, /* 0xC0545265, 0x57E4D2F2 */
ra7  = -9.81432934416914548592e+00, /* 0xC023A0EF, 0xC69AC25C */
sa1  =  1.96512716674392571292e+01, /* 0x4033A6B9, 0xBD707687 */
sa2  =  1.37657754143519042600e+02, /* 0x4061350C, 0x526AE721 */
sa3  =  4.34565877475229228821e+02, /* 0x407B290D, 0xD58A1A71 */
sa4  =  6.45387271733267880336e+02, /* 0x40842B19, 0x21EC2868 */
sa5  =  4.29008140027567833386e+02, /* 0x407AD021, 0x57700314 */
sa6  =  1.08635005541779435134e+02, /* 0x405B28A3, 0xEE48AE2C */
sa7  =  6.57024977031928170135e+00, /* 0x401A47EF, 0x8E484A93 */
sa8  = -6.04244152148580987438e-02, /* 0xBFAEEFF2, 0xEE749A62 */
/*
 * Coefficients for approximation to  erfc in [1/.35,28]
 */
rb0  = -9.86494292470009928597e-03, /* 0xBF843412, 0x39E86F4A */
rb1  = -7.99283237680523006574e-01, /* 0xBFE993BA, 0x70C285DE */
rb2  = -1.77579549177547519889e+01, /* 0xC031C209, 0x555F995A */
rb3  = -1.60636384855821916062e+02, /* 0xC064145D, 0x43C5ED98 */
rb4  = -6.37566443368389627722e+02, /* 0xC083EC88, 0x1375F228 */
rb5  = -1.02509513161107724954e+03, /* 0xC0900461, 0x6A2E5992 */
rb6  = -4.83519191608651397019e+02, /* 0xC07E384E, 0x9BDC383F */
sb1  =  3.03380607434824582924e+01, /* 0x403E568B, 0x261D5190 */
sb2  =  3.25792512996573918826e+02, /* 0x40745CAE, 0x221B9F0A */
sb3  =  1.53672958608443695994e+03, /* 0x409802EB, 0x189D5118 */
sb4  =  3.19985821950859553908e+03, /* 0x40A8FFB7, 0x688C246A */
sb5  =  2.55305040643316442583e+03, /* 0x40A3F219, 0xCEDF3BE6 */
sb6  =  4.74528541206955367215e+02, /* 0x407DA874, 0xE79FE763 */
sb7  = -2.24409524465858183362e+01; /* 0xC03670E2, 0x42712D62 */

static double ighmm_erf (double x) {
  double R,S,P,Q,s,y,z,r;
  double ax = fabs(x);
#ifdef HAVE_IEEE754
  if (!isfinite(x)) {
    if (isnan(x)) return x;     /* erf(nan)=nan */
    return (x==ax) ? 1 : -1;	/* erf(+-inf)=+-1 */
  }
#endif
  if (ax < 0.84375) {		/* |x|<0.84375 */
    if (ax < 3.7252903e-9) { 	/* |x|<2**-28 */
      if (ax < tiny)
	return 0.125*(8.0*x+efx8*x);  /*avoid underflow */
      return x + efx*x;
    }
    z = x*x;
    r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
    s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
    y = r/s;
    return x + x*y;
  }
  if (ax < 1.25) {			/* 0.84375 <= |x| < 1.25 */
    s = ax-one;
    P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6)))));
    Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6)))));
    if (x>=0) return erx + P/Q;
    else return -erx - P/Q;
  }
  if (ax >= 6.0) {		/* inf>|x|>=6 */
    if (x>=0) return one-tiny;
    else return tiny-one;
  }
  s = one/(x*x);
  if (ax < 2.857142857) {	/* |x| < 1/0.35 */
    R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*(ra5+s*(ra6+s*ra7))))));
    S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*(sa5+s*(sa6+s*(sa7+s*sa8)))))));
  }
  else {		/* |x| >= 1/0.35 */
    R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*(rb5+s*rb6)))));
    S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*(sb5+s*(sb6+s*sb7))))));
  }
  z  = (double)(float) ax;
  r  = exp(-z*z-0.5625)*exp((z-ax)*(z+ax)+R/S);
  if (x>=0) return one-r/ax;
  else return  r/ax-one;
}

static double ighmm_erfc (double x) {
  double R,S,P,Q,s,y,z,r;
  double ax = fabs(x);
#ifdef HAVE_IEEE754
  if (!isfinite(x)) {
    if (isnan(x)) return x;     /* erfc(nan)=nan */
    return (x==ax) ? 0 : 2;	/* erfc(+-inf)=0,2 */
  }
#endif
  if (ax < 0.84375) {		/* |x|<0.84375 */
    if (ax < 13.8777878e-18)  	/* |x|<2**-56 */
      return one-x;
    z = x*x;
    r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
    s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
    y = r/s;
    if (ax < 0.25) {  		/* x<1/4 */
      return one-(x+x*y);
    }
    else {
      r = x*y;
      r += (x-half);
      return half - r ;
    }
  }
  if (ax < 1.25) {			/* 0.84375 <= |x| < 1.25 */
    s = fabs(x)-one;
    P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6)))));
    Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6)))));
    if (x>=0) {
      z  = one-erx; return z - P/Q;
    }
    else {
      z = erx+P/Q; return one+z;
    }
  }
  if (ax < 28.0) {		/* |x|<28 */
    s = one/(x*x);
    if (ax < 2.857142857) {	/* |x| < 1/.35 ~ 2.857143*/
      R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*(ra5+s*(ra6+s*ra7))))));
      S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*(sa5+s*(sa6+s*(sa7+s*sa8)))))));
    }
    else {			/* |x| >= 1/.35 ~ 2.857143 */
      if (x < -6.0) return two-tiny;/* x < -6 */
      R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*(rb5+s*rb6)))));
      S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*(sb5+s*(sb6+s*sb7))))));
    }
    z  = (double)(float) ax;
    r  = exp(-z*z-0.5625)*exp((z-ax)*(z+ax)+R/S);
    if (x>0) return r/ax;
    else return two-r/ax;
  }
  else {
    if(x>0) return tiny*tiny;
    else return two-tiny;
  }
}
#endif /* check for ISO C99 */


/**
 *
 * @file qwrapper_slaset2.c
 *
 *  PLASMA core_blas quark wrapper
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Hatem Ltaief
 * @date 2010-11-15
 * @generated s Tue Jan  7 11:44:59 2014
 *
 **/
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 **/
void QUARK_CORE_slaset2(Quark *quark, Quark_Task_Flags *task_flags,
                       PLASMA_enum uplo, int M, int N,
                       float alpha, float *A, int LDA)
{
    DAG_CORE_LASET;
    QUARK_Insert_Task(quark, CORE_slaset2_quark, task_flags,
        sizeof(PLASMA_enum),                &uplo,  VALUE,
        sizeof(int),                        &M,     VALUE,
        sizeof(int),                        &N,     VALUE,
        sizeof(float),         &alpha, VALUE,
        sizeof(float)*M*N,     A,      OUTPUT,
        sizeof(int),                        &LDA,   VALUE,
        0);
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_slaset2_quark = PCORE_slaset2_quark
#define CORE_slaset2_quark PCORE_slaset2_quark
#endif
void CORE_slaset2_quark(Quark *quark)
{
    PLASMA_enum uplo;
    int M;
    int N;
    float alpha;
    float *A;
    int LDA;

    quark_unpack_args_6(quark, uplo, M, N, alpha, A, LDA);
    CORE_slaset2(uplo, M, N, alpha, A, LDA);
}


///////////////////////////////////////////////////////////////////////////////
//
// File eigen_mm.h
//
// MIT License

// Copyright (c) 2020 EigenMM

// Permission is hereby granted, free of charge, to any person obtaining a copy
// of this software and associated documentation files (the "Software"), to deal
// in the Software without restriction, including without limitation the rights
// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
// copies of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:

// The above copyright notice and this permission notice shall be included in all
// copies or substantial portions of the Software.

// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
// SOFTWARE.
//
// Description: EigenMM library definitions
//
///////////////////////////////////////////////////////////////////////////////

#ifndef eigen_mm_H
#define eigen_mm_H

#include <petsc.h>
#include <slepceps.h>

#include <algorithm>
#include <vector>
#include <map>
#include <string>
#include <fstream>
#include <iterator>
#include <iostream>
#include "mpi.h"
#include "tinyxml.h"

#define PI 3.141592653589793238462

class SolverOptions
{
private:
    // communicator options
    PetscInt _nodesperevaluator = 1;
    PetscInt _subproblemsperevaluator = 1;
    PetscInt _totalsubproblems = 1;
    PetscInt _nevaluators = 1;
    PetscInt _nevals = -1;
    PetscInt _taskspernode = 28;

    // eigenvalue partitioning options
    PetscInt _nk = 7;
    PetscInt _nb = 4;
    PetscInt _p = 0;
    PetscInt _nv = 10;
    PetscInt _splitmaxiters = 10;
    PetscInt _raditers = 10;
    PetscReal _splittol = 0.9;
    PetscReal _radtol = 1e-3;
    PetscReal _L = 0.01;
    PetscReal _R = -1.0;

    // save and print options
    bool _terse = false;
    bool _details = false;
    bool _debug = false;
    bool _save_operators = false;
    bool _save_correctness = false;
    bool _save_eigenvalues = false;
    bool _save_eigenbasis = false;
    char _operators_filename[2048];
    char _correctness_filename[2048];
    char _eigenvalues_filename[2048];
    char _eigenbasis_filename[2048];

public:
    SolverOptions() {}

    // set communicator options
    void set_nodesperevaluator(PetscInt v) { _nodesperevaluator = v; }
    void set_subproblemsperevaluator(PetscInt v) { _subproblemsperevaluator = v; }
    void set_totalsubproblems(PetscInt v) { _totalsubproblems = v; }
    void set_nevaluators(PetscInt v) { _nevaluators = v; }
    void set_nevals(PetscInt v) { _nevals = v; }
    void set_taskspernode(PetscInt v) { _taskspernode = v; }

    // set eigenvalue partitioning options
    void set_nk(PetscInt v) { _nk = v; }
    void set_nb(PetscInt v) { _nb = v; }
    void set_p(PetscInt v) { _p = v; }
    void set_nv(PetscInt v) { _nv = v; }
    void set_splitmaxiters(PetscInt v) { _splitmaxiters = v; }
    void set_raditers(PetscInt v) { _raditers = v; }
    void set_splittol(PetscReal v) { _splittol = v; }
    void set_radtol(PetscReal v) { _radtol = v; }
    void set_L(PetscReal v) { _L = v; }
    void set_R(PetscReal v) { _R = v; }

    // set save and print options
    void set_terse(bool v) { _terse = v; }
    void set_details(bool v) { _details = v; }
    void set_debug(bool v) { _debug = v; }
    void set_save_operators(bool v, const char* filename)
    {
        _save_operators = v;
        sprintf(_operators_filename, "%s", filename);
    }
    void set_save_correctness(bool v, const char* filename)
    {
        _save_correctness = v;
        sprintf(_correctness_filename, "%s", filename);
    }
    void set_save_eigenvalues(bool v, const char* filename)
    {
        _save_eigenvalues = v;
        sprintf(_eigenvalues_filename, "%s", filename);
    }
    void set_save_eigenbasis(bool v, const char* filename)
    {
        _save_eigenbasis = v;
         sprintf(_eigenbasis_filename, "%s", filename);
    }

    // get communicator options
    PetscInt nodesperevaluator() { return _nodesperevaluator; }
    PetscInt subproblemsperevaluator() { return _subproblemsperevaluator; }
    PetscInt totalsubproblems() { return _totalsubproblems; }
    PetscInt nevaluators() { return _nevaluators; }
    PetscInt nevals() { return _nevals; }
    PetscInt taskspernode() { return _taskspernode; }

    // get eigenvalue partitioning options
    PetscInt nk() { return _nk; }
    PetscInt nb() { return _nb; }
    PetscInt p() { return _p; }
    PetscInt nv() { return _nv; }
    PetscInt splitmaxiters() { return _splitmaxiters; }
    PetscInt raditers() { return _raditers; }
    PetscReal splittol() { return _splittol; }
    PetscReal radtol() { return _radtol; }
    PetscReal L() { return _L; }
    PetscReal R() { return _R; }

    // get save and print options
    bool terse() { return _terse; }
    bool details() { return _details; }
    bool debug() { return _debug; }
    bool save_operators() { return _save_operators; }
    bool save_correctness() { return _save_correctness; }
    bool save_eigenvalues() { return _save_eigenvalues; }
    bool save_eigenbasis() { return _save_eigenbasis; }
    char* operators_filename() { return _operators_filename; }
    char* correctness_filename() { return _correctness_filename; }
    char* eigenvalues_filename() { return _eigenvalues_filename; }
    char* eigenbasis_filename() { return _eigenbasis_filename; }
};

struct NodeInfo
{
    // world
    PetscInt worldrank, worldsize;

    // evaluator
    PetscInt rank, size, id;
    MPI_Comm comm;

    // additional properties
    PetscInt nevaluators;

    const char* procname;
    PetscInt procid;

    // Results
    PetscInt neval;
    PetscInt neval0;
};

class eigen_mm
{
private:

    EPS eps;
    SolverOptions opts;
    NodeInfo node;
    Mat K, M, V;
    Mat K_global, M_global;
    Vec lambda;
    std::vector<PetscReal> intervals;
    std::vector<PetscReal> residuals;

    void findUpperBound();
    void rescaleInterval();
    void formSubproblems();
    PetscReal count_subintervals(PetscInt n, PetscReal Nhat, PetscInt Nbar,
        std::vector<PetscReal> x, std::vector<PetscInt> &RA, std::vector<PetscInt> &A);
    void merge_approximations(PetscReal Nhat, PetscInt Nbar,
        std::vector<PetscReal> &x, std::vector<PetscInt> &RA,
        std::vector<PetscReal> y, std::vector<PetscInt> RB,
        std::vector<PetscInt> &A);
    PetscInt solveSubproblems();
    void formEigenbasis(PetscInt neval);

    PetscInt solveSubProblem(PetscReal *intervals, int job);
    void splitSubProblem(PetscReal a, PetscReal b, PetscReal *c,
        PetscInt *out_ec_left, PetscInt *out_ec_right);
    void global_refine(PetscInt n,
                       std::vector<PetscReal>  x,
                       std::vector<PetscReal> &y,
                       std::vector<PetscInt>   C,
                       PetscReal Nhat);
    void balance_intervals(PetscReal   a, PetscReal   b, PetscReal   *c,
                           PetscInt reva, PetscInt revb, PetscInt *revc,
                           PetscInt  *Cl, PetscInt  *Cr);
    PetscInt computeDev_approximate(PetscReal a, PetscReal U, PetscBool rl);
    PetscInt computeDev_exact(PetscReal a, PetscBool rl);
    PetscReal computeRadius(Mat &A);
    void countInterval(PetscReal a, PetscReal b, PetscInt *count);

public:

    eigen_mm();
    ~eigen_mm();

    int init(Mat &K_in, Mat &M_in, SolverOptions &opt);
    int solve(Mat *V_out, Vec *lambda_out);

    void exactEigenvalues_square_neumann(int Ne,
        std::vector<PetscReal> &lambda,
        std::vector<PetscReal> &eta1,
        std::vector<PetscReal> &eta2);
    void exactEigenvalues_cube_neumann(int Ne,
        std::vector<PetscReal> &lambda,
        std::vector<PetscReal> &eta1,
        std::vector<PetscReal> &eta2,
        std::vector<PetscReal> &eta3);

};

#endif //eigen_mm_H


/*!
 *  Copyright (c) 2014 by Contributors
 * \file base.h
 * \brief definitions of base types, operators, macros functions
 *
 * \author Bing Xu, Tianqi Chen
 */
#ifndef MSHADOW_BASE_H_
#define MSHADOW_BASE_H_
#ifdef _MSC_VER
#define _CRT_SECURE_NO_WARNINGS
#define _CRT_SECURE_NO_DEPRECATE
#define NOMINMAX
#endif
#include <cmath>
#include <cstdio>
#include <cfloat>
#include <climits>
#include <algorithm>
// macro defintiions
/*!
 * \brief if this macro is define to be 1,
 * mshadow should compile without any of other libs
 */
#ifndef MSHADOW_STAND_ALONE
#define MSHADOW_STAND_ALONE 0
#endif
/*! \brief whether do padding during allocation */
#ifndef MSHADOW_ALLOC_PAD
#define MSHADOW_ALLOC_PAD true
#endif
/*!
 * \brief
 *  x dimension of data must be bigger pad_size * ratio to be alloced padded memory,
 *  otherwise use tide allocation
 *  for example, if pad_ratio=2, GPU memory alignement size is 32,
 *  then we will only allocate padded memory if x dimension > 64
 *  set it to 0 then we will always allocate padded memory
 */
#ifndef MSHADOW_MIN_PAD_RATIO
  #define MSHADOW_MIN_PAD_RATIO 2
#endif

#if MSHADOW_STAND_ALONE
  #define MSHADOW_USE_CBLAS 0
  #define MSHADOW_USE_MKL   0
  #define MSHADOW_USE_CUDA  0
#endif

/*!
 * \brief force user to use GPU stream during computation
 *  error will be shot when default stream NULL is used
 */
#ifndef MSHADOW_FORCE_STREAM
#define MSHADOW_FORCE_STREAM 0
#endif

/*! \brief use CBLAS for CBLAS */
#ifndef MSHADOW_USE_CBLAS
  #define MSHADOW_USE_CBLAS 0
#endif
/*! \brief use MKL for BLAS */
#ifndef MSHADOW_USE_MKL
  #define MSHADOW_USE_MKL   1
#endif
/*!
 * \brief use CUDA support, must ensure that the cuda include path is correct,
 * or directly compile using nvcc
 */
#ifndef MSHADOW_USE_CUDA
  #define MSHADOW_USE_CUDA   1
#endif

/*!
 * \brief seems CUDAARCH is deprecated in future NVCC
 * set this to 1 if you want to use CUDA version smaller than 2.0
 */
#ifndef MSHADOW_OLD_CUDA
#define MSHADOW_OLD_CUDA 0
#endif

/*! \brief whether use SSE */
#ifndef MSHADOW_USE_SSE
  #define MSHADOW_USE_SSE 1
#endif
/*! \brief whether use NVML to get dynamic info */
#ifndef MSHADOW_USE_NVML
  #define MSHADOW_USE_NVML 0
#endif
// SSE is conflict with cudacc
#ifdef __CUDACC__
  #undef MSHADOW_USE_SSE
  #define MSHADOW_USE_SSE 0
#endif

#if MSHADOW_USE_CBLAS
extern "C" {
    #include <cblas.h>
}
#elif MSHADOW_USE_MKL
  #include <mkl.h>
  #include <mkl_cblas.h>
  #include <mkl_vsl.h>
  #include <mkl_vsl_functions.h>
#endif

#if MSHADOW_USE_CUDA
  #include <cublas.h>
  #include <curand.h>
#endif

#if MSHADOW_USE_NVML
  #include <nvml.h>
#endif
// --------------------------------
// MSHADOW_XINLINE is used for inlining template code for both CUDA and CPU code
#ifdef MSHADOW_XINLINE
  #error "MSHADOW_XINLINE must not be defined"
#endif
#ifdef _MSC_VER
#define MSHADOW_FORCE_INLINE __forceinline
#pragma warning( disable : 4068 )
#else
#define MSHADOW_FORCE_INLINE inline __attribute__((always_inline))
#endif
#ifdef __CUDACC__
  #define MSHADOW_XINLINE MSHADOW_FORCE_INLINE __device__ __host__
#else
  #define MSHADOW_XINLINE MSHADOW_FORCE_INLINE
#endif
/*! \brief cpu force inline */
#define MSHADOW_CINLINE MSHADOW_FORCE_INLINE

#if defined(__GXX_EXPERIMENTAL_CXX0X) ||\
    defined(__GXX_EXPERIMENTAL_CXX0X__) || __cplusplus >= 201103L
  #define MSHADOW_CONSTEXPR constexpr
#else
  #define MSHADOW_CONSTEXPR const
#endif

/*!
 * \brief default data type for tensor string
 *  in code release, change it to default_real_t
 *  during development, change it to empty string so that missing
 *  template arguments can be detected
 */
#ifndef MSHADOW_DEFAULT_DTYPE
#define MSHADOW_DEFAULT_DTYPE = default_real_t
//#define MSHADOW_DEFAULT_DTYPE
#endif

/*! \brief namespace for mshadow */
namespace mshadow {
/*! \brief buffer size for each random number generator */
const unsigned kRandBufferSize = 1000000;
/*! \brief pi  */
const float kPi = 3.1415926f;
/*! \brief type that will be used for index */
typedef unsigned index_t;
/*! \brief float point type that will be used in default by mshadow */
typedef float default_real_t;

/*! \brief namespace for operators */
namespace op {
// binary operator
/*! \brief mul operator */
struct mul{
  /*! \brief map a, b to result using defined operation */
  template<typename DType>
  MSHADOW_XINLINE static DType Map(DType a, DType b) {
    return a * b;
  }
};
/*! \brief plus operator */
struct plus {
  /*! \brief map a, b to result using defined operation */
  template<typename DType>
  MSHADOW_XINLINE static DType Map(DType a, DType b) {
    return a + b;
  }
};
/*! \brief minus operator */
struct minus {
  /*! \brief map a, b to result using defined operation */
  template<typename DType>
  MSHADOW_XINLINE static DType Map(DType a, DType b) {
    return a - b;
  }
};
/*! \brief divide operator */
struct div {
  /*! \brief map a, b to result using defined operation */
  template<typename DType>
  MSHADOW_XINLINE static DType Map(DType a, DType b) {
    return a / b;
  }
};
/*! \brief get rhs */
struct right {
  /*! \brief map a, b to result using defined operation */
  template<typename DType>
  MSHADOW_XINLINE static DType Map(DType a, DType b) {
    return b;
  }
};
// unary operator/ function: example
// these operators can be defined by user,
// in the same style as binary and unary operator
// to use, simply write F<op::identity>( src )
/*! \brief identity function that maps a real number to it self */
struct identity{
  /*! \brief map a to result using defined operation */
  template<typename DType>
  MSHADOW_XINLINE static DType Map(DType a) {
    return a;
  }
};
}  // namespace op
/*! \brief namespace for savers */
namespace sv {
/*! \brief save to saver: = */
struct saveto {
  /*! \brief save b to a using save method */
  template<typename DType>
  MSHADOW_XINLINE static void Save(DType &a, DType b) {
    a = b;
  }
  /*! \brief helper constant to use BLAS, alpha */
  inline static default_real_t AlphaBLAS(void) { return 1.0f; }
  /*! \brief helper constant to use BLAS, beta */
  inline static default_real_t BetaBLAS(void) { return 0.0f; }
  /*! \brief corresponding binary operator type */
  typedef op::right OPType;
};
/*! \brief save to saver: += */
struct plusto {
  /*! \brief save b to a using save method */
  template<typename DType>
  MSHADOW_XINLINE static void Save(DType &a, DType b) {
    a += b;
  }
  /*! \brief helper constant to use BLAS, alpha */
  inline static default_real_t AlphaBLAS(void) { return 1.0f; }
  /*! \brief helper constant to use BLAS, beta */
  inline static default_real_t BetaBLAS(void) { return 1.0f; }
  /*! \brief corresponding binary operator type */
  typedef op::plus OPType;
};
/*! \brief minus to saver: -= */
struct minusto {
  /*! \brief save b to a using save method */
  template<typename DType>
  MSHADOW_XINLINE static void Save(DType &a, DType b) {
    a -= b;
  }
  /*! \brief helper constant to use BLAS, alpha */
  inline static default_real_t AlphaBLAS(void) { return -1.0f; }
  /*! \brief helper constant to use BLAS, beta */
  inline static default_real_t BetaBLAS(void) { return 1.0f; }
  /*! \brief corresponding binary operator type */
  typedef op::minus OPType;
};
/*! \brief multiply to saver: *= */
struct multo {
  /*! \brief save b to a using save method */
  template<typename DType>
  MSHADOW_XINLINE static void Save(DType &a, DType b) {
    a *= b;
  }
  /*! \brief corresponding binary operator type */
  typedef op::mul OPType;
};
/*! \brief divide to saver: /= */
struct divto {
  /*! \brief save b to a using save method */
  template<typename DType>
  MSHADOW_XINLINE static void Save(DType& a, DType b) {
    a /= b;
  }
  /*! \brief corresponding binary operator type */
  typedef op::div OPType;
};
}  // namespace sv
/*! \brief namespace for potential reducer operations */
namespace red {
namespace limits {
/*!
 * \brief minimum value of certain types
 * \tparam DType data type
 */
template<typename DType>
MSHADOW_XINLINE DType MinValue(void);
/*! \brief minimum value of float */
template<>
MSHADOW_XINLINE float MinValue<float>(void) {
  return -FLT_MAX;
}
/*! \brief minimum value of double */
template<>
MSHADOW_XINLINE double MinValue<double>(void) {
  return -DBL_MAX;
}
/*! \brief minimum value of int */
template<>
MSHADOW_XINLINE int MinValue<int>(void) {
  return INT_MIN;
}
}  // namespace limits

/*! \brief sum reducer */
struct sum {
  /*! \brief do reduction into dst */
  template<typename DType>
  MSHADOW_XINLINE static void Reduce(volatile DType& dst,  volatile DType src) {
    dst += src;
  }
  /*!
   *\brief calculate gradient of redres with respect to redsrc,
   * redres: reduced result, redsrc: one of reduction element
   */
  template<typename DType>
  MSHADOW_XINLINE static DType PartialGrad(DType redres, DType redsrc) {
    return 1;
  }
  /*!
   *\brief set the initial value during reduction
   */
  template<typename DType>
  MSHADOW_XINLINE static void SetInitValue(DType &initv) {
    initv = 0;
  }
};
/*! \brief maximum reducer */
struct maximum {
  /*! \brief do reduction into dst */
  template<typename DType>
  MSHADOW_XINLINE static void Reduce(volatile DType& dst,  volatile DType src) {
    using namespace std;
    dst = max(dst, src);
  }
  /*!
   * \brief calculate gradient of redres with respect to redsrc,
   * redres: reduced result, redsrc: one of reduction element
   */
  template<typename DType>
  MSHADOW_XINLINE static DType PartialGrad(DType redres, DType redsrc) {
    return redres == redsrc ? 1: 0;
  }
  /*!
   *\brief set the initial value during reduction
   */
  template<typename DType>
  MSHADOW_XINLINE static void SetInitValue(DType &initv) {
    initv = limits::MinValue<DType>();
  }
};
}  // namespace red
}  // namespace mshadow
#endif  // MSHADOW_BASE_H_


/* -----------------------------------------------------------------------------
 * Copyright 2021 Jonathan Haigh
 * SPDX-License-Identifier: MIT
 * ---------------------------------------------------------------------------*/

#ifndef SQ_INCLUDE_GUARD_parser_Parser_inl_h_
#define SQ_INCLUDE_GUARD_parser_Parser_inl_h_

#include <charconv>

#include "core/ASSERT.h"
#include "core/errors.h"

#include <gsl/gsl>

namespace sq::parser {

template <std::integral Int> std::optional<Int> Parser::parse_integer() {
  const auto opt_token = accept_token(TokenKind::Integer);
  if (!opt_token) {
    return std::nullopt;
  }
  const auto &token = opt_token.value();
  const auto str_view = token.view();
  ASSERT(!str_view.empty());
  const auto *begin = str_view.data();
  // We can't really avoid using pointer arithmetic when using
  // std::from_chars - it requires a const char* to indicate the end of the
  // string, but we can only reasonably make one using pointer arithmetic.
  // In particular, std::string, std::string_view, std::span etc. only
  // provide iterator versions of end(), but we need a pointer.
  // NOLINTNEXTLINE(cppcoreguidelines-pro-bounds-pointer-arithmetic)
  const auto *end = begin + str_view.size();
  Int value = 0;
  const auto [ptr, ec] = std::from_chars(begin, end, value, 10);
  if (ec == std::errc::result_out_of_range) {
    auto ss = std::ostringstream{};
    ss << "integer " << str_view << " does not fit in required type; "
       << "must be in the closed interval [" << std::numeric_limits<Int>::min()
       << ", " << std::numeric_limits<Int>::max() << "]";
    throw OutOfRangeError{token, ss.str()};
  }
  ASSERT(ec == std::errc{});
  ASSERT(ptr == end);
  return value;
}

} // namespace sq::parser

#endif // SQ_INCLUDE_GUARD_parser_Parser_inl_h_


/*
 * Copyright (c) 2016-2021 lymastee, All rights reserved.
 * Contact: lymastee@hotmail.com
 *
 * This file is part of the gslib project.
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to deal
 * in the Software without restriction, including without limitation the rights
 * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 * copies of the Software, and to permit persons to whom the Software is
 * furnished to do so, subject to the following conditions:
 *
 * The above copyright notice and this permission notice shall be included in all
 * copies or substantial portions of the Software.
 *
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
 * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
 * SOFTWARE.
 */

#pragma once

#ifndef type_3f1a28e2_0da6_44b6_84db_29542f5a65c0_h
#define type_3f1a28e2_0da6_44b6_84db_29542f5a65c0_h

#include <utility>
#include <gslib/basetype.h>
#include <gslib/math.h>

__gslib_begin__

template<class _ty, class _protopt>
struct point_t:
    public _protopt
{
    typedef _ty type;
    typedef _protopt proto;
    typedef point_t<_ty, _protopt> myref;

public:
    point_t() { this->x = 0; this->y = 0; }
    point_t(const proto& p): proto(p) {}
    point_t(type a, type b) { this->x = a; this->y = b; }
    void offset(type u, type v) { this->x += u; this->y += v; }
    void offset(const proto& p) { this->x += p.x; this->y += p.y; }
    void set_point(type a, type b) { this->x = a; this->y = b; }
    bool operator == (const myref& that) const { return this->x == that.x && this->y == that.y; }
    bool operator != (const myref& that) const { return this->x != that.x || this->y != that.y; }
};

struct vec2i { int x, y; };
typedef point_t<int, vec2i> point;
typedef point_t<float, vec2> pointf;

template<class _ty, class _ptcls>
struct rect_t
{
    typedef _ty type;
    typedef rect_t<_ty, _ptcls> myref;
    typedef _ptcls point;

public:
    type    left, top, right, bottom;

public:
    rect_t()
    {
        left = 0;
        top = 0;
        right = 0;
        bottom = 0;
    }
    rect_t(type l, type t, type w, type h) { set_rect(l, t, w, h); }
    type width() const { return right - left; }
    type height() const { return bottom - top; }
    void set_rect(type l, type t, type w, type h)
    {
        left = l;
        top = t;
        right = l + w;
        bottom = t + h;
    }
    void set_ltrb(type l, type t, type r, type b)
    {
        left = l;
        top = t;
        right = r;
        bottom = b;
    }
    void set_by_pts(const point& p1, const point& p2)
    {
        left = gs_min(p1.x, p2.x);
        top = gs_min(p1.y, p2.y);
        right = gs_max(p1.x, p2.x);
        bottom = gs_max(p1.y, p2.y);
    }
    bool in_rect(const point& pt) const { return pt.x >= left && pt.x < right && pt.y >= top && pt.y < bottom; }
    void offset(type x, type y) { left += x; right += x; top += y; bottom += y; }
    void deflate(type u, type v);
    void move_to(const point& pt) { move_to(pt.x, pt.y); }
    void move_to(type x, type y);
    bool operator == (const myref& that) const { return left == that.left && right == that.right && top == that.top && bottom == that.bottom; }
    bool operator != (const myref& that) const { return left != that.left || right != that.right || top != that.top || bottom != that.bottom; }
    type area() const { return width() * height(); }
    point center() const
    {
        point c;
        c.x = (left + right) / 2;
        c.y = (top + bottom) / 2;
        return c;
    }
    point top_left() const { return point(left, top); }
    point top_right() const { return point(right, top); }
    point bottom_left() const { return point(left, bottom); }
    point bottom_right() const { return point(right, bottom); }
};

typedef rect_t<int, point> rect;
typedef rect_t<float, pointf> rectf;

inline rectf to_rectf(const rect& rc)
{
    return std::move(rectf((float)rc.left, (float)rc.top, (float)rc.width(), (float)rc.height()));
}

inline rect to_aligned_rect(const rectf& rc)
{
    return std::move(rect(round(rc.left), round(rc.top), round(rc.width()), round(rc.height())));
}

gs_export extern bool intersect_rect(rect& rc, const rect& rc1, const rect& rc2);
gs_export extern bool is_rect_intersected(const rect& rc1, const rect& rc2);
gs_export extern void union_rect(rect& rc, const rect& rc1, const rect& rc2);
gs_export extern bool substract_rect(rect& rc, const rect& rc1, const rect& rc2);
gs_export extern bool intersect_rect(rectf& rc, const rectf& rc1, const rectf& rc2);
gs_export extern bool is_rect_intersected(const rectf& rc1, const rectf& rc2);
gs_export extern bool is_rect_contained(const rect& rc1, const rect& rc2);
gs_export extern bool is_rect_contained(const rectf& rc1, const rectf& rc2);
gs_export extern void union_rect(rectf& rc, const rectf& rc1, const rectf& rc2);
gs_export extern bool substract_rect(rectf& rc, const rectf& rc1, const rectf& rc2);
gs_export extern bool is_line_rect_overlapped(const point& p1, const point& p2, const rect& rc);
gs_export extern bool is_line_rect_overlapped(const pointf& p1, const pointf& p2, const rectf& rc);

__gslib_end__

#endif


#pragma once

#include <complex>
#include <cstddef>
#include <cstdint>
#include <iosfwd>
#include <string>
#include <utility>
#include <vector>

#include <gsl/gsl>

#include "chainerx/error.h"
#include "chainerx/float16.h"

namespace chainerx {

// NOTE: The dtype list is not fixed yet!!!
enum class Dtype {
    kBool = 1,
    kInt8,
    kInt16,
    kInt32,
    kInt64,
    kUInt8,
    kFloat16,
    kFloat32,
    kFloat64,
};

inline bool IsValidDtype(Dtype dtype) {
    using Underlying = std::underlying_type_t<Dtype>;
    auto value = static_cast<Underlying>(dtype);
    return 1 <= value && value <= static_cast<Underlying>(Dtype::kFloat64);
}

std::ostream& operator<<(std::ostream& os, Dtype dtype);

}  // namespace chainerx

namespace std {

template <>
struct hash<::chainerx::Dtype> {
    size_t operator()(::chainerx::Dtype dtype) const {
        using T = std::underlying_type_t<::chainerx::Dtype>;
        return hash<T>()(static_cast<T>(dtype));
    }
};

}  // namespace std

namespace chainerx {

// Kind of dtypes.
enum class DtypeKind {
    kBool = 0,
    kInt,
    kUInt,
    kFloat,
};

// Gets the single character identifier compatible to NumPy's dtype kind
inline char GetDtypeKindChar(DtypeKind kind) {
    switch (kind) {
        case DtypeKind::kBool:
            return 'b';
        case DtypeKind::kInt:
            return 'i';
        case DtypeKind::kUInt:
            return 'u';
        case DtypeKind::kFloat:
            return 'f';
        default:
            throw DtypeError{"invalid dtype kind"};
    }
}

template <typename T>
constexpr bool IsFloatingPointV = std::is_floating_point<T>::value || std::is_same<std::remove_const_t<T>, Float16>::value;

// Tag type used for dynamic dispatching with dtype value.
//
// This class template is used to resolve mapping from runtime dtype values to compile-time primitive types.
template <typename T>
struct PrimitiveType;

#define CHAINERX_DEFINE_PRIMITIVE_TYPE(name, code, dtype, kind, t, dst) \
    template <>                                                         \
    struct PrimitiveType<t> {                                           \
        using type = t;                                                 \
        using device_storage_type = dst;                                \
        static constexpr char kCharCode = code;                         \
        static constexpr Dtype kDtype = dtype;                          \
        static constexpr int64_t kElementSize = sizeof(type);           \
        static constexpr DtypeKind kKind = kind;                        \
        static const char* GetName() { return name; }                   \
    }

// TODO(niboshi): Char codes are mapped according to current development environment. They should be remapped depending on the executing
// environment, as in NumPy.
CHAINERX_DEFINE_PRIMITIVE_TYPE("bool", '?', Dtype::kBool, DtypeKind::kBool, bool, bool);
CHAINERX_DEFINE_PRIMITIVE_TYPE("int8", 'b', Dtype::kInt8, DtypeKind::kInt, int8_t, int8_t);
CHAINERX_DEFINE_PRIMITIVE_TYPE("int16", 'h', Dtype::kInt16, DtypeKind::kInt, int16_t, int16_t);
CHAINERX_DEFINE_PRIMITIVE_TYPE("int32", 'i', Dtype::kInt32, DtypeKind::kInt, int32_t, int32_t);
CHAINERX_DEFINE_PRIMITIVE_TYPE("int64", 'l', Dtype::kInt64, DtypeKind::kInt, int64_t, int64_t);
CHAINERX_DEFINE_PRIMITIVE_TYPE("uint8", 'B', Dtype::kUInt8, DtypeKind::kUInt, uint8_t, uint8_t);
CHAINERX_DEFINE_PRIMITIVE_TYPE("float16", 'e', Dtype::kFloat16, DtypeKind::kFloat, chainerx::Float16, uint16_t);
CHAINERX_DEFINE_PRIMITIVE_TYPE("float32", 'f', Dtype::kFloat32, DtypeKind::kFloat, float, float);
CHAINERX_DEFINE_PRIMITIVE_TYPE("float64", 'd', Dtype::kFloat64, DtypeKind::kFloat, double, double);

#undef CHAINERX_DEFINE_PRIMITIVE_TYPE

namespace dtype_detail {
template <typename To, typename From>
using WithConstnessOf = std::conditional_t<std::is_const<From>::value, std::add_const_t<To>, std::remove_const_t<To>>;
}

template <typename T>
using TypeToDeviceStorageType = dtype_detail::WithConstnessOf<typename PrimitiveType<std::remove_const_t<T>>::device_storage_type, T>;

// Dtype mapped from primitive type.
template <typename T>
constexpr Dtype TypeToDtype = PrimitiveType<std::remove_const_t<T>>::kDtype;

// Invokes a function by passing PrimitiveType<T> corresponding to given dtype value.
//
// For example,
//     VisitDtype(Dtype::kInt32, f, args...);
// is equivalent to
//     f(PrimtiveType<int>, args...);
// Note that the dtype argument can be a runtime value. This function can be used for dynamic dispatching based on dtype values.
//
// Note (beam2d): This function should be constexpr, but GCC 5.x does not allow it because of the throw statement, so currently not marked
// as constexpr.
template <typename F, typename... Args>
auto VisitDtype(Dtype dtype, F&& f, Args&&... args) {
    switch (dtype) {
        case Dtype::kBool:
            return std::forward<F>(f)(PrimitiveType<bool>{}, std::forward<Args>(args)...);
        case Dtype::kInt8:
            return std::forward<F>(f)(PrimitiveType<int8_t>{}, std::forward<Args>(args)...);
        case Dtype::kInt16:
            return std::forward<F>(f)(PrimitiveType<int16_t>{}, std::forward<Args>(args)...);
        case Dtype::kInt32:
            return std::forward<F>(f)(PrimitiveType<int32_t>{}, std::forward<Args>(args)...);
        case Dtype::kInt64:
            return std::forward<F>(f)(PrimitiveType<int64_t>{}, std::forward<Args>(args)...);
        case Dtype::kUInt8:
            return std::forward<F>(f)(PrimitiveType<uint8_t>{}, std::forward<Args>(args)...);
        case Dtype::kFloat16:
            return std::forward<F>(f)(PrimitiveType<chainerx::Float16>{}, std::forward<Args>(args)...);
        case Dtype::kFloat32:
            return std::forward<F>(f)(PrimitiveType<float>{}, std::forward<Args>(args)...);
        case Dtype::kFloat64:
            return std::forward<F>(f)(PrimitiveType<double>{}, std::forward<Args>(args)...);
        default:
            throw DtypeError{"invalid dtype: ", static_cast<std::underlying_type_t<Dtype>>(dtype)};
    }
}

// Invokes a function by passing PrimitiveType<T> corresponding to given numeric dtype value.
// See VisitDtype for more detail.
template <typename F, typename... Args>
auto VisitNumericDtype(Dtype dtype, F&& f, Args&&... args) {
    switch (dtype) {
        case Dtype::kInt8:
            return std::forward<F>(f)(PrimitiveType<int8_t>{}, std::forward<Args>(args)...);
        case Dtype::kInt16:
            return std::forward<F>(f)(PrimitiveType<int16_t>{}, std::forward<Args>(args)...);
        case Dtype::kInt32:
            return std::forward<F>(f)(PrimitiveType<int32_t>{}, std::forward<Args>(args)...);
        case Dtype::kInt64:
            return std::forward<F>(f)(PrimitiveType<int64_t>{}, std::forward<Args>(args)...);
        case Dtype::kUInt8:
            return std::forward<F>(f)(PrimitiveType<uint8_t>{}, std::forward<Args>(args)...);
        case Dtype::kFloat16:
            return std::forward<F>(f)(PrimitiveType<chainerx::Float16>{}, std::forward<Args>(args)...);
        case Dtype::kFloat32:
            return std::forward<F>(f)(PrimitiveType<float>{}, std::forward<Args>(args)...);
        case Dtype::kFloat64:
            return std::forward<F>(f)(PrimitiveType<double>{}, std::forward<Args>(args)...);
        default:
            throw DtypeError{"invalid dtype"};
    }
}

// Invokes a function by passing PrimitiveType<T> corresponding to given floating-point dtype value.
// See VisitDtype for more detail.
template <typename F, typename... Args>
auto VisitFloatingPointDtype(Dtype dtype, F&& f, Args&&... args) {
    switch (dtype) {
        case Dtype::kFloat16:
            return std::forward<F>(f)(PrimitiveType<chainerx::Float16>{}, std::forward<Args>(args)...);
        case Dtype::kFloat32:
            return std::forward<F>(f)(PrimitiveType<float>{}, std::forward<Args>(args)...);
        case Dtype::kFloat64:
            return std::forward<F>(f)(PrimitiveType<double>{}, std::forward<Args>(args)...);
        default:
            throw DtypeError{"invalid dtype"};
    }
}

// Gets the single character identifier compatible to NumPy's char code
inline char GetCharCode(Dtype dtype) {
    return VisitDtype(dtype, [](auto pt) { return decltype(pt)::kCharCode; });
}

// Gets the element size of the dtype in bytes.
inline int64_t GetItemSize(Dtype dtype) {
    return VisitDtype(dtype, [](auto pt) { return decltype(pt)::kElementSize; });
}

// Gets the kind of dtype.
inline DtypeKind GetKind(Dtype dtype) {
    return VisitDtype(dtype, [](auto pt) { return decltype(pt)::kKind; });
}

Dtype PromoteTypes(Dtype dt1, Dtype dt2);

// const char* representation of dtype compatible to NumPy's dtype name.
inline const char* GetDtypeName(Dtype dtype) {
    return VisitDtype(dtype, [](auto pt) { return decltype(pt)::GetName(); });
}

// Gets the dtype of given name.
Dtype GetDtype(const std::string& name);

// Returns a vector of all possible dtype values.
std::vector<Dtype> GetAllDtypes();

// Throws an exception if two dtypes mismatch.
void CheckEqual(Dtype lhs, Dtype rhs);

}  // namespace chainerx


/*
This file is a part of NNTL project (https://github.com/Arech/nntl)

Copyright (c) 2015-2021, Arech (aradvert@gmail.com; https://github.com/Arech)
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

* Redistributions of source code must retain the above copyright notice, this
  list of conditions and the following disclaimer.

* Redistributions in binary form must reproduce the above copyright notice,
  this list of conditions and the following disclaimer in the documentation
  and/or other materials provided with the distribution.

* Neither the name of NNTL nor the names of its
  contributors may be used to endorse or promote products derived from
  this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#pragma once

#include <cblas.h>
//TODO: function definitions (like dgemm()) conflicts with similar function definitions in ACML. It builds successfully, but
//links to wrong library and access violation happens in run-time.

#include <complex>
#define lapack_complex_float ::std::complex<float>
#define lapack_complex_double ::std::complex<double>
#include <lapacke.h>

//#include "../../../utils/denormal_floats.h"

#pragma comment(lib,"libopenblas.dll.a")

//what else to do to use OpenBLAS:
// -in the Solution's VC++ Directories property page set parameter Library Directories to point to a folder with the libopenblas.dll.a file
// -copy correct libopenblas.dll and another dlls that the libopenblas.dll require to the debug/release solution's folder
// -if you're going to use any calling convetion except for __cdecl, then most likely, you'll have to update function declarations
//		within the cblas.h and other blas's .h files included to contain the __cdecl keyword (it's absent for some reason).
//		Check the b_OpenBLAS:: methods to find out which function definitions should be changed.

//http://www.christophlassner.de/using-blas-from-c-with-row-major-data.html

// BTW: lda,ldb,ldc is a "major stride". The stride represents the distance in memory between elements in adjacent rows
// (if row-major) or in adjacent columns (if column-major). This means that the stride is usually equal to the number
// of rows/columns in the matrix.
// Matrix A = [1 2 3]
//            [4 5 6]
// Row-major stores values as {1,2,3,4,5,6} Stride here is 3
// Col-major stores values as {1,4,2,5,3,6} Stride here is 2
// (https://www.physicsforums.com/threads/understanding-blas-dgemm-in-c.543110/)

namespace nntl {
namespace math {

	// wrapper around BLAS API. Should at least isolate from double/float differences
	// Also, we are going to use ColMajor ordering in all math libraries (most of them use it by default)
	// EXPECTING data to be in COL-MAJOR mode!
	//
	// NB: Leading dimension is the number of elements in major dimension. We're using Col-Major ordering,
	// therefore it is the number of ROWs of a matrix
	struct b_OpenBLAS {
	private:
		typedef utils::_scoped_restore_FPU _restoreFPU;
	public:
		//TODO: beware that sz_t type used as substitution of blasint can overflow blasint and silencing conversion warnings here can make it difficult to debug!
		//TODO: May be there should be some preliminary check for this condition.

		//////////////////////////////////////////////////////////////////////////
		//////////////////////////////////////////////////////////////////////////
		// LEVEL 1
		// AXPY y=a*x+y
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, double>::value > axpy(
			const sz_t n, const fl_t alpha, const fl_t *x, const sz_t incx, fl_t *y, const sz_t incy)
		{
			_restoreFPU r;
			cblas_daxpy(static_cast<blasint>(n), alpha, x, static_cast<blasint>(incx), y, static_cast<blasint>(incy));
		}
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, float>::value > axpy(
			const sz_t n, const fl_t alpha, const fl_t *x, const sz_t incx, fl_t *y, const sz_t incy)
		{
			_restoreFPU r;
			cblas_saxpy(static_cast<blasint>(n), alpha, x, static_cast<blasint>(incx), y, static_cast<blasint>(incy));
		}

		//////////////////////////////////////////////////////////////////////////
		// cblas_?dot
		// Computes a vector - vector dot product.
		//	Input Parameters
		// n - Specifies the number of elements in vectors x and y.
		// x - Array, size at least(1 + (n - 1)*abs(incx)).
		// incx - Specifies the increment for the elements of x.
		// y - Array, size at least(1 + (n - 1)*abs(incy)).
		// incy - Specifies the increment for the elements of y.
		// Return Values - The result of the dot product of x and y, if n is positive.Otherwise, returns 0.
		//https://software.intel.com/en-us/mkl-developer-reference-c-cblas-dot
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, double>::value, double >
			dot(const sz_t n, const fl_t *x, const sz_t incx, const fl_t *y, const sz_t incy)
		{
			_restoreFPU r;
			return cblas_ddot(static_cast<blasint>(n), x, static_cast<blasint>(incx), y, static_cast<blasint>(incy));
		}
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, float>::value, float >
			dot(const sz_t n, const fl_t *x, const sz_t incx, const fl_t *y, const sz_t incy)
		{
			_restoreFPU r;
			return cblas_sdot(static_cast<blasint>(n), x, static_cast<blasint>(incx), y, static_cast<blasint>(incy));
		}

		//////////////////////////////////////////////////////////////////////////
		//////////////////////////////////////////////////////////////////////////
		// LEVEL 2

		//////////////////////////////////////////////////////////////////////////
		//////////////////////////////////////////////////////////////////////////
		// LEVEL 3
		//
		//////////////////////////////////////////////////////////////////////////
		// General matrix multiplication
		// GEMM C := alpha*op(A)*op(B) + beta*C
		// https://software.intel.com/en-us/node/520775
		// where:
		// op(X) is one of op(X) = X, or op(X) = XT, or op(X) = XH,
		// alpha and beta are scalars,
		// A, B and C are matrices :
		// op(A) is an m - by - k matrix,
		// op(B) is a k - by - n matrix,
		// C is an m - by - n matrix.
		//
		// M - Specifies the number of rows of the matrix op(A) and of the matrix C. The value of m must be at least zero.
		// N - Specifies the number of columns of the matrix op(B) and the number of columns of the matrix C. The value of n must be at least zero.
		// K - Specifies the number of columns of the matrix op(A) and the number of rows of the matrix op(B). The value of k must be at least zero.
		// A - {transa=CblasNoTrans : Array, size lda*k. Before entry, the leading m-by-k part of the array a must contain the matrix A.
		//		transa=CblasTrans : Array, size lda*m. Before entry, the leading k-by-m part of the array a must contain the matrix A.}
		// lda - Specifies the leading dimension of A as declared in the calling (sub)program.
		//		{transa=CblasNoTrans, lda must be at least max(1, m).
		//		transa=CblasTrans, lda must be at least max(1, k)}
		// B - {transb=CblasNoTrans : Array, size ldb by n. Before entry, the leading k-by-n part of the array b must contain the matrix B.
		//		transb=CblasTrans : Array, size ldb by k. Before entry the leading n-by-k part of the array b must contain the matrix B.}
		// ldb - Specifies the leading dimension of B as declared in the calling (sub)program.
		//		{transb = CblasNoTrans : ldb must be at least max(1, k).
		//		transb=CblasTrans : ldb must be at least max(1, n).}
		// C - Array, size ldc by n. Before entry, the leading m-by-n part of the array c must contain the matrix C, except when beta is
		//		equal to zero, in which case c need not be set on entry.
		// ldc - Specifies the leading dimension of c as declared in the calling (sub)program. ldc must be at least max(1, m).
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, double>::value >
			gemm( //const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_TRANSPOSE TransB,
			const bool bTransposeA, const bool bTransposeB,
			const sz_t M, const sz_t N, const sz_t K, const fl_t alpha, const fl_t *A, const sz_t lda,
			const fl_t *B, const sz_t ldb, const fl_t beta, fl_t *C, const sz_t ldc)
		{
			_restoreFPU r;
			cblas_dgemm(CblasColMajor, bTransposeA ? CblasTrans : CblasNoTrans, bTransposeB ? CblasTrans : CblasNoTrans,
				static_cast<blasint>(M), static_cast<blasint>(N), static_cast<blasint>(K),
				alpha, A, static_cast<blasint>(lda), B, static_cast<blasint>(ldb), beta, C, static_cast<blasint>(ldc));
			//global_denormalized_floats_mode();
		}
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, float>::value >
			gemm( //const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_TRANSPOSE TransB,
			const bool bTransposeA, const bool bTransposeB,
			const sz_t M, const sz_t N, const sz_t K, const fl_t alpha, const fl_t *A, const sz_t lda,
			const fl_t *B, const sz_t ldb, const fl_t beta, fl_t *C, const sz_t ldc)
		{
			_restoreFPU r;
			cblas_sgemm(CblasColMajor, bTransposeA ? CblasTrans: CblasNoTrans, bTransposeB ? CblasTrans : CblasNoTrans,
				static_cast<blasint>(M), static_cast<blasint>(N), static_cast<blasint>(K),
				alpha, A, static_cast<blasint>(lda), B, static_cast<blasint>(ldb), beta, C, static_cast<blasint>(ldc));
			//global_denormalized_floats_mode();
		}

		//////////////////////////////////////////////////////////////////////////
		// cblas_?syrk, https://software.intel.com/en-us/node/520780
		// Performs a symmetric rank-k update.
		// The ?syrk routines perform a rank-k matrix-matrix operation for a symmetric matrix C using a general matrix A.
		// The operation is defined as:
		// C := alpha*A*A' + beta*C,
		//		or
		// C : = alpha*A'*A + beta*C,
		// where :
		//		alpha and beta are scalars,
		//		C is an n-by-n symmetric matrix,
		//		A is an n-by-k matrix in the first case and a k-by-n matrix in the second case.
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, double>::value >
			syrk( const bool bCLowerTriangl, const bool bFirstATransposed, const sz_t N, const sz_t K, const fl_t alpha
				, const fl_t *A, const sz_t lda, const fl_t beta, fl_t *C, const sz_t ldc)
		{
			_restoreFPU r;
			cblas_dsyrk(CblasColMajor, bCLowerTriangl ? CblasLower : CblasUpper, bFirstATransposed ? CblasTrans : CblasNoTrans
				, static_cast<blasint>(N), static_cast<blasint>(K), alpha, A, static_cast<blasint>(lda), beta, C, static_cast<blasint>(ldc));
			//global_denormalized_floats_mode();
		}
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, float>::value >
			syrk(const bool bCLowerTriangl, const bool bFirstATransposed, const sz_t N, const sz_t K, const fl_t alpha
				, const fl_t *A, const sz_t lda, const fl_t beta, fl_t *C, const sz_t ldc)
		{
			_restoreFPU r;
			cblas_ssyrk(CblasColMajor, bCLowerTriangl ? CblasLower : CblasUpper, bFirstATransposed ? CblasTrans : CblasNoTrans
				, static_cast<blasint>(N), static_cast<blasint>(K), alpha, A, static_cast<blasint>(lda), beta, C, static_cast<blasint>(ldc));
			//global_denormalized_floats_mode();
		}

		//////////////////////////////////////////////////////////////////////////
		// cblas_?symm, https://software.intel.com/en-us/node/520779
		// Computes a matrix - matrix product where one input matrix is symmetric.
		// The ?symm routines compute a scalar-matrix-matrix product with one symmetric matrix and add the
		// result to a scalar-matrix product. The operation is defined as
		// C: = alpha*A*B + beta*C,
		//		or
		// C : = alpha*B*A + beta*C,
		// where :
		//		alpha and beta are scalars,
		//		A is a symmetric matrix,
		//		B and C are m - by - n matrices.
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, double>::value >
			symm(const bool bSymmAatLeft, const bool bALowerTriangl, const sz_t M, const sz_t N, const fl_t alpha
				, const fl_t *A, const sz_t lda, const fl_t *B, const sz_t ldb, const fl_t beta, fl_t *C, const sz_t ldc)
		{
			_restoreFPU r;
			cblas_dsymm(CblasColMajor, bSymmAatLeft ? CblasLeft : CblasRight, bALowerTriangl ? CblasLower : CblasUpper
				, static_cast<blasint>(M), static_cast<blasint>(N), alpha, A, static_cast<blasint>(lda)
				, B, static_cast<blasint>(ldb), beta, C, static_cast<blasint>(ldc));
			//global_denormalized_floats_mode();
		}
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, float>::value >
			symm(const bool bSymmAatLeft, const bool bALowerTriangl, const sz_t M, const sz_t N, const fl_t alpha
				, const fl_t *A, const sz_t lda, const fl_t *B, const sz_t ldb, const fl_t beta, fl_t *C, const sz_t ldc)
		{
			_restoreFPU r;
			cblas_ssymm(CblasColMajor, bSymmAatLeft ? CblasLeft : CblasRight, bALowerTriangl ? CblasLower : CblasUpper
				, static_cast<blasint>(M), static_cast<blasint>(N), alpha, A, static_cast<blasint>(lda)
				, B, static_cast<blasint>(ldb), beta, C, static_cast<blasint>(ldc));
			//global_denormalized_floats_mode();
		}

		//////////////////////////////////////////////////////////////////////////
		//////////////////////////////////////////////////////////////////////////
		// LAPACKE

		// ?gesvd
		// https://software.intel.com/en-us/node/521150
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, double>::value, int>
			gesvd(/*int matrix_layout,*/ const char jobu, const char jobvt,
				const sz_t m, const sz_t n, fl_t* A,
				const sz_t lda, fl_t* S, fl_t* U, const sz_t ldu,
				fl_t* Vt, const sz_t ldvt, fl_t* superb)
		{
			_restoreFPU r;
			return static_cast<int>(LAPACKE_dgesvd(LAPACK_COL_MAJOR, jobu, jobvt, static_cast<lapack_int>(m), static_cast<lapack_int>(n)
				, A, static_cast<lapack_int>(lda), S, U, static_cast<lapack_int>(ldu), Vt, static_cast<lapack_int>(ldvt), superb));
		}
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, float>::value, int>
			gesvd(/*int matrix_layout,*/ const char jobu, const char jobvt,
				const sz_t m, const sz_t n, fl_t* A,
				const sz_t lda, fl_t* S, fl_t* U, const sz_t ldu,
				fl_t* Vt, const sz_t ldvt, fl_t* superb)
		{
			_restoreFPU r;
			return static_cast<int>(LAPACKE_sgesvd(LAPACK_COL_MAJOR, jobu, jobvt, static_cast<lapack_int>(m), static_cast<lapack_int>(n)
				, A, static_cast<lapack_int>(lda), S, U, static_cast<lapack_int>(ldu), Vt, static_cast<lapack_int>(ldvt), superb));
		}

		//////////////////////////////////////////////////////////////////////////
		//////////////////////////////////////////////////////////////////////////
		// Extensions

		// The omatcopy routine performs scaling and out-of-place transposition/copying of matrices. A transposition
		// operation can be a normal matrix copy, a transposition, a conjugate transposition, or just a conjugation.
		// The operation is defined as follows:
		// B : = alpha*op(A)
		//
		// Parameters
		// rows - The number of rows in the source matrix.
		// cols - The number of columns in the source matrix.
		// alpha - This parameter scales the input matrix by alpha.
		// pA - Array.
		// lda - Distance between the first elements in adjacent columns(in the case of the column - major order)
		//		or rows(in the case of the row - major order) in the source matrix; measured in the number of elements.
		//		This parameter must be at least max(1, rows) if ordering = 'C' or 'c', and max(1, cols) otherwise.
		// b - Array.
		// ldb - Distance between the first elements in adjacent columns(in the case of the column - major order)
		//		or rows(in the case of the row - major order) in the destination matrix; measured in the number of elements.
		//		To determine the minimum value of ldb on output, consider the following guideline :
		//		If ordering = 'C' or 'c', then
		//			If trans = 'T' or 't' or 'C' or 'c', this parameter must be at least max(1, cols)
		//			If trans = 'N' or 'n' or 'R' or 'r', this parameter must be at least max(1, rows)
		//		If ordering = 'R' or 'r', then
		//			If trans = 'T' or 't' or 'C' or 'c', this parameter must be at least max(1, rows)
		//			If trans = 'N' or 'n' or 'R' or 'r', this parameter must be at least max(1, cols)
		//
		// #warning current OpenBLAS implementation is slower, than it can be. See TEST(TestPerfDecisions, mTranspose) in test_perf_decisions.cpp
		//and https://github.com/xianyi/OpenBLAS/issues/1243
		// https://github.com/xianyi/OpenBLAS/issues/2532
		// https://stackoverflow.com/questions/16737298/what-is-the-fastest-way-to-transpose-a-matrix-in-c/16743203#16743203
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, double>::value >
			omatcopy(const bool bTranspose, const sz_t rows, const sz_t cols, const fl_t alpha,
				const fl_t* pA, const sz_t lda, fl_t* pB, const sz_t ldb)
		{
			_restoreFPU r;
			cblas_domatcopy(CblasColMajor, bTranspose ? CblasTrans : CblasNoTrans,
				static_cast<blasint>(rows), static_cast<blasint>(cols), alpha,
				pA, static_cast<blasint>(lda), pB, static_cast<blasint>(ldb));
		}
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, float>::value >
			omatcopy(const bool bTranspose, const sz_t rows, const sz_t cols, const fl_t alpha,
				const fl_t* pA, const sz_t lda, fl_t* pB, const sz_t ldb)
		{
			_restoreFPU r;
			cblas_somatcopy(CblasColMajor, bTranspose ? CblasTrans : CblasNoTrans,
				static_cast<blasint>(rows), static_cast<blasint>(cols), alpha,
				pA, static_cast<blasint>(lda), pB, static_cast<blasint>(ldb));
		}

		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, double>::value >
			imatcopy(const bool bTranspose, const sz_t rows, const sz_t cols, const fl_t alpha,
				fl_t* pA, const sz_t lda, const sz_t ldb)
		{
			_restoreFPU r;
			cblas_dimatcopy(CblasColMajor, bTranspose ? CblasTrans : CblasNoTrans,
				static_cast<blasint>(rows), static_cast<blasint>(cols), alpha,
				pA, static_cast<blasint>(lda), static_cast<blasint>(ldb));
		}
		template<typename sz_t, typename fl_t>
		static typename ::std::enable_if_t< ::std::is_same< ::std::remove_pointer_t<fl_t>, float>::value >
			imatcopy(const bool bTranspose, const sz_t rows, const sz_t cols, const fl_t alpha,
				fl_t* pA, const sz_t lda, const sz_t ldb)
		{
			_restoreFPU r;
			cblas_simatcopy(CblasColMajor, bTranspose ? CblasTrans : CblasNoTrans,
				static_cast<blasint>(rows), static_cast<blasint>(cols), alpha,
				pA, static_cast<blasint>(lda), static_cast<blasint>(ldb));
		}
	};

}
}