- Timestamp:
- 09/16/09 22:52:57 (15 years ago)
- Files:
-
- 1 modified
Legend:
- Unmodified
- Added
- Removed
-
library/bdm/itpp_ext.cpp
r587 r622 18 18 // from algebra/lapack.h 19 19 20 extern "C" { /* QR factorization of a general matrix A */ 21 void dgeqrf_ ( int *m, int *n, double *a, int *lda, double *tau, double *work, 22 int *lwork, int *info ); 20 extern "C" /* QR factorization of a general matrix A */ 21 { 22 void dgeqrf_ (int *m, int *n, double *a, int *lda, double *tau, double *work, 23 int *lwork, int *info); 23 24 }; 24 25 25 namespace itpp { 26 Array<int> to_Arr ( const ivec &indices ) { 27 Array<int> a ( indices.size() ); 28 for ( int i = 0; i < a.size(); i++ ) { 29 a ( i ) = indices ( i ); 26 namespace itpp 27 { 28 Array<int> to_Arr (const ivec &indices) 29 { 30 Array<int> a (indices.size()); 31 for (int i = 0; i < a.size(); i++) { 32 a (i) = indices (i); 30 33 } 31 34 return a; 32 35 } 33 36 34 ivec linspace ( int from, int to ) { 37 ivec linspace (int from, int to) 38 { 35 39 int n = to - from + 1; 36 40 int i; 37 it_assert_debug ( n > 0, "wrong linspace");38 ivec iv ( n);39 for ( i = 0; i < n; i++ ) iv ( i) = from + i;41 it_assert_debug (n > 0, "wrong linspace"); 42 ivec iv (n); 43 for (i = 0; i < n; i++) iv (i) = from + i; 40 44 return iv; 41 45 }; 42 46 43 void set_subvector ( vec &ov, const ivec &iv, const vec &v ) { 44 it_assert_debug ( ( iv.length() <= v.length() ), 47 void set_subvector (vec &ov, const ivec &iv, const vec &v) 48 { 49 it_assert_debug ( (iv.length() <= v.length()), 45 50 "Vec<>::set_subvector(ivec, vec<Num_T>): Indexing out " 46 "of range of v" ); 47 for ( int i = 0; i < iv.length(); i++ ) { 48 it_assert_debug ( iv ( i ) < ov.length(), 49 "Vec<>::set_subvector(ivec, vec<Num_T>): Indexing out " 50 "of range of v" ); 51 ov ( iv ( i ) ) = v ( i ); 52 } 53 } 54 55 vec get_vec ( const vec &v, const ivec &indexlist ) { 51 "of range of v"); 52 for (int i = 0; i < iv.length(); i++) { 53 it_assert_debug (iv (i) < ov.length(), 54 "Vec<>::set_subvector(ivec, vec<Num_T>): Indexing out " 55 "of range of v"); 56 ov (iv (i)) = v (i); 57 } 58 } 59 60 vec get_vec (const vec &v, const ivec &indexlist) 61 { 56 62 int size = indexlist.size(); 57 vec temp ( size);58 for ( int i = 0; i < size; ++i) {59 temp ( i ) = v._data() [indexlist ( i) ];63 vec temp (size); 64 for (int i = 0; i < size; ++i) { 65 temp (i) = v._data() [indexlist (i) ]; 60 66 } 61 67 return temp; … … 68 74 #define R_FINITE std::isfinite 69 75 70 bvec operator> ( const vec &t1, const vec &t2 ) { 71 it_assert_debug ( t1.length() == t2.length(), "Vec<>::operator>(): different size of vectors" ); 72 bvec temp ( t1.length() ); 73 for ( int i = 0; i < t1.length(); i++ ) 74 temp ( i ) = ( t1[i] > t2[i] ); 76 bvec operator> (const vec &t1, const vec &t2) 77 { 78 it_assert_debug (t1.length() == t2.length(), "Vec<>::operator>(): different size of vectors"); 79 bvec temp (t1.length()); 80 for (int i = 0; i < t1.length(); i++) 81 temp (i) = (t1[i] > t2[i]); 75 82 return temp; 76 83 } 77 84 78 bvec operator< ( const vec &t1, const vec &t2 ) { 79 it_assert_debug ( t1.length() == t2.length(), "Vec<>::operator>(): different size of vectors" ); 80 bvec temp ( t1.length() ); 81 for ( int i = 0; i < t1.length(); i++ ) 82 temp ( i ) = ( t1[i] < t2[i] ); 85 bvec operator< (const vec &t1, const vec &t2) 86 { 87 it_assert_debug (t1.length() == t2.length(), "Vec<>::operator>(): different size of vectors"); 88 bvec temp (t1.length()); 89 for (int i = 0; i < t1.length(); i++) 90 temp (i) = (t1[i] < t2[i]); 83 91 return temp; 84 92 } 85 93 86 94 87 bvec operator& ( const bvec &a, const bvec &b ) { 88 it_assert_debug ( b.size() == a.size(), "operator&(): Vectors of different lengths" ); 89 90 bvec temp ( a.size() ); 91 for ( int i = 0; i < a.size(); i++ ) { 92 temp ( i ) = a ( i ) & b ( i ); 95 bvec operator& (const bvec &a, const bvec &b) 96 { 97 it_assert_debug (b.size() == a.size(), "operator&(): Vectors of different lengths"); 98 99 bvec temp (a.size()); 100 for (int i = 0; i < a.size(); i++) { 101 temp (i) = a (i) & b (i); 93 102 } 94 103 return temp; 95 104 } 96 105 97 bvec operator| ( const bvec &a, const bvec &b ) { 98 it_assert_debug ( b.size() != a.size(), "operator&(): Vectors of different lengths" ); 99 100 bvec temp ( a.size() ); 101 for ( int i = 0; i < a.size(); i++ ) { 102 temp ( i ) = a ( i ) | b ( i ); 106 bvec operator| (const bvec &a, const bvec &b) 107 { 108 it_assert_debug (b.size() != a.size(), "operator&(): Vectors of different lengths"); 109 110 bvec temp (a.size()); 111 for (int i = 0; i < a.size(); i++) { 112 temp (i) = a (i) | b (i); 103 113 } 104 114 return temp; … … 106 116 107 117 //#if 0 108 Gamma_RNG::Gamma_RNG ( double a, double b ) { 109 setup ( a, b ); 110 } 111 double Gamma_RNG::sample() { 118 Gamma_RNG::Gamma_RNG (double a, double b) 119 { 120 setup (a, b); 121 } 122 double Gamma_RNG::sample() 123 { 112 124 //A copy of rgamma code from the R package!! 113 125 // … … 147 159 double scale = 1.0 / beta; 148 160 149 if ( !R_FINITE ( a ) || !R_FINITE ( scale ) || a < 0.0 || scale <= 0.0) {150 it_error ( "Gamma_RNG wrong parameters");151 } 152 153 if ( a < 1. ) {/* GS algorithm for parameters a < 1 */154 if ( a == 0)161 if (!R_FINITE (a) || !R_FINITE (scale) || a < 0.0 || scale <= 0.0) { 162 it_error ("Gamma_RNG wrong parameters"); 163 } 164 165 if (a < 1.) { /* GS algorithm for parameters a < 1 */ 166 if (a == 0) 155 167 return 0.; 156 168 e = 1.0 + exp_m1 * a; 157 for ( ;; ) {//VS repeat169 for (;;) { //VS repeat 158 170 p = e * unif_rand(); 159 if ( p >= 1.0) {160 x = -log ( ( e - p ) / a);161 if ( exp_rand() >= ( 1.0 - a ) * log ( x ))171 if (p >= 1.0) { 172 x = -log ( (e - p) / a); 173 if (exp_rand() >= (1.0 - a) * log (x)) 162 174 break; 163 175 } else { 164 x = exp ( log ( p ) / a);165 if ( exp_rand() >= x)176 x = exp (log (p) / a); 177 if (exp_rand() >= x) 166 178 break; 167 179 } … … 173 185 174 186 /* Step 1: Recalculations of s2, s, d if a has changed */ 175 if ( a != aa) {187 if (a != aa) { 176 188 aa = a; 177 189 s2 = a - 0.5; 178 s = sqrt ( s2);190 s = sqrt (s2); 179 191 d = sqrt32 - s * 12.0; 180 192 } … … 186 198 x = s + 0.5 * t; 187 199 ret_val = x * x; 188 if ( t >= 0.0)200 if (t >= 0.0) 189 201 return scale * ret_val; 190 202 191 203 /* Step 3: u = 0,1 - uniform sample. squeeze acceptance (s) */ 192 204 u = unif_rand(); 193 if ( ( d * u ) <= ( t * t * t ))205 if ( (d * u) <= (t * t * t)) 194 206 return scale * ret_val; 195 207 196 208 /* Step 4: recalculations of q0, b, si, c if necessary */ 197 209 198 if ( a != aaa) {210 if (a != aaa) { 199 211 aaa = a; 200 212 r = 1.0 / a; 201 q0 = ( ( ( ( ( ( q7 * r + q6 ) * r + q5 ) * r + q4 ) * r + q3) * r202 + q2 ) * r + q1) * r;213 q0 = ( ( ( ( ( (q7 * r + q6) * r + q5) * r + q4) * r + q3) * r 214 + q2) * r + q1) * r; 203 215 204 216 /* Approximation depending on size of parameter a */ … … 206 218 /* were established by numerical experiments */ 207 219 208 if ( a <= 3.686) {220 if (a <= 3.686) { 209 221 b = 0.463 + s + 0.178 * s2; 210 222 si = 1.235; 211 223 c = 0.195 / s - 0.079 + 0.16 * s; 212 } else if ( a <= 13.022) {224 } else if (a <= 13.022) { 213 225 b = 1.654 + 0.0076 * s2; 214 226 si = 1.68 / s + 0.275; … … 222 234 /* Step 5: no quotient test if x not positive */ 223 235 224 if ( x > 0.0) {236 if (x > 0.0) { 225 237 /* Step 6: calculation of v and quotient q */ 226 v = t / ( s + s);227 if ( fabs ( v ) <= 0.25)228 q = q0 + 0.5 * t * t * ( ( ( ( ( ( a7 * v + a6 ) * v + a5 ) * v + a4) * v229 + a3 ) * v + a2 ) * v + a1) * v;238 v = t / (s + s); 239 if (fabs (v) <= 0.25) 240 q = q0 + 0.5 * t * t * ( ( ( ( ( (a7 * v + a6) * v + a5) * v + a4) * v 241 + a3) * v + a2) * v + a1) * v; 230 242 else 231 q = q0 - s * t + 0.25 * t * t + ( s2 + s2 ) * log ( 1.0 + v);243 q = q0 - s * t + 0.25 * t * t + (s2 + s2) * log (1.0 + v); 232 244 233 245 234 246 /* Step 7: quotient acceptance (q) */ 235 if ( log ( 1.0 - u ) <= q)247 if (log (1.0 - u) <= q) 236 248 return scale * ret_val; 237 249 } 238 250 239 for ( ;; ) {//VS repeat251 for (;;) { //VS repeat 240 252 /* Step 8: e = standard exponential deviate 241 253 * u = 0,1 -uniform deviate … … 244 256 u = unif_rand(); 245 257 u = u + u - 1.0; 246 if ( u < 0.0)258 if (u < 0.0) 247 259 t = b - si * e; 248 260 else 249 261 t = b + si * e; 250 262 /* Step 9: rejection if t < tau(1) = -0.71874483771719 */ 251 if ( t >= -0.71874483771719) {263 if (t >= -0.71874483771719) { 252 264 /* Step 10: calculation of v and quotient q */ 253 v = t / ( s + s);254 if ( fabs ( v ) <= 0.25)265 v = t / (s + s); 266 if (fabs (v) <= 0.25) 255 267 q = q0 + 0.5 * t * t * 256 ( ( ( ( ( ( a7 * v + a6 ) * v + a5 ) * v + a4 ) * v + a3) * v257 + a2 ) * v + a1) * v;268 ( ( ( ( ( (a7 * v + a6) * v + a5) * v + a4) * v + a3) * v 269 + a2) * v + a1) * v; 258 270 else 259 q = q0 - s * t + 0.25 * t * t + ( s2 + s2 ) * log ( 1.0 + v);271 q = q0 - s * t + 0.25 * t * t + (s2 + s2) * log (1.0 + v); 260 272 /* Step 11: hat acceptance (h) */ 261 273 /* (if q not positive go to step 8) */ 262 if ( q > 0.0) {274 if (q > 0.0) { 263 275 // TODO: w = expm1(q); 264 w = exp ( q) - 1;276 w = exp (q) - 1; 265 277 /* ^^^^^ original code had approximation with rel.err < 2e-7 */ 266 278 /* if t is rejected sample again at step 8 */ 267 if ( ( c * fabs ( u ) ) <= ( w * exp ( e - 0.5 * t * t ) ))279 if ( (c * fabs (u)) <= (w * exp (e - 0.5 * t * t))) 268 280 break; 269 281 } … … 275 287 276 288 277 bool qr ( const mat &A, mat &R ) { 289 bool qr (const mat &A, mat &R) 290 { 278 291 int info; 279 292 int m = A.rows(); 280 293 int n = A.cols(); 281 294 int lwork = n; 282 int k = std::min ( m, n);283 vec tau ( k);284 vec work ( lwork);295 int k = std::min (m, n); 296 vec tau (k); 297 vec work (lwork); 285 298 286 299 R = A; … … 288 301 // perform workspace query for optimum lwork value 289 302 int lwork_tmp = -1; 290 dgeqrf_ ( 291 &info);292 if ( info == 0) {293 lwork = static_cast<int> ( work ( 0 ));294 work.set_size ( lwork, false);295 } 296 dgeqrf_ ( &m, &n, R._data(), &m, tau._data(), work._data(), &lwork, &info);303 dgeqrf_ (&m, &n, R._data(), &m, tau._data(), work._data(), &lwork_tmp, 304 &info); 305 if (info == 0) { 306 lwork = static_cast<int> (work (0)); 307 work.set_size (lwork, false); 308 } 309 dgeqrf_ (&m, &n, R._data(), &m, tau._data(), work._data(), &lwork, &info); 297 310 298 311 // construct R 299 for ( int i = 0; i < m; i++)300 for ( int j = 0; j < std::min ( i, n ); j++)301 R ( i, j) = 0;302 303 return ( info == 0);312 for (int i = 0; i < m; i++) 313 for (int j = 0; j < std::min (i, n); j++) 314 R (i, j) = 0; 315 316 return (info == 0); 304 317 } 305 318 306 319 //#endif 307 std::string num2str ( double d ) { 320 std::string num2str (double d) 321 { 308 322 char tmp[20];//that should do 309 sprintf ( tmp, "%f", d);310 return std::string ( tmp);323 sprintf (tmp, "%f", d); 324 return std::string (tmp); 311 325 }; 312 std::string num2str ( int i ) { 326 std::string num2str (int i) 327 { 313 328 char tmp[10];//that should do 314 sprintf ( tmp, "%d", i);315 return std::string ( tmp);329 sprintf (tmp, "%d", i); 330 return std::string (tmp); 316 331 }; 317 332 … … 321 336 #define el 0.5772156649015329 322 337 323 double psi ( double x ) { 338 double psi (double x) 339 { 324 340 double s, ps, xa, x2; 325 341 int n, k; … … 335 351 }; 336 352 337 xa = fabs ( x);353 xa = fabs (x); 338 354 s = 0.0; 339 if ( ( x == ( int ) x ) && ( x <= 0.0 )) {355 if ( (x == (int) x) && (x <= 0.0)) { 340 356 ps = 1e308; 341 357 return ps; 342 358 } 343 if ( xa == ( int ) xa) {359 if (xa == (int) xa) { 344 360 n = xa; 345 for ( k = 1; k < n; k++) {361 for (k = 1; k < n; k++) { 346 362 s += 1.0 / k; 347 363 } 348 364 ps = s - el; 349 } else if ( ( xa + 0.5 ) == ( ( int ) ( xa + 0.5 ) )) {365 } else if ( (xa + 0.5) == ( (int) (xa + 0.5))) { 350 366 n = xa - 0.5; 351 for ( k = 1; k <= n; k++) {352 s += 1.0 / ( 2.0 * k - 1.0);367 for (k = 1; k <= n; k++) { 368 s += 1.0 / (2.0 * k - 1.0); 353 369 } 354 370 ps = 2.0 * s - el - 1.386294361119891; 355 371 } else { 356 if ( xa < 10.0) {357 n = 10 - ( int) xa;358 for ( k = 0; k < n; k++) {359 s += 1.0 / ( xa + k);372 if (xa < 10.0) { 373 n = 10 - (int) xa; 374 for (k = 0; k < n; k++) { 375 s += 1.0 / (xa + k); 360 376 } 361 377 xa += n; 362 378 } 363 x2 = 1.0 / ( xa * xa);364 ps = log ( xa ) - 0.5 / xa + x2 * ( ( ( ( ( ( ( a[7] * x2 + a[6] ) * x2 + a[5]) * x2 +365 a[4] ) * x2 + a[3] ) * x2 + a[2] ) * x2 + a[1] ) * x2 + a[0]);379 x2 = 1.0 / (xa * xa); 380 ps = log (xa) - 0.5 / xa + x2 * ( ( ( ( ( ( (a[7] * x2 + a[6]) * x2 + a[5]) * x2 + 381 a[4]) * x2 + a[3]) * x2 + a[2]) * x2 + a[1]) * x2 + a[0]); 366 382 ps -= s; 367 383 } 368 if ( x < 0.0)369 ps = ps - M_PI * std::cos ( M_PI * x ) / std::sin ( M_PI * x) - 1.0 / x;384 if (x < 0.0) 385 ps = ps - M_PI * std::cos (M_PI * x) / std::sin (M_PI * x) - 1.0 / x; 370 386 return ps; 371 387 } 372 388 373 void triu(mat &A){ 374 for(int i=1;i<A.rows();i++) { // row cycle 375 for (int j=0; j<i; j++) {A(i,j)=0;} 376 } 377 } 378 379 class RandunStorage{ 380 const int A; 381 const int M; 382 static double seed; 383 static int counter; 389 void triu (mat &A) 390 { 391 for (int i = 1;i < A.rows();i++) { // row cycle 392 for (int j = 0; j < i; j++) {A (i, j) = 0;} 393 } 394 } 395 396 class RandunStorage 397 { 398 const int A; 399 const int M; 400 static double seed; 401 static int counter; 384 402 public: 385 RandunStorage() : A(16807), M(2147483647) {};386 void set_seed (double seed0){seed=seed0;}387 double get() {403 RandunStorage() : A (16807), M (2147483647) {}; 404 void set_seed (double seed0) {seed = seed0;} 405 double get() { 388 406 long long tmp = A * seed; 389 407 tmp = tmp % M; 390 408 seed = tmp; 391 counter++; 392 return seed/M;} 409 counter++; 410 return seed / M; 411 } 393 412 }; 394 413 static RandunStorage randun_global_storage; 395 double RandunStorage::seed=1111111; 396 int RandunStorage::counter=0; 397 double randun(){return randun_global_storage.get();}; 398 vec randun(int n){vec res(n); for(int i=0;i<n;i++){res(i)=randun();}; return res;}; 399 mat randun(int n, int m){mat res(n,m); for(int i=0;i<n*m;i++){res(i)=randun();}; return res;}; 414 double RandunStorage::seed = 1111111; 415 int RandunStorage::counter = 0; 416 double randun() {return randun_global_storage.get();}; 417 vec randun (int n) {vec res (n); for (int i = 0;i < n;i++) {res (i) = randun();}; return res;}; 418 mat randun (int n, int m) {mat res (n, m); for (int i = 0;i < n*m;i++) {res (i) = randun();}; return res;}; 419 400 420 ivec unique (const ivec &in) 401 421 {