/* Eigen.c
 *
 * Copyright (C) 1993-2003 David Weenink
 *
 * 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., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/*
 djmw 20010719
 djmw 20020402 GPL header
 djmw 20030205 last modification
*/

#include "Eigen.h"
#include "NUMmachar.h"
#include "NUMlapack.h"
#include "NUMclapack.h"
#include "NUM2.h"
#include "SVD.h"

#include "oo_DESTROY.h"
#include "Eigen_def.h"
#include "oo_COPY.h"
#include "Eigen_def.h"
#include "oo_EQUAL.h"
#include "Eigen_def.h"
#include "oo_WRITE_ASCII.h"
#include "Eigen_def.h"
#include "oo_READ_ASCII.h"
#include "Eigen_def.h"
#include "oo_WRITE_BINARY.h"
#include "Eigen_def.h"
#include "oo_READ_BINARY.h"
#include "Eigen_def.h"
#include "oo_DESCRIPTION.h"
#include "Eigen_def.h"

#define MAX(m,n) ((m) > (n) ? (m) : (n))
#define MIN(m,n) ((m) < (n) ? (m) : (n))
#define SWAP(a,b) {temp=(a);(a)=(b);(b)=temp;}

extern machar_Table NUMfpp;
extern int praat_USE_LAPACK;

static void Graphics_ticks (Graphics g, double min, double max, int hasNumber,
	int hasTick, int hasDottedLine, int integers)
{
	double range = max - min, scale = 1, tick = min, dtick = 1;

	if (range == 0)
	{
		return;
	}
	else if (range > 1)
	{
		while (range / scale > 10) scale *= 10;
		range /= scale;
	}
	else
	{
		while (range / scale < 10) scale /= 10;
		range *= scale;
	}

	if (range < 3) dtick = 0.5; 
	dtick *= scale;	
	tick = dtick * floor (min / dtick);
	if (tick < min) tick += dtick;
	while (tick <= max)
	{
		double num = integers ? floor (tick + 0.5) : tick;
		Graphics_markBottom (g, num, hasNumber, hasTick, hasDottedLine, NULL);
		tick += dtick;
	}
}

class_methods (Eigen, Data)
	class_method_local (Eigen, destroy)
	class_method_local (Eigen, description)
	class_method_local (Eigen, copy)
	class_method_local (Eigen, equal)
	class_method_local (Eigen, writeAscii)
	class_method_local (Eigen, readAscii)
	class_method_local (Eigen, writeBinary)
	class_method_local (Eigen, readBinary)
class_methods_end

int Eigen_init (I, long numberOfEigenvalues, long dimension)
{
	iam (Eigen);
	my numberOfEigenvalues = numberOfEigenvalues;
	my dimension = dimension;
	if (! (my eigenvalues = NUMdvector (1, numberOfEigenvalues)) ||
		! (my eigenvectors = NUMdmatrix (1, numberOfEigenvalues, 
			1, dimension))) return 0;
	return 1;
}

int Eigen_initFromSquareRoot (I, double **a, long numberOfRows, long numberOfColumns)
{
	iam (Eigen);
	SVD svd;
	long i, j, k, numberOfZeroed, numberOfEigenvalues;
	
	my dimension = numberOfColumns;
	if (! (svd = SVD_create_d (a, numberOfRows, numberOfColumns))) return 0;
	
	/*
		Make sv's that are too small zero. These values occur automatically 
		when the rank of A'A < numberOfColumns. This could occur when for
		example numberOfRows <= numberOfColumns. 
		(n points in  an n-dimensional space define maximally an n-1 
		dimensional surface for which we maximally need an n-1 dimensional
		basis.)
	*/

	numberOfZeroed = SVD_zeroSmallSingularValues (svd, 0);

	numberOfEigenvalues = numberOfColumns - numberOfZeroed;
	
	if (! Eigen_init (me, numberOfEigenvalues, numberOfColumns)) goto end;

	for (k = 0, i = 1; i <= numberOfColumns; i++)
	{
		double t = svd -> d[i];
		if (t > 0)
		{
			my eigenvalues[++k] = t * t;
			for (j = 1; j <= numberOfColumns; j++)
			{
				my eigenvectors[k][j] = svd -> v[j][i];
			}
		}
	}
	
	Eigen_sort (me);
	
end:
	forget (svd);
	return ! Melder_hasError ();
}

double **NUMdmatrix_transpose (double **m, long nr, long nc);
double **NUMdmatrix_transpose (double **m, long nr, long nc)
{
	long i = 1, j = 1;
	double **to = NUMdmatrix (1, nc, 1, nr);
	
	if (to == NULL) return NULL;
	
	for (i = 1; i <= nr; i++)
	{
		for (j = 1; j <= nc; j++)
		{
			to[j][i] = m[i][j];
		}
	}
	return to;
}

int Eigen_initFromSquareRootPair (I, double **a, long numberOfRows,
	long numberOfColumns, double **b, long numberOfRows_b)
{
	iam (Eigen);
	double *u = NULL, *v = NULL, *work = NULL, **ac = NULL, **bc = NULL;
	double *alpha = NULL, *beta = NULL, **q = NULL, maxsv2 = -10;
	char jobu = 'N', jobv = 'N', jobq = 'Q';
	long i, j = 0, k, ll, m = numberOfRows, n = numberOfColumns, p = numberOfRows_b;
	long lda = m, ldb = p, ldu = lda, ldv = ldb, ldq = n;
	long lwork = MAX (MAX (3*n, m), p) + n, *iwork = NULL, info;

/*	Melder_assert (numberOfRows >= numberOfColumns || numberOfRows_b >= numberOfColumns);*/
	
	my dimension = numberOfColumns;
	
	if (((alpha = NUMdvector (1, n)) == NULL) ||
		((beta = NUMdvector (1, n)) == NULL) ||
		((q = NUMdmatrix (1, n, 1, n)) == NULL) ||
		((work = NUMdvector (1, lwork)) == NULL) ||
		((iwork = NUMlvector (1, n)) == NULL) ||
		((ac = NUMdmatrix_transpose (a, numberOfRows,numberOfColumns)) == NULL) ||
		((bc = NUMdmatrix_transpose (b, numberOfRows_b,numberOfColumns)) == NULL)) goto end;
	
	(void) NUMlapack_dggsvd (&jobu, &jobv, &jobq, &m, &n, &p, &k, &ll, 
		&ac[1][1], &lda, &bc[1][1], &ldb, &alpha[1], &beta[1], u, &ldu,
		v, &ldv, &q[1][1], &ldq, &work[1], &iwork[1], &info);
	
	if (info != 0) goto end;
	
	/*
		Calculate the eigenvalues alpha[i]/beta[i] and store in alpha[i].
	*/
	
	for (i = 1; i <= ll; i++)
	{
		double t = alpha[k+i] / beta[k+i];
		alpha[k+i] = t * t;	
	}
	
	/*
		Deselect the eigenvalues < eps * max_eigenvalue.
		The iwork array contains the index of the sorted alpha[i].
	*/
	
	maxsv2 = alpha[k+iwork[1]];
	
	if (! NUMfpp) NUMmachar ();

	for (n = 0, i = 1; i <= ll; i++)
	{
		if (alpha[k+i] < NUMfpp -> eps * maxsv2)
		{
			n++; alpha[k+i] = -1;
		}
	}
				
	if (! Eigen_init (me, ll - n, numberOfColumns)) goto end;
	
	/* Sort the eigenvalues on the basis of iwork */
	
	for (i = 1; i <= my numberOfEigenvalues; i++)
	{
		if (my eigenvalues[i] == 0)
		{
			/*
				Copy v[iwork[i]] -> v[i];
			*/
			
			my eigenvalues[i] = alpha[k+iwork[i]];
			for (j = 1; j <= numberOfColumns; j++)
			{
				my eigenvectors[i][j] = q[k+iwork[i]][j];
			}
		}
		if (iwork[i] != i && iwork[i] <= my numberOfEigenvalues)
		{
			my eigenvalues[iwork[i]] = alpha[k+i];
			for (j = 1; j <= numberOfColumns; j++)
			{
				my eigenvectors[iwork[i]][j] = q[k+i][j];
			}
		}
	}

	NUMnormalizeRows_d (my eigenvectors, my numberOfEigenvalues, numberOfColumns, 1);
		
end:

	NUMdmatrix_free (bc, 1, 1);
	NUMdmatrix_free (ac, 1, 1);
	NUMlvector_free (iwork, 1);
	NUMdvector_free (work, 1);
	NUMdmatrix_free (q, 1, 1);
	NUMdvector_free (beta, 1);
	NUMdvector_free (alpha, 1);
				
	return ! Melder_hasError();
}

int Eigen_initFromSymmetricMatrix (I, double **a, long n)
{
	iam (Eigen);
	double *work, wt[1], temp;
	char jobz = 'V', uplo = 'U';
	long  i, j, lwork = -1, info;
	
	my dimension = my numberOfEigenvalues = n;
		
	NUMdmatrix_copyElements (a, my eigenvectors, 1, n, 1, n);
		
	/*
		Get size of work array
	*/
			
	(void) NUMlapack_dsyev (&jobz, &uplo, &n, &my eigenvectors[1][1], &n, 
			&my eigenvalues[1], wt, &lwork, &info);
	if (info != 0) return 0;
	
	lwork = wt[0];
	work = NUMdvector (1, lwork);
	if (work == NULL) return 0;
		
	(void) NUMlapack_dsyev (&jobz, &uplo, &n, &my eigenvectors[1][1], &n, 
		&my eigenvalues[1], &work[1], &lwork, &info);
	NUMdvector_free (work, 1);
	if (info != 0) return 0;
		
	/*
		We want descending order instead of ascending.
	*/
		
	for (i = 1; i <= n / 2; i++)
	{
		long ilast = n - i + 1;
			 
		SWAP(my eigenvalues[i], my eigenvalues[ilast])
		for (j = 1; j <= n; j++)
		{
			SWAP(my eigenvectors[i][j], my eigenvectors[ilast][j])
		}	
	}

	return 1;
}

Eigen Eigen_create (long numberOfEigenvalues, long dimension)
{
	Eigen me = new (Eigen);
	
	if (! me || ! Eigen_init (me, numberOfEigenvalues, dimension)) forget (me);
	return me;
}

long Eigen_getNumberOfEigenvectors (I)
{
	iam (Eigen);
	return my numberOfEigenvalues;
}

long Eigen_getDimensionOfComponents (I)
{
	iam (Eigen);
	return my dimension;
}

double Eigen_getSumOfEigenvalues (I)
{
	iam (Eigen); long i; double sum = 0;
	for (i = 1; i <= my numberOfEigenvalues; i++) sum += my eigenvalues[i];
	return sum;
}

double Eigen_getCumulativeContributionOfComponents (I, long from, long to)
{
	iam (Eigen);
	long i;
	double partial = 0, sum = 0;
	
	if (to == 0) to = my numberOfEigenvalues;
	if (from > 0 && to <= my numberOfEigenvalues && from <= to)
	{
		for (i = 1; i <= my numberOfEigenvalues; i++)
		{
			sum += my eigenvalues[i];
			if (i >= from && i <= to) partial += my eigenvalues[i];
		}
	}
	return sum > 0 ? partial / sum : 0;

}

long Eigen_getDimensionOfFraction (I, double fraction)
{
	iam (Eigen); 
	long n;
	double p, sum = Eigen_getSumOfEigenvalues (me);
	
	if (sum == 0) return 1;
	
	n = 1; p = my eigenvalues[1];
	while (p / sum < fraction && n < my numberOfEigenvalues)
	{
		p += my eigenvalues[++n];
	}
	return n;
}

void Eigen_sort (I)
{
	iam (Eigen); 
	long i, j, k;
	double temp, *e = my eigenvalues, **v = my eigenvectors;
			
    for (i = 1; i < my numberOfEigenvalues; i++)
    {
        double emax = e[k=i];
        for (j = i + 1; j <= my numberOfEigenvalues; j++)
		{
			if (e[j] > emax) emax = e[k=j];
		}
		if (k != i)
        {
			/*
				Swap eigenvalues and eigenvectors
			*/
			
			SWAP (e[i], e[k]) 
            for (j = 1; j <= my dimension; j++)
			{
				SWAP (v[i][j], v[k][j])
			}
        }
    }
}

void Eigen_invertEigenvector (I, long ivec)
{
	iam (Eigen); long j;

	if (ivec < 1 || ivec > my numberOfEigenvalues) return;

	for (j = 1; j <= my dimension; j++)
	{
		my eigenvectors[ivec][j] = - my eigenvectors[ivec][j];
	}
}

void Eigen_drawEigenvalues_scree (I, Graphics g, long first, long last, 
	double minimum, double maximum, double size_mm, const char *mark, 
	int garnish)
{
	iam (Eigen); double xmin = first, xmax = last; long i;

	if (last <= first )
	{
		first = 1; last = my numberOfEigenvalues;
		xmin = 0; xmax = last + 1;
	}
	if (maximum <= minimum)
	{
		maximum = my eigenvalues[first];
		minimum = my eigenvalues[last];
	}
	Graphics_setInner (g);
	Graphics_setWindow (g, xmin, xmax, minimum, maximum);
	for (i=first; i <= last; i++)
	{
		Graphics_mark (g, i, my eigenvalues[i], size_mm, mark);
	}
	Graphics_unsetInner (g);
	if (garnish)
	{
    	Graphics_drawInnerBox (g);
    	Graphics_marksLeft (g, 2, 1, 1, 0);
    	Graphics_textLeft (g, 1, "eigenvalue");
		Graphics_ticks (g, first, last, 1, 1, 0, 1);
		Graphics_textBottom (g, 1, "eigenvalue number");
	}
}

void Eigen_drawEigenvector (I, Graphics g, long ivec, long first, long last,
	double minimum, double maximum, int weigh, double size_mm, const char *mark,
	int connect, int garnish)
{
	iam (Eigen); 
	long i; 
	double xmin = first, xmax = last, *vec, w;
	
	if (ivec < 1 || ivec > my numberOfEigenvalues) return;
	
	if (last <= first )
	{
		first = 1; last = my dimension;
		xmin = 0; xmax = last + 1;
	}
	vec = my eigenvectors[ivec];
	w = weigh ? sqrt (my eigenvalues[ivec]) : 1;
	if (maximum <= minimum)
	{
		NUMdvector_extrema (vec, first, last, &minimum, &maximum);
		maximum *= w; minimum *= w;
	}
	Graphics_setInner (g);
	Graphics_setWindow (g, xmin, xmax, minimum, maximum);
	
	Graphics_mark (g, first, w * vec[first], size_mm, mark);
	for (i = first + 1; i <= last; i++)
	{
		Graphics_mark (g, i, w * vec[i], size_mm, mark);
		if (connect) Graphics_line (g, i - 1, w * vec[i-1], i, w * vec[i]);
	}
	Graphics_unsetInner (g);
	if (garnish)
	{
		char ltext[20]; 
		sprintf (ltext, "eigenvector %d", ivec);
    	Graphics_drawInnerBox (g);
    	if (minimum * maximum < 0) Graphics_markLeft (g, 0.0, 1, 1, 1, NULL);
    	Graphics_marksLeft (g, 2, 1, 1, 0);
    	Graphics_textLeft (g, 1, ltext);
 		Graphics_ticks (g, first, last, 1, 1, 0, 1);
		Graphics_textBottom (g, 1, "dimension");
	}
}

#undef MAX
#undef MIN
#undef SWAP

/* End of file Eigen.c */