/* ode-initval/rk2.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 Gerard Jungman
 *
 * 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.
 */

/* Runge-Kutta 2(3), Euler-Cauchy */

/* Author:  G. Jungman
 */

/* Reference: Abramowitz & Stegun, section 25.5. Runge-Kutta 2nd (25.5.7)
   and 3rd (25.5.8) order methods */

#include <config.h>
#include <stdlib.h>
#include <string.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_odeiv.h>

#include "odeiv_util.h"

typedef struct
{
  double *k1;
  double *k2;
  double *k3;
  double *ytmp;
}
rk2_state_t;

static void *
rk2_alloc (size_t dim)
{
  rk2_state_t *state = (rk2_state_t *) malloc (sizeof (rk2_state_t));

  if (state == 0)
    {
      GSL_ERROR_NULL ("failed to allocate space for rk2_state", GSL_ENOMEM);
    }

  state->k1 = (double *) malloc (dim * sizeof (double));

  if (state->k1 == 0)
    {
      free (state);
      GSL_ERROR_NULL ("failed to allocate space for k1", GSL_ENOMEM);
    }

  state->k2 = (double *) malloc (dim * sizeof (double));

  if (state->k2 == 0)
    {
      free (state->k1);
      free (state);
      GSL_ERROR_NULL ("failed to allocate space for k2", GSL_ENOMEM);
    }

  state->k3 = (double *) malloc (dim * sizeof (double));

  if (state->k3 == 0)
    {
      free (state->k2);
      free (state->k1);
      free (state);
      GSL_ERROR_NULL ("failed to allocate space for k2", GSL_ENOMEM);
    }

  state->ytmp = (double *) malloc (dim * sizeof (double));

  if (state->ytmp == 0)
    {
      free (state->k3);
      free (state->k2);
      free (state->k1);
      free (state);
      GSL_ERROR_NULL ("failed to allocate space for k2", GSL_ENOMEM);
    }

  return state;
}

static int
rk2_apply (void *vstate,
           size_t dim,
           double t,
           double h,
           double y[],
           double yerr[],
           const double dydt_in[],
           double dydt_out[],
           const gsl_odeiv_system * sys)
{
  rk2_state_t *state = (rk2_state_t *) vstate;

  size_t i;

  double *const k1 = state->k1;
  double *const k2 = state->k2;
  double *const k3 = state->k3;
  double *const ytmp = state->ytmp;

  /* k1 step */
  /* k1 = f(t,y) */

  if (dydt_in != NULL)
    {
      DBL_MEMCPY (k1, dydt_in, dim);
    }
  else
    {
      int s = GSL_ODEIV_FN_EVAL (sys, t, y, k1);

      if (s != GSL_SUCCESS)
	{
	  return s;
	}
    }

  /* k2 step */
  /* k2 = f(t + 0.5*h, y + 0.5*k1) */

  for (i = 0; i < dim; i++)
    {
      ytmp[i] = y[i] + 0.5 * h * k1[i];
    }

  {
    int s = GSL_ODEIV_FN_EVAL (sys, t + 0.5 * h, ytmp, k2);

    if (s != GSL_SUCCESS)
      {
	return s;
      }
  }

  /* k3 step */
  /* for 3rd order estimates, is used for error estimation
     k3 = f(t + h, y - k1 + 2*k2) */

  for (i = 0; i < dim; i++)
    {
      ytmp[i] = y[i] + h * (-k1[i] + 2.0 * k2[i]);
    }

  {
    int s = GSL_ODEIV_FN_EVAL (sys, t + h, ytmp, k3);

    if (s != GSL_SUCCESS)
      {
	return s;
      }
  }

  /* final sum */

  for (i = 0; i < dim; i++)
    {
      /* Save original values if derivative evaluation below fails */
      ytmp[i] = y[i];

      {
	const double ksum3 = (k1[i] + 4.0 * k2[i] + k3[i]) / 6.0;
	y[i] += h * ksum3;
      }
    }

  /* Derivatives at output */

  if (dydt_out != NULL)
    {
      int s = GSL_ODEIV_FN_EVAL (sys, t + h, y, dydt_out);

      if (s != GSL_SUCCESS)
	{
	  /* Restore original values */
	  DBL_MEMCPY (y, ytmp, dim);

	  return s;
	}
    }

  /* Error estimation */

  for (i = 0; i < dim; i++)
    {
      const double ksum3 = (k1[i] + 4.0 * k2[i] + k3[i]) / 6.0;
      yerr[i] = h * (k2[i] - ksum3);
    }

  return GSL_SUCCESS;
}

static int
rk2_reset (void *vstate, size_t dim)
{
  rk2_state_t *state = (rk2_state_t *) vstate;

  DBL_ZERO_MEMSET (state->k1, dim);
  DBL_ZERO_MEMSET (state->k2, dim);
  DBL_ZERO_MEMSET (state->k3, dim);
  DBL_ZERO_MEMSET (state->ytmp, dim);

  return GSL_SUCCESS;
}

static unsigned int
rk2_order (void *vstate)
{
  rk2_state_t *state = (rk2_state_t *) vstate;
  state = 0; /* prevent warnings about unused parameters */
  return 2;
}

static void
rk2_free (void *vstate)
{
  rk2_state_t *state = (rk2_state_t *) vstate;
  free (state->k1);
  free (state->k2);
  free (state->k3);
  free (state->ytmp);
  free (state);
}

static const gsl_odeiv_step_type rk2_type = { "rk2",    /* name */
  1,                           /* can use dydt_in */
  1,                           /* gives exact dydt_out */
  &rk2_alloc,
  &rk2_apply,
  &rk2_reset,
  &rk2_order,
  &rk2_free
};

const gsl_odeiv_step_type *gsl_odeiv_step_rk2 = &rk2_type;


//-*-C++-*-
/***************************************************************************
 *
 *   Copyright (C) 2010 by Paul Demorest
 *   Licensed under the Academic Free License version 2.1
 *
 ***************************************************************************/

#ifndef __Pulsar_SplineFit_h
#define __Pulsar_SplineFit_h

#include "Estimate.h"
#include "Reference.h"

#include <gsl/gsl_bspline.h>
#include <gsl/gsl_matrix.h>

//! Spline fitting for smoothing and/or interpolation, using
//! GSL's bspline routines.
class SplineFit : public Reference::Able {

public:

  //! Default constructor
  SplineFit ();

  //! Destructor
  virtual ~SplineFit ();

  //! Clear all current data, results
  void reset();

  //! Set the degree of the fit
  void set_order(int n) { order=n; calculated=false; }

  //! Get the current degree
  int get_order() { return order; }

  //! Set uniform breakpoints to span the data
  void set_uniform_breaks(int nint);

  //! Add a data point
  void add_data(double x, Estimate<double> y);

  //! Compute the fit using current data
  void compute();

  //! Evaluate the fit solution at the given x
  double evaluate(double x);

  //! Evaluate the fit solution's derivative at the given x
  double evaluate_deriv(double x);

  //! Get the reduced chi2 of the fit
  double get_rchi2();

protected:

  //! The x values for the fit
  std::vector<double> x;

  //! The y values/errors for the fit
  std::vector< Estimate<double> > y;

  //! The spline breakpoints
  std::vector<double> bp;

  //! Spline order (0=const, 3=cubic, etc)
  int order;

  //! The fit chi2
  double chi2;

  //! Fit NDOF
  int ndof;

  //! Has the fit been calculated?
  bool calculated;

  //! The fitted coeffs
  gsl_vector *coeffs;

  //! The fit cov matrix
  gsl_matrix *cov;

  //! Check if a requested x val is in the fit range
  bool check_range(double x);

  //! Check if spline intervals and data make sense
  void interval_check(bool fix=false);

  //! Free spline workspaces
  void free_workspaces();

  //! bspline temp space
  gsl_bspline_workspace *bwork;

private:

};

#endif


/*
Written by John MacCallum, The Center for New Music and Audio Technologies,
University of California, Berkeley.  Copyright (c) 2006-09, The Regents of
the University of California (Regents).
Permission to use, copy, modify, distribute, and distribute modified versions
of this software and its documentation without fee and without a signed
licensing agreement, is hereby granted, provided that the above copyright
notice, this paragraph and the following two paragraphs appear in all copies,
modifications, and distributions.

IN NO EVENT SHALL REGENTS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT,
SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, INCLUDING LOST PROFITS, ARISING
OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF REGENTS HAS
BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

REGENTS SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE SOFTWARE AND ACCOMPANYING DOCUMENTATION, IF ANY, PROVIDED
HEREUNDER IS PROVIDED "AS IS". REGENTS HAS NO OBLIGATION TO PROVIDE
MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.

@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
NAME: randdist
DESCRIPTION: Random number generator with over 30 statistical distributions.
AUTHORS: John MacCallum
COPYRIGHT_YEARS: 2006-09
DRUPAL_NODE: /patch/4023
SVN_REVISION: $LastChangedRevision: 587 $
VERSION 1.1: Changed the way the random seed it made
VERSION 1.2: Universal binary
VERSION 1.2.1: Changed the license to be GPL compatible
VERSION 1.3: The object now takes arguments to specify the distribution
VERSION 1.3.1: Use of the buffering system is now optional and off by default
VERSION 1.3.2: Fixed a bug that would cause a crash if randdist was instantiated with a number instead of a symbol as its first arg.
VERSION 1.3.3: Added Gaussdist faker to helpfile, bump version to re-release. -mzed
VERSION 1.4: Default state, changed dump to distlist, user-defined pmfs are now done with the nonparametric message, bugfixes.
VERSION 2.0: Rewritten with common code between randdist and randdist~ put in libranddist.h/c
VERSION 2.1: Re-re-factored.  Nonparametric now uses gsl_ran_discrete().
VERSION 2.1.1: Fixed a bug that occurred when distlist was used with nonparametric
VERSION 2.1.2: Fixed a bug with the multinomial distribution
VERSION 2.1.3: Added multivariate hypergeometric distribution
VERSION 2.1.4: fixed a bug with the way that multinomial arguments were being handled
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
*/

#include "ext.h"
#include "ext_obex.h"
#include "ext_obex_util.h"
#include "libranddist.h"
#include "version.h"
#include "version.c"
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>

#define RDIST_DEFAULT_BUF_SIZE 1024

typedef struct _rdist{
        t_object r_ob;
        void *r_out0;
	void *r_out1;
        gsl_rng *r_rng; // random number generator
	gsl_ran_discrete_t *r_g; // lookup table for nonparametric pdf sampling
        t_atom r_vars[R_MAX_N_VARS];
        t_symbol *r_dist;
        t_atom *r_arIn;
        short r_pmfLength;
        int r_numVars;
	int r_stride;
	void (*r_function)(gsl_rng*, int, void*, int, float*);
	t_atom *r_output_buffer;
} t_rdist;

void *rdist_class;

void rdist_anything(t_rdist *x, t_symbol *msg, short argc, t_atom *argv);
void rdist_bang(t_rdist *x);
void rdist_distlist(t_rdist *x, long n);
void rdist_assist(t_rdist *x, void *b, long m, long a, char *s);
void *rdist_new(t_symbol *msg, short argc, t_atom *argv);
void rdist_anything(t_rdist *x, t_symbol *msg, short argc, t_atom *argv);
void rdist_list(t_rdist *x, t_symbol *msg, short argc, t_atom *argv);
void rdist_nonparametric(t_rdist *x, t_symbol *msg, short argc, t_atom *argv);
void rdist_int(t_rdist *x, long n);
void rdist_float(t_rdist *x, double n);
void rdist_seed(t_rdist *x, long s);
void rdist_free(t_rdist *x);
void rdist_tellmeeverything(t_rdist *x);
void rdist_errorHandler(const char * reason, const char * file, int line, int gsl_errno);

int main(void){
	setup((t_messlist **)&rdist_class, (method)rdist_new, (method)rdist_free, (short)sizeof(t_rdist), 0L, A_GIMME, 0);

	addmess((method)version, "version", 0);
	addmess((method)rdist_assist, "assist", A_CANT, 0);
	addbang((method)rdist_bang);
	addmess((method)rdist_distlist, "distlist", A_DEFLONG, 0);
        addint((method)rdist_int);
        addfloat((method)rdist_float);
        addmess((method)rdist_list, "list", A_GIMME, 0);
	addmess((method)rdist_anything, "anything", A_GIMME, 0);
        addmess((method)rdist_nonparametric, "nonparametric", A_GIMME, 0);
        addmess((method)rdist_seed, "seed", A_LONG, 0);
        addmess((method)rdist_tellmeeverything, "tellmeeverything", 0);

	version(0);

	return 0;
}

void *rdist_new(t_symbol *msg, short argc, t_atom *argv){
	t_rdist *x;
	int i;
	t_atom ar[2];

	x = (t_rdist *)newobject(rdist_class); // create a new instance of this object

	x->r_out0 = outlet_new(x, 0);

	x->r_numVars = 0;

	// set up the random number generator
	gsl_rng_env_setup();

	// waterman14 was the fastest according to my tests
	x->r_rng = gsl_rng_alloc((const gsl_rng_type *)gsl_rng_waterman14);

	// seed it by reading from /dev/random on mac os x and
	// something similar on windows
	gsl_rng_set(x->r_rng, makeseed());

	// this is really fucking important.  if there's an error and the gsl's
	// default handler gets called, it aborts the program!
	gsl_set_error_handler(rdist_errorHandler);

	// setup a workspace
	x->r_output_buffer = (t_atom *)malloc(RDIST_DEFAULT_BUF_SIZE * sizeof(t_atom));

	// init the lib.  just gensyms all the distribution names
	librdist_init();

	// handle the args.  this should be done with attributes.
	if(argc){
		if(argv[0].a_type == A_SYM){
			rdist_anything(x, argv[0].a_w.w_sym, argc - 1, argv + 1);
		}
	} else {
		SETFLOAT(&(ar[0]), 0.);
		SETFLOAT(&(ar[1]), 1.);
		rdist_anything(x, gensym("uniform"), 2, ar);
	}

	return x;
}

void rdist_bang(t_rdist *x){
	int stride = x->r_stride;
	float out[stride];
	int i;
	t_symbol *msg;

	//msg = (stride > 1) ? gensym("list") : gensym("float");

	//post("buffer: %d, pos: %d, val: %f", x->r_whichBuffer, x->r_bufferPos, out[0].a_w.w_float);
	if(x->r_dist == ps_nonparametric){
		x->r_function(x->r_rng, 0, x->r_g, stride, out);
	}else{
		x->r_function(x->r_rng, x->r_numVars, x->r_vars, stride, out);
	}

	if(stride > 1){
		for(i = 0; i < stride; i++){
			SETFLOAT(x->r_output_buffer + i, out[i]);
		}
		outlet_list(x->r_out0, NULL, stride, x->r_output_buffer);
	}else{
		outlet_float(x->r_out0, out[0]);
	}
	//outlet_anything(x->r_out0, msg, stride, x->r_output_buffer);
}

void rdist_anything(t_rdist *x, t_symbol *msg, short argc, t_atom *argv){
	if(argc > R_MAX_N_VARS){
		error("randdist: too many variables");
		return;
	}

	// need to check that this is a valid dist.
	x->r_dist = msg;
	int i;
	if(x->r_dist == gensym("multinomial")){
		double sum = 0;
		for(i = 1; i < argc; i++){
			sum += atom_getfloat(argv + i);
		}
		x->r_vars[0] = argv[0];
		for(i = 1; i < argc; i++){
			atom_setfloat(x->r_vars + i, atom_getfloat(argv + i) / sum);
		}
	}else{
		memcpy(x->r_vars, argv, argc * sizeof(t_atom));
	}

	x->r_numVars = (int)argc;

	if(x->r_dist == ps_bivariate_gaussian){
		x->r_stride = 2;
	}else if(x->r_dist == ps_dirichlet){
		x->r_stride = x->r_numVars;
	}else if(x->r_dist == ps_multinomial || x->r_dist == ps_multivariate_hypergeometric){
		x->r_stride = x->r_numVars - 1;
	}else{
		x->r_stride = 1;
	}

	x->r_function = librdist_get_function(x->r_dist);
}

void rdist_nonparametric(t_rdist *x, t_symbol *msg, short argc, t_atom *argv){
	double f[argc];
	int i;
	x->r_dist = msg;
	for(i = 0; i < argc; i++){
		f[i] = librdist_atom_getfloat(argv + i);
		//post("%d, %f", i, f[i]);
	}
	if(x->r_g){
		gsl_ran_discrete_free(x->r_g);
	}
	x->r_g = gsl_ran_discrete_preproc(argc, f);
	x->r_function = librdist_nonparametric;
}

void rdist_list(t_rdist *x, t_symbol *msg, short argc, t_atom *argv){
	rdist_anything(x, x->r_dist, argc, argv);
}

void rdist_int(t_rdist *x, long n){
	t_atom argv[1];
	SETFLOAT(argv, (double)n);
	rdist_anything(x, x->r_dist, 1, argv);
}

void rdist_float(t_rdist *x, double n){
	t_atom argv[1];
	SETFLOAT(argv, n);
	rdist_anything(x, x->r_dist, 1, argv);
}

void rdist_distlist(t_rdist *x, long n){
	int i, j;
	int stride = x->r_stride;
	float out[n * stride];
	if(stride * n > RDIST_DEFAULT_BUF_SIZE){
		error("randdist: output list is too long (%d > %d)",
		      n * stride,
		      RDIST_DEFAULT_BUF_SIZE);
		return;
	}

	if(n < 1){
		error("randdist: distlist argument must be >= 1.");
		return;
	}

	for(i = 0; i < n; i++){
		if(x->r_dist == gensym("nonparametric")){
			x->r_function(x->r_rng, x->r_numVars, x->r_g, stride, out);
		}else{
			x->r_function(x->r_rng, x->r_numVars, x->r_vars, stride, out);
		}
		for(j = 0; j < stride; j++){
			SETFLOAT(x->r_output_buffer + ((i * stride) + j), out[j]);
		}
	}

	outlet_anything(x->r_out0, gensym("list"), n * stride, x->r_output_buffer);
}

void rdist_assist(t_rdist *x, void *b, long m, long a, char *s){
	if (m == ASSIST_INLET)
		sprintf(s,"Probability distribution and arguments");
	else {
		switch (a) {
		case 0:
			sprintf(s,"Random variate");
			break;
		}
	}
}

void rdist_tellmeeverything(t_rdist *x){
	int i;
	float vars[x->r_numVars];
	post("Distribution: %s", x->r_dist->s_name);
	post("Args:");
	for(i = 0; i < x->r_numVars; i++){
		post("\t%f", x->r_vars[i]);
	}
}

void rdist_free(t_rdist *x){
	if(x->r_rng){
		gsl_rng_free(x->r_rng);
	}
	if(x->r_g){
		gsl_ran_discrete_free(x->r_g);
	}
	if(x->r_arIn){
		free(x->r_arIn);
	}
	if(x->r_output_buffer){
		free(x->r_output_buffer);
	}
}

void rdist_errorHandler(const char * reason, const char * file, int line, int gsl_errno){
	error("randdist: a(n) %s has occured in file %s at line %d (error %d)", reason, file, line, gsl_errno);
}


#ifndef _linalg_h_included_
#define _linalg_h_included_

#include <boost/config.hpp>
#include <boost/numeric/ublas/vector.hpp>
#include <boost/numeric/ublas/matrix.hpp>
#include <boost/numeric/ublas/operation.hpp>

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

#include <jsc/util/log.hpp>

extern "C" {
	extern void dgetrf_(int *,int *,double *,int *,double *,int *);
	extern void dgetri_(int *,double *,int *,double *,double *,int *,int *);
	extern void dpotrf_(char *,int *,double *,int *,int *);
	extern void dpotri_(char *,int *,double *,int *,int *);
};

using namespace boost;
using namespace boost::numeric;
using namespace jsc::util;

class linalg {
	public:
		static void invert_matrix(const ublas::matrix<double> & A,
				ublas::matrix<double> & inv) {
			invert_matrix_gsl_lu(A, inv);
			// invert_matrix_lapack_lu(A, inv);
			// invert_matrix_lapack_cholesky(A, inv);
			unsigned long K = A.size1() + 1;
			ublas::matrix<double> rst(K-1, K-1);
			ublas::matrix<double> ident = ublas::identity_matrix<double>(K-1);
			axpy_prod(A, inv, rst);
			for (unsigned long p = 0; p < K - 1; ++p) {
				for (unsigned long q = 0; q < K - 1; ++q) {
					if (abs(rst(p,q) - ident(p,q)) > 1E-5) {
						L_(debug) << "A*(invA)[" << p << "," << q
							<< "] = " << rst(p,q);
					}
				}
			}
		}
	private:
		static void invert_matrix_gsl_lu(const ublas::matrix<double> & A,
				ublas::matrix<double> & inv) {
			unsigned long K = A.size1() + 1;

			gsl_matrix* m = gsl_matrix_alloc(K - 1, K - 1);
			for (unsigned long p = 0; p < K - 1; ++p) {
				for (unsigned long q = 0; q < K - 1; ++q) {
					gsl_matrix_set(m, p, q, A(p,q));
				}
			}

			gsl_matrix* inverse = gsl_matrix_alloc(K - 1, K - 1);
			gsl_permutation*perm = gsl_permutation_alloc(K-1);
			int s=0;
			gsl_linalg_LU_decomp(m, perm, &s);
			gsl_linalg_LU_invert(m, perm, inverse);
			for (unsigned long p = 0; p < K - 1; ++p) {
				for (unsigned long q = 0; q < K - 1; ++q) {
					inv(p,q) = gsl_matrix_get(inverse, p, q);
				}
			}
			gsl_permutation_free(perm);
			gsl_matrix_free(inverse);
			gsl_matrix_free(m);
		}

		static void invert_matrix_lapack_lu(const ublas::matrix<double> & A,
				ublas::matrix<double> & inv) {
			unsigned long K = A.size1() + 1;

			double * m = (double *)malloc((K - 1)*(K - 1)*sizeof(double));
			for (unsigned long p = 0; p < K - 1; ++p) {
				for (unsigned long q = 0; q < K - 1; ++q) {
					m[p + q*(K-1)] = A(p,q);
				}
			}
			double * ipiv = (double *)malloc((K - 1)*sizeof(double));
			int N = K - 1;
			int lda = N;
			int info;
			dgetrf_(&N, &N, &m[0], &lda, &ipiv[0], &info);
			assert(info == 0);

			double * work = (double *)malloc((K - 1)*sizeof(double));
			int lwork = N;
			dgetri_(&N, &m[0], &lda, &ipiv[0], &work[0], &lwork, &info);
			assert(info == 0);

			for (unsigned long p = 0; p < K - 1; ++p) {
				for (unsigned long q = 0; q < K - 1; ++q) {
					inv(p,q) = m[p + q*(K-1)];
				}
			}

			free(m);
			free(ipiv);
			free(work);
		}

		static void invert_matrix_lapack_cholesky(const ublas::matrix<double> & A,
				ublas::matrix<double> & inv) {
			unsigned long K = A.size1() + 1;

			double * m = (double *)malloc((K - 1)*(K - 1)*sizeof(double));
			for (unsigned long p = 0; p < K - 1; ++p) {
				for (unsigned long q = 0; q < K - 1; ++q) {
					m[p + q*(K-1)] = A(p,q);
				}
			}
			int N = K - 1;
			int lda = N;
			int info;
			char UPLO = 'U';
			dpotrf_(&UPLO, &N, &m[0], &lda, &info);
			assert(info == 0);
			dpotrf_(&UPLO, &N, &m[0], &lda, &info);
			assert(info == 0);

			for (unsigned long p = 0; p < K - 1; ++p) {
				for (unsigned long q = 0; q < K - 1; ++q) {
					inv(p,q) = m[p + q*(K-1)];
				}
			}

			free(m);
		}
};

#endif


#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include <assert.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_sf_gamma.h>
#include <gsl/gsl_sf_result.h>
#include <fftw3.h>

#include "cosmocalc.h"

double get_k0_fftlog(int N, double mu, double q, double r0, double L, double k0guess);
void um_fftlog(int m, double mu, double q, double k0, double r0, double L, double *realpart, double *imagpart);

void compute_discrete_spherical_fft(double *data, int N, double r0, double L, double q, double *result, double *k0)
{
  double mu,rn,kn,tmp[2],um[2],k0guess;
  int i,m;
  static int initFlag = 1;
  static double *rin;
  static fftw_complex *out;
  static fftw_plan pf,pb;

  if(initFlag)
    {
      initFlag = 0;

      rin = (double*)fftw_malloc(sizeof(double)*N);
      out = (fftw_complex*)fftw_malloc(sizeof(fftw_complex)*(N/2+1));
      pf = fftw_plan_dft_r2c_1d(N,rin,out,FFTW_MEASURE);
      pb = fftw_plan_dft_c2r_1d(N,out,rin,FFTW_MEASURE);
    }

  for(i=0;i<N;++i)
    {
      rn = r0*exp(L/((double) N)*((double) (i-N/2)));
      rin[i] = data[i]*4.0*M_PI*pow(rn,1.5)*sqrt(M_PI/2.0);
    }
  fftw_execute(pf);

  q = 0.0;
  mu = 0.5;
  k0guess = *k0;
  *k0 = get_k0_fftlog(N,mu,q,r0,L,k0guess);
  for(i=0;i<N/2+1;++i)
    {
      if(i >= N/2)
	m = i-N;
      else
	m = i;

      um_fftlog(m,mu,q,*k0,r0,L,&(um[0]),&(um[1]));
      if(m == N/2 || m == -N/2)
	um[1] = 0.0;

      tmp[0] = out[i][0]*um[0] - out[i][1]*um[1];
      tmp[1] = out[i][1]*um[0] + out[i][0]*um[1];

      out[i][0] = tmp[0];
      out[i][1] = tmp[1];
    }

  fftw_execute(pb);

  for(i=0;i<N;++i)
    {
      kn = (*k0)*exp(L/((double) N)*((double) (N/2-i)));
      result[N-i-1] = rin[i]/((double) N)/pow(kn,1.5)*exp(L/((double) N)*3.0/2.0);
    }

  /* not needed
     fftw_destroy_plan(pf);
     fftw_destroy_plan(pb);

     fftw_free(rin);
     fftw_free(out);
  */
}

double get_k0_fftlog(int N, double mu, double q, double r0, double L, double k0guess)
{
  double zr,zi,arg;
  gsl_sf_result lnr_top,lnr_bot;
  gsl_sf_result arg_top,arg_bot;
  double twox[2];
  double grat[2];
  double tmp[2];
  double lnkr;
  int intval;

  //do top part of gamma function ratio
  zr = (mu + 1.0 + q)/2.0;
  zi = M_PI*((double) N)/L/2.0;
  gsl_sf_lngamma_complex_e(zr,zi,&lnr_top,&arg_top);

  //do bottom
  zr = (mu + 1.0 - q)/2.0;
  zi = -1.0*M_PI*((double) N)/L/2.0;
  gsl_sf_lngamma_complex_e(zr,zi,&lnr_bot,&arg_bot);

  //get real and imag parts of 2^(q+i*2*pi*m/L)
  zr = pow(2.0,q);
  twox[0] = zr*cos(M_PI*((double) N)/L*log(2.0));
  twox[1] = zr*sin(M_PI*((double) N)/L*log(2.0));

  //now do computation of real and imag parts of result
  zr = exp(lnr_top.val-lnr_bot.val);
  grat[0] = zr*cos(arg_top.val-arg_bot.val);
  grat[1] = zr*sin(arg_top.val-arg_bot.val);

  //do product
  tmp[0] = grat[0]*twox[0] - grat[1]*twox[1];
  tmp[1] = grat[0]*twox[1] + grat[1]*twox[0];

  //find k0
  lnkr = log(k0guess*r0);
  arg = atan2(tmp[1],tmp[0])/M_PI*L/((double) N);
  intval = (int) ((lnkr-arg)/(L/((double) N)));

  return exp(arg + ((double) intval)*L/((double) N))/r0;
}

void um_fftlog(int m, double mu, double q, double k0, double r0, double L, double *realpart, double *imagpart)
{
  double zr,zi;
  gsl_sf_result lnr_top,lnr_bot;
  gsl_sf_result arg_top,arg_bot;
  double kr[2];
  double twox[2];
  double grat[2];
  double tmp[2];

  //do top part of gamma function ratio
  zr = (mu + 1.0 + q)/2.0;
  zi = M_PI*((double) m)/L;
  gsl_sf_lngamma_complex_e(zr,zi,&lnr_top,&arg_top);

  //do bottom
  zr = (mu + 1.0 - q)/2.0;
  zi = -1.0*M_PI*((double) m)/L;
  gsl_sf_lngamma_complex_e(zr,zi,&lnr_bot,&arg_bot);

  //get real and imag parts of (k0*r0)^(i*2*pi*m/L)
  zr = -1.0*log(k0*r0)*2.0*M_PI*((double) m)/L;
  kr[0] = cos(zr);
  kr[1] = sin(zr);

  //get real and imag parts of 2^(q+i*2*pi*m/L)
  zr = pow(2.0,q);
  twox[0] = zr*cos(2.0*M_PI*m/L*log(2.0));
  twox[1] = zr*sin(2.0*M_PI*m/L*log(2.0));

  //now do computation of real and imag parts of result
  zr = exp(lnr_top.val-lnr_bot.val);
  grat[0] = zr*cos(arg_top.val-arg_bot.val);
  grat[1] = zr*sin(arg_top.val-arg_bot.val);

  tmp[0] = kr[0]*twox[0] - kr[1]*twox[1];
  tmp[1] = kr[0]*twox[1] + kr[1]*twox[0];

  *realpart = tmp[0]*grat[0] - tmp[1]*grat[1];
  *imagpart = tmp[0]*grat[1] + tmp[1]*grat[0];
}


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

#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_cblas.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_randist.h>

#define TSSIZE 10
#define WL 10000

typedef struct tagInterpolant{
  gsl_matrix *Bs;
  int *nodes;
}Interpolant;

/* function to create an orthonormal basis set from a training set of models */
double *create_basis(double weight, double tolerance, gsl_matrix *TS, size_t *nbases);

/* function to create the empirical interpolant */
//void create_interpolant(gsl_matrix *RB, gsl_matrix **Bs, int **idxarray);
Interpolant *create_interpolant(gsl_matrix *RB);

/* define function to project model vector onto the training set of models */
void project_onto_basis(double dt, gsl_matrix *RB, gsl_matrix *TS, gsl_matrix *projections, gsl_matrix *projection_coefficients, int idx);

/* dot product of two vectors, but with one multiplied by the weighting factor */
double weighted_dot_product(double weight, gsl_vector *a, gsl_vector *b);

/* normalise a vector */
void normalise(double weight, gsl_vector *a);

/* get the B_matrix */
gsl_matrix *B_matrix(gsl_matrix *V, gsl_matrix *RB);

void print_shape(gsl_matrix *a);

/* create ROQ weights for interpolant to calculate the data dot model terms */
gsl_vector *create_data_model_weights(gsl_matrix *B, double *data);

/* calculate ROQ version of the data model dot product (where the model
   vector is the model just computed at the interpolant points) */
double roq_data_dot_model(gsl_vector *weights, double *model);

/* create ROQ weights for interpolant to calculate the model dot model terms */
gsl_matrix *create_model_model_weights(gsl_matrix *B);

/* calculate ROQ version of the model model dot product (where the model
   vector is the model just computed at the interpolant points) */
double roq_model_dot_model(gsl_matrix *weights, double *model);

double *create_basis(double weight, double tolerance, gsl_matrix *TS, size_t *nbases){
  double *RB = NULL;

  gsl_matrix *projections; /* projections of the basis onto the training set */
  gsl_matrix *residual;
  gsl_matrix *projection_coeffs;
  gsl_vector *projection_errors;
  gsl_vector_view resrow;

  double sigma = 1.;
  size_t dlength = TS->size2, nts = TS->size1;
  size_t mindex = 0, k=0;
  int idx = 0;

  /* allocate reduced basis (initially just one model vector in length).
     Here we have RB just as a double array, rather than a gsl_matrix,
     as there is no realloc functions for GSL matrices. When wanting to
     use RB as a GSL matrix we will have to use matrix views. */
  RB = calloc(dlength, sizeof(double));

  gsl_matrix_view RBview = gsl_matrix_view_array(RB, 1, dlength);
  gsl_vector *firstrow = gsl_vector_calloc(dlength);
  gsl_matrix_get_row(firstrow, TS, 0);
  gsl_matrix_set_row(&RBview.matrix, 0, firstrow);
  gsl_vector_free(firstrow);

  projection_errors = gsl_vector_calloc(dlength);
  residual = gsl_matrix_calloc(nts, dlength);
  projections = gsl_matrix_calloc(nts, dlength);
  projection_coeffs = gsl_matrix_calloc(nts, nts);

  /* create reduced basis set using greedy binning Algorithm 1 of http://arxiv.org/abs/1308.3565 */
  while ( sigma >= tolerance ){
    if ( idx > nts-1 ){
      fprintf(stderr, "Not enough training models (%zu) to produce orthonormal basis given the tolerance of %le\n", nts, tolerance);
      return NULL;
    }

    project_onto_basis(weight, &RBview.matrix, TS, projections, projection_coeffs, idx);

    gsl_matrix_memcpy(residual, TS); /* copy training set into residual */

    /* get residuals by subtracting projections from training set */
    gsl_matrix_sub(residual, projections);

    /* get projection errors */
    for( k=0; k < nts; k++ ){
      double err;

      resrow = gsl_matrix_row(residual, k);
      err = weighted_dot_product(weight, &resrow.vector, &resrow.vector);

      gsl_vector_set(projection_errors, k, err);
    }

    sigma = fabs(gsl_vector_max(projection_errors));

    if ( sigma > 1e-5 ){ fprintf(stderr, "%.12lf\t%d\n", sigma, idx); }
    else { fprintf(stderr, "%.12le\t%d\n", sigma, idx); }

    if ( sigma < tolerance ) { break; }

    /* get index of training set with the largest projection errors */
    mindex = gsl_vector_max_index( projection_errors );

    gsl_vector *next_basis = gsl_vector_calloc(dlength);
    gsl_vector_view proj_basis = gsl_matrix_row(projections, mindex);
    gsl_matrix_get_row(next_basis, TS, mindex);
    gsl_vector_sub(next_basis, &proj_basis.vector);

    /* normalise vector */
    normalise(weight, next_basis);

    idx++;

    /* expand reduced basis */
    RB = realloc(RB, sizeof(double)*dlength*(idx+1));

    /* add on next basis */
    RBview = gsl_matrix_view_array(RB, idx+1, dlength);
    gsl_matrix_set_row(&RBview.matrix, idx, next_basis);

    gsl_vector_free(next_basis);
  }

  *nbases = (size_t)idx;

  gsl_matrix_free(projection_coeffs);
  gsl_matrix_free(residual);
  gsl_matrix_free(TS);

  return RB;
}

void project_onto_basis(double dt, gsl_matrix *RB, gsl_matrix *TS, gsl_matrix *projections, gsl_matrix *projection_coefficients, int idx){
  size_t row = 0;

  gsl_vector_view basis = gsl_matrix_row(RB, idx);

  for ( row=0; row < TS->size1; row++ ){
    double prod;
    gsl_vector_view proj = gsl_matrix_row(projections, row);
    gsl_vector *basisscale = gsl_vector_calloc(TS->size2);

    gsl_vector_view model = gsl_matrix_row(TS, row); /* get model from training set */

    prod = weighted_dot_product(dt, &basis.vector, &model.vector);

    gsl_matrix_set(projection_coefficients, idx, row, prod);
    gsl_vector_memcpy(basisscale, &basis.vector);
    gsl_vector_scale(basisscale, prod);
    gsl_vector_add(&proj.vector, basisscale);
    gsl_vector_free(basisscale);
  }
}

double weighted_dot_product(double weight, gsl_vector *a, gsl_vector *b){
  double dp;
  gsl_vector *weighted = gsl_vector_calloc(a->size);
  gsl_vector_memcpy(weighted, a);

  /* multiply vector by weight */
  gsl_vector_scale(weighted, weight);

  /* get dot product */
  gsl_blas_ddot(weighted, b, &dp);

  gsl_vector_free(weighted);

  return dp;
}

void normalise(double weight, gsl_vector *a){
  double norm = gsl_blas_dnrm2(a); /* use GSL normalisation calculation function */

  gsl_vector_scale(a, 1./(norm*sqrt(weight)));
}

gsl_matrix *B_matrix(gsl_matrix *V, gsl_matrix *RB){
  /* get inverse of V */
  size_t n = V->size1;
  gsl_matrix *invV = gsl_matrix_alloc(n, n);
  int signum;

  /* use LU decomposition to get inverse */
  gsl_matrix *LU = gsl_matrix_alloc(n, n);
  gsl_matrix_memcpy(LU, V);

  gsl_permutation *p = gsl_permutation_alloc(n);
  gsl_linalg_LU_decomp(LU, p, &signum);
  gsl_linalg_LU_invert(LU, p, invV);
  gsl_permutation_free(p);
  gsl_matrix_free(LU);

  /* get B matrix */
  gsl_matrix_view subRB = gsl_matrix_submatrix(RB, 0, 0, n, RB->size2);
  gsl_matrix *B = gsl_matrix_alloc(n, RB->size2);
  gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, invV, &subRB.matrix, 0., B);

  gsl_matrix_free(invV);
  return B;
}

void print_shape(gsl_matrix *a){
  fprintf(stderr, "Matrix is %zu x %zu\n", a->size1, a->size2);
}

gsl_vector *create_data_model_weights(gsl_matrix *B, double *data){
  gsl_vector_view dataview = gsl_vector_view_array(data, B->size2);

  /* create weights */
  gsl_vector *weights = gsl_vector_alloc(B->size1);

  gsl_blas_dgemv(CblasNoTrans, 1.0, B, &dataview.vector, 0., weights);

  return weights;
}

double roq_data_dot_model(gsl_vector *weights, double *model){
  double d_dot_m = 0.;
  gsl_vector_view modelview = gsl_vector_view_array(model, weights->size);

  gsl_blas_ddot(weights, &modelview.vector, &d_dot_m);

  return d_dot_m;
}

gsl_matrix *create_model_model_weights(gsl_matrix *B){
  gsl_matrix *weights = gsl_matrix_alloc(B->size1, B->size1);
  size_t i=0, j=0;
  double ressum = 0.;

  for ( i=0; i<B->size1; i++ ){
    for ( j=0; j<B->size1; j++ ){
      gsl_vector_view Bi = gsl_matrix_row(B, i);
      gsl_vector_view Bj = gsl_matrix_row(B, j);
      gsl_blas_ddot(&Bi.vector, &Bj.vector, &ressum);
      gsl_matrix_set(weights, i, j, ressum);
    }
  }

  return weights;
}

double roq_model_dot_model(gsl_matrix *weights, double *model){
  gsl_vector *ws = gsl_vector_alloc(weights->size1);
  gsl_vector_view modelview = gsl_vector_view_array(model, weights->size1);
  double m_dot_m = 0.;

  gsl_blas_dgemv(CblasTrans, 1.0, weights, &modelview.vector, 0., ws);
  gsl_blas_ddot(ws, &modelview.vector, &m_dot_m);

  return m_dot_m;
}

Interpolant *create_interpolant(gsl_matrix *RB){
  /* now find the empirical interopolant and interpolation nodes using Algorithm 2
     of http://arxiv.org/abs/1308.3565 */
  size_t RBsize = RB->size1; /* reduced basis size (no. of reduced bases) */
  size_t dlength = RB->size2; /* length of each base */
  size_t i=1, j=0, k=0;
  double *V = malloc(sizeof(double));
  gsl_matrix_view Vview;

  Interpolant *interp = malloc(sizeof(Interpolant));

  int idmax = 0, newidx = 0;

  /* get index of maximum absolute value of first basis */
  gsl_vector_view firstbasis = gsl_matrix_row(RB, 0);
  idmax = (int)gsl_blas_idamax(&firstbasis.vector); /* function gets index of maximum absolute value */

  interp->nodes = malloc(RBsize*sizeof(int));

  interp->nodes[0] = idmax;

  fprintf(stderr, "first index = %d\n", interp->nodes[0]);

  for ( i=1; i<RBsize; i++ ){
   Vview = gsl_matrix_view_array(V, i, i);

   for ( j=0; j<i; j++ ){
      for ( k=0; k<i; k++ ){
        gsl_matrix_set(&Vview.matrix, k, j, gsl_matrix_get(RB, j, interp->nodes[k]));
      }
    }

    /* get B matrix */
    gsl_matrix *B = B_matrix(&Vview.matrix, RB);

    /* make empirical interpolant of basis */
    gsl_vector *interpolant = gsl_vector_calloc(dlength);
    gsl_vector *subbasis = gsl_vector_calloc(i);
    gsl_vector_view subview = gsl_matrix_row(RB, i);

    for ( k=0; k<i; k++ ){
      gsl_vector_set(subbasis, k, gsl_vector_get(&subview.vector, interp->nodes[k]));
    }

    gsl_blas_dgemv(CblasTrans, 1.0, B, subbasis, 0., interpolant);

    /* get residuals of interpolant */
    gsl_vector_sub(interpolant, &subview.vector);

    newidx = (int)gsl_blas_idamax(interpolant);

    interp->nodes[i] = newidx;

    fprintf(stderr, "%zu: idx[%d]\n", i, interp->nodes[i]);

    gsl_vector_free(subbasis);
    gsl_matrix_free(B);
    gsl_vector_free(interpolant);

    /* reallocate memory for V */
    V = realloc(V, (i+1)*(i+1)*sizeof(double));
  }

  /* NOTE: the above works and produces identical results to the ipython notebook */

  /* get final B vector with all the indices */
  Vview = gsl_matrix_view_array(V, RBsize, RBsize);
  for( j=0; j<RBsize; j++ ){
    for( k=0; k<RBsize; k++ ){
      gsl_matrix_set(&Vview.matrix, k, j, gsl_matrix_get(RB, j, interp->nodes[k]));
    }
  }

  interp->Bs = B_matrix(&Vview.matrix, RB);

  free(V);

  return interp;
}

int main(){
  gsl_matrix *TS; /* the training set of waveforms */

  size_t TSsize;  /* the size of the training set (number of waveforms) */
  size_t wl;      /* the length of each waveform */
  size_t k = 0, j = 0, i = 0, nbases = 0;

  double *RB = NULL; /* the reduced basis set */
  Interpolant *interp = NULL;

  gsl_vector *times;

  double tolerance = 1e-12, sigma = 1.; /* tolerance for reduced basis generation loop */

  double dt = 60.; /* model time steps */

  TSsize = TSSIZE;
  wl = WL;

  /* allocate memory for training set */
  TS = gsl_matrix_calloc(TSsize, wl);

  double fmin = -0.0001, fmax = 0.0001, f0 = 0., m0 = 0.;
  times = gsl_vector_alloc(wl);

  /* set up training set */
  for ( k=0; k < TSsize; k++ ){
    f0 = fmin + (double)k*(fmax-fmin)/((double)TSsize-1.);

    for ( j=0; j < wl; j++ ){
      double tv = dt*(double)j;
      m0 = sin(2.*M_PI*f0*tv);
      gsl_vector_set(times, j, tv);
      gsl_matrix_set(TS, k, j, m0);
    }

    gsl_vector_view rowview = gsl_matrix_row(TS, k);
    normalise(dt, &rowview.vector);
  }

  if ( (RB = create_basis(dt, tolerance, TS, &nbases)) == NULL){
    fprintf(stderr, "Error... problem producing basis\n");
    return 1;
  }

  gsl_matrix_view RBview = gsl_matrix_view_array(RB, nbases, wl);

  fprintf(stderr, "%zu, %zu x %zu\n", nbases, RBview.matrix.size1, RBview.matrix.size2);

  //FILE *fp = fopen("test_vector.txt", "w");
  //gsl_vector_view testview = gsl_matrix_row(&RBview.matrix, RBview.matrix.size1-1);
  //gsl_vector_fprintf(fp, &testview.vector, "%le");
  //fclose(fp);

  /* NOTE: the above appears to be correct and gives identical values to those in the ipython notebook */

  interp = create_interpolant(&RBview.matrix);

  /* do some timing tests */

  /* create the model dot model weights */
  gsl_matrix *mmw = create_model_model_weights(interp->Bs);

  double randf0 = -0.00004; /* a random frequency to create a model */

  double *modelfull = calloc(wl, sizeof(double));
  double *modelreduced = calloc(nbases, sizeof(double));
  double *timesred = calloc(nbases, sizeof(double));

  /* create model */
  for ( i=0; i<wl; i++ ){ modelfull[i] = sin(2.*M_PI*randf0*gsl_vector_get(times, i)); }
  for ( i=0; i<nbases; i++ ){ modelreduced[i] = sin(2.*M_PI*randf0*gsl_vector_get(times, interp->nodes[i])); }

  gsl_vector_view mfview = gsl_vector_view_array(modelfull, wl);

  struct timespec t1, t2, t3, t4;
  double dt1, dt2;

  /* get the model model term with the full model */
  double mmfull, mmred;
  clock_gettime(CLOCK_MONOTONIC, &t1);
  gsl_blas_ddot(&mfview.vector, &mfview.vector, &mmfull);
  clock_gettime(CLOCK_MONOTONIC, &t2);

  clock_gettime(CLOCK_MONOTONIC, &t3);
  mmred = roq_model_dot_model(mmw, modelreduced);
  clock_gettime(CLOCK_MONOTONIC, &t4);

  dt1 = (double)((t2.tv_sec + t2.tv_nsec*1.e-9) - (t1.tv_sec + t1.tv_nsec*1.e-9));
  dt2 = (double)((t4.tv_sec + t4.tv_nsec*1.e-9) - (t3.tv_sec + t3.tv_nsec*1.e-9));
  fprintf(stderr, "M dot M (full) = %le [%.9lf s], M dot M (reduced) = %le [%.9lf s], time ratio = %lf\n", mmfull, dt1, mmred, dt2, dt1/dt2);

  /* get the data dot model terms by generating some random data */
  const gsl_rng_type *T;
  gsl_rng * r;

  gsl_rng_env_setup();

  T = gsl_rng_default;
  r = gsl_rng_alloc(T);

  double *data = calloc(wl, sizeof(double));
  for ( i=0; i<wl; i++ ){ data[i] = gsl_ran_gaussian(r, 1.0); }

  /* create the data dot model weights */
  gsl_vector *dmw = create_data_model_weights(interp->Bs, data);
  gsl_vector_view dataview = gsl_vector_view_array(data, wl);

  double dmfull, dmred;
  clock_gettime(CLOCK_MONOTONIC, &t1);
  gsl_blas_ddot(&dataview.vector, &mfview.vector, &dmfull);
  clock_gettime(CLOCK_MONOTONIC, &t2);

  clock_gettime(CLOCK_MONOTONIC, &t3);
  dmred = roq_data_dot_model(dmw, modelreduced);
  clock_gettime(CLOCK_MONOTONIC, &t4);

  dt1 = (double)((t2.tv_sec + t2.tv_nsec*1.e-9) - (t1.tv_sec + t1.tv_nsec*1.e-9));
  dt2 = (double)((t4.tv_sec + t4.tv_nsec*1.e-9) - (t3.tv_sec + t3.tv_nsec*1.e-9));
  fprintf(stderr, "D dot M (full) = %le [%.9lf s], D dot M (reduced) = %le [%.9lf s], time ratio = %lf\n", dmfull, dt1, dmred, dt2, dt1/dt2);

  /* check difference in log likelihoods */
  double Lfull, Lred;

  Lfull = mmfull - 2.*dmfull;
  Lred = mmred - 2.*dmred;

  fprintf(stderr, "Fractional difference in log likelihoods = %lf%%\n", 100.*fabs(Lfull-Lred)/fabs(Lfull));

  return 0;
}


/* gsl_sf_hermite.h
 *
 * Copyright (C) 2011-2014 Konrad Griessinger
 *
 * 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.
 */

/*----------------------------------------------------------------------*
 * (konradg(at)gmx.net)                                                 *
 *----------------------------------------------------------------------*/

#ifndef __GSL_SF_HERMITE_H__
#define __GSL_SF_HERMITE_H__

#include <gsl/gsl_sf_result.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

int gsl_sf_hermite_prob_e(const int n, const double x, gsl_sf_result * result);
double gsl_sf_hermite_prob(const int n, const double x);
int gsl_sf_hermite_prob_deriv_e(const int m, const int n, const double x, gsl_sf_result * result);
double gsl_sf_hermite_prob_deriv(const int m, const int n, const double x);
int gsl_sf_hermite_e(const int n, const double x, gsl_sf_result * result);
double gsl_sf_hermite(const int n, const double x);
int gsl_sf_hermite_deriv_e(const int m, const int n, const double x, gsl_sf_result * result);
double gsl_sf_hermite_deriv(const int m, const int n, const double x);
int gsl_sf_hermite_func_e(const int n, const double x, gsl_sf_result * result);
double gsl_sf_hermite_func(const int n, const double x);
int gsl_sf_hermite_func_fast_e(const int n, const double x, gsl_sf_result * result);
double gsl_sf_hermite_func_fast(const int n, const double x);
int gsl_sf_hermite_prob_array(const int nmax, const double x, double * result_array);
int gsl_sf_hermite_prob_array_deriv(const int m, const int nmax, const double x, double * result_array);
int gsl_sf_hermite_prob_deriv_array(const int mmax, const int n, const double x, double * result_array);
int gsl_sf_hermite_prob_series_e(const int n, const double x, const double * a, gsl_sf_result * result);
double gsl_sf_hermite_prob_series(const int n, const double x, const double * a);
int gsl_sf_hermite_array(const int nmax, const double x, double * result_array);
int gsl_sf_hermite_array_deriv(const int m, const int nmax, const double x, double * result_array);
int gsl_sf_hermite_deriv_array(const int mmax, const int n, const double x, double * result_array);
int gsl_sf_hermite_series_e(const int n, const double x, const double * a, gsl_sf_result * result);
double gsl_sf_hermite_series(const int n, const double x, const double * a);
int gsl_sf_hermite_func_array(const int nmax, const double x, double * result_array);
int gsl_sf_hermite_func_series_e(const int n, const double x, const double * a, gsl_sf_result * result);
double gsl_sf_hermite_func_series(const int n, const double x, const double * a);
int gsl_sf_hermite_func_der_e(const int m, const int n, const double x, gsl_sf_result * result);
double gsl_sf_hermite_func_der(const int m, const int n, const double x);
int gsl_sf_hermite_prob_zero_e(const int n, const int s, gsl_sf_result * result);
double gsl_sf_hermite_prob_zero(const int n, const int s);
int gsl_sf_hermite_zero_e(const int n, const int s, gsl_sf_result * result);
double gsl_sf_hermite_zero(const int n, const int s);
int gsl_sf_hermite_func_zero_e(const int n, const int s, gsl_sf_result * result);
double gsl_sf_hermite_func_zero(const int n, const int s);

#ifndef GSL_DISABLE_DEPRECATED

int gsl_sf_hermite_phys_e(const int n, const double x, gsl_sf_result * result);
double gsl_sf_hermite_phys(const int n, const double x);
int gsl_sf_hermite_phys_der_e(const int m, const int n, const double x, gsl_sf_result * result);
double gsl_sf_hermite_phys_der(const int m, const int n, const double x);
int gsl_sf_hermite_phys_array(const int nmax, const double x, double * result_array);
int gsl_sf_hermite_phys_series_e(const int n, const double x, const double * a, gsl_sf_result * result);
double gsl_sf_hermite_phys_series(const int n, const double x, const double * a);
int gsl_sf_hermite_phys_array_der(const int m, const int nmax, const double x, double * result_array);
int gsl_sf_hermite_phys_der_array(const int mmax, const int n, const double x, double * result_array);
int gsl_sf_hermite_phys_zero_e(const int n, const int s, gsl_sf_result * result);
double gsl_sf_hermite_phys_zero(const int n, const int s);

int gsl_sf_hermite_prob_array_der(const int m, const int nmax, const double x, double * result_array);
int gsl_sf_hermite_prob_der_array(const int mmax, const int n, const double x, double * result_array);
int gsl_sf_hermite_prob_der_e(const int m, const int n, const double x, gsl_sf_result * result);
double gsl_sf_hermite_prob_der(const int m, const int n, const double x);

#endif /* !GSL_DISABLE_DEPRECATED */

__END_DECLS

#endif /* __GSL_SF_HERMITE_H__ */


/* ============================================================ *
 * lensing_3rd.h						*
 * Martin Kilbinger, Liping Fu 2010.				*
 * ============================================================ */

#ifndef __LENSING_3RD_H
#define __LENSING_3RD_H

#include <math.h>
#include <stdlib.h>
#include <stdio.h>
#include <assert.h>
#include <fftw3.h>

#include <gsl/gsl_integration.h>
#include <gsl/gsl_monte.h>
#include <gsl/gsl_monte_plain.h>
#include <gsl/gsl_monte_vegas.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_sf_bessel.h>

#include "cosmo.h"
#include "nofz.h"
#include "lensing.h"
#include "errorlist.h"
#include "maths_base.h"

#define tenoverseven   1.428571428571
#define fouroverseven  0.571428571429

/* Minimum scale factor where a non-linear scale can be defined. *
 * See {a,b,c}scocou.						 */
#define A_NL_MIN 0.02

#define s2_min     0.1
#define s2_max     1.0e6
#define N_s2       50
#define epsilon0   1.0e-2
#define N_EFF_MIN -2.0

/* more ce_xyz in smith2.h */
#define lensing_3rd_base         -2400
#define lensing_3rd_wrongmode    -1 + lensing_3rd_base
#define lensing_3rd_rootbracket  -4 + lensing_3rd_base
#define lensing_3rd_slc          -5 + lensing_3rd_base

typedef enum {fgauss=0, fpoly=1, ftophat=2, fdelta=3, fxip=4, fxim=5, fall=6} filter_t;

typedef enum {PT=0, SCOCOU=1, GM12} bispmode_t;
#define sbispmode_t(i) (   \
  i==PT     ? "PT" :       \
  i==SCOCOU ? "scocou01" : \
  i==GM12   ? "GM12" :     \
  "")
#define Nbispmode_t 3

/* Intrinsic 3rd-order alignment model */
typedef enum {ia_3rd_none, ia_3rd_S08} ia_3rd_t;
#define sia_3rd_t(i) ( \
  i==ia_3rd_none ? "none" : \
  i==ia_3rd_S08  ? "S08" : \
  "")
#define Nia_3rd_t 2

/* Bit-coded IA terms */
typedef enum {ia_3rd_undef, ia_GGI_GII_III, ia_only_GGI, ia_only_GII, ia_only_III} ia_3rd_terms_t;
#define sia_3rd_terms_t(i) (      \
  i==ia_3rd_undef     ? "undef" :   \
  i==ia_GGI_GII_III   ? "GGI_GII_III" :   \
  i==ia_only_GGI      ? "only_GGI" : \
  i==ia_only_GII      ? "only_GII" : \
  i==ia_only_III      ? "only_III" : \
  "")
#define Nia_3rd_terms_t 5

/* Source-lens clustering */
typedef enum {slc_none, slc_FK13} slc_t;
#define sslc_t(i) ( \
  i==slc_none      ? "none" : \
  i==slc_FK13      ? "slc_FK13" : \
  "")
#define Nslc_t 2

typedef enum {kkk=0, kkg=1, kgg=2, ggg=3} bispfield_t;

typedef struct {

  /* Lensing, including basic cosmology and redshift distribution)(s) */
  cosmo_lens *lens;

  /* Intrinsic alignment parameters */
  ia_3rd_t ia;
  ia_3rd_terms_t ia_terms;
  double A_GGI, theta_GGI, A_GII, theta_GII;

  /* Source-lens clustering */
  slc_t slc;
  double b_slc, gamma_slc;

  /* ============================================================ *
   * Precomputed stuff (at the moment only one redshift-bin).     *
   * ============================================================ */

  interTable *k_NL, *n_eff;
  double scale_NL_amin;
  interTable2D **B_kappa[3];

  bispmode_t bispmode;

} cosmo_3rd;

typedef struct {
  double r1, r2;
  cosmo_3rd *self;
} cosmo3ANDdoubleANDdouble;

typedef struct {
  double r1, r2;
  cosmo_3rd *self;
  int i, n_bin[3];
} cosmo3ANDtomo;

typedef struct {
  cosmo_3rd *self;
  double R[3];
  filter_t wfilter;
  int n_bin[3];
  int m;
  error **err;
} cosmo3ANDmorestuff;

typedef struct {
   cosmo_3rd *self;
   error **err;
   double a1, a2, f1, f2, R;
} cosmo3SLC;

cosmo_3rd *init_parameters_3rd(double OMEGAM, double OMEGAV, double W0_DE, double W1_DE,
			       double *W_POLY_DE, int N_POLY_DE,
			       double H100, double OMEGAB, double OMEGANUMASS,
			       double NEFFNUMASS, double NORM, double NSPEC,
			       int Nzbin, const int *Nnz, const nofz_t *nofz, double *par_nz,
			       nonlinear_t NONLINEAR, transfer_t TRANSFER,
			       growth_t GROWTH, de_param_t DEPARAM,
			       norm_t normmode,
			       ia_t IA, ia_terms_t IA_TERMS, double A_IA,
			       bispmode_t BISPMODE,
			       ia_3rd_t IA_3RD, ia_3rd_terms_t IA_3RD_TERMS, double A_GGI, double theta_GGI,
			       double A_GII, double theta_GII,
			       slc_t slc, double b_slc, double gamma_slc,
			       error **err);

void consistency_parameters_3rd(const cosmo_3rd *self, error **err);
cosmo_3rd *copy_parameters_3rd_only(cosmo_3rd *source, error **err);
void updateFrom_3rd(cosmo_3rd *avant, cosmo_3rd *apres, error **err);
cosmo_3rd *set_cosmological_parameters_to_default_lens_3rd(error **err);
void read_cosmological_parameters_lens_3rd(cosmo_3rd **self, FILE *F, error **err);
void free_parameters_3rd(cosmo_3rd **self);
void dump_param_3rd(cosmo_3rd* self, FILE *F, error **err);

double dcub(double a);
double n_eff_one(cosmo *self, double k, error **err);
double n_eff(cosmo_3rd *, double, int, error **);
double Q3(double, error **err);
double temp_NL(double, double, cosmo *, error **);
double scale_NL(cosmo_3rd *, double, error **);

double ascocou(cosmo_3rd *, double, double, error **);
double bscocou(cosmo_3rd *, double, double, error **);
double cscocou(cosmo_3rd *, double, double, error **);

double int_for_B_kappa_bar0(double a, void *intpar, error **err);
double int_for_B_kappa_bar1(double a, void *intpar, error **err);
double int_for_B_kappa_bar2(double a, void *intpar, error **err);
double int_for_B_kappa_bar3(double a, void *intpar, error **err);

double F2eff(cosmo_3rd *, double a, double k1, double k2, double cosphi, error **);
double F2bar(int, double, double, error **);
double F2(int, double, double, error **);
double F2cos(int, double, error **err);

double Q_123(cosmo_3rd *, double, double, double, double, error **);
double bb(cosmo_3rd *, double, double, double, int i_bin, int j_bin, int k_bin, error **);
double B_kappa_bar(cosmo_3rd *self, double s1, double s2, int abc, int i_bin, int j_bin, int k_bin, error **err);

double hept_rtbis(double (*func)(double,double,cosmo*,error**), double, double,
		  double, double, cosmo *, error **);
double B_delta(cosmo_3rd *self, double k1, double k2, double cosbeta, double a,
	       error **err);

double Uhat_one(double x, filter_t wfilter);
double Uhat(double eta, filter_t wfilter);
void permute3(double *x, int offset);
double int_for_map3_3d(double x[], size_t dim, void *intpar);
double map3_perm(cosmo_3rd *self, double R[3], int i_bin, int j_bin, int k_bin, filter_t wfilter, error **err);
double map3(cosmo_3rd *self, double R[3], int i_bin, int j_bin, int k_bin, filter_t wfilter, error **err);

double int_for_E_GGI(cosmo_lens *self, double zs1, double zs2, double zl, error **err);
double E_GGI(cosmo_lens *self, error **err);
double map3_GGI(cosmo_3rd *self, double theta, error **err);

double int_for_E_GII(cosmo_lens *self, double zs, double zl, error **err);
double E_GII(cosmo_lens *self, error **err);
double map3_GII(cosmo_3rd *self, double theta, error **err);

double map3_SLC_t1(cosmo_3rd *self, double R, int n_bin, error **err);
double bias_SLC(cosmo_3rd *self, double a, error **err);
double int_for_Q_mc(double x[], size_t dim, void *intpar);
double Q_mc(cosmo_3rd *self, double a1, double a2, double f1, double f2, double R, double *abserr,
	    double *chisqr, error **err);

double lensing_signal_3rd(cosmo_3rd *self, double theta[3], int i_bin, int j_bin, int k_bin, error **err);
void fill_dmm_map3gauss_diag(cosmo_3rd *self, double *data_minus_model, int start, const double *data,
			     int Nzbin, int Ntheta, double *theta, error **err);
void fill_dmm_map3gauss(cosmo_3rd *self, double *data_minus_model, int start, const double *data,
			int Ntheta, double *theta, error **err);
double chi2_lensing_3rd(cosmo_3rd *self, datcov *dc, const cosebi_info_t *cosebi_info, error **err);

#endif


#ifndef __RNG_H
#define __RNG_H

// #include <Rcpp.h>
#include <RcppGSL.h>
#include <gsl/gsl_rng.h>

// [[Rcpp::depends(RcppGSL)]]

using namespace Rcpp;

// Setup RNG for GSL
extern gsl_rng *r_RNG;

unsigned long int random_seed();

//' Generate one sample from a Dirichlet distribution.
//'
//' ## RNG
//'
//' this function uses GSL's RNG seed, unaffected by R's RNG.
//'
//' @param alpha the Dirichlet hyperparameter
//' @param seed the RNG seed: if 0 (default), generate a time-based seed
//' @return a numeric vector
//' @export
//' @family RNG functions
// [[Rcpp::export]]
Rcpp::NumericVector rdirichlet_cpp(const Rcpp::NumericVector &alpha, const unsigned long int seed = 0);

//' Generate from a Dirichlet distribution using the stick breaking definition (safer).
//'
//' ## RNG
//'
//' this function uses R's RNG seed.
//'
//' @param n how many samples to generate
//' @param alpha the Dirichlet hyperparameter, with p entries
//' @return a numeric matrix, n*p
//' @export
//' @family RNG functions
// [[Rcpp::export]]
Rcpp::NumericMatrix rdirichlet_beta_cpp(const unsigned int n, Rcpp::NumericVector alpha);

//' Generate a Dirichlet-Dirichlet-Gamma population (unsafe).
//'
//' Generate samples from m sources and p parameters, n sample per source.
//' The between-source alpha hyperparameter used to generate the source parameters is mandatory.
//'
//' ## RNG
//'
//' this function uses GSL's RNG seed, unaffected by R's RNG.
//'
//' @param n number of samples per source
//' @param m number of sources
//' @param alpha_0 between-source Gamma hyperparameter, a scalar
//' @param beta_0 between-source Gamma hyperparameter, a scalar
//' @param nu_0 between-source Dirichlet hyperparameter, a numeric vector
//' @export
//' @return a matrix with n*m rows
//' @inheritParams rdirichlet_cpp
//' @family RNG functions
// [[Rcpp::export]]
RcppGSL::Matrix rdirdirgamma_cpp(
      const unsigned int &n, const unsigned int &m,
      const double &alpha_0, const double &beta_0,
      const Rcpp::NumericVector &nu_0,
      const unsigned int seed = 0
);

//' Generate a Dirichlet-Dirichlet-Gamma population (safer).
//'
//' Generate samples from m sources and p parameters, n sample per source.
//' The between-source alpha hyperparameter used to generate the source parameters is mandatory.
//'
//' ## RNG
//'
//' this function uses R's RNG seed.
//'
//' @export
//' @return a matrix with n*m rows
//' @inheritParams rdirdirgamma_cpp
//' @family RNG functions
// [[Rcpp::export]]
Rcpp::NumericMatrix rdirdirgamma_beta_cpp(
      const unsigned int &n, const unsigned int &m,
      const double &alpha_0, const double &beta_0,
      const Rcpp::NumericVector nu_0
);

#endif


//gcc -g meanpreds.c -o meanpreds
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include "my_misc.c"
#define isnum(c) (((c>='0') && (c<='9'))||(c=='-')||(c=='+')||(c==' '))
//static char pr[1024];
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_matrix_double.h>
//#include <gsl/gsl_multimin.h>
#include <gsl/gsl_multiroots.h>
//#include "my_misc.c"
//#define GSL 1
#undef GSL
#define GSL 1
//#define GSL 0
int GSLtag;
void least_gsl_error_handler( const char * reason,
			      const char * file,
			      int line,
			      int gsl_errno)
{
  //  printf("%s:%d: %s (gsl_error: %s)\n",
  //	 file, line, reason, gsl_strerror(gsl_errno));
  printf("%s:%d: %s (gsl_error %d)\n",
	 file, line, reason,gsl_errno);
  GSLtag=1;
}
double VarY;
void calc_Ainvb(double *M, double *A_data, double *b_data, int nx, int ndata,int nxmarume)
{
  /* b= A M  --> M= Ainv b
     b  in R^{ndata x 1}
     A  in R^{ndata x nx}   (ndata>nx)
     M  in R^{nx    x 1}
   */
  int i;
  gsl_vector *S;
  gsl_vector *work;
  gsl_vector *x;
  gsl_vector *b;
  gsl_matrix *V;
  gsl_matrix *A;
  if(ndata<=0){
    M[0]=1;
    for(i=1;i<nx;i++) M[i]=1./nx;
  }
  else{
    A =gsl_matrix_alloc(ndata,nx);
    b =gsl_vector_alloc(ndata);b->data=b_data;
    A->data=A_data;
    //  for(i=0;i<ndata;i++){printf("%e %e %d #bi,Ai\n",A->data[i],b->data[i],i); }

    V = gsl_matrix_alloc (nx,nx);
    S = gsl_vector_alloc (nx);
    work = gsl_vector_alloc(nx);
    x = gsl_vector_alloc(nx);

    gsl_set_error_handler( &least_gsl_error_handler );GSLtag=0;

#if GSL == 1
    gsl_linalg_SV_decomp_jacobi (A, V, S); //higer accuracy than Golub-Reinsh
#elif GSL == 2
    gsl_linalg_SV_decomp (A, V, S, work); //Golub-Reinsh
#elif GSL == 3
    {//faster
      gsl_matrix *X;
      X = gsl_matrix_alloc (nx,nx);
      gsl_linalg_SV_decomp_mod (A, X, V, S, work);
      gsl_matrix_free(X);
    }
#endif
    //    for(i=nxmarume;i<nx;i++){

    fprintf(stdout,"Lambda");
    for(i=0;i<nx;i++){
      //      if(nx>40) break;
      //      fprintf(stdout,"S->data[%d]=%e;",i,S->data[i]);
      fprintf(stdout,"(%d)%e",i,S->data[i]);
    }
    fprintf(stdout,"\n");
    VarY=0;
    if(GSLtag==1){
      fprintf(stderr,"\nEigenValue=");for(i=0;i<nx;i++) fprintf(stderr,"%e ",S->data[i]); fprintf(stderr,"\n");
      for(i=0;i<nx;i++) M[i]=1./nx;
    }
    else{
      if(nxmarume>=0){//Principal Component Analysis
	for(i=nxmarume;i<nx;i++) S->data[i]=0;
	for(i=0;i<nxmarume;i++) VarY+=S->data[i];
	gsl_linalg_SV_solve(A,V,S,b,x);
	for(i=0;i<nx;i++) M[i]=gsl_vector_get(x,i);
	//    {//check
	//      double err=0,yhat;
	//      int j;
	//      for(i=0;i<ndata;i++){
	//	if(i>10) break;
	//	yhat=b_data[i];
	//	for(j=0;j<nx;j++){
	//	  yhat-= M[j]*A_data[i*nx+j];
	//	}
	//	err+=square(yhat);
	//	fprintf(stderr,"err=%e=%e/%d. yhat=%e=(%e",err/(i+1.),err,i,yhat,b_data[i]);
	//	for(j=0;j<nx;j++) fprintf(stderr,"-(%e)*(%e)",M[j],A_data[i*nx+j]);
	//	fprintf(stderr,")^2\n");
	//      }
	//    }
      }
      else{//Minor Component Analysis
	int ii=0;
	int im=-nxmarume;
	for(i=nx-1;i>=0;i--){
	  if(S->data[i]>1e-20){
	    ii++;
	    VarY+=S->data[i];
	    if(ii>=im) break;
	  }
	}
	int j;

	double M0=-V->data[i];
	for(j=1;j<nx;j++){
	  M[j-1]=V->data[j*nx+i]/M0;
	}
//	double M0=-V->data[i*nx];
//	for(j=1;j<nx;j++){
//	  M[j-1]=V->data[i*nx+j]/M0;
//	}

      }
    }
    gsl_vector_free(S);
    gsl_vector_free(work);
    gsl_vector_free(x);
    gsl_matrix_free(V);
    gsl_matrix_free(A);
    gsl_vector_free(b);
  }
}
void calc_AtinvbMCA(double *M, double *At_data, double *b_data, int nx, int ndata,int nxmarume)
{
  /* b= A M  --> M= Ainv b
     b  in R^{ndata x 1}
     A=At  in R^{ndata x nx}
     M  in R^{nx    x 1}
   */
  int nx1=nx+1,i,j,jnx1;
  gsl_matrix *A  =gsl_matrix_alloc(ndata,nx1);
  for(j=0;j<ndata;j++){
    jnx1=j*nx1;
    A->data[jnx1]=b_data[j];
    for(i=0;i<nx;i++){
      A->data[jnx1+i+1]=At_data[i*ndata+j];
    }
  }
  calc_Ainvb(M, (double *)(A->data), b_data, nx1, ndata, -nxmarume);

  gsl_matrix_free(A);
}
void calc_Atinvb(double *M, double *At_data, double *b_data, int nx, int ndata,int nxmarume)
{
  /* b= A M  --> M= Ainv b
     b  in R^{ndata x 1}
     A=At  in R^{ndata x nx}
     M  in R^{nx    x 1}
   */
  gsl_matrix *At =gsl_matrix_alloc(nx,ndata);
  gsl_matrix *A  =gsl_matrix_alloc(ndata,nx);
  At->data=At_data;
  gsl_matrix_transpose_memcpy(A, At);
  calc_Ainvb(M, (double *)(A->data), b_data, nx, ndata, nxmarume);
  gsl_matrix_free(A);
  gsl_matrix_free(At);
}
void calc_yp(double *y, double *a_data, int nx, int ndata,int nxmarume)
{//M[i]=Ainv b
  int i, l,j;
  double sumS=0,sumSj=0;
  gsl_vector *S;
  gsl_vector *work;
  gsl_vector *x;
  //  gsl_vector *b;
  gsl_matrix *V;
  gsl_matrix *A;
  A =gsl_matrix_alloc(ndata,nx);
  A->data=a_data;
  //    b =gsl_vector_alloc(ndata);
  //    b->data=b_data;
  V = gsl_matrix_alloc (nx,nx);
  S = gsl_vector_alloc (nx);
  work = gsl_vector_alloc(nx);
  x = gsl_vector_alloc(nx);

  gsl_set_error_handler( &least_gsl_error_handler );GSLtag=0;

#if GSL == 1
  gsl_linalg_SV_decomp_jacobi (A, V, S); //higer accuracy than Golub-Reinsh
#elif GSL == 2
  gsl_linalg_SV_decomp (A, V, S, work); //Golub-Reinsh
#elif GSL == 3
  {//faster
    gsl_matrix *X;
    X = gsl_matrix_alloc (nx,nx);
    gsl_linalg_SV_decomp_mod (A, X, V, S, work);
    gsl_matrix_free(X);
  }
#endif
  //    for(i=nxmarume;i<nx;i++){
  sumS=sumSj=0;
  for(l=0;l<nx;l++) sumS+=gsl_vector_get(S,l);
  if(nxmarume>=0){
    for(i=0;i<ndata;i++){
      y[i]=0;
      for(l=0;l<nxmarume;l++){
	//	fprintf(stderr,"S%d=%e.\n",l,gsl_vector_get(S,l));
	for(j=0;j<nx;j++){
	  //	y[i]+=S->data[l]*A->data[i*nx+l]*V->data[j*nx+l];
	  y[i]+=gsl_vector_get(S,l)*gsl_matrix_get(A,i,l)*gsl_matrix_get(V,j,l);
	}
      }
      y[i]/=nx;
      if(i<5){
	sumSj+=gsl_vector_get(S,i);
	fprintf(stderr,"[%d]y=%e, s=%e, CumulativeProp=%f=%f/%f\n",i,y[i],gsl_vector_get(S,i),sumSj/sumS,sumSj,sumS);
      }
    }
  }
  else{
    int ll=0;
    for(i=0;i<ndata;i++){
      y[i]=0;
      for(l=nx;;l--){
	if(gsl_vector_get(S,l)<=1e-30) continue;
	if(i==0) fprintf(stderr,"S%d=%e.\n",l,gsl_vector_get(S,l));
	for(j=0;j<nx;j++){
	  y[i]+=gsl_vector_get(S,l)*gsl_matrix_get(A,i,l)*gsl_matrix_get(V,j,l);
	}
	if(++ll>=-nxmarume) break;
      }
      y[i]/=nx;
      if(i<5){
	sumSj+=gsl_vector_get(S,i);
	if(i<5) fprintf(stderr,"[%d]y=%e, s=%e, CumulativeProp=%f=%f/%f\n",i,y[i],gsl_vector_get(S,i),sumSj/sumS,sumSj,sumS);
      }
    }
  }
  gsl_vector_free(S);
  gsl_vector_free(work);
  gsl_vector_free(x);
  gsl_matrix_free(V);
}

////For Maximizing the Entropy of the training data
////For Minimizing the minus of the Entropy of the training data
//Lagrange Method
int
my_df_Entropy(const gsl_vector *v, void *params, gsl_vector *df)
{
  double **dp = (double **)params;
  int nd=(int)((double)*dp[0]);
  int nl=(int)((double)*dp[1]);
  double *y=(double *)dp[2];
  double *f=(double *)dp[3];
  int sgn=(int)((double)*dp[4]);
  double *yp=(double*)malloc(sizeof(double)*nd);
  double *e2=(double*)malloc(sizeof(double)*nd);
  double *e =(double*)malloc(sizeof(double)*nd);
  double *dHdp=(double*)malloc(sizeof(double)*nd);
  double *dpde2=(double*)malloc(sizeof(double)*nd*nd);
  double E2,lognd=log(nd),pi;
  int i,j,k,l;

  E2=0;
  for(i=0;i<nd;i++){
    yp[i]=0; for(j=0;j<nl;j++) yp[i]+=square(v->data[j])*f[j*nd+i];
    e[i]=(y[i]-yp[i]);
    e2[i]=e[i]*e[i];
    E2+=e2[i];
  }
  for(i=0;i<nd;i++){
    pi=e2[i]/E2;
    dHdp[i]=(log(pi)+1.)/lognd;//for the minus Entropy
    for(k=0;k<nd;k++){
      if(i == k) dpde2[i*nd+k]=1./E2-e2[i]/E2/E2;
      else dpde2[i*nd+k]=-e2[i]/E2/E2;
    }
  }
  //  double dfnorm=0;
  //  fprintf(stdout,"df=");
  for(l=0;l<nl;l++){
    df->data[l]=0;
    for(i=0;i<nd;i++){
      for(k=0;k<nd;k++){
	df->data[l]+=dHdp[i]*dpde2[i*nd+k]*(2.*e[k]*(-2.*v->data[l]*f[l*nd+k]));
	//	df->data[l]+=dHdp[i]*dpde2[i*nd+k]*(-2.*e[k]*f[l*nd+k]);
      }
      df->data[l]+= 2.*v->data[nl]*v->data[l]*sgn;//for Penalty
      //      df->data[l]-= 2.*v->data[nl]*v->data[l];//for Penalty
      //      df->data[l] = C0*(-2.*e[i]*f[l*nd+i])/E0 +C1*df->data[l];//for H=C0*E2/E0+C1*Entropy
    }
    //    dfnorm+=square(df->data[l]);
    //    fprintf(stdout,"%.4f ",df->data[l]);
  }
  //Lagrange for sumv=1. v->data[nd]=lambda
  double sumv=0;//for Lagrange
  for(j=0;j<nl;j++) sumv+=square(v->data[j]);//for Lagrange
  df->data[nl]=(sumv-1.)*sgn;//for Lagrange L=H+lambda*(sum c_l-1)
  //  df->data[nl]=1.-sumv;//for Lagrange L=H-lambda*(sum c_l-1)
  //  fprintf(stdout,";dfnorm=%.4e\n",dfnorm);
  free(yp);
  free(e);
  free(e2);
  return GSL_SUCCESS;
}
int
gsl_print_state (size_t iter, gsl_multiroot_fsolver * s, void *params)
{
  double **dp = (double **)params;
  int nd=(int)((double)*dp[0]);
  int nl=(int)((double)*dp[1]);
  double *y=(double *)dp[2];
  double *f=(double *)dp[3];
  double *yp=(double*)malloc(sizeof(double)*nd);
  double *e2=(double*)malloc(sizeof(double)*nd);
  double *e =(double*)malloc(sizeof(double)*nd);
  double E2,pi;
  int i,j;

  E2=0;
  for(i=0;i<nd;i++){
    yp[i]=0; for(j=0;j<nl;j++) yp[i]+=square(gsl_vector_get (s->x, j))*f[j*nd+i];
    e[i]=(y[i]-yp[i]);
    e2[i]=e[i]*e[i];
    E2+=e2[i];
  }
  double H=0;//
  for(i=0;i<nd;i++){
    pi=e2[i]/E2;
    H += pi*log(pi);//the minus Entropy
  }
  H/=log(nd);
  printf ("iter = %3u H=%f x0=%.3e...%.3e "
	  "dL/dx=%.3e...%3e\n",
	  (unsigned int)iter,-H,
	  square(gsl_vector_get (s->x, 0)),
	  gsl_vector_get (s->x, nl),
	  gsl_vector_get (s->f, 0),
	  gsl_vector_get (s->f, nl));
  return 0;
}

//////For Maximizing the Entropy of the training data
//////For Minimizing the minus of the Entropy of the training data
//double
//my_f_Entropy(const gsl_vector *v, void *params)
//{
//  //params
//  /*
//    e_i=y_i- sum_l v[l] f[l][i] (l=0:nx-1)
//    p_i= e_i^2/ sum_j e_j^2
//    H= sum_i p_i log(p_i);
//
//  */
//  double **dp = (double **)params;
//  int nd=(int)((double)*dp[0]);
//  int nl=(int)((double)*dp[1]);
//  double *y=(double *)dp[2];
//  double *f=(double *)dp[3];
//  double C0=(double)*dp[4];
////  double C1=(double)*dp[5];
////  double E0=(double)*dp[6];
//  double *e2=(double*)malloc(sizeof(double)*nd);
//  double E2;
//  double H,ypi,pi;
//  int i,j;
//  E2=0;
//  for(i=0;i<nd;i++){
//    ypi=0; for(j=0;j<nl;j++) ypi+=square(v->data[j])*f[j*nd+i];
//    e2[i]=square(ypi-y[i]);
//    E2+=e2[i];
//  }
//  H=0;
//  for(i=0;i<nd;i++){
//    pi=e2[i]/E2;
//    H += pi*log(pi);//the minus Entropy
//  }
//  H/=log(nd);
//
//  //  H=C0*E2/E0+C1*H;//for H=C0*E2/E0+C1*Entropy
//
//  //Lagrange for sumv=1. v->data[nd]=lambda
//  double sumv=0;//for Lagrange
//  for(j=0;j<nl;j++) sumv+=square(v->data[j]);//for Lagrange
//  //  if(C0*(sumv-1.)<0) C0*=-1;
//  //  H+=v->data[nl]*(sumv-1.);//for Lagrange
//  fprintf(stderr,"H=%f,sumv=%e",H,sumv);
//  H+=C0*(sumv-1.);//for Penalty method
//  /////
//  free(e2);
//  return H;
//}
//
///* The gradient of f, df = (df/dx, df/dy). */
//void
//my_df_Entropy(const gsl_vector *v, void *params,
//       gsl_vector *df)
//{
//  double **dp = (double **)params;
//  int nd=(int)((double)*dp[0]);
//  int nl=(int)((double)*dp[1]);
//  double *y=(double *)dp[2];
//  double *f=(double *)dp[3];
//  double C0=(double)*dp[4];
//  //  double C1=(double)*dp[5];
//  //  double E0=(double)*dp[6];
//  double *yp=(double*)malloc(sizeof(double)*nd);
//  double *e2=(double*)malloc(sizeof(double)*nd);
//  double *e =(double*)malloc(sizeof(double)*nd);
//  double *dHdp=(double*)malloc(sizeof(double)*nd);
//  double *dpde2=(double*)malloc(sizeof(double)*nd*nd);
//  double E2,lognd=log(nd),pi;
//  int i,j,k,l;
////  {
////    double sumv;
////    for(j=0;j<nl;j++) sumv+=square(v->data[j]);//for Lagrange
////    if(C0*(sumv-1.)<0) C0*=-1;
////  }
//  E2=0;
//  for(i=0;i<nd;i++){
//    yp[i]=0; for(j=0;j<nl;j++) yp[i]+=square(v->data[j])*f[j*nd+i];
//    e[i]=(y[i]-yp[i]);
//    e2[i]=e[i]*e[i];
//    E2+=e2[i];
//  }
//  for(i=0;i<nd;i++){
//    pi=e2[i]/E2;
//    //    dHdp[i]=(-log(pi)-1.)/lognd;
//    dHdp[i]=(log(pi)+1.)/lognd;//for the minus Entropy
//    for(k=0;k<nd;k++){
//      if(i == k) dpde2[i*nd+k]=1./E2-e2[i]/E2/E2;
//      else dpde2[i*nd+k]=-e2[i]/E2/E2;
//    }
//  }
//  double dfnorm=0;
//  //  fprintf(stdout,"df=");
//  for(l=0;l<nl;l++){
//    df->data[l]=0;
//    for(i=0;i<nd;i++){
//      for(k=0;k<nd;k++){
//	df->data[l]+=dHdp[i]*dpde2[i*nd+k]*(2.*e[k]*(-2.*v->data[l]*f[l*nd+k]));
//	//	df->data[l]+=dHdp[i]*dpde2[i*nd+k]*(-2.*e[k]*f[l*nd+k]);
//      }
//      df->data[l]+= 2.*C0*v->data[l];//for Penalty
//      //      df->data[l] = C0*(-2.*e[i]*f[l*nd+i])/E0 +C1*df->data[l];//for H=C0*E2/E0+C1*Entropy
//    }
//    dfnorm+=square(df->data[l]);
//    //    fprintf(stdout,"%.4f ",df->data[l]);
//  }
//  //Lagrange for sumv=1. v->data[nd]=lambda
//  //  double sumv=0;//for Lagrange
//  //  for(j=0;j<nl;j++) sumv+=square(v->data[j]);//for Lagrange
//  //  df->data[nl]=sumv-1.;//for Lagrange
//
//  fprintf(stdout,";dfnorm=%.4e\n",dfnorm);
//  free(yp);
//  free(e);
//  free(e2);
//}
//
///* Compute both f and df together. */
//void
//my_fdf_Entropy(const gsl_vector *x, void *params,
//	double *f, gsl_vector *df)
//{
//  *f = my_f_Entropy(x, params);
//  my_df_Entropy(x, params, df);
//}

////
typedef struct{
  int r1;
  int r2;
  double r3;
  int nr;
  double r12;
  double *r;
  double ymin;
  double ymax;
} RESOLUTION;
#define ZERO 1e-20
int init_res(RESOLUTION *res)
{
  int i;
  char buff[32];
  if(res->r2==0) return(-1);
  if(fabs(res->ymax-res->ymin)<ZERO) {
    res->r2=0;
    return(-1);
  }
  if(res->r3<-ZERO){//negrect resolution for the meanpred
    res->r2=0;
    return(-1);
  }
  res->r12=(double)res->r1/res->r2;
  //  res->nr=(res->ymax-res->ymin)/res->r12;
  res->nr=(res->ymax-res->ymin)/res->r12+0.5;//??
  //  res->r12=(res->ymax-res->ymin)/res->nr;//for ymin and ymax more reliable than r1 and r2 for ijcnn06
  res->r=(double*)malloc(sizeof(double)*(res->nr+1));
  if(fabs(res->r3)>ZERO){
    for(i=0;i<=res->nr;i++){
      sprintf(buff,"%.10le",((int)((i*res->r12+res->ymin)/res->r3+0.5))*res->r3);//r3$B7e$G;M<N8^F~(B
      sscanf(buff,"%lf",&res->r[i]);
    }
  }
  else{
    for(i=0;i<=res->nr;i++){
      sprintf(buff,"%.10le",(double)i*res->r12+res->ymin);
      sscanf(buff,"%lf",&res->r[i]);
    }
  }
  return(0);
}
double y_res(double y,RESOLUTION *res)
{
  int ii;
  if(res->r2==0) return(y);
  //  ii=(int)((y-ymin)/r12+0.5);//4sha5nyu
  ii=floor((y-res->ymin)/res->r12+0.5);//4sha5nyu
  if(y<res->ymin) return((double)res->r[0]);
  if(y>res->ymax) return((double)res->r[res->nr]);
  return((double)res->r[ii]);
}
#define buffsize 1024
int main(int argc, char **argv)
{
  int i,j,l;
  FILE *fp;
  char buff[buffsize];
  double *yp,_yp;
  double *y,_y,*yr,_yr;
  int *n,_n;
  int num=0,num0=0;
  //  char *fnpredict="predict+.dat";
  //  char *fnloss="loss+.dat";
  int intmode=0, j0=1,nfiles=argc-1;
  char fn_is[256],fn_pred[256],fn_pred0[256],fn_prob[256];
  double _is,_mseis,_n_msetrain,_msetrain,_n_cells2,_nCells1,_n_mse,_mse,_msetrainis;
  double *prob,*sigma2,meansigma2,probtotal;
  FILE *fp0;
  int bayesmode=0; //0 (for flat probability) or 1 (for probatility decaying according to MSE).
  double bayesopt1=0;//for adjusting probability (1 for same probatility)
  double bayesopt2=0;//0 for original L, 1 for L_derivative requiring nfiles>=3.
  double bayesopt3=0;//??
  double bayesopt4=0;//??
  //  double *ds;
  //  int *s;
  double Lvar,Lvarval,Lval,LD=0,_LD;//
  double skew,kurtosis,entropy,skew2,skewa;//skew=3rd moment, kurtosis=4th moment
  double m2,m3,m4,m5,m6,m3a,m5a;//5th moment, 6th moment
  double m3p,m3m;//m3plus,m3minus
  int nm3p,nm3m;
  double mcov;//mean covariance
  double Lvar0;
  double Ltrain,LtrainE,H0;
  double *var,*vv;
  int *cc,ccmax=0;
  double _var,_vv,_cc;
  double *kyorix2,_kyorix2,_e2;
  int LDmode=2;
  RESOLUTION res={0,0,0,};
  double *yp00;
  int nop=0;
  if(argc<2){
    fprintf(stderr,"Usage: %s [ib:<intmode>:<basesmode>[:<probfile>]] <pred&is-body#1> <pred&is-body#1> ... \n",argv[0]);
    fprintf(stderr,"<intmode>:1 for intmode, 0 for real.\n");
    fprintf(stderr,"<bayesmode>:0 simple ensemble.?\n");
    fprintf(stderr,"<bayesmode>:1 for bayes mode1 exp.\n");
    fprintf(stderr,"<bayesmode>:2 for bayes mode2 YpInvY.\n");
    fprintf(stderr,"<bayesmode>:-1 for reading from probfile.\n");
    fprintf(stderr,"res:<r1>:<r2>:<ymin>:<ymax>.\n");
    fprintf(stderr,"Old Usage: %s [<int>:<bases>] <pred&is-body#1> <pred&is-body#1> ... \n",argv[0]);
    fprintf(stderr,"par:paramfile.\n");
    exit(1);
  }
  //  fprintf(stderr,"last arg[%d]='%s'\n",argc,argv[argc-1]);
  int parfile=0;
  //
  for(i=1;i<argc;i++){
    if(strncmp(argv[i],"par:",4)==0){//for compatibility to old version
      parfile=1;
      break;
    }
  }
  char *_argv0;
  if(parfile==1){
    char *fn=&argv[i][4];
    FILE *fp;
    if((fp=fopen(fn,"r"))==NULL){
      fprintf(stderr,"Param file (%s) open error.\n",fn);
      return(-1);
    }

    fseek( fp, 0L, SEEK_END );
    int fsize=ftell(fp);
    fseek( fp, 0L, SEEK_SET );//rewind(fp);//
    //    fprintf(stderr,"fsize=%d\n",fsize);
    _argv0=(char*)malloc(sizeof(char)*fsize);
    fgets(_argv0,fsize,fp);
    fclose(fp);
    argc=1;
    char *p=_argv0;
    for(j=0;j<fsize;j++) if(p[j]==' ') argc++;
    argv=(char**)malloc(sizeof(char*)*(argc));
    for(j=1;j<argc;j++){
      for(p++;;p++) if(*p==' ') {*p=0;break;}
      for(p++;;p++) if(*p!=' ') break;
      argv[j]=p;
    }
  }
  intmode=0;
  bayesmode=0;
  j0=1;
  nfiles=argc-1;
  for(i=j0;i<argc;i++){
    if(strncmp(argv[i],"int",3)==0){//for compatibility to old version
      intmode=1;
      j0++;
      nfiles--;
    }
    else if(strncmp(argv[i],"ib:",3)==0){
      sscanf(&(argv[i][3]),"%d:%d:%lf:%lf:%lf:%lf",&intmode,&bayesmode,&bayesopt1,&bayesopt2,&bayesopt3,&bayesopt4);
      if(bayesmode==-1) sprintf(fn_prob,"%s",&(argv[1][8]));
      j0++;
      nfiles--;
    }
    else if(strncmp(argv[i],"ry:",3)==0){
      sscanf(&argv[i][3],"%d:%d:%lf:%lf:%lf",&res.r1,&res.r2,&res.r3,&res.ymin,&res.ymax);
      j0++;
      nfiles--;
      init_res(&res);
    }
    else if(strncmp(argv[i],"LDm:",4)==0){
      sscanf(&argv[i][4],"%d",&LDmode);
      j0++;
      nfiles--;
      init_res(&res);
    }
    else if(strncmp(argv[i],"nop:",4)==0){
      sscanf(&argv[i][4],"%d",&nop);
      j0++;
      nfiles--;
    }
  }
  ////
  if(nop!=1){
    printf("#start:%s",argv[0]);
    for(i=1;i<argc;i++){
      printf(" %s",argv[i]);
    }
  }
//  else{//if(nop==1){
//    fprintf(stdout,"+");
//    fflush(stdout);
//  }

  int (*net_printf)(char *);
  if(nop==0) net_printf=printf1;
  else net_printf=noprintf;

  prob =(double*) malloc(sizeof(double)*nfiles);
  sigma2=(double*) malloc(sizeof(double)*nfiles);
  meansigma2=0;
  for(j=0;j<nfiles;j++) argv[j+j0][strlen(argv[j+j0])-8]=0; //argv[j+j0]=fn_bodypred.dat
  for(j=0;j<nfiles;j++){
    sprintf(fn_is,"%sis.dat",argv[j+j0]);
    if((fp=fopen(fn_is,"r"))==NULL){
      fprintf(stderr,"#Execute without '%s'\n",fn_is);
      //      fprintf(stderr,"file(%s) could not be opened!\n",fn_is);
      num=0; sigma2[j]=0; meansigma2+=0;//050914
      num0=0;
    }
    else{
      fscanf(fp,"%lf%lf%lf%lf%lf%lf%lf%lf%lf",&_is,&_mseis,&_n_msetrain,&_msetrain,&_n_cells2,&_nCells1,&_n_mse,&_mse,&_msetrainis);
      //      num=_n_msetrain; sigma2[j]=_msetrain; meansigma2+=_msetrain;//050902??
      //      num=_n_mse; sigma2[j]=_mse; meansigma2+=_mse;//050823
      num=_n_mse; sigma2[j]=_msetrain; meansigma2+=_msetrain;//050914
      num0=_n_msetrain;
      //      fprintf(stderr,"sigma2[%d]%e\n",j,sigma2[j]);
      fclose(fp);
    }
  }
  meansigma2/=nfiles;
  ////////////////////////////////
  if(bayesmode>=100){}//end of bayesmode>=100
  else{//bayesmode <100
    if(bayesmode==0){//same probability
      probtotal=nfiles;
      for(j=0;j<nfiles;j++)  prob[j]=1./probtotal;
      probtotal=0; for(j=0;j<nfiles;j++) probtotal+=prob[j];
    }
    else if(bayesmode==1){//probatility depending on MSE(=sigma2)
      int jj;double probj;//probj is 1/prob[j] for avoiding marumegosa.
      probtotal=0;
      for(j=0;j<nfiles;j++){
	probj=0;
	for(jj=0;jj<nfiles;jj++){
	  if(jj==j) probj+=1;
	  else probj+= exp((sigma2[j]-sigma2[jj])*bayesopt1/meansigma2);
	}
	prob[j]=1./probj;
	probtotal+=prob[j];
      }
      for(j=0;j<nfiles;j++)  prob[j]/=probtotal;
      probtotal=0; for(j=0;j<nfiles;j++) probtotal+=prob[j];
    }
    ////////////////////////////////
    int m_LD=bayesopt2,nfiles2;//bayesopt2=m for LD= Loss_D = sum_{j=1}^m ((f_{l0+j}-f_{l0})^2 +(f_{l0-j}-f_{l0})^2)
    if(bayesmode==3) m_LD=0;
    else m_LD=bayesopt2;
    if(nfiles<m_LD*2+1) m_LD=(nfiles-1)/2;// (nfiles,m_LD)=(2,0),(3,1),(4,1),(5,2),(6,2);
    nfiles2=nfiles-m_LD*2;//for LD of generalization error
    int nmean=nfiles-nfiles2+1;//nmean=2*m_LD+1
    //    double *ww =(double*) malloc(sizeof(double)*nfiles*(nmean));
    //#define LDmode 2
    //#define LDmode 4
    //	//LDmode==4 is only for ib:0:0:0:m ???
    //#if LDmode == 2
    //    double *ww =(double*) malloc(sizeof(double)*(nfiles+1)*(nmean));
    //#elif  LDmode == 4
    //    double *ww0 =(double*) malloc(sizeof(double)*(nfiles+1)*(nmean)*2);
    //    double *ww =(double*) malloc(sizeof(double)*(nfiles+1)*(nmean)*(nmean));
    double *ww =(double*) malloc(sizeof(double)*(nfiles)*(nmean)*(nmean));
    //#endif
    //    double *ww=&ww0[1];
    double *ww0=&ww[(m_LD+m_LD*nmean)*nfiles];

    {//////////for Lvar0
      //      double *yp0=(double*) malloc(sizeof(double)*num0*nfiles);
      //      double *yt0=(double*) malloc(sizeof(double)*(nfiles+1)*num0+2);
      //      double *yt=(double*) &yt0[2];//yt[0]=num0,yt[1]=nmean;

      double *yt=(double*) malloc(sizeof(double)*(nfiles+1)*num0);
      double *yp01=(double*) &yt[num0];
      double *yp =(double*) malloc(sizeof(double)*num0);
      //      nfiles2=nfiles-2*bayesopt2;//for LD of generalization error
      if(nfiles<3) {m_LD=bayesopt2=0;nfiles2=nfiles;}//training ?
      //      else {m_LD=1;nfiles2=nfiles-2*bayesopt2;}//for LD of generalization error
      //      probtotal=0;
      //      for(j=m_LD;j<nfiles2+m_LD;j++){//prediction of training data?
      for(j=0;j<nfiles;j++){//prediction of training data?
#define NEWp0
#ifdef NEWp0
	{
	  char *p1,*p;
	  sprintf(fn_pred0,"%s",argv[j+j0]);
	  for(p=fn_pred0;;p++){if(*p=='+') break;}
	  p1=++p;
	  for(;;p++){if(*p=='+') break;}
	  ++p;
	  sprintf(p1,"%spred0.dat",p);
	}
#else
	sprintf(fn_pred0,"%spred0.dat",argv[j+j0]);
#endif
	fp0=fopen(fn_pred0,"r");
	for(i=0;i<num0;i++){
	  fgets(buff,buffsize,fp0);
	  sscanf(buff,"%lf%d%lf%lf%lf%lf%lf",&_yp,&_n,&_y,&_yr,&_var,&_cc,&_vv);//sscanf(buff,"%lf%d%lf%lf",&_yp,&_n,&_y,&_yr);
	  if(res.r3<0) _yp=_yr; //neglect resolution for the meanpred
	  else _yp=y_res(_yp,&res);
	  //	  yp0[i*nfiles+j] =_yp;
	  yp01[j*num0+i] =_yp;
	  yt[i]=_y;
	}
	fclose(fp0);
      }
      if(bayesmode==2){
	//	if(1==0 && nfiles==1) ww[0]=1;
	//	else
	{
	  for(j=0;j<nmean;j++){
	    for(l=0;l<nmean;l++){
	      //LDmode = 2,4,8 neighbours
	      if(LDmode==2 && l!=m_LD) continue;//only yoko
	      if(LDmode==4 && (l-m_LD)*(j-m_LD)!=0 ) continue;//only tate&yoko
	      //calc_AtinvbMCA((double *)(&ww[j*nfiles]),(double *)(&yp01[j*num0]),(double *)(&yt[0]),(int)(nfiles2),(int)num0,(int)bayesopt1);
	      calc_Atinvb((double *)(&ww[(l*nmean+j)*nfiles]),(double *)(&yp01[j*num0]),(double *)(&yt[0]),(int)(nfiles2+l-m_LD),(int)num0,(int)bayesopt1);
	      //	  calc_Ainvb((double *)(&ww[j*nfiles]),(double *)(&yp0[j]),(double *)(&yt[j]),(int)(nfiles2),(int)num0,(int)bayesopt1);
	      //	  calc_Ainvb((double *)(&ww[j*nfiles]),(double *)(&yp01[j*num0]),(double *)(&yt[0]),(int)(nfiles2),(int)num0,(int)bayesopt1);
	      //	    calc_Ainvb((double *)(&ww[j*nfiles]),(double *)(&yp01[j*num0]),(double *)(&yt[0]),(int)(nfiles2),(int)num0,(int)bayesopt1);
	      //	    for(i=0;i<=nfiles2;i++) ww[j*nfiles+i]=1./nfiles2;
	      //	    for(i=0;i<10;i++) fprintf(stderr,"j%2d,i%2d)yt%+e yp%+e %+e\n",j,i,yt[i],yp01[(j)*num0+i],yp01[(j+1)*num0+i]);
	      if(fabs(VarY)<1e-10){
		for(i=0;i<nfiles2+l-m_LD;i++) ww[(l*nmean+j)*nfiles+i]=1./(nfiles2+l-m_LD);
	      }
	      fprintf(stderr,"w[%d,%d]:",j,l);
	      for(i=0;i<nfiles2+l-m_LD;i++) fprintf(stderr,"%+.4f ",ww[(l*nmean+j)*nfiles+i]);
	      fprintf(stderr,"\n");
	    }
	  }
	}
      }

      else if(bayesmode==3){//ib:0:3:10:0:0 ib:0:3:itermax:0:0 H=C0*E2/E0+C1*Entropy
	for(j=0;j<nmean;j++){
	  for(l=0;l<nmean;l++){
	    if(LDmode==2 && l!=m_LD) continue;//only yoko
	    if(LDmode==4 && (l-m_LD)*(j-m_LD)!=0 ) continue;//only tate&yoko
	    {
	      size_t iter = 0;
	      size_t itermax=bayesopt1;if(itermax<1e-20) itermax=100;
	      int status;
	      double nl=(double)(nfiles2+l-m_LD);
	      double nd=(double)num0;
	      int nl1=nl+1;
	      double *par[7];
	      double sgn;
	      if(bayesopt2>=0) sgn=1; else sgn=-1;
	      par[0]=(double *)&nd;
	      par[1]=&nl;
	      par[2]=&yt[0];
	      par[3]=&yp01[j*num0];
	      par[4]=&sgn;
	      const gsl_multiroot_fsolver_type *T;
	      gsl_multiroot_fsolver *s;
	      gsl_multiroot_function df = {&my_df_Entropy, nl1, &par};
	      gsl_vector *x = gsl_vector_alloc (nl1); //&ww[(l*nmean+j)*nfiles];
	      for(i=0;i<=nl;i++) gsl_vector_set (x, i, sqrt(1./nl));
	      gsl_vector_set (x, nl, 0.0);//Good!?
	      T = gsl_multiroot_fsolver_hybrids;
	      s = gsl_multiroot_fsolver_alloc (T, nl1);
	      gsl_multiroot_fsolver_set (s, &df, x);
	      gsl_print_state (iter, s, par);
	      do {
		iter++;
		status = gsl_multiroot_fsolver_iterate (s);
		gsl_print_state (iter, s, par);
		/* check if solver is stuck */
		if (status) {
		  printf ("Minimum not found (ERR=%d)? See /usr/include/gsl/gsl_errno.h for details.",status);
		  if (status==GSL_EBADFUNC) {printf ("Encountered a singular point.\n");}
		  else if (status==GSL_EBADFUNC) {printf ("Noprogress.\n");}
		  else if (status==GSL_ENOPROGJ) {printf (" ERR=%d:Jacobian is not improving the solution.\n",GSL_ENOPROGJ);}
		  break;}//break at Sucess or failure ?
		//		status = gsl_multiroot_test_residual (s->f, 1e-7);
		status = gsl_multiroot_test_residual (s->f, 1./nl);
	      }  while (status == GSL_CONTINUE && iter < itermax);
	      for(i=0;i<nl;i++) ww[(l*nmean+j)*nfiles+i]=square(gsl_vector_get (s->x, i));
	      gsl_multiroot_fsolver_free (s);
	      gsl_vector_free (x);
	      double sumw=0;
	      fprintf(stderr,"w[%d,%d]:",j,l);
	      for(i=0;i<nl;i++) fprintf(stderr,"%+.4f ",ww[(l*nmean+j)*nfiles+i]);
	      for(i=0;i<nl;i++) sumw+=ww[(l*nmean+j)*nfiles+i];
	      fprintf(stderr,"sumw=%f\n",sumw);
	    }
	  }
	}
      }
      else{//for bayesmode!=2
	for(l=0;l<nmean;l++){
	  if(LDmode==2 && l!=m_LD) continue;//only yoko
	  for(j=0;j<nmean;j++){
	    if(LDmode==4 && (l-m_LD)*(j-m_LD)!=0 ) continue;//only tate&yoko
	    for(i=0;i<nfiles2+l-m_LD;i++) ww[(l*nmean+j)*nfiles+i]=1./(nfiles2+l-m_LD);
	  }
	  //	  fprintf(stderr,"w[0-%d,0-%d]=%+.4f\n",nfiles2,nfiles2+l-m_LD,1./(nfiles2+l-m_LD));
	}
      }
      LtrainE=Ltrain=Lvar0=0;
      for(i=0;i<num0;i++){
	//      yp[i]=0;for(j=m_LD;j<nfiles2+m_LD;j++) yp[i]+=(yp01[j*num0+i]*ww[m_LD*nfiles+j-m_LD]);//prediction of training data
	yp[i]=0;
	for(j=0;j<nfiles2;j++){
	  yp[i]+=(yp01[(j+m_LD)*num0+i]*ww0[j]);//prediction of training data
	}
	//	for(j=m_LD;j<nfiles2+m_LD;j++){
	//	  //	  yp[i]+=(yp01[j*num0+i]*ww[(m_LD+m_LD*nmean)*nfiles+j-m_LD]);//prediction of training data
	//	  yp[i]+=(yp01[j*num0+i]*ww0[j-m_LD]);//prediction of training data
	//	}
	yp[i]=y_res(yp[i],&res);
	for(j=m_LD;j<nfiles2+m_LD;j++){
	  Lvar0+= square(yp[i]-yp01[j*num0+i]);
	  LtrainE += square(yp01[(j)*num0+i]-yt[i]);
	}
	//	for(j=m_LD;j<nfiles2+m_LD;j++) Lvar0+= exp(square(yp[i]-yp01[j*num0+i]));//???060530
	Ltrain+= square(yt[i]-yp[i]);
      }
      //      Lvar0 /=(nfiles2*num0); //      Lvar0 = VarY;//?????
      //Lvar0 /=(nfiles2*num0-1+1e-10); //unbiased estimator
      if(nfiles2>=2) Lvar0 /=((num0+ZERO)*(nfiles2)*(nfiles2-1));//estimated variance of ensemble prediction
      else Lvar0 /=(num0+ZERO); //average of unbiased estimator
      Ltrain/=(num0+ZERO);
      LtrainE/=(nfiles*num0+ZERO);
      //      free(yp01);//??why bat result if active?
#define Ltrain4Entropy
#ifdef Ltrain4Entropy
      {
	double pn,E2sum=Ltrain*num0;//Entropy
	H0=0;
	for(i=0;i<num0;i++){
	  pn=square(yp[i]-yt[i])/E2sum;
	  H0 -= pn*log(pn);
	}
	H0/=log(num0+ZERO);
	//	Ltrain=H0;
      }
#endif
      free(yt);//
      free(yp);//
    }//end of "for Lvar0"
#define BAYES2GE 1
#if BAYES2GE == 1
    {//
      int li,l;
      yp00=(double*) malloc(sizeof(double)*num*nfiles);
      //#if LDmode == 2
      //      double *ypbuff=(double*) malloc(sizeof(double)*num*nmean);
      //#elif LDmode == 4
      //      double *ypbuff=(double*) malloc(sizeof(double)*num*nmean*2);
      double *ypbuff=(double*) malloc(sizeof(double)*num*nmean*(nmean));
      //#endif
      y=(double*) malloc(sizeof(double)*num);
      yr=(double*) malloc(sizeof(double)*num);
      n=(int*) malloc(sizeof(int)*num);
      var=(double*) malloc(sizeof(double)*num);
      vv=(double*) malloc(sizeof(double)*num);
      //      cc=(int*) malloc(sizeof(int)*num);
      cc=(int*) malloc(sizeof(int)*num*nfiles);
      kyorix2=(double*)malloc(sizeof(double)*num);
      //      yp=&ypbuff[num*(int)(bayesopt2)];//??what happen when bayesopt2==0??
      yp=&ypbuff[(m_LD+m_LD*nmean)*num];//center of nmean*nmean=(2*m_LD+1)*(2*m_LD+1)
      // yp=&ypbuff[m_LD*num];//
      for(i=0;i<num;i++){yp[i]= n[i]= y[i]= yr[i]=var[i]=vv[i]=0; }
      {///???
	for(j=0;j<nfiles;j++){
	  sprintf(fn_pred,"%spred.dat",argv[j+j0]);
	  fp=fopen(fn_pred,"r");
	  for(i=0;i<num;i++){
	    fgets(buff,buffsize,fp);
	    sscanf(buff,"%lf%d%lf%lf%lf%lf%lf%lf%lf",&_yp,&_n,&_y,&_yr,&_var,&_cc,&_vv,&_e2,&_kyorix2);
	    //	    yp0[i*nfiles+j] =y_res(_yp,&res);
	    if(res.r3<0) yp00[j*num+i]=_yr; //neglect resolution for the meanpred
	    else yp00[j*num+i] =y_res(_yp,&res);
	    //	    yp00[j*num+i] =y_res(_yp,&res);
	    cc[j*num+i] =_cc;//??
	    if(ccmax<_cc) ccmax=_cc;
	    if(j>=m_LD && j<nfiles-m_LD){
	      //	      yp[i]+=_yp*prob[j];//sum for j in [1,...,nfiles-2]
	      n[i]+=_n;
	      y[i]+=_y;//sum for j in [1,...,nfiles-2]
	      yr[i]+=_yr;
	      var[i]+=(_var*_vv);
	      vv[i]+=_vv;
	      //	      cc[i]=_cc;
	      kyorix2[i]=_kyorix2;
	    }
	  }
	  //	  if(j>=m_LD && j<nfiles-m_LD) probtotal+=prob[j];
	  fclose(fp);
	}
	//////////////
	Lvar=Lvarval=Lval=0;
	skew=kurtosis=entropy=mcov=skew2=0,skewa=0;
	m3p=m3m=m2=m3a=m4=m5a=m6=0;nm3p=nm3m=0;
	for(i=0;i<num;i++){//num=1?
	  //	  yp[i]/=probtotal;//mean for j in [1,...,nfiles-2]
	  //	  yp[i]=y_res(yp[i]/probtotal,&res);
	  yp[i]=0;
	  //	  for(j=0;j<nfiles2;j++) {yp[i] +=yp0[i*nfiles+j]*ww[(m_LD)*nfiles+j];}
	  //	  for(j=0;j<nfiles2;j++) {yp[i] +=yp00[(j+m_LD)*num+i]*ww[(m_LD)*nfiles+j];}
	  //	  for(j=m_LD;j<nfiles2+m_LD;j++) yp[i]+=(yp00[j*num+i]*ww[m_LD*nfiles+j]);//prediction of center of test data
	  //	  for(j=0;j<nfiles2;j++) yp[i]+=(yp00[(j+m_LD)*num+i]*ww[(m_LD+n_LD*nmean)*nfiles+j]);//prediction of center of test data
	  for(j=0;j<nfiles2;j++) yp[i]+=(yp00[(j+m_LD)*num+i]*ww0[j]);//prediction of center of test data
	  yp[i]=y_res(yp[i],&res);
	  n[i] = (int)((double)n[i]/nfiles2+0.5);
	  y[i] = y[i]/nfiles2;//mean for j in [1,...,nfiles-2]
	  yr[i]= yr[i]/nfiles2;
	  //	  for(j=m_LD;j<nfiles-m_LD;j++){
	  //	  for(j=m_LD;j<nfiles2+m_LD;j++){
	  double skewj=0,sigma2j=0;
	  double m2j=0,m3j=0,m4j=0,m5j=0,m6j=0;
	  double m3pj=0,m3mj=0;
	  //	  int nm3pj=0,nm3mj=0;
	  double nm3pj=0,nm3mj=0;
	  for(j=0;j<nfiles2;j++){//number of bags
	    double err=yp00[(j+m_LD)*num+i]-yp[i];//inversed 091008
	    double err2_=err*err;
	    m2j+=err2_;//sigma2j+=err2;//m2j
	    skew2+=(err>0)?(err2_):(-err2_);//?
	    m3j+=(err2_*=err);//skewj+=(errn=err2*err);//m3j
	    if(err>0){
	      nm3pj++;
	      m3pj+=err2_;//err^3
	    }
	    else if(err<0){
	      nm3mj++;
	      m3mj+=err2_;//err^3
	    }
	    m4j+=(err2_*=err);//kurtosis+=(errn=errn*err);//m4j
	    m5j+=(err2_*=err);
	    m6j+=(err2_*=err);
	    //Lvar    += square(yp[i]-yp00[(j+m_LD)*num+i]);
	    //Lvar    += square(yp[i]-yp00[(j+m_LD)*num+i]);
	    //Lvar    += exp(square(yp[i]-yp00[(j+m_LD)*num+i]));//???060530
	    Lvarval += square(yp00[(j+m_LD)*num+i]-y[i]);
	    {//mean covariance
	      int l;
	      for(l=0;l<nfiles2;l++){
		if(l!=j) mcov+=(err*(yp00[(l+m_LD)*num+i]-yp[i]));
	      }
	    }
	  }//closing for(j=0;j<nfiles2;j++){
	  Lval += square(yp[i]-y[i]);
	  Lvar+=m2j;//Lvar+=sigma2j;
	  double sj=sqrt(m2j/nfiles2);// double sj=sqrt(sigma2j/nfiles);
	  sj+=ZERO;
	  nm3pj+=ZERO;
	  nm3mj+=ZERO;
	  int mnorm=0;
	  if(mnorm==0){//original
	    m2+=(m2j/nfiles2);
	    m3+=(m3j/nfiles2)/pow(sj,3.);//skew+=skewj;//m3
	    m3a+=fabs(m3j/nfiles2)/pow(sj,3.);//skewa+=fabs(skewj/nfiles2)/pow(sj,3);//m3a
	    m3p+=(m3pj/(nm3pj))/pow(sj,3.);
	    m3m+=(m3mj/(nm3mj))/pow(sj,3.);
	    nm3p+=nm3pj;
	    nm3m+=nm3mj;
	    m4 +=    (m4j/nfiles2)/pow(sj,4.);//
	    m5a+=fabs(m5j/nfiles2)/pow(sj,5.);//?5/2
	    m6 +=    (m6j/nfiles2)/pow(sj,6.);//?3=6/2
	  }
	  else if(mnorm==1){//new for normalize m3,m4,m5,m6
	    m2+=(m2j/nfiles2);
	    m3+=pow(m3j/nfiles2,1./3.)/sj;//skew+=skewj;//m3
	    m3a+=pow(fabs(m3j/nfiles2),1./3.)/sj;//skewa+=fabs(skewj/nfiles2)/pow(sj,3);//m3a
	    m4 +=pow(m4j/nfiles2,1./4.)/sj;//
	    m5a+=pow(fabs(m5j/nfiles2),1./5.)/sj;//?5/2
	    m6 +=pow(m6j/nfiles2,1./6.)/sj;//?3=6/2
	  }
	  else if(mnorm==2){//this does not work for skew and kurtosis
	    m2+=(m2j/nfiles2);
	    m3+=pow(m3j/nfiles2,1./3.);//skew+=skewj;//m3
	    m3a+=pow(fabs(m3j/nfiles2),1./3.);//skewa+=fabs(skewj/nfiles2)/pow(sj,3);//m3a
	    m4 +=pow(m4j/nfiles2,1./4.);//
	    m5a+=pow(fabs(m5j/nfiles2),1./5.);//
	    m6 +=pow(m6j/nfiles2,1./6.);//
	  }
	  //	  if(i<10) fprintf(stderr,"[%d]Lval=%9.3e,yp=%.3e,y=%.3e\n",i,Lval,yp[i],y[i]);
	  //	  if(i>1900) fprintf(stderr,"[%d]Lval=%9.3e,yp=%.3e,y=%.3e\n",i,Lval/num,yp[i],y[i]);
	}//closing for(i=0;i<num;i++){
	int num2=num*nfiles2;
	//Lvar /= (nfiles2*num);
	//??	if(nfiles2>=2) Lvar /=((num)*(nfiles2)*(nfiles2-1.));//estimated variance of ensemble prediction
	//if(nfiles2>=2) Lvar /=num2;//estimated variance of ensemble prediction
	//else Lvar/=(num);
	for(i=0;i<num;i++){
	  for(j=0;j<nfiles2;j++){
	    double err=yp[i]-yp00[(j+m_LD)*num+i];
	    double p=(err*err)/(Lvar+ZERO);
	    p+=ZERO;
	    entropy -= p*log(p);
	  }
	}
	entropy/=log(num2+ZERO);
	//
	Lvar/=num2;//?see above
	mcov/=(num2*(nfiles2-1));
	double sigma=sqrt(Lvar);
	double sigma3=sigma*sigma*sigma;
	m2/=num;
	m3/=num;//skew=(skew/num2)/sigma3;//	skewa/=num;
	m3a/=num;//	skewa/=num;
	m3p/=num;
	m3m/=num;
	m4/=num;//kurtosis=(kurtosis/num2)/sigma3/sigma;//!modified 20130418
	m5a/=num;
	m6=m6/num;
	skew=m3;skewa=m3a;kurtosis=m4;
	Lvar=m2+ZERO;//??
	//	skew2=skew2/num2/Lvar;
	//	kurtosis=(kurtosis/num2)/sigma3/sigma-3;//!!!m4-3
	/////////////
	//Lvar /=((nfiles2*num)*(nfiles2*num-1.));//A-type Uncertainty
	//	Lvar /=((nfiles2*num)*(nfiles2*num-1.));//A-type Uncertainty
	Lvarval /= (num2);
	Lval /= (num);
	//	fprintf(stderr,"#Lvar=%e,Lvarval=%e,Lval=%e,_LD:",Lvar,Lvarval,Lval);
	//	fprintf(stderr,"#Lvar=%e,Lvarval=%e,Lval=%e,num=%d,_LD:",Lvar,Lvarval,Lval,num);
	//fprintf(stderr,"%g %g %g %g %g %g #Ltst,Lvar,skew,krt,ent,log|s*k|#n%db%d\n",Lval,Lvar,skew,kurtosis,entropy,log(fabs(skew*kurtosis)),num,nfiles);
	{
	  FILE *fp=fopen("loss.dat","w");

	  fprintf(fp,"%g %g %g %g %g %d %d %g %g %g %d %g %g %g %g %d %g %d\n#Ltst,Lvar,skw,krt,ent,n,b,cor,skwa,yp0,num,skw2,m5a,m6,m3p,nm3p,m3m,nm3m\n",
		  Lval,Lvar,m3,m4,entropy,num,nfiles,mcov/Lvar,m3a,yp[0],num,skew2,m5a,m6,m3p,nm3p,m3m,nm3m);//4=K,9=sa,13=m5a,14=m6
	  //      1    2    3  4  5       6   7      8         9   10    11  12    13  14 15  16   17  18
	  //	  fprintf(fp,"%g %g %g %g %g %d %d %g %g %g %d %g %g %g\n#Ltst,Lvar,skw,krt,ent,n,b,cor,skwa,yp0,num,skw2\n",Lval,Lvar,skew,kurtosis,entropy,num,nfiles,mcov/Lvar,skewa,yp[0],num,skew2,m5a,m6);//4=K,9=sa,13=m5a,14=m6
	  //	  fprintf(fp,"%g %g %g %g %g %d %d %g %g %g %d\n#Ltst,Lvar,skw,krt,ent,n,b,cor,skew2,yp0,num\n",Lval,Lvar,skew,kurtosis,entropy,num,nfiles,mcov/Lvar,skew2,yp[0],num);
	  //	  fprintf(fp,"%.4g %.4g %.4g %.4g %.4g %d %d\n#Ltst,Lvar,skew,krt,ent,n,b\n",Lval,Lvar,skew,kurtosis,entropy,num,nfiles);
	  fclose(fp);
//	  fprintf(stderr,"###cat loss.dat###\n");
//	  system("cat loss.dat");
//	  fprintf(stderr,"#######\n");
	}
	//	fprintf(stderr,"#Lvar%e,Lvarval%e,Ltst%e,skew%.3g,krt%g,ent%.3g,n%d,b%d,",Lvar,Lvarval,Lval,skew,kurtosis,entropy,num,nfiles);
	int jj;
	for(i=0;i<num;i++){
	  for(j=-m_LD;j<=m_LD;j++){//l1
	    for(l=-m_LD;l<=m_LD;l++){//ld
	      if(j==0 && l==0 ) continue;//already obtained above
	      if(LDmode==2 && l!=0) continue;//only yoko
	      if(LDmode==4 && (l)*(j)!=0 ) continue;//only tate&yoko
	      li=(l*nmean+j)*num+i;
	      yp[li]=0;
	      //	    for(j=0;j<nfiles2;j++) {yp[li] +=yp0[i*nfiles+j]*ww[(m_LD+l)*nfiles+j];}
	      //	    for(j=0;j<nfiles2;j++) {yp[li] +=yp00[(j+m_LD+l)*num+i]*ww[(m_LD+l)*nfiles+j];}
	      for(jj=0;jj<nfiles2+l;jj++) {
		yp[li] +=yp00[(jj+m_LD+j)*num+i]*ww0[(l*nmean+j)*nfiles+jj];
		//		fprintf(stderr,"jj+m_LD+j=%d+%d+%d=%d\n",jj,m_LD,j,jj+m_LD+j);
	      }
	      yp[li]=y_res(yp[li],&res);
	      //	    li=(l+m_LD+1)*num+i;
	      //	    yp[li]=0;
	      //	    for(j=0;j<nfiles2+l;j++) {yp[li] +=yp00[(j+m_LD)*num+i]*ww[((l*nmean+m_LD)*nfiles+j];}
	      //	    yp[li]=y_res(yp[li],&res);
	    }
	  }
	}
	if(1==0){//unnecessary????
	  LD=0;
	  for(j=-m_LD;j<=m_LD;j++){//l1
	    for(l=-m_LD;l<=m_LD;l++){
	      if(j==0 && l==0 ) continue;//already obtained above
	      if(LDmode==2 && l!=0) continue;//only yoko
	      if(LDmode==4 && (l)*(j)!=0 ) continue;//only tate&yoko
	      _LD=0;
	      for(i=0;i<num;i++) {
		_LD += square(yp[i]-yp[(l*nmean+j)*num+i]);
		//		_LD += square(yp[i]-yp[l*num+i]);
		//		_LD += square(yp[i]-yp[(l+m_LD+1)*num+i]);
	      }
	      _LD/=num;
	      LD+=_LD;
	      fprintf(stderr,"_LD%9.3e ",_LD);
	    }
	  }
	  if(LDmode==2) LD/=(m_LD*4.);//
	  else if(LDmode==4) LD/=(m_LD*8.);//
	  else LD/=(nmean*nmean-1);//
	  //	  LD/=(m_LD*8.);//LD/=(m_LD*2.);
	  fprintf(stderr,"LD%e\n",LD);
	}//end of if(1==0)
      }//end of ???
    }//end of for BAYES2GE
#endif
  }//end of bayesmode<100

  //obtain heterosedastic err only vaid for known y[i] ?
#define newvari
#ifdef newvari //20150115
  double *bias=(double*) malloc(sizeof(double)*num);
  double *err=(double*) malloc(sizeof(double)*num);
  int    *nVi=(int*) malloc(sizeof(int)*num);
  {
    int ji,ii;
    for(i=0;i<num;i++) {
      bias[i]=var[i]=nVi[i]=0;
    }
    ccmax+=1;
    double *varcc=(double*)malloc(sizeof(double)*ccmax);
    double *biascc=(double*)malloc(sizeof(double)*ccmax);
    int *nvarcc=(int*)malloc(sizeof(int)*ccmax);
    //    free *varcc;
    for(j=0;j<nfiles;j++){//bags
      int cci;
      for(cci=0;cci<ccmax;cci++) varcc[cci]=biascc[cci]=nvarcc[cci]=0;
      for(i=0;i<num;i++){
	err[i]=yp00[j*num+i]-yp[i];
	varcc[cc[i]]+=square(err[i]);
	biascc[cc[i]]=err[i];
	nvarcc[cc[i]]++;
//	{
//	  fp=fopen("predict+.dat","w");
//	  fprintf(fp,"hello\n");
//	  fclose(fp);
//	}
      }
      for(i=0;i<num;i++){
	var[i]+=varcc[cc[i]];
	bias[i]+=biascc[cc[i]];
	nVi[i]+=nvarcc[cc[i]];
      }
    }
    for(i=0;i<num;i++){
      bias[i]/=nVi[i];
      var[i]/=nVi[i];
    }
    net_printf("##################new variance###\n");
  }

#else //old var[i]
  double *bias=(double*) malloc(sizeof(double)*num);
  double *err=(double*) malloc(sizeof(double)*num);
  int    *nVi=(int*) malloc(sizeof(int)*num);
  int    *nVib=(int*) malloc(sizeof(int)*num);

  {
    int ji,ii;
    for(i=0;i<num;i++) {
      err[i]=yp[i]-y[i];
      bias[i]=var[i]=nViv[i]=nVib[i]=0;
    }
    for(j=0;j<nfiles;j++){//bags
      for(i=0;i<num;i++){
	bias[i]+=err[i];        nVib[i]++;
	var[i] +=square(err[i]);nVi[i]++;
	//	if(1==0){//for check Lval0=9.126e-02
	{//for obtaining the average of the noise
	  ji=j*num+i;
	  for(ii=i+1;ii<num;ii++){
	    if(cc[ji]==cc[j*num+ii]) {//error for the same cell
	      //bias[i]+=err[ii];  nVib[i]++;
	      //bias[ii]+=err[i];  nVib[ii]++;
	      var[i] +=square(err[ii]); nVi[i]++;
	      var[ii]+=square(err[i]);  nVi[ii]++;
	    }
	  }
	}
      }
    }
    for(i=0;i<num;i++){
      bias[i]/=nVib[i];
      var[i]/=nViv[i];
    }
  }
#endif
  //////
  //  fp=fopen(fnpredict,"w");
  fp=fopen("predict+.dat","w");
  for(i=0;i<num;i++){
    if(intmode==1){
      //      fprintf(fp,"%d %d %.7e %.7e %.7e %d %.7e %.7e %.7e #Y^,t,Y,yr,var,c,v,k,b\n",(int)(yp[i]+0.5),n[i],y[i],yr[i],var[i]/vv[i],cc[i],vv[i],kyorix2[i],bias[i]);
      fprintf(fp,"%d %d %.7e %.7e %.7e %d %.7e %.7e %.7e %d #Y^,t,Y,yr,var,c,v,k,b,nvar\n",(int)(yp[i]+0.5),n[i],y[i],yr[i],var[i],cc[i],vv[i],kyorix2[i],bias[i],nVi[i]);
    }
    else{
      fprintf(fp,"%.7e %d %.7e %.7e %.7e %d %.7e %.7e %.7e %d #Y^,t,Y,yr,var,c,v,k,b,nvar\n",yp[i],n[i],y[i],yr[i],var[i],cc[i],vv[i],kyorix2[i],bias[i],nVi[i]);
//      {//error check
//	char buff[256];
//	sprintf(buff,"%.7e %d %.7e %.7e %.7e %d %.7e %.7e %.7e %d #Y^,t,Y,yr,var,c,v,k,b,nvar\n",yp[i],n[i],y[i],yr[i],var[i],cc[i],vv[i],kyorix2[i],bias[i],nVi[i]);
//	fprintf(stdout,"%s",buff);
//	fprintf(fp,"%s",buff);
//      }
      //      fprintf(fp,"%.7e %d %.7e %.7e %.7e %d %.7e %.7e %.7e #Y^,t,Y,yr,var,c,v,k,b\n",yp[i],n[i],y[i],yr[i],var[i]/vv[i],cc[i],vv[i],kyorix2[i],bias[i]);
    }
  }
  fclose(fp);
  //  fp=fopen(fnloss,"w");
  fp=fopen("loss+.dat","w");
  fprintf(fp,"%13.7e %13.7e %13.7e %13.7e %13.7e %d %d %.7e %.7e %.7e #LD Lval Lvar Lvarval Lvar0 nfiles num Ltrain LtrainE H0\n",LD,Lval,Lvar,Lvarval,Lvar0,nfiles,num,Ltrain,LtrainE,H0);
  fclose(fp);
  //  fprintf(stderr,"Created '%s'=%s",fnpredict,fnbody(argv[1],pr));
  //  for(j=2;j<=nfiles;j++) fprintf(stderr,"+%s" ,fnbody(argv[j],pr));
  //  fprintf(stderr,"\n");
  net_printf(strx3("Created '%s' and '%s'. #LDmode=%d.\n","predict+.dat","loss+.dat",LDmode));
  return(1);
}