Algol 68 Genie

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-2026 J. Marcel van der Veer [algol68g@algol68genie.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_ != GSL_SUCCESS) {\
  42        BUFFER txt;\
  43        ASSERT (a68g_bufprt (txt, SNPRINTF_SIZE, "%s: %d: math error", __FILE__, __LINE__) >= 0);\
  44        torrix_error_handler (txt, "", 0, _rc_);\
  45      }}
  46    
  47    A68G_ROW matrix_to_row (NODE_T *, gsl_matrix *);
  48    A68G_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 a68g_vector_free (gsl_vector *);
  77    void a68g_matrix_free (gsl_matrix *);
  78    void a68g_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