a68g-torrix.h
1 //! @file a68g-torrix.h
2 //! @author J. Marcel van der Veer
3
4 //! @section Copyright
5 //!
6 //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
7 //! Copyright 2001-2024 J. Marcel van der Veer [algol68g@xs4all.nl].
8
9 //! @section License
10 //!
11 //! This program is free software; you can redistribute it and/or modify it
12 //! under the terms of the GNU General Public License as published by the
13 //! Free Software Foundation; either version 3 of the License, or
14 //! (at your option) any later version.
15 //!
16 //! This program is distributed in the hope that it will be useful, but
17 //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
19 //! more details. You should have received a copy of the GNU General Public
20 //! License along with this program. If not, see [http://www.gnu.org/licenses/].
21
22 //! @section Synopsis
23 //!
24 //! REAL vector and matrix support.
25
26 #if ! defined (__A68G_TORRIX_H__)
27 #define __A68G_TORRIX_H__
28
29 #include "a68g-genie.h"
30 #include "a68g-prelude.h"
31
32 #if defined (HAVE_GSL)
33
34 #define NO_REAL_MATRIX ((gsl_matrix *) NULL)
35 #define NO_REF_MATRIX ((gsl_matrix **) NULL)
36 #define NO_REAL_VECTOR ((gsl_vector *) NULL)
37 #define NO_REF_VECTOR ((gsl_vector **) NULL)
38
39 #define ASSERT_GSL(f) {\
40 int _rc_ = (f);\
41 if (_rc_ != 0) {\
42 BUFFER txt;\
43 ASSERT (a68_bufprt (txt, SNPRINTF_SIZE, "%s: %d: math error", __FILE__, __LINE__) >= 0);\
44 torrix_error_handler (txt, "", 0, _rc_);\
45 }}
46
47 A68_ROW matrix_to_row (NODE_T *, gsl_matrix *);
48 A68_ROW vector_to_row (NODE_T *, gsl_vector *);
49 gsl_matrix_complex *pop_matrix_complex (NODE_T *, BOOL_T);
50 gsl_matrix *compute_pca_cv (NODE_T *, gsl_vector **, gsl_matrix *);
51 gsl_matrix *compute_pca_svd (NODE_T *, gsl_vector **, gsl_matrix *);
52 gsl_matrix *compute_pca_svd_pad (NODE_T *, gsl_vector **, gsl_matrix *);
53 gsl_matrix *matrix_hcat (NODE_T *, gsl_matrix *, gsl_matrix *);
54 gsl_matrix *matrix_vcat (NODE_T *, gsl_matrix *, gsl_matrix *);
55 gsl_matrix *pop_matrix (NODE_T *, BOOL_T);
56 gsl_permutation *pop_permutation (NODE_T *, BOOL_T);
57 gsl_vector_complex *pop_vector_complex (NODE_T *, BOOL_T);
58 gsl_vector *pop_vector (NODE_T *, BOOL_T);
59 REAL_T matrix_norm (gsl_matrix *);
60 void compute_pseudo_inverse (NODE_T *, gsl_matrix **, gsl_matrix *, REAL_T);
61 void print_matrix (gsl_matrix *, unt);
62 void print_vector (gsl_vector *, unt);
63 void push_matrix_complex (NODE_T *, gsl_matrix_complex *);
64 void push_matrix (NODE_T *, gsl_matrix *);
65 void push_permutation (NODE_T *, gsl_permutation *);
66 void push_vector_complex (NODE_T *, gsl_vector_complex *);
67 void push_vector (NODE_T *, gsl_vector *);
68 void torrix_error_handler (const char *, const char *, int, int);
69 void torrix_test_error (int);
70
71 // BLAS support
72
73 #define FLIP ((CBLAS_TRANSPOSE_t) CblasTrans)
74 #define SELF ((CBLAS_TRANSPOSE_t) CblasNoTrans)
75
76 void a68_vector_free (gsl_vector *);
77 void a68_matrix_free (gsl_matrix *);
78 void a68_dgemm (CBLAS_TRANSPOSE_t, CBLAS_TRANSPOSE_t, double, gsl_matrix *, gsl_matrix *, double, gsl_matrix **);
79 gsl_matrix *mat_before_ab (NODE_T *, gsl_matrix *, gsl_matrix *);
80 gsl_matrix *mat_over_ab (NODE_T *, gsl_matrix *, gsl_matrix *);
81
82 #endif
83
84 #endif
© 2002-2024 J.M. van der Veer (jmvdveer@xs4all.nl)
|