/* randist/hyperg.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 James Theiler, Brian Gough
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or (at
 * your option) any later version.
 *
 * This program 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
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 */

#include <config.h>
#include <math.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_sf_gamma.h>

/* The hypergeometric distribution has the form,

   prob(k) =  choose(n1,t) choose(n2, t-k) / choose(n1+n2,t)

   where choose(a,b) = a!/(b!(a-b)!)

   n1 + n2 is the total population (tagged plus untagged)
   n1 is the tagged population
   t is the number of samples taken (without replacement)
   k is the number of tagged samples found

*/

unsigned int
gsl_ran_hypergeometric (const gsl_rng * r, unsigned int n1, unsigned int n2,
                        unsigned int t)
{
  const unsigned int n = n1 + n2;

  unsigned int i = 0;
  unsigned int a = n1;
  unsigned int b = n1 + n2;
  unsigned int k = 0;

  if (t > n)
    {
      t = n ;
    }

  if (t < n / 2)
    {
      for (i = 0 ; i < t ; i++)
        {
          double u = gsl_rng_uniform(r) ;

          if (b * u < a)
            {
              k++ ;
              if (k == n1)
                return k ;
              a-- ;
            }
          b-- ;
        }
      return k;
    }
  else
    {
      for (i = 0 ; i < n - t ; i++)
        {
          double u = gsl_rng_uniform(r) ;

          if (b * u < a)
            {
              k++ ;
              if (k == n1)
                return n1 - k ;
              a-- ;
            }
          b-- ;
        }
      return n1 - k;
    }

}

double
gsl_ran_hypergeometric_pdf (const unsigned int k,
                            const unsigned int n1,
                            const unsigned int n2,
                            unsigned int t)
{
  if (t > n1 + n2)
    {
      t = n1 + n2 ;
    }

  if (k > n1 || k > t)
    {
      return 0 ;
    }
  else if (t > n2 && k + n2 < t )
    {
      return 0 ;
    }
  else
    {
      double p;

      double c1 = gsl_sf_lnchoose(n1,k);
      double c2 = gsl_sf_lnchoose(n2,t-k);
      double c3 = gsl_sf_lnchoose(n1+n2,t);

      p = exp(c1 + c2 - c3) ;

      return p;
    }
}


//This computes the DFT (discrete Fourier transformation) along dim of matrix X.
//This uses a CBLAS matrix multiplication by the DFT matrix.

//This can be useful for smaller transform sizes, especially odd-length ones.
//It is nice that the scaling can be included in the matrix.

//This can also be useful if using only a few of the output frequencies, as given by F.
//Especially useful (with modification) if can be combined with another matrix multiply.

#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <cblas.h>

#ifndef M_PI
    #define M_PI 3.14159265358979323846
#endif

#ifdef __cplusplus
namespace codee {
extern "C" {
#endif

int dft_cblas_s (float *Y, const float *X, const size_t R, const size_t C, const size_t S, const size_t H, const int iscolmajor, const size_t dim, const size_t ndft, const size_t F, const int sc);
int dft_cblas_d (double *Y, const double *X, const size_t R, const size_t C, const size_t S, const size_t H, const int iscolmajor, const size_t dim, const size_t ndft, const size_t F, const int sc);
int dft_cblas_c (float *Y, const float *X, const size_t R, const size_t C, const size_t S, const size_t H, const int iscolmajor, const size_t dim, const size_t ndft, const size_t F, const int sc);
int dft_cblas_z (double *Y, const double *X, const size_t R, const size_t C, const size_t S, const size_t H, const int iscolmajor, const size_t dim, const size_t ndft, const size_t F, const int sc);

int dft_cblas_s (float *Y, const float *X, const size_t R, const size_t C, const size_t S, const size_t H, const int iscolmajor, const size_t dim, const size_t ndft, const size_t F, const int sc)
{
    if (dim>3u) { fprintf(stderr,"error in dft_cblas_s: dim must be in [0 3]\n"); return 1; }

    const size_t N = R*C*S*H;
    const size_t Lx = (dim==0u) ? R : (dim==1u) ? C : (dim==2u) ? S : H;
    if (ndft<Lx) { fprintf(stderr,"error in dft_cblas_s: ndft must be >= Lx (length of vecs in X)\n"); return 1; }
    if (ndft<F) { fprintf(stderr,"error in dft_cblas_s: ndft must be >= F (num output freqs)\n"); return 1; }

    //Scaling
    const float s = sc ? 1.0f/sqrtf((float)(2u*ndft)) : 1.0f;

    if (N==0u || F==0u) {}
    else if (ndft==1u)
    {
        for (size_t n=N; n>0u; --n, ++X) { *Y++ = *X; *Y++ = 0.0f; }
        Y -= 2u*N;
    }
    else
    {
        //Initialize DFT matrix multiply (real, imag parts separate)
        const size_t LF = Lx * F;
        const float P2_N = (float)(2.0*M_PI/(double)ndft);
        float *DFTr, *DFTi;
        DFTr = (float *)aligned_alloc(sizeof(float),LF*sizeof(float));
        DFTi = (float *)aligned_alloc(sizeof(float),LF*sizeof(float));
        if (!DFTr) { fprintf(stderr,"error in dft_cblas_s: problem with aligned_alloc. "); perror("aligned_alloc"); return 1; }
        if (!DFTi) { fprintf(stderr,"error in dft_cblas_s: problem with aligned_alloc. "); perror("aligned_alloc"); return 1; }
        for (size_t l=0u; l<Lx; ++l, ++DFTr, ++DFTi) { *DFTr = s; *DFTi = 0.0f; }
        for (size_t f=1u; f<F; ++f)
        {
            for (size_t l=0u; l<Lx; ++l)
            {
                *DFTr++ = s * cosf(P2_N*(float)f*(float)l);
                *DFTi++ = -s * sinf(P2_N*(float)f*(float)l);
            }
        }
        DFTr -= LF; DFTi -= LF;

        if (Lx==N)
        {
            //Matrix multiply
            cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,1.0f,DFTr,(int)Lx,X,1,0.0f,Y,2);
            cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,1.0f,DFTi,(int)Lx,X,1,0.0f,&Y[1],2);

            //Enforce real Nyquist
            if (ndft%2u==0u && F>ndft/2u) { Y[ndft+1u] = 0.0f; }
        }
        else
        {
            const size_t K = (iscolmajor) ? ((dim==0u) ? 1u : (dim==1u) ? R : (dim==2u) ? R*C : R*C*S) : ((dim==0u) ? C*S*H : (dim==1u) ? S*H : (dim==2u) ? H : 1u);
            const size_t B = (iscolmajor && dim==0u) ? C*S*H : K;
            const size_t V = N/Lx, G = V/B;

            if (K==1u && (G==1u || B==1u))
            {
                for (size_t v=0u; v<V; ++v, Y+=2u*F)
                {
                    //Matrix multiply
                    cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,1.0f,DFTr,(int)Lx,X,1,0.0f,Y,2);
                    cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,1.0f,DFTi,(int)Lx,X,1,0.0f,&Y[1],2);

                    //Enforce real Nyquist
                    if (ndft%2u==0u && F>ndft/2u) { Y[ndft+1u] = 0.0f; }
                }
            }
            else
            {
                for (size_t g=G; g>0u; --g, X+=B*(Lx-1u), Y+=2u*B*(F-1u))
                {
                    for (size_t b=B; b>0u; --b, ++X, Y+=2)
                    {
                        //Matrix multiply
                        cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,1.0f,DFTr,(int)Lx,X,(int)K,0.0f,Y,2*(int)K);
                        cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,1.0f,DFTi,(int)Lx,X,(int)K,0.0f,&Y[1],2*(int)K);

                        //Enforce real Nyquist
                        //if (ndft%2u==0u && F>ndft/2u) { Y[2u*K*(ndft/2u+1u)+1u] = 0.0f; }
                    }
                }
            }
        }
        free(DFTr); free(DFTi);
    }

    return 0;
}

int dft_cblas_d (double *Y, const double *X, const size_t R, const size_t C, const size_t S, const size_t H, const int iscolmajor, const size_t dim, const size_t ndft, const size_t F, const int sc)
{
    if (dim>3u) { fprintf(stderr,"error in dft_cblas_d: dim must be in [0 3]\n"); return 1; }

    const size_t N = R*C*S*H;
    const size_t Lx = (dim==0u) ? R : (dim==1u) ? C : (dim==2u) ? S : H;
    if (ndft<Lx) { fprintf(stderr,"error in dft_cblas_d: ndft must be >= Lx (length of vecs in X)\n"); return 1; }
    if (ndft<F) { fprintf(stderr,"error in dft_cblas_d: ndft must be >= F (num output freqs)\n"); return 1; }

    //Scaling
    const double s = sc ? 1.0/sqrt((double)(2u*ndft)) : 1.0;

    if (N==0u || F==0u) {}
    else if (ndft==1u)
    {
        for (size_t n=N; n>0u; --n, ++X) { *Y++ = *X; *Y++ = 0.0; }
        Y -= 2u*N;
    }
    else
    {
        //Initialize DFT matrix multiply
        const size_t LF = Lx * F;
        const double P2_N = 2.0*M_PI/(double)ndft;
        double *DFTr, *DFTi;
        DFTr = (double *)aligned_alloc(sizeof(double),LF*sizeof(double));
        DFTi = (double *)aligned_alloc(sizeof(double),LF*sizeof(double));
        if (!DFTr) { fprintf(stderr,"error in dft_cblas_d: problem with aligned_alloc. "); perror("aligned_alloc"); return 1; }
        if (!DFTi) { fprintf(stderr,"error in dft_cblas_d: problem with aligned_alloc. "); perror("aligned_alloc"); return 1; }
        for (size_t l=0u; l<Lx; ++l, ++DFTr, ++DFTi) { *DFTr = s; *DFTi = 0.0; }
        for (size_t f=1u; f<F; ++f)
        {
            for (size_t l=0u; l<Lx; ++l)
            {
                *DFTr++ = s * cos(P2_N*(double)f*(double)l);
                *DFTi++ = -s * sin(P2_N*(double)f*(double)l);
            }
        }
        DFTr -= LF; DFTi -= LF;

        if (Lx==N)
        {
            //Matrix multiply
            cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,1.0,DFTr,(int)Lx,X,1,0.0,Y,2);
            cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,1.0,DFTi,(int)Lx,X,1,0.0,&Y[1],2);

            //Enforce real Nyquist
            if (ndft%2u==0u && F>ndft/2u) { Y[ndft+1u] = 0.0f; }
        }
        else
        {
            const size_t K = (iscolmajor) ? ((dim==0u) ? 1u : (dim==1u) ? R : (dim==2u) ? R*C : R*C*S) : ((dim==0u) ? C*S*H : (dim==1u) ? S*H : (dim==2u) ? H : 1u);
            const size_t B = (iscolmajor && dim==0u) ? C*S*H : K;
            const size_t V = N/Lx, G = V/B;

            if (K==1u && (G==1u || B==1u))
            {
                for (size_t v=0u; v<V; ++v, Y+=2u*F)
                {
                    //Matrix multiply
                    cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,1.0,DFTr,(int)Lx,X,1,0.0,Y,2);
                    cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,1.0,DFTi,(int)Lx,X,1,0.0,&Y[1],2);

                    //Enforce real Nyquist
                    if (ndft%2u==0u && F>ndft/2u) { Y[ndft+1u] = 0.0; }
                }
            }
            else
            {
                for (size_t g=G; g>0u; --g, X+=B*(Lx-1u), Y+=2u*B*(F-1u))
                {
                    for (size_t b=B; b>0u; --b, ++X, Y+=2)
                    {
                        //Matrix multiply
                        cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,1.0,DFTr,(int)Lx,X,(int)K,0.0,Y,2*(int)K);
                        cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,1.0,DFTi,(int)Lx,X,(int)K,0.0,&Y[1],2*(int)K);

                        //Enforce real Nyquist
                        //if (ndft%2u==0u && F>ndft/2u) { Y[2u*K*(ndft/2u+1u)+1u] = 0.0; }
                    }
                }
            }
        }
        free(DFTr); free(DFTi);
    }

    return 0;
}

int dft_cblas_c (float *Y, const float *X, const size_t R, const size_t C, const size_t S, const size_t H, const int iscolmajor, const size_t dim, const size_t ndft, const size_t F, const int sc)
{
    if (dim>3u) { fprintf(stderr,"error in dft_cblas_c: dim must be in [0 3]\n"); return 1; }

    const size_t N = R*C*S*H;
    const size_t Lx = (dim==0u) ? R : (dim==1u) ? C : (dim==2u) ? S : H;
    if (ndft<Lx) { fprintf(stderr,"error in dft_cblas_c: ndft must be >= Lx (length of vecs in X)\n"); return 1; }
    if (ndft<F) { fprintf(stderr,"error in dft_cblas_c: ndft must be >= F (num output freqs)\n"); return 1; }

    //Scaling
    const float s = sc ? 1.0f/sqrtf((float)(2u*ndft)) : 1.0f;

    if (N==0u || F==0u) {}
    else if (ndft==1u)
    {
        for (size_t n=2u*N; n>0u; --n, ++X, ++Y) { *Y = *X; }
        Y -= 2u*N;
    }
    else
    {
        //Init DFT matrix multiply
        const float z[2] = {0.0f,0.0f}, o[2] = {1.0f,0.0f};
        const size_t LF = Lx * F;
        const float P2_N = (float)(2.0*M_PI/(double)ndft);
        float *DFT;
        DFT = (float *)aligned_alloc(sizeof(float),2u*LF*sizeof(float));
        if (!DFT) { fprintf(stderr,"error in dft_cblas_c: problem with aligned_alloc. "); perror("aligned_alloc"); return 1; }
        for (size_t f=0u; f<F; ++f)
        {
            for (size_t l=0u; l<Lx; ++l)
            {
                *DFT++ = s * cosf(P2_N*(float)f*(float)l);
                *DFT++ = -s * sinf(P2_N*(float)f*(float)l);
            }
        }
        DFT -= 2u*LF;

        if (Lx==N)
        {
            //Matrix multiply
            cblas_cgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,o,DFT,(int)Lx,X,1,z,Y,1);
        }
        else
        {
            const size_t K = (iscolmajor) ? ((dim==0u) ? 1u : (dim==1u) ? R : (dim==2u) ? R*C : R*C*S) : ((dim==0u) ? C*S*H : (dim==1u) ? S*H : (dim==2u) ? H : 1u);
            const size_t B = (iscolmajor && dim==0u) ? C*S*H : K;
            const size_t V = N/Lx, G = V/B;

            if (K==1u && (G==1u || B==1u))
            {
                for (size_t v=0u; v<V; ++v, Y+=2u*F)
                {
                    //Matrix multiply
                    cblas_cgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,o,DFT,(int)Lx,X,1,z,Y,1);
                }
            }
            else
            {
                for (size_t g=G; g>0u; --g, X+=2u*B*(Lx-1u), Y+=2u*B*(F-1u))
                {
                    for (size_t b=B; b>0u; --b, X+=2, Y+=2)
                    {
                        //Matrix multiply
                        cblas_cgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,o,DFT,(int)Lx,X,(int)K,z,Y,(int)K);
                    }
                }
            }
        }
        free(DFT);
    }

    return 0;
}

int dft_cblas_z (double *Y, const double *X, const size_t R, const size_t C, const size_t S, const size_t H, const int iscolmajor, const size_t dim, const size_t ndft, const size_t F, const int sc)
{
    if (dim>3u) { fprintf(stderr,"error in dft_cblas_z: dim must be in [0 3]\n"); return 1; }

    const size_t N = R*C*S*H;
    const size_t Lx = (dim==0u) ? R : (dim==1u) ? C : (dim==2u) ? S : H;
    if (ndft<Lx) { fprintf(stderr,"error in dft_cblas_z: ndft must be >= Lx (length of vecs in X)\n"); return 1; }
    if (ndft<F) { fprintf(stderr,"error in dft_cblas_z: ndft must be >= F (num output freqs)\n"); return 1; }

    //Scaling
    const double s = sc ? 1.0/sqrt((double)(2u*ndft)) : 1.0;

    if (N==0u || F==0u) {}
    else if (ndft==1u)
    {
        for (size_t n=2u*N; n>0u; --n, ++X, ++Y) { *Y = *X; }
        Y -= 2u*N;
    }
    else
    {
        //Init DFT matrix multiply
        const double z[2] = {0.0,0.0}, o[2] = {1.0,0.0};
        const size_t LF = Lx * F;
        const double P2_N = 2.0*M_PI/(double)ndft;
        double *DFT;
        DFT = (double *)aligned_alloc(sizeof(double),2u*LF*sizeof(double));
        if (!DFT) { fprintf(stderr,"error in dft_cblas_z: problem with aligned_alloc. "); perror("aligned_alloc"); return 1; }
        for (size_t f=0u; f<F; ++f)
        {
            for (size_t l=0u; l<Lx; ++l)
            {
                *DFT++ = s * cos(P2_N*(double)f*(double)l);
                *DFT++ = -s * sin(P2_N*(double)f*(double)l);
            }
        }
        DFT -= 2u*LF;

        if (Lx==N)
        {
            //Matrix multiply
            cblas_zgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,o,DFT,(int)Lx,X,1,z,Y,1);
        }
        else
        {
            const size_t K = (iscolmajor) ? ((dim==0u) ? 1u : (dim==1u) ? R : (dim==2u) ? R*C : R*C*S) : ((dim==0u) ? C*S*H : (dim==1u) ? S*H : (dim==2u) ? H : 1u);
            const size_t B = (iscolmajor && dim==0u) ? C*S*H : K;
            const size_t V = N/Lx, G = V/B;

            if (K==1u && (G==1u || B==1u))
            {
                for (size_t v=0u; v<V; ++v, Y+=2u*F)
                {
                    //Matrix multiply
                    cblas_zgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,o,DFT,(int)Lx,X,1,z,Y,1);
                }
            }
            else
            {
                for (size_t g=G; g>0u; --g, X+=2u*B*(Lx-1u), Y+=2u*B*(F-1u))
                {
                    for (size_t b=B; b>0u; --b, X+=2, Y+=2)
                    {
                        //Matrix multiply
                        cblas_zgemv(CblasRowMajor,CblasNoTrans,(int)F,(int)Lx,o,DFT,(int)Lx,X,(int)K,z,Y,(int)K);
                    }
                }
            }
        }
        free(DFT);
    }

    return 0;
}

#ifdef __cplusplus
}
}
#endif


/*
 * agentlib.h
 *
 *  Created on: Jul. 5, 2019
 *      Author: takis
 */

#ifndef MY_INCLUDES_AGENTLIB_H_
#define MY_INCLUDES_AGENTLIB_H_

/********************************************************************************************************
 * 											INCLUDES
 * ******************************************************************************************************
 */
#include <vector>
#include <string>
#include <fstream>

// my own includes
#include <gsl/gsl_blas.h>
#include <gsl/gsl_math.h>
#include <math.h>

/********************************************************************************************************
 * 											MACROS
 * ******************************************************************************************************
 */
#define		Nx				100		// number of columns in physical environment
#define		Ny				100 	// number of rows in physical environment
#define		MaxMapEntries	48		// maximum number of contexts
#define		MaxIterations	9999	// maximum number of times main mapping loop can execute
#define		SenseRange		75		// units of distance that the agent can "see"
#define		MinVectorNorm	0.01	// a landmark must be further away than 1 cm from the agent
#define		MATSIZE			8		// matrix dimension (MATSIZE x MATSIZE) for analysis

/********************************************************************************************************
 * 											TYPEDEFs
 * ******************************************************************************************************
 */
typedef	std::vector<std::vector<std::string> >	vvs_t;	// 2D vector type for the
														// physical environment

typedef	vvs_t::size_type	vvs_sz_t;	// size_type for 2D vector type

typedef	enum 	e_region_t 	// enumerate the possible regions
	{
		R0,
		R1,
		R2,
		R3,
		R4,
		R5
	}	region_t;

typedef	enum	e_orient_t	// enumerate the possible directions
	{
		North,
		NorthEast,
		East,
		SouthEast,
		South,
		SouthWest,
		West,
		NorthWest
	}	orient_t;

typedef	enum	e_scan_direction_t	// scan goes from top left to bottom right,
									// or from bottom right to top left
	{
		SE,
		NW
	} 	scan_direction_t;

struct	loc_t	// type for a location in the physical environment
{
	vvs_sz_t		X;
	vvs_sz_t		Y;
};

struct	read_data_t		// type for storing data read from file
{
	std::string		context;
	region_t		region;
};

struct dprec_t // define a type to store dot products and corresponding directions
{
	orient_t dir;
	double dp;
};

/********************************************************************************************************
 * 											FUNCTION PROTOTYPES
 * ******************************************************************************************************
 */

/*
 * 		function: 	sgn
 * 		purpose:	determines the sign of a double variable
 * 		parameters:	a real number (double)
 * 		returns:	+1 or -1 (short int)
 *
 */
short int	sgn(double);

/*
 * 		function: 	load_known_contexts_from_file
 * 		purpose:	reads pairs of tokens from a file of the form <string, unsigned_integer> <newline>
 * 		parameters:	string consisting of the file name
 * 		returns:	a vector of read_data_t elements
 *
 */
std::vector<read_data_t> loadKnownContextsfromFile(const std::string);

/*
 * 		function: 	load_global_map_with_file_data
 * 		purpose:	fills contextual/associative map data structure with information in vector of read_data_t elements
 * 		parameters:	the associate map (passed by reference), and the vector of read_data_t elements, passed by constant reference
 * 		returns:	nothing (void function)space
 *
 */
void loadGlobalMapwithFileData(std::map<std::string, region_t>&, const std::vector<read_data_t>&);

/*
 * 		function: 	convertContextStringtoMatrix
 * 		purpose:	takes a key string associated with the spatial associative map, and converts it into a matrix
 * 		parameters:	the context string
 * 		returns:	a matrix (of type gsl_matrix_float*)
 */
gsl_matrix_float *convertContextStringtoMatrix(const std::string&);

/*
 * 		function:	mat2Norm
 * 		purpose:	compute the 2-norm of a matrix from the definition on page 291 of
 * 					Matrix Analysis, Horn & Johnson
 * 		parameters:	a matrix of type gsl_matrix_float*
 * 		returns:	the matrix 2-norm value
 */
float mat2Norm(const gsl_matrix_float);

/*
 * 		function: 	matTr
 * 		purpose: 	yields the transformation matrix we need, T_k, where k=0,+/-1,+/-2,...
 * 		parameters:	an integer (k)
 * 		returns:	a matrix of type gsl_matrix_float*
 *
 */
gsl_matrix_float *matTr(int);

/*
 * 		function:	compareContexts
 * 		purpose:	compare context matrices, return the closeness value
 * 		parameters:	two matrices to be compared, of type gsl_matrix_float*
 * 		returns:	a closeness value, the greater, the closer the matrices are
 */
float	compareContexts(const gsl_matrix_float*, const gsl_matrix_float*);

/*
 * 		function: 	alphaK
 * 		purpose:	implements a continuous monotonically decreasing function
 * 		parameters: a real number, x (float)
 * 		returns:	(float) exp(-x)
 */
float alphaK(const float);

/*
 * 		function:	agentScan360
 * 		purpose:	at a fixed position (loc_t, first parameter) in the physical environment, deduce the context string,
 * 					which consists of relative position data, e.g., lm_A to East, lm_B to SW, to be identified
 * 					as the key AEBSW for the associative map;
 * 		parameters: the agent's location, the associative map, the physical map, and the landmark locations
 * 		returns:	nothing (changes are made to the associative map)
 */
void agentScan360(loc_t, std::map<std::string, region_t>&, const vvs_t&, const std::vector<loc_t>&, const std::vector<std::string>&);

/*
 * 		function:	scan
 * 		purpose:	survey a rectangular subset of 2D space, either in a SE or a NW sense, using recursion
 * 		parameters:	rA (top left corner of scan), rB (bottom right corner of scan), r0 (agent current location)
 * 					spatial_mem (associative map of space), physmap (physical map of space)
 * 		returns: 	nothing (void type, but changes are made to the spatial memory, a.k.a., the associate map)
 */
void scan(bool& done, const scan_direction_t, 		loc_t, 		loc_t, 		loc_t, 		std::map<std::string, region_t>&, 				const vvs_t&, 			const std::map<char, loc_t>&, 			const std::vector<std::string>&);
//   scan(bool& done, const scan_direction_t dir, 	loc_t rA, 	loc_t rB, 	loc_t r0, 	std::map<std::string, region_t>& spatial_mem, 	const vvs_t& physmap, 	const std::map<char, loc_t>& landmarks, const std::vector<std::string>& orient_str)

#endif /* MY_INCLUDES_AGENTLIB_H_ */


/* rng/fishman20.c
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 3 of the License, or (at
 * your option) any later version.
 *
 * This program 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
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 */

/*
 * This generator is taken from
 *
 * Donald E. Knuth
 * The Art of Computer Programming
 * Volume 2
 * Third Edition
 * Addison-Wesley
 * Page 108
 *
 * It is called "Fishman"
 *
 * This implementation copyright (C) 2001 Carlo Perassi
 * and (C) 2003 Heiko Bauke.
 */

#include <config.h>
#include <stdlib.h>
#include <gsl/gsl_rng.h>

static inline unsigned long int ran_get (void *vstate);
static double ran_get_double (void *vstate);
static void ran_set (void *state, unsigned long int s);

static const long int m = 2147483647, a = 48271, q = 44488, r = 3399;

typedef struct
{
  unsigned long int x;
}
ran_state_t;

static inline unsigned long int
ran_get (void *vstate)
{
  ran_state_t *state = (ran_state_t *) vstate;

  const unsigned long int x = state->x;

  const long int h = x / q;
  const long int t = a * (x - h * q) - h * r;

  if (t < 0)
    {
      state->x = t + m;
    }
  else
    {
      state->x = t;
    }

  return state->x;
}

static double
ran_get_double (void *vstate)
{
  ran_state_t *state = (ran_state_t *) vstate;

  return ran_get (state) / 2147483647.0;
}

static void
ran_set (void *vstate, unsigned long int s)
{
  ran_state_t *state = (ran_state_t *) vstate;

  if ((s%m) == 0)
    s = 1;                      /* default seed is 1 */

  state->x = s & m;

  return;
}

static const gsl_rng_type ran_type = {
  "fishman20",                  /* name */
  2147483646,                   /* RAND_MAX */
  1,                            /* RAND_MIN */
  sizeof (ran_state_t),
  &ran_set,
  &ran_get,
  &ran_get_double
};

const gsl_rng_type *gsl_rng_fishman20 = &ran_type;


#include <stdio.h>
#include <math.h>

#include <gsl/gsl_integration.h>
#include "CosmoCalcs.h"

int main() {
	UniverseLCDM myU;
	double err = 0.0;
	double x, y, z;

	double Wl = 0.75;
	double Wm = 0.05;
	double Wr = 1e-6;
	double Wk = 1.0 - Wl - Wm - Wr;

	InitUniverse( &myU, 70.0 * MpcPerMeter * 1e3, Wl, Wm, Wr, false, true );

	/*x = Dc(0.5, &err);
	printf("GSL value, unc: %.16e, %.16e\n", x, err);*/

	printf("Wl = %.16e, Wm = %.16e, Wr = %.16e\n", myU.OmegaLambda, myU.OmegaMatter, myU.OmegaRelativistic );

	//z = 0.484375;
	z = 0.5048828125;
	y = tL0_Cosmic(&myU, z, true, 1e-6, 1e-6, 128, &err);
	printf("z = %f, tL0 = %.16e, z' = %.16e\n", z, y, tL0Inv_Cosmic(&myU, y, 0, 1e-9, 1024));

	z = 0.5;
	y = tL0_Cosmic(&myU, z, true, 1e-6, 1e-6, 128, &err);
	printf("z = %f, tL0 = %.16e, z' = %.16e\n", z, y, tL0Inv_Cosmic(&myU, y, 0, 1e-9, 1024));

	z = 0.75;
	y = tL0_Cosmic(&myU, z, true, 1e-6, 1e-6, 128, &err);
	printf("z = %f, tL0 = %.16e, z' = %.16e\n", z, y, tL0Inv_Cosmic(&myU, y, 0, 1e-9, 1024));

	z = 1.0;
	y = tL0_Cosmic(&myU, z, true, 1e-6, 1e-6, 128, &err);
	printf("z = %f, tL0 = %.16e, z' = %.16e\n", z, y, tL0Inv_Cosmic(&myU, y, 0, 1e-9, 1024));

	z = 5.0;
	y = tL0_Cosmic(&myU, z, true, 1e-6, 1e-6, 128, &err);
	printf("z = %f, tL0 = %.16e, z' = %.16e\n", z, y, tL0Inv_Cosmic(&myU, y, 2, 1e-9, 1024));

	return 0;
}


#ifndef KGS_GSL_HELPERS_H
#define KGS_GSL_HELPERS_H

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

/** Print matrix to cout */
void gsl_matrix_cout (      const gsl_matrix *m);

/** Print matrix to file specified by `filename` */
void gsl_matrix_outtofile ( const gsl_matrix *m, const std::string& filename    );

/** Print vector to file specified by `filename` */
void gsl_vector_outtofile ( const gsl_vector *v, const std::string& filename    );

/** Print vector to output-stream */
void gsl_vector_out (const gsl_vector *v, std::ostream& os);

/** Print vector to cout */
void gsl_vector_cout (const gsl_vector *v);

/** Return length of vector */
double gsl_vector_length(   const gsl_vector *v );

/** Scale vector to length 1.0 */
void gsl_vector_normalize ( gsl_vector *v );

/** Scale vector to specified length */
void gsl_vector_scale_to_length(gsl_vector* ret, double length);

/** Scale vector so largest absolute value of any component is at most `maxComponent`.
 * If the values of all components are less than `maxComponent` no scaling is performed. */
void gsl_vector_scale_max_component(gsl_vector* v, double maxComponent);

/** Make a copy of the vector */
gsl_vector* gsl_vector_copy(gsl_vector*);

gsl_matrix* gsl_matrix_trans(gsl_matrix* A);

gsl_matrix* gsl_matrix_mul(gsl_matrix* A, gsl_matrix* B);

gsl_vector* gsl_matrix_vector_mul(gsl_matrix* A, gsl_vector* v);

gsl_matrix* pca (gsl_matrix* sample_matrix);

gsl_vector* RandomUnitVector (int size);

double frobenius_norm (const gsl_matrix *m);

/** Compute Shannon entropy (as in JCIM paper: fraction of significant contributors) for given input vector**/
double fractionOfSignificantContributors(const gsl_vector *v);

/** Compute Shannon entropy unnormalized: number of significant contributors of given input vector**/
double significantContributors(const gsl_vector *v);

/** Compute Shannon entropy from information theory in bits for given input vector**/
double shannonEntropyInBits(const gsl_vector* v);

/** Compute Shannon entropy from information theory in bits for given input vector**/
double shannonEntropyUnnormalizedInBits(const gsl_vector* v);

#endif //KGS_GSL_HELPERS_H


/* Authors:
   G. Jungman
   J. Scott (james.scott@lexifi.com)
 */
/* Implementation for Sobol generator.
 * See
 *   [Bratley+Fox, TOMS 14, 88 (1988)]
 *   [Antonov+Saleev, USSR Comput. Maths. Math. Phys. 19, 252 (1980)]
 */
#include <config.h>
#include <gsl/gsl_qrng.h>
#include <gsl/gsl_rng.h>

#define SOBOL_BIT_COUNT 30

/* prototypes for generator type functions */
static size_t sobol_state_size(unsigned int dimension);
static int sobol_init(void * state, unsigned int dimension);
static int sobol_get(void * state, unsigned int dimension, double * v);

/* global Sobol generator type object */
static const gsl_qrng_type sobol_type =
{
  "sobol",
  0,
  sobol_state_size,
  sobol_init,
  sobol_get
};
const gsl_qrng_type * gsl_qrng_sobol = &sobol_type;

/* Sobol generator state.
 *   sequence_count       = number of calls with this generator
 *   last_numerator_vec   = last generated numerator vector
 *   last_denominator_inv = 1/denominator for last numerator vector
 *   v_direction          = direction number table
 */
typedef struct
{
  unsigned int  sequence_count;
  double        last_denominator_inv;
  int           *last_numerator_vec;
  int           *v_direction[SOBOL_BIT_COUNT];
} sobol_state_t;

static size_t sobol_state_size(unsigned int dimension)
{
  return
    sizeof(sobol_state_t) +      /* The struct */
    sizeof(int) * dimension +    /* for last_numerator_vec */
    sizeof(int) * dimension * SOBOL_BIT_COUNT; /* for the direction no.s */
}

/* l is a degree number, between 1 and the degree of the polynomial
   associated with the dimension being initialized */
static int sobol_init_direction(gsl_rng *r, int l)
{
  /* See Peter Jaeckel, Monte Carlo Methods in Finance, Wiley 2002, p86.
   */
  int wkl = gsl_rng_uniform_int(r, 1<<l) | 1;
  return wkl;
}

void get_primitive_polynomials(int dimension, int *degree_table, int *primitive_polynomials);

static int sobol_init(void * state, unsigned int dimension)
{
  sobol_state_t * s_state = (sobol_state_t *) state;
  unsigned int i_dim;
  int j, k;
  int ell;
  int *degree_table;
  int *primitive_polynomials;
  int *includ;
  int max_degree;
  gsl_rng *r = gsl_rng_alloc(gsl_rng_default);

  if(dimension < 1) {
    return GSL_EINVAL;
  }

  { /* initialize degree_table, primitive_polynomials, max_degree and includ */
    degree_table = (int *) malloc(sizeof(int) * dimension);
    if (degree_table==0)
      GSL_ERROR_NULL ("allocation of degree table failed for sobol init", GSL_ENOMEM);
    primitive_polynomials = (int *) malloc(sizeof(int) * dimension);
    if (primitive_polynomials==0) {
      free(degree_table);
      GSL_ERROR_NULL ("allocation of primitives failed for sobol init", GSL_ENOMEM);
    }

    /* Generate the primitive polynomials */
    get_primitive_polynomials(dimension, degree_table, primitive_polynomials);

    max_degree = degree_table[dimension-1];
    includ = (int *) malloc(sizeof(int) * max_degree);
    if (includ==0) {
      free(degree_table);
      free(primitive_polynomials);
      GSL_ERROR_NULL ("allocation of 'includ' failed for sobol init", GSL_ENOMEM);
    }
  }

  s_state->last_numerator_vec = (int *) ((char *) s_state + sizeof(sobol_state_t));

  /* Initialize direction table in dimension 0. */
  for(k=0; k<SOBOL_BIT_COUNT; k++) {
    s_state->v_direction[k] =
      (int *) (((char *) s_state) +
	       sizeof(sobol_state_t) +
	       sizeof(int) * dimension +
	       sizeof(int) * dimension * k);
    s_state->v_direction[k][0] = 1;
  }

  /* Initialize in remaining dimensions. */
  for(i_dim=1; i_dim<dimension; i_dim++) {

    const int poly_index = i_dim;
    const int degree_i = degree_table[poly_index];

    /* Expand the polynomial bit pattern to separate
     * components of the logical array includ[].
     */
    int p_i = primitive_polynomials[poly_index];
    for(k = degree_i-1; k >= 0; k--) {
      includ[k] = ((p_i % 2) == 1);
      p_i /= 2;
    }

    /* Leading elements for dimension i are randomly initialized */
    for(j=0; j<degree_i; j++) s_state->v_direction[j][i_dim] = sobol_init_direction(r, j+1);

    /* Calculate remaining elements for this dimension,
     * as explained in Bratley+Fox, section 2.
     */
    for(j=degree_i; j<SOBOL_BIT_COUNT; j++) {
      int newv = s_state->v_direction[j-degree_i][i_dim];
      ell = 1;
      for(k=0; k<degree_i; k++) {
        ell *= 2;
        if(includ[k]) newv ^= (ell * s_state->v_direction[j-k-1][i_dim]);
      }
      s_state->v_direction[j][i_dim] = newv;
    }
  }

  /* Multiply columns of v by appropriate power of 2. */
  ell = 1;
  for(j=SOBOL_BIT_COUNT-1-1; j>=0; j--) {
    ell *= 2;
    for(i_dim=0; i_dim<dimension; i_dim++) {
      s_state->v_direction[j][i_dim] *= ell;
    }
  }

  /* 1/(common denominator of the elements in v_direction) */
  s_state->last_denominator_inv = 1.0 /(2.0 * ell);

  /* final setup */
  s_state->sequence_count = 0;
  for(i_dim=0; i_dim<dimension; i_dim++) s_state->last_numerator_vec[i_dim] = 0;

  free(degree_table);
  free(primitive_polynomials);
  free(includ);
  gsl_rng_free(r);

  return GSL_SUCCESS;
}

static int sobol_get(void * state, unsigned int dimension, double * v)
{
  sobol_state_t * s_state = (sobol_state_t *) state;

  unsigned int i_dimension;

  /* Find the position of the least-significant zero in count. */
  int ell = 0;
  int c = s_state->sequence_count;
  while(1) {
    ++ell;
    if((c % 2) == 1) c /= 2;
    else break;
  }

  /* Check for exhaustion. */
  if(ell > SOBOL_BIT_COUNT) return GSL_EFAILED; /* FIXME: good return code here */

  for(i_dimension=0; i_dimension<dimension; i_dimension++) {
    const int direction_i     = s_state->v_direction[ell-1][i_dimension];
    const int old_numerator_i = s_state->last_numerator_vec[i_dimension];
    const int new_numerator_i = old_numerator_i ^ direction_i;
    s_state->last_numerator_vec[i_dimension] = new_numerator_i;
    v[i_dimension] = new_numerator_i * s_state->last_denominator_inv;
  }

  s_state->sequence_count++;

  return GSL_SUCCESS;
}


/*
 file includeDef.h
 list of headers and definitions used by the program OmegaMaxEnt (main source files: OmegaMaxEnt_main.cpp, OmegaMaxEnt_data.h, OmegaMaxEnt_data.cpp, graph_2D.h, graph_2D.cpp, generique.h, generique.cpp)

 Copyright (C) 2015 Dominic Bergeron (dominic.bergeron@usherbrooke.ca)

 This program is free software: you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
 the Free Software Foundation, either version 3 of the License, or
 (at your option) any later version.

 This program 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 General Public License for more details.

 You should have received a copy of the GNU General Public License
 along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/

#ifndef INCLUDEDEF_H
#define INCLUDEDEF_H

#include "fftw3.h"
#include <cmath>
#include <iostream>
#include <iomanip>
#include <fstream>
#include <cstdio>
#include <complex>
#include <string>
#include <cstring>
#include <ctime>
#include <limits>
#include <stdio.h>
#include <sys/stat.h>
#include <random>
#include <gsl/gsl_linalg.h>
#include "armadillo"

#ifndef PI
#define PI acos((double)-1.0)
#endif

#ifndef EPSILON
#define EPSILON numeric_limits<double>::epsilon()
#endif

#ifndef DBL_MIN
#define DBL_MIN numeric_limits<double>::min()
#endif

#ifndef DBL_MAX
#define DBL_MAX numeric_limits<double>::max()
#endif

#ifndef INF
#define INF numeric_limits<double>::infinity()
#endif

using namespace std;

typedef complex<double> dcomplex;
typedef unsigned int  uint;

#endif


/* Copyright 2017. The Regents of the University of California.
 * Copyright 2016. Martin Uecker.
 * All rights reserved. Use of this source code is governed by
 * a BSD-style license which can be found in the LICENSE file.
 *
 * Authors:
 * 2016 Martin Uecker <martin.uecker@med.uni-goettingen.de>
 * 2017 Jon Tamir <jtamir@eecs.berkeley.edu>
 */

#include <complex.h>

#include "misc/misc.h"

#ifdef NOLAPACKE
#include "lapacke/lapacke.h"
#elif USE_MKL
#include <mkl.h>
#else
#include <lapacke.h>
#endif

#include "lapack.h"

#define LAPACKE(x, ...) \
	if (0 != LAPACKE_##x(LAPACK_COL_MAJOR, __VA_ARGS__))	\
		error("LAPACK: " # x " failed.");

/* ATTENTION: blas and lapack use column-major matrices
 * while native C uses row-major. All matrices are
 * transposed to what one would expect.
 *
 * LAPACK svd destroys its input matrix
 **/

void lapack_eig(long N, float eigenval[N], complex float matrix[N][N])
{
	LAPACKE(cheev, 'V', 'U', N, &matrix[0][0], N, eigenval);
}

void lapack_svd(long M, long N, complex float U[M][M], complex float VH[N][N], float S[(N > M) ? M : N], complex float A[N][M])
{
	LAPACKE(cgesdd, 'A', M, N, &A[0][0], M, S, &U[0][0], M, &VH[0][0], N);
}

void lapack_svd_econ(long M, long N,
		     complex float U[M][(N > M) ? M : N],
		     complex float VH[(N > M) ? M : N][N],
		     float S[(N > M) ? M : N],
		     complex float A[N][M])
{
	PTR_ALLOC(float[MIN(M, N) - 1], superb);
	LAPACKE(cgesvd, 'S', 'S', M, N, &A[0][0], M, S, &U[0][0], M, &VH[0][0], MIN(M, N), *superb);
	PTR_FREE(superb);
}

void lapack_eig_double(long N, double eigenval[N], complex double matrix[N][N])
{
	LAPACKE(zheev, 'V', 'U', N, &matrix[0][0], N, eigenval);
}

void lapack_svd_double(long M, long N, complex double U[M][M], complex double VH[N][N], double S[(N > M) ? M : N], complex double A[N][M])
{
	LAPACKE(zgesdd, 'A', M, N, &A[0][0], M, S, &U[0][0], M, &VH[0][0], N);
}

static void lapack_cholesky_UL(long N, char UL, complex float A[N][N])
{
	LAPACKE(cpotrf, UL, N, &A[0][0], N);
}

void lapack_cholesky(long N, complex float A[N][N])
{
	lapack_cholesky_UL(N, 'U', A);
}

void lapack_cholesky_lower(long N, complex float A[N][N])
{
	lapack_cholesky_UL(N, 'L', A);
}

static void lapack_trimat_inverse_UL(long N, char UL, complex float A[N][N])
{
	LAPACKE(ctrtri, UL, 'N', N, &A[0][0], N);
}

void lapack_trimat_inverse(long N, complex float A[N][N])
{
	lapack_trimat_inverse_UL(N, 'U', A);
}

void lapack_trimat_inverse_lower(long N, complex float A[N][N])
{
	lapack_trimat_inverse_UL(N, 'L', A);
}


// lu2t.c
//
// test program for blocked LU decomposition
//
// Time-stamp: <09/08/31 00:41:24 makino>

#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#ifndef NOBLAS
#include <cblas.h>
#endif
#include <lu2tlib.h>
void timer_init();
double cpusec();
double wsec();
#define FTYPE double
void copymats( int n, double a[n+1][n], double a2[n+1][n])

{
    int i, j;
    for(j=0;j<n+1;j++)
	for(i=0;i<n;i++)
	    a2[j][i] = a[j][i];
}

void showresult(int n, double a[n+1][n], double x[])
{
    int i, j;
    double emax = 0;
    for(i=0;i<n;i++){
	int k;
	double b2=0;
	printf("%3d: ", i);
	//	for(j=0;j<n;j++) printf(" %10.3e", a[j][i]);
	for(j=0;j<n;j++) b2 += a[j][i] * x[j];
	double err = b2-a[n][i];
        emax =  (fabs(err) > emax) ? fabs(err):emax;
	printf(" %10.3e  %10.3e %10.3e %10.3e \n", x[i], a[n][i], b2, err);
    }
    printf("Emax= %10.3e\n", emax);
}

void readmat( int n, double a[n+1][n])
{
    int i, j;
    for(i=0;i<n;i++){
	for(j=0;j<n+1;j++) scanf("%le", &(a[j][i]));
    }
}

void printmat( int n, double a[n+1][n])

{
    int i, j;
    for(i=0;i<n;i++){
	printf("%3d: ", i);
	for(j=0;j<n+1;j++) printf(" %10.3e", a[j][i]);
	printf("\n");
    }
    printf("\n");
}

void backward_sub(int n,double a[n+1][n], double b[])
{
    int i,j,k;
    for (i=0;i<n;i++)b[i] = a[n][i];
    for(j=n-2;j>=0;j--)
	for(k=j+1;k<n;k++) b[j] -= b[k]*a[k][j];
}

void lu( int n, double a[n+1][n], double b[])
{
    int i, j, k;
    for(i=0;i<n-1;i++){
	// select pivot
	double amax = fabs(a[i][i]);
	int p=i;
	for(j=i+1;j<n;j++){
	    if (fabs(a[i][j]) > amax){
		amax = fabs(a[i][j]);
		p = j;
	    }
	}
	// exchange rows
	if (p != i){
	    for(j=i;j<n+1;j++){
		double tmp = a[j][p];
		a[j][p] = a[j][i];
		a[j][i]=tmp;
	    }
	}

	// normalize row i
	double ainv = 1.0/a[i][i];
	//	fprintf(stderr,"%d %e\n", i, ainv);
	for(k=i+1;k<n+1;k++) a[k][i]*= ainv;
	// subtract row i from all lower rows
	for(j=i+1;j<n;j++){
	    //	    fprintf(stderr,"j=%d \n",j);
	    for(k=i+1;k<n+1;k++) a[k][j] -= a[i][j] * a[k][i];
	}
    }
    printmat(n,a);

    a[n][n-1] /= a[n-1][n-1];
    backward_sub(n,a,b);
}

void lumcolumn( int n, double a[n+1][n], double b[], int m, int pv[],
		int recursive)
{
    int i;
    for(i=0;i<n;i+=m){
	if (recursive){
	    cm_column_decomposition_recursive(n, a+i, m, pv,i);
	}else{
	    cm_column_decomposition(n, a+i, m, pv,i);
	}
	cm_process_right_part(n,a+i,m,pv,i,n+1);
    }
    backward_sub(n,a,b);
}

main()
{
    int n;
    fprintf(stderr, "Enter n:");
    scanf("%d", &n);
    printf("N=%d\n", n);
#if 0
    double a[n+1][n];
    double b[n];
    double acopy[n+1][n];
    double bcopy[n];
    int pv[n];
#endif
    double (*a)[];
    double (*acopy)[];
    int * pv;
    double *b, *bcopy;
    a = (double(*)[]) malloc(sizeof(double)*n*(n+1));
    acopy = (double(*)[]) malloc(sizeof(double)*n*(n+1));
    b = (double*)malloc(sizeof(double)*n);
    bcopy = (double*)malloc(sizeof(double)*n);
    pv = (int*)malloc(sizeof(int)*n);
    readmat(n,a);
    copymats(n,a,acopy);
    //    printmat(n,a,b);
    //    lu2columnv2(n,a,b);
    //    lu2columnv2(n,a,b);
    //    lub(n,a,b,NBK);
    //    printmat(n,a,b);
    //    showresult(n,acopy, b, bcopy);
    //    copymats(n,acopy,bcopy,a, b);
    //    lu(n,a,b);
    timer_init();
    lumcolumn(n,a,b,16,pv,1);
    double ctime=cpusec();
    double wtime=wsec();
    showresult(n,acopy, b);
    printf("cpsec =  %g wsec=%g\n",   ctime, wtime);
    return 0;
}


/**
 *
 * @generated d Tue Jan  7 11:45:26 2014
 *
 **/
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <math.h>
#ifdef USE_MKL
#include <mkl_cblas.h>
#include <mkl_lapacke.h>
#else
#include <cblas.h>
#include <lapacke.h>
#endif
#include "plasma.h"
#include <core_blas.h>
#include "auxiliary.h"

/*--------------------------------------------------------------
 * Check the solution
 */

double d_check_solution(int M, int N, int NRHS, double *A, int LDA,
                      double *B,  double *X, int LDB)
{
/*     int info_solution; */
    double Rnorm = -1.00;
    double zone  =  1.0;
    double mzone = -1.0;
    double *work = (double *)malloc(max(M, N)* sizeof(double));

    LAPACKE_dlange_work(LAPACK_COL_MAJOR, 'i', M, N,    A, LDA, work);
    LAPACKE_dlange_work(LAPACK_COL_MAJOR, 'i', M, NRHS, X, LDB, work);
    LAPACKE_dlange_work(LAPACK_COL_MAJOR, 'i', N, NRHS, B, LDB, work);

    cblas_dgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, M, NRHS, N, (zone), A, LDA, X, LDB, (mzone), B, LDB);

    Rnorm = LAPACKE_dlange_work(LAPACK_COL_MAJOR, 'i', N, NRHS, B, LDB, work);

    free(work);

    return Rnorm;
}


/*
	STOCHASTIC LOTKA-VOLTERRA MODEL WITH MULTIDIMENSIONAL NICHE SPACES
	by Tommaso Biancalani <tommasob@mit.edu>

	Supporting Material to the paper:
	"Framework for analyzing ecological trait-based models in multidimensional niche spaces" - Phys. Rev. E 91, 052107

	ABSTRACT
	We develop a theoretical framework for analyzing ecological models with a multidimensional niche space. Our approach relies on the fact that ecological niches are described by sequences of symbols, which allows us to include multiple phenotypic traits. Ecological drivers, such as competitive exclusion, are modeled by introducing the Hamming distance between two sequences. We show that a suitable transform diagonalizes the community interaction matrix of these models, making it possible to predict the conditions for niche differentiation and, close to the instability onset, the asymptotically long time population distributions of niches. We exemplify our method using the Lotka-Volterra equations with an exponential competition kernel.

	INSTALL
 	The code requires the GSL (GNU Scientific Library). On linux, I simply compile it with:
 	$ gcc lotka-volterra.c -lgsl -lgslcblas -lm -Wall -o "lotka-volterra"
 */

#include <stdio.h>
#include <string.h>
#include <unistd.h>
#include <stdlib.h>
#include <sys/types.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <sys/time.h>
#include <time.h>
#include <sys/select.h>
#include <math.h>

// Headers for special functions
#include <gsl/gsl_math.h>
#include <gsl/gsl_sf_exp.h>

// Headers for Mersenne-Twister random generator
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>

// Global variables
#define R_CONST		1.			// Competition kernel length scale
#define	SIGMA		2			// Competition kernel exponent
#define	V_CONST		100.		// System size of single compartment
#define	T_SAMP		1. 			// Sampling time (outputs every T_SAMP)
#define	TOT_TIME	100. 		// Evolve the system until t/V = TOT_TIME

// Sequence space definitions (sequences are called 'genomes')
typedef char GENOME_S;
typedef unsigned int GENOME_N;
#define	C_CONST	5.52486			// Competition kernel normalization constant
#define L 	3					// Phenotype length
#define NUM_GENOMES	54			// Total number of genome in the systems
const int DELTA[L] = {3,9,2};  	// It specifies the sequence space
GENOME_S *genome_0 = "000";
GENOME_S genome_db[NUM_GENOMES][L+1];
#define A(k1,k2) (k1)+2*(k2)  	// reaction k1 in genome k2
FILE *out;
unsigned int *org;				// org[I]: number of organisms with genome I

// GSL rn definitions (Mersenne-Twister)
const gsl_rng_type * rgT;
gsl_rng * rg;
double rn;
unsigned long int seed;
/**********************************************************/

GENOME_S *genome_num2str(GENOME_N I)
{
/*
	Helper for converting genomes from numbers (GENOME_N) to string (GENOME_S).
	Return converted genome in string format.
*/
	int l;
	GENOME_S *tbl = "0123456789abcdefghijklmnopqrstuvwxyz";
	GENOME_S *out;
	out = (GENOME_S *) malloc(sizeof(GENOME_S)*L);
	memcpy(out, genome_0, sizeof(GENOME_S)*L);
	int len = L-1;
	for(l=0; 1; l++)
	{
		 out[len--] = tbl[I % DELTA[l]];
		 if((I /= DELTA[l]) == 0)
		 	break;
	}
	return out;
}

unsigned int Hamming_dist(GENOME_S *genome_I, GENOME_S *genome_J)
{
/*
	Return Hamming distance between genomes I and J
*/
	int l;
	unsigned int ham_dist=L;
	for(l=0; l<L; l++)
		if(genome_I[l] - genome_J[l] == 0)
			ham_dist--;
	return ham_dist;
}

double G_IJ(GENOME_S *genome_I, GENOME_S *genome_J) {
/*
	Return competition rate G on genome I due to genome J.
*/
	double arg, ham_dist;
	ham_dist = ((double)Hamming_dist(genome_I, genome_J)) / R_CONST;
	arg = gsl_pow_int(ham_dist, SIGMA);
	return gsl_sf_exp(-arg);
}

int gillespie_evolve()
{
/*
	Print model dynamic on standard output. Dynamic is computed using Gillespie's algorithm. Return zero when time reaches TOT_TIME.
*/
	GENOME_N I, J;		// Genome indexes
	int k;				// Reaction index
	long int step; 		// Time iteration index
	int sample_step;	// Sampled time iteration index
	double tau, t; 		// Stochastic times
	double *T_rates; 	// Transition rates
	double T_sum, Tr2, T_tmp;
	double rn; 			// rand number

	// Allocate memory for transition rates
	T_rates = (double *)malloc(sizeof(double) * NUM_GENOMES * 2);

	// Main Loop
	t=0.; step=0; sample_step=0;
	while(t < TOT_TIME)
	{
		// Output as time reaches next sampled time
		if(t > (double) (T_SAMP * sample_step))
		{
			for(I=0; I<NUM_GENOMES; I++)
				fprintf(out, "%.3f ", org[I]/V_CONST);
			fprintf(out, "\n");
			sample_step++;
		}

		// Compute transiton rates
		for (I=0; I<NUM_GENOMES; I++)
		{
			T_rates[A(0, I)] = org[I]; 	// reaction 0 = birth
			T_rates[A(1, I)] = 0.; 		// reaction 1 = death
			for(J=0; J<NUM_GENOMES; J++)
				T_rates[A(1,I)] += G_IJ(genome_db[I], genome_db[J]) * org[J];
			T_rates[A(1,I)] *= org[I] / (V_CONST * C_CONST);
		}

		// Compute total transition rate
		T_sum = 0.;
		for(I=0; I<NUM_GENOMES; I++)
			T_sum += T_rates[A(0, I)] + T_rates[A(1, I)];

		// Generate next reaction time (tau)
		rn = gsl_rng_uniform_pos(rg);
		tau = (1./T_sum) * log(1./rn);

		// Update time
		t += tau;

		// Generate what reaction occurs and on which species
		Tr2 = gsl_rng_uniform_pos(rg) * T_sum;
		T_tmp = 0.;
		for (I=0; I<NUM_GENOMES; I++)
		{
			for(k=0; k<2; k++)
			{
				T_tmp += T_rates[A(k,I)];
				if(T_tmp >= Tr2)  goto gotten; // this is a fine use of goto :-)
			}
		}
		gotten:

		// Execute reaction i on species k
		switch(k) // Wich reaction?
		{
			// BIRTH
			case 0:
				org[I]++;
			break;

			// DEATH
			case 1:
				org[I]--;
			break;
		}
		// update step
		step = step+1;
	} // main loop
	return 0;
} // gillespe_evolve()

int main(int argc, char * argv[])
{
/*
	Main function. Arguments are not processed. The model parameters are set by the constants and globals defined at the beginning of the code.
*/
	GENOME_N I; // Genome index

	// Initialize random generator
	srand(time(NULL));
	seed = (unsigned long int)rand();
	rgT = gsl_rng_default; // default = Mersenne Twister
	rg = gsl_rng_alloc (rgT);
	gsl_rng_set (rg, seed);

	// Initialize organisms, e.g. org[23] = number of organisms with genome 23
	org = (unsigned int *)malloc(sizeof(unsigned int) * NUM_GENOMES);

	// Initialize system around homogeneous state
	for (I=0; I<NUM_GENOMES; I++)
		org[I] = V_CONST;

	// Set file descriptor for output
	out = stdout;

	// Initialize genome space
	for(I=0; I<NUM_GENOMES; I++)
		strcpy(genome_db[I], genome_num2str(I));

	// Compute model dynamic
	gillespie_evolve();

	// Free descriptors and quit
	fclose(out);
	gsl_rng_free(rg);
	return 0;
} // main()


#include <math.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include "cconfigspace_internal.h"
#include "distribution_internal.h"

struct _ccs_distribution_uniform_data_s {
	_ccs_distribution_common_data_t common_data;
	ccs_numeric_t                   lower;
	ccs_numeric_t                   upper;
	ccs_scale_type_t                scale_type;
	ccs_numeric_t                   quantization;
	ccs_numeric_type_t              internal_type;
	ccs_numeric_t                   internal_lower;
        ccs_numeric_t                   internal_upper;
	int                             quantize;
};
typedef struct _ccs_distribution_uniform_data_s _ccs_distribution_uniform_data_t;

static ccs_result_t
_ccs_distribution_del(ccs_object_t o) {
	(void)o;
	return CCS_SUCCESS;
}

static ccs_result_t
_ccs_distribution_uniform_get_bounds(_ccs_distribution_data_t *data,
                                     ccs_interval_t           *interval_ret);

static ccs_result_t
_ccs_distribution_uniform_samples(_ccs_distribution_data_t *data,
                                  ccs_rng_t                 rng,
                                  size_t                    num_values,
                                  ccs_numeric_t            *values);

static ccs_result_t
_ccs_distribution_uniform_strided_samples(_ccs_distribution_data_t *data,
                                          ccs_rng_t                 rng,
                                          size_t                    num_values,
                                          size_t                    stride,
                                          ccs_numeric_t            *values);

static ccs_result_t
_ccs_distribution_uniform_soa_samples(_ccs_distribution_data_t  *data,
                                      ccs_rng_t                  rng,
                                      size_t                     num_values,
                                      ccs_numeric_t            **values);

static _ccs_distribution_ops_t _ccs_distribution_uniform_ops = {
	{ &_ccs_distribution_del },
	&_ccs_distribution_uniform_samples,
	&_ccs_distribution_uniform_get_bounds,
	&_ccs_distribution_uniform_strided_samples,
	&_ccs_distribution_uniform_soa_samples
 };

static ccs_result_t
_ccs_distribution_uniform_get_bounds(_ccs_distribution_data_t *data,
                                     ccs_interval_t           *interval_ret) {
	_ccs_distribution_uniform_data_t *d = (_ccs_distribution_uniform_data_t *)data;
        ccs_numeric_t          l;
	ccs_bool_t             li;
	ccs_numeric_t          u;
	ccs_bool_t             ui;

	l = d->lower;
	li = CCS_TRUE;
	u = d->upper;
        ui = CCS_FALSE;
	interval_ret->type = d->common_data.data_types[0];
	interval_ret->lower = l;
	interval_ret->upper = u;
	interval_ret->lower_included = li;
	interval_ret->upper_included = ui;
	return CCS_SUCCESS;
}

static ccs_result_t
_ccs_distribution_uniform_strided_samples(_ccs_distribution_data_t *data,
                                          ccs_rng_t                 rng,
                                          size_t                    num_values,
                                          size_t                    stride,
                                          ccs_numeric_t            *values) {
	_ccs_distribution_uniform_data_t *d = (_ccs_distribution_uniform_data_t *)data;
	size_t i;
	const ccs_numeric_type_t  data_type      = d->common_data.data_types[0];
	const ccs_scale_type_t    scale_type     = d->scale_type;
	const ccs_numeric_t       quantization   = d->quantization;
	const ccs_numeric_t       lower          = d->lower;
	const ccs_numeric_t       internal_lower = d->internal_lower;
	const ccs_numeric_t       internal_upper = d->internal_upper;
	const int                 quantize       = d->quantize;
	gsl_rng *grng;
	CCS_VALIDATE(ccs_rng_get_gsl_rng(rng, &grng));

	if (data_type == CCS_NUM_FLOAT) {
		for (i = 0; i < num_values; i++) {
			values[i*stride].f = gsl_ran_flat(grng, internal_lower.f, internal_upper.f);
		}
		if (scale_type == CCS_LOGARITHMIC) {
			for (i = 0; i < num_values; i++)
				values[i*stride].f = exp(values[i*stride].f);
			if (quantize)
				for (i = 0; i < num_values; i++)
					values[i*stride].f = floor((values[i*stride].f - lower.f)/quantization.f) * quantization.f + lower.f;
		} else
			if (quantize)
				for (i = 0; i < num_values; i++)
					values[i*stride].f = floor(values[i*stride].f) * quantization.f + lower.f;
			else
				for (i = 0; i < num_values; i++)
					values[i*stride].f += lower.f;
	} else {
		if (scale_type == CCS_LOGARITHMIC) {
			for (i = 0; i < num_values; i++) {
				values[i*stride].i = floor(exp(gsl_ran_flat(grng, internal_lower.f, internal_upper.f)));
			}
			if (quantize)
				for (i = 0; i < num_values; i++)
					values[i*stride].i = ((values[i*stride].i - lower.i)/quantization.i) * quantization.i + lower.i;
		} else {
			for (i = 0; i < num_values; i++) {
				values[i*stride].i = gsl_rng_uniform_int(grng, internal_upper.i);
			}
			if (quantize)
				for (i = 0; i < num_values; i++)
					values[i*stride].i = values[i*stride].i * quantization.i + lower.i;
			else
				for (i = 0; i < num_values; i++)
					values[i*stride].i += lower.i;
		}
	}
	return CCS_SUCCESS;
}

static ccs_result_t
_ccs_distribution_uniform_samples(_ccs_distribution_data_t *data,
                                  ccs_rng_t                 rng,
                                  size_t                    num_values,
                                  ccs_numeric_t            *values) {
	_ccs_distribution_uniform_data_t *d = (_ccs_distribution_uniform_data_t *)data;
	size_t i;
	const ccs_numeric_type_t  data_type      = d->common_data.data_types[0];
	const ccs_scale_type_t    scale_type     = d->scale_type;
	const ccs_numeric_t       quantization   = d->quantization;
	const ccs_numeric_t       lower          = d->lower;
	const ccs_numeric_t       internal_lower = d->internal_lower;
	const ccs_numeric_t       internal_upper = d->internal_upper;
	const int                 quantize       = d->quantize;
	gsl_rng *grng;
	CCS_VALIDATE(ccs_rng_get_gsl_rng(rng, &grng));

	if (data_type == CCS_NUM_FLOAT) {
		for (i = 0; i < num_values; i++) {
			values[i].f = gsl_ran_flat(grng, internal_lower.f, internal_upper.f);
		}
		if (scale_type == CCS_LOGARITHMIC) {
			for (i = 0; i < num_values; i++)
				values[i].f = exp(values[i].f);
			if (quantize)
				for (i = 0; i < num_values; i++)
					values[i].f = floor((values[i].f - lower.f)/quantization.f) * quantization.f + lower.f;
		} else
			if (quantize)
				for (i = 0; i < num_values; i++)
					values[i].f = floor(values[i].f) * quantization.f + lower.f;
			else
				for (i = 0; i < num_values; i++)
					values[i].f += lower.f;
	} else {
		if (scale_type == CCS_LOGARITHMIC) {
			for (i = 0; i < num_values; i++) {
				values[i].i = floor(exp(gsl_ran_flat(grng, internal_lower.f, internal_upper.f)));
			}
			if (quantize)
				for (i = 0; i < num_values; i++)
					values[i].i = ((values[i].i - lower.i)/quantization.i) * quantization.i + lower.i;
		} else {
			for (i = 0; i < num_values; i++) {
				values[i].i = gsl_rng_uniform_int(grng, internal_upper.i);
			}
			if (quantize)
				for (i = 0; i < num_values; i++)
					values[i].i = values[i].i * quantization.i + lower.i;
			else
				for (i = 0; i < num_values; i++)
					values[i].i += lower.i;
		}
	}
	return CCS_SUCCESS;
}

static ccs_result_t
_ccs_distribution_uniform_soa_samples(_ccs_distribution_data_t  *data,
                                      ccs_rng_t                  rng,
                                      size_t                     num_values,
                                      ccs_numeric_t            **values) {
	if (*values)
		return _ccs_distribution_uniform_samples(data, rng, num_values, *values);
	return CCS_SUCCESS;
}

ccs_result_t
ccs_create_uniform_distribution(ccs_numeric_type_t  data_type,
                                ccs_numeric_t       lower,
                                ccs_numeric_t       upper,
                                ccs_scale_type_t    scale_type,
                                ccs_numeric_t       quantization,
                                ccs_distribution_t *distribution_ret) {
	CCS_CHECK_PTR(distribution_ret);
	if (data_type != CCS_NUM_FLOAT && data_type != CCS_NUM_INTEGER)
		return -CCS_INVALID_TYPE;
	if (scale_type != CCS_LINEAR && scale_type != CCS_LOGARITHMIC)
		return -CCS_INVALID_SCALE;
	if (data_type == CCS_NUM_INTEGER && (
		lower.i >= upper.i ||
		(scale_type == CCS_LOGARITHMIC && lower.i <= 0) ||
		quantization.i < 0 ||
		quantization.i > upper.i - lower.i ) )
		return -CCS_INVALID_VALUE;
	if (data_type == CCS_NUM_FLOAT && (
		lower.f >= upper.f ||
		(scale_type == CCS_LOGARITHMIC && lower.f <= 0.0) ||
		quantization.f < 0.0 ||
		quantization.f > upper.f - lower.f ) )
		return -CCS_INVALID_VALUE;
	uintptr_t mem = (uintptr_t)calloc(1, sizeof(struct _ccs_distribution_s) + sizeof(_ccs_distribution_uniform_data_t) + sizeof(ccs_numeric_type_t));

	if (!mem)
		return -CCS_OUT_OF_MEMORY;
	ccs_distribution_t distrib = (ccs_distribution_t)mem;
	_ccs_object_init(&(distrib->obj), CCS_DISTRIBUTION, (_ccs_object_ops_t *)&_ccs_distribution_uniform_ops);
        _ccs_distribution_uniform_data_t * distrib_data = (_ccs_distribution_uniform_data_t *)(mem + sizeof(struct _ccs_distribution_s));
	distrib_data->common_data.data_types    = (ccs_numeric_type_t *)(mem + sizeof(struct _ccs_distribution_s) + sizeof(_ccs_distribution_uniform_data_t));
	distrib_data->common_data.type          = CCS_UNIFORM;
	distrib_data->common_data.dimension     = 1;
	distrib_data->common_data.data_types[0] = data_type;
	distrib_data->scale_type                = scale_type;
	distrib_data->quantization              = quantization;
	distrib_data->lower                     = lower;
	distrib_data->upper                     = upper;

	if (data_type == CCS_NUM_FLOAT) {
		if (quantization.f != 0.0)
			distrib_data->quantize = 1;
		if (scale_type == CCS_LOGARITHMIC) {
			distrib_data->internal_lower.f = log(lower.f);
			distrib_data->internal_upper.f = log(upper.f);
		} else {
			distrib_data->internal_lower.f = 0.0;
			distrib_data->internal_upper.f = upper.f - lower.f;
			if (distrib_data->quantize)
				distrib_data->internal_upper.f /= quantization.f;
		}
	} else {
		if (quantization.i != 0)
			distrib_data->quantize = 1;
		if (scale_type == CCS_LOGARITHMIC) {
			distrib_data->internal_lower.f = log(lower.i);
			distrib_data->internal_upper.f = log(upper.i);
		} else {
			distrib_data->internal_lower.i = 0;
			distrib_data->internal_upper.i = upper.i - lower.i;
			if (quantization.i != 0)
				distrib_data->internal_upper.i /= quantization.i;
		}
	}
	distrib->data = (_ccs_distribution_data_t *)distrib_data;
	*distribution_ret = distrib;
	return CCS_SUCCESS;
}

ccs_result_t
ccs_uniform_distribution_get_parameters(ccs_distribution_t  distribution,
                                        ccs_numeric_t      *lower_ret,
                                        ccs_numeric_t      *upper_ret,
                                        ccs_scale_type_t   *scale_type_ret,
                                        ccs_numeric_t      *quantization_ret) {
	CCS_CHECK_DISTRIBUTION(distribution, CCS_UNIFORM);
	if (!lower_ret && !upper_ret && !scale_type_ret && !quantization_ret)
		return -CCS_INVALID_VALUE;
	_ccs_distribution_uniform_data_t * data = (_ccs_distribution_uniform_data_t *)distribution->data;

	if (lower_ret)
		*lower_ret = data->lower;
	if (upper_ret)
		*upper_ret = data->upper;
	if (scale_type_ret)
		*scale_type_ret = data->scale_type;
	if (quantization_ret)
		*quantization_ret = data->quantization;
	return CCS_SUCCESS;
}


/**
 *
 * @file core_zpltmg_chebvand.c
 *
 *  PLASMA core_blas kernel
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Mathieu Faverge
 * @date 2010-11-15
 * @precisions normal z -> c d s
 *
 **/
#include <lapacke.h>
#include <math.h>
#include "common.h"

/***************************************************************************//**
 *
 * @ingroup CORE_PLASMA_Complex64_t
 *
 *  CORE_zpltmg_chebvand is a kernel used in Vandermonde-like matrix generation
 *
 *  See http://www.mathworks.fr/fr/help/matlab/ref/gallery.html#f84-999859
 *
 *  Vandermonde-like matrix for the Chebyshev polynomials
 *
 *  Produces the (primal) Chebyshev Vandermonde matrix based on the vector of
 *  points p, which define where the Chebyshev polynomial is calculated.
 *
 *  If seed != 0, C(i,j) = Ti – 1(p(j)) where Ti – 1 is the Chebyshev
 *  polynomial of degree i – 1, and p is a vector of N equally spaced points on
 *  the interval [0,1].
 *
 *******************************************************************************
 *
 * @param[in] M
 *         The number of rows of the tile A to initialize. M >= 2.
 *
 * @param[in] N
 *         The number of columns of the tile A to initialize. N >= 0.
 *
 * @param[out] A
 *         On entry, the M-by-N tile to be initialized.
 *         On exit, each element of A is defined by:
 *         A(i,j) = Ti – 1(p(j)) where Ti – 1 is the Chebyshev polynomial of
 *         degree i – 1
 *
 * @param[in] LDA
 *         The leading dimension of the tile A. LDA >= max(1,M).
 *
 * @param[in] gN
 *         The global number of columns of the full matrix, A is belonging to. gN >= (n0+gN).
 *
 * @param[in] m0
 *         The index of the first row of tile A in the full matrix. m0 >= 0.
 *
 * @param[in] n0
 *         The index of the first column of tile A in the full matrix. n0 >= 0.
 *
 * @param[in] gN
 *         The global number of columns of the full matrix, A is belonging to. gN >= (n0+gN).
 *
 * @param[in,out] W
 *          Workspace of size 2-by-N, that contains the N triplets:
 *               ( A( m0-2, j), A(m0-1, j) )
 *          On entry, if m == 0, W is uinitialized, otherwise contains the data
 *          described above.
 *          On exit, contains the triplets ( A(m0+M-2, j), A(m0+M-1, j) )
 *
 *******************************************************************************
 *
 * @return
 *         \retval PLASMA_SUCCESS successful exit
 *         \retval <0 if INFO = -k, the k-th argument had an illegal value
 *
 ******************************************************************************/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_zpltmg_chebvand = PCORE_zpltmg_chebvand
#define CORE_zpltmg_chebvand PCORE_zpltmg_chebvand
#endif
int CORE_zpltmg_chebvand( int M, int N, PLASMA_Complex64_t *A, int LDA,
                          int gN, int m0, int n0,
                          PLASMA_Complex64_t *W )
{
    PLASMA_Complex64_t step;
    int i, j, jj;

    /* Check input arguments */
    if (M < 0) {
        coreblas_error(1, "Illegal value of M");
        return -1;
    }
    if (N < 0) {
        coreblas_error(2, "Illegal value of N");
        return -2;
    }
    if ((LDA < max(1,M)) && (M > 0)) {
        coreblas_error(4, "Illegal value of LDA");
        return -4;
    }
    if (m0 < 0) {
        coreblas_error(6, "Illegal value of m0");
        return -6;
    }
    if (n0 < 0) {
        coreblas_error(7, "Illegal value of n0");
        return -7;
    }
    if (gN < n0+N) {
        coreblas_error(5, "Illegal value of gN");
        return -5;
    }

    step = (PLASMA_Complex64_t)1. / (gN - 1.);

    /* Initialize W if required */
    if (m0 == 0) {
        for (j=0, jj=n0; j<N; j++, jj++) {
            W[2*j  ] = 1.;
            W[2*j+1] = jj * step;
        }

        if ( M == 1 ) {
            LAPACKE_zlacpy_work( LAPACK_COL_MAJOR, 'A',
                                 1, N, W, 2, A, LDA );
            return PLASMA_SUCCESS;
        }

        LAPACKE_zlacpy_work( LAPACK_COL_MAJOR, 'A',
                             2, N, W, 2, A, LDA );

        M -= 2;
        A += 2;
    }

    /* Case NB=1, W contains row 0 and 1 and M should be 1 */
    if (m0 == 1) {
        if (M != 1) {
            coreblas_error(1, "Illegal value of M for m0 = 1");
            return -1;
        }

        LAPACKE_zlacpy_work( LAPACK_COL_MAJOR, 'A',
                             1, N, W+1, 2, A, LDA );
        return PLASMA_SUCCESS;
    }

    for (j=0, jj=n0; j<N; j++, jj++) {
        /* First line */
        if (M > 0) {
            A[LDA*j] = 2. * jj * step * W[j*2 + 1] - W[j*2  ];
        }

        /* Second line */
        if (M > 1) {
            A[LDA*j+1] = 2. * jj * step * A[LDA*j  ] - W[j*2+1];
        }

        for (i=2; i<M; i++) {
            A[LDA*j+i] = 2. * jj * step * A[LDA*j+i-1] - A[LDA*j+i-2];
        }
    }

    if ( M == 1 ) {
        cblas_zcopy( N, W+1, 2, W, 2 );
        cblas_zcopy( N, A+M-1, LDA, W+1, 2 );
    }
    else {
        LAPACKE_zlacpy_work( LAPACK_COL_MAJOR, 'A',
                             2, N, A + M - 2, LDA, W, 2 );
    }

    return PLASMA_SUCCESS;
}


#include <math.h>
#include <gsl/gsl_statistics.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_cdf.h>
#include <gsl/gsl_randist.h>

double t_test(const double *data1, int n1, const double *data2, int n2)
{
    double mean1, mean2, var1, var2, num, sp, denom, t, dof, p;
    mean1 = gsl_stats_mean(data1, 1, n1);
    mean2 = gsl_stats_mean(data2, 1, n2);
    var1 = gsl_stats_variance(data1, 1, n1);
    var2 = gsl_stats_variance(data2, 1, n2);
    num = mean1 - mean2;
    sp = sqrt((((n1 - 1) * var1) + ((n2 - 1) * var2)) / (n1 + n2 - 2));
    denom = sp * sqrt((1 / (double) n1) + (1 / (double) n2));
    t = fabs(num / denom);
    dof = (double) n1 + n2 - 2;
    p = (1 - gsl_cdf_tdist_P(t, dof)) * 2;
    return p;
}


/**
 */
#include <math.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_statistics.h>
#include <gsl/gsl_multiroots.h>
#include "aXe_grism.h"
#include "aXe_utils.h"
#include "spc_trace_functions.h"
#include "disp_conf.h"
#include "trace_conf.h"
#include "crossdisp_utils.h"

/*
 * Function: print_state
 * The function prints a status report
 * on a multi-dimensional root finding
 * solver onto the screen
 *
 * Parameters:
 * @param iter - the iteration number
 * @param s    - the multi-d solver
 */

void print_state (size_t iter, gsl_multiroot_fsolver *s)
{
  printf ("iter = %3zu x = % .3f % .3f "
          "f(x) = % .3e % .3e\n",
          iter,
          gsl_vector_get (s->x, 0),
          gsl_vector_get (s->x, 1),
          gsl_vector_get (s->f, 0),
          gsl_vector_get (s->f, 1));
  // print: current x-value, y-value, x-error, y-error
}

/*
 * Function: drizzle_distort
 * This function can be passed to a gsl multi-d function.
 * It defines the function:
 * x'=f'(x,y) = f(x,y)-x_0
 * y'=g'(x,y) = g(x,y)-y_0
 * with f(x,y) and g(x,y) the equations to undistort
 * the coordinates x and y, respectively and the
 * constants x_0 and y_0.
 * Solving for f'(x,y)=g'(x,y)=0.0
 * means to find (x,y) such that
 * f(x,y) = x_0 and g(x,y) = y_0.
 *
 * Parameters:
 * @param x      - the input x,y
 * @param params - the parameters for the function
 * @param f      - the result values in x,y
 *
 * Returns:
 * @return GSL_SUCCESS - always
 */
int
drizzle_distort(const gsl_vector * x, void *params, gsl_vector * f)
{
  // extract the components from the parameter-structure
  gsl_matrix *coeffs = ((drz_pars *) params)->coeffs;
  px_point  npixels = ((drz_pars *) params)->npixels;
  d_point offset = ((drz_pars *) params)->offset;

  d_point xy_in;
  d_point xy_out;

  // extract the input
  xy_in.x = gsl_vector_get(x,0);
  xy_in.y = gsl_vector_get(x,1);

  // undistort the input
  xy_out = get_drz_position(xy_in, coeffs, npixels);

  // subtract the input
  xy_out.x = xy_out.x-offset.x;
  xy_out.y = xy_out.y-offset.y;

  // set the output
  gsl_vector_set(f, 0, xy_out.x);
  gsl_vector_set(f, 1, xy_out.y);

  // return always the same
  return GSL_SUCCESS;
}

/*
 * Function: distort_point
 * The function finds the distorted coordinates
 * for a given undistorted coordinate and the
 * transformations to get the undistorted coordinates.
 * This function makes the inverse transformation
 * to the drizzle transformation.
 *
 * Parameters:
 * @param coeffs   - the drizzle coefficients
 * @param pixmax   - the image dimensions
 * @param xy_image - the undistorted (x,y)
 *
 * Returns:
 * @return xy_ret - the distorted (x,y)
 */
d_point
distort_point(gsl_matrix *coeffs, const px_point pixmax, d_point xy_image)
{
  const gsl_multiroot_fsolver_type *msolve_type;
  gsl_multiroot_fsolver *msolve;

  int status;
  size_t iter = 0;

  //const size_t n = 2;

  gsl_multiroot_function mult_func;

  drz_pars   *drzpars;
  gsl_vector *xy_in = gsl_vector_alloc(2);
  gsl_vector *xy_out = gsl_vector_alloc(2);
  d_point xy_ret;

  // set up the parameters for the
  // multi-d function
  drzpars = (drz_pars *) malloc(sizeof(drz_pars));
  drzpars->coeffs = coeffs;
  drzpars->offset = xy_image;
  drzpars->npixels = pixmax;

  // set up the multi-d function
  mult_func.f = &drizzle_distort;
  mult_func.n = 2;
  mult_func.params = drzpars;

  // set the starting coordinates
  gsl_vector_set(xy_in, 0, xy_image.x);
  gsl_vector_set(xy_in, 1, xy_image.y);

  // allocate and initialize the multi-d solver
  msolve_type = gsl_multiroot_fsolver_dnewton;
  msolve = gsl_multiroot_fsolver_alloc (msolve_type, 2);
  gsl_multiroot_fsolver_set (msolve, &mult_func, xy_in);

  //  print_state (iter, msolve);

  // iterate
  do
  {
    // count the number of iterations
    iter++;

    // do an iteration
    status = gsl_multiroot_fsolver_iterate (msolve);

    //    print_state (iter, msolve);

    // check if solver is stuck
    if (status)
      break;

    // evaluate the iteration
    status = gsl_multiroot_test_residual (msolve->f, 1e-7);
  }
  while (status == GSL_CONTINUE && iter < 1000);
  // chek for the break conditions

  // transfer the result to the return struct
  xy_ret.x = gsl_vector_get(msolve->x,0);
  xy_ret.y = gsl_vector_get(msolve->x,1);

  // deallocate the different structures
  gsl_multiroot_fsolver_free (msolve);
  gsl_vector_free(xy_in);
  gsl_vector_free(xy_out);

  // return the result
  return xy_ret;
}

/*
 * Function: undistort_point
 *
 * Parameters:
 * @param coeffs   - the drizzle coefficients
 * @param pixmax   - the image dimensions
 * @param xy_image - the undistorted (x,y)
 *
 * Returns:
 * @return xy_new - the undistorted (x,y)
 */
d_point
undistort_point(gsl_matrix *coeffs, const px_point pixmax, d_point xy_image)
{
  d_point xy_new;

  xy_new = get_drz_position(xy_image, coeffs, pixmax);

  return xy_new;
}

/*
 * Function: get_crossdisp_matrix
 * The function extracts the drizzle coefficients stored in the
 * keyword headers of an image extension and creates a matrix
 * to store those coefficients. The matrix is returned.
 * Currently the drizzle coefficients are ALWAYS stored in the
 * primary header of the grism images. For this reason
 * all keywords are read from extension '1' (hardcoded).
 *
 * Parameters:
 * @param  filename   - the image filename
 * @param  sci_numext - the extension number
 *
 * Returns:
 * @return ret - the matrix with the drizzle coefficients
 */
gsl_matrix  *
get_crossdisp_matrix(char * filename, int sci_numext)
{
  int ncoeffs;
  int i;
  gsl_matrix * ret;
  //px_point    pixmax;
  char templt[FLEN_CARD];
  float acoeff, tmp;

  // get the number of coefficients
  tmp = get_float_from_keyword(filename, 1, "DRZCNUM");
  //  tmp = get_float_from_keyword(filename, sci_numext, "DRZCNUM");
  if (isnan(tmp)){
    // in case that the keyword does not exist,
    // find a nice way out of the door
    aXe_message(aXe_M_FATAL, __FILE__, __LINE__,
                "Could not find drizzle keywords in: %s\n", filename);
    ret = gsl_matrix_alloc(1,1);
    gsl_matrix_set(ret, 0,0,GSL_NAN);
    return ret;
  }
  else {
    // cast the value to int
    ncoeffs = (int)tmp;
  }

  // allocate the matrix, set it to the default
  ret = gsl_matrix_alloc(2,ncoeffs);
  gsl_matrix_set_all (ret, 0.0);

  // go over the number of coefficients
  for (i=0; i<ncoeffs; i++){

    // set the name for the x-coefficient, get it and store it
    sprintf (templt, "DRZ%1iX%02i", sci_numext, i+1);
    //    acoeff = get_float_from_keyword(filename, sci_numext, templt);
    acoeff = get_float_from_keyword(filename, 1, templt);
    gsl_matrix_set(ret, 0,i,acoeff);

    // set the name for the y-coefficient, get it and store it
    sprintf (templt, "DRZ%1iY%02i", sci_numext, i+1);
    //    acoeff = get_float_from_keyword(filename, sci_numext, templt);
    acoeff = get_float_from_keyword(filename, 1, templt);
    gsl_matrix_set(ret, 1,i,acoeff);

  }

  // return the matrix
  return ret;
}

/*
 * Function: get_axis_scales
 * The function computes the distance scale along the major and
 * minor half axis of an object. The distance scale is subject
 * to changes due to the image distortion.
 *
 * Parameters:
 * @param actbeam   - the beam to get the drizzle scales for
 * @param drzcoeffs - the drizzle coefficients
 * @param pixmax    - the image dimensions
 *
 * Returns:
 * @return ret - the drizzle scales along major and minor half axis
 */
d_point
get_axis_scales(beam actbeam, gsl_matrix * drzcoeffs, px_point pixmax){

  d_point dispnt;
  d_point drz_ref;
  d_point drz_dis;

  d_point ret;

  // find a dummy point along the major half axis
  dispnt.x = actbeam.refpoint.x + cos(actbeam.aorient);
  dispnt.y = actbeam.refpoint.y + sin(actbeam.aorient);

  // compute the undistorted coos for the refpoint
  drz_ref = get_drz_position(actbeam.refpoint, drzcoeffs, pixmax);

  // compute the undistorted coos for the dummy point
  drz_dis = get_drz_position(dispnt, drzcoeffs, pixmax);

  // compute the scale along the major axis
  ret.x = sqrt((drz_ref.x-drz_dis.x)*(drz_ref.x-drz_dis.x) +
               (drz_ref.y-drz_dis.y)*(drz_ref.y-drz_dis.y));

  // find a dummy point along the minor half axis
  dispnt.x = actbeam.refpoint.x + cos(actbeam.aorient + M_PI/2.0);
  dispnt.y = actbeam.refpoint.y + sin(actbeam.aorient + M_PI/2.0);

  // compute the undistorted coos for the dummy point
  drz_dis = get_drz_position(dispnt, drzcoeffs, pixmax);

  // compute the scale along the minor axis
  ret.y = sqrt((drz_ref.x-drz_dis.x)*(drz_ref.x-drz_dis.x) +
               (drz_ref.y-drz_dis.y)*(drz_ref.y-drz_dis.y));

  // return the result
  return ret;
}

/*
 * Function: get_crossdisp_scale
 * The function computes the drizzle scale in cross-
 * dispersion direction for a given point and the
 * drizzle parameters of an image.
 *
 * Parameters:
 * @param trace     - the object trace
 * @param refpnt    - the reference point
 * @param drzcoeffs - the drizzle coefficients
 * @param pixmax    - the image dimensions
 *
 * Returns:
 * @return crscale - the drizzle scale in crossdispersion
 *                   direction
 */
double
get_crossdisp_scale(trace_func *trace, d_point refpnt, gsl_matrix * drzcoeffs,
                    px_point pixmax)
{
  double crscale;
  double phi_trace;
  //int beamID = 0;
  d_point dispnt;
  d_point drz_ref;
  d_point drz_dis;

  // get the trace angle
  phi_trace = atan2 (trace->deriv (0.0, trace->data), 1.0);

  // compute a dummy point along the cross-dispersion direction
  dispnt.x = refpnt.x + cos(phi_trace + M_PI/2.0);
  dispnt.y = refpnt.y + sin(phi_trace + M_PI/2.0);

  // get the undistorted positions of the refpoint and
  // the dummy point
  drz_ref = get_drz_position(refpnt, drzcoeffs, pixmax);
  drz_dis = get_drz_position(dispnt, drzcoeffs, pixmax);

  // compute the drizzle scale
  crscale = sqrt((drz_ref.x-drz_dis.x)*(drz_ref.x-drz_dis.x) +
                 (drz_ref.y-drz_dis.y)*(drz_ref.y-drz_dis.y));

  // return the drizzle scale
  return crscale;
}

/*
 * Function: evaln
 * The function evaluates the drizzle coefficients to return
 * either the x- or y-value in the undistorted system.
 * This is a translation of a fortran function with
 * the identical name inside the drizzle package.
 *
 * Parameters:
 * @param x         - the x-value in the distorted system
 * @param y         - the y-value in the distorted system
 * @param drzcoeffs - the drizzle coefficients
 * @param row       - which row of the coefficients to evaluate
 *
 * Returns:
 * @return ret - the undistorted coordinate value
 */
double
evaln(double x, double y, gsl_matrix * drzcoeffs, int row){

  double ret=0.0;
  int order;
  int n,m,nc,ncoeffs;
  order = 0;
  ncoeffs = 1;

  // derive the number of 'orders'
  while(ncoeffs+order+2 <= (int)drzcoeffs->size2){
    ncoeffs = ncoeffs+order+2;
    order++;
  }

  // add each individual term
  nc = 0;
  for (n=1; n < order+2; n++){
    for (m=1; m < n+1; m++){
      ret = ret + gsl_matrix_get(drzcoeffs,row,nc) * pow(x,(double)(n-m)) * pow(y,(double)(m-1));
      nc++;
    }
  }

  // give back the result
  return ret;
}

/*
 * Function: devalndx
 * The function numerically differentiates the
 * function 'evaln' with respect to the x-axis.
 *
 * Parameters:
 * @param x         - the x-value in the distorted system
 * @param y         - the y-value in the distorted system
 * @param drzcoeffs - the drizzle coefficients
 * @param row       - which row of the coefficients to evaluate
 *
 * Returns:
 * @return ret - the differential
 */
double
devalndx(double x, double y, gsl_matrix * drzcoeffs, int row){
  double ret=0.0;
  int order;
  int n,m,nc,ncoeffs;

  // derive the number of 'orders'
  order = 0;
  ncoeffs = 1;
  while(ncoeffs+order+2 <= (int)drzcoeffs->size2){
    ncoeffs = ncoeffs+order+2;
    order++;
  }

  // add each individual term
  nc = 0;
  for (n=1; n < order+2; n++){
    for (m=1; m < n; m++){
      ret = ret + gsl_matrix_get(drzcoeffs,row,nc) * (double)(n-m) * pow(x,(double)(n-m-1)) * pow(y,(double)(m-1));
      nc++;
    }
    nc++;
  }

  // return the result
  return ret;
}

/*
 * Function: devalndy
 * The function numerically differentiates the
 * function 'evaln' with respect to the y-axis.
 *
 * Parameters:
 * @param x         - the x-value in the distorted system
 * @param y         - the y-value in the distorted system
 * @param drzcoeffs - the drizzle coefficients
 * @param row       - which row of the coefficients to evaluate
 *
 * Returns:
 * @return ret - the differential
 */
double
devalndy(double x, double y, gsl_matrix * drzcoeffs, int row){
  double ret=0.0;
  int order;
  int n,m,nc,ncoeffs;

  // derive the number of 'orders'
  order = 0;
  ncoeffs = 1;
  while(ncoeffs+order+2 <= (int)drzcoeffs->size2){
    ncoeffs = ncoeffs+order+2;
    order++;
  }

  // add each individual term
  nc = 0;
  for (n=1; n < order+2; n++){
    nc++;
    for (m=2; m < n+1; m++){
      ret = ret + gsl_matrix_get(drzcoeffs,row,nc) * pow(x,(double)(n-m)) * (double)(m-1) * pow(y,(double)(m-2));
      nc++;
    }
  }

  // return the result
  return ret;
}

/*
 * Function: get_jacobian
 *
 * Parameters:
 * @param i         -
 * @param j         -
 * @param drzcoeffs - the drizzle coefficients
 * @param width     -
 * @param height    -
 *
 * Returns:
 * @return ret -
 */
gsl_matrix *
get_jacobian(int i, int j, gsl_matrix * drzcoeffs, int width, int height){

  double xr, yr;
  gsl_matrix * ret;

  ret = gsl_matrix_alloc(2,2);
  gsl_matrix_set_all (ret, 0.0);

  xr = (double)i - ((double)(width/2)+1.0);
  yr = (double)j - ((double)(height/2)+1.0);

  gsl_matrix_set(ret, 0, 0, devalndx( xr, yr, drzcoeffs, 0));
  gsl_matrix_set(ret, 0, 1, devalndy( xr, yr, drzcoeffs, 0));
  gsl_matrix_set(ret, 1, 0, devalndx( xr, yr, drzcoeffs, 1));
  gsl_matrix_set(ret, 1, 1, devalndy( xr, yr, drzcoeffs, 1));

  return ret;
}

/*
 * Function: get_det_jacobian
 *
 * Parameters:
 * @param i         -
 * @param j         -
 * @param drzcoeffs - the drizzle coefficients
 * @param width     -
 * @param height    -
 *
 * Returns:
 * @return ret -
 */
double
get_det_jacobian(int i, int j, gsl_matrix * drzcoeffs, int width, int height){

  gsl_matrix * jacob;
  double ret;

  jacob = get_jacobian(i,j,drzcoeffs,width,height);

  ret = gsl_matrix_get(jacob, 0, 0) * gsl_matrix_get(jacob, 1, 1)
       -gsl_matrix_get(jacob, 0, 1) * gsl_matrix_get(jacob, 1, 0);

  gsl_matrix_free(jacob);

  return ret;
}

/*
 * Function: get_drz_position
 * The function transforms distorted coordinates image to undistorted
 * image coordinates. As an assumption, the undistorted image
 * has the same dimension as the distorted.
 *
 * Parameters:
 * @param in_point  - the coordinates in the distorted frame
 * @param drzcoeffs - the drizzle coefficients
 * @param pixmax    - the image dimension of the distorted frame
 *
 * Returns:
 * @return: ou_point - the coordinates in the undistorted frame
 */
d_point
get_drz_position(d_point in_point, gsl_matrix *drzcoeffs, px_point pixmax)
{
  d_point ou_point;
  double xr, yr;
  double xn, yn;

  // transform the input coos into the drizzle system
  xr = in_point.x - ((double)(pixmax.x/2)+1.0);
  yr = in_point.y - ((double)(pixmax.y/2)+1.0);

  //  ou_point.x = evaln(xr,yr,drzcoeffs,0);
  //  ou_point.y = evaln(xr,yr,drzcoeffs,1);
  // get the undistorted coos in the drizzle system
  xn = evaln(xr,yr,drzcoeffs,0);
  yn = evaln(xr,yr,drzcoeffs,1);

  // transform back into the image system,
  // assuming identical image dimensions
  ou_point.x = xn + ((double)(pixmax.x/2)+1.0);
  ou_point.y = yn + ((double)(pixmax.y/2)+1.0);

  // return the undistorted coos
  return ou_point;
}

/*
 * Function: get_drz_position_free
 * The function transforms distorted coordinates image to undistorted
 * image coordinates. The size of the input and output image are free.
 *
 * Parameters:
 * @param in_point  - the coordinates in the distorted frame
 * @param drzcoeffs - the drizzle coefficients
 * @param pix_in    - the image dimension of the distorted frame
 * @param pix_out   - the image dimension of the distorted frame
 *
 * Returns:
 * @return: ou_point - the coordinates in the undistorted frame
 */
d_point
get_drz_position_free(d_point in_point, gsl_matrix *drzcoeffs,
                      px_point pix_in, px_point pix_out)
{
  d_point ou_point;
  double xr, yr;
  double xn, yn;

  // transform the input coos into the drizzle system
  xr = in_point.x - ((double)(pix_in.x/2)+1.0);
  yr = in_point.y - ((double)(pix_in.y/2)+1.0);

  //  ou_point.x = evaln(xr,yr,drzcoeffs,0);
  //  ou_point.y = evaln(xr,yr,drzcoeffs,1);
  // get the undistorted coos in the drizzle system
  xn = evaln(xr,yr,drzcoeffs,0);
  yn = evaln(xr,yr,drzcoeffs,1);

  // transform back into the image system,
  // assuming identical image dimensions
  ou_point.x = xn + ((double)(pix_out.x/2)+1.0);
  ou_point.y = yn + ((double)(pix_out.y/2)+1.0);

  // return the undistorted coos
  return ou_point;
}

trace_func *
get_tracefunc_at(char *filename, d_point p){

  int beamID = 0;
  trace_func  *trace;
  tracestruct *tstruct;

  tstruct = get_tracestruct_at_pos (filename, beamID, p);
  trace   = vector_to_trace_polyN ( tstruct->pol );

  return trace;
}


#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include <string.h>

double likelihood(double *y_obs, double* y_model);
void my_model(double *y_init, double *x_obs, double a, double b, double c, double d);
int minimo (double *arr, int nsteps, int nburn);
double std_dev(double *arr, int n_steps, int n_burn);

int main(int argc, char **argv){

  int n_steps = atoi(argv[1]);
  int n_burn = atoi(argv[2]);
  int npoints = n_steps;

  double *x_obs;
  double *y_obs;
  double *a_walk;
  double *b_walk;
  double *c_walk;
  double *d_walk;
  double *l_walk;
  double *y_init;
  double *y_prime;
  FILE *in;
  double var0;
  double var1;
  double var2;
  double var3;
  double var4;

  x_obs  = malloc(npoints * sizeof(double));
  y_obs  = malloc(npoints * sizeof(double));
  a_walk = malloc(npoints * sizeof(double));
  b_walk = malloc(npoints * sizeof(double));
  c_walk = malloc(npoints * sizeof(double));
  d_walk = malloc(npoints * sizeof(double));
  l_walk = malloc(npoints * sizeof(double));
  y_init = malloc(npoints * sizeof(double));
  y_prime = malloc(npoints * sizeof(double));

  in = fopen("monthrg.dat", "r");
  if(!in){
    printf("problems opening the file %s\n", "monthrg.dat");
    exit(1);
  }

  int i;
  for(i=0;i<4141;i++){
    fscanf(in,"%lf %lf %lf %lf %lf\n", &var0, &var1, &var2, &var3, &var4);
    if (var3!=-99){
      x_obs[i] = var0 + var1/12.0;
      y_obs[i] = var3;
      // printf("%f %f\n",x_obs[i], var3);
    }

  }
  fclose(in);

  char output1[512];
  char output2[512];
  char* line = "_";
  char* mcmc_solar = "mcmc_solar";
  char* dat = ".dat";
  char name[512] = "";
  strcat(name,mcmc_solar);
  strcat(name,line);
  strcat(name,argv[1]);
  strcat(name,line);
  strcat(name,argv[2]);
  strcat(name,dat);
  //printf("%s\n", name);

  srand((unsigned)time(NULL));

  FILE *fp;
  fp = fopen(name, "ab+");

  a_walk[0]=((double)rand() / (double) (RAND_MAX/50.0));
  b_walk[0]=((double)rand() / (double) (RAND_MAX/50.0));
  c_walk[0]=((double)rand() / (double) (RAND_MAX/50.0));
  d_walk[0]=((double)rand() / (double) (RAND_MAX/50.0));

  // printf("%f %f %f %f\n",a_walk[0], b_walk[0], c_walk[0], d_walk[0]);
  my_model (y_init, x_obs, a_walk[0], b_walk[0], c_walk[0], d_walk[0]);
  l_walk[0] = likelihood(y_obs, y_init);
  // printf("%f\n",l_walk[0]);

  int j;

   const gsl_rng_type * T;
   gsl_rng * r;
   gsl_rng_env_setup();
   T = gsl_rng_default;
   r = gsl_rng_alloc(T);

   double a_prime;
   double b_prime;
   double c_prime;
   double d_prime;
   double l_prime;
   double l_init;
   double gamma;
   double beta;

   for (j = 0; j<n_steps; j++){

    a_prime =(double)gsl_ran_gaussian(r, 0.1)+a_walk[j];
    b_prime =(double)gsl_ran_gaussian(r, 0.1)+b_walk[j];
    c_prime =(double)gsl_ran_gaussian(r, 0.1)+c_walk[j];
    d_prime =(double)gsl_ran_gaussian(r, 0.1)+d_walk[j];

    // printf("%f %f %f %f\n",a_walk[j], b_walk[j], c_walk[j], d_walk[j]);

    my_model(y_init, x_obs, a_walk[j], b_walk[j], c_walk[j], d_walk[j]);
    my_model(y_prime, x_obs, a_prime, b_prime, c_prime, d_prime);

    l_prime = likelihood(y_obs, y_prime);
    l_init = likelihood(y_obs, y_init);

    gamma = -l_prime + l_init;
    // printf("%f\n",gamma);

    if(gamma>=0.0){

      a_walk[j+1] = a_prime;
      b_walk[j+1] = b_prime;
      c_walk[j+1] = c_prime;
      d_walk[j+1] = d_prime;
      l_walk[j+1] = l_prime;

    }
    else{

      beta = ((double)rand() / (double) (RAND_MAX/50.0));

      if(beta<=exp(gamma)){

      a_walk[j+1] = a_prime;
      b_walk[j+1] = b_prime;
      c_walk[j+1] = c_prime;
      d_walk[j+1] = d_prime;
      l_walk[j+1] = l_prime;

      }
      else{

      a_walk[j+1] = a_walk[j];
      b_walk[j+1] = b_walk[j];
      c_walk[j+1] = c_walk[j];
      d_walk[j+1] = d_walk[j];
      l_walk[j+1] = l_init;

      }

    }
    // printf("%f %f %f %f\n",a_walk[j], b_walk[j], c_walk[j], d_walk[j]);

  }
  double *a_burned;
  double *b_burned;
  double *c_burned;
  double *d_burned;
  double *l_burned;
  double *x_burned;

  a_burned = malloc(npoints * sizeof(double));
  b_burned = malloc(npoints * sizeof(double));
  c_burned = malloc(npoints * sizeof(double));
  d_burned = malloc(npoints * sizeof(double));
  l_burned = malloc(npoints * sizeof(double));

  int co;

  for (co = 0; co < n_steps-n_burn; co++){

    a_burned[co] = a_walk[n_burn + co];
    b_burned[co] = b_walk[n_burn + co];
    c_burned[co] = c_walk[n_burn + co];
    d_burned[co] = d_walk[n_burn + co];
    l_burned[co] = l_walk[n_burn + co];
    fprintf(fp, "%f %f %f %f %f\n",a_burned[co], b_burned[co], c_burned[co], d_burned[co], l_burned[co]);
    //printf("%f %f %f %f %f\n",a_walk[co], b_walk[co], c_walk[co], d_walk[co], l_walk[co]);

  }

  int max_likelihood_id = minimo(l_burned, n_steps, n_burn);
  // printf("%i\n", max_likelihood_id);
  double best_a = a_burned[max_likelihood_id];
  double best_b = b_burned[max_likelihood_id];
  double best_c = c_burned[max_likelihood_id];
  double best_d = d_burned[max_likelihood_id];
  // printf("%f %f %f %f\n",a_burned[max_likelihood_id], b_burned[max_likelihood_id], c_burned[max_likelihood_id], d_burned[max_likelihood_id]);

  printf("a = %f +/- %f\n",best_a, std_dev(a_burned, n_steps, n_burn));
  printf("b = %f +/- %f\n",best_b, std_dev(b_burned, n_steps, n_burn));
  printf("c = %f +/- %f\n",best_c, std_dev(c_burned, n_steps, n_burn));
  printf("d = %f +/- %f\n",best_d, std_dev(d_burned, n_steps, n_burn));

 fclose(fp);

  gsl_rng_free(r);
  return 0;
}

double likelihood(double *y_obs, double* y_model){

  double chi_squared = 0.0;
  int counter;

  for (counter = 0; counter < 4141; counter++){
    chi_squared = chi_squared + pow((y_obs[counter]-y_model[counter]),2);
  }
  return (1.0/2.0)*chi_squared;
}

void my_model(double *y_init, double *x_obs, double a, double b, double c, double d){

  int counter2;
  double pi = 3.14159265359;

  for (counter2 = 0; counter2<4141; counter2++){

    y_init[counter2] = a*cos((2*pi/d)*x_obs[counter2] + b) + c;

  }
}

int minimo (double *arr, int nsteps, int nburn){

    int c = 0;
    double min = arr[0];
    int minimo = 0;

    for (c = 1; c<nsteps-nburn; c++){

      if (arr[c] < min){

	min = arr[c];
	minimo = c;

      }

    }
    return minimo;

}

double std_dev(double *arr, int n_steps, int n_burn){

  double mean = 0.0, sum_dev = 0.0;

  int k;
  int n = n_steps-n_burn;

  for (k=0; k<n; k++){

    mean+=arr[k];

  }
  mean = mean/n;
  for (k = 0; k<n; k++){

    sum_dev+=(arr[k]-mean)*(arr[k]-mean);

  }
  return pow(sum_dev/n,0.5);

}


#include <stdio.h>
#include <gsl/gsl_combination.h>

int
main (void)
{
  gsl_combination * c;
  size_t i;

  printf ("All subsets of {0,1,2,3} by size:\n") ;
  for (i = 0; i <= 4; i++)
    {
      c = gsl_combination_calloc (4, i);
      do
        {
          printf ("{");
          gsl_combination_fprintf (stdout, c, " %u");
          printf (" }\n");
        }
      while (gsl_combination_next (c) == GSL_SUCCESS);
      gsl_combination_free (c);
    }

  return 0;
}


/* AUTORIGHTS
Copyright (C) 2007 Princeton University

This file is part of Ferret Toolkit.

Ferret Toolkit is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

This program 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 General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software Foundation,
Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*/
#include <assert.h>
#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include <fenv.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_cdf.h>
#include <gsl/gsl_vector.h>
#include "LSH.h"
#include "perturb.h"

#define MISS_GAMMA	1

#ifndef M_PI
    #define M_PI 3.14159265358979323846
#endif

#define MAX_M	64
#define MAX_T	600

static inline double p_col_helper (double x)
{
	double result;
	result = 2.0*gsl_cdf_ugaussian_P(x) - 1.0;
	result += sqrt(2.0/M_PI) * (exp(-x*x/2.0)-1.0)/x;
	return result;
}

static inline double p_col_p_helper (double x, double k)
{
	return gsl_cdf_ugaussian_P((1.0 + k) * x) - gsl_cdf_ugaussian_P(k * x);
}

int LSH_recall_init (LSH_recall_t *recall, int d_step, float d_min, float d_max,
		int M, int L, int T, float W)
{
	ptb_vec_t *ptb_score;
	ptb_vec_t *ptb_set;
	float **table;
	double dist, r, p;
	int i, j, k;
	int l;

	ptb_score = gen_score(M);
	assert(ptb_score != NULL);
	ptb_set = type_calloc(ptb_vec_t, T);
	assert(ptb_set != NULL);
	gen_perturb_set(ptb_score, ptb_set, M, T);

	recall->d_step = d_step;
	recall->d_min = d_min;
	recall->d_max = d_max;
	recall->T = T;
	recall->table = table = type_matrix_alloc(float, T + 1, d_step);

	for (i = 0; i < d_step; i++)
	{
		dist = d_min + (d_max - d_min) * i / d_step;
		dist = W / sqrt(dist);
		p = p_col_helper(dist);
		table[0][i] = log(1.0 - pow(p, M));
		for (j = 1; j <= T; j++)
		{
			r = 1.0;
			l = 0;
			for (k = 0; k < 2 * M; k++)
			if (ptb_set[j-1].set & (1 << k))
			{
				r *= p_col_p_helper(dist, ptb_score[k].key1);
				l++;
			}
			assert(l > 0);
			l = M - l;
			r *= pow(p, l);
			table[j][i] = table[j-1][i] + log(1.0-r);
		}
		for (j = 0; j <= T; j++)
		{
			table[j][i] = 1.0 - exp(L * table[j][i]);
		}
	}

	free(ptb_score);
	free(ptb_set);
	return 0;
}

int LSH_recall_dump (LSH_recall_t *recall, CASS_FILE *fout)
{
	int ret;
	ret = cass_write_size(&recall->d_step, 1, fout);
	ret += cass_write_size(&recall->T, 1, fout);
	ret += cass_write_float(&recall->d_min, 1, fout);
	ret += cass_write_float(&recall->d_max, 1, fout);

	if (ret != 4) return CASS_ERR_IO;

	if (type_matrix_dump_stream(float, fout, recall->T + 1, recall->d_step, recall->table) != 0) return CASS_ERR_IO;

	return 0;
}

int LSH_recall_load (LSH_recall_t *recall, CASS_FILE *fin)
{
	int ret;
	cass_size_t row, col;
	ret = cass_read_size(&recall->d_step, 1, fin);
	ret += cass_read_size(&recall->T, 1, fin);
	ret += cass_read_float(&recall->d_min, 1, fin);
	ret += cass_read_float(&recall->d_max, 1, fin);

	if (ret != 4) return CASS_ERR_IO;

	type_matrix_load_stream(float, fin, &row, &col, &recall->table);

	assert(row == recall->T +1);
	assert(col == recall->d_step);

	return 0;
}


#include "lah.h"

#ifdef HAVE_LAPACK /* Use a LAPACK package to do the heavy work */
#include <lapacke.h>
lah_Return lah_LU(lah_mat *A, lah_index setZero, lapack_int *ipiv)
{
    lah_index i = 0;
    lah_index j = 0;
    lapack_int res = 1;
    if (A == NULL || A->nR != A->nC)
        return lahReturnParameterError;

    /*
    matrix_layout = LAH_LAPACK_LAYOUT(A);
    lda = (matrix_layout == LAPACK_COL_MAJOR) ? A->nR : A->nC;
    */
    res = GETRF(LAH_LAPACK_LAYOUT, A->nR, A->nC, A->data, LAH_LEADING_DIM(A), ipiv);

    /* Set rest of matrix to zero, if setZero == 1 */
    if (setZero)
    {
        for (i = 0; i < A->nR; i++)
        {
            for(j = i + 1; j < A->nC; ++j)
                LAH_ENTRY(A, i , j) = 0.0;
        }
    }
    return (res == 0) ? lahReturnOk : lahReturnExternError;
}
#endif


/* Copyright 2016, Alistair Boyle, 3-clause BSD License */
#include "config.h"
#include <stdio.h>
#include <stdlib.h> /* for exit */
#include <math.h>  /* for fabs */
#include <cblas.h> /* for cblas_dgemm */

int
main (void)
{
    double const a[] = { 0.11, 0.12, 0.13,
                         0.21, 0.22, 0.23
                       };
    double const b[] = { 1011.0, 1012.0,
                         1021.0, 1022.0,
                         1031.0, 1032.0
                       };
    double c[] = { 0.00, 0.00,
                   0.00, 0.00
                 };
    /* Compute C = a A B + c C */
    cblas_dgemm (CblasRowMajor, CblasNoTrans, CblasNoTrans,
                 3, 2, 3, /* m, n, k, */
                 1.0, a, 3, b, 2, /* a, A, m, B, n, */
                 0.0, c, 2); /* c, C, k */
    /* A is m x k, B is k x n, C is m x n */
    /* matlab: expect = a*b */
    double const expect[] = { 367.7600, 368.1200,
                              674.0600, 674.7200
                            };
    printf("\tactual\t\t\texpect\n");
    printf ("[ %g, %g    ==  [ %g, %g\n", c[0], c[1], expect[0], expect[1]);
    printf ("  %g, %g ]        %g, %g ]\n", c[2], c[3], expect[2], expect[3]);
    int i;
    for(i = 0; i < 4; i++) {
        if ( fabs(expect[i] - c[i]) > 1e-12 ) {
            printf("FAIL\n");
            return 1;
        }
    }
    printf("PASS\n");
    exit(EXIT_SUCCESS);
}