/***************************************************************************
 * data_cf.h is part of Math Graphic Library
 * Copyright (C) 2007-2016 Alexey Balakin <mathgl.abalakin@gmail.ru>       *
 *                                                                         *
 *   This program is free software; you can redistribute it and/or modify  *
 *   it under the terms of the GNU Library General Public License as       *
 *   published by the Free Software Foundation; either version 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 Library General Public     *
 *   License along with this program; if not, write to the                 *
 *   Free Software Foundation, Inc.,                                       *
 *   59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.             *
 ***************************************************************************/
#ifndef _MGL_DATA_CF_H_
#define _MGL_DATA_CF_H_
//-----------------------------------------------------------------------------
#include "mgl2/abstract.h"
//-----------------------------------------------------------------------------
#if MGL_HAVE_GSL
#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#else
#ifdef __cplusplus
struct gsl_vector;
struct gsl_matrix;
#else
typedef void gsl_vector;
typedef void gsl_matrix;
#endif
#endif
//-----------------------------------------------------------------------------
#ifdef __cplusplus
extern "C" {
#endif
/// Get integer power of x
double MGL_EXPORT_CONST mgl_ipow(double x,int n);
double MGL_EXPORT_PURE mgl_ipow_(mreal *x,int *n);
/// Get number of seconds since 1970 for given string
double MGL_EXPORT mgl_get_time(const char *time, const char *fmt);
double MGL_EXPORT mgl_get_time_(const char *time, const char *fmt,int,int);

/// Create HMDT object
HMDT MGL_EXPORT mgl_create_data();
uintptr_t MGL_EXPORT mgl_create_data_();
/// Create HMDT object with specified sizes
HMDT MGL_EXPORT mgl_create_data_size(long nx, long ny, long nz);
uintptr_t MGL_EXPORT mgl_create_data_size_(int *nx, int *ny, int *nz);
/// Create HMDT object with data from file
HMDT MGL_EXPORT mgl_create_data_file(const char *fname);
uintptr_t MGL_EXPORT mgl_create_data_file_(const char *fname, int len);
/// Delete HMDT object
void MGL_EXPORT mgl_delete_data(HMDT dat);
void MGL_EXPORT mgl_delete_data_(uintptr_t *dat);

/// Rearange data dimensions
void MGL_EXPORT mgl_data_rearrange(HMDT dat, long mx,long my,long mz);
void MGL_EXPORT mgl_data_rearrange_(uintptr_t *dat, int *mx, int *my, int *mz);
/// Link external data array (don't delete it at exit)
void MGL_EXPORT mgl_data_link(HMDT dat, mreal *A,long mx,long my,long mz);
void MGL_EXPORT mgl_data_link_(uintptr_t *d, mreal *A, int *nx,int *ny,int *nz);
/// Allocate memory and copy the data from the (float *) array
void MGL_EXPORT mgl_data_set_float(HMDT dat, const float *A,long mx,long my,long mz);
void MGL_EXPORT mgl_data_set_float_(uintptr_t *dat, const float *A,int *NX,int *NY,int *NZ);
void MGL_EXPORT mgl_data_set_float1_(uintptr_t *d, const float *A,int *N1);
/// Allocate memory and copy the data from the (double *) array
void MGL_EXPORT mgl_data_set_double(HMDT dat, const double *A,long mx,long my,long mz);
void MGL_EXPORT mgl_data_set_double_(uintptr_t *dat, const double *A,int *NX,int *NY,int *NZ);
void MGL_EXPORT mgl_data_set_double1_(uintptr_t *d, const double *A,int *N1);
/// Allocate memory and copy the data from the (float **) array
void MGL_EXPORT mgl_data_set_float2(HMDT d, float const * const *A,long N1,long N2);
void MGL_EXPORT mgl_data_set_float2_(uintptr_t *d, const float *A,int *N1,int *N2);
/// Allocate memory and copy the data from the (double **) array
void MGL_EXPORT mgl_data_set_double2(HMDT d, double const * const *A,long N1,long N2);
void MGL_EXPORT mgl_data_set_double2_(uintptr_t *d, const double *A,int *N1,int *N2);
/// Allocate memory and copy the data from the (float ***) array
void MGL_EXPORT mgl_data_set_float3(HMDT d, float const * const * const *A,long N1,long N2,long N3);
void MGL_EXPORT mgl_data_set_float3_(uintptr_t *d, const float *A,int *N1,int *N2,int *N3);
/// Allocate memory and copy the data from the (double ***) array
void MGL_EXPORT mgl_data_set_double3(HMDT d, double const * const * const *A,long N1,long N2,long N3);
void MGL_EXPORT mgl_data_set_double3_(uintptr_t *d, const double *A,int *N1,int *N2,int *N3);
/// Import data from abstract type
void MGL_EXPORT mgl_data_set(HMDT dat, HCDT a);
void MGL_EXPORT mgl_data_set_(uintptr_t *dat, uintptr_t *a);
/// Allocate memory and copy the data from the gsl_vector
void MGL_EXPORT mgl_data_set_vector(HMDT dat, gsl_vector *v);
/// Allocate memory and copy the data from the gsl_matrix
void MGL_EXPORT mgl_data_set_matrix(HMDT dat, gsl_matrix *m);
/// Set value of data element [i,j,k]
void MGL_EXPORT mgl_data_set_value(HMDT dat, mreal v, long i, long j, long k);
void MGL_EXPORT mgl_data_set_value_(uintptr_t *d, mreal *v, int *i, int *j, int *k);
/// Get value of data element [i,j,k]
mreal MGL_EXPORT mgl_data_get_value(HCDT dat, long i, long j, long k);
mreal MGL_EXPORT mgl_data_get_value_(uintptr_t *d, int *i, int *j, int *k);
/// Allocate memory and scanf the data from the string
void MGL_EXPORT mgl_data_set_values(HMDT dat, const char *val, long nx, long ny, long nz);
void MGL_EXPORT mgl_data_set_values_(uintptr_t *d, const char *val, int *nx, int *ny, int *nz, int l);

/// Read data array from HDF file (parse HDF4 and HDF5 files)
int MGL_EXPORT mgl_data_read_hdf(HMDT d,const char *fname,const char *data);
int MGL_EXPORT mgl_data_read_hdf_(uintptr_t *d, const char *fname, const char *data,int l,int n);
/// Read data from tab-separated text file with auto determining size
int MGL_EXPORT mgl_data_read(HMDT dat, const char *fname);
int MGL_EXPORT mgl_data_read_(uintptr_t *d, const char *fname,int l);
/// Read data from text file with size specified at beginning of the file
int MGL_EXPORT mgl_data_read_mat(HMDT dat, const char *fname, long dim);
int MGL_EXPORT mgl_data_read_mat_(uintptr_t *dat, const char *fname, int *dim, int);
/// Read data from text file with specifeid size
int MGL_EXPORT mgl_data_read_dim(HMDT dat, const char *fname,long mx,long my,long mz);
int MGL_EXPORT mgl_data_read_dim_(uintptr_t *dat, const char *fname,int *mx,int *my,int *mz,int);
/// Read data from tab-separated text files with auto determining size which filenames are result of sprintf(fname,templ,t) where t=from:step:to
int MGL_EXPORT mgl_data_read_range(HMDT d, const char *templ, double n1, double n2, double step, int as_slice);
int MGL_EXPORT mgl_data_read_range_(uintptr_t *d, const char *fname, mreal *n1, mreal *n2, mreal *step, int *as_slice,int l);
/// Read data from tab-separated text files with auto determining size which filenames are satisfied to template (like "t_*.dat")
int MGL_EXPORT mgl_data_read_all(HMDT dat, const char *templ, int as_slice);
int MGL_EXPORT mgl_data_read_all_(uintptr_t *d, const char *fname, int *as_slice,int l);
/// Import data array from PNG file according color scheme
void MGL_EXPORT mgl_data_import(HMDT dat, const char *fname, const char *scheme,mreal v1,mreal v2);
void MGL_EXPORT mgl_data_import_(uintptr_t *dat, const char *fname, const char *scheme,mreal *v1,mreal *v2,int,int);
/// Scan textual file for template and fill data array
int MGL_EXPORT mgl_data_scan_file(HMDT dat,const char *fname, const char *templ);
int MGL_EXPORT mgl_data_scan_file_(uintptr_t *dat,const char *fname, const char *templ,int,int);
/// Read data array from Tektronix WFM file
/** Parse Tektronix TDS5000/B, TDS6000/B/C, TDS/CSA7000/B, MSO70000/C, DSA70000/B/C DPO70000/B/C DPO7000/ MSO/DPO5000. */
int MGL_EXPORT mgl_data_read_wfm(HMDT d,const char *fname, long num, long step, long start);
int MGL_EXPORT mgl_data_read_wfm_(uintptr_t *d, const char *fname, long *num, long *step, long *start,int l);
/// Read data array from Matlab MAT file (parse versions 4 and 5)
int MGL_EXPORT mgl_data_read_matlab(HMDT d,const char *fname,const char *data);
int MGL_EXPORT mgl_data_read_matlab_(uintptr_t *d, const char *fname, const char *data,int l,int n);

/// Create or recreate the array with specified size and fill it by zero
void MGL_EXPORT mgl_data_create(HMDT dat, long nx,long ny,long nz);
void MGL_EXPORT mgl_data_create_(uintptr_t *dat, int *nx,int *ny,int *nz);
/// Transpose dimensions of the data (generalization of Transpose)
void MGL_EXPORT mgl_data_transpose(HMDT dat, const char *dim);
void MGL_EXPORT mgl_data_transpose_(uintptr_t *dat, const char *dim,int);
/// Normalize the data to range [v1,v2]
void MGL_EXPORT mgl_data_norm(HMDT dat, mreal v1,mreal v2,int sym,long dim);
void MGL_EXPORT mgl_data_norm_(uintptr_t *dat, mreal *v1,mreal *v2,int *sym,int *dim);
/// Normalize the data to range [v1,v2] slice by slice
void MGL_EXPORT mgl_data_norm_slice(HMDT dat, mreal v1,mreal v2,char dir,long keep_en,long sym);
void MGL_EXPORT mgl_data_norm_slice_(uintptr_t *dat, mreal *v1,mreal *v2,char *dir,int *keep_en,int *sym,int l);
/// Limit the data to be inside [-v,v], keeping the original sign
void MGL_EXPORT mgl_data_limit(HMDT dat, mreal v);
void MGL_EXPORT mgl_data_limit_(uintptr_t *dat, mreal *v);
/// Project the periodical data to range [v1,v2] (like mod() function). Separate branches by NAN if sep=true.
void MGL_EXPORT mgl_data_coil(HMDT dat, mreal v1, mreal v2, int sep);
void MGL_EXPORT mgl_data_coil_(uintptr_t *dat, mreal *v1, mreal *v2, int *sep);

/// Get sub-array of the data with given fixed indexes
HMDT MGL_EXPORT mgl_data_subdata(HCDT dat, long xx,long yy,long zz);
uintptr_t MGL_EXPORT mgl_data_subdata_(uintptr_t *dat, int *xx,int *yy,int *zz);
/// Get sub-array of the data with given fixed indexes (like indirect access)
HMDT MGL_EXPORT mgl_data_subdata_ext(HCDT dat, HCDT xx, HCDT yy, HCDT zz);
uintptr_t MGL_EXPORT mgl_data_subdata_ext_(uintptr_t *dat, uintptr_t *xx,uintptr_t *yy,uintptr_t *zz);
/// Get column (or slice) of the data filled by formulas of named columns
HMDT MGL_EXPORT mgl_data_column(HCDT dat, const char *eq);
uintptr_t MGL_EXPORT mgl_data_column_(uintptr_t *dat, const char *eq,int l);
/// Get data from sections ids, separated by value val along specified direction.
/** If section id is negative then reverse order is used (i.e. -1 give last section). */
HMDT MGL_EXPORT mgl_data_section(HCDT dat, HCDT ids, char dir, mreal val);
uintptr_t MGL_EXPORT mgl_data_section_(uintptr_t *d, uintptr_t *ids, const char *dir, mreal *val,int);
/// Get data from section id, separated by value val along specified direction.
/** If section id is negative then reverse order is used (i.e. -1 give last section). */
HMDT MGL_EXPORT mgl_data_section_val(HCDT dat, long id, char dir, mreal val);
uintptr_t MGL_EXPORT mgl_data_section_val_(uintptr_t *d, int *id, const char *dir, mreal *val,int);
/// Get contour lines for dat[i,j]=val. NAN values separate the the curves
HMDT mgl_data_conts(mreal val, HCDT dat);

/// Equidistantly fill the data to range [x1,x2] in direction dir
void MGL_EXPORT mgl_data_fill(HMDT dat, mreal x1,mreal x2,char dir);
void MGL_EXPORT mgl_data_fill_(uintptr_t *dat, mreal *x1,mreal *x2,const char *dir,int);
/// Modify the data by specified formula assuming x,y,z in range [r1,r2]
void MGL_EXPORT mgl_data_fill_eq(HMGL gr, HMDT dat, const char *eq, HCDT vdat, HCDT wdat,const char *opt);
void MGL_EXPORT mgl_data_fill_eq_(uintptr_t *gr, uintptr_t *dat, const char *eq, uintptr_t *vdat, uintptr_t *wdat,const char *opt, int, int);
/// Fill dat by interpolated values of vdat parametrically depended on xdat for x in range [x1,x2] using global spline
void MGL_EXPORT mgl_data_refill_gs(HMDT dat, HCDT xdat, HCDT vdat, mreal x1, mreal x2, long sl);
void MGL_EXPORT mgl_data_refill_gs_(uintptr_t *dat, uintptr_t *xdat, uintptr_t *vdat, mreal *x1, mreal *x2, long *sl);
/// Fill dat by interpolated values of vdat parametrically depended on xdat for x in range [x1,x2]
void MGL_EXPORT mgl_data_refill_x(HMDT dat, HCDT xdat, HCDT vdat, mreal x1, mreal x2, long sl);
void MGL_EXPORT mgl_data_refill_x_(uintptr_t *dat, uintptr_t *xdat, uintptr_t *vdat, mreal *x1, mreal *x2, long *sl);
/// Fill dat by interpolated values of vdat parametrically depended on xdat,ydat for x,y in range [x1,x2]*[y1,y2]
void MGL_EXPORT mgl_data_refill_xy(HMDT dat, HCDT xdat, HCDT ydat, HCDT vdat, mreal x1, mreal x2, mreal y1, mreal y2, long sl);
void MGL_EXPORT mgl_data_refill_xy_(uintptr_t *dat, uintptr_t *xdat, uintptr_t *ydat, uintptr_t *vdat, mreal *x1, mreal *x2, mreal *y1, mreal *y2, long *sl);
/// Fill dat by interpolated values of vdat parametrically depended on xdat,ydat,zdat for x,y,z in range [x1,x2]*[y1,y2]*[z1,z2]
void MGL_EXPORT mgl_data_refill_xyz(HMDT dat, HCDT xdat, HCDT ydat, HCDT zdat, HCDT vdat, mreal x1, mreal x2, mreal y1, mreal y2, mreal z1, mreal z2);
void MGL_EXPORT mgl_data_refill_xyz_(uintptr_t *dat, uintptr_t *xdat, uintptr_t *ydat, uintptr_t *zdat, uintptr_t *vdat, mreal *x1, mreal *x2, mreal *y1, mreal *y2, mreal *z1, mreal *z2);
/// Fill dat by interpolated values of vdat parametrically depended on xdat,ydat,zdat for x,y,z in axis range
void MGL_EXPORT mgl_data_refill_gr(HMGL gr, HMDT dat, HCDT xdat, HCDT ydat, HCDT zdat, HCDT vdat, long sl, const char *opt);
void MGL_EXPORT mgl_data_refill_gr_(uintptr_t *gr, uintptr_t *dat, uintptr_t *xdat, uintptr_t *ydat, uintptr_t *zdat, uintptr_t *vdat, long *sl, const char *opt,int);
/// Set the data by triangulated surface values assuming x,y,z in range [r1,r2]
void MGL_EXPORT mgl_data_grid(HMGL gr, HMDT d, HCDT xdat, HCDT ydat, HCDT zdat,const char *opt);
void MGL_EXPORT mgl_data_grid_(uintptr_t *gr, uintptr_t *dat, uintptr_t *xdat, uintptr_t *ydat, uintptr_t *zdat, const char *opt,int);
/// Set the data by triangulated surface values assuming x,y,z in range [x1,x2]*[y1,y2]
void MGL_EXPORT mgl_data_grid_xy(HMDT d, HCDT xdat, HCDT ydat, HCDT zdat, mreal x1, mreal x2, mreal y1, mreal y2);
void MGL_EXPORT mgl_data_grid_xy_(uintptr_t *dat, uintptr_t *xdat, uintptr_t *ydat, uintptr_t *zdat, mreal *x1, mreal *x2, mreal *y1, mreal *y2);
/// Put value to data element(s)
void MGL_EXPORT mgl_data_put_val(HMDT dat, mreal val, long i, long j, long k);
void MGL_EXPORT mgl_data_put_val_(uintptr_t *dat, mreal *val, int *i, int *j, int *k);
/// Put array to data element(s)
void MGL_EXPORT mgl_data_put_dat(HMDT dat, HCDT val, long i, long j, long k);
void MGL_EXPORT mgl_data_put_dat_(uintptr_t *dat, uintptr_t *val, int *i, int *j, int *k);
/// Modify the data by specified formula
void MGL_EXPORT mgl_data_modify(HMDT dat, const char *eq,long dim);
void MGL_EXPORT mgl_data_modify_(uintptr_t *dat, const char *eq,int *dim,int);
/// Modify the data by specified formula
void MGL_EXPORT mgl_data_modify_vw(HMDT dat, const char *eq,HCDT vdat,HCDT wdat);
void MGL_EXPORT mgl_data_modify_vw_(uintptr_t *dat, const char *eq, uintptr_t *vdat, uintptr_t *wdat,int);
/// Reduce size of the data
void MGL_EXPORT mgl_data_squeeze(HMDT dat, long rx,long ry,long rz,long smooth);
void MGL_EXPORT mgl_data_squeeze_(uintptr_t *dat, int *rx,int *ry,int *rz,int *smooth);

/// Get array which is n-th pairs {x[i],y[i]} for iterated function system (fractal) generated by A
/** NOTE: A.nx must be >= 7. */
HMDT MGL_EXPORT mgl_data_ifs_2d(HCDT A, long n, long skip);
uintptr_t MGL_EXPORT mgl_data_ifs_2d_(uintptr_t *A, long *n, long *skip);
/// Get array which is n-th points {x[i],y[i],z[i]} for iterated function system (fractal) generated by A
/** NOTE: A.nx must be >= 13. */
HMDT MGL_EXPORT mgl_data_ifs_3d(HCDT A, long n, long skip);
uintptr_t MGL_EXPORT mgl_data_ifs_3d_(uintptr_t *A, long *n, long *skip);
/// Get array which is n-th points {x[i],y[i],z[i]} for iterated function system (fractal) defined in *.ifs file 'fname' and named as 'name'
HMDT MGL_EXPORT mgl_data_ifs_file(const char *fname, const char *name, long n, long skip);
uintptr_t mgl_data_ifs_file_(const char *fname, const char *name, long *n, long *skip,int l,int m);
/// Codes for flame fractal functions
enum {
	mglFlame2d_linear=0,	mglFlame2d_sinusoidal,	mglFlame2d_spherical,	mglFlame2d_swirl,		mglFlame2d_horseshoe,
	mglFlame2d_polar,		mglFlame2d_handkerchief,mglFlame2d_heart,		mglFlame2d_disc,		mglFlame2d_spiral,
	mglFlame2d_hyperbolic,	mglFlame2d_diamond,		mglFlame2d_ex,			mglFlame2d_julia,		mglFlame2d_bent,
	mglFlame2d_waves,		mglFlame2d_fisheye,		mglFlame2d_popcorn,		mglFlame2d_exponential,	mglFlame2d_power,
	mglFlame2d_cosine,		mglFlame2d_rings,		mglFlame2d_fan,			mglFlame2d_blob,		mglFlame2d_pdj,
	mglFlame2d_fan2,		mglFlame2d_rings2,		mglFlame2d_eyefish,		mglFlame2d_bubble,		mglFlame2d_cylinder,
	mglFlame2d_perspective,	mglFlame2d_noise,		mglFlame2d_juliaN,		mglFlame2d_juliaScope,	mglFlame2d_blur,
	mglFlame2d_gaussian,	mglFlame2d_radialBlur,	mglFlame2d_pie,			mglFlame2d_ngon,		mglFlame2d_curl,
	mglFlame2d_rectangles,	mglFlame2d_arch,		mglFlame2d_tangent,		mglFlame2d_square,		mglFlame2d_blade,
	mglFlame2d_secant,		mglFlame2d_rays,		mglFlame2d_twintrian,	mglFlame2d_cross,		mglFlame2d_disc2,
	mglFlame2d_supershape,	mglFlame2d_flower,		mglFlame2d_conic,		mglFlame2d_parabola,	mglFlame2d_bent2,
	mglFlame2d_bipolar,		mglFlame2d_boarders,	mglFlame2d_butterfly,	mglFlame2d_cell,		mglFlame2d_cpow,
	mglFlame2d_curve,		mglFlame2d_edisc,		mglFlame2d_elliptic,	mglFlame2d_escher,		mglFlame2d_foci,
	mglFlame2d_lazySusan,	mglFlame2d_loonie,		mglFlame2d_preBlur,		mglFlame2d_modulus,		mglFlame2d_oscope,
	mglFlame2d_polar2,		mglFlame2d_popcorn2,	mglFlame2d_scry,		mglFlame2d_separation,	mglFlame2d_split,
	mglFlame2d_splits,		mglFlame2d_stripes,		mglFlame2d_wedge,		mglFlame2d_wedgeJulia,	mglFlame2d_wedgeSph,
	mglFlame2d_whorl,		mglFlame2d_waves2,		mglFlame2d_exp,			mglFlame2d_log,			mglFlame2d_sin,
	mglFlame2d_cos,			mglFlame2d_tan,			mglFlame2d_sec,			mglFlame2d_csc,			mglFlame2d_cot,
	mglFlame2d_sinh,		mglFlame2d_cosh,		mglFlame2d_tanh,		mglFlame2d_sech,		mglFlame2d_csch,
	mglFlame2d_coth,		mglFlame2d_auger,		mglFlame2d_flux,		mglFlame2dLAST
};
/// Get array which is n-th pairs {x[i],y[i]} for Flame fractal generated by A with functions F
/** NOTE: A.nx must be >= 7 and F.nx >= 2 and F.nz=A.ny.
 * F[0,i,j] denote function id. F[1,i,j] give function weight. F(2:5,i,j) provide function parameters.
 * Resulting point is {xnew,ynew} = sum_i F[1,i,j]*F[0,i,j]{IFS2d(A[j]){x,y}}. */
HMDT MGL_EXPORT mgl_data_flame_2d(HCDT A, HCDT F, long n, long skip);
uintptr_t MGL_EXPORT mgl_data_flame_2d_(uintptr_t *A, uintptr_t *F, long *n, long *skip);

/// Get curves, separated by NAN, for maximal values of array d as function of x coordinate.
/** Noises below lvl amplitude are ignored.
  * Parameter dy \in [0,ny] set the "attraction" distance of points to curve. */
HMDT MGL_EXPORT mgl_data_detect(HCDT d, mreal lvl, mreal dj, mreal di, mreal min_len);
uintptr_t MGL_EXPORT mgl_data_detect_(uintptr_t *d, mreal *lvl, mreal *dj, mreal *di, mreal *min_len);

/// Get array as solution of tridiagonal matrix solution a[i]*x[i-1]+b[i]*x[i]+c[i]*x[i+1]=d[i]
/** String \a how may contain:
 * 'x', 'y', 'z' for solving along x-,y-,z-directions, or
 * 'h' for solving along hexagonal direction at x-y plain (need nx=ny),
 * 'c' for using periodical boundary conditions,
 * 'd' for diffraction/diffuse calculation.
 * NOTE: It work for flat data model only (i.e. for a[i,j]==a[i+nx*j]) */
HMDT MGL_EXPORT mgl_data_tridmat(HCDT A, HCDT B, HCDT C, HCDT D, const char *how);
uintptr_t MGL_EXPORT mgl_data_tridmat_(uintptr_t *A, uintptr_t *B, uintptr_t *C, uintptr_t *D, const char *how, int);

/// Returns pointer to data element [i,j,k]
MGL_EXPORT mreal *mgl_data_value(HMDT dat, long i,long j,long k);
/// Returns pointer to internal data array
MGL_EXPORT_PURE mreal *mgl_data_data(HMDT dat);

/// Gets the x-size of the data.
long MGL_EXPORT mgl_data_get_nx(HCDT d);
long MGL_EXPORT mgl_data_get_nx_(uintptr_t *d);
/// Gets the y-size of the data.
long MGL_EXPORT mgl_data_get_ny(HCDT d);
long MGL_EXPORT mgl_data_get_ny_(uintptr_t *d);
/// Gets the z-size of the data.
long MGL_EXPORT mgl_data_get_nz(HCDT d);
long MGL_EXPORT mgl_data_get_nz_(uintptr_t *d);

/// Get the data which is direct multiplication (like, d[i,j] = this[i]*a[j] and so on)
HMDT MGL_EXPORT mgl_data_combine(HCDT dat1, HCDT dat2);
uintptr_t MGL_EXPORT mgl_data_combine_(uintptr_t *dat1, uintptr_t *dat2);
/// Extend data dimensions
void MGL_EXPORT mgl_data_extend(HMDT dat, long n1, long n2);
void MGL_EXPORT mgl_data_extend_(uintptr_t *dat, int *n1, int *n2);
/// Insert data rows/columns/slices
void MGL_EXPORT mgl_data_insert(HMDT dat, char dir, long at, long num);
void MGL_EXPORT mgl_data_insert_(uintptr_t *dat, const char *dir, int *at, int *num, int);
/// Delete data rows/columns/slices
void MGL_EXPORT mgl_data_delete(HMDT dat, char dir, long at, long num);
void MGL_EXPORT mgl_data_delete_(uintptr_t *dat, const char *dir, int *at, int *num, int);
/// Joind another data array
void MGL_EXPORT mgl_data_join(HMDT dat, HCDT d);
void MGL_EXPORT mgl_data_join_(uintptr_t *dat, uintptr_t *d);

/// Smooth the data on specified direction or directions
/** String \a dir may contain:
 *  ‘x’, ‘y’, ‘z’ for 1st, 2nd or 3d dimension;
 *  ‘dN’ for linear averaging over N points;
 *  ‘3’ for linear averaging over 3 points;
 *  ‘5’ for linear averaging over 5 points.
 *  By default quadratic averaging over 5 points is used. */
void MGL_EXPORT mgl_data_smooth(HMDT d, const char *dirs, mreal delta);
void MGL_EXPORT mgl_data_smooth_(uintptr_t *dat, const char *dirs, mreal *delta,int);
/// Get array which is result of summation in given direction or directions
HMDT MGL_EXPORT mgl_data_sum(HCDT dat, const char *dir);
uintptr_t MGL_EXPORT mgl_data_sum_(uintptr_t *dat, const char *dir,int);
/// Get array which is result of maximal values in given direction or directions
HMDT MGL_EXPORT mgl_data_max_dir(HCDT dat, const char *dir);
uintptr_t MGL_EXPORT mgl_data_max_dir_(uintptr_t *dat, const char *dir,int);
/// Get array which is result of minimal values in given direction or directions
HMDT MGL_EXPORT mgl_data_min_dir(HCDT dat, const char *dir);
uintptr_t MGL_EXPORT mgl_data_min_dir_(uintptr_t *dat, const char *dir,int);
/// Get positions of local maximums and minimums
HMDT MGL_EXPORT mgl_data_minmax(HCDT dat);
uintptr_t MGL_EXPORT mgl_data_minmax_(uintptr_t *dat);
/// Get indexes of a set of connected surfaces for set of values {a_ijk,b_ijk} as dependent on j,k
/** NOTE: not optimized for general case!!! */
HMDT MGL_EXPORT mgl_data_connect(HCDT a, HCDT b);
uintptr_t MGL_EXPORT mgl_data_connect_(uintptr_t *a, uintptr_t *b);
/// Resort data values according found connected surfaces for set of values {a_ijk,b_ijk} as dependent on j,k
/** NOTE: not optimized for general case!!! */
void MGL_EXPORT mgl_data_connect_r(HMDT a, HMDT b);
void MGL_EXPORT mgl_data_connect_r_(uintptr_t *a, uintptr_t *b);

/// Cumulative summation the data in given direction or directions
void MGL_EXPORT mgl_data_cumsum(HMDT dat, const char *dir);
void MGL_EXPORT mgl_data_cumsum_(uintptr_t *dat, const char *dir,int);
/// Integrate (cumulative summation) the data in given direction or directions
void MGL_EXPORT mgl_data_integral(HMDT dat, const char *dir);
void MGL_EXPORT mgl_data_integral_(uintptr_t *dat, const char *dir,int);
/// Differentiate the data in given direction or directions
void MGL_EXPORT mgl_data_diff(HMDT dat, const char *dir);
void MGL_EXPORT mgl_data_diff_(uintptr_t *dat, const char *dir,int);
/// Differentiate the parametrically specified data along direction v1 with v2,v3=const (v3 can be NULL)
void MGL_EXPORT mgl_data_diff_par(HMDT dat, HCDT v1, HCDT v2, HCDT v3);
void MGL_EXPORT mgl_data_diff_par_(uintptr_t *dat, uintptr_t *v1, uintptr_t *v2, uintptr_t *v3);
/// Double-differentiate (like Laplace operator) the data in given direction
void MGL_EXPORT mgl_data_diff2(HMDT dat, const char *dir);
void MGL_EXPORT mgl_data_diff2_(uintptr_t *dat, const char *dir,int);
/// Swap left and right part of the data in given direction (useful for Fourier spectrum)
void MGL_EXPORT mgl_data_swap(HMDT dat, const char *dir);
void MGL_EXPORT mgl_data_swap_(uintptr_t *dat, const char *dir,int);
/// Roll data along direction dir by num slices
void MGL_EXPORT mgl_data_roll(HMDT dat, char dir, long num);
void MGL_EXPORT mgl_data_roll_(uintptr_t *dat, const char *dir, int *num, int);
/// Mirror the data in given direction (useful for Fourier spectrum)
void MGL_EXPORT mgl_data_mirror(HMDT dat, const char *dir);
void MGL_EXPORT mgl_data_mirror_(uintptr_t *dat, const char *dir,int);
/// Sort rows (or slices) by values of specified column
void MGL_EXPORT mgl_data_sort(HMDT dat, long idx, long idy);
void MGL_EXPORT mgl_data_sort_(uintptr_t *dat, int *idx, int *idy);
/// Return dilated array of 0 or 1 for data values larger val
void MGL_EXPORT mgl_data_dilate(HMDT dat, mreal val, long step);
void MGL_EXPORT mgl_data_dilate_(uintptr_t *dat, mreal *val, int *step);
/// Return eroded array of 0 or 1 for data values larger val
void MGL_EXPORT mgl_data_erode(HMDT dat, mreal val, long step);
void MGL_EXPORT mgl_data_erode_(uintptr_t *dat, mreal *val, int *step);

/// Apply Hankel transform
void MGL_EXPORT mgl_data_hankel(HMDT dat, const char *dir);
void MGL_EXPORT mgl_data_hankel_(uintptr_t *dat, const char *dir,int);
/// Apply Sin-Fourier transform
void MGL_EXPORT mgl_data_sinfft(HMDT dat, const char *dir);
void MGL_EXPORT mgl_data_sinfft_(uintptr_t *dat, const char *dir,int);
/// Apply Cos-Fourier transform
void MGL_EXPORT mgl_data_cosfft(HMDT dat, const char *dir);
void MGL_EXPORT mgl_data_cosfft_(uintptr_t *dat, const char *dir,int);
/// Fill data by coordinates/momenta samples for Hankel ('h') or Fourier ('f') transform
/** Parameter \a how may contain:
 * ‘x‘,‘y‘,‘z‘ for direction (only one will be used),
 * ‘k‘ for momenta samples,
 * ‘h‘ for Hankel samples,
 * ‘f‘ for Cartesian/Fourier samples (default). */
void MGL_EXPORT mgl_data_fill_sample(HMDT dat, const char *how);
void MGL_EXPORT mgl_data_fill_sample_(uintptr_t *dat, const char *how,int);
/// Find correlation between 2 data arrays
HMDT MGL_EXPORT mgl_data_correl(HCDT dat1, HCDT dat2, const char *dir);
uintptr_t MGL_EXPORT mgl_data_correl_(uintptr_t *dat1, uintptr_t *dat2, const char *dir,int);
/// Apply wavelet transform
/** Parameter \a dir may contain:
 * ‘x‘,‘y‘,‘z‘ for directions,
 * ‘d‘ for daubechies, ‘D‘ for centered daubechies,
 * ‘h‘ for haar, ‘H‘ for centered haar,
 * ‘b‘ for bspline, ‘B‘ for centered bspline,
 * ‘i‘ for applying inverse transform. */
void MGL_EXPORT mgl_data_wavelet(HMDT dat, const char *how, int k);
void MGL_EXPORT mgl_data_wavelet_(uintptr_t *d, const char *dir, int *k,int);

/// Allocate and prepare data for Fourier transform by nthr threads
MGL_EXPORT void *mgl_fft_alloc(long n, void **space, long nthr);
MGL_EXPORT void *mgl_fft_alloc_thr(long n);
/// Free data for Fourier transform
void MGL_EXPORT mgl_fft_free(void *wt, void **ws, long nthr);
void MGL_EXPORT mgl_fft_free_thr(void *wt);
/// Make Fourier transform of data x of size n and step s between points
void MGL_EXPORT mgl_fft(double *x, long s, long n, const void *wt, void *ws, int inv);
/// Clear internal data for speeding up FFT and Hankel transforms
void MGL_EXPORT mgl_clear_fft();

/// Interpolate by cubic spline the data to given point x=[0...nx-1], y=[0...ny-1], z=[0...nz-1]
mreal MGL_EXPORT mgl_data_spline(HCDT dat, mreal x,mreal y,mreal z);
mreal MGL_EXPORT mgl_data_spline_(uintptr_t *dat, mreal *x,mreal *y,mreal *z);
/// Interpolate by cubic spline the data and return its derivatives at given point x=[0...nx-1], y=[0...ny-1], z=[0...nz-1]
mreal MGL_EXPORT mgl_data_spline_ext(HCDT dat, mreal x,mreal y,mreal z, mreal *dx,mreal *dy,mreal *dz);
mreal MGL_EXPORT mgl_data_spline_ext_(uintptr_t *dat, mreal *x,mreal *y,mreal *z, mreal *dx,mreal *dy,mreal *dz);
/// Prepare coefficients for global spline interpolation
HMDT MGL_EXPORT mgl_gspline_init(HCDT x, HCDT v);
uintptr_t MGL_EXPORT mgl_gspline_init_(uintptr_t *x, uintptr_t *v);
/// Evaluate global spline (and its derivatives d1, d2 if not NULL) using prepared coefficients \a coef
mreal MGL_EXPORT mgl_gspline(HCDT coef, mreal dx, mreal *d1, mreal *d2);
mreal MGL_EXPORT mgl_gspline_(uintptr_t *c, mreal *dx, mreal *d1, mreal *d2);
/// Return an approximated x-value (root) when dat(x) = val
mreal MGL_EXPORT mgl_data_solve_1d(HCDT dat, mreal val, int spl, long i0);
mreal MGL_EXPORT mgl_data_solve_1d_(uintptr_t *dat, mreal *val, int *spl, int *i0);
/// Return an approximated value (root) when dat(x) = val
HMDT MGL_EXPORT mgl_data_solve(HCDT dat, mreal val, char dir, HCDT i0, int norm);
uintptr_t MGL_EXPORT mgl_data_solve_(uintptr_t *dat, mreal *val, const char *dir, uintptr_t *i0, int *norm,int);

/// Get trace of the data array
HMDT MGL_EXPORT mgl_data_trace(HCDT d);
uintptr_t MGL_EXPORT mgl_data_trace_(uintptr_t *d);
/// Resize the data to new sizes
HMDT MGL_EXPORT mgl_data_resize(HCDT dat, long mx,long my,long mz);
uintptr_t MGL_EXPORT mgl_data_resize_(uintptr_t *dat, int *mx,int *my,int *mz);
/// Resize the data to new sizes of box [x1,x2]*[y1,y2]*[z1,z2]
HMDT MGL_EXPORT mgl_data_resize_box(HCDT dat, long mx,long my,long mz,mreal x1,mreal x2,mreal y1,mreal y2,mreal z1,mreal z2);
uintptr_t MGL_EXPORT mgl_data_resize_box_(uintptr_t *dat, int *mx,int *my,int *mz,mreal *x1,mreal *x2,mreal *y1,mreal *y2,mreal *z1,mreal *z2);
/// Create n-th points distribution of this data values in range [v1, v2]
HMDT MGL_EXPORT mgl_data_hist(HCDT dat, long n, mreal v1, mreal v2, long nsub);
uintptr_t MGL_EXPORT mgl_data_hist_(uintptr_t *dat, int *n, mreal *v1, mreal *v2, int *nsub);
/// Create n-th points distribution of this data values in range [v1, v2] with weight w
HMDT MGL_EXPORT mgl_data_hist_w(HCDT dat, HCDT weight, long n, mreal v1, mreal v2, long nsub);
uintptr_t MGL_EXPORT mgl_data_hist_w_(uintptr_t *dat, uintptr_t *weight, int *n, mreal *v1, mreal *v2, int *nsub);
/// Get momentum (1D-array) of data along direction 'dir'. String looks like "x1" for median in x-direction, "x2" for width in x-dir and so on.
HMDT MGL_EXPORT mgl_data_momentum(HCDT dat, char dir, const char *how);
uintptr_t MGL_EXPORT mgl_data_momentum_(uintptr_t *dat, char *dir, const char *how, int,int);
/// Get pulse properties: pulse maximum and its position, pulse duration near maximum and by half height.
HMDT MGL_EXPORT mgl_data_pulse(HCDT dat, char dir);
uintptr_t MGL_EXPORT mgl_data_pulse_(uintptr_t *dat, char *dir,int);
/// Get array which values is result of interpolation this for coordinates from other arrays
HMDT MGL_EXPORT mgl_data_evaluate(HCDT dat, HCDT idat, HCDT jdat, HCDT kdat, int norm);
uintptr_t MGL_EXPORT mgl_data_evaluate_(uintptr_t *dat, uintptr_t *idat, uintptr_t *jdat, uintptr_t *kdat, int *norm);
/// Set as the data envelop
void MGL_EXPORT mgl_data_envelop(HMDT dat, char dir);
void MGL_EXPORT mgl_data_envelop_(uintptr_t *dat, const char *dir, int);
/// Remove phase jump
void MGL_EXPORT mgl_data_sew(HMDT dat, const char *dirs, mreal da);
void MGL_EXPORT mgl_data_sew_(uintptr_t *dat, const char *dirs, mreal *da, int);
/// Crop the data
void MGL_EXPORT mgl_data_crop(HMDT dat, long n1, long n2, char dir);
void MGL_EXPORT mgl_data_crop_(uintptr_t *dat, int *n1, int *n2, const char *dir,int);
/// Crop the data to be most optimal for FFT (i.e. to closest value of 2^n*3^m*5^l)
void MGL_EXPORT mgl_data_crop_opt(HMDT dat, const char *how);
void MGL_EXPORT mgl_data_crop_opt_(uintptr_t *dat, const char *how,int);
/// Remove rows with duplicate values in column id
void MGL_EXPORT mgl_data_clean(HMDT dat, long id);
void MGL_EXPORT mgl_data_clean_(uintptr_t *dat, int *id);

/// Multiply the data by other one for each element
void MGL_EXPORT mgl_data_mul_dat(HMDT dat, HCDT d);
void MGL_EXPORT mgl_data_mul_dat_(uintptr_t *dat, uintptr_t *d);
/// Divide the data by other one for each element
void MGL_EXPORT mgl_data_div_dat(HMDT dat, HCDT d);
void MGL_EXPORT mgl_data_div_dat_(uintptr_t *dat, uintptr_t *d);
/// Add the other data
void MGL_EXPORT mgl_data_add_dat(HMDT dat, HCDT d);
void MGL_EXPORT mgl_data_add_dat_(uintptr_t *dat, uintptr_t *d);
/// Subtract the other data
void MGL_EXPORT mgl_data_sub_dat(HMDT dat, HCDT d);
void MGL_EXPORT mgl_data_sub_dat_(uintptr_t *dat, uintptr_t *d);
/// Multiply each element by the number
void MGL_EXPORT mgl_data_mul_num(HMDT dat, mreal d);
void MGL_EXPORT mgl_data_mul_num_(uintptr_t *dat, mreal *d);
/// Divide each element by the number
void MGL_EXPORT mgl_data_div_num(HMDT dat, mreal d);
void MGL_EXPORT mgl_data_div_num_(uintptr_t *dat, mreal *d);
/// Add the number
void MGL_EXPORT mgl_data_add_num(HMDT dat, mreal d);
void MGL_EXPORT mgl_data_add_num_(uintptr_t *dat, mreal *d);
/// Subtract the number
void MGL_EXPORT mgl_data_sub_num(HMDT dat, mreal d);
void MGL_EXPORT mgl_data_sub_num_(uintptr_t *dat, mreal *d);

/// Integral data transformation (like Fourier 'f' or 'i', Hankel 'h' or None 'n') for amplitude and phase
HMDT MGL_EXPORT mgl_transform_a(HCDT am, HCDT ph, const char *tr);
uintptr_t MGL_EXPORT mgl_transform_a_(uintptr_t *am, uintptr_t *ph, const char *tr, int);
/// Integral data transformation (like Fourier 'f' or 'i', Hankel 'h' or None 'n') for real and imaginary parts
HMDT MGL_EXPORT mgl_transform(HCDT re, HCDT im, const char *tr);
uintptr_t MGL_EXPORT mgl_transform_(uintptr_t *re, uintptr_t *im, const char *tr, int);
/// Apply Fourier transform for the data and save result into it
void MGL_EXPORT mgl_data_fourier(HMDT re, HMDT im, const char *dir);
void MGL_EXPORT mgl_data_fourier_(uintptr_t *re, uintptr_t *im, const char *dir, int l);
/// Short time Fourier analysis for real and imaginary parts. Output is amplitude of partial Fourier (result will have size {dn, floor(nx/dn), ny} for dir='x'
HMDT MGL_EXPORT mgl_data_stfa(HCDT re, HCDT im, long dn, char dir);
uintptr_t MGL_EXPORT mgl_data_stfa_(uintptr_t *re, uintptr_t *im, int *dn, char *dir, int);

/// Do something like Delone triangulation for 3d points
HMDT MGL_EXPORT mgl_triangulation_3d(HCDT x, HCDT y, HCDT z);
uintptr_t MGL_EXPORT mgl_triangulation_3d_(uintptr_t *x, uintptr_t *y, uintptr_t *z);
/// Do Delone triangulation for 2d points
HMDT MGL_EXPORT mgl_triangulation_2d(HCDT x, HCDT y);
uintptr_t MGL_EXPORT mgl_triangulation_2d_(uintptr_t *x, uintptr_t *y);

/// Find root for nonlinear equation
mreal MGL_EXPORT mgl_find_root(mreal (*func)(mreal val, void *par), mreal ini, void *par);
/// Find root for nonlinear equation defined by textual formula
mreal MGL_EXPORT mgl_find_root_txt(const char *func, mreal ini, char var_id);
mreal MGL_EXPORT mgl_find_root_txt_(const char *func, mreal *ini, const char *var_id,int,int);
/// Find roots for nonlinear equation defined by textual formula
HMDT MGL_EXPORT mgl_data_roots(const char *func, HCDT ini, char var_id);
uintptr_t MGL_EXPORT mgl_data_roots_(const char *func, uintptr_t *ini, const char *var_id,int,int);
/// Find roots for set of nonlinear equations defined by textual formulas
HMDT MGL_EXPORT mgl_find_roots_txt(const char *func, const char *vars, HCDT ini);
uintptr_t MGL_EXPORT mgl_find_roots_txt_(const char *func, const char *vars, uintptr_t *ini,int,int);
/// Find roots for set of nonlinear equations defined by function
int MGL_EXPORT mgl_find_roots(size_t n, void (*func)(const mreal *x, mreal *f, void *par), mreal *x0, void *par);
//-----------------------------------------------------------------------------
#ifdef __cplusplus
}
#endif
#endif
//-----------------------------------------------------------------------------


#ifndef UTIL_H
#define UTIL_H

#include <vector>

#include <gsl/gsl_matrix.h>

class Matrices_keeper {

    private:
        std::vector<gsl_matrix*> matrices;
    public:
        Matrices_keeper();
        Matrices_keeper(const Matrices_keeper& keeper);
        Matrices_keeper& operator=(const Matrices_keeper& keeper);

        gsl_matrix* alloc_next(int s1, int s2);
        void dalloc_all();
        ~Matrices_keeper();

};

bool validate_inputs(char **args);
void usage();

void exit_on_status(int status, char *msg);
void exit_on_null(void *p, char *msg);

#endif // UTIL_H


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <stdarg.h>
#include <math.h>
#include <unistd.h>
#include <limits.h>
#include <sys/time.h>
#include <zlib.h>

#ifdef INTEL_COMPILER
#include "mkl.h"
#else
#include <cblas.h>
#endif

//#define FIBS_UNIT 1000
#define DEFAULT_NDIGITS 10
#define SZBUF 1024
#define SZBYTE 256
#define N_GENOTYPES 4
#define NA_GENO_CHAR (N_GENOTYPES-1)
#define DEFAULT_ROW_SIZE 100000
#define DEFAULT_SIZE_MATRIX 1000000
#define DEFAULT_SIZE_HEADER 100000
#define DEFAULT_DELIMS " \t\r\n"
#define SZ_LONG_BUF 1000000
#define DEFAULT_TPED_NUM_HEADER_COLS 4
#define DEFAULT_TFAM_NUM_HEADER_COLS 6
#define DEFAULT_TPED_SNPID_INDEX 1
#define DEFAULT_PHENO_NUM_HEADER_COLS 2

struct HFILE {
  int gzflag;       // 1 if gz if used
  int wflag;        // r(0)/w(1) for plain, rb(0)/wb(1) for gz
  int nheadercols;  // # of header columns (0 if nrows=0)
  int nvaluecols;   // # of value cols (0 if nrows=0)
  int nrows;        // # of rows
  FILE* fp;         // plain file handle
  gzFile gzfp;      // gzip file handle
};

// Input routines
void close_file (struct HFILE* fhp);
struct HFILE open_file(char* filename, int gzflag, int wflag);
struct HFILE open_file_with_suffix(char* prefix, char* suffix, int gzflag, int wflag);
//void read_matrix_with_col_headers( struct HFILE* fhp, int nheadercols, char* delims, int symmetric, int* p_nmiss, unsigned char** matrix, char*** headers);
void read_matrix_with_col_headers( struct HFILE* fhp, int nheadercols, char* delims, int* p_nmiss, unsigned char** matrix, char*** headers);
unsigned char* tokenize_tped_line_with_col_headers( struct HFILE* fhp, int nheadercols, char* delims, char* lbuf, unsigned char* values, char** headers, int* p_nvalues, int* p_nmiss );

void emmax_error( const char* format, ... );
void print_help(void);
FILE* readfile(char* filename);

void print_help(void) {
  fprintf(stderr,"Usage: emmax_kin [tpedf]\n");
  fprintf(stderr,"Required parameters\n");
  fprintf(stderr,"\t[tpedf]     : tped file\n");
  fprintf(stderr,"Optional parameters\n");
  fprintf(stderr,"\t-d [# digits]  : precision of the kinship values (default : 10)\n");
  fprintf(stderr,"\t-M [float] : maximum memory in GB (default: 4.0)\n");
  fprintf(stderr,"\t-s : compute IBS kinship matrix (default is Balding-Nicholas)\n");
  fprintf(stderr,"\t-v : turn on verbose mode\n");
  fprintf(stderr,"\t-r : randomly fill missing genotypes (default is imputation by average)\n");
  fprintf(stderr,"\t-x : include non-autosomal chromosomes in computing kinship matrices\n");
  fprintf(stderr,"\t-S [int] : set random seed\n");
  fprintf(stderr,"\t-m [float] : MAF threshold (default is 0)\n");
  fprintf(stderr,"\t-c [float] : Call rate threshold (default is 0)\n");
}

//void read_matrix_with_col_headers( struct HFILE* fhp, int nheadercols, char* delims, int symmetric, int* p_nmiss, unsigned char** matrix, char*** headers) {
void read_matrix_with_col_headers( struct HFILE* fhp, int nheadercols, char* delims, int* p_nmiss, unsigned char** matrix, char*** headers) {
  char* lbuf = (char*) malloc(sizeof(char*) * SZ_LONG_BUF);
  int szmat = DEFAULT_SIZE_MATRIX;
  int szheader = DEFAULT_SIZE_HEADER;
  unsigned char* cmat = (unsigned char*) malloc(sizeof(unsigned char) * szmat );
  char** cheaders = (char**) malloc(sizeof(char*) * szheader );
  int nvalues, i, j, nmiss;

  fhp->nheadercols = nheadercols;
  nmiss = 0;

  while( tokenize_tped_line_with_col_headers(fhp, nheadercols, delims, lbuf, &cmat[fhp->nrows*fhp->nvaluecols], &cheaders[fhp->nrows*fhp->nheadercols], &nvalues, &nmiss) != NULL ) {
    if ( fhp->nrows == 1 ) {
      fhp->nvaluecols = nvalues;
    }
    else if ( fhp->nvaluecols != nvalues ) {
      emmax_error("The column size %d do not match to %d at line %d\n",nvalues,fhp->nvaluecols,fhp->nrows);
    }

    if ( (fhp->nrows+1)*(fhp->nvaluecols) > szheader ) {
      szheader *= 2;
      fprintf(stderr,"Header size is doubled to %d\n",szheader);
      cheaders = (char**) realloc( cheaders, sizeof(char*) * szheader );
    }

    if ( (fhp->nrows+1)*(fhp->nvaluecols) > szheader ) {
      szmat *= 2;
      fprintf(stderr,"Matrix size is doubled to %d\n",szmat);
      cmat = (unsigned char*) realloc( cmat, sizeof(unsigned char) * szmat );
    }
  }
  free(lbuf);

  *p_nmiss = nmiss;

  unsigned char* fmat = (unsigned char*) malloc(sizeof(unsigned char)*fhp->nrows*fhp->nvaluecols);
  char** fheaders = (char**) malloc(sizeof(char*)*fhp->nrows*fhp->nheadercols);
  for(i=0; i < fhp->nrows; ++i) {
    for(j=0; j < fhp->nvaluecols; ++j) {
      fmat[i+j*fhp->nrows] = cmat[i*fhp->nvaluecols+j];
    }
    for(j=0; j < fhp->nheadercols; ++j) {
      fheaders[i+j*fhp->nrows] = cheaders[i*fhp->nheadercols+j];
    }
  }
  free(cmat);
  free(cheaders);

  if ( matrix != NULL ) {
    if ( *matrix != NULL ) {
      free(*matrix);
    }
    *matrix = fmat;
  }

  if ( headers != NULL ) {
    if ( *headers != NULL ) {
      free(*headers);
    }
    *headers = fheaders;
  }
}

unsigned char* tokenize_tped_line_with_col_headers( struct HFILE* fhp, int nheadercols, char* delims, char* lbuf, unsigned char* values, char** headers, int* p_nvalues, int* p_nmiss ) {
  int j;
  char *token;
  unsigned char ctoken;

  char *ret = (fhp->gzflag == 1) ? gzgets(fhp->gzfp, lbuf, SZ_LONG_BUF) : fgets( lbuf, SZ_LONG_BUF, fhp->fp );
  int nmiss = 0;

  if ( ret == NULL ) {
    return NULL;
  }

  if ( fhp->nheadercols != nheadercols ) {
    emmax_error("# of header columns mismatch (%d vs %d) at line %d",fhp->nheadercols,nheadercols,fhp->nrows);
  }

  //fprintf(stderr,"tokenize-line called %s\n",lbuf);

  token = strtok(lbuf, delims);
  for( j=0; token != NULL; ++j ) {
    if ( j < nheadercols ) {
      headers[j] = strdup(token);
    }
    // if zero_miss_flag is set, assume the genotypes are encoded 0,1,2
    // Additively encodes the two genotypes in the following way
    // when (j-nheadercols) is even, 0->MISSING, add 1->0, 2->1
    // when (j-nheadercols) is odd, check 0-0 consistency, and add 1->0, 2->1
    else {
      ctoken = (unsigned char)(token[0]-'0');

      if ( ctoken > 2 ) {
	fprintf(stderr,"Unrecognized token %s\n",token);
	abort();
      }

      if ( (j-nheadercols) % 2 == 0 ) {
	values[(j-nheadercols)/2] = ctoken;
      }
      else {
	if ( ( ctoken > 0 ) && ( values[(j-nheadercols)/2] == 0 ) ) {
	  fprintf(stderr,"Unmatched token pair 0 %s\n",token);
	  abort();
	}
	else if ( ( ctoken == 0 ) && ( values[(j-nheadercols)/2] > 0 ) ) {
	  fprintf(stderr,"Unmatched token pair - %d 0\n",(int)values[(j-nheadercols)/2]);
	  abort();
	}
	values[(j-nheadercols)/2] = (unsigned char)(values[(j-nheadercols)/2]+ctoken);
      }
    }
    token = strtok(NULL, delims);
  }
  //fprintf(stderr,"tokenize-line ended %d %d\n",j,nheadercols);
  if ( (j-nheadercols) % 2 != 0 ) {
    fprintf(stderr,"Number of value tokens are not even %d\n",j-nheadercols);
    abort();
  }

  *p_nvalues = (j-nheadercols)/2;
  *p_nmiss += nmiss;
  ++(fhp->nrows);

  if ( j < nheadercols ) {
    fprintf(stderr,"Number of header columns are %d, but only %d columns were observed\n", nheadercols, j);
    abort();
  }

  return values;
}

// open_file_with_suffix()
// - [prefix].[suffix] : file name to open
// - gzflag : gzip flag (use gzfp if gzflag=1, otherwise use fp)
// - wflag : write flag (1 if write mode otherwise read mode
struct HFILE open_file_with_suffix(char* prefix, char* suffix, int gzflag, int wflag) {
  char filename[SZBUF];
  sprintf(filename,"%s.%s",prefix,suffix);
  return open_file(filename,gzflag,wflag);
}

// open_file()
// - filename : file name to open
// - gzflag : gzip flag (use gzfp if gzflag=1, otherwise use fp)
// - wflag : write flag (1 if write mode otherwise read mode)
struct HFILE open_file(char* filename, int gzflag, int wflag) {
  struct HFILE fh;
  fh.gzflag = gzflag;
  fh.wflag = wflag;
  fh.nheadercols = 0;
  fh.nvaluecols = 0;
  fh.nrows = 0;
  if ( gzflag == 1 ) {
    char* mode = (wflag == 1) ? "wb" : "rb";
    fh.gzfp = gzopen(filename,mode);
    fh.fp = NULL;

    if ( fh.gzfp == NULL ) {
      emmax_error("Cannot open file %s for reading",filename);
    }
  }
  else {
    char* mode = (wflag == 1) ? "w" : "r";
    fh.gzfp = (gzFile) NULL;
    fh.fp = fopen(filename,mode);

    if ( fh.fp == NULL ) {
      emmax_error("Cannot open file %s for writing",filename);
    }
  }
  return fh;
}

void emmax_error( const char* format, ... ) {
  va_list args;
  fprintf(stderr, "ERROR: ");
  va_start (args, format);
  vfprintf(stderr, format, args);
  va_end (args);
  fprintf(stderr,"\n");
  abort();
}

void close_file(struct HFILE* fhp) {
  if ( fhp->gzflag == 1 ) {
    gzclose(fhp->gzfp);
    fhp->gzfp = NULL;
  }
  else {
    fclose(fhp->fp);
    fhp->fp = NULL;
  }
}

int main(int argc, char** argv) {
  int i, j, n, c, ac0, ac1, ac2, nmiss, nelems, nex, n_sum_nin, nin, nex_maf, nex_call_rate, nex_autosomal;
  int verbose, ndigits, tped_nheadercols, tfam_nheadercols, flag_autosomal, rand_fill_flag, ibs_flag, n_unit_lines;
  unsigned char *snprow;
  char *suffix, buf[SZBUF];
  double f, max_memory_GB, maf_thres, call_rate_thres, aaf, call_rate;
  //long *fibs_sums, *scores, mean_score;
  double *kin, *snpunit;
  char *tpedf, *delims, *lbuf;
  char **tfam_headers, **tped_headers;
  struct HFILE tpedh, tfamh, kinsh;
  struct timeval tv;

  // set default params
  gettimeofday(&tv, NULL);
  srand((unsigned int)tv.tv_usec);
  delims = DEFAULT_DELIMS;
  tped_nheadercols = DEFAULT_TPED_NUM_HEADER_COLS;
  tfam_nheadercols = DEFAULT_TFAM_NUM_HEADER_COLS;
  tped_headers = tfam_headers = NULL;
  tpedf = lbuf = 0;
  flag_autosomal = 1;
  rand_fill_flag = 0;
  ibs_flag = 0;
  verbose = 0;
  ndigits = DEFAULT_NDIGITS;
  max_memory_GB = 4.0; // 4.0GB
  maf_thres = 0.0;
  call_rate_thres = 0.0;

  // read arguments and update params
  while ((c = getopt(argc, argv, "d:rsc:vxS:M:m:c:")) != -1 ) {
    switch(c) {
    case 'd': // precision of digits
      ndigits = atoi(optarg);
      break;
    case 'r':
      rand_fill_flag = 1;
      break;
    case 's':
      ibs_flag = 1;
      break;
    case 'v':
      verbose = 1;
      break;
    case 'x':
      flag_autosomal = 0;
      break;
    case 'S':
      srand(atoi(optarg));
      break;
    case 'M':
      max_memory_GB = atof(optarg);
      break;
    case 'm':
      maf_thres = atof(optarg);
      break;
    case 'c':
      call_rate_thres = atof(optarg);
      break;
    default:
      fprintf(stderr,"Error : Unknown option unsigned character %c\n",c);
      abort();
    }
  }

  // Sanity check for the number of required parameters
  if ( argc != optind + 1 ) {
    print_help();
    abort();
  }

  // Read required parameters
  tpedf = argv[optind++];

  if ( verbose) fprintf(stderr,"\nReading TFAM file %s.tfam ....\n",tpedf);

  tfamh = open_file_with_suffix(tpedf, "tfam", 0, 0);
  //read_matrix_with_col_headers( &tfamh, tfam_nheadercols, delims, 0, &nmiss, NULL, &tfam_headers);
  read_matrix_with_col_headers( &tfamh, tfam_nheadercols, delims, &nmiss, NULL, &tfam_headers);
  n = tfamh.nrows; // n is # of individuals
  if ( verbose ) fprintf(stderr,"Identified %d individuals from TFAM file\n",n);

  // compute the # of lines to read together
  // we would need two n*n matrix, and n*m matrix
  // (n*n + n*m)*sizeof(double) < M*1e9
  // m < M*1e9/sizeof(double)/n - n
  n_unit_lines = (int)floor((max_memory_GB * 1.0e9 / sizeof(double) / n - n)/2)*2;
  n_sum_nin = 0;
#ifdef INTEL_COMPILER
  char cn = 'N', ct = 'T';
  double one = 1.;
#endif

  if ( verbose ) fprintf(stderr,"Setting # unit lines = %d to fit the memory requirement\n",n_unit_lines);

  snprow = (unsigned char*)malloc(sizeof(unsigned char)*n);
  tped_headers = (char**)malloc(sizeof(char*)*n);
  lbuf = (char*) malloc(sizeof(char*) * SZ_LONG_BUF);

  kin = (double*)calloc(n*n, sizeof(double));
  snpunit = (double*)malloc(n*n_unit_lines * sizeof(double));

  if ( verbose) fprintf(stderr,"Reading TPED file %s.tped ....\n",tpedf);

  tpedh = open_file_with_suffix(tpedf, "tped", 0, 0);
  tpedh.nheadercols = tped_nheadercols;

  nex_autosomal = nex_maf = nex_call_rate = 0;

  for ( i=0, nin=0, nex = 0; tokenize_tped_line_with_col_headers( &tpedh, tped_nheadercols, delims, lbuf, snprow, tped_headers, &nelems, &nmiss) != NULL; ++i) {
    if ( ( verbose ) && ( i % 10000 ) == 0 ) fprintf(stderr,"Reading %d SNPs\n",i);

    if ( ( flag_autosomal == 1 ) && ( ( atoi(tped_headers[0]) == 0 ) || ( atoi(tped_headers[0]) > 22 ) ) ) // if SNP is not in autosomal chromosomes
      //if ( ( flag_autosomal == 1 ) && ( atoi(tped_headers[0]) > 22 ) ) // if SNP is not in autosomal chromosomes
    {
      ++nex; // # excluded snps from the last unit
      ++nex_autosomal;
      continue;
    }

    if ( nelems != n ) {
      emmax_error("Number of values %d in line %d do not match to %d, the number of columns\n", nelems, tpedh.nvaluecols, n);
    }

  /*
    Perform rapid kinship generate IBS, BN, NCOR matrix
--------------------
IBS pairwise matrix
--------------------
i/j  0  1  2  3
0    NA NA NA NA
1    NA 2  1  0
2    NA 1  2  1
3    NA 0  1  2

In fact is what it does is
X = (m*n) genotype matrix (1,2,3 coded)
Xn = X-2
K = (t(Xn) %*% Xn)/(2*m)
------------------
* NA column may be just averaged or predicted based on r2 with previous SNP
  with a certain window size

---------------------
pairwise BN matrix
--------------------
X : (m*n) genotype matrix
Xn : (m*n) matrix each row standardized, missing assigned to 0
K = t(Xn) %*% Xn / L
--------------------
*/

    ac0 = ac1 = ac2 = 0;
    for(j=0; j < n; ++j) {
      if ( snprow[j] > 0 ) {
	if ( snprow[j] < 2 ) {
	  fprintf(stderr,"Invalid snprow[%d] value %d at line %d, individual %d\n",j,(int)snprow[j],i,j);
	}
	snprow[j] -= 2; // from 2,3,4 to 0,1,2 coding

	switch(snprow[j]) {
	case 0:
	  ++ac0;
	  break;
	case 1:
	  ++ac1;
	  break;
	case 2:
	  ++ac2;
	  break;
	default:
	  emmax_error("Unknown allele %s, converted to %d\n",buf,(int)snprow[j]);
	  break;
	}
      }
      else {
	snprow[j] = (unsigned char)NA_GENO_CHAR;
      }
    }

    call_rate = (double)(ac0+ac1+ac2)/(double)n;
    //fprintf(stderr,"CallRate = %lf\n", call_rate);
    if ( call_rate <= call_rate_thres ) {
      ++nex;
      ++nex_call_rate;
      continue;
    }
    aaf = (double)(ac1+2*ac2)/(double)(2*(ac0+ac1+ac2));
    if ( ( aaf <= maf_thres ) || ( 1.-aaf <= maf_thres ) ) {
      ++nex;
      ++nex_maf;
      continue;
    }

    if ( rand_fill_flag == 1 ) {
      for(j=0; j < n; ++j) {
	if ( snprow[j] == (unsigned char)NA_GENO_CHAR ) {
	  if ( (rand() / (double) RAND_MAX) > aaf ) {
	    if ( (rand() / (double) RAND_MAX) > aaf ) {
	      snprow[j] = (unsigned char)2;
	      //ac1 += 2;
	      ++ac2;
	    }
	    else {
	      snprow[j] = (unsigned char)1;
	      ++ac1;
	      //++ac0;
	      //++ac1;
	    }
	  }
	  else {
	    if ( (rand() / (double) RAND_MAX) > aaf ) {
	      snprow[j] = (unsigned char)1;
	      ++ac1;
	      //++ac0;
	      //++ac1;
	    }
	    else {
	      snprow[j] = (unsigned char)0;
	      ++ac0;
	      //ac0 += 2;
	    }
	  }
	}
      }
      aaf = (double)(ac1+2*ac2)/(double)(2*(ac0+ac1+ac2));
      //aaf = (double)ac1/(double)(ac0+ac1);
    }

    // copy current values to arrays
    // Xn = [-1,1] - two rows per SNP : IBS matrix
    // Xn ~ N(0,1) : BN matrix
    if ( ibs_flag == 1 ) {
      for(j=0; j < n; ++j) {
	if ( snprow[j] == (unsigned char)NA_GENO_CHAR ) {
	  snpunit[nin+  j*n_unit_lines] = 2.*aaf-1.;
	  snpunit[nin+1+j*n_unit_lines] = 2.*aaf-1.;
	}
	else {
	  if ( snprow[j] == 0 ) {
	    snpunit[nin+  j*n_unit_lines] = -1.;
	    snpunit[nin+1+j*n_unit_lines] = -1.;
	  }
	  else if ( snprow[j] == 1 ) {
	    snpunit[nin+  j*n_unit_lines] = 1.;
	    snpunit[nin+1+j*n_unit_lines] = -1.;
	  }
	  else if ( snprow[j] == 2 ) {
	    snpunit[nin+  j*n_unit_lines] = 1.;
	    snpunit[nin+1+j*n_unit_lines] = 1.;
	  }
	  else {
	    emmax_error("Invalid genotype %d\n",snprow[j]);
	  }
	}
      }
      nin += 2;
    }
    else {
      for(j=0; j < n; ++j) {
	if ( snprow[j] == (unsigned char)NA_GENO_CHAR ) {
	    snpunit[nin+j*n_unit_lines] = 0.;
	}
	else {
	  snpunit[nin+j*n_unit_lines] = ((double)snprow[j]-(aaf*2.))/sqrt(4*aaf*(1-aaf));
	}
      }
      ++nin;
    }

    // check if nin == n_unit_lines
    if ( nin >= n_unit_lines ) {
      if ( verbose ) {
	fprintf(stderr,"At SNP %d, intermediately computing kinship matrix with %d SNPs..\n",i,n_unit_lines);
      }
      // kin = kin + t(snpunit)%*%(snpunit)
#ifdef INTEL_COMPILER
      dgemm(&ct,&cn,&n,&n,&n_unit_lines,&one,snpunit,&n_unit_lines,snpunit,&n_unit_lines,&one,kin,&n);
#else
      cblas_dgemm(CblasColMajor, CblasTrans, CblasNoTrans, n, n, n_unit_lines, 1.0, snpunit, n_unit_lines, snpunit, n_unit_lines, 1.0, kin, n);
#endif
      memset(snpunit, 0, sizeof(double)*n_unit_lines*n);

      n_sum_nin += nin;
      nin = 0;
    }
  }
  close_file(&tpedh);

  if ( verbose ) {
    fprintf(stderr,"Succesfully finished reading TPED file\n");
  }
  if ( nin > 0 ) {
    if ( verbose ) {
      fprintf(stderr,"Computing kinship matrix with the remaining %d SNPs..\n",nin);
    }
#ifdef INTEL_COMPILER
    dgemm(&ct,&cn,&n,&n,&n_unit_lines,&one,snpunit,&n_unit_lines,snpunit,&n_unit_lines,&one,kin,&n);
#else
    cblas_dgemm(CblasColMajor, CblasTrans, CblasNoTrans, n, n, n_unit_lines, 1.0, snpunit, n_unit_lines, snpunit, n_unit_lines, 1.0, kin, n);
#endif
    n_sum_nin += nin;
  }

  if ( ibs_flag == 1 ) {
    if ( rand_fill_flag == 1 ) {
      suffix = "rIBS.kinf";
    }
    else {
      suffix = "aIBS.kinf";
    }
  }
  else {
    if ( rand_fill_flag == 1 ) {
      suffix = "rBN.kinf";
    }
    else {
      suffix = "aBN.kinf";
    }
  }
  kinsh = open_file_with_suffix( tpedf, suffix, 0, 1 );

  if ( verbose ) fprintf(stderr,"Printing the kinship matrix to file %s.%s\n",tpedf,suffix);

  for(i=0; i < n; ++i) {
    for(j=0; j < n; ++j) {
      if ( j > 0 ) fprintf(kinsh.fp,"\t");
      f = (double)kin[i+j*n]/(double)(n_sum_nin);
      if ( ibs_flag == 1 ) {
	fprintf(kinsh.fp,"%-.*lf",ndigits,0.5*f+0.5);
      }
      else {
	fprintf(kinsh.fp,"%-.*lf",ndigits,f);
      }
    }
    fprintf(kinsh.fp,"\n");
  }
  close_file(&kinsh);
  free(snprow);
  free(kin);
  free(snpunit);
  free(lbuf);
  free(tped_headers);
  free(tfam_headers);
  return 0;
}


/* ieee-utils/fp-gnuc99.c
 *
 * Copyright (C) 2003, 2004, 2007 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 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.
 */

#define _GNU_SOURCE 1

#include <math.h>
#include <stdio.h>
#include <fenv.h>
#include <gsl/gsl_ieee_utils.h>
#include <gsl/gsl_errno.h>

int
gsl_ieee_set_mode (int precision, int rounding, int exception_mask)
{
  int mode;

  switch (precision)
    {
    case GSL_IEEE_SINGLE_PRECISION:
      GSL_ERROR ("single precision rounding is not supported by <fenv.h>",
                 GSL_EUNSUP) ;
      break ;
    case GSL_IEEE_DOUBLE_PRECISION:
      GSL_ERROR ("double precision rounding is not supported by <fenv.h>",
                 GSL_EUNSUP) ;
      break ;
    case GSL_IEEE_EXTENDED_PRECISION:
      GSL_ERROR ("extended precision rounding is not supported by <fenv.h>",
                 GSL_EUNSUP) ;
      break ;
    }

  switch (rounding)
    {
    case GSL_IEEE_ROUND_TO_NEAREST:
#ifdef FE_TONEAREST
      fesetround (FE_TONEAREST) ;
#else
      GSL_ERROR ("round-to-nearest is not supported by <fenv.h>", GSL_EUNSUP) ;
#endif
      break ;
    case GSL_IEEE_ROUND_DOWN:
#ifdef FE_DOWNWARD
      fesetround (FE_DOWNWARD) ;
#else
      GSL_ERROR ("round-down is not supported by <fenv.h>", GSL_EUNSUP) ;
#endif
      break ;
    case GSL_IEEE_ROUND_UP:
#ifdef FE_UPWARD
      fesetround (FE_UPWARD) ;
#else
      GSL_ERROR ("round-up is not supported by <fenv.h>", GSL_EUNSUP) ;
#endif
      break ;
    case GSL_IEEE_ROUND_TO_ZERO:
#ifdef FE_TOWARDZERO
      fesetround (FE_TOWARDZERO) ;
#else
      GSL_ERROR ("round-toward-zero is not supported by <fenv.h>", GSL_EUNSUP) ;
#endif
      break ;
    default:
#ifdef FE_TONEAREST
      fesetround (FE_TONEAREST) ;
#else
      GSL_ERROR ("default round-to-nearest mode is not supported by <fenv.h>", GSL_EUNSUP) ;
#endif
    }

  /* Turn on all the exceptions apart from 'inexact' */

  mode = 0;

#ifdef FE_INVALID
  mode |= FE_INVALID;
#endif

#ifdef FE_DIVBYZERO
  mode |= FE_DIVBYZERO;
#endif

#ifdef FE_OVERFLOW
  mode |= FE_OVERFLOW ;
#endif

#ifdef FE_UNDERFLOW
  mode |= FE_UNDERFLOW ;
#endif

  if (exception_mask & GSL_IEEE_MASK_INVALID)
    {
#ifdef FE_INVALID
    mode &= ~ FE_INVALID ;
#else
    GSL_ERROR ("invalid operation exception not supported by <fenv.h>",
               GSL_EUNSUP);
#endif
    }

  if (exception_mask & GSL_IEEE_MASK_DENORMALIZED)
    {
      /* do nothing */
    }
  else
    {
      GSL_ERROR ("denormalized operand exception not supported by <fenv.h>. "
                 "Use 'mask-denormalized' to work around this.", GSL_EUNSUP) ;
    }

  if (exception_mask & GSL_IEEE_MASK_DIVISION_BY_ZERO)
    {
#ifdef FE_DIVBYZERO
      mode &= ~ FE_DIVBYZERO ;
#else
      GSL_ERROR ("division by zero exception not supported by <fenv.h>",
                 GSL_EUNSUP);
#endif
    }

  if (exception_mask & GSL_IEEE_MASK_OVERFLOW)
    {
#ifdef FE_OVERFLOW
      mode &= ~ FE_OVERFLOW ;
#else
      GSL_ERROR ("overflow exception not supported by <fenv.h>", GSL_EUNSUP);
#endif
    }

  if (exception_mask & GSL_IEEE_MASK_UNDERFLOW)
    {
#ifdef FE_UNDERFLOW
      mode &=  ~ FE_UNDERFLOW ;
#else
      GSL_ERROR ("underflow exception not supported by <fenv.h>", GSL_EUNSUP);
#endif
    }

  if (exception_mask & GSL_IEEE_TRAP_INEXACT)
    {
#ifdef FE_INEXACT
      mode |= FE_INEXACT ;
#else
      GSL_ERROR ("inexact exception not supported by <fenv.h>", GSL_EUNSUP);
#endif
    }
  else
    {
#ifdef FE_INEXACT
      mode &= ~ FE_INEXACT ;
#else
      /* do nothing */
#endif
    }

#if HAVE_DECL_FEENABLEEXCEPT
  feenableexcept (mode) ;
#elif HAVE_DECL_FESETTRAPENABLE
  fesettrapenable (mode);
#else
  GSL_ERROR ("unknown exception trap method", GSL_EUNSUP)
#endif

  return GSL_SUCCESS ;
}


///
/// @file
///
/// @author Mirko Myllykoski (mirkom@cs.umu.se), Umeå University
///
/// @internal LICENSE
///
/// Copyright (c) 2019-2020, Umeå Universitet
///
/// Redistribution and use in source and binary forms, with or without
/// modification, are permitted provided that the following conditions are met:
///
/// 1. Redistributions of source code must retain the above copyright notice,
///    this list of conditions and the following disclaimer.
///
/// 2. Redistributions in binary form must reproduce the above copyright notice,
///    this list of conditions and the following disclaimer in the documentation
///    and/or other materials provided with the distribution.
///
/// 3. Neither the name of the copyright holder nor the names of its
///    contributors may be used to endorse or promote products derived from this
///    software without specific prior written permission.
///
/// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
/// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
/// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
/// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
/// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
/// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
/// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
/// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
/// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
/// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
/// POSSIBILITY OF SUCH DAMAGE.
///

#include <starneig_config.h>
#include <starneig/configuration.h>
#include "sirobust-geig.h"
#include "robust.h"
#include "../common/common.h"
#include "../common/node_internal.h"
#include <starneig/gep_sm.h>
#include <cblas.h>
#include <stdlib.h>
#include <starpu.h>

__attribute__ ((visibility ("default")))
starneig_error_t starneig_GEP_SM_Eigenvectors_expert(
    struct starneig_eigenvectors_conf *_conf,
    int n,
    int selected[],
    double S[], int ldS,
    double T[], int ldT,
    double Z[], int ldZ,
    double X[], int ldX)
{
    if (n < 1)              return -2;
    if (selected == NULL)   return -3;
    if (S == NULL)          return -4;
    if (ldS < n)            return -5;
    if (T == NULL)          return -6;
    if (ldT < n)            return -7;
    if (Z == NULL)          return -8;
    if (ldZ < n)            return -9;
    if (X == NULL)          return -10;
    if (ldX < n)            return -11;

    if (!starneig_node_initialized())
        return STARNEIG_NOT_INITIALIZED;

    starneig_error_t ret = STARNEIG_SUCCESS;
    double *_X = NULL; int ld_X;

    // use default configuration if necessary
    struct starneig_eigenvectors_conf *conf;
    struct starneig_eigenvectors_conf local_conf;
    if (_conf == NULL)
        starneig_eigenvectors_init_conf(&local_conf);
    else
        local_conf = *_conf;
    conf = &local_conf;

    if (conf->tile_size == STARNEIG_EIGENVECTORS_DEFAULT_TILE_SIZE) {
        conf->tile_size = MAX(64, divceil(0.016*n, 8)*8);
        starneig_message("Setting tile size to %d.", conf->tile_size);
    }
    else if (conf->tile_size < 8) {
        starneig_error("Invalid tile size.");
        ret = STARNEIG_INVALID_CONFIGURATION;
        goto cleanup;
    }

    int selected_count = 0;
    for (int i = 0; i < n; i++)
        if (selected[i]) selected_count++;

    {
        size_t ld;
        _X = starneig_alloc_matrix(n, selected_count, sizeof(double), &ld);
        ld_X = ld;
    }

    //
    // solve
    //

    starneig_node_set_blas_mode(STARNEIG_BLAS_MODE_SEQUENTIAL);
    starneig_node_set_mode(STARNEIG_MODE_SM);
    starneig_node_resume_starpu();

    starneig_eigvec_gen_initialize_omega(100);
    int _ret = starneig_eigvec_gen_sinew(n, S, ldS, T, ldT, selected, _X, ld_X,
        conf->tile_size, conf->tile_size);

    starpu_task_wait_for_all();
    starneig_node_pause_starpu();
    starneig_node_set_blas_mode(STARNEIG_BLAS_MODE_ORIGINAL);

    if (_ret != 0) {
        ret = STARNEIG_GENERIC_ERROR;
        goto cleanup;
    }

    //
    // back transformation
    //

    starneig_node_set_blas_mode(STARNEIG_BLAS_MODE_PARALLEL);
    starneig_node_pause_awake_starpu();

    cblas_dgemm(CblasColMajor, CblasNoTrans, CblasNoTrans,
        n, selected_count, n, 1.0, Z, ldZ, _X, ld_X, 0.0, X, ldX);

    starneig_node_resume_awake_starpu();
    starneig_node_set_blas_mode(STARNEIG_BLAS_MODE_ORIGINAL);

cleanup:

    starneig_free_matrix(_X);

    return ret;
}

__attribute__ ((visibility ("default")))
starneig_error_t starneig_GEP_SM_Eigenvectors(
    int n,
    int selected[],
    double S[], int ldS,
    double T[], int ldT,
    double Z[], int ldZ,
    double X[], int ldX)
{
    if (n < 1)              return -1;
    if (selected == NULL)   return -2;
    if (S == NULL)          return -3;
    if (ldS < n)            return -4;
    if (T == NULL)          return -5;
    if (ldT < n)            return -6;
    if (Z == NULL)          return -7;
    if (ldZ < n)            return -8;
    if (X == NULL)          return -9;
    if (ldX < n)            return -10;

    if (!starneig_node_initialized())
        return STARNEIG_NOT_INITIALIZED;

    return starneig_GEP_SM_Eigenvectors_expert(
        NULL, n, selected, S, ldS, T, ldT, Z, ldZ, X, ldX);
}


#ifndef libceed_solids_examples_utils_h
#define libceed_solids_examples_utils_h

#include <ceed.h>
#include <petsc.h>

// Translate PetscMemType to CeedMemType
static inline CeedMemType MemTypeP2C(PetscMemType mem_type) {
  return PetscMemTypeDevice(mem_type) ? CEED_MEM_DEVICE : CEED_MEM_HOST;
}

#endif // libceed_solids_examples_utils_h


/* combination/gsl_combination.h
 * based on permutation/gsl_permutation.h by Brian Gough
 *
 * Copyright (C) 2001 Szymon Jaroszewicz
 *
 * 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.
 */

#ifndef __GSL_COMBINATION_H__
#define __GSL_COMBINATION_H__

#include <stdlib.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_types.h>
#include <gsl/gsl_check_range.h>

#undef __BEGIN_DECLS
#undef __END_DECLS
#ifdef __cplusplus
# define __BEGIN_DECLS extern "C" {
# define __END_DECLS }
#else
# define __BEGIN_DECLS /* empty */
# define __END_DECLS /* empty */
#endif

__BEGIN_DECLS

struct gsl_combination_struct
{
  size_t n;
  size_t k;
  size_t *data;
};

typedef struct gsl_combination_struct gsl_combination;

gsl_combination *gsl_combination_alloc (const size_t n, const size_t k);
gsl_combination *gsl_combination_calloc (const size_t n, const size_t k);
void gsl_combination_init_first (gsl_combination * c);
void gsl_combination_init_last (gsl_combination * c);
void gsl_combination_free (gsl_combination * c);
int gsl_combination_memcpy (gsl_combination * dest, const gsl_combination * src);

int gsl_combination_fread (FILE * stream, gsl_combination * c);
int gsl_combination_fwrite (FILE * stream, const gsl_combination * c);
int gsl_combination_fscanf (FILE * stream, gsl_combination * c);
int gsl_combination_fprintf (FILE * stream, const gsl_combination * c, const char *format);

size_t gsl_combination_n (const gsl_combination * c);
size_t gsl_combination_k (const gsl_combination * c);
size_t * gsl_combination_data (const gsl_combination * c);

size_t gsl_combination_get (const gsl_combination * c, const size_t i);

int gsl_combination_valid (gsl_combination * c);
int gsl_combination_next (gsl_combination * c);
int gsl_combination_prev (gsl_combination * c);

#ifdef HAVE_INLINE

extern inline
size_t
gsl_combination_get (const gsl_combination * c, const size_t i)
{
#if GSL_RANGE_CHECK
  if (i >= c->k)
    {
      GSL_ERROR_VAL ("index out of range", GSL_EINVAL, 0);
    }
#endif
  return c->data[i];
}

#endif /* HAVE_INLINE */

__END_DECLS

#endif /* __GSL_COMBINATION_H__ */


# ifndef __HEADER__GA__
# define __HEADER__GA__

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <gsl/gsl_math.h>
#include "utils.h"

# define UL_SIZE sizeof(unsigned long)

# define GENES_C1 3
# define GENES_C2 11

// we are going to use a two chromosome genome,
typedef struct Genome {
	unsigned long c1[GENES_C1];
	unsigned long c2[GENES_C2];
	double fitness;
} Genome;

void generate_genome(Genome * genome);

Genome * generate_population(int individuals);
int next_generation(
	Genome * parents, Genome * children,
	int n_elitism, int n_select, int n_cross, int n_new, double p_mutation, int mutation_bit
);

/*
 * Copies the information in the input genome to the output genome.
 * Note that the fitness function is also copied over.
 */
void copy_genome(Genome * in, Genome * out);

// a.k.a crossover
void tinder(Genome * population, int pop_size, Genome * out);
// actual crossover
void crossover_genomes(
	Genome * gen1in,
	Genome * gen2in,
	Genome * out
);

void mutate_genome(Genome * genome, double p_mut);

/*
 * Implementation of elitism operator.
 * This selects the best of the best individuals to be passed over to the next generation.
 *
 * @param population the initial population with fitness values calculated
 * @param pop_size the total population size
 * @param number_elitism the number of best individuals to be selected
 * @param out the population to be filled with the best individuals
 *
 * @return the position of the best individual
 */

int extinction(int ek, Genome * population, Genome * survivors, int pop_size, int number_survivors);

void elitism(Genome * population, int pop_size, int number_elitism, Genome * out);

/*
 * Implementation of roulette wheel method.
 * This method chooses the individuals according to their fidelity, individuals with
 * lower fidelity have a lower change of being selected.
 *
 * @param population the initial population with fitness values calculated
 * @param pop_size the total population size
 * @param best_genomes the number of best individuals to choose
 * @param out the population to be filled with the best individuals
 */
int casting(Genome * population, int pop_size, int best_genomes, Genome * out);

/*
 * Add `n_new` individuals to the start of the passed genome array.
 */
void migration(
	Genome * genome,
	int n_new
);

# endif


//
//     smctc.h
//
//     The principle header file for the SMC template class.
//
//     Copyright Adam Johansen, 2008
//
//
//   This file is part of SMCTC.
//
//   SMCTC 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.
//
//   SMCTC 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 SMCTC.  If not, see <http://www.gnu.org/licenses/>.
//

/// \mainpage smctc -- A Template Class Library for SMC Simulation
///
/// \version 1.0
/// \author Adam M. Johansen
///
/// \section intro_sec Summary
///
/// The SMC template class library (SMCTC) is intended to be used to implement SMC
/// algorithms ranging from simple particle filter to complicated SMC algorithms
/// from simple particle filters to the SMC samplers of Del Moral, Doucet and Jasra (2006)
/// within a generic framework.
///
/// \section license License
///
/// SMCTC 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.
///
/// SMCTC 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 SMCTC.  If not, see <http://www.gnu.org/licenses/>.
///
/// The software is still in development but is thought to be sufficiently fully-featured and
/// stable for use.
///
/// \section using_sec Using the Template Library
///
/// In order to use the template libary it is necessary to place the set of header files in
/// a suitable include directory and then to instantiate the various classes with the
/// appropriate type for your sampler.
///
/// For implementation details, please see the accompanying user guide.
///
///
/// \section example_sec Examples
///
/// \subsection A Simple Particle Filter
///
/// This example provides a simple particle filter for the approximate filtering of
/// nonlinear, nongaussian state space models.
///
/// \subsection SMC Samplers for Rare Event Simulation
///
/// The main.cc file provides an example of a use of the template library to estimate
/// Gaussian tail probabilities within an SMC samplers framework by making use of a sequence
/// of intermediate distributions defined by introducing a potential function which
/// varies from flat to being very close to an indicator function on the tail event.
///
/// This example is taken from from Johansen, Del Moral and Doucet (2006).
///
/// \subsection Acknowledgements
///
/// Thanks are due to Edmund Jackson and Mark Briers for testing SMCTC on a variety of platforms.
/// The Visual C++ project and solution files are kindly provided by Mark Briers.
///

//! \file
//! \brief The main header file for SMCTC.
//!
//! This file serves as an interface between user-space programs and the SMCTC library.
//! This is the only header file which applications need to include to make use of the library (it includes
//! such additional files as are necessary).

#ifndef __SMC_TDSMC_HH

#define __SMC_TDSMC_HH 1.0

#include <cmath>
#include <cstdlib>
#include <iostream>

#include <gsl/gsl_rng.h>

#include "smc-exception.h"
#include "sampler.h"

/// The Sequential Monte Carlo namespace

///
///    The classes and functions within this namespace are intended to be used for producing
///    implemenetations of SMC samplers and related simulation techniques.

namespace smc {}

/// The standard namespace

///     The classes provided within the standard libraries reside within this namespace and
///     the TDSMC class library adds a number of additional operator overloads to some of
///     the standard classes to allow them to deal with our structures.

namespace std {}
#endif


/**
 * @copyright (c) 2017 King Abdullah University of Science and Technology (KAUST).
 *                     All rights reserved.
 **/
/**
 * @file auxcompute_z.h
 *
 * This file contains the declarations of computational auxiliary functions.
 *
 * HiCMA is a software package provided by King Abdullah University of Science and Technology (KAUST)
 *
 * @version 0.1.1
 * @author Kadir Akbudak
 * @date 2018-11-08
 **/
#ifndef __AUXCOMPUTE_Z__
#define __AUXCOMPUTE_Z__

#include "hicma_struct.h"
#ifdef MKL
  #include <mkl.h>
  //#pragma message("MKL is used")
#else
  #include <cblas.h>
  #ifdef LAPACKE_UTILS
    #include <lapacke_utils.h>
  #endif
  #include <lapacke.h>
  //#pragma message("MKL is NOT used")
#endif

#include <stdio.h>
#include "morse.h"
#ifndef min
#define min(a, b) ((a) < (b) ? (a) : (b))
#endif

#include "starsh.h"
int HICMA_zuncompress(
        MORSE_enum uplo, MORSE_desc_t *AUV, MORSE_desc_t *AD, MORSE_desc_t *Ark);
int HICMA_zuncompress_custom_size(MORSE_enum uplo,
        MORSE_desc_t *AUV, MORSE_desc_t *AD, MORSE_desc_t *Ark,
        int numrows_matrix,
        int numcolumns_matrix,
        int numrows_block,
        int numcolumns_block
        );
int HICMA_zdiag_vec2mat(
        MORSE_desc_t *vec, MORSE_desc_t *mat);
void HICMA_znormest( int M, int N, double *A, double *e, double *work);
void HICMA_zgenerate_problem(
        int probtype, //problem type defined in hicma_constants.h
        char sym,     // symmetricity of problem: 'N' or 'S'
        double decay, // decay of singular values. Will be used in HICMA_STARSH_PROB_RND. Set 0 for now.
        int _M,       // number of rows/columns of matrix
        int _nb,      // number of rows/columns of a single tile
        int _mt,      // number of tiles in row dimension
        int _nt,      // number of tiles in column dimension
        HICMA_problem_t *hicma_problem // pointer to hicma struct (starsh format will be used to pass coordinate info to number generation and compression phase)
        );
#endif