/* linalg/test.c * * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2004, 2005, 2006, 2007, 2010 Gerard Jungman, Brian Gough * Copyright (C) Huan Wu (test_choleskyc_invert and test_choleskyc_invert_dim) * * 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. */ /* Author: G. Jungman */ #include #include #include #include #include #include #include #include #include #include #include #define TEST_SVD_4X4 1 int check (double x, double actual, double eps); gsl_matrix * create_hilbert_matrix(unsigned long size); gsl_matrix * create_general_matrix(unsigned long size1, unsigned long size2); gsl_matrix * create_vandermonde_matrix(unsigned long size); gsl_matrix * create_moler_matrix(unsigned long size); gsl_matrix * create_row_matrix(unsigned long size1, unsigned long size2); gsl_matrix * create_2x2_matrix(double a11, double a12, double a21, double a22); gsl_matrix * create_diagonal_matrix(double a[], unsigned long size); gsl_matrix * create_sparse_matrix(unsigned long m, unsigned long n); int test_matmult(void); int test_matmult_mod(void); int test_LU_solve_dim(const gsl_matrix * m, const double * actual, double eps); int test_LU_solve(void); int test_LUc_solve_dim(const gsl_matrix_complex * m, const double * actual, double eps); int test_LUc_solve(void); int test_QR_solve_dim(const gsl_matrix * m, const double * actual, double eps); int test_QR_solve(void); int test_QR_QRsolve_dim(const gsl_matrix * m, const double * actual, double eps); int test_QR_QRsolve(void); int test_QR_lssolve_dim(const gsl_matrix * m, const double * actual, double eps); int test_QR_lssolve(void); int test_QR_decomp_dim(const gsl_matrix * m, double eps); int test_QR_decomp(void); int test_QRPT_solve_dim(const gsl_matrix * m, const double * actual, double eps); int test_QRPT_solve(void); int test_QRPT_QRsolve_dim(const gsl_matrix * m, const double * actual, double eps); int test_QRPT_QRsolve(void); int test_QRPT_decomp_dim(const gsl_matrix * m, const double expected_rcond, double eps); int test_QRPT_decomp(void); int test_QRPT_lssolve_dim(const gsl_matrix * m, const double * actual, double eps); int test_QRPT_lssolve(void); int test_QRPT_lssolve2_dim(const gsl_matrix * m, const double * actual, double eps); int test_QRPT_lssolve2(void); int test_QR_update_dim(const gsl_matrix * m, double eps); int test_QR_update(void); int test_QRPT_update_dim(const gsl_matrix * m, double eps); int test_QRPT_update(void); int test_LQ_solve_dim(const gsl_matrix * m, const double * actual, double eps); int test_LQ_solve(void); int test_LQ_LQsolve_dim(const gsl_matrix * m, const double * actual, double eps); int test_LQ_LQsolve(void); int test_LQ_lssolve_dim(const gsl_matrix * m, const double * actual, double eps); int test_LQ_lssolve(void); int test_LQ_decomp_dim(const gsl_matrix * m, double eps); int test_LQ_decomp(void); int test_PTLQ_solve_dim(const gsl_matrix * m, const double * actual, double eps); int test_PTLQ_solve(void); int test_PTLQ_LQsolve_dim(const gsl_matrix * m, const double * actual, double eps); int test_PTLQ_LQsolve(void); int test_PTLQ_decomp_dim(const gsl_matrix * m, double eps); int test_PTLQ_decomp(void); int test_LQ_update_dim(const gsl_matrix * m, double eps); int test_LQ_update(void); int test_SV_solve_dim(const gsl_matrix * m, const double * actual, double eps); int test_SV_solve(void); int test_SV_decomp_dim(const gsl_matrix * m, double eps); int test_SV_decomp(void); int test_SV_decomp_mod_dim(const gsl_matrix * m, double eps); int test_SV_decomp_mod(void); int test_SV_decomp_jacobi_dim(const gsl_matrix * m, double eps); int test_SV_decomp_jacobi(void); int test_cholesky_solve_dim(const gsl_matrix * m, const double * actual, double eps); int test_cholesky_solve(void); int test_HH_solve_dim(const gsl_matrix * m, const double * actual, double eps); int test_HH_solve(void); int test_TDS_solve_dim(unsigned long dim, double d, double od, const double * actual, double eps); int test_TDS_solve(void); int test_TDN_solve_dim(unsigned long dim, double d, double a, double b, const double * actual, double eps); int test_TDN_solve(void); int test_TDS_cyc_solve_one(const unsigned long dim, const double * d, const double * od, const double * r, const double * actual, double eps); int test_TDS_cyc_solve(void); int test_TDN_cyc_solve_dim(unsigned long dim, double d, double a, double b, const double * actual, double eps); int test_TDN_cyc_solve(void); int test_bidiag_decomp_dim(const gsl_matrix * m, double eps); int test_bidiag_decomp(void); int check (double x, double actual, double eps) { if (x == actual) { return 0; } else if (actual == 0) { return fabs(x) > eps; } else { return (fabs(x - actual)/fabs(actual)) > eps; } } gsl_vector * vector_alloc (size_t n) { size_t p[5] = {3, 5, 7, 11, 13}; static size_t k = 0; size_t stride = p[k]; k = (k + 1) % 5; { gsl_block * b = gsl_block_alloc (n * stride); gsl_vector * v = gsl_vector_alloc_from_block (b, 0, n, stride); v->owner = 1; return v; } } void vector_free (gsl_vector * v) { gsl_vector_free (v); } gsl_matrix * create_hilbert_matrix(unsigned long size) { unsigned long i, j; gsl_matrix * m = gsl_matrix_alloc(size, size); for(i=0; isize1; size_t i, j; gsl_matrix_set_zero(m); for (i = 0; i < N; ++i) { for (j = 0; j <= i; ++j) { double mij = gsl_rng_uniform(r); /* put lower bound on diagonal entries to ensure invertibility */ if (i == j) mij = GSL_MAX(mij, 0.3); if (Uplo == CblasLower) gsl_matrix_set(m, i, j, mij); else gsl_matrix_set(m, j, i, mij); if (Diag == CblasUnit && i == j) gsl_matrix_set(m, i, j, 1.0); } } return GSL_SUCCESS; } gsl_matrix * m11; gsl_matrix * m51; gsl_matrix * m35; gsl_matrix * m53; gsl_matrix * m97; gsl_matrix * s35; gsl_matrix * s53; gsl_matrix * hilb2; gsl_matrix * hilb3; gsl_matrix * hilb4; gsl_matrix * hilb12; gsl_matrix * row3; gsl_matrix * row5; gsl_matrix * row12; gsl_matrix * A22; gsl_matrix * A33; gsl_matrix * A44; gsl_matrix * A55; gsl_matrix_complex * c7; gsl_matrix * inf5; double inf5_data[] = {1.0, 0.0, -3.0, 0.0, -5.0}; gsl_matrix * nan5; gsl_matrix * dblmin3, * dblmin5, * dblsubnorm5; gsl_matrix * bigsparse; double m53_lssolution[] = {52.5992295702070, -337.7263113752073, 351.8823436427604}; double hilb2_solution[] = {-8.0, 18.0} ; double hilb3_solution[] = {27.0, -192.0, 210.0}; double hilb4_solution[] = {-64.0, 900.0, -2520.0, 1820.0}; double hilb12_solution[] = {-1728.0, 245388.0, -8528520.0, 127026900.0, -1009008000.0, 4768571808.0, -14202796608.0, 27336497760.0, -33921201600.0, 26189163000.0, -11437874448.0, 2157916488.0 }; double c7_solution[] = { 2.40717272023734e+01, -9.84612797621247e+00, -2.69338853034031e+02, 8.75455232472528e+01, 2.96661356736296e+03, -1.02624473923993e+03, -1.82073812124749e+04, 5.67384473042410e+03, 5.57693879019068e+04, -1.61540963210502e+04, -7.88941207561151e+04, 1.95053812987858e+04, 3.95548551241728e+04, -7.76593696255317e+03 }; gsl_matrix * vander2; gsl_matrix * vander3; gsl_matrix * vander4; gsl_matrix * vander12; double vander2_solution[] = {1.0, 0.0}; double vander3_solution[] = {0.0, 1.0, 0.0}; double vander4_solution[] = {0.0, 0.0, 1.0, 0.0}; double vander12_solution[] = {0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0}; gsl_matrix * moler10; #include "test_cholesky.c" #include "test_cod.c" int test_LU_solve_dim(const gsl_matrix * m, const double * actual, double eps) { int s = 0; int signum; unsigned long i, dim = m->size1; gsl_permutation * perm = gsl_permutation_alloc(dim); gsl_vector * rhs = gsl_vector_alloc(dim); gsl_matrix * lu = gsl_matrix_alloc(dim,dim); gsl_vector * x = gsl_vector_alloc(dim); gsl_vector * residual = gsl_vector_alloc(dim); gsl_matrix_memcpy(lu,m); for(i=0; isize1; gsl_permutation * perm = gsl_permutation_alloc(dim); gsl_vector_complex * rhs = gsl_vector_complex_alloc(dim); gsl_matrix_complex * lu = gsl_matrix_complex_alloc(dim,dim); gsl_vector_complex * x = gsl_vector_complex_alloc(dim); gsl_vector_complex * residual = gsl_vector_complex_alloc(dim); gsl_matrix_complex_memcpy(lu,m); for(i=0; isize1; gsl_vector * rhs = gsl_vector_alloc(dim); gsl_matrix * qr = gsl_matrix_alloc(dim,dim); gsl_vector * d = gsl_vector_alloc(dim); gsl_vector * x = gsl_vector_alloc(dim); gsl_matrix_memcpy(qr,m); for(i=0; isize1; gsl_vector * rhs = gsl_vector_alloc(dim); gsl_matrix * qr = gsl_matrix_alloc(dim,dim); gsl_matrix * q = gsl_matrix_alloc(dim,dim); gsl_matrix * r = gsl_matrix_alloc(dim,dim); gsl_vector * d = gsl_vector_alloc(dim); gsl_vector * x = gsl_vector_alloc(dim); gsl_matrix_memcpy(qr,m); for(i=0; isize1, N = m->size2; gsl_vector * rhs = gsl_vector_alloc(M); gsl_matrix * qr = gsl_matrix_alloc(M,N); gsl_vector * d = gsl_vector_alloc(N); gsl_vector * x = gsl_vector_alloc(N); gsl_vector * r = gsl_vector_alloc(M); gsl_vector * res = gsl_vector_alloc(M); gsl_matrix_memcpy(qr,m); for(i=0; isize1, N = m->size2; gsl_matrix * qr = gsl_matrix_alloc(M,N); gsl_matrix * a = gsl_matrix_alloc(M,N); gsl_matrix * q = gsl_matrix_alloc(M,M); gsl_matrix * r = gsl_matrix_alloc(M,N); gsl_vector * d = gsl_vector_alloc(GSL_MIN(M,N)); gsl_matrix_memcpy(qr,m); s += gsl_linalg_QR_decomp(qr, d); s += gsl_linalg_QR_unpack(qr, d, q, r); /* compute a = q r */ gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1.0, q, r, 0.0, a); for(i=0; isize1, N = m->size2; gsl_vector * rhs = gsl_vector_alloc(M); gsl_matrix * QRPT = gsl_matrix_alloc(M,N); gsl_vector * tau = gsl_vector_alloc(N); gsl_vector * x = gsl_vector_alloc(N); gsl_vector * r = gsl_vector_alloc(M); gsl_vector * res = gsl_vector_alloc(M); gsl_permutation * perm = gsl_permutation_alloc(N); gsl_vector * work = gsl_vector_alloc(N); int signum; gsl_matrix_memcpy(QRPT, m); for(i = 0; i < M; i++) gsl_vector_set(rhs, i, i + 1.0); s += gsl_linalg_QRPT_decomp(QRPT, tau, perm, &signum, work); s += gsl_linalg_QRPT_lssolve(QRPT, tau, perm, rhs, x, res); for (i = 0; i < N; i++) { int foo = check(gsl_vector_get(x, i), actual[i], eps); if(foo) { printf("(%3lu,%3lu)[%lu]: %22.18g %22.18g\n", M, N, i, gsl_vector_get(x, i), actual[i]); } s += foo; } /* compute residual r = b - m x */ if (M == N) { gsl_vector_set_zero(r); } else { gsl_vector_memcpy(r, rhs); gsl_blas_dgemv(CblasNoTrans, -1.0, m, x, 1.0, r); } for (i = 0; i < N; i++) { int foo = check(gsl_vector_get(res, i), gsl_vector_get(r,i), sqrt(eps)); if(foo) { printf("(%3lu,%3lu)[%lu]: %22.18g %22.18g\n", M, N, i, gsl_vector_get(res, i), gsl_vector_get(r,i)); } s += foo; } gsl_vector_free(r); gsl_vector_free(res); gsl_vector_free(x); gsl_vector_free(tau); gsl_matrix_free(QRPT); gsl_vector_free(rhs); gsl_permutation_free(perm); gsl_vector_free(work); return s; } int test_QRPT_lssolve(void) { int f; int s = 0; f = test_QRPT_lssolve_dim(m53, m53_lssolution, 2 * 64.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_lssolve m(5,3)"); s += f; f = test_QRPT_lssolve_dim(hilb2, hilb2_solution, 2 * 8.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_lssolve hilbert(2)"); s += f; f = test_QRPT_lssolve_dim(hilb3, hilb3_solution, 2 * 64.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_lssolve hilbert(3)"); s += f; f = test_QRPT_lssolve_dim(hilb4, hilb4_solution, 2 * 2048.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_lssolve hilbert(4)"); s += f; f = test_QRPT_lssolve_dim(hilb12, hilb12_solution, 0.5); gsl_test(f, " QRPT_lssolve hilbert(12)"); s += f; f = test_QRPT_lssolve_dim(vander2, vander2_solution, 8.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_lssolve vander(2)"); s += f; f = test_QRPT_lssolve_dim(vander3, vander3_solution, 64.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_lssolve vander(3)"); s += f; f = test_QRPT_lssolve_dim(vander4, vander4_solution, 1024.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_lssolve vander(4)"); s += f; f = test_QRPT_lssolve_dim(vander12, vander12_solution, 0.05); gsl_test(f, " QRPT_lssolve vander(12)"); s += f; return s; } int test_QRPT_lssolve2_dim(const gsl_matrix * m, const double * actual, double eps) { int s = 0; size_t i, M = m->size1, N = m->size2; gsl_vector * rhs = gsl_vector_alloc(M); gsl_matrix * QRPT = gsl_matrix_alloc(M,N); gsl_vector * tau = gsl_vector_alloc(N); gsl_vector * x = gsl_vector_alloc(N); gsl_vector * r = gsl_vector_alloc(M); gsl_vector * res = gsl_vector_alloc(M); gsl_permutation * perm = gsl_permutation_alloc(N); gsl_vector * work = gsl_vector_alloc(N); int signum; size_t rank; gsl_matrix_memcpy(QRPT, m); for(i = 0; i < M; i++) gsl_vector_set(rhs, i, i + 1.0); s += gsl_linalg_QRPT_decomp(QRPT, tau, perm, &signum, work); rank = gsl_linalg_QRPT_rank(QRPT, -1.0); s += gsl_linalg_QRPT_lssolve2(QRPT, tau, perm, rhs, rank, x, res); if (M > N) { for (i = 0; i < N; i++) { int foo = check(gsl_vector_get(x, i), actual[i], eps); if(foo) { printf("(%3lu,%3lu)[%lu]: %22.18g %22.18g\n", M, N, i, gsl_vector_get(x, i), actual[i]); } s += foo; } } /* compute residual r = b - m x */ if (M == N) { gsl_vector_set_zero(r); } else { gsl_vector_memcpy(r, rhs); gsl_blas_dgemv(CblasNoTrans, -1.0, m, x, 1.0, r); } for (i = 0; i < N; i++) { int foo = check(gsl_vector_get(res, i), gsl_vector_get(r,i), sqrt(eps)); if(foo) { printf("(%3lu,%3lu)[%lu]: %22.18g %22.18g\n", M, N, i, gsl_vector_get(res, i), gsl_vector_get(r,i)); } s += foo; } gsl_vector_free(r); gsl_vector_free(res); gsl_vector_free(x); gsl_vector_free(tau); gsl_matrix_free(QRPT); gsl_vector_free(rhs); gsl_permutation_free(perm); gsl_vector_free(work); return s; } int test_QRPT_lssolve2(void) { int f; int s = 0; f = test_QRPT_lssolve2_dim(m53, m53_lssolution, 2 * 64.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_lssolve2 m(5,3)"); s += f; f = test_QRPT_lssolve2_dim(hilb2, hilb2_solution, 2 * 8.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_lssolve2 hilbert(2)"); s += f; f = test_QRPT_lssolve2_dim(hilb3, hilb3_solution, 2 * 64.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_lssolve2 hilbert(3)"); s += f; f = test_QRPT_lssolve2_dim(hilb4, hilb4_solution, 2 * 2048.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_lssolve2 hilbert(4)"); s += f; f = test_QRPT_lssolve2_dim(hilb12, hilb12_solution, 0.5); gsl_test(f, " QRPT_lssolve2 hilbert(12)"); s += f; f = test_QRPT_lssolve2_dim(vander2, vander2_solution, 8.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_lssolve2 vander(2)"); s += f; f = test_QRPT_lssolve2_dim(vander3, vander3_solution, 64.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_lssolve2 vander(3)"); s += f; f = test_QRPT_lssolve2_dim(vander4, vander4_solution, 1024.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_lssolve2 vander(4)"); s += f; f = test_QRPT_lssolve2_dim(vander12, vander12_solution, 0.05); gsl_test(f, " QRPT_lssolve2 vander(12)"); s += f; return s; } int test_QRPT_solve_dim(const gsl_matrix * m, const double * actual, double eps) { int s = 0; int signum; unsigned long i, dim = m->size1; gsl_permutation * perm = gsl_permutation_alloc(dim); gsl_vector * rhs = gsl_vector_alloc(dim); gsl_matrix * qr = gsl_matrix_alloc(dim,dim); gsl_vector * d = gsl_vector_alloc(dim); gsl_vector * x = gsl_vector_alloc(dim); gsl_vector * norm = gsl_vector_alloc(dim); gsl_matrix_memcpy(qr,m); for(i=0; isize1; gsl_permutation * perm = gsl_permutation_alloc(dim); gsl_vector * rhs = gsl_vector_alloc(dim); gsl_matrix * qr = gsl_matrix_alloc(dim,dim); gsl_matrix * q = gsl_matrix_alloc(dim,dim); gsl_matrix * r = gsl_matrix_alloc(dim,dim); gsl_vector * d = gsl_vector_alloc(dim); gsl_vector * x = gsl_vector_alloc(dim); gsl_vector * norm = gsl_vector_alloc(dim); gsl_matrix_memcpy(qr,m); for(i=0; isize1, N = m->size2; gsl_matrix * QR = gsl_matrix_alloc(M, N); gsl_matrix * A = gsl_matrix_alloc(M, N); gsl_matrix * Q = gsl_matrix_alloc(M, M); gsl_matrix * R = gsl_matrix_alloc(M, N); gsl_vector * tau = gsl_vector_alloc(GSL_MIN(M, N)); gsl_vector * norm = gsl_vector_alloc(N); gsl_permutation * perm = gsl_permutation_alloc(N); gsl_matrix_memcpy(QR, m); s += gsl_linalg_QRPT_decomp(QR, tau, perm, &signum, norm); s += gsl_linalg_QR_unpack(QR, tau, Q, R); /* compute A = Q R */ gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1.0, Q, R, 0.0, A); /* Compute QR P^T by permuting the elements of the rows of QR */ for (i = 0; i < M; i++) { gsl_vector_view row = gsl_matrix_row (A, i); gsl_permute_vector_inverse (perm, &row.vector); } for (i = 0; i < M; i++) { for (j = 0; j < N; j++) { double aij = gsl_matrix_get(A, i, j); double mij = gsl_matrix_get(m, i, j); int foo = check(aij, mij, eps); if(foo) printf("(%3lu,%3lu)[%lu,%lu]: %22.18g %22.18g\n", M, N, i,j, aij, mij); s += foo; } } if (expected_rcond > 0.0) { double rcond; int foo; gsl_vector * work = gsl_vector_alloc(3 * N); gsl_linalg_QRPT_rcond(QR, &rcond, work); foo = check(rcond, expected_rcond, 1.0e-10); if (foo) printf("QRPT_rcond (%3lu,%3lu): %22.18g %22.18g\n", M, N, rcond, expected_rcond); s += foo; gsl_vector_free(work); } gsl_permutation_free (perm); gsl_vector_free(norm); gsl_vector_free(tau); gsl_matrix_free(QR); gsl_matrix_free(A); gsl_matrix_free(Q); gsl_matrix_free(R); return s; } int test_QRPT_decomp(void) { int f; int s = 0; f = test_QRPT_decomp_dim(m35, -1.0, 2 * 8.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_decomp m(3,5)"); s += f; /* rcond value from LAPACK DTRCON */ f = test_QRPT_decomp_dim(m53, 2.915362697820e-03, 2 * 8.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_decomp m(5,3)"); s += f; f = test_QRPT_decomp_dim(s35, -1.0, 2 * 8.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_decomp s(3,5)"); s += f; f = test_QRPT_decomp_dim(s53, 1.002045825443827e-03, 2 * 8.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_decomp s(5,3)"); s += f; f = test_QRPT_decomp_dim(hilb2, 4.347826086956522e-02, 2 * 8.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_decomp hilbert(2)"); s += f; f = test_QRPT_decomp_dim(hilb3, 1.505488055305100e-03, 2 * 64.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_decomp hilbert(3)"); s += f; f = test_QRPT_decomp_dim(hilb4, 4.872100915910022e-05, 2 * 1024.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_decomp hilbert(4)"); s += f; f = test_QRPT_decomp_dim(hilb12, -1.0, 2 * 1024.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_decomp hilbert(12)"); s += f; f = test_QRPT_decomp_dim(vander2, 1.249999999999999e-01, 8.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_decomp vander(2)"); s += f; f = test_QRPT_decomp_dim(vander3, 9.708737864077667e-03, 64.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_decomp vander(3)"); s += f; f = test_QRPT_decomp_dim(vander4, 5.255631229339451e-04, 1024.0 * GSL_DBL_EPSILON); gsl_test(f, " QRPT_decomp vander(4)"); s += f; f = test_QRPT_decomp_dim(vander12, -1.0, 0.0005); /* FIXME: bad accuracy */ gsl_test(f, " QRPT_decomp vander(12)"); s += f; return s; } int test_QR_update_dim(const gsl_matrix * m, double eps) { int s = 0; unsigned long i,j,k, M = m->size1, N = m->size2; gsl_matrix * qr1 = gsl_matrix_alloc(M,N); gsl_matrix * qr2 = gsl_matrix_alloc(M,N); gsl_matrix * q1 = gsl_matrix_alloc(M,M); gsl_matrix * r1 = gsl_matrix_alloc(M,N); gsl_matrix * q2 = gsl_matrix_alloc(M,M); gsl_matrix * r2 = gsl_matrix_alloc(M,N); gsl_vector * d = gsl_vector_alloc(GSL_MIN(M,N)); gsl_vector * solution1 = gsl_vector_alloc(N); gsl_vector * solution2 = gsl_vector_alloc(N); gsl_vector * u = gsl_vector_alloc(M); gsl_vector * v = gsl_vector_alloc(N); gsl_vector * w = gsl_vector_alloc(M); gsl_matrix_memcpy(qr1,m); gsl_matrix_memcpy(qr2,m); for(i=0; isize1, N = m->size2; gsl_matrix * qr1 = gsl_matrix_alloc(M,N); gsl_matrix * qr2 = gsl_matrix_alloc(M,N); gsl_matrix * q1 = gsl_matrix_alloc(M,M); gsl_matrix * r1 = gsl_matrix_alloc(M,N); gsl_matrix * q2 = gsl_matrix_alloc(M,M); gsl_matrix * r2 = gsl_matrix_alloc(M,N); gsl_vector * d = gsl_vector_alloc(GSL_MIN(M,N)); gsl_vector * u = gsl_vector_alloc(M); gsl_vector * v = gsl_vector_alloc(N); gsl_vector * w = gsl_vector_alloc(M); gsl_vector * norm = gsl_vector_alloc(N); gsl_permutation * perm = gsl_permutation_alloc(N); gsl_matrix_memcpy(qr1,m); gsl_matrix_memcpy(qr2,m); for(i=0; isize1; gsl_vector * rhs = gsl_vector_alloc(dim); gsl_matrix * lq = gsl_matrix_alloc(dim,dim); gsl_vector * d = gsl_vector_alloc(dim); gsl_vector * x = gsl_vector_alloc(dim); gsl_matrix_transpose_memcpy(lq,m); for(i=0; isize1; gsl_vector * rhs = gsl_vector_alloc(dim); gsl_matrix * lq = gsl_matrix_alloc(dim,dim); gsl_matrix * q = gsl_matrix_alloc(dim,dim); gsl_matrix * l = gsl_matrix_alloc(dim,dim); gsl_vector * d = gsl_vector_alloc(dim); gsl_vector * x = gsl_vector_alloc(dim); gsl_matrix_transpose_memcpy(lq,m); for(i=0; isize1, N = m->size2; gsl_vector * rhs = gsl_vector_alloc(M); gsl_matrix * lq = gsl_matrix_alloc(N,M); gsl_vector * d = gsl_vector_alloc(N); gsl_vector * x = gsl_vector_alloc(N); gsl_vector * r = gsl_vector_alloc(M); gsl_vector * res = gsl_vector_alloc(M); gsl_matrix_transpose_memcpy(lq,m); for(i=0; isize1, N = m->size2; gsl_matrix * lq = gsl_matrix_alloc(M,N); gsl_matrix * a = gsl_matrix_alloc(M,N); gsl_matrix * q = gsl_matrix_alloc(N,N); gsl_matrix * l = gsl_matrix_alloc(M,N); gsl_vector * d = gsl_vector_alloc(GSL_MIN(M,N)); gsl_matrix_memcpy(lq,m); s += gsl_linalg_LQ_decomp(lq, d); s += gsl_linalg_LQ_unpack(lq, d, q, l); /* compute a = q r */ gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1.0, l, q, 0.0, a); for(i=0; isize1; gsl_permutation * perm = gsl_permutation_alloc(dim); gsl_vector * rhs = gsl_vector_alloc(dim); gsl_matrix * lq = gsl_matrix_alloc(dim,dim); gsl_vector * d = gsl_vector_alloc(dim); gsl_vector * x = gsl_vector_alloc(dim); gsl_vector * norm = gsl_vector_alloc(dim); gsl_matrix_transpose_memcpy(lq,m); for(i=0; isize1; gsl_permutation * perm = gsl_permutation_alloc(dim); gsl_vector * rhs = gsl_vector_alloc(dim); gsl_matrix * lq = gsl_matrix_alloc(dim,dim); gsl_matrix * q = gsl_matrix_alloc(dim,dim); gsl_matrix * l = gsl_matrix_alloc(dim,dim); gsl_vector * d = gsl_vector_alloc(dim); gsl_vector * x = gsl_vector_alloc(dim); gsl_vector * norm = gsl_vector_alloc(dim); gsl_matrix_transpose_memcpy(lq,m); for(i=0; isize1, N = m->size2; gsl_matrix * lq = gsl_matrix_alloc(N,M); gsl_matrix * a = gsl_matrix_alloc(N,M); gsl_matrix * q = gsl_matrix_alloc(M,M); gsl_matrix * l = gsl_matrix_alloc(N,M); gsl_vector * d = gsl_vector_alloc(GSL_MIN(M,N)); gsl_vector * norm = gsl_vector_alloc(N); gsl_permutation * perm = gsl_permutation_alloc(N); gsl_matrix_transpose_memcpy(lq,m); s += gsl_linalg_PTLQ_decomp(lq, d, perm, &signum, norm); s += gsl_linalg_LQ_unpack(lq, d, q, l); /* compute a = l q */ gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1.0, l, q, 0.0, a); /* Compute P LQ by permuting the rows of LQ */ for (i = 0; i < M; i++) { gsl_vector_view col = gsl_matrix_column (a, i); gsl_permute_vector_inverse (perm, &col.vector); } for(i=0; isize1, N = m->size2; gsl_matrix * lq1 = gsl_matrix_alloc(N,M); gsl_matrix * lq2 = gsl_matrix_alloc(N,M); gsl_matrix * q1 = gsl_matrix_alloc(M,M); gsl_matrix * l1 = gsl_matrix_alloc(N,M); gsl_matrix * q2 = gsl_matrix_alloc(M,M); gsl_matrix * l2 = gsl_matrix_alloc(N,M); gsl_vector * d2 = gsl_vector_alloc(GSL_MIN(M,N)); gsl_vector * u = gsl_vector_alloc(M); gsl_vector * v = gsl_vector_alloc(N); gsl_vector * w = gsl_vector_alloc(M); gsl_matrix_transpose_memcpy(lq1,m); gsl_matrix_transpose_memcpy(lq2,m); for(i=0; isize1; gsl_vector * rhs = gsl_vector_alloc(dim); gsl_matrix * u = gsl_matrix_alloc(dim,dim); gsl_matrix * q = gsl_matrix_alloc(dim,dim); gsl_vector * d = gsl_vector_alloc(dim); gsl_vector * x = gsl_vector_calloc(dim); gsl_matrix_memcpy(u,m); for(i=0; isize1, N = m->size2; unsigned long input_nans = 0; gsl_matrix * v = gsl_matrix_alloc(M,N); gsl_matrix * a = gsl_matrix_alloc(M,N); gsl_matrix * q = gsl_matrix_alloc(N,N); gsl_matrix * dqt = gsl_matrix_alloc(N,N); gsl_vector * d = gsl_vector_alloc(N); gsl_vector * w = gsl_vector_alloc(N); gsl_matrix_memcpy(v,m); /* Check for nans in the input */ for (i = 0; i 0) continue; /* skip NaNs if present in input */ else { s++; printf("bad singular value %lu = %22.18g\n", i, di); } } if (di < 0) { s++; printf("singular value %lu = %22.18g < 0\n", i, di); } if(i > 0 && di > di1) { s++; printf("singular value %lu = %22.18g vs previous %22.18g\n", i, di, di1); } di1 = di; } /* Scale dqt = D Q^T */ for (i = 0; i < N ; i++) { double di = gsl_vector_get (d, i); for (j = 0; j < N; j++) { double qji = gsl_matrix_get(q, j, i); gsl_matrix_set (dqt, i, j, qji * di); } } /* compute a = v dqt */ gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1.0, v, dqt, 0.0, a); for(i=0; idata; for (i=0; i<9; i++) { a[i] = lower; } while (carry == 0.0) { f = test_SV_decomp_dim(A33, 64 * GSL_DBL_EPSILON); gsl_test(f, " SV_decomp (3x3) A=[ %g, %g, %g; %g, %g, %g; %g, %g, %g]", a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8]); /* increment */ carry=1.0; for (i=9; carry > 0.0 && i>0 && i--;) { double v=a[i]+carry; carry = (v>upper) ? 1.0 : 0.0; a[i] = (v>upper) ? lower : v; } } } #ifdef TEST_SVD_4X4 { int i; double carry = 0, lower = 0, upper = 1; double *a = A44->data; for (i=0; i<16; i++) { a[i] = lower; } while (carry == 0.0) { f = test_SV_decomp_dim(A44, 64 * GSL_DBL_EPSILON); gsl_test(f, " SV_decomp (4x4) A=[ %g, %g, %g, %g; %g, %g, %g, %g; %g, %g, %g, %g; %g, %g, %g, %g]", a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9], a[10], a[11], a[12], a[13], a[14], a[15]); /* increment */ carry=1.0; for (i=16; carry > 0.0 && i>0 && i--;) { double v=a[i]+carry; carry = (v>upper) ? 1.0 : 0.0; a[i] = (v>upper) ? lower : v; } } } #endif return s; } int test_SV_decomp_mod_dim(const gsl_matrix * m, double eps) { int s = 0; double di1; unsigned long i,j, M = m->size1, N = m->size2; gsl_matrix * v = gsl_matrix_alloc(M,N); gsl_matrix * a = gsl_matrix_alloc(M,N); gsl_matrix * q = gsl_matrix_alloc(N,N); gsl_matrix * x = gsl_matrix_alloc(N,N); gsl_matrix * dqt = gsl_matrix_alloc(N,N); gsl_vector * d = gsl_vector_alloc(N); gsl_vector * w = gsl_vector_alloc(N); gsl_matrix_memcpy(v,m); s += gsl_linalg_SV_decomp_mod(v, x, q, d, w); /* Check that singular values are non-negative and in non-decreasing order */ di1 = 0.0; for (i = 0; i < N; i++) { double di = gsl_vector_get (d, i); if (gsl_isnan (di)) { continue; /* skip NaNs */ } if (di < 0) { s++; printf("singular value %lu = %22.18g < 0\n", i, di); } if(i > 0 && di > di1) { s++; printf("singular value %lu = %22.18g vs previous %22.18g\n", i, di, di1); } di1 = di; } /* Scale dqt = D Q^T */ for (i = 0; i < N ; i++) { double di = gsl_vector_get (d, i); for (j = 0; j < N; j++) { double qji = gsl_matrix_get(q, j, i); gsl_matrix_set (dqt, i, j, qji * di); } } /* compute a = v dqt */ gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1.0, v, dqt, 0.0, a); for(i=0; idata; for (i=0; i<9; i++) { a[i] = lower; } while (carry == 0.0) { f = test_SV_decomp_mod_dim(A33, 64 * GSL_DBL_EPSILON); gsl_test(f, " SV_decomp_mod (3x3) A=[ %g, %g, %g; %g, %g, %g; %g, %g, %g]", a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8]); /* increment */ carry=1.0; for (i=9; carry > 0.0 && i>0 && i--;) { double v=a[i]+carry; carry = (v>upper) ? 1.0 : 0.0; a[i] = (v>upper) ? lower : v; } } } #ifdef TEST_SVD_4X4 { int i; double carry = 0, lower = 0, upper = 1; double *a = A44->data; for (i=0; i<16; i++) { a[i] = lower; } while (carry == 0.0) { f = test_SV_decomp_mod_dim(A44, 64 * GSL_DBL_EPSILON); gsl_test(f, " SV_decomp_mod (4x4) A=[ %g, %g, %g, %g; %g, %g, %g, %g; %g, %g, %g, %g; %g, %g, %g, %g]", a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9], a[10], a[11], a[12], a[13], a[14], a[15]); /* increment */ carry=1.0; for (i=16; carry>0.0 && i>0 && i--;) { double v=a[i]+carry; carry = (v>upper) ? 1.0 : 0.0; a[i] = (v>upper) ? lower : v; } } } #endif return s; } int test_SV_decomp_jacobi_dim(const gsl_matrix * m, double eps) { int s = 0; double di1; unsigned long i,j, M = m->size1, N = m->size2; gsl_matrix * v = gsl_matrix_alloc(M,N); gsl_matrix * a = gsl_matrix_alloc(M,N); gsl_matrix * q = gsl_matrix_alloc(N,N); gsl_matrix * dqt = gsl_matrix_alloc(N,N); gsl_vector * d = gsl_vector_alloc(N); gsl_matrix_memcpy(v,m); s += gsl_linalg_SV_decomp_jacobi(v, q, d); if (s) printf("call returned status = %d\n", s); /* Check that singular values are non-negative and in non-decreasing order */ di1 = 0.0; for (i = 0; i < N; i++) { double di = gsl_vector_get (d, i); if (gsl_isnan (di)) { continue; /* skip NaNs */ } if (di < 0) { s++; printf("singular value %lu = %22.18g < 0\n", i, di); } if(i > 0 && di > di1) { s++; printf("singular value %lu = %22.18g vs previous %22.18g\n", i, di, di1); } di1 = di; } /* Scale dqt = D Q^T */ for (i = 0; i < N ; i++) { double di = gsl_vector_get (d, i); for (j = 0; j < N; j++) { double qji = gsl_matrix_get(q, j, i); gsl_matrix_set (dqt, i, j, qji * di); } } /* compute a = v dqt */ gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1.0, v, dqt, 0.0, a); for(i=0; idata; for (i=0; i<9; i++) { a[i] = lower; } while (carry == 0.0) { f = test_SV_decomp_jacobi_dim(A33, 64 * GSL_DBL_EPSILON); gsl_test(f, " SV_decomp_jacobi (3x3) A=[ %g, %g, %g; %g, %g, %g; %g, %g, %g]", a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8]); /* increment */ carry=1.0; for (i=9; carry > 0.0 && i>0 && i--;) { double v=a[i]+carry; carry = (v>upper) ? 1.0 : 0.0; a[i] = (v>upper) ? lower : v; } } } #ifdef TEST_SVD_4X4 { int i; unsigned long k = 0; double carry = 0, lower = 0, upper = 1; double *a = A44->data; for (i=0; i<16; i++) { a[i] = lower; } while (carry == 0.0) { k++; f = test_SV_decomp_jacobi_dim(A44, 64 * GSL_DBL_EPSILON); gsl_test(f, " SV_decomp_jacobi (4x4) A=[ %g, %g, %g, %g; %g, %g, %g, %g; %g, %g, %g, %g; %g, %g, %g, %g] %lu", a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9], a[10], a[11], a[12], a[13], a[14], a[15], k); /* increment */ carry=1.0; for (i=16; carry > 0.0 && i>0 && i--;) { double v=a[i]+carry; carry = (v>upper) ? 1.0 : 0.0; a[i] = (v>upper) ? lower : v; } } } #endif { int i; unsigned long k = 0; double carry = 0, lower = 0, upper = 1; double *a = A55->data; for (i=0; i<25; i++) { a[i] = lower; } while (carry == 0.0) { k++; if (k % 1001 == 0) { f = test_SV_decomp_jacobi_dim(A55, 64 * GSL_DBL_EPSILON); gsl_test(f, " SV_decomp_jacobi (5x5) case=%lu",k); } /* increment */ carry=1.0; for (i=25; carry >0.0 && i>0 && i--;) { double v=a[i]+carry; carry = (v>upper) ? 1.0 : 0.0; a[i] = (v>upper) ? lower : v; } } } return s; } int test_cholesky_solve_dim(const gsl_matrix * m, const double * actual, double eps) { int s = 0; unsigned long i, dim = m->size1; gsl_vector * rhs = gsl_vector_alloc(dim); gsl_matrix * u = gsl_matrix_alloc(dim,dim); gsl_vector * x = gsl_vector_calloc(dim); gsl_matrix_memcpy(u,m); for(i=0; isize1; gsl_vector * rhs = gsl_vector_alloc(dim); gsl_matrix * u = gsl_matrix_alloc(dim,dim); gsl_vector * x = gsl_vector_calloc(dim); gsl_vector * D = gsl_vector_calloc(dim); gsl_matrix_memcpy(u,m); for(i=0; isize1; const unsigned long N = m->size2; unsigned long i,j; gsl_matrix * v = gsl_matrix_alloc(M,N); gsl_matrix * a = gsl_matrix_alloc(M,N); gsl_matrix * l = gsl_matrix_alloc(M,N); gsl_matrix * lt = gsl_matrix_alloc(N,N); gsl_matrix * dm = gsl_matrix_alloc(M,N); gsl_vector * dv = gsl_vector_alloc(M); gsl_matrix_memcpy(v,m); s += gsl_linalg_cholesky_decomp_unit(v, dv); /* for(i = 0; i < M; i++) { for(j = 0; j < N; j++) { printf("v[%lu,%lu]: %22.18e\n", i,j, gsl_matrix_get(v, i, j)); } } for(i = 0; i < M; i++) { printf("d[%lu]: %22.18e\n", i, gsl_vector_get(dv, i)); } */ /* put L and transpose(L) into separate matrices */ for(i = 0; i < N ; i++) { for(j = 0; j < N; j++) { const double vij = gsl_matrix_get(v, i, j); gsl_matrix_set (l, i, j, i>=j ? vij : 0); gsl_matrix_set (lt, i, j, i<=j ? vij : 0); } } /* put D into its own matrix */ gsl_matrix_set_zero(dm); for(i = 0; i < M; ++i) gsl_matrix_set(dm, i, i, gsl_vector_get(dv, i)); /* compute a = L * D * transpose(L); uses v for temp space */ gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1.0, dm, lt, 0.0, v); gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1.0, l, v, 0.0, a); for(i = 0; i < M; i++) { for(j = 0; j < N; j++) { const double aij = gsl_matrix_get(a, i, j); const double mij = gsl_matrix_get(m, i, j); int foo = check(aij, mij, eps); if(foo) { printf("(%3lu,%3lu)[%lu,%lu]: %22.18g %22.18g\n", M, N, i,j, aij, mij); } s += foo; } } gsl_vector_free(dv); gsl_matrix_free(dm); gsl_matrix_free(lt); gsl_matrix_free(l); gsl_matrix_free(v); gsl_matrix_free(a); return s; } int test_cholesky_decomp_unit(void) { int f; int s = 0; f = test_cholesky_decomp_unit_dim(hilb2, 2 * 8.0 * GSL_DBL_EPSILON); gsl_test(f, " cholesky_decomp_unit hilbert(2)"); s += f; f = test_cholesky_decomp_unit_dim(hilb3, 2 * 64.0 * GSL_DBL_EPSILON); gsl_test(f, " cholesky_decomp_unit hilbert(3)"); s += f; f = test_cholesky_decomp_unit_dim(hilb4, 2 * 1024.0 * GSL_DBL_EPSILON); gsl_test(f, " cholesky_decomp_unit hilbert(4)"); s += f; f = test_cholesky_decomp_unit_dim(hilb12, 2 * 1024.0 * GSL_DBL_EPSILON); gsl_test(f, " cholesky_decomp_unit hilbert(12)"); s += f; return s; } int test_choleskyc_solve_dim(const gsl_matrix_complex * m, const gsl_vector_complex * actual, double eps) { int s = 0; unsigned long i, dim = m->size1; gsl_complex z; gsl_vector_complex * rhs = gsl_vector_complex_alloc(dim); gsl_matrix_complex * u = gsl_matrix_complex_alloc(dim,dim); gsl_vector_complex * x = gsl_vector_complex_calloc(dim); GSL_SET_IMAG(&z, 0.0); gsl_matrix_complex_memcpy(u,m); for(i=0; isize1, N = m->size2; gsl_matrix_complex * v = gsl_matrix_complex_alloc(M,N); gsl_matrix_complex * a = gsl_matrix_complex_alloc(M,N); gsl_matrix_complex * l = gsl_matrix_complex_alloc(M,N); gsl_matrix_complex * lh = gsl_matrix_complex_alloc(N,N); gsl_matrix_complex_memcpy(v, m); gsl_matrix_complex_set_zero(l); gsl_matrix_complex_set_zero(lh); s += gsl_linalg_complex_cholesky_decomp(v); /* Compute L L^H */ for (i = 0; i < N ; i++) { for (j = 0; j <= i; j++) { gsl_complex vij = gsl_matrix_complex_get(v, i, j); gsl_matrix_complex_set (l, i, j, vij); gsl_matrix_complex_set (lh, j, i, gsl_complex_conjugate(vij)); } } /* compute a = l lh */ gsl_blas_zgemm (CblasNoTrans, CblasNoTrans, GSL_COMPLEX_ONE, l, lh, GSL_COMPLEX_ZERO, a); for(i=0; isize1; gsl_complex af, bt; gsl_matrix_complex * v = gsl_matrix_complex_alloc(N, N); gsl_matrix_complex * c = gsl_matrix_complex_alloc(N, N); gsl_matrix_complex_memcpy(v, m); s += gsl_linalg_complex_cholesky_decomp(v); s += gsl_linalg_complex_cholesky_invert(v); GSL_SET_COMPLEX(&af, 1.0, 0.0); GSL_SET_COMPLEX(&bt, 0.0, 0.0); gsl_blas_zhemm(CblasLeft, CblasUpper, af, m, v, bt, c); /* c should be the identity matrix */ for (i = 0; i < N; ++i) { for (j = 0; j < N; ++j) { int foo; gsl_complex cij = gsl_matrix_complex_get(c, i, j); double expected, actual; /* check real part */ if (i == j) expected = 1.0; else expected = 0.0; actual = GSL_REAL(cij); foo = check(actual, expected, eps); if (foo) printf("REAL(%3lu,%3lu)[%lu,%lu]: %22.18g %22.18g\n", N, N, i,j, actual, expected); s += foo; /* check imaginary part */ expected = 0.0; actual = GSL_IMAG(cij); foo = check(actual, expected, eps); if (foo) printf("IMAG(%3lu,%3lu)[%lu,%lu]: %22.18g %22.18g\n", N, N, i,j, actual, expected); s += foo; } } gsl_matrix_complex_free(v); gsl_matrix_complex_free(c); return s; } int test_choleskyc_invert(void) { int f; int s = 0; double dat2[] = { 92.303, 0.000, 10.858, 1.798, 10.858, -1.798, 89.027, 0.000 }; double dat3[] = { 59.75,0, 49.25,172.25, 66.75,-162.75, 49.25,-172.25, 555.5,0, -429,-333.5, 66.75,162.75, -429,333.5, 536.5,0 }; double dat4[] = { 102.108, 0.000, 14.721, 1.343, -17.480, 15.591, 3.308, -2.936, 14.721, -1.343, 101.970, 0.000, 11.671, -6.776, -5.009, -2.665, -17.480, -15.591, 11.671, 6.776, 105.071, 0.000, 3.396, 6.276, 3.308, 2.936, -5.009, 2.665, 3.396, -6.276, 107.128, 0.000 }; { gsl_matrix_complex_view rv2 = gsl_matrix_complex_view_array(dat2, 2, 2); f = test_choleskyc_invert_dim(&rv2.matrix, 2 * 8.0 * GSL_DBL_EPSILON); gsl_test(f, " choleskyc_invert 2x2 Hermitian"); s += f; } { gsl_matrix_complex_view rv3 = gsl_matrix_complex_view_array(dat3, 3, 3); f = test_choleskyc_invert_dim(&rv3.matrix, 2 * 1024.0 * GSL_DBL_EPSILON); gsl_test(f, " choleskyc_invert 3x3 Hermitian"); s += f; } { gsl_matrix_complex_view rv4 = gsl_matrix_complex_view_array(dat4, 4, 4); f = test_choleskyc_invert_dim(&rv4.matrix, 2 * 64.0 * GSL_DBL_EPSILON); gsl_test(f, " choleskyc_invert 4x4 Hermitian"); s += f; } return s; } int test_HH_solve_dim(const gsl_matrix * m, const double * actual, double eps) { int s = 0; unsigned long i, dim = m->size1; gsl_permutation * perm = gsl_permutation_alloc(dim); gsl_matrix * hh = gsl_matrix_alloc(dim,dim); gsl_vector * d = gsl_vector_alloc(dim); gsl_vector * x = gsl_vector_alloc(dim); gsl_matrix_memcpy(hh,m); for(i=0; isize1, N = m->size2; gsl_matrix * A = gsl_matrix_alloc(M,N); gsl_matrix * a = gsl_matrix_alloc(M,N); gsl_matrix * b = gsl_matrix_alloc(N,N); gsl_matrix * u = gsl_matrix_alloc(M,N); gsl_matrix * v = gsl_matrix_alloc(N,N); gsl_vector * tau1 = gsl_vector_alloc(N); gsl_vector * tau2 = gsl_vector_alloc(N-1); gsl_vector * d = gsl_vector_alloc(N); gsl_vector * sd = gsl_vector_alloc(N-1); gsl_matrix_memcpy(A,m); s += gsl_linalg_bidiag_decomp(A, tau1, tau2); s += gsl_linalg_bidiag_unpack(A, tau1, u, tau2, v, d, sd); gsl_matrix_set_zero(b); for (i = 0; i < N; i++) gsl_matrix_set(b, i,i, gsl_vector_get(d,i)); for (i = 0; i < N-1; i++) gsl_matrix_set(b, i,i+1, gsl_vector_get(sd,i)); /* Compute A = U B V^T */ for (i = 0; i < M ; i++) { for (j = 0; j < N; j++) { double sum = 0; for (k = 0; k < N; k++) { for (r = 0; r < N; r++) { sum += gsl_matrix_get(u, i, k) * gsl_matrix_get (b, k, r) * gsl_matrix_get(v, j, r); } } gsl_matrix_set (a, i, j, sum); } } for(i=0; i