/* 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_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_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_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); /* ensure diagonally dominant matrix */ if (i == j) { if (Diag == CblasUnit) mij = 1.0; else mij += 10.0; } else if (Diag == CblasUnit) mij *= 0.01; if (Uplo == CblasLower) gsl_matrix_set(m, i, j, mij); else gsl_matrix_set(m, j, i, mij); } } 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_common.c" #include "test_cholesky.c" #include "test_choleskyc.c" #include "test_cod.c" #include "test_ldlt.c" #include "test_lu.c" #include "test_luc.c" #include "test_lu_band.c" #include "test_lq.c" #include "test_tri.c" #include "test_ql.c" #include "test_qr.c" #include "test_qrc.c" #include "test_qr_band.c" int test_QR_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 * 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_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(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 * 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; 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