|
Packit |
67cb25 |
/* eigen/sort.c
|
|
Packit |
67cb25 |
*
|
|
Packit |
67cb25 |
* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2006, 2007 Gerard Jungman, Patrick Alken
|
|
Packit |
67cb25 |
*
|
|
Packit |
67cb25 |
* This program is free software; you can redistribute it and/or modify
|
|
Packit |
67cb25 |
* it under the terms of the GNU General Public License as published by
|
|
Packit |
67cb25 |
* the Free Software Foundation; either version 3 of the License, or (at
|
|
Packit |
67cb25 |
* your option) any later version.
|
|
Packit |
67cb25 |
*
|
|
Packit |
67cb25 |
* This program is distributed in the hope that it will be useful, but
|
|
Packit |
67cb25 |
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
Packit |
67cb25 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
Packit |
67cb25 |
* General Public License for more details.
|
|
Packit |
67cb25 |
*
|
|
Packit |
67cb25 |
* You should have received a copy of the GNU General Public License
|
|
Packit |
67cb25 |
* along with this program; if not, write to the Free Software
|
|
Packit |
67cb25 |
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
|
Packit |
67cb25 |
*/
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
/* Author: G. Jungman, Modified: B. Gough. */
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
#include <config.h>
|
|
Packit |
67cb25 |
#include <stdlib.h>
|
|
Packit |
67cb25 |
#include <gsl/gsl_math.h>
|
|
Packit |
67cb25 |
#include <gsl/gsl_eigen.h>
|
|
Packit |
67cb25 |
#include <gsl/gsl_complex.h>
|
|
Packit |
67cb25 |
#include <gsl/gsl_complex_math.h>
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
/* Compares real parts of a and b and, if they are not approximately equal,
|
|
Packit |
67cb25 |
* returns Re(a) < Re(b); otherwise returns Im(a) < Im(b). */
|
|
Packit |
67cb25 |
static int
|
|
Packit |
67cb25 |
complex_less(gsl_complex a, gsl_complex b)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
return gsl_fcmp(GSL_REAL(a), GSL_REAL(b), GSL_DBL_EPSILON) == 0 ?
|
|
Packit |
67cb25 |
GSL_IMAG(a) < GSL_IMAG(b) : GSL_REAL(a) < GSL_REAL(b);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
/* The eigen_sort below is not very good, but it is simple and
|
|
Packit |
67cb25 |
* self-contained. We can always implement an improved sort later. */
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
int
|
|
Packit |
67cb25 |
gsl_eigen_symmv_sort (gsl_vector * eval, gsl_matrix * evec,
|
|
Packit |
67cb25 |
gsl_eigen_sort_t sort_type)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
if (evec->size1 != evec->size2)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
GSL_ERROR ("eigenvector matrix must be square", GSL_ENOTSQR);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else if (eval->size != evec->size1)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
GSL_ERROR ("eigenvalues must match eigenvector matrix", GSL_EBADLEN);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
const size_t N = eval->size;
|
|
Packit |
67cb25 |
size_t i;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
for (i = 0; i < N - 1; i++)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
size_t j;
|
|
Packit |
67cb25 |
size_t k = i;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
double ek = gsl_vector_get (eval, i);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
/* search for something to swap */
|
|
Packit |
67cb25 |
for (j = i + 1; j < N; j++)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
int test;
|
|
Packit |
67cb25 |
const double ej = gsl_vector_get (eval, j);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
switch (sort_type)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_VAL_ASC:
|
|
Packit |
67cb25 |
test = (ej < ek);
|
|
Packit |
67cb25 |
break;
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_VAL_DESC:
|
|
Packit |
67cb25 |
test = (ej > ek);
|
|
Packit |
67cb25 |
break;
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_ABS_ASC:
|
|
Packit |
67cb25 |
test = (fabs (ej) < fabs (ek));
|
|
Packit |
67cb25 |
break;
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_ABS_DESC:
|
|
Packit |
67cb25 |
test = (fabs (ej) > fabs (ek));
|
|
Packit |
67cb25 |
break;
|
|
Packit |
67cb25 |
default:
|
|
Packit |
67cb25 |
GSL_ERROR ("unrecognized sort type", GSL_EINVAL);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if (test)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
k = j;
|
|
Packit |
67cb25 |
ek = ej;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if (k != i)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
/* swap eigenvalues */
|
|
Packit |
67cb25 |
gsl_vector_swap_elements (eval, i, k);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
/* swap eigenvectors */
|
|
Packit |
67cb25 |
gsl_matrix_swap_columns (evec, i, k);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
return GSL_SUCCESS;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
int
|
|
Packit |
67cb25 |
gsl_eigen_hermv_sort (gsl_vector * eval, gsl_matrix_complex * evec,
|
|
Packit |
67cb25 |
gsl_eigen_sort_t sort_type)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
if (evec->size1 != evec->size2)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
GSL_ERROR ("eigenvector matrix must be square", GSL_ENOTSQR);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else if (eval->size != evec->size1)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
GSL_ERROR ("eigenvalues must match eigenvector matrix", GSL_EBADLEN);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
const size_t N = eval->size;
|
|
Packit |
67cb25 |
size_t i;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
for (i = 0; i < N - 1; i++)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
size_t j;
|
|
Packit |
67cb25 |
size_t k = i;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
double ek = gsl_vector_get (eval, i);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
/* search for something to swap */
|
|
Packit |
67cb25 |
for (j = i + 1; j < N; j++)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
int test;
|
|
Packit |
67cb25 |
const double ej = gsl_vector_get (eval, j);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
switch (sort_type)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_VAL_ASC:
|
|
Packit |
67cb25 |
test = (ej < ek);
|
|
Packit |
67cb25 |
break;
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_VAL_DESC:
|
|
Packit |
67cb25 |
test = (ej > ek);
|
|
Packit |
67cb25 |
break;
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_ABS_ASC:
|
|
Packit |
67cb25 |
test = (fabs (ej) < fabs (ek));
|
|
Packit |
67cb25 |
break;
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_ABS_DESC:
|
|
Packit |
67cb25 |
test = (fabs (ej) > fabs (ek));
|
|
Packit |
67cb25 |
break;
|
|
Packit |
67cb25 |
default:
|
|
Packit |
67cb25 |
GSL_ERROR ("unrecognized sort type", GSL_EINVAL);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if (test)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
k = j;
|
|
Packit |
67cb25 |
ek = ej;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if (k != i)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
/* swap eigenvalues */
|
|
Packit |
67cb25 |
gsl_vector_swap_elements (eval, i, k);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
/* swap eigenvectors */
|
|
Packit |
67cb25 |
gsl_matrix_complex_swap_columns (evec, i, k);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
return GSL_SUCCESS;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
int
|
|
Packit |
67cb25 |
gsl_eigen_nonsymmv_sort (gsl_vector_complex * eval,
|
|
Packit |
67cb25 |
gsl_matrix_complex * evec,
|
|
Packit |
67cb25 |
gsl_eigen_sort_t sort_type)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
if (evec && (evec->size1 != evec->size2))
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
GSL_ERROR ("eigenvector matrix must be square", GSL_ENOTSQR);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else if (evec && (eval->size != evec->size1))
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
GSL_ERROR ("eigenvalues must match eigenvector matrix", GSL_EBADLEN);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
const size_t N = eval->size;
|
|
Packit |
67cb25 |
size_t i;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
for (i = 0; i < N - 1; i++)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
size_t j;
|
|
Packit |
67cb25 |
size_t k = i;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
gsl_complex ek = gsl_vector_complex_get (eval, i);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
/* search for something to swap */
|
|
Packit |
67cb25 |
for (j = i + 1; j < N; j++)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
int test;
|
|
Packit |
67cb25 |
const gsl_complex ej = gsl_vector_complex_get (eval, j);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
switch (sort_type)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_ABS_ASC:
|
|
Packit |
67cb25 |
test = (gsl_complex_abs (ej) < gsl_complex_abs (ek));
|
|
Packit |
67cb25 |
break;
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_ABS_DESC:
|
|
Packit |
67cb25 |
test = (gsl_complex_abs (ej) > gsl_complex_abs (ek));
|
|
Packit |
67cb25 |
break;
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_VAL_ASC:
|
|
Packit |
67cb25 |
test = complex_less(ej, ek);
|
|
Packit |
67cb25 |
break;
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_VAL_DESC:
|
|
Packit |
67cb25 |
test = complex_less(ek, ej);
|
|
Packit |
67cb25 |
break;
|
|
Packit |
67cb25 |
default:
|
|
Packit |
67cb25 |
GSL_ERROR ("invalid sort type", GSL_EINVAL);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if (test)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
k = j;
|
|
Packit |
67cb25 |
ek = ej;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if (k != i)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
/* swap eigenvalues */
|
|
Packit |
67cb25 |
gsl_vector_complex_swap_elements (eval, i, k);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
/* swap eigenvectors */
|
|
Packit |
67cb25 |
if (evec)
|
|
Packit |
67cb25 |
gsl_matrix_complex_swap_columns (evec, i, k);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
return GSL_SUCCESS;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
int
|
|
Packit |
67cb25 |
gsl_eigen_gensymmv_sort (gsl_vector * eval, gsl_matrix * evec,
|
|
Packit |
67cb25 |
gsl_eigen_sort_t sort_type)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
int s;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
s = gsl_eigen_symmv_sort(eval, evec, sort_type);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
return s;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
int
|
|
Packit |
67cb25 |
gsl_eigen_genhermv_sort (gsl_vector * eval, gsl_matrix_complex * evec,
|
|
Packit |
67cb25 |
gsl_eigen_sort_t sort_type)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
int s;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
s = gsl_eigen_hermv_sort(eval, evec, sort_type);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
return s;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
int
|
|
Packit |
67cb25 |
gsl_eigen_genv_sort (gsl_vector_complex * alpha, gsl_vector * beta,
|
|
Packit |
67cb25 |
gsl_matrix_complex * evec, gsl_eigen_sort_t sort_type)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
if (evec->size1 != evec->size2)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
GSL_ERROR ("eigenvector matrix must be square", GSL_ENOTSQR);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else if (alpha->size != evec->size1 || beta->size != evec->size1)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
GSL_ERROR ("eigenvalues must match eigenvector matrix", GSL_EBADLEN);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
const size_t N = alpha->size;
|
|
Packit |
67cb25 |
size_t i;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
for (i = 0; i < N - 1; i++)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
size_t j;
|
|
Packit |
67cb25 |
size_t k = i;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
gsl_complex ak = gsl_vector_complex_get (alpha, i);
|
|
Packit |
67cb25 |
double bk = gsl_vector_get(beta, i);
|
|
Packit |
67cb25 |
gsl_complex ek;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if (bk < GSL_DBL_EPSILON)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
GSL_SET_COMPLEX(&ek,
|
|
Packit |
67cb25 |
GSL_SIGN(GSL_REAL(ak)) ? GSL_POSINF : GSL_NEGINF,
|
|
Packit |
67cb25 |
GSL_SIGN(GSL_IMAG(ak)) ? GSL_POSINF : GSL_NEGINF);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else
|
|
Packit |
67cb25 |
ek = gsl_complex_div_real(ak, bk);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
/* search for something to swap */
|
|
Packit |
67cb25 |
for (j = i + 1; j < N; j++)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
int test;
|
|
Packit |
67cb25 |
const gsl_complex aj = gsl_vector_complex_get (alpha, j);
|
|
Packit |
67cb25 |
double bj = gsl_vector_get(beta, j);
|
|
Packit |
67cb25 |
gsl_complex ej;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if (bj < GSL_DBL_EPSILON)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
GSL_SET_COMPLEX(&ej,
|
|
Packit |
67cb25 |
GSL_SIGN(GSL_REAL(aj)) ? GSL_POSINF : GSL_NEGINF,
|
|
Packit |
67cb25 |
GSL_SIGN(GSL_IMAG(aj)) ? GSL_POSINF : GSL_NEGINF);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else
|
|
Packit |
67cb25 |
ej = gsl_complex_div_real(aj, bj);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
switch (sort_type)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_ABS_ASC:
|
|
Packit |
67cb25 |
test = (gsl_complex_abs (ej) < gsl_complex_abs (ek));
|
|
Packit |
67cb25 |
break;
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_ABS_DESC:
|
|
Packit |
67cb25 |
test = (gsl_complex_abs (ej) > gsl_complex_abs (ek));
|
|
Packit |
67cb25 |
break;
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_VAL_ASC:
|
|
Packit |
67cb25 |
case GSL_EIGEN_SORT_VAL_DESC:
|
|
Packit |
67cb25 |
default:
|
|
Packit |
67cb25 |
GSL_ERROR ("invalid sort type", GSL_EINVAL);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if (test)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
k = j;
|
|
Packit |
67cb25 |
ek = ej;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if (k != i)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
/* swap eigenvalues */
|
|
Packit |
67cb25 |
gsl_vector_complex_swap_elements (alpha, i, k);
|
|
Packit |
67cb25 |
gsl_vector_swap_elements (beta, i, k);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
/* swap eigenvectors */
|
|
Packit |
67cb25 |
gsl_matrix_complex_swap_columns (evec, i, k);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
return GSL_SUCCESS;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|