File: ML_meal.cpp

package info (click to toggle)
r-cran-pcapp 1.9-73-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 800 kB
  • sloc: cpp: 5,961; ansic: 917; sh: 13; makefile: 2
file content (189 lines) | stat: -rw-r--r-- 5,745 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
/*
    SMat - Simple Matrix Classes v0.1beta
    Copyright (C) 2011 by Heinrich Fritz (heinrich_fritz@hotmail.com)

    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/>.
*/

//	ML_meal.cpp
//	MATLAB Mathematical Environment Abstraction Layer

#ifdef MATLAB_MEX_FILE
#include "ML_meal.h"

#ifdef ES_DEV_ENV
	#include "../SMat/smat.h"
#else
	#include "smat.h"
#endif

/////////////////////	
//	CRmealSettings  //
/////////////////////	

	CRmealSettings &GetRealSettings ()
	{
		static CRmealSettings settings ;
		return settings ;
	}

	CRmealSettings::CRmealSettings ()
		: m_szEmail ("<NA>")
	{

	}

	CRmealSettings::CRmealSettings (const char *szEmail)
	{
		if (szEmail)	GetRealSettings ().m_szEmail = szEmail ;
	}


	void meal_geev (const char* jobvl, const char* jobvr, const int* n, double* a, const int* lda, double* wr, double* wi, double* vl, const int* ldvl, double* vr, const int* ldvr, double* work, const int* lwork, int* info)
	{ FORTRAN_WRAPPER(dgeev)((char *) jobvl, (char *) jobvr, (int *) n, a, (int *) lda, wr, wi, vl, (int *) ldvl, vr, (int *) ldvr, work, (int *) lwork, info) ; }

	void meal_gemm (const char *transa, const char *transb, const int *m, const int *n, const int *k, const double *alpha, const double *a, const int *lda, const double *b, const int *ldb, const double *beta, double *c, const int *ldc)
	{ 
#ifdef OLD_ML
		THROW (0) ;
#else
		FORTRAN_WRAPPER(dgemm)((char *) transa, (char *)transb, (int *)m, (int *) n, (int *) k, (double *) alpha, (double *) a, (int *) lda, (double *) b, (int *) ldb, (double *) beta, (double *) c, (int *) ldc) ; 
#endif
	}

	void meal_dgesv (const int* n, const int* nrhs, double* a, const int* lda, int* ipiv, double* b, const int* ldb, int* info)
	{ FORTRAN_WRAPPER(dgesv)((int *) n, (int *) nrhs, a, (int *) lda, ipiv, b, (int *) ldb, info) ; }

	void meal_dgesvd (const char* jobu, const char* jobvt, const int* m, const int* n, double* a, const int* lda, double* s, double* u, const int* ldu, double* vt, const int* ldvt, double* work, const int* lwork, int* info)
	{ FORTRAN_WRAPPER(dgesvd)((char *) jobu, (char *) jobvt, (int *)m, (int *)n, a, (int *)lda, s, u, (int *)ldu, vt, (int *)ldvt, work, (int *)lwork, info) ; }

	void meal_sort (double *d, int l)
	{
		sme_qsort (d, l) ;
	}

	void meal_sort_order (double *d, int *o, int l)
	{
		sme_qsortI (d, o, l) ;
	}

	void meal_sort_order_rev (double *d, int *o, int l)
	{
		sme_qsortI (d, o, l, TRUE) ;
	}
/*
////////////////////////
//	Random Generator  //
////////////////////////

	void meal_PutRNGstate ()	{ THROW(0) ; }
	void meal_GetRNGstate ()	{ THROW(0) ; 	}

	double meal_unif_rand ()	{ THROW(0) ; return 0 ;	}
	double meal_norm_rand ()	{ THROW(0) ; return 0 ;	}
	double meal_exp_rand  ()	{ THROW(0) ; return 0 ;	}
*/
////////////////////////////////////
//	special values amd constants  //
////////////////////////////////////

	double	meal_NaN	() { return mxGetNaN () ; }
	double	meal_PosInf	() { return mxGetInf () ; }
	double	meal_NegInf	() { return -mxGetInf (); }
	double	meal_NaReal	() { THROW (0); return 0 ; }
	int		meal_NaInt	() { THROW (0); return 0 ; }

	double  meal_PI		() { return 3.141592653589793238462643383279502884197169399375 ; } //	{ return utGetPI () ; }	//	where did utGetPI go?

//////////////////////////
//	printing functions  //
//////////////////////////

	void meal_printf (const char *sz, ...)
	{
//		va_list va_l ;				//	further arguments not supported yet...
//		va_start (va_l, sz) ;
		mexPrintf (sz/*, va_l*/) ;
	}

	void meal_warning (const char *sz)
	{
		mexWarnMsgTxt (sz) ;
	}

	void meal_error (const char *sz)
	{
		mexErrMsgTxt (sz) ;
	}

	void *meal_alloc (size_t n, int s)
	{
		return new char [n * s] ;
	}

	void meal_free (void *p)
	{
		delete [] (char *) p ;
	}


//////////////////
//	Exceptions  //
//////////////////

	void meal_OnException (const char * szDate, const char * szFile, int nLine)
	{

		mexPrintf (
			"\n"
			"  An exception occurred.\n"
			"  Please contact the author (%s), providing\n"
			"  the following details:\n"
			"\n"
			"\tR version number\n"
			"\tPackage version number\n"
			"\tBuild date:\t%s\n"
			"\tFile:\t\t%s\n"
			"\tLine:\t\t%d\n"
			"\n"
			"  If possible please include the code which caused this error, including\n"
			"  eventual source data and the state of the random generator (seed) before\n"
			"  experiencing this issue.\n"
			"\n"
			"\tYour contribution is appreciated!\n\n",
			GetRealSettings ().GetEmail (), szDate, szFile, nLine) ;
		meal_error ("An exception has occurred.") ;
	}

	void meal_OnUException ()
	{
		mexPrintf (
			"\n"
			"  An unknown exception occurred.\n"
			"  Please contact the author (%s), providing\n"
			"  the following details:\n"
			"\n"
			"\tR version number\n"
			"\tPackage version number\n"
			"\n"
			"  If possible please include the code which caused this error, including\n"
			"  eventual source data and the state of the random generator (seed) before\n"
			"  experiencing this issue.\n\n"
			"\n"
			"\tYour contribution is appreciated!\n\n",
			GetRealSettings ().GetEmail ()) ;
		meal_error ("An unknown exception has occurred.") ;
	}

#endif	//	#ifdef MATLAB_MEX_FILE