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