2008-02-26 14:55:23 +01:00
/*
LA : linear algebra C + + interface library
Copyright ( C ) 2008 Jiri Pittner < jiri . pittner @ jh - inst . cas . cz > or < jiri @ pittnerovi . com >
complex versions written by Roman Curik < roman . curik @ jh - inst . cas . cz >
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 , see < http : //www.gnu.org/licenses/>.
*/
2009-11-12 22:01:19 +01:00
2004-03-17 04:07:21 +01:00
# include <iostream>
2005-02-14 01:10:07 +01:00
# include <stdlib.h>
# include <sys/types.h>
# include <sys/stat.h>
# include <fcntl.h>
2005-11-20 14:46:00 +01:00
# include <errno.h>
2009-11-12 22:01:19 +01:00
# include "vec.h"
2006-04-01 06:48:01 +02:00
# include "qsort.h"
2005-02-14 01:10:07 +01:00
extern " C " {
extern ssize_t read ( int , void * , size_t ) ;
extern ssize_t write ( int , const void * , size_t ) ;
}
2009-11-12 22:01:19 +01:00
namespace LA {
2004-03-17 04:07:21 +01:00
//////////////////////////////////////////////////////////////////////////////
//// forced instantization in the corespoding object file
# define INSTANTIZE(T) \
2005-09-11 22:04:24 +02:00
template void NRVec < T > : : put ( int fd , bool dim , bool transp ) const ; \
template void NRVec < T > : : get ( int fd , bool dim , bool transp ) ; \
2005-02-18 23:08:15 +01:00
2004-03-17 04:07:21 +01:00
INSTANTIZE ( double )
INSTANTIZE ( complex < double > )
2004-03-17 06:34:59 +01:00
INSTANTIZE ( char )
2009-11-12 22:01:19 +01:00
INSTANTIZE ( short )
INSTANTIZE ( int )
INSTANTIZE ( long )
INSTANTIZE ( long long )
2005-02-14 01:10:07 +01:00
INSTANTIZE ( unsigned char )
2009-11-12 22:01:19 +01:00
INSTANTIZE ( unsigned short )
2006-09-10 22:06:44 +02:00
INSTANTIZE ( unsigned int )
2006-04-01 06:48:01 +02:00
INSTANTIZE ( unsigned long )
2009-11-12 22:01:19 +01:00
INSTANTIZE ( unsigned long long )
2006-04-01 06:48:01 +02:00
2005-02-18 23:08:15 +01:00
2004-03-17 04:07:21 +01:00
/*
* Templates first , specializations for BLAS next
*/
// conversion ctor
# ifndef MATPTR
template < typename T >
NRVec < T > : : NRVec ( const NRMat < T > & rhs )
{
nn = rhs . nn * rhs . mm ;
v = rhs . v ;
count = rhs . count ;
( * count ) + + ;
}
# endif
2005-02-14 01:10:07 +01:00
//raw I/O
template < typename T >
2005-09-11 22:04:24 +02:00
void NRVec < T > : : put ( int fd , bool dim , bool transp ) const
2005-02-14 01:10:07 +01:00
{
errno = 0 ;
int pad = 1 ; //align at least 8-byte
if ( dim )
{
if ( sizeof ( int ) ! = write ( fd , & nn , sizeof ( int ) ) ) laerror ( " cannot write " ) ;
if ( sizeof ( int ) ! = write ( fd , & pad , sizeof ( int ) ) ) laerror ( " cannot write " ) ;
}
LA_traits < T > : : multiput ( nn , fd , v , dim ) ;
}
template < typename T >
2005-09-11 22:04:24 +02:00
void NRVec < T > : : get ( int fd , bool dim , bool transp )
2005-02-14 01:10:07 +01:00
{
int nn0 [ 2 ] ; //align at least 8-byte
errno = 0 ;
if ( dim )
{
if ( 2 * sizeof ( int ) ! = read ( fd , & nn0 , 2 * sizeof ( int ) ) ) laerror ( " cannot read " ) ;
resize ( nn0 [ 0 ] ) ;
}
else
copyonwrite ( ) ;
LA_traits < T > : : multiget ( nn , fd , v , dim ) ;
}
2004-03-17 04:07:21 +01:00
// formatted print for NRVec
template < typename T >
void NRVec < T > : : fprintf ( FILE * file , const char * format , const int modulo ) const
{
lawritemat ( file , v , 1 , nn , format , 1 , modulo , 0 ) ;
}
// formatted scan for NRVec
2005-02-14 01:10:07 +01:00
template < typename T >
2004-03-17 04:07:21 +01:00
void NRVec < T > : : fscanf ( FILE * f , const char * format )
{
int n ;
if ( std : : fscanf ( f , " %d " , & n ) ! = 1 ) laerror ( " cannot read vector dimension " ) ;
resize ( n ) ;
for ( int i = 0 ; i < n ; i + + )
if ( std : : fscanf ( f , format , v + i ) ! = 1 )
laerror ( " cannot read the vector eleemnt " ) ;
}
// unary minus
template < typename T >
const NRVec < T > NRVec < T > : : operator - ( ) const
{
NRVec < T > result ( nn ) ;
for ( int i = 0 ; i < nn ; i + + ) result . v [ i ] = - v [ i ] ;
return result ;
}
2005-09-06 17:55:07 +02:00
//comparison operators (for lexical order)
template < typename T >
const bool NRVec < T > : : operator > ( const NRVec & rhs ) const
{
int n = nn ; if ( rhs . nn < n ) n = rhs . nn ;
for ( int i = 0 ; i < n ; + + i )
{
if ( LA_traits < T > : : bigger ( v [ i ] , rhs . v [ i ] ) ) return true ;
if ( LA_traits < T > : : smaller ( v [ i ] , rhs . v [ i ] ) ) return false ;
}
return nn > rhs . nn ;
}
template < typename T >
const bool NRVec < T > : : operator < ( const NRVec & rhs ) const
{
int n = nn ; if ( rhs . nn < n ) n = rhs . nn ;
for ( int i = 0 ; i < n ; + + i )
{
if ( LA_traits < T > : : smaller ( v [ i ] , rhs . v [ i ] ) ) return true ;
if ( LA_traits < T > : : bigger ( v [ i ] , rhs . v [ i ] ) ) return false ;
}
return nn < rhs . nn ;
}
2008-03-03 16:35:37 +01:00
template < >
void NRVec < double > : : randomize ( const double & x )
{
for ( int i = 0 ; i < nn ; + + i ) v [ i ] = x * ( 2. * random ( ) / ( 1. + RAND_MAX ) - 1. ) ;
}
2009-10-08 16:01:15 +02:00
template < >
void NRVec < complex < double > > : : randomize ( const double & x )
{
for ( int i = 0 ; i < nn ; + + i ) v [ i ] = complex < double > ( x * ( 2. * random ( ) / ( 1. + RAND_MAX ) - 1. ) , x * ( 2. * random ( ) / ( 1. + RAND_MAX ) - 1. ) ) ;
}
//complex from real constructor
template < >
NRVec < complex < double > > : : NRVec ( const NRVec < double > & rhs , bool imagpart )
: nn ( rhs . size ( ) ) , v ( new complex < double > [ rhs . size ( ) ] ) , count ( new int ( 1 ) )
{
memset ( v , 0 , nn * sizeof ( complex < double > ) ) ;
cblas_dcopy ( nn , & rhs [ 0 ] , 1 , ( ( double * ) v ) + ( imagpart ? 1 : 0 ) , 2 ) ;
}
2005-09-06 17:55:07 +02:00
2004-03-17 04:07:21 +01:00
// axpy call for T = double (not strided)
2005-11-20 14:46:00 +01:00
template < >
2004-03-17 04:07:21 +01:00
void NRVec < double > : : axpy ( const double alpha , const NRVec < double > & x )
{
# ifdef DEBUG
if ( nn ! = x . nn ) laerror ( " axpy of incompatible vectors " ) ;
# endif
copyonwrite ( ) ;
cblas_daxpy ( nn , alpha , x . v , 1 , v , 1 ) ;
}
// axpy call for T = complex<double> (not strided)
2005-11-20 14:46:00 +01:00
template < >
2004-03-17 04:07:21 +01:00
void NRVec < complex < double > > : : axpy ( const complex < double > alpha ,
const NRVec < complex < double > > & x )
{
# ifdef DEBUG
if ( nn ! = x . nn ) laerror ( " axpy of incompatible vectors " ) ;
# endif
copyonwrite ( ) ;
2009-11-12 22:01:19 +01:00
cblas_zaxpy ( nn , & alpha , x . v , 1 , v , 1 ) ;
2004-03-17 04:07:21 +01:00
}
// axpy call for T = double (strided)
2005-11-20 14:46:00 +01:00
template < >
2004-03-17 04:07:21 +01:00
void NRVec < double > : : axpy ( const double alpha , const double * x , const int stride )
{
copyonwrite ( ) ;
cblas_daxpy ( nn , alpha , x , stride , v , 1 ) ;
}
// axpy call for T = complex<double> (strided)
2005-11-20 14:46:00 +01:00
template < >
2004-03-17 04:07:21 +01:00
void NRVec < complex < double > > : : axpy ( const complex < double > alpha ,
const complex < double > * x , const int stride )
{
copyonwrite ( ) ;
2009-11-12 22:01:19 +01:00
cblas_zaxpy ( nn , & alpha , x , stride , v , 1 ) ;
2004-03-17 04:07:21 +01:00
}
// unary minus
2005-11-20 14:46:00 +01:00
template < >
2004-03-17 04:07:21 +01:00
const NRVec < double > NRVec < double > : : operator - ( ) const
{
NRVec < double > result ( * this ) ;
result . copyonwrite ( ) ;
cblas_dscal ( nn , - 1.0 , result . v , 1 ) ;
return result ;
}
2005-11-20 14:46:00 +01:00
template < >
2004-03-17 04:07:21 +01:00
const NRVec < complex < double > >
NRVec < complex < double > > : : operator - ( ) const
{
NRVec < complex < double > > result ( * this ) ;
result . copyonwrite ( ) ;
2009-11-12 22:01:19 +01:00
cblas_zdscal ( nn , - 1.0 , result . v , 1 ) ;
2004-03-17 04:07:21 +01:00
return result ;
}
// assignment of scalar to every element
template < typename T >
NRVec < T > & NRVec < T > : : operator = ( const T & a )
{
copyonwrite ( ) ;
if ( a ! = ( T ) 0 )
for ( int i = 0 ; i < nn ; i + + ) v [ i ] = a ;
else
memset ( v , 0 , nn * sizeof ( T ) ) ;
return * this ;
}
// Normalization of NRVec<double>
2005-11-20 14:46:00 +01:00
template < >
2004-03-17 04:07:21 +01:00
NRVec < double > & NRVec < double > : : normalize ( )
{
double tmp ;
tmp = cblas_dnrm2 ( nn , v , 1 ) ;
# ifdef DEBUG
if ( ! tmp ) laerror ( " normalization of zero vector " ) ;
# endif
copyonwrite ( ) ;
tmp = 1.0 / tmp ;
cblas_dscal ( nn , tmp , v , 1 ) ;
return * this ;
}
// Normalization of NRVec< complex<double> >
2005-11-20 14:46:00 +01:00
template < >
2004-03-17 04:07:21 +01:00
NRVec < complex < double > > & NRVec < complex < double > > : : normalize ( )
{
complex < double > tmp ;
2009-11-12 22:01:19 +01:00
tmp = cblas_dznrm2 ( nn , v , 1 ) ;
2004-03-17 04:07:21 +01:00
# ifdef DEBUG
if ( ! ( tmp . real ( ) ) & & ! ( tmp . imag ( ) ) ) laerror ( " normalization of zero vector " ) ;
# endif
copyonwrite ( ) ;
tmp = 1.0 / tmp ;
2009-11-12 22:01:19 +01:00
cblas_zscal ( nn , & tmp , v , 1 ) ;
2004-03-17 04:07:21 +01:00
return * this ;
}
2005-02-18 23:08:15 +01:00
//stubs for linkage
2006-04-01 06:48:01 +02:00
2009-10-08 16:01:15 +02:00
# define INSTANTIZE_DUMMY(T) \
template < > void NRVec < T > : : gemv ( const T beta , const NRMat < T > & a , const char trans , const T alpha , const NRVec < T > & x ) { laerror ( " gemv on unsupported types " ) ; } \
template < > void NRVec < T > : : gemv ( const T beta , const NRSMat < T > & a , const char trans , const T alpha , const NRVec < T > & x ) { laerror ( " gemv on unsupported types " ) ; } \
template < > void NRVec < T > : : gemv ( const T beta , const SparseMat < T > & a , const char trans , const T alpha , const NRVec < T > & x , bool s ) { laerror ( " gemv on unsupported types " ) ; } \
template < > void NRVec < T > : : gemv ( const LA_traits_complex < T > : : Component_type beta , const LA_traits_complex < T > : : NRMat_Noncomplex_type & a , const char trans , const LA_traits_complex < T > : : Component_type alpha , const NRVec < T > & x ) { laerror ( " gemv on unsupported types " ) ; } \
2009-11-12 22:01:19 +01:00
template < > void NRVec < T > : : gemv ( const LA_traits_complex < T > : : Component_type beta , const LA_traits_complex < T > : : NRSMat_Noncomplex_type & a , const char trans , const LA_traits_complex < T > : : Component_type alpha , const NRVec < T > & x ) { laerror ( " gemv on unsupported types " ) ; } \
template < > NRVec < T > & NRVec < T > : : normalize ( ) { laerror ( " normalize() impossible for integer types " ) ; return * this ; } \
template < > const NRMat < T > NRVec < T > : : otimes ( const NRVec < T > & b , const bool conj , const T & scale ) const { laerror ( " otimes presently implemented only for double and complex double " ) ; return NRMat < T > ( ) ; }
2006-04-01 06:48:01 +02:00
2004-03-17 06:34:59 +01:00
2005-02-18 23:08:15 +01:00
// gemv calls
2005-11-20 14:46:00 +01:00
template < >
2004-03-17 04:07:21 +01:00
void NRVec < double > : : gemv ( const double beta , const NRMat < double > & A ,
const char trans , const double alpha , const NRVec & x )
{
# ifdef DEBUG
if ( ( trans = = ' n ' ? A . ncols ( ) : A . nrows ( ) ) ! = x . size ( ) )
laerror ( " incompatible sizes in gemv A*x " ) ;
# endif
2006-09-12 01:07:22 +02:00
copyonwrite ( ) ;
2004-03-17 04:07:21 +01:00
cblas_dgemv ( CblasRowMajor , ( trans = = ' n ' ? CblasNoTrans : CblasTrans ) ,
2005-02-18 23:08:15 +01:00
A . nrows ( ) , A . ncols ( ) , alpha , A , A . ncols ( ) , x . v , 1 , beta , v , 1 ) ;
2004-03-17 04:07:21 +01:00
}
2005-02-18 23:08:15 +01:00
2009-10-08 16:01:15 +02:00
template < >
void NRVec < complex < double > > : : gemv ( const double beta , const NRMat < double > & A ,
const char trans , const double alpha , const NRVec < complex < double > > & x )
{
# ifdef DEBUG
if ( ( trans = = ' n ' ? A . ncols ( ) : A . nrows ( ) ) ! = x . size ( ) )
laerror ( " incompatible sizes in gemv A*x " ) ;
# endif
copyonwrite ( ) ;
cblas_dgemv ( CblasRowMajor , ( trans = = ' n ' ? CblasNoTrans : CblasTrans ) , A . nrows ( ) , A . ncols ( ) , alpha , A , A . ncols ( ) , ( double * ) x . v , 2 , beta , ( double * ) v , 2 ) ;
cblas_dgemv ( CblasRowMajor , ( trans = = ' n ' ? CblasNoTrans : CblasTrans ) , A . nrows ( ) , A . ncols ( ) , alpha , A , A . ncols ( ) , ( ( double * ) x . v ) + 1 , 2 , beta , ( ( double * ) v ) + 1 , 2 ) ;
}
2005-11-20 14:46:00 +01:00
template < >
2004-03-17 04:07:21 +01:00
void NRVec < complex < double > > : : gemv ( const complex < double > beta ,
const NRMat < complex < double > > & A , const char trans ,
const complex < double > alpha , const NRVec & x )
{
# ifdef DEBUG
if ( ( trans = = ' n ' ? A . ncols ( ) : A . nrows ( ) ) ! = x . size ( ) )
laerror ( " incompatible sizes in gemv A*x " ) ;
# endif
2006-09-12 01:07:22 +02:00
copyonwrite ( ) ;
2004-03-17 04:07:21 +01:00
cblas_zgemv ( CblasRowMajor , ( trans = = ' n ' ? CblasNoTrans : CblasTrans ) ,
2005-02-18 23:08:15 +01:00
A . nrows ( ) , A . ncols ( ) , & alpha , A , A . ncols ( ) ,
x . v , 1 , & beta , v , 1 ) ;
2004-03-17 04:07:21 +01:00
}
2005-02-18 23:08:15 +01:00
2005-11-20 14:46:00 +01:00
template < >
2005-02-18 23:08:15 +01:00
void NRVec < double > : : gemv ( const double beta , const NRSMat < double > & A ,
const char trans , const double alpha , const NRVec & x )
2004-03-17 04:07:21 +01:00
{
# ifdef DEBUG
2005-02-18 23:08:15 +01:00
if ( A . ncols ( ) ! = x . size ( ) ) laerror ( " incompatible dimension in gemv A*x " ) ;
2004-03-17 04:07:21 +01:00
# endif
2006-09-12 01:07:22 +02:00
copyonwrite ( ) ;
2005-02-18 23:08:15 +01:00
cblas_dspmv ( CblasRowMajor , CblasLower , A . ncols ( ) , alpha , A , x . v , 1 , beta , v , 1 ) ;
2004-03-17 04:07:21 +01:00
}
2005-02-18 23:08:15 +01:00
2009-10-08 16:01:15 +02:00
template < >
void NRVec < complex < double > > : : gemv ( const double beta , const NRSMat < double > & A ,
const char trans , const double alpha , const NRVec < complex < double > > & x )
{
# ifdef DEBUG
if ( A . ncols ( ) ! = x . size ( ) ) laerror ( " incompatible dimension in gemv A*x " ) ;
# endif
copyonwrite ( ) ;
cblas_dspmv ( CblasRowMajor , CblasLower , A . ncols ( ) , alpha , A , ( double * ) x . v , 2 , beta , ( double * ) v , 2 ) ;
cblas_dspmv ( CblasRowMajor , CblasLower , A . ncols ( ) , alpha , A , ( ( double * ) x . v ) + 1 , 2 , beta , ( ( double * ) v ) + 1 , 2 ) ;
}
2005-02-18 23:08:15 +01:00
2005-11-20 14:46:00 +01:00
template < >
2005-02-18 23:08:15 +01:00
void NRVec < complex < double > > : : gemv ( const complex < double > beta ,
const NRSMat < complex < double > > & A , const char trans ,
const complex < double > alpha , const NRVec & x )
2004-03-17 04:07:21 +01:00
{
# ifdef DEBUG
2005-02-18 23:08:15 +01:00
if ( A . ncols ( ) ! = x . size ( ) ) laerror ( " incompatible dimension in gemv " ) ;
2004-03-17 04:07:21 +01:00
# endif
2006-09-12 01:07:22 +02:00
copyonwrite ( ) ;
2005-02-18 23:08:15 +01:00
cblas_zhpmv ( CblasRowMajor , CblasLower , A . ncols ( ) , & alpha , A ,
x . v , 1 , & beta , v , 1 ) ;
2004-03-17 04:07:21 +01:00
}
2005-02-18 23:08:15 +01:00
2009-11-12 22:01:19 +01:00
// Direct product Mat = Vec | Vec
2005-11-20 14:46:00 +01:00
template < >
2009-11-12 22:01:19 +01:00
const NRMat < double > NRVec < double > : : otimes ( const NRVec < double > & b , const bool conj , const double & scale ) const
2004-03-17 04:07:21 +01:00
{
NRMat < double > result ( 0. , nn , b . nn ) ;
2009-11-12 22:01:19 +01:00
cblas_dger ( CblasRowMajor , nn , b . nn , scale , v , 1 , b . v , 1 , result , b . nn ) ;
2004-03-17 04:07:21 +01:00
return result ;
}
2009-11-12 22:01:19 +01:00
2005-11-20 14:46:00 +01:00
template < >
2004-03-17 04:07:21 +01:00
const NRMat < complex < double > >
2009-11-12 22:01:19 +01:00
NRVec < complex < double > > : : otimes ( const NRVec < complex < double > > & b , const bool conj , const complex < double > & scale ) const
2004-03-17 04:07:21 +01:00
{
NRMat < complex < double > > result ( 0. , nn , b . nn ) ;
2009-11-12 22:01:19 +01:00
if ( conj ) cblas_zgerc ( CblasRowMajor , nn , b . nn , & scale , v , 1 , b . v , 1 , result , b . nn ) ;
else cblas_zgeru ( CblasRowMajor , nn , b . nn , & scale , v , 1 , b . v , 1 , result , b . nn ) ;
2004-03-17 04:07:21 +01:00
return result ;
}
2006-04-01 06:48:01 +02:00
template < typename T >
2006-04-01 16:56:35 +02:00
int NRVec < T > : : sort ( int direction , int from , int to , int * perm )
2006-04-01 06:48:01 +02:00
{
copyonwrite ( ) ;
2006-04-01 14:58:57 +02:00
if ( to = = - 1 ) to = nn - 1 ;
2006-04-01 16:56:35 +02:00
if ( direction ) return memqsort < 1 , NRVec < T > , int , int > ( * this , perm , from , to ) ;
else return memqsort < 0 , NRVec < T > , int , int > ( * this , perm , from , to ) ;
2006-04-01 06:48:01 +02:00
}
2006-09-10 22:06:44 +02:00
//////////////////////////////////////////////////////////////////////////////
//// forced instantization in the corespoding object file
template class NRVec < double > ;
template class NRVec < complex < double > > ;
template class NRVec < char > ;
template class NRVec < short > ;
template class NRVec < int > ;
2009-11-12 22:01:19 +01:00
template class NRVec < long > ;
template class NRVec < long long > ;
template class NRVec < unsigned char > ;
template class NRVec < unsigned short > ;
2006-09-10 22:06:44 +02:00
template class NRVec < unsigned int > ;
template class NRVec < unsigned long > ;
2009-11-12 22:01:19 +01:00
template class NRVec < unsigned long long > ;
2006-09-10 22:06:44 +02:00
2009-10-08 16:01:15 +02:00
INSTANTIZE_DUMMY ( char )
INSTANTIZE_DUMMY ( short )
INSTANTIZE_DUMMY ( int )
2009-11-12 22:01:19 +01:00
INSTANTIZE_DUMMY ( long )
INSTANTIZE_DUMMY ( long long )
INSTANTIZE_DUMMY ( unsigned char )
INSTANTIZE_DUMMY ( unsigned short )
2009-10-08 16:01:15 +02:00
INSTANTIZE_DUMMY ( unsigned int )
INSTANTIZE_DUMMY ( unsigned long )
2009-11-12 22:01:19 +01:00
INSTANTIZE_DUMMY ( unsigned long long )
2009-10-08 16:01:15 +02:00
INSTANTIZE_DUMMY ( complex < char > )
INSTANTIZE_DUMMY ( complex < short > )
INSTANTIZE_DUMMY ( complex < int > )
2009-11-12 22:01:19 +01:00
INSTANTIZE_DUMMY ( complex < long > )
INSTANTIZE_DUMMY ( complex < long long > )
INSTANTIZE_DUMMY ( complex < unsigned char > )
INSTANTIZE_DUMMY ( complex < unsigned short > )
2009-10-08 16:01:15 +02:00
INSTANTIZE_DUMMY ( complex < unsigned int > )
2009-11-12 22:01:19 +01:00
INSTANTIZE_DUMMY ( complex < unsigned long > )
INSTANTIZE_DUMMY ( complex < unsigned long long > )
2009-10-08 16:01:15 +02:00
INSTANTIZE_DUMMY ( complex < complex < double > > )
INSTANTIZE_DUMMY ( complex < complex < float > > )
2009-11-12 22:01:19 +01:00
} //namespace