├── src ├── divonne │ ├── KorobovCoeff.c │ ├── common.c │ ├── Divonne.c │ ├── decl.h │ ├── Iterate.c │ ├── Explore.c │ ├── Sample.c │ └── Split.c ├── common │ ├── Data.c │ ├── WorkerIni.c │ ├── Global.c │ ├── ChiSquare.c │ ├── Erf.c │ ├── sock.h │ ├── CSample.c │ ├── MSample.c │ ├── Fork.c │ ├── DoSample.c │ └── Random.c ├── cuhre │ ├── common.c │ ├── decl.h │ ├── Cuhre.c │ ├── Cuhre.tm │ └── Integrate.c ├── vegas │ ├── common.c │ ├── decl.h │ ├── Vegas.c │ ├── Grid.c │ ├── Integrate.c │ └── Vegas.tm └── suave │ ├── common.c │ ├── decl.h │ ├── Fluct.c │ ├── Suave.c │ ├── Grid.c │ ├── Sample.c │ └── Suave.tm ├── cuba.pdf ├── tools ├── partview.pro ├── mkstatic ├── partview.m ├── fcc ├── mcc ├── mkdist.c ├── partview.cpp └── print.xpm ├── demo ├── demo-c.out ├── demo-math.m ├── cuba.F ├── testsuite.m ├── demo-c.c └── demo-fortran.F ├── makesharedlib.sh ├── README.rst ├── configure.ac ├── config.h.in ├── cuba.h ├── COPYING └── install-sh /src/divonne/KorobovCoeff.c: -------------------------------------------------------------------------------- 1 | KorobovCoeff.c-9689 -------------------------------------------------------------------------------- /cuba.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JohannesBuchner/cuba/HEAD/cuba.pdf -------------------------------------------------------------------------------- /tools/partview.pro: -------------------------------------------------------------------------------- 1 | TEMPLATE = app 2 | CONFIG += qt release 3 | SOURCES += partview.cpp 4 | HEADERS += quit.xpm print.xpm 5 | DESTDIR = . 6 | MOC_DIR = . 7 | -------------------------------------------------------------------------------- /src/common/Data.c: -------------------------------------------------------------------------------- 1 | /* 2 | Data.c 3 | initialized data for Cuba 4 | by Thomas Hahn 5 | last modified 21 Jul 14 th 6 | */ 7 | 8 | 9 | #include "stddecl.h" 10 | 11 | int cubaverb_ = uninitialized; 12 | 13 | #ifdef HAVE_FORK 14 | corespec cubaworkers_ = { 15 | uninitialized, uninitialized, 16 | uninitialized, uninitialized }; 17 | #endif 18 | 19 | -------------------------------------------------------------------------------- /demo/demo-c.out: -------------------------------------------------------------------------------- 1 | VEGAS RESULT: neval 10000 fail 0 2 | VEGAS RESULT: 0.66481073 +- 0.00049218 p = 0.089 3 | SUAVE RESULT: nregions 7 neval 7000 fail 0 4 | SUAVE RESULT: 0.66444529 +- 0.00056577 p = 0.210 5 | DIVONNE RESULT: nregions 14 neval 3052 fail 0 6 | DIVONNE RESULT: 0.66461951 +- 0.00063503 p = 0.000 7 | CUHRE RESULT: nregions 2 neval 381 fail 0 8 | CUHRE RESULT: 0.66466968 +- 0.00000000 p = 0.000 9 | -------------------------------------------------------------------------------- /src/cuhre/common.c: -------------------------------------------------------------------------------- 1 | /* 2 | common.c 3 | includes most of the modules 4 | this file is part of Cuhre 5 | last modified 2 Aug 13 11 th 6 | */ 7 | 8 | 9 | #include "ChiSquare.c" 10 | #include "Rule.c" 11 | 12 | static inline bool BadDimension(cThis *t) 13 | { 14 | if( t->ndim > MAXDIM ) return true; 15 | return t->ndim < 2; 16 | } 17 | 18 | static inline bool BadComponent(cThis *t) 19 | { 20 | if( t->ncomp > MAXCOMP ) return true; 21 | return t->ncomp < 1; 22 | } 23 | 24 | -------------------------------------------------------------------------------- /makesharedlib.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # Author: Johannes Buchner (C) 2015 3 | # For creating a shared library (libcuba.so). 4 | 5 | sed 's/CFLAGS = -O3 -fomit-frame-pointer/CFLAGS = -O3 -fPIC -fcommon -fomit-frame-pointer/g' --in-place makefile 6 | echo "rebuilding libcuba.a archive" 7 | make -B libcuba.a 8 | echo "unpacking libcuba.a" 9 | FILES=$(ar xv libcuba.a |sed 's/x - //g') 10 | echo "making libcuba.so" 11 | echo gcc -shared -Wall $FILES -lm -o libcuba.so 12 | gcc -shared -Wall $FILES -lm -o libcuba.so 13 | rm $FILES 14 | 15 | 16 | -------------------------------------------------------------------------------- /src/vegas/common.c: -------------------------------------------------------------------------------- 1 | /* 2 | common.c 3 | Code common to Vegas.c and Vegas.tm 4 | this file is part of Vegas 5 | last modified 29 Jul 13 th 6 | */ 7 | 8 | 9 | #include "Random.c" 10 | #include "ChiSquare.c" 11 | #include "Grid.c" 12 | 13 | static inline bool BadDimension(cThis *t) 14 | { 15 | if( t->ndim > MAXDIM ) return true; 16 | return t->ndim < SOBOL_MINDIM || 17 | (t->seed == 0 && t->ndim > SOBOL_MAXDIM); 18 | } 19 | 20 | static inline bool BadComponent(cThis *t) 21 | { 22 | if( t->ncomp > MAXCOMP ) return true; 23 | return t->ncomp < 1; 24 | } 25 | 26 | -------------------------------------------------------------------------------- /README.rst: -------------------------------------------------------------------------------- 1 | Cuba - a library for multidimensional numerical integration 2 | ------------------------------------------------------------ 3 | 4 | Cuba was written by Thomas Hahn and is distributed under the LGPL (see COPYING). 5 | Refer to the main website http://www.feynarts.de/cuba/ 6 | 7 | Installing 8 | ----------- 9 | To build libcuba.so, run:: 10 | 11 | $ ./configure 12 | $ ./makeshared.sh # (instead of make) 13 | 14 | To use Cuba with Python, see the `PyCuba `_ project and its `documentation `_. 15 | 16 | -------------------------------------------------------------------------------- /tools/mkstatic: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | exe= 4 | mach= 5 | mlmach= 6 | case `uname -s` in 7 | Linux) tag=Linux 8 | st=-static 9 | #mach=-m32 10 | #mlmach=-b32 11 | ;; 12 | Darwin) tag=Mac 13 | st=-static-libgcc 14 | mach=-mmacosx-version-min=10.6 15 | ;; 16 | CYG*) tag=Windows 17 | export CC=i686-pc-cygwin-gcc 18 | st="-static -static-libgcc" 19 | exe=.exe 20 | ;; 21 | esac 22 | 23 | ./configure CFLAGS="-O3 -fomit-frame-pointer -ffast-math $st $mach" MCFLAGS="-st $mlmach" 24 | 25 | make math 26 | 27 | for file in Vegas Suave Divonne Cuhre ; do 28 | gzip $file$exe 29 | mv $file$exe.gz $file$exe-$tag.gz 30 | done 31 | 32 | -------------------------------------------------------------------------------- /src/common/WorkerIni.c: -------------------------------------------------------------------------------- 1 | /* 2 | WorkerIni.c 3 | set/run the init/exit functions for worker processes 4 | by Thomas Hahn 5 | last modified 6 Sep 12 th 6 | */ 7 | 8 | 9 | #include "stddecl.h" 10 | 11 | extern workerini cubaini; 12 | 13 | Extern void SUFFIX(cubasetinit)(subroutine f, void *arg) 14 | { 15 | cubaini.initfun = f; 16 | cubaini.initarg = arg; 17 | } 18 | 19 | 20 | Extern void SUFFIX(cubasetexit)(subroutine f, void *arg) 21 | { 22 | cubaini.exitfun = f; 23 | cubaini.exitarg = arg; 24 | } 25 | 26 | 27 | Extern void SUFFIX(cubaruninit)() 28 | { 29 | if( cubaini.initfun ) cubaini.initfun(cubaini.initarg); 30 | } 31 | 32 | 33 | Extern void SUFFIX(cubarunexit)() 34 | { 35 | if( cubaini.exitfun ) cubaini.exitfun(cubaini.exitarg); 36 | } 37 | 38 | -------------------------------------------------------------------------------- /demo/demo-math.m: -------------------------------------------------------------------------------- 1 | Install["Vegas"] 2 | 3 | Install["Suave"] 4 | 5 | Install["Divonne"] 6 | 7 | Install["Cuhre"] 8 | 9 | 10 | test[n_] := {t[n, Vegas], t[n, Suave], t[n, Divonne], t[n, Cuhre]} 11 | 12 | t[n_, int_] := int[f[n][x, y, z], {x,0,1}, {y,0,1}, {z,0,1}] 13 | 14 | 15 | f[1][x_, y_, z_] := Sin[x] Cos[y] Exp[z] 16 | 17 | f[2][x_, y_, z_] := 1/((x + y)^2 + .003) Cos[y] Exp[z] 18 | 19 | f[3][x_, y_, z_] := 1/(3.75 - Cos[Pi x] - Cos[Pi y] - Cos[Pi z]) 20 | 21 | f[4][x_, y_, z_] := Abs[x^2 + y^2 + z^2 - .125] 22 | 23 | f[5][x_, y_, z_] := Exp[-x^2 - y^2 - z^2] 24 | 25 | f[6][x_, y_, z_] := 1/(1 - x y z + 10^-10) 26 | 27 | f[7][x_, y_, z_] := Sqrt[Abs[x - y - z]] 28 | 29 | f[8][x_, y_, z_] := Exp[-x y z] 30 | 31 | f[9][x_, y_, z_] := x^2/(Cos[x + y + z + 1] + 5) 32 | 33 | f[10][x_, y_, z_] := If[ x > .5, 1/Sqrt[x y z + 10^-5], Sqrt[x y z] ] 34 | 35 | f[11][x_, y_, z_] := If[ x^2 + y^2 + z^2 < 1, 1, 0 ] 36 | 37 | -------------------------------------------------------------------------------- /src/suave/common.c: -------------------------------------------------------------------------------- 1 | /* 2 | common.c 3 | includes most of the modules 4 | this file is part of Suave 5 | last modified 29 Jul 13 th 6 | */ 7 | 8 | 9 | static inline Region *RegionAlloc(cThis *t, cnumber n, cnumber nnew) 10 | { 11 | csize_t size = sizeof(Region) + 12 | t->ncomp*sizeof(Result) + 13 | t->ndim*sizeof(Bounds) + 14 | t->ncomp*t->ndim*2*sizeof(real) + 15 | n*SAMPLESIZE + 16 | nnew*t->ndim*sizeof(bin_t); 17 | Region *p; 18 | MemAlloc(p, size); 19 | p->size = size; 20 | return p; 21 | } 22 | 23 | static inline bool BadDimension(cThis *t) 24 | { 25 | if( t->ndim > MAXDIM ) return true; 26 | return t->ndim < SOBOL_MINDIM || 27 | (t->seed == 0 && t->ndim > SOBOL_MAXDIM); 28 | } 29 | 30 | static inline bool BadComponent(cThis *t) 31 | { 32 | if( t->ncomp > MAXCOMP ) return true; 33 | return t->ncomp < 1; 34 | } 35 | 36 | #include "Random.c" 37 | #include "ChiSquare.c" 38 | #include "Grid.c" 39 | #include "Sample.c" 40 | #include "Fluct.c" 41 | 42 | -------------------------------------------------------------------------------- /tools/partview.m: -------------------------------------------------------------------------------- 1 | (* 2 | partview.m 3 | A partition viewer for Cuba results in Mathematica 4 | last modified 4 Feb 05 th 5 | *) 6 | 7 | 8 | BeginPackage["Cuba`"] 9 | 10 | PartView::usage = "For a Cuba result obtained with Regions -> True, 11 | PartView[result, dimx, dimy] displays the dimx-dimy plane of the 12 | tessellation used in the integration." 13 | 14 | Rect::usage = "Rect[{x1, y1}, {x2, y2}] is the graphics primitive used 15 | by PartView to render a rectangle." 16 | 17 | Begin["`PartView`"] 18 | 19 | PartView[expr_, dimx_Integer, dimy_Integer] := 20 | Block[ {r, g, maxarea}, 21 | r = Cases[expr, 22 | Region[ll_, ur_, ___] :> {ll[[{dimx, dimy}]], ur[[{dimx, dimy}]]}, 23 | Infinity]; 24 | maxarea = Times@@ (Max/@ #2 - Min/@ #1 &)@@ Transpose[r, {3, 1, 2}]; 25 | (Show[#]; #)& @ Graphics[Apply[Rect, r, 1], AspectRatio -> 1] 26 | ] 27 | 28 | maxarea = 1 29 | 30 | Rect[{l_, d_}, {r_, u_}] := { 31 | { Hue[0, (ArcSin[1 - (r - l) (u - d)/maxarea]/(Pi/2))^2, 1], 32 | Rectangle[{l, d}, {r, u}] }, 33 | { RGBColor[0, 0, 0], 34 | Line[{{l, d}, {r, d}, {r, u}, {l, u}, {l, d}}] } 35 | } 36 | 37 | End[] 38 | 39 | EndPackage[] 40 | 41 | -------------------------------------------------------------------------------- /src/common/Global.c: -------------------------------------------------------------------------------- 1 | /* 2 | Global.c 3 | set global vars 4 | by Thomas Hahn 5 | last modified 21 Jul 14 th 6 | */ 7 | 8 | 9 | #include "stddecl.h" 10 | 11 | 12 | coreinit cubafun_; 13 | extern int cubaverb_; 14 | 15 | #ifdef HAVE_FORK 16 | extern corespec cubaworkers_; 17 | #endif 18 | 19 | 20 | Extern void SUFFIX(cubaverbose)(cint verb) 21 | { 22 | cubaverb_ = verb; 23 | } 24 | 25 | /*********************************************************************/ 26 | 27 | Extern void SUFFIX(cubacores)(cint n, cint p) 28 | { 29 | #ifdef HAVE_FORK 30 | cubaworkers_.ncores = n; 31 | cubaworkers_.pcores = p; 32 | #endif 33 | } 34 | 35 | Extern void SUFFIX(cubaaccel)(cint n, cint p) 36 | { 37 | #ifdef HAVE_FORK 38 | cubaworkers_.naccel = n; 39 | cubaworkers_.paccel = p; 40 | #endif 41 | } 42 | 43 | /*********************************************************************/ 44 | 45 | Extern void SUFFIX(cubainit)(subroutine f, void *arg) 46 | { 47 | cubafun_.initfun = f; 48 | cubafun_.initarg = arg; 49 | } 50 | 51 | /*********************************************************************/ 52 | 53 | Extern void SUFFIX(cubaexit)(subroutine f, void *arg) 54 | { 55 | cubafun_.exitfun = f; 56 | cubafun_.exitarg = arg; 57 | } 58 | 59 | -------------------------------------------------------------------------------- /src/vegas/decl.h: -------------------------------------------------------------------------------- 1 | /* 2 | decl.h 3 | Type declarations 4 | this file is part of Vegas 5 | last modified 21 Jul 14 th 6 | */ 7 | 8 | 9 | #include "stddecl.h" 10 | 11 | #define MAXGRIDS 10 12 | 13 | #define NBINS 128 14 | 15 | typedef unsigned char bin_t; 16 | /* Note: bin_t must be wide enough to hold the numbers 0..NBINS */ 17 | 18 | typedef const bin_t cbin_t; 19 | 20 | typedef real Grid[NBINS]; 21 | 22 | typedef struct { 23 | real sum, sqsum; 24 | real weightsum, avgsum; 25 | real chisum, chisqsum, guess; 26 | real avg, err, chisq; 27 | } Cumulants; 28 | 29 | typedef const Cumulants cCumulants; 30 | 31 | typedef int (*Integrand)(ccount *, creal *, ccount *, real *, 32 | void *, cnumber *, cint *, creal *, cint *); 33 | 34 | typedef struct _this { 35 | count ndim, ncomp; 36 | #ifndef MLVERSION 37 | Integrand integrand; 38 | void *userdata; 39 | number nvec; 40 | #ifdef HAVE_FORK 41 | SHM_ONLY(int shmid;) 42 | Spin *spin; 43 | #endif 44 | #endif 45 | real *frame; 46 | real epsrel, epsabs; 47 | int flags, seed; 48 | number mineval, maxeval; 49 | number nstart, nincrease, nbatch; 50 | int gridno; 51 | cchar *statefile; 52 | number neval; 53 | RNGState rng; 54 | jmp_buf abort; 55 | } This; 56 | 57 | #define nframe nbatch 58 | 59 | typedef const This cThis; 60 | 61 | static Grid *gridptr_[MAXGRIDS]; 62 | static count griddim_[MAXGRIDS]; 63 | 64 | -------------------------------------------------------------------------------- /src/common/ChiSquare.c: -------------------------------------------------------------------------------- 1 | /* 2 | ChiSquare.c 3 | the chi-square cdf 4 | after W.J. Kennedy and J.E. Gentle, 5 | Statistical computing, p. 116 6 | last modified 9 Feb 05 th 7 | */ 8 | 9 | #ifdef HAVE_ERF 10 | #define Erf erf 11 | #else 12 | #include "Erf.c" 13 | #endif 14 | 15 | static inline real Normal(creal x) 16 | { 17 | return .5*Erf(x/1.414213562373095048801689) + .5; 18 | } 19 | 20 | /*********************************************************************/ 21 | 22 | static real ChiSquare(creal x, cint df) 23 | { 24 | real y; 25 | 26 | if( df <= 0 ) return -999; 27 | 28 | if( x <= 0 ) return 0; 29 | if( x > 1000*df ) return 1; 30 | 31 | if( df > 1000 ) { 32 | if( x < 2 ) return 0; 33 | y = 2./(9*df); 34 | y = (pow(x/df, 1/3.) - (1 - y))/sqrt(y); 35 | if( y > 5 ) return 1; 36 | if( y < -18.8055 ) return 0; 37 | return Normal(y); 38 | } 39 | 40 | y = .5*x; 41 | 42 | if( df & 1 ) { 43 | creal sqrty = sqrt(y); 44 | real h = Erf(sqrty); 45 | count i; 46 | 47 | if( df == 1 ) return h; 48 | 49 | y = sqrty*exp(-y)/.8862269254527579825931; 50 | for( i = 3; i < df; i += 2 ) { 51 | h -= y; 52 | y *= x/i; 53 | } 54 | y = h - y; 55 | } 56 | else { 57 | real term = exp(-y), sum = term; 58 | count i; 59 | 60 | for( i = 1; i < df/2; ++i ) 61 | sum += term *= y/i; 62 | y = 1 - sum; 63 | } 64 | 65 | return Max(0., y); 66 | } 67 | 68 | -------------------------------------------------------------------------------- /tools/fcc: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | # script to compile C programs that are linked 3 | # against Fortran libraries 4 | # last modified 4 Nov 14 th 5 | 6 | args= 7 | compileonly= 8 | objs= 9 | ldflags= 10 | fldflags= 11 | 12 | cc="${REALCC:-cc}" 13 | cxx="${REALCXX:-c++}" 14 | test `basename $0 .in` = f++ && cc="$cxx" 15 | case `$cxx --version 2>&1` in 16 | *clang*) cxx="$cxx -stdlib=libstdc++" ;; 17 | esac 18 | 19 | while test $# -gt 0 ; do 20 | case "$1" in 21 | -st | -b32 | -b64) 22 | ;; # ignore mcc-specific flags 23 | -arch) 24 | shift 25 | ;; 26 | -lstdc++) 27 | cc="$cxx" 28 | ;; # or else -static-libstdc++ has no effect 29 | -Wno-long-double) 30 | ;; # mcc adds this on Macs & gcc 4 doesn't like it 31 | -L*CompilerAdditions*) 32 | ldflags="$ldflags '$1'" 33 | mldir=`echo "$1" | sed ' 34 | s/^-L// 35 | s/Links.MathLink.DeveloperKit/Libraries/ 36 | s/CompilerAdditions.*$//'` 37 | test -f "$mldir/libuuid.a" && { 38 | ldflags="$ldflads '-L$mldir'" 39 | fldflags="$fldflags -luuid" 40 | } 41 | ;; 42 | -[Ll]* | -Wl*) 43 | ldflags="$ldflags '$1'" 44 | ;; 45 | *.tm.o) 46 | objs="'$1' $objs" 47 | ;; 48 | *.a | *.o | *.so) 49 | objs="$objs '$1'" 50 | ;; 51 | *.cc) 52 | args="$args '$1'" 53 | cc="$cxx" 54 | ;; 55 | -c) 56 | compileonly="-c" 57 | ;; 58 | -o) 59 | args="$args -o '$2'" 60 | shift 61 | ;; 62 | *) 63 | args="$args '$1'" 64 | ;; 65 | esac 66 | shift 67 | done 68 | 69 | eval "set -x ; exec $cc $args ${compileonly:-$objs $ldflags $fldflags}" 70 | 71 | -------------------------------------------------------------------------------- /src/common/Erf.c: -------------------------------------------------------------------------------- 1 | /* 2 | Erf.c 3 | Gaussian error function 4 | = 2/Sqrt[Pi] Integrate[Exp[-t^2], {t, 0, x}] 5 | Code from Takuya Ooura's gamerf2a.f 6 | http://www.kurims.kyoto-u.ac.jp/~ooura/gamerf.html 7 | last modified 8 Feb 05 th 8 | */ 9 | 10 | 11 | static real Erfc(creal x) 12 | { 13 | static creal c[] = { 14 | 2.96316885199227378e-01, 6.12158644495538758e-02, 15 | 1.81581125134637070e-01, 5.50942780056002085e-01, 16 | 6.81866451424939493e-02, 1.53039662058770397e+00, 17 | 1.56907543161966709e-02, 2.99957952311300634e+00, 18 | 2.21290116681517573e-03, 4.95867777128246701e+00, 19 | 1.91395813098742864e-04, 7.41471251099335407e+00, 20 | 9.71013284010551623e-06, 1.04765104356545238e+01, 21 | 1.66642447174307753e-07, 1.48455557345597957e+01, 22 | 6.10399733098688199e+00, 1.26974899965115684e+01 }; 23 | real y = x*x; 24 | y = exp(-y)*x*( 25 | c[0]/(y + c[1]) + c[2]/(y + c[3]) + 26 | c[4]/(y + c[5]) + c[6]/(y + c[7]) + 27 | c[8]/(y + c[9]) + c[10]/(y + c[11]) + 28 | c[12]/(y + c[13]) + c[14]/(y + c[15]) ); 29 | if( x < c[16] ) y += 2/(exp(c[17]*x) + 1); 30 | return y; 31 | } 32 | 33 | 34 | static real Erf(creal x) 35 | { 36 | static creal c[] = { 37 | 1.12837916709551257e+00, 38 | -3.76126389031833602e-01, 39 | 1.12837916706621301e-01, 40 | -2.68661698447642378e-02, 41 | 5.22387877685618101e-03, 42 | -8.49202435186918470e-04 }; 43 | real y = fabs(x); 44 | if( y > .125 ) { 45 | y = 1 - Erfc(y); 46 | return (x > 0) ? y : -y; 47 | } 48 | y *= y; 49 | return x*(c[0] + y*(c[1] + y*(c[2] + 50 | y*(c[3] + y*(c[4] + y*c[5]))))); 51 | } 52 | -------------------------------------------------------------------------------- /src/suave/decl.h: -------------------------------------------------------------------------------- 1 | /* 2 | decl.h 3 | Type declarations 4 | this file is part of Suave 5 | last modified 25 Nov 14 th 6 | */ 7 | 8 | 9 | #include "stddecl.h" 10 | 11 | #define MINSAMPLES 10 12 | 13 | #define NBINS 64 14 | 15 | typedef unsigned char bin_t; 16 | /* Note: bin_t must be wide enough to hold the numbers 0..NBINS */ 17 | 18 | typedef const bin_t cbin_t; 19 | 20 | typedef real Grid[NBINS]; 21 | 22 | typedef const Grid cGrid; 23 | 24 | typedef struct { 25 | real avg, err, sigsq, chisq; 26 | } Result; 27 | 28 | typedef const Result cResult; 29 | 30 | typedef struct { 31 | real lower, upper; 32 | Grid grid; 33 | } Bounds; 34 | 35 | typedef const Bounds cBounds; 36 | 37 | typedef int (*Integrand)(ccount *, creal *, ccount *, real *, 38 | void *, cnumber *, cint *, creal *, cint *); 39 | 40 | typedef struct _this { 41 | count ndim, ncomp; 42 | #ifndef MLVERSION 43 | Integrand integrand; 44 | void *userdata; 45 | number nvec; 46 | #ifdef HAVE_FORK 47 | SHM_ONLY(int shmid;) 48 | Spin *spin; 49 | real *frame; 50 | #endif 51 | #endif 52 | real epsrel, epsabs; 53 | int flags, seed; 54 | number mineval, maxeval; 55 | number nnew, nmin; 56 | real flatness; 57 | cchar *statefile; 58 | count nregions; 59 | number neval; 60 | RNGState rng; 61 | jmp_buf abort; 62 | } This; 63 | 64 | #define nframe nnew 65 | 66 | typedef const This cThis; 67 | 68 | typedef struct region { 69 | struct region *next; 70 | size_t size; 71 | count div, df; 72 | number n; 73 | Result result[]; 74 | } Region; 75 | 76 | #define RegionBounds(r) ((Bounds *)(r->result + t->ncomp)) 77 | #define RegionW(r) ((real *)(RegionBounds(r) + t->ndim)) 78 | 79 | -------------------------------------------------------------------------------- /src/suave/Fluct.c: -------------------------------------------------------------------------------- 1 | /* 2 | Fluct.c 3 | compute the fluctuation in the left and right half 4 | this file is part of Suave 5 | last modified 29 Jul 13 th 6 | */ 7 | 8 | 9 | #if defined(HAVE_LONG_DOUBLE) && defined(HAVE_POWL) 10 | 11 | typedef long double realx; 12 | #define XDBL_MAX_EXP LDBL_MAX_EXP 13 | #define XDBL_MAX LDBL_MAX 14 | #define powx powl 15 | #define ldexpx ldexpl 16 | 17 | #else 18 | 19 | typedef double realx; 20 | #define XDBL_MAX_EXP DBL_MAX_EXP 21 | #define XDBL_MAX DBL_MAX 22 | #define powx pow 23 | #define ldexpx ldexp 24 | 25 | #endif 26 | 27 | typedef const realx crealx; 28 | 29 | typedef struct { 30 | realx fluct; 31 | number n; 32 | } Var; 33 | 34 | /*********************************************************************/ 35 | 36 | static void Fluct(cThis *t, Var *var, 37 | cBounds *b, creal *w, number n, ccount comp, creal avg, creal err) 38 | { 39 | creal *x = w + n; 40 | creal *f = x + n*t->ndim + comp; 41 | count nvar = 2*t->ndim; 42 | creal norm = 1/(err*Max(fabs(avg), err)); 43 | creal flat = 2/3./t->flatness; 44 | crealx max = ldexpx(1., (int)((XDBL_MAX_EXP - 2)/t->flatness)); 45 | 46 | Clear(var, nvar); 47 | 48 | while( n-- ) { 49 | count dim; 50 | crealx arg = 1 + fabs(*w++)*Sq(*f - avg)*norm; 51 | crealx ft = powx(arg < max ? arg : max, t->flatness); 52 | 53 | f += t->ncomp; 54 | 55 | for( dim = 0; dim < t->ndim; ++dim ) { 56 | Var *v = &var[2*dim + (*x++ >= .5*(b[dim].lower + b[dim].upper))]; 57 | crealx f = v->fluct + ft; 58 | v->fluct = (f > XDBL_MAX/2) ? XDBL_MAX/2 : f; 59 | ++v->n; 60 | } 61 | } 62 | 63 | while( nvar-- ) { 64 | var->fluct = powx(var->fluct, flat); 65 | ++var; 66 | } 67 | } 68 | 69 | -------------------------------------------------------------------------------- /src/cuhre/decl.h: -------------------------------------------------------------------------------- 1 | /* 2 | decl.h 3 | Type declarations 4 | this file is part of Cuhre 5 | last modified 21 Jul 14 th 6 | */ 7 | 8 | 9 | #include "stddecl.h" 10 | 11 | typedef struct { 12 | real avg, err; 13 | count bisectdim; 14 | } Result; 15 | 16 | typedef const Result cResult; 17 | 18 | typedef struct { 19 | real avg, err, lastavg, lasterr; 20 | real weightsum, avgsum; 21 | real guess, chisum, chisqsum, chisq; 22 | } Totals; 23 | 24 | typedef const Totals cTotals; 25 | 26 | typedef struct { 27 | real lower, upper; 28 | } Bounds; 29 | 30 | typedef const Bounds cBounds; 31 | 32 | enum { nrules = 5 }; 33 | 34 | typedef struct { 35 | count n; 36 | real weight[nrules], scale[nrules], norm[nrules]; 37 | real gen[]; 38 | } Set; 39 | 40 | #define SetSize (sizeof(Set) + t->ndim*sizeof(real)) 41 | 42 | typedef struct { 43 | Set *first, *last; 44 | real errcoeff[3]; 45 | count n; 46 | } Rule; 47 | 48 | typedef const Rule cRule; 49 | 50 | typedef int (*Integrand)(ccount *, creal *, ccount *, real *, 51 | void *, cnumber *, cint *); 52 | 53 | typedef struct _this { 54 | count ndim, ncomp; 55 | #ifndef MLVERSION 56 | Integrand integrand; 57 | void *userdata; 58 | number nvec; 59 | #ifdef HAVE_FORK 60 | SHM_ONLY(int shmid;) 61 | Spin *spin; 62 | #endif 63 | #endif 64 | real *frame; 65 | real epsrel, epsabs; 66 | int flags; 67 | number mineval, maxeval; 68 | count key, nregions; 69 | cchar *statefile; 70 | number neval; 71 | Rule rule; 72 | jmp_buf abort; 73 | } This; 74 | 75 | #define nframe rule.n 76 | 77 | typedef const This cThis; 78 | 79 | typedef struct region { 80 | count div; 81 | Bounds bounds[]; 82 | } Region; 83 | 84 | #define RegionSize (sizeof(Region) + t->ndim*sizeof(Bounds) + t->ncomp*sizeof(Result)) 85 | 86 | #define RegionResult(r) ((Result *)(r->bounds + t->ndim)) 87 | 88 | #define RegionPtr(p, n) ((Region *)((char *)p->region + (n)*regionsize)) 89 | 90 | -------------------------------------------------------------------------------- /src/common/sock.h: -------------------------------------------------------------------------------- 1 | /* 2 | sock.h 3 | socket read/write 4 | by Thomas Hahn 5 | last modified 27 May 14 th 6 | */ 7 | 8 | #include 9 | 10 | #ifdef DEBUG 11 | #define TERM_RED "\e[31m" 12 | #define TERM_BLUE "\e[34m" 13 | #define TERM_RESET "\e[0m\n" 14 | #define MASTER(s, ...) \ 15 | fprintf(stderr, TERM_RED ROUTINE " master %d(%d): " s TERM_RESET, core, getpid(), ##__VA_ARGS__) 16 | #define WORKER(s, ...) \ 17 | fprintf(stderr, TERM_BLUE ROUTINE " worker %d(%d): " s TERM_RESET, core, getpid(), ##__VA_ARGS__) 18 | #define DEB_ONLY(...) __VA_ARGS__ 19 | #else 20 | #define MASTER(s, ...) 21 | #define WORKER(s, ...) 22 | #define DEB_ONLY(...) 23 | #endif 24 | 25 | #ifdef LOW_LEVEL_DEBUG 26 | #define TERM_GREEN "\e[32m" 27 | #define TERM_MAGENTA "\e[35m" 28 | #define READ(s, ...) \ 29 | fprintf(stderr, TERM_GREEN ROUTINE " pid %d: read " s TERM_RESET, getpid(), ##__VA_ARGS__) 30 | #define WRITE(s, ...) \ 31 | fprintf(stderr, TERM_MAGENTA ROUTINE " pid %d: write " s TERM_RESET, getpid(), ##__VA_ARGS__) 32 | #else 33 | #define READ(s, ...) 34 | #define WRITE(s, ...) 35 | #endif 36 | 37 | /*********************************************************************/ 38 | 39 | #ifndef MSG_WAITALL 40 | /* Windows */ 41 | #define MSG_WAITALL 0 42 | #endif 43 | 44 | static inline int readsock(cint fd, void *data, csize_t n) 45 | { 46 | ssize_t got; 47 | size_t remain = n; 48 | do got = recv(fd, data, remain, MSG_WAITALL); 49 | while( got > 0 && (data += got, remain -= got) > 0 ); 50 | READ("%lu bytes at %p from fd %d", n, data, fd); 51 | return got; 52 | } 53 | 54 | /*********************************************************************/ 55 | 56 | static inline int writesock(cint fd, const void *data, csize_t n) 57 | { 58 | ssize_t got; 59 | size_t remain = n; 60 | do got = send(fd, data, remain, MSG_WAITALL); 61 | while( got > 0 && (data += got, remain -= got) > 0 ); 62 | WRITE("%lu bytes at %p to fd %d", n, data, fd); 63 | return got; 64 | } 65 | 66 | -------------------------------------------------------------------------------- /src/divonne/common.c: -------------------------------------------------------------------------------- 1 | /* 2 | common.c 3 | includes most of the modules 4 | this file is part of Divonne 5 | last modified 29 Jul 13 th 6 | */ 7 | 8 | 9 | #include "Random.c" 10 | #include "ChiSquare.c" 11 | #include "Rule.c" 12 | #include "Sample.c" 13 | #include "FindMinimum.c" 14 | #include "Split.c" 15 | #include "Explore.c" 16 | #include "Iterate.c" 17 | 18 | static inline bool BadDimension(cThis *t, ccount key) 19 | { 20 | if( t->ndim > MAXDIM ) return true; 21 | if( IsSobol(key) ) return 22 | t->ndim < SOBOL_MINDIM || (t->seed == 0 && t->ndim > SOBOL_MAXDIM); 23 | if( IsRule(key, t->ndim) ) return t->ndim < 1; 24 | return t->ndim < KOROBOV_MINDIM || t->ndim > KOROBOV_MAXDIM; 25 | } 26 | 27 | static inline bool BadComponent(cThis *t) 28 | { 29 | if( t->ncomp > MAXCOMP ) return true; 30 | return t->ncomp < 1; 31 | } 32 | 33 | static inline void AllocGiven(This *t) 34 | { 35 | real *xgiven = NULL, *fgiven = NULL; 36 | 37 | if( t->ngiven | t->nextra ) { 38 | cnumber nxgiven = t->ngiven*t->ndim; 39 | cnumber nxextra = t->nextra*t->ndim; 40 | cnumber nfgiven = t->ngiven*t->ncomp; 41 | cnumber nfextra = t->nextra*t->ncomp; 42 | 43 | Alloc(xgiven, nxgiven + nxextra + nfgiven + nfextra); 44 | t->xextra = xgiven + nxgiven; 45 | fgiven = t->xextra + nxextra; 46 | t->fextra = fgiven + nfgiven; 47 | 48 | if( nxgiven ) { 49 | #ifdef MLVERSION 50 | Copy(xgiven, t->xgiven, nxgiven); 51 | Copy(fgiven, t->fgiven, nfgiven); 52 | #else 53 | if( t->ldxgiven == t->ndim ) 54 | Copy(xgiven, t->xgiven, nxgiven); 55 | else { 56 | number i; 57 | real *sgiven = t->xgiven, *dgiven = xgiven; 58 | for( i = 0; i < t->ngiven; ++i ) { 59 | Copy(dgiven, sgiven, t->ndim); 60 | sgiven += t->ldxgiven; 61 | dgiven += t->ndim; 62 | } 63 | } 64 | t->phase = 0; 65 | DoSample(t, t->ngiven, xgiven, fgiven); 66 | #endif 67 | } 68 | } 69 | 70 | t->xgiven = xgiven; 71 | t->fgiven = fgiven; 72 | } 73 | 74 | -------------------------------------------------------------------------------- /src/common/CSample.c: -------------------------------------------------------------------------------- 1 | /* 2 | CSample.c 3 | the serial sampling routine 4 | for the C versions of the Cuba routines 5 | by Thomas Hahn 6 | last modified 9 Oct 14 th 7 | */ 8 | 9 | 10 | coreinit cubafun_; 11 | extern int cubaverb_; 12 | extern corespec cubaworkers_; 13 | 14 | 15 | static inline number SampleRaw(This *t, number n, creal *x, real *f, 16 | cint core VES_ONLY(, creal *w, ccount iter)) 17 | { 18 | number nvec; 19 | for( nvec = t->nvec; n > 0; n -= nvec ) { 20 | nvec = IMin(n, nvec); 21 | if( t->integrand(&t->ndim, x, &t->ncomp, f, t->userdata, &nvec, &core 22 | VES_ONLY(, w, &iter) 23 | DIV_ONLY(, &t->phase)) == ABORT ) return -1; 24 | VES_ONLY(w += nvec;) 25 | x += nvec*t->ndim; 26 | f += nvec*t->ncomp; 27 | } 28 | return 0; 29 | } 30 | 31 | /*********************************************************************/ 32 | 33 | static inline void DoSampleSerial(This *t, cnumber n, creal *x, real *f 34 | VES_ONLY(, creal *w, ccount iter)) 35 | { 36 | MasterInit(); 37 | t->neval += n; 38 | if( SampleRaw(t, n, x, f, -1 VES_ONLY(, w, iter)) ) 39 | longjmp(t->abort, -99); 40 | } 41 | 42 | /*********************************************************************/ 43 | 44 | #ifdef HAVE_FORK 45 | 46 | static void DoSample(This *t, number n, creal *x, real *f 47 | VES_ONLY(, creal *w, ccount iter)); 48 | DIV_ONLY(static int Explore(This *t, cint iregion);) 49 | 50 | #else 51 | 52 | #define DoSample DoSampleSerial 53 | #define Explore ExploreSerial 54 | #define ForkCores(t) 55 | 56 | static inline void WaitCores(This *t, Spin **pspin) 57 | { 58 | if( Invalid(pspin) ) MasterExit(); 59 | } 60 | 61 | #define WaitCores(t, pspin) 62 | 63 | #endif 64 | 65 | #ifdef DIVONNE 66 | static inline count SampleExtra(This *t, cBounds *b) 67 | { 68 | number n = t->nextra; 69 | t->peakfinder(&t->ndim, b, &n, t->xextra, t->userdata); 70 | DoSample(t, n, t->xextra, t->fextra); 71 | return n; 72 | } 73 | #endif 74 | 75 | #include "common.c" 76 | 77 | #ifdef HAVE_FORK 78 | #include "Parallel.c" 79 | #endif 80 | 81 | #include "Integrate.c" 82 | 83 | -------------------------------------------------------------------------------- /src/cuhre/Cuhre.c: -------------------------------------------------------------------------------- 1 | /* 2 | Cuhre.c 3 | Adaptive integration using cubature rules 4 | by Thomas Hahn 5 | last modified 22 Jul 14 th 6 | */ 7 | 8 | 9 | #define CUHRE 10 | #define ROUTINE "Cuhre" 11 | 12 | #include "decl.h" 13 | #include "CSample.c" 14 | 15 | /*********************************************************************/ 16 | 17 | Extern void EXPORT(Cuhre)(ccount ndim, ccount ncomp, 18 | Integrand integrand, void *userdata, cnumber nvec, 19 | creal epsrel, creal epsabs, 20 | cint flags, cnumber mineval, cnumber maxeval, 21 | ccount key, cchar *statefile, Spin **pspin, 22 | count *pnregions, number *pneval, int *pfail, 23 | real *integral, real *error, real *prob) 24 | { 25 | This t; 26 | 27 | VerboseInit(); 28 | 29 | t.ndim = ndim; 30 | t.ncomp = ncomp; 31 | t.integrand = integrand; 32 | t.userdata = userdata; 33 | t.nvec = nvec; 34 | t.epsrel = epsrel; 35 | t.epsabs = epsabs; 36 | t.flags = MaxVerbose(flags); 37 | t.mineval = mineval; 38 | t.maxeval = maxeval; 39 | t.key = key; 40 | t.statefile = statefile; 41 | FORK_ONLY(t.spin = Invalid(pspin) ? NULL : *pspin;) 42 | 43 | *pfail = Integrate(&t, integral, error, prob); 44 | *pnregions = t.nregions; 45 | *pneval = t.neval; 46 | 47 | WaitCores(&t, pspin); 48 | } 49 | 50 | /*********************************************************************/ 51 | 52 | Extern void EXPORT(cuhre)(ccount *pndim, ccount *pncomp, 53 | Integrand integrand, void *userdata, cnumber *pnvec, 54 | creal *pepsrel, creal *pepsabs, 55 | cint *pflags, cnumber *pmineval, cnumber *pmaxeval, 56 | ccount *pkey, cchar *statefile, Spin **pspin, 57 | count *pnregions, number *pneval, int *pfail, 58 | real *integral, real *error, real *prob, cint statefilelen) 59 | { 60 | This t; 61 | 62 | VerboseInit(); 63 | 64 | t.ndim = *pndim; 65 | t.ncomp = *pncomp; 66 | t.integrand = integrand; 67 | t.userdata = userdata; 68 | t.nvec = *pnvec; 69 | t.epsrel = *pepsrel; 70 | t.epsabs = *pepsabs; 71 | t.flags = MaxVerbose(*pflags); 72 | t.mineval = *pmineval; 73 | t.maxeval = *pmaxeval; 74 | t.key = *pkey; 75 | CString(t.statefile, statefile, statefilelen); 76 | FORK_ONLY(t.spin = Invalid(pspin) ? NULL : *pspin;) 77 | 78 | *pfail = Integrate(&t, integral, error, prob); 79 | *pnregions = t.nregions; 80 | *pneval = t.neval; 81 | 82 | WaitCores(&t, pspin); 83 | } 84 | 85 | -------------------------------------------------------------------------------- /src/common/MSample.c: -------------------------------------------------------------------------------- 1 | /* 2 | MSample.c 3 | the sampling routine for the 4 | Mathematica versions of the Cuba routines 5 | by Thomas Hahn 6 | last modified 26 Nov 14 th 7 | */ 8 | 9 | 10 | #if MLINTERFACE < 4 11 | #define MLReleaseRealList MLDisownRealList 12 | #endif 13 | 14 | 15 | static void DoSample(This *t, cnumber n, real *x, real *f 16 | VES_ONLY(, real *w, ccount iter)) 17 | { 18 | real *mma_f; 19 | long mma_n; 20 | 21 | if( MLAbort ) longjmp(t->abort, -99); 22 | 23 | MLPutFunction(stdlink, "EvaluatePacket", 1); 24 | MLPutFunction(stdlink, "Cuba`" ROUTINE "`sample", 1 VES_ONLY(+2) DIV_ONLY(+1)); 25 | MLPutRealList(stdlink, x, n*t->ndim); 26 | VES_ONLY(MLPutRealList(stdlink, w, n); 27 | MLPutInteger(stdlink, iter);) 28 | DIV_ONLY(MLPutInteger(stdlink, t->phase);) 29 | MLEndPacket(stdlink); 30 | 31 | MLNextPacket(stdlink); 32 | if( !MLGetRealList(stdlink, &mma_f, &mma_n) ) { 33 | MLClearError(stdlink); 34 | MLNewPacket(stdlink); 35 | longjmp(t->abort, -99); 36 | } 37 | 38 | t->neval += mma_n; 39 | 40 | if( mma_n != n*t->ncomp ) { 41 | MLReleaseRealList(stdlink, mma_f, mma_n); 42 | longjmp(t->abort, -3); 43 | } 44 | 45 | Copy(f, mma_f, n*t->ncomp); 46 | MLReleaseRealList(stdlink, mma_f, mma_n); 47 | } 48 | 49 | /*********************************************************************/ 50 | 51 | #ifdef DIVONNE 52 | #define Explore ExploreSerial 53 | 54 | static count SampleExtra(This *t, cBounds *b) 55 | { 56 | count n, nget; 57 | real *mma_f; 58 | long mma_n; 59 | 60 | MLPutFunction(stdlink, "EvaluatePacket", 1); 61 | MLPutFunction(stdlink, "Cuba`Divonne`findpeak", 2); 62 | MLPutRealList(stdlink, (real *)b, 2*t->ndim); 63 | MLPutInteger(stdlink, t->phase); 64 | MLEndPacket(stdlink); 65 | 66 | MLNextPacket(stdlink); 67 | if( !MLGetRealList(stdlink, &mma_f, &mma_n) ) { 68 | MLClearError(stdlink); 69 | MLNewPacket(stdlink); 70 | longjmp(t->abort, -99); 71 | } 72 | 73 | t->neval += nget = mma_n/(t->ndim + t->ncomp); 74 | 75 | n = IMin(nget, t->nextra); 76 | if( n ) { 77 | Copy(t->xextra, mma_f, n*t->ndim); 78 | Copy(t->fextra, mma_f + nget*t->ndim, n*t->ncomp); 79 | } 80 | 81 | MLReleaseRealList(stdlink, mma_f, mma_n); 82 | 83 | return n; 84 | } 85 | #endif 86 | 87 | /*********************************************************************/ 88 | 89 | #include "common.c" 90 | 91 | #define ForkCores(t) 92 | #define WaitCores(t) 93 | 94 | #include "Integrate.c" 95 | 96 | -------------------------------------------------------------------------------- /src/vegas/Vegas.c: -------------------------------------------------------------------------------- 1 | /* 2 | Vegas.c 3 | Vegas Monte Carlo integration 4 | by Thomas Hahn 5 | last modified 25 Nov 14 th 6 | */ 7 | 8 | 9 | #define VEGAS 10 | #define ROUTINE "Vegas" 11 | 12 | #include "decl.h" 13 | #include "CSample.c" 14 | 15 | /*********************************************************************/ 16 | 17 | Extern void EXPORT(Vegas)(ccount ndim, ccount ncomp, 18 | Integrand integrand, void *userdata, cnumber nvec, 19 | creal epsrel, creal epsabs, cint flags, cint seed, 20 | cnumber mineval, cnumber maxeval, 21 | cnumber nstart, cnumber nincrease, 22 | cnumber nbatch, cint gridno, 23 | cchar *statefile, Spin **pspin, 24 | number *pneval, int *pfail, 25 | real *integral, real *error, real *prob) 26 | { 27 | This t; 28 | 29 | VerboseInit(); 30 | 31 | t.ndim = ndim; 32 | t.ncomp = ncomp; 33 | t.integrand = integrand; 34 | t.userdata = userdata; 35 | t.nvec = nvec; 36 | t.epsrel = epsrel; 37 | t.epsabs = epsabs; 38 | t.flags = MaxVerbose(flags); 39 | t.seed = seed; 40 | t.mineval = mineval; 41 | t.maxeval = maxeval; 42 | t.nstart = nstart; 43 | t.nincrease = nincrease; 44 | t.nbatch = nbatch; 45 | t.gridno = gridno; 46 | t.statefile = statefile; 47 | FORK_ONLY(t.spin = Invalid(pspin) ? NULL : *pspin;) 48 | 49 | *pfail = Integrate(&t, integral, error, prob); 50 | *pneval = t.neval; 51 | 52 | WaitCores(&t, pspin); 53 | } 54 | 55 | /*********************************************************************/ 56 | 57 | Extern void EXPORT(vegas)(ccount *pndim, ccount *pncomp, 58 | Integrand integrand, void *userdata, cnumber *pnvec, 59 | creal *pepsrel, creal *pepsabs, cint *pflags, cint *pseed, 60 | cnumber *pmineval, cnumber *pmaxeval, 61 | cnumber *pnstart, cnumber *pnincrease, 62 | cnumber *pnbatch, cint *pgridno, 63 | cchar *statefile, Spin **pspin, 64 | number *pneval, int *pfail, 65 | real *integral, real *error, real *prob, cint statefilelen) 66 | { 67 | This t; 68 | 69 | VerboseInit(); 70 | 71 | t.ndim = *pndim; 72 | t.ncomp = *pncomp; 73 | t.integrand = integrand; 74 | t.userdata = userdata; 75 | t.nvec = *pnvec; 76 | t.epsrel = *pepsrel; 77 | t.epsabs = *pepsabs; 78 | t.flags = MaxVerbose(*pflags); 79 | t.seed = *pseed; 80 | t.mineval = *pmineval; 81 | t.maxeval = *pmaxeval; 82 | t.nstart = *pnstart; 83 | t.nincrease = *pnincrease; 84 | t.nbatch = *pnbatch; 85 | t.gridno = *pgridno; 86 | CString(t.statefile, statefile, statefilelen); 87 | FORK_ONLY(t.spin = Invalid(pspin) ? NULL : *pspin;) 88 | 89 | *pfail = Integrate(&t, integral, error, prob); 90 | *pneval = t.neval; 91 | 92 | WaitCores(&t, pspin); 93 | } 94 | 95 | -------------------------------------------------------------------------------- /src/suave/Suave.c: -------------------------------------------------------------------------------- 1 | /* 2 | Suave.c 3 | Subregion-adaptive Vegas Monte Carlo integration 4 | by Thomas Hahn 5 | last modified 28 Nov 14 th 6 | */ 7 | 8 | 9 | #define SUAVE 10 | #define ROUTINE "Suave" 11 | 12 | #include "decl.h" 13 | #include "CSample.c" 14 | 15 | /*********************************************************************/ 16 | 17 | Extern void EXPORT(Suave)(ccount ndim, ccount ncomp, 18 | Integrand integrand, void *userdata, cnumber nvec, 19 | creal epsrel, creal epsabs, 20 | cint flags, cint seed, 21 | cnumber mineval, cnumber maxeval, 22 | cnumber nnew, cnumber nmin, creal flatness, 23 | cchar *statefile, Spin **pspin, 24 | count *pnregions, number *pneval, int *pfail, 25 | real *integral, real *error, real *prob) 26 | { 27 | This t; 28 | 29 | VerboseInit(); 30 | 31 | t.ndim = ndim; 32 | t.ncomp = ncomp; 33 | t.integrand = integrand; 34 | t.userdata = userdata; 35 | t.nvec = nvec; 36 | t.epsrel = epsrel; 37 | t.epsabs = epsabs; 38 | t.flags = MaxVerbose(flags); 39 | t.seed = seed; 40 | t.mineval = mineval; 41 | t.maxeval = maxeval; 42 | t.nnew = nnew; 43 | t.nmin = IMax(nmin, 2); 44 | t.flatness = flatness; 45 | t.statefile = statefile; 46 | FORK_ONLY(t.spin = Invalid(pspin) ? NULL : *pspin;) 47 | 48 | *pfail = Integrate(&t, integral, error, prob); 49 | *pnregions = t.nregions; 50 | *pneval = t.neval; 51 | 52 | WaitCores(&t, pspin); 53 | } 54 | 55 | /*********************************************************************/ 56 | 57 | Extern void EXPORT(suave)(ccount *pndim, ccount *pncomp, 58 | Integrand integrand, void *userdata, cnumber *pnvec, 59 | creal *pepsrel, creal *pepsabs, 60 | cint *pflags, cint *pseed, 61 | cnumber *pmineval, cnumber *pmaxeval, 62 | cnumber *pnnew, cnumber *pnmin, creal *pflatness, 63 | cchar *statefile, Spin **pspin, 64 | count *pnregions, number *pneval, int *pfail, 65 | real *integral, real *error, real *prob, cint statefilelen) 66 | { 67 | This t; 68 | 69 | VerboseInit(); 70 | 71 | t.ndim = *pndim; 72 | t.ncomp = *pncomp; 73 | t.integrand = integrand; 74 | t.userdata = userdata; 75 | t.nvec = *pnvec; 76 | t.epsrel = *pepsrel; 77 | t.epsabs = *pepsabs; 78 | t.flags = MaxVerbose(*pflags); 79 | t.seed = *pseed; 80 | t.mineval = *pmineval; 81 | t.maxeval = *pmaxeval; 82 | t.nnew = *pnnew; 83 | t.nmin = IMax(*pnmin, 2); 84 | t.flatness = *pflatness; 85 | CString(t.statefile, statefile, statefilelen); 86 | FORK_ONLY(t.spin = Invalid(pspin) ? NULL : *pspin;) 87 | 88 | *pfail = Integrate(&t, integral, error, prob); 89 | *pnregions = t.nregions; 90 | *pneval = t.neval; 91 | 92 | WaitCores(&t, pspin); 93 | } 94 | 95 | -------------------------------------------------------------------------------- /src/vegas/Grid.c: -------------------------------------------------------------------------------- 1 | /* 2 | Grid.c 3 | utility functions for the Vegas grid 4 | this file is part of Vegas 5 | last modified 13 Dec 11 th 6 | */ 7 | 8 | 9 | static inline void GetGrid(cThis *t, Grid *grid) 10 | { 11 | count bin, dim; 12 | unsigned const int slot = abs(t->gridno) - 1; 13 | 14 | if( t->gridno < 0 && slot < MAXGRIDS ) griddim_[slot] = 0; 15 | 16 | if( slot < MAXGRIDS && gridptr_[slot] ) { 17 | if( griddim_[slot] == t->ndim ) { 18 | XCopy(grid, gridptr_[slot]); 19 | return; 20 | } 21 | free(gridptr_[slot]); 22 | gridptr_[slot] = NULL; 23 | } 24 | 25 | for( bin = 0; bin < NBINS; ++bin ) 26 | grid[0][bin] = (bin + 1)/(real)NBINS; 27 | for( dim = 1; dim < t->ndim; ++dim ) 28 | Copy(&grid[dim], &grid[0], 1); 29 | } 30 | 31 | /*********************************************************************/ 32 | 33 | static inline void PutGrid(cThis *t, Grid *grid) 34 | { 35 | unsigned const int slot = abs(t->gridno) - 1; 36 | 37 | if( slot < MAXGRIDS ) { 38 | if( gridptr_[slot] == NULL ) Alloc(gridptr_[slot], t->ndim); 39 | griddim_[slot] = t->ndim; 40 | XCopy(gridptr_[slot], grid); 41 | } 42 | } 43 | 44 | /*********************************************************************/ 45 | 46 | static void RefineGrid(cThis *t, Grid grid, Grid margsum) 47 | { 48 | real avgperbin, thisbin, newcur, delta; 49 | Grid imp, newgrid; 50 | int bin, newbin; 51 | 52 | /* smooth the f^2 value stored for each bin */ 53 | real prev = margsum[0]; 54 | real cur = margsum[1]; 55 | real norm = margsum[0] = .5*(prev + cur); 56 | for( bin = 1; bin < NBINS - 1; ++bin ) { 57 | creal s = prev + cur; 58 | prev = cur; 59 | cur = margsum[bin + 1]; 60 | norm += margsum[bin] = (s + cur)/3.; 61 | } 62 | norm += margsum[NBINS - 1] = .5*(prev + cur); 63 | 64 | if( norm == 0 ) return; 65 | norm = 1/norm; 66 | 67 | /* compute the importance function for each bin */ 68 | avgperbin = 0; 69 | for( bin = 0; bin < NBINS; ++bin ) { 70 | real impfun = 0; 71 | if( margsum[bin] > 0 ) { 72 | creal r = margsum[bin]*norm; 73 | avgperbin += impfun = pow((r - 1)/log(r), 1.5); 74 | } 75 | imp[bin] = impfun; 76 | } 77 | avgperbin /= NBINS; 78 | 79 | /* redefine the size of each bin */ 80 | cur = newcur = 0; 81 | thisbin = 0; 82 | bin = -1; 83 | for( newbin = 0; newbin < NBINS - 1; ++newbin ) { 84 | while( thisbin < avgperbin ) { 85 | thisbin += imp[++bin]; 86 | prev = cur; 87 | cur = grid[bin]; 88 | } 89 | thisbin -= avgperbin; 90 | delta = (cur - prev)*thisbin; 91 | newgrid[newbin] = SHARPEDGES ? 92 | cur - delta/imp[bin] : 93 | (newcur = Max(newcur, 94 | cur - 2*delta/(imp[bin] + imp[IDim(bin - 1)]))); 95 | } 96 | Copy(grid, newgrid, NBINS - 1); 97 | grid[NBINS - 1] = 1; 98 | } 99 | 100 | -------------------------------------------------------------------------------- /demo/cuba.F: -------------------------------------------------------------------------------- 1 | * cuba.F 2 | * Fortran chooser for the Cuba routines 3 | * last modified 3 Feb 05 th 4 | 5 | #define VEGAS 1 6 | #define SUAVE 2 7 | #define DIVONNE 3 8 | #define CUHRE 4 9 | 10 | 11 | subroutine Cuba(method, ndim, ncomp, integrand, 12 | & integral, error, prob) 13 | implicit none 14 | integer method, ndim, ncomp 15 | external integrand 16 | double precision integral(*), error(*), prob(*) 17 | 18 | character*7 name(4) 19 | data name /"Vegas", "Suave", "Divonne", "Cuhre"/ 20 | 21 | integer mineval, maxeval, verbose, last 22 | double precision epsrel, epsabs 23 | parameter (epsrel = 1D-3) 24 | parameter (epsabs = 1D-12) 25 | parameter (verbose = 2) 26 | parameter (last = 4) 27 | parameter (mineval = 0) 28 | parameter (maxeval = 50000) 29 | 30 | integer nstart, nincrease 31 | parameter (nstart = 1000) 32 | parameter (nincrease = 500) 33 | 34 | integer nnew 35 | double precision flatness 36 | parameter (nnew = 1000) 37 | parameter (flatness = 25D0) 38 | 39 | integer key1, key2, key3, maxpass 40 | double precision border, maxchisq, mindeviation 41 | integer ngiven, ldxgiven, nextra 42 | parameter (key1 = 47) 43 | parameter (key2 = 1) 44 | parameter (key3 = 1) 45 | parameter (maxpass = 5) 46 | parameter (border = 0D0) 47 | parameter (maxchisq = 10D0) 48 | parameter (mindeviation = .25D0) 49 | parameter (ngiven = 0) 50 | parameter (ldxgiven = ndim) 51 | parameter (nextra = 0) 52 | 53 | integer key 54 | parameter (key = 0) 55 | 56 | integer nregions, neval, fail 57 | 58 | 59 | if( method .eq. VEGAS ) then 60 | 61 | call vegas(ndim, ncomp, integrand, 62 | & epsrel, epsabs, verbose, mineval, maxeval, 63 | & nstart, nincrease, 64 | & neval, fail, integral, error, prob) 65 | nregions = 1 66 | 67 | else if( method .eq. SUAVE ) then 68 | 69 | call suave(ndim, ncomp, integrand, 70 | & epsrel, epsabs, verbose + last, mineval, maxeval, 71 | & nnew, flatness, 72 | & nregions, neval, fail, integral, error, prob) 73 | 74 | else if( method .eq. DIVONNE ) then 75 | 76 | call divonne(ndim, ncomp, integrand, 77 | & epsrel, epsabs, verbose, mineval, maxeval, 78 | & key1, key2, key3, maxpass, 79 | & border, maxchisq, mindeviation, 80 | & ngiven, ldxgiven, 0, nextra, 0, 81 | & nregions, neval, fail, integral, error, prob) 82 | 83 | else if( method .eq. CUHRE ) then 84 | 85 | call cuhre(ndim, ncomp, integrand, 86 | & epsrel, epsabs, verbose + last, mineval, maxeval, 87 | & key, 88 | & nregions, neval, fail, integral, error, prob) 89 | 90 | else 91 | 92 | print *, "invalid method ", method 93 | return 94 | 95 | endif 96 | 97 | print *, "method =", name(method) 98 | print *, "nregions =", nregions 99 | print *, "neval =", neval 100 | print *, "fail =", fail 101 | print '(G20.12," +- ",G20.12," p = ",F8.3)', 102 | & (integral(c), error(c), prob(c), c = 1, ncomp) 103 | end 104 | 105 | -------------------------------------------------------------------------------- /tools/mcc: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | # this script jumps in if there is no working mcc on the path: 3 | # - on Mac OS it (hopefully) figures out the location of mcc, 4 | # - on Cygwin it substitutes mcc completely 5 | # last modified 14 Jul 14 th 6 | 7 | 8 | sdkpath() 9 | { 10 | mathcmd="$1" 11 | shift 12 | mathcmd=`IFS=: 13 | PATH="$PATH:$*" which $mathcmd` 14 | 15 | eval `"$mathcmd" -run ' 16 | Print["sysid=\"", $SystemID, "\""]; 17 | Print["topdir=\"", $TopDirectory, "\""]; 18 | Exit[]' < /dev/null | tr '\r' ' ' | tail -2` 19 | 20 | # check whether Cygwin's dlltool can handle 64-bit DLLs 21 | test "$sysid" = Windows-x86-64 && { 22 | ${DLLTOOL:-dlltool} --help | grep x86-64 > /dev/null || sysid=Windows 23 | } 24 | 25 | topdir=`cd "$topdir" ; echo $PWD` 26 | 27 | for sdk in \ 28 | "$topdir/SystemFiles/Links/MathLink/DeveloperKit/$sysid/CompilerAdditions" \ 29 | "$topdir/SystemFiles/Links/MathLink/DeveloperKit/CompilerAdditions" \ 30 | "$topdir/AddOns/MathLink/DeveloperKit/$sysid/CompilerAdditions" ; do 31 | test -d "$sdk" && return 32 | done 33 | 34 | echo "MathLink SDK not found" 1>&2 35 | exit 1 36 | } 37 | 38 | 39 | cygmcc() 40 | { 41 | sdkpath math \ 42 | "`cygpath '$ProgramW6432'`/Wolfram Research/Mathematica"/* \ 43 | "`cygpath '$PROGRAMFILES'`/Wolfram Research/Mathematica"/* \ 44 | "/cygdrive/c/Program Files/Wolfram Research/Mathematica"/* \ 45 | "/cygdrive/c/Program Files (x86)/Wolfram Research/Mathematica"/* 46 | 47 | for sdk in "$sdk"/m* ; do 48 | break 49 | done 50 | 51 | cache=MLcyg-cache 52 | test -d $cache || mkdir $cache 53 | 54 | for libname in "$sdk"/lib/ml*m.lib ; do 55 | : 56 | done 57 | dllname=`basename "$libname" m.lib` 58 | 59 | lib="$cache/${dllname}m" 60 | test -f "$lib.a" || { 61 | ( echo "EXPORTS" 62 | ${NM:-nm} -C --defined-only "$libname" | awk '/ T [^.]/ { print $3 }' 63 | ) > "$lib.def" 64 | ${DLLTOOL:-dlltool} -k --dllname "$dllname.dll" \ 65 | --def "$lib.def" --output-lib "$lib.a" 66 | } 67 | 68 | tmp= 69 | args="-DWIN$OSbits -I'$sdk/include'" 70 | for arg in "$@" ; do 71 | case "$arg" in 72 | *.tm) 73 | cp "$arg" "$arg.tm" 74 | "$sdk"/bin/mprep -lines -o "$arg.c" "$arg.tm" 75 | tmp="$tmp '$arg.c' '$arg.tm'" 76 | args="$args '$arg.c'" ;; 77 | *) 78 | args="$args '$arg'" ;; 79 | esac 80 | done 81 | 82 | trap "rm -f $tmp" 0 1 2 3 15 83 | eval "set -x ; ${CC:-gcc} $args $lib.a -mwindows" 84 | } 85 | 86 | 87 | macmcc() 88 | { 89 | sdkpath MathKernel \ 90 | /Applications/Mathematica*/Contents/MacOS \ 91 | $HOME/Desktop/Mathematica*/Contents/MacOS 92 | exec "$sdk/mcc" "$@" 93 | } 94 | 95 | 96 | defaultmcc() 97 | { 98 | sdkpath math \ 99 | /usr/local/bin \ 100 | /usr/local/Wolfram/bin \ 101 | /usr/local/Wolfram/Mathematica/*/Executables \ 102 | /opt/Wolfram/bin \ 103 | /opt/Wolfram/Mathematica/*/Executables 104 | exec "$sdk/mcc" "$@" 105 | } 106 | 107 | 108 | shopt -s nullglob 2> /dev/null 109 | 110 | case `uname -s` in 111 | Darwin) macmcc "$@" ;; 112 | CYG*) cygmcc "$@" ;; 113 | *) defaultmcc "$@" ;; 114 | esac 115 | 116 | -------------------------------------------------------------------------------- /configure.ac: -------------------------------------------------------------------------------- 1 | # Process this file with autoconf to produce a configure script. 2 | 3 | AC_PREREQ(2.59) 4 | AC_INIT([Cuba], [4.1], [hahn@feynarts.de]) 5 | AC_CONFIG_SRCDIR([cuba.h]) 6 | 7 | LIBS=-lm 8 | USER_CFLAGS="$CFLAGS" 9 | 10 | AC_ARG_VAR(MCFLAGS, [MathLink C compiler flags]) 11 | 12 | AC_PROG_CC 13 | AC_PROG_F77 14 | AC_PROG_RANLIB 15 | AC_PROG_INSTALL 16 | 17 | AS_IF([test "$GCC" = yes], 18 | [AS_CASE([`$CC --version 2>&1 < /dev/null`], 19 | [*LLVM*], [opt=-O3], 20 | [*gcc*4.2* | *gcc*4.4.3*], [opt=-O0], 21 | [opt=-O3]) 22 | CFLAGS=${USER_CFLAGS:-$opt -fomit-frame-pointer -ffast-math -Wall}], 23 | [CFLAGS=${USER_CFLAGS:--O}]) 24 | 25 | AC_C_CONST 26 | AC_C_INLINE 27 | AC_C_LONG_DOUBLE 28 | 29 | AC_TYPE_SIZE_T 30 | AC_TYPE_SSIZE_T 31 | AC_TYPE_PID_T 32 | 33 | AC_CHECK_FUNCS([powl]) 34 | AC_CHECK_FUNCS([erf]) 35 | AC_FUNC_FORK 36 | AC_FUNC_ALLOCA 37 | 38 | AC_DEFUN([chk_shmget], [dnl 39 | AC_REQUIRE([AC_CANONICAL_HOST]) 40 | AS_CASE([$host_os], 41 | [*cygwin*], [], 42 | [AC_CHECK_FUNCS([shmget])]) 43 | ]) 44 | chk_shmget 45 | AC_CHECK_FUNCS([getloadavg]) 46 | 47 | MAXDIM=${MAXDIM:-16} 48 | AC_ARG_WITH(maxdim, 49 | [AS_HELP_STRING([--with-maxdim=N], 50 | [the maximum dimension for integration, 51 | if variable-size array are not supported])], 52 | [MAXDIM=$withval]) 53 | 54 | MAXCOMP=${MAXCOMP:-4} 55 | AC_ARG_WITH(maxcomp, 56 | [AS_HELP_STRING([--with-maxcomp=N], 57 | [the maximum number of components of the integrand, 58 | if variable-size array are not supported])], 59 | [MAXCOMP=$withval]) 60 | 61 | AC_MSG_CHECKING([for variable-size arrays]) 62 | AC_COMPILE_IFELSE([AC_LANG_SOURCE(,[[ 63 | void test(int n) { 64 | char s[n]; 65 | } 66 | ]])], 67 | [AC_MSG_RESULT([yes])], 68 | [AC_MSG_RESULT([no, using MAXDIM=$MAXDIM and MAXCOMP=$MAXCOMP]) 69 | AC_DEFINE_UNQUOTED([NDIM], [$MAXDIM], [Maximum number of components]) 70 | AC_DEFINE_UNQUOTED([NCOMP], [$MAXCOMP], [Maximum number of dimensions])] 71 | ) 72 | 73 | AC_MSG_CHECKING([for MathLink]) 74 | cat > conftest.tm << _EOF_ 75 | :Begin: 76 | :Function: inc 77 | :Pattern: Inc[i_Integer] 78 | :Arguments: {i} 79 | :ArgumentTypes: {Integer} 80 | :ReturnType: Integer 81 | :End: 82 | 83 | #include "mathlink.h" 84 | 85 | static int inc(const int i) { return i + 1; } 86 | 87 | int main(int argc, char **argv) { 88 | return MLMain(argc, argv); 89 | } 90 | _EOF_ 91 | FCC="$srcdir/tools/fcc" 92 | rm -f conftest$EXEEXT 93 | MCSTDCPP= 94 | for MCSTDCPP in "" -stdlib=libstdc++ ; do 95 | REALCC="$CC" CC="$FCC" CXX="$FCC $MCSTDCPP" PATH="$PATH:$srcdir/tools" \ 96 | mcc $MCFLAGS $CFLAGS -o conftest$EXEEXT conftest.tm > /dev/null 2>&1 97 | AS_IF([test -x conftest$EXEEXT], [break]) 98 | done 99 | AS_IF([test -x conftest$EXEEXT], 100 | [AC_MSG_RESULT([yes]) 101 | MATH_DEFAULT=math], 102 | [AC_MSG_RESULT([no])]) 103 | AC_SUBST([MCSTDCPP]) 104 | AC_SUBST([MATH_DEFAULT]) 105 | 106 | AC_CHECK_PROGS([HAVE_QMAKE], [qmake]) 107 | AS_IF([test -n "$HAVE_QMAKE"], 108 | [AS_CASE([`qmake -v`], 109 | [*Qt?version?4*], [TOOLS_DEFAULT=tools])]) 110 | AC_SUBST([TOOLS_DEFAULT]) 111 | 112 | test -n "$F77" && DEMO_FORTRAN_DEFAULT=demo-fortran 113 | AC_SUBST([DEMO_FORTRAN_DEFAULT]) 114 | 115 | AC_CONFIG_HEADERS([config.h]) 116 | AC_CONFIG_FILES([makefile]) 117 | 118 | AC_OUTPUT 119 | 120 | -------------------------------------------------------------------------------- /demo/testsuite.m: -------------------------------------------------------------------------------- 1 | (* Test suite of Genz, used also by Sloan and Joe, and Novak and Ritter *) 2 | 3 | seed = 4711 4 | 5 | maxpoints = 150000 6 | 7 | repeat = 20 8 | 9 | 10 | (* Family 1: Oscillatory *) 11 | 12 | f[1][x_, c_, w_] := Cos[2 Pi w[[1]] + c.x] 13 | 14 | 15 | (* Family 2: Product peak *) 16 | 17 | f[2][x_, c_, w_] := Times@@ MapThread[f2a, {x, c, w}] 18 | 19 | f2a[xi_, ci_, wi_] := 1/(ci^-2 + (xi - wi)^2) 20 | 21 | 22 | (* Family 3: Corner peak *) 23 | 24 | f[3][x_, c_, w_] := (1 + c.x)^(-(Length[x] + 1)) 25 | 26 | 27 | (* Family 4: Gaussian *) 28 | 29 | f[4][x_, c_, w_] := Exp[Plus@@ MapThread[f4a, {x, c, w}]] 30 | 31 | f4a[xi_, ci_, wi_] := -ci^2 (xi - wi)^2 32 | 33 | 34 | (* Family 5: Exponential *) 35 | 36 | f[5][x_, c_, w_] := Exp[Plus@@ MapThread[f5a, {x, c, w}]] 37 | 38 | f5a[xi_, ci_, wi_] := -ci Abs[xi - wi] 39 | 40 | 41 | (* Family 6: Discontinuous *) 42 | 43 | f[6][x_, c_, w_] := 0 /; x[[1]] > w[[1]] || x[[2]] > w[[2]] 44 | 45 | f[6][x_, c_, w_] := Exp[c.x] 46 | 47 | 48 | (* Novak & Ritter use 49 | difficulty[fam_] := {9.00, 7.25, 1.85, 7.03, 2.04, 4.30}[[fam]] 50 | *) 51 | 52 | (* Sloan & Joe use 53 | scale[dim_] := dim^Min[Max[.2 dim, 1], 2] 54 | 55 | SetOptions[Interpolation, InterpolationOrder -> 2] 56 | 57 | ifun[1] = Interpolation[{{5, 145.7}, {8, 354.0}, {10, 900.0}}]; 58 | ifun[2] = Interpolation[{{5, 261.0}, {8, 545.0}, {10, 1760.0}}]; 59 | ifun[3] = Interpolation[{{5, 433.0}, {8, 193.0}, {10, 185.0}}]; 60 | ifun[4] = Interpolation[{{5, 155.0}, {8, 382.0}, {10, 1230.0}}]; 61 | ifun[5] = Interpolation[{{5, 217.0}, {8, 674.0}, {10, 2040.0}}]; 62 | ifun[6] = Interpolation[{{5, 90.0}, {8, 240.0}, {10, 1470.0}}]; 63 | 64 | difficulty[fam_] := ifun[fam][ndim]/scale[ndim] 65 | *) 66 | 67 | difficulty[fam_] := {6.0, 18.0, 2.2, 15.2, 16.1, 16.4}[[fam]] 68 | 69 | c[fam_] := Block[{r = w}, r difficulty[fam]/Plus@@ r] 70 | 71 | 72 | Install["Vegas"] 73 | 74 | Install["Suave"] 75 | 76 | Install["Divonne"] 77 | 78 | Install["Cuhre"] 79 | 80 | 81 | 82 | SetAll[opt__] := ( 83 | SetOptions[Vegas, opt]; 84 | SetOptions[Suave, opt]; 85 | SetOptions[Divonne, opt]; 86 | SetOptions[Cuhre, opt]; 87 | SetOptions[NIntegrate, opt]; 88 | ) 89 | 90 | SetAll[PrecisionGoal -> 3, MaxPoints -> maxpoints] 91 | 92 | SetOptions[Divonne, Key1 -> -200] 93 | 94 | 95 | def[f_][{x__}][{r__}] := ( 96 | Attributes[idef] = {HoldAll}; 97 | idef[int_, NIntegrate] := ( 98 | int := Module[{count = 0, res}, 99 | res = NIntegrate[f, r, EvaluationMonitor :> (++count)]; 100 | {count, res}] 101 | ) /; $VersionNumber >= 5; 102 | idef[int_, Int_] := ( 103 | int := Module[{count = 0, res}, 104 | res = Int[(++count; f), r]; 105 | {count, res}] 106 | ); 107 | idef[vegas, Vegas]; 108 | idef[suave, Suave]; 109 | idef[divonne, Divonne]; 110 | idef[cuhre, Cuhre]; 111 | idef[nint, NIntegrate]; 112 | ) 113 | 114 | vars = Table[Unique["x"], {20}] 115 | 116 | test[ndim_, fam_] := 117 | Block[ {w, xs = Take[vars, ndim]}, 118 | w := Table[Random[], {ndim}]; 119 | def[f[fam][xs, c[fam], w]][xs][{#, 0, 1}&/@ xs]; 120 | {vegas, suave, divonne, cuhre, nint} 121 | ] 122 | 123 | 124 | dotest[ndim_, from_:1, to_:6] := 125 | Block[ {dir = ToString[ndim]}, 126 | If[ FileType[dir] =!= Directory, CreateDirectory[dir] ]; 127 | Do[ 128 | SeedRandom[seed]; 129 | Put[ Table[test[ndim, fam], {repeat}], 130 | ToFileName[dir, "fam" <> ToString[fam]] ], 131 | {fam, from, to}] 132 | ] 133 | 134 | -------------------------------------------------------------------------------- /src/divonne/Divonne.c: -------------------------------------------------------------------------------- 1 | /* 2 | Divonne.c 3 | Multidimensional integration by partitioning 4 | originally by J.H. Friedman and M.H. Wright 5 | (CERNLIB subroutine D151) 6 | this version by Thomas Hahn 7 | last modified 22 Jul 14 th 8 | */ 9 | 10 | #define DIVONNE 11 | #define ROUTINE "Divonne" 12 | 13 | #include "decl.h" 14 | #include "CSample.c" 15 | 16 | /*********************************************************************/ 17 | 18 | Extern void EXPORT(Divonne)(ccount ndim, ccount ncomp, 19 | Integrand integrand, void *userdata, cnumber nvec, 20 | creal epsrel, creal epsabs, 21 | cint flags, cint seed, 22 | cnumber mineval, cnumber maxeval, 23 | cint key1, cint key2, cint key3, ccount maxpass, 24 | creal border, creal maxchisq, creal mindeviation, 25 | cnumber ngiven, ccount ldxgiven, real *xgiven, 26 | cnumber nextra, PeakFinder peakfinder, 27 | cchar *statefile, Spin **pspin, 28 | int *pnregions, number *pneval, int *pfail, 29 | real *integral, real *error, real *prob) 30 | { 31 | This t; 32 | 33 | VerboseInit(); 34 | 35 | t.ndim = ndim; 36 | t.ncomp = ncomp; 37 | t.integrand = integrand; 38 | t.userdata = userdata; 39 | t.nvec = nvec; 40 | t.epsrel = epsrel; 41 | t.epsabs = epsabs; 42 | t.flags = MaxVerbose(flags); 43 | t.seed = seed; 44 | t.mineval = mineval; 45 | t.maxeval = maxeval; 46 | t.key1 = key1; 47 | t.key2 = key2; 48 | t.key3 = key3; 49 | t.maxpass = maxpass; 50 | t.border.upper = 1 - (t.border.lower = border); 51 | t.maxchisq = maxchisq; 52 | t.mindeviation = mindeviation; 53 | t.ngiven = ngiven; 54 | t.xgiven = xgiven; 55 | t.ldxgiven = ldxgiven; 56 | t.nextra = nextra; 57 | t.peakfinder = peakfinder; 58 | t.statefile = statefile; 59 | FORK_ONLY(t.spin = Invalid(pspin) ? NULL : *pspin;) 60 | 61 | *pfail = Integrate(&t, integral, error, prob); 62 | *pnregions = t.nregions; 63 | *pneval = t.neval; 64 | 65 | WaitCores(&t, pspin); 66 | } 67 | 68 | /*********************************************************************/ 69 | 70 | Extern void EXPORT(divonne)(ccount *pndim, ccount *pncomp, 71 | Integrand integrand, void *userdata, cnumber *pnvec, 72 | creal *pepsrel, creal *pepsabs, 73 | cint *pflags, cint *pseed, 74 | cnumber *pmineval, cnumber *pmaxeval, 75 | cint *pkey1, cint *pkey2, cint *pkey3, ccount *pmaxpass, 76 | creal *pborder, creal *pmaxchisq, creal *pmindeviation, 77 | cnumber *pngiven, ccount *pldxgiven, real *xgiven, 78 | cnumber *pnextra, PeakFinder peakfinder, 79 | cchar *statefile, Spin **pspin, 80 | int *pnregions, number *pneval, int *pfail, 81 | real *integral, real *error, real *prob, cint statefilelen) 82 | { 83 | This t; 84 | 85 | VerboseInit(); 86 | 87 | t.ndim = *pndim; 88 | t.ncomp = *pncomp; 89 | t.integrand = integrand; 90 | t.userdata = userdata; 91 | t.nvec = *pnvec; 92 | t.epsrel = *pepsrel; 93 | t.epsabs = *pepsabs; 94 | t.flags = MaxVerbose(*pflags); 95 | t.seed = *pseed; 96 | t.mineval = *pmineval; 97 | t.maxeval = *pmaxeval; 98 | t.key1 = *pkey1; 99 | t.key2 = *pkey2; 100 | t.key3 = *pkey3; 101 | t.maxpass = *pmaxpass; 102 | t.border.upper = 1 - (t.border.lower = *pborder); 103 | t.maxchisq = *pmaxchisq; 104 | t.mindeviation = *pmindeviation; 105 | t.ngiven = *pngiven; 106 | t.xgiven = xgiven; 107 | t.ldxgiven = *pldxgiven; 108 | t.nextra = *pnextra; 109 | t.peakfinder = peakfinder; 110 | CString(t.statefile, statefile, statefilelen); 111 | FORK_ONLY(t.spin = Invalid(pspin) ? NULL : *pspin;) 112 | 113 | *pfail = Integrate(&t, integral, error, prob); 114 | *pnregions = t.nregions; 115 | *pneval = t.neval; 116 | 117 | WaitCores(&t, pspin); 118 | } 119 | 120 | -------------------------------------------------------------------------------- /src/suave/Grid.c: -------------------------------------------------------------------------------- 1 | /* 2 | Grid.c 3 | utility functions for the Vegas grid 4 | this file is part of Suave 5 | last modified 7 Aug 13 th 6 | */ 7 | 8 | 9 | static void RefineGrid(cThis *t, Grid grid, Grid margsum) 10 | { 11 | real avgperbin, thisbin, newcur, delta; 12 | Grid imp, newgrid; 13 | int bin, newbin; 14 | 15 | /* smooth the f^2 value stored for each bin */ 16 | real prev = margsum[0]; 17 | real cur = margsum[1]; 18 | real norm = margsum[0] = .5*(prev + cur); 19 | for( bin = 1; bin < NBINS - 1; ++bin ) { 20 | creal s = prev + cur; 21 | prev = cur; 22 | cur = margsum[bin + 1]; 23 | norm += margsum[bin] = (s + cur)/3.; 24 | } 25 | norm += margsum[NBINS - 1] = .5*(prev + cur); 26 | 27 | if( norm == 0 ) return; 28 | norm = 1/norm; 29 | 30 | /* compute the importance function for each bin */ 31 | avgperbin = 0; 32 | for( bin = 0; bin < NBINS; ++bin ) { 33 | real impfun = 0; 34 | if( margsum[bin] > 0 ) { 35 | creal r = margsum[bin]*norm; 36 | avgperbin += impfun = pow((r - 1)/log(r), 1.5); 37 | } 38 | imp[bin] = impfun; 39 | } 40 | avgperbin /= NBINS; 41 | 42 | /* redefine the size of each bin */ 43 | cur = newcur = 0; 44 | thisbin = 0; 45 | bin = -1; 46 | for( newbin = 0; newbin < NBINS - 1; ++newbin ) { 47 | while( thisbin < avgperbin ) { 48 | thisbin += imp[++bin]; 49 | prev = cur; 50 | cur = grid[bin]; 51 | } 52 | thisbin -= avgperbin; 53 | delta = (cur - prev)*thisbin; 54 | newgrid[newbin] = SHARPEDGES ? 55 | cur - delta/imp[bin] : 56 | (newcur = Max(newcur + 16*DBL_EPSILON, 57 | cur - 2*delta/(imp[bin] + imp[IDim(bin - 1)]))); 58 | } 59 | Copy(grid, newgrid, NBINS - 1); 60 | grid[NBINS - 1] = 1; 61 | } 62 | 63 | /*********************************************************************/ 64 | 65 | static void Reweight(cThis *t, Bounds *b, 66 | creal *w, creal *f, creal *lastf, cResult *total) 67 | { 68 | Vector(Grid, margsum, NDIM); 69 | Vector(real, scale, NCOMP); 70 | cbin_t *bin = (cbin_t *)lastf; 71 | count dim, comp; 72 | 73 | if( t->ncomp == 1 ) scale[0] = 1; 74 | else { 75 | for( comp = 0; comp < t->ncomp; ++comp ) 76 | scale[comp] = (total[comp].avg == 0) ? 0 : 1/total[comp].avg; 77 | } 78 | 79 | XClear(margsum); 80 | 81 | while( f < lastf ) { 82 | real fsq = 0; 83 | for( comp = 0; comp < t->ncomp; ++comp ) 84 | fsq += Sq(*f++*scale[comp]); 85 | fsq *= Sq(*w++); 86 | if( fsq != 0 ) 87 | for( dim = 0; dim < t->ndim; ++dim ) 88 | margsum[dim][bin[dim]] += fsq; 89 | bin += t->ndim; 90 | } 91 | 92 | for( dim = 0; dim < t->ndim; ++dim ) 93 | RefineGrid(t, b[dim].grid, margsum[dim]); 94 | } 95 | 96 | /*********************************************************************/ 97 | 98 | static void StretchGrid(cGrid grid, Grid gridL, Grid gridR) 99 | { 100 | real prev = 0, cur, step, x; 101 | count bin = 0; 102 | 103 | while( bin < NBINS ) { 104 | cur = grid[bin++]; 105 | if( cur >= .5 ) break; 106 | prev = cur; 107 | } 108 | 109 | step = (bin - (cur - .5)/(cur - prev))/NBINS; 110 | 111 | prev = x = 0; 112 | cur = *grid; 113 | 114 | for( bin = 0; bin < NBINS; ++bin ) { 115 | x += step; 116 | if( x > 1 ) { 117 | --x; 118 | prev = cur; 119 | cur = *++grid; 120 | } 121 | gridL[bin] = 2*(prev + (cur - prev)*x); 122 | } 123 | 124 | step = 1 - step; 125 | for( bin = 0; bin < NBINS - 1; ++bin ) { 126 | x += step; 127 | if( x > 1 ) { 128 | --x; 129 | prev = cur; 130 | cur = *++grid; 131 | } 132 | gridR[bin] = 2*(prev + (cur - prev)*x) - 1; 133 | } 134 | gridR[NBINS - 1] = 1; 135 | } 136 | 137 | 138 | -------------------------------------------------------------------------------- /src/divonne/decl.h: -------------------------------------------------------------------------------- 1 | /* 2 | decl.h 3 | Type declarations 4 | this file is part of Divonne 5 | last modified 9 Oct 14 th 6 | */ 7 | 8 | 9 | #include "stddecl.h" 10 | 11 | #define INIDEPTH 3 12 | #define DEPTH 5 13 | #define POSTDEPTH 15 14 | 15 | #define Tag(x) ((x) | INT_MIN) 16 | #define Untag(x) ((x) & INT_MAX) 17 | 18 | typedef struct { 19 | real lower, upper; 20 | } Bounds; 21 | 22 | typedef const Bounds cBounds; 23 | 24 | typedef struct { 25 | real avg, err; 26 | } PhaseResult; 27 | 28 | typedef struct { 29 | real avg, spreadsq; 30 | real spread, secondspread; 31 | real nneed, maxerrsq, mindevsq; 32 | real integral, sigsq, chisq; 33 | PhaseResult phase[2]; 34 | int iregion; 35 | } Totals; 36 | 37 | enum { nrules = 5 }; 38 | 39 | typedef struct { 40 | count n; 41 | real weight[nrules], scale[nrules], norm[nrules]; 42 | real gen[]; 43 | } Set; 44 | 45 | #define SetSize (sizeof(Set) + t->ndim*sizeof(real)) 46 | 47 | #define NextSet(p) p = (Set *)((char *)p + setsize) 48 | 49 | typedef struct { 50 | Set *first, *last; 51 | real errcoeff[3]; 52 | count n; 53 | } Rule; 54 | 55 | typedef const Rule cRule; 56 | 57 | typedef struct samples { 58 | real *x, *f; 59 | void (*sampler)(struct _this *t, ccount); 60 | cRule *rule; 61 | number n, neff; 62 | count coeff; 63 | } Samples; 64 | 65 | typedef const Samples cSamples; 66 | 67 | typedef struct { 68 | real diff, err, spread; 69 | } Errors; 70 | 71 | typedef const Errors cErrors; 72 | 73 | typedef struct { 74 | real avg, err, spread, chisq; 75 | real fmin, fmax; 76 | } Result; 77 | 78 | typedef const Result cResult; 79 | 80 | #define MinMaxSize (t->ncomp*t->ndim*2*sizeof(real)) 81 | 82 | typedef struct region { 83 | int depth, next; 84 | count isamples, cutcomp, xmajor; 85 | real fmajor, fminor, vol; 86 | Bounds bounds[]; 87 | } Region; 88 | 89 | #define RegionSize (sizeof(Region) + t->ndim*sizeof(Bounds) + t->ncomp*sizeof(Result) + MinMaxSize) 90 | 91 | #define RegionResult(r) ((Result *)(r->bounds + t->ndim)) 92 | 93 | #define RegionMinMax(r) ((real *)(RegionResult(r) + t->ncomp)) 94 | 95 | #define RegionPtr(n) ((Region *)((char *)t->region + (n)*regionsize)) 96 | 97 | 98 | typedef int (*Integrand)(ccount *, creal *, ccount *, real *, 99 | void *, cnumber *, cint *, cint *); 100 | 101 | typedef void (*PeakFinder)(ccount *, cBounds *, number *, real *, void *); 102 | 103 | typedef struct _this { 104 | count ndim, ncomp; 105 | #ifndef MLVERSION 106 | Integrand integrand; 107 | void *userdata; 108 | number nvec; 109 | #ifdef HAVE_FORK 110 | SHM_ONLY(int shmid;) 111 | Spin *spin; 112 | real *frame; 113 | number nframe; 114 | int running; 115 | #endif 116 | PeakFinder peakfinder; 117 | #endif 118 | real epsrel, epsabs; 119 | int flags, seed; 120 | number mineval, maxeval; 121 | int key1, key2, key3; 122 | count maxpass; 123 | Bounds border; 124 | real maxchisq, mindeviation; 125 | number ngiven, nextra; 126 | real *xgiven, *fgiven; 127 | real *xextra, *fextra; 128 | count ldxgiven; 129 | count nregions; 130 | cchar *statefile; 131 | number neval, neval_opt, neval_cut, nrand; 132 | count phase; 133 | count selectedcomp, size; 134 | Samples samples[3]; 135 | Totals *totals; 136 | Rule rule7, rule9, rule11, rule13; 137 | RNGState rng; 138 | Region *region; 139 | jmp_buf abort; 140 | } This; 141 | 142 | typedef const This cThis; 143 | 144 | 145 | #define CHUNKSIZE 4096 146 | 147 | #define AllocRegions(t) \ 148 | MemAlloc((t)->region, (t)->size*regionsize) 149 | 150 | #define EnlargeRegions(t, n) if( (t)->nregions + n > (t)->size ) \ 151 | ReAlloc((t)->region, ((t)->size += CHUNKSIZE)*regionsize) 152 | 153 | #define SAMPLERDEFS \ 154 | csize_t regionsize = RegionSize; \ 155 | Region *region = RegionPtr(iregion); \ 156 | cBounds *b = region->bounds; \ 157 | Result *res = RegionResult(region); \ 158 | cSamples *samples = &t->samples[region->isamples]; \ 159 | real *x = samples->x, *f = samples->f; \ 160 | cnumber n = samples->n 161 | 162 | -------------------------------------------------------------------------------- /src/common/Fork.c: -------------------------------------------------------------------------------- 1 | /* 2 | Fork.c 3 | fork the cores for parallel sampling 4 | (C version only) 5 | by Thomas Hahn 6 | last modified 27 Aug 14 th 7 | */ 8 | 9 | 10 | #define ROUTINE "cubafork" 11 | #include "stddecl.h" 12 | 13 | #ifdef HAVE_FORK 14 | 15 | #include "sock.h" 16 | 17 | #define MINCORES 1 18 | 19 | coreinit cubafun_; 20 | extern int cubaverb_; 21 | extern corespec cubaworkers_; 22 | 23 | /*********************************************************************/ 24 | 25 | static inline void Child(cint fd, cint core) 26 | { 27 | dispatch d; 28 | 29 | while( readsock(fd, &d, sizeof d) == sizeof d ) { 30 | if( d.thissize ) { 31 | MemAlloc(d.thisptr, d.thissize); 32 | WORKER("reading This (%lu)", d.thissize); 33 | readsock(fd, d.thisptr, d.thissize); 34 | } 35 | WORKER("running %p on fd %d", d.thisptr, fd); 36 | d.worker(d.thisptr, d.thissize, core, fd); 37 | if( d.thissize ) free(d.thisptr); 38 | } 39 | } 40 | 41 | /*********************************************************************/ 42 | 43 | Extern void SUFFIX(cubafork)(Spin **pspin) 44 | { 45 | char out[128]; 46 | int cores, core, *pfd; 47 | Spin *spin; 48 | 49 | VerboseInit(); 50 | 51 | EnvInit(cubaworkers_.paccel, "CUBAACCELMAX", 1000); 52 | EnvInit(cubaworkers_.pcores, "CUBACORESMAX", 10000); 53 | EnvInit(cubaworkers_.naccel, "CUBAACCEL", 0); 54 | EnvInit(cubaworkers_.ncores, "CUBACORES", -sysconf(_SC_NPROCESSORS_ONLN)); 55 | 56 | #ifdef HAVE_GETLOADAVG 57 | if( cubaworkers_.ncores < 0 ) { 58 | static int load = uninitialized; 59 | if( load == uninitialized ) { 60 | double loadavg; 61 | getloadavg(&loadavg, 1); 62 | load = floor(loadavg); 63 | } 64 | cubaworkers_.ncores = IMax(-cubaworkers_.ncores - load, 0); 65 | } 66 | #else 67 | cubaworkers_.ncores = abs(cubaworkers_.ncores); 68 | #endif 69 | 70 | cores = cubaworkers_.naccel + cubaworkers_.ncores; 71 | if( cores < MINCORES ) { 72 | *pspin = NULL; 73 | return; 74 | } 75 | 76 | if( cubaverb_ ) { 77 | sprintf(out, "using %d cores %d accelerators via " 78 | #ifdef HAVE_SHMGET 79 | "shared memory", 80 | #else 81 | "pipes", 82 | #endif 83 | cubaworkers_.ncores, cubaworkers_.naccel); 84 | Print(out); 85 | } 86 | 87 | fflush(NULL); /* make sure all buffers are flushed, 88 | or else buffered content will be written 89 | out multiply, at each child's exit(0) */ 90 | 91 | MemAlloc(spin, sizeof *spin + cores*sizeof(int)); 92 | spin->spec = cubaworkers_; 93 | pfd = spin->fd; 94 | for( core = -spin->spec.naccel; core < spin->spec.ncores; ++core ) { 95 | int fd[2]; 96 | pid_t pid; 97 | assert( 98 | socketpair(AF_LOCAL, SOCK_STREAM, 0, fd) != -1 && 99 | (pid = fork()) != -1 ); 100 | if( pid == 0 ) { 101 | close(fd[0]); 102 | free(spin); 103 | Child(fd[1], core); 104 | exit(0); 105 | } 106 | MASTER("forked pid %d pipe %d(master) -> %d(worker)", 107 | pid, fd[0], fd[1]); 108 | close(fd[1]); 109 | *pfd++ = fd[0]; 110 | } 111 | 112 | *pspin = spin; 113 | } 114 | 115 | /*********************************************************************/ 116 | 117 | Extern void SUFFIX(cubawait)(Spin **pspin) 118 | { 119 | int cores, core, status; 120 | Spin *spin; 121 | 122 | MasterExit(); 123 | 124 | if( Invalid(pspin) || (spin = *pspin) == NULL ) return; 125 | 126 | cores = spin->spec.naccel + spin->spec.ncores; 127 | 128 | for( core = 0; core < cores; ++core ) { 129 | MASTER("closing fd %d", spin->fd[core]); 130 | close(spin->fd[core]); 131 | } 132 | 133 | for( core = 0; core < cores; ++core ) { 134 | DEB_ONLY(pid_t pid;) 135 | MASTER("waiting for child"); 136 | DEB_ONLY(pid =) wait(&status); 137 | MASTER("pid %d terminated with exit code %d", pid, status); 138 | } 139 | 140 | free(spin); 141 | *pspin = NULL; 142 | } 143 | 144 | #else 145 | 146 | Extern void SUFFIX(cubafork)(Spin **pspin) {} 147 | 148 | Extern void SUFFIX(cubawait)(Spin **pspin) 149 | { 150 | MasterExit(); 151 | } 152 | 153 | #endif 154 | 155 | -------------------------------------------------------------------------------- /src/divonne/Iterate.c: -------------------------------------------------------------------------------- 1 | /* 2 | Iterate.c 3 | recursion over regions 4 | this file is part of Divonne 5 | last modified 2 Aug 13 th 6 | */ 7 | 8 | 9 | static void Iterate(This *t, count iregion, cint depth, cint isamples, 10 | Totals *totals) 11 | { 12 | csize_t regionsize = RegionSize; 13 | Region *parent, *region; 14 | typedef struct { 15 | real avg, err, spread, spreadsq; 16 | } Corr; 17 | Vector(Corr, corr, NCOMP); 18 | Corr *c, *C = corr + t->ncomp; 19 | Result *res; 20 | count ireg, mreg = iregion; 21 | count comp, maxsplit; 22 | int last, idest, isrc; 23 | 24 | region = RegionPtr(iregion); 25 | region->depth = depth; 26 | region->next = -iregion - 1; 27 | if( isamples < 0 ) Split(t, iregion); 28 | else { 29 | region->isamples = isamples; 30 | ExploreSerial(t, iregion); 31 | } 32 | 33 | ireg = iregion + RegionPtr(iregion)->next; 34 | 35 | do { 36 | region = RegionPtr(ireg); 37 | if( region->depth > 0 ) { 38 | --region->depth; 39 | FORK_ONLY(more:) 40 | ireg = Explore(t, ireg); 41 | if( ireg == -1 ) return; 42 | region = RegionPtr(ireg); 43 | } 44 | if( region->depth < 0 ) mreg = IMax(mreg, ireg); 45 | ireg += region->next; 46 | } while( ireg > 0 ); 47 | 48 | FORK_ONLY(if( t->running ) goto more;) 49 | 50 | maxsplit = 1; 51 | for( ireg = mreg; ireg >= iregion; --ireg ) { 52 | parent = RegionPtr(ireg); 53 | maxsplit -= NegQ(parent->depth); 54 | if( parent->depth < 0 ) { 55 | count xreg; 56 | struct { 57 | count from, to; 58 | } todo[maxsplit], *tdmax = todo, *td; 59 | count nsplit = 0; 60 | real norm; 61 | 62 | FClear(corr); 63 | 64 | tdmax->from = ireg + parent->next; 65 | tdmax->to = tdmax->from - parent->depth; 66 | ++tdmax; 67 | for( td = todo; td < tdmax; ++td ) { 68 | for( xreg = td->from; xreg < td->to; ++xreg ) { 69 | Region *region = RegionPtr(xreg); 70 | if( region->depth < 0 ) { 71 | tdmax->from = xreg + region->next; 72 | tdmax->to = tdmax->from - region->depth; 73 | ++tdmax; 74 | } 75 | else { 76 | ++nsplit; 77 | for( res = RegionResult(region), c = corr; c < C; ++res, ++c ) { 78 | c->avg += res->avg; 79 | c->err += res->err; 80 | c->spread += Sq(res->spread); 81 | } 82 | } 83 | } 84 | } 85 | 86 | norm = 1./nsplit--; 87 | for( res = RegionResult(parent), c = corr; c < C; ++res, ++c ) { 88 | creal diff = fabs(res->avg - c->avg)*norm; 89 | c->avg = diff*norm*nsplit; 90 | c->err = (c->err == 0) ? 1 : 1 + diff/c->err; 91 | c->spread = (c->spread == 0) ? 1 : 1 + diff/sqrt(c->spread); 92 | } 93 | 94 | for( td = todo; td < tdmax; ++td ) 95 | for( xreg = td->from; xreg < td->to; ++xreg ) { 96 | Region *region = RegionPtr(xreg); 97 | if( region->depth >= 0 ) { 98 | cnumber neff = t->samples[region->isamples].neff; 99 | for( res = RegionResult(region), c = corr; c < C; ++res, ++c ) { 100 | if( res->err > 0 ) res->err = res->err*c->err + c->avg; 101 | res->spread = res->spread*c->spread + c->avg*neff; 102 | c->spreadsq += Sq(res->spread); 103 | } 104 | } 105 | } 106 | } 107 | } 108 | 109 | if( totals ) 110 | for( comp = 0; comp < t->ncomp; ++comp ) 111 | totals[comp].spreadsq += corr[comp].spreadsq; 112 | 113 | for( last = -1, idest = isrc = iregion; iregion <= mreg; ++iregion ) { 114 | Region *region = RegionPtr(iregion); 115 | cint cur = NegQ(region->depth); 116 | switch( cur - last ) { 117 | case -1: 118 | memmove(RegionPtr(idest), RegionPtr(isrc), 119 | (iregion - isrc)*regionsize); 120 | idest += iregion - isrc; 121 | break; 122 | case 1: 123 | isrc = iregion; 124 | } 125 | last = cur; 126 | } 127 | 128 | memmove(RegionPtr(idest), RegionPtr(iregion), 129 | (t->nregions - iregion)*regionsize); 130 | t->nregions += idest - iregion; 131 | } 132 | 133 | -------------------------------------------------------------------------------- /config.h.in: -------------------------------------------------------------------------------- 1 | /* config.h.in. Generated from configure.ac by autoheader. */ 2 | 3 | /* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP 4 | systems. This function is required for `alloca.c' support on those systems. 5 | */ 6 | #undef CRAY_STACKSEG_END 7 | 8 | /* Define to 1 if using `alloca.c'. */ 9 | #undef C_ALLOCA 10 | 11 | /* Define to 1 if you have `alloca', as a function or macro. */ 12 | #undef HAVE_ALLOCA 13 | 14 | /* Define to 1 if you have and it should be used (not on Ultrix). 15 | */ 16 | #undef HAVE_ALLOCA_H 17 | 18 | /* Define to 1 if you have the `erf' function. */ 19 | #undef HAVE_ERF 20 | 21 | /* Define to 1 if you have the `fork' function. */ 22 | #undef HAVE_FORK 23 | 24 | /* Define to 1 if you have the `getloadavg' function. */ 25 | #undef HAVE_GETLOADAVG 26 | 27 | /* Define to 1 if you have the header file. */ 28 | #undef HAVE_INTTYPES_H 29 | 30 | /* Define to 1 if the type `long double' works and has more range or precision 31 | than `double'. */ 32 | #undef HAVE_LONG_DOUBLE 33 | 34 | /* Define to 1 if the type `long double' works and has more range or precision 35 | than `double'. */ 36 | #undef HAVE_LONG_DOUBLE_WIDER 37 | 38 | /* Define to 1 if you have the header file. */ 39 | #undef HAVE_MEMORY_H 40 | 41 | /* Define to 1 if you have the `powl' function. */ 42 | #undef HAVE_POWL 43 | 44 | /* Define to 1 if you have the `shmget' function. */ 45 | #undef HAVE_SHMGET 46 | 47 | /* Define to 1 if you have the header file. */ 48 | #undef HAVE_STDINT_H 49 | 50 | /* Define to 1 if you have the header file. */ 51 | #undef HAVE_STDLIB_H 52 | 53 | /* Define to 1 if you have the header file. */ 54 | #undef HAVE_STRINGS_H 55 | 56 | /* Define to 1 if you have the header file. */ 57 | #undef HAVE_STRING_H 58 | 59 | /* Define to 1 if you have the header file. */ 60 | #undef HAVE_SYS_STAT_H 61 | 62 | /* Define to 1 if you have the header file. */ 63 | #undef HAVE_SYS_TYPES_H 64 | 65 | /* Define to 1 if you have the header file. */ 66 | #undef HAVE_UNISTD_H 67 | 68 | /* Define to 1 if you have the `vfork' function. */ 69 | #undef HAVE_VFORK 70 | 71 | /* Define to 1 if you have the header file. */ 72 | #undef HAVE_VFORK_H 73 | 74 | /* Define to 1 if `fork' works. */ 75 | #undef HAVE_WORKING_FORK 76 | 77 | /* Define to 1 if `vfork' works. */ 78 | #undef HAVE_WORKING_VFORK 79 | 80 | /* Maximum number of dimensions */ 81 | #undef NCOMP 82 | 83 | /* Maximum number of components */ 84 | #undef NDIM 85 | 86 | /* Define to the address where bug reports for this package should be sent. */ 87 | #undef PACKAGE_BUGREPORT 88 | 89 | /* Define to the full name of this package. */ 90 | #undef PACKAGE_NAME 91 | 92 | /* Define to the full name and version of this package. */ 93 | #undef PACKAGE_STRING 94 | 95 | /* Define to the one symbol short name of this package. */ 96 | #undef PACKAGE_TARNAME 97 | 98 | /* Define to the home page for this package. */ 99 | #undef PACKAGE_URL 100 | 101 | /* Define to the version of this package. */ 102 | #undef PACKAGE_VERSION 103 | 104 | /* If using the C implementation of alloca, define if you know the 105 | direction of stack growth for your system; otherwise it will be 106 | automatically deduced at runtime. 107 | STACK_DIRECTION > 0 => grows toward higher addresses 108 | STACK_DIRECTION < 0 => grows toward lower addresses 109 | STACK_DIRECTION = 0 => direction of growth unknown */ 110 | #undef STACK_DIRECTION 111 | 112 | /* Define to 1 if you have the ANSI C header files. */ 113 | #undef STDC_HEADERS 114 | 115 | /* Define to empty if `const' does not conform to ANSI C. */ 116 | #undef const 117 | 118 | /* Define to `__inline__' or `__inline' if that's what the C compiler 119 | calls it, or to nothing if 'inline' is not supported under any name. */ 120 | #ifndef __cplusplus 121 | #undef inline 122 | #endif 123 | 124 | /* Define to `int' if does not define. */ 125 | #undef pid_t 126 | 127 | /* Define to `unsigned int' if does not define. */ 128 | #undef size_t 129 | 130 | /* Define to `int' if does not define. */ 131 | #undef ssize_t 132 | 133 | /* Define as `fork' if `vfork' does not work. */ 134 | #undef vfork 135 | -------------------------------------------------------------------------------- /src/divonne/Explore.c: -------------------------------------------------------------------------------- 1 | /* 2 | Explore.c 3 | sample region, determine min and max, split if necessary 4 | this file is part of Divonne 5 | last modified 28 May 14 th 6 | */ 7 | 8 | 9 | typedef struct { 10 | real fmin, fmax; 11 | creal *xmin, *xmax; 12 | } Extrema; 13 | 14 | /*********************************************************************/ 15 | 16 | static int ExploreSerial(This *t, ccount iregion) 17 | { 18 | csize_t regionsize = RegionSize; 19 | Region *region = RegionPtr(iregion); 20 | cBounds *bounds = region->bounds; 21 | Result *result = RegionResult(region); 22 | real *minmax = RegionMinMax(region); 23 | 24 | Vector(Extrema, extrema, NCOMP); 25 | Vector(real, xtmp, NDIM); 26 | Result *r; 27 | creal *x; 28 | real *f; 29 | real halfvol, maxerr; 30 | count n, dim, comp, maxcomp; 31 | cSamples *samples = &t->samples[region->isamples]; 32 | 33 | for( comp = 0; comp < t->ncomp; ++comp ) { 34 | Extrema *e = &extrema[comp]; 35 | e->fmin = INFTY; 36 | e->fmax = -INFTY; 37 | e->xmin = e->xmax = NULL; 38 | } 39 | 40 | if( region->isamples == 0 ) { /* others already sampled */ 41 | real vol = 1; 42 | for( dim = 0; dim < t->ndim; ++dim ) { 43 | cBounds *b = &bounds[dim]; 44 | vol *= b->upper - b->lower; 45 | } 46 | region->vol = vol; 47 | 48 | for( comp = 0; comp < t->ncomp; ++comp ) { 49 | Result *r = &result[comp]; 50 | r->fmin = INFTY; 51 | r->fmax = -INFTY; 52 | } 53 | 54 | x = t->xgiven; 55 | f = t->fgiven; 56 | n = t->ngiven; 57 | if( t->nextra ) n += SampleExtra(t, bounds); 58 | 59 | for( ; n; --n ) { 60 | for( dim = 0; dim < t->ndim; ++dim ) { 61 | cBounds *b = &bounds[dim]; 62 | if( x[dim] < b->lower || x[dim] > b->upper ) goto skip; 63 | } 64 | for( comp = 0; comp < t->ncomp; ++comp ) { 65 | Extrema *e = &extrema[comp]; 66 | creal y = f[comp]; 67 | if( y < e->fmin ) e->fmin = y, e->xmin = x; 68 | if( y > e->fmax ) e->fmax = y, e->xmax = x; 69 | } 70 | skip: 71 | x += t->ldxgiven; 72 | f += t->ncomp; 73 | } 74 | 75 | samples->sampler(t, iregion); 76 | } 77 | 78 | x = samples->x; 79 | f = samples->f; 80 | for( n = samples->n; n; --n ) { 81 | for( comp = 0; comp < t->ncomp; ++comp ) { 82 | Extrema *e = &extrema[comp]; 83 | creal y = *f++; 84 | if( y < e->fmin ) e->fmin = y, e->xmin = x; 85 | if( y > e->fmax ) e->fmax = y, e->xmax = x; 86 | } 87 | x += t->ndim; 88 | } 89 | t->neval_opt -= t->neval; 90 | 91 | halfvol = .5*region->vol; 92 | maxerr = -INFTY; 93 | maxcomp = -1; 94 | 95 | for( comp = 0; comp < t->ncomp; ++comp ) { 96 | Extrema *e = &extrema[comp]; 97 | Result *r = &result[comp]; 98 | real ftmp, err; 99 | 100 | if( e->xmin ) { /* not all NaNs */ 101 | t->selectedcomp = comp; 102 | XCopy(xtmp, e->xmin); 103 | ftmp = FindMinimum(t, bounds, xtmp, e->fmin); 104 | if( ftmp < r->fmin ) { 105 | r->fmin = ftmp; 106 | XCopy(&minmax[2*comp*t->ndim], xtmp); 107 | } 108 | 109 | t->selectedcomp = Tag(comp); 110 | XCopy(xtmp, e->xmax); 111 | ftmp = -FindMinimum(t, bounds, xtmp, -e->fmax); 112 | if( ftmp > r->fmax ) { 113 | r->fmax = ftmp; 114 | XCopy(&minmax[(2*comp + 1)*t->ndim], xtmp); 115 | } 116 | } 117 | 118 | r->spread = halfvol*(r->fmax - r->fmin); 119 | err = r->spread/Max(fabs(r->avg), NOTZERO); 120 | if( err > maxerr ) { 121 | maxerr = err; 122 | maxcomp = comp; 123 | } 124 | } 125 | 126 | t->neval_opt += t->neval; 127 | 128 | if( maxcomp == -1 ) { /* all NaNs */ 129 | region->depth = 0; 130 | return -1; 131 | } 132 | 133 | region->cutcomp = maxcomp; 134 | r = RegionResult(region) + maxcomp; 135 | if( halfvol*(r->fmin + r->fmax) > r->avg ) { 136 | region->fminor = r->fmin; 137 | region->fmajor = r->fmax; 138 | region->xmajor = (2*maxcomp + 1)*t->ndim; 139 | } 140 | else { 141 | region->fminor = r->fmax; 142 | region->fmajor = r->fmin; 143 | region->xmajor = 2*maxcomp*t->ndim; 144 | } 145 | 146 | if( region->isamples == 0 ) { 147 | if( (region->depth < INIDEPTH && r->spread < samples->neff*r->err) || 148 | r->spread < t->totals[maxcomp].secondspread ) 149 | region->depth = 0; 150 | if( region->depth == 0 ) 151 | for( comp = 0; comp < t->ncomp; ++comp ) 152 | t->totals[comp].secondspread = 153 | Max(t->totals[comp].secondspread, result[comp].spread); 154 | } 155 | 156 | if( region->depth ) Split(t, iregion); 157 | 158 | return iregion; 159 | } 160 | 161 | -------------------------------------------------------------------------------- /demo/demo-c.c: -------------------------------------------------------------------------------- 1 | /* 2 | demo-c.c 3 | test program for the Cuba library 4 | last modified 28 Nov 14 th 5 | */ 6 | 7 | #include 8 | #include 9 | #include 10 | #include "cuba.h" 11 | 12 | 13 | static inline double Sq(double x) { 14 | return x*x; 15 | } 16 | 17 | 18 | static int Integrand(const int *ndim, const double xx[], 19 | const int *ncomp, double ff[], void *userdata) { 20 | 21 | #define x xx[0] 22 | #define y xx[1] 23 | #define z xx[2] 24 | #define f ff[0] 25 | 26 | #ifndef FUN 27 | #define FUN 1 28 | #endif 29 | 30 | #define rsq (Sq(x) + Sq(y) + Sq(z)) 31 | 32 | #if FUN == 1 33 | f = sin(x)*cos(y)*exp(z); 34 | #elif FUN == 2 35 | f = 1/(Sq(x + y) + .003)*cos(y)*exp(z); 36 | #elif FUN == 3 37 | f = 1/(3.75 - cos(M_PI*x) - cos(M_PI*y) - cos(M_PI*z)); 38 | #elif FUN == 4 39 | f = fabs(rsq - .125); 40 | #elif FUN == 5 41 | f = exp(-rsq); 42 | #elif FUN == 6 43 | f = 1/(1 - x*y*z + 1e-10); 44 | #elif FUN == 7 45 | f = sqrt(fabs(x - y - z)); 46 | #elif FUN == 8 47 | f = exp(-x*y*z); 48 | #elif FUN == 9 49 | f = Sq(x)/(cos(x + y + z + 1) + 5); 50 | #elif FUN == 10 51 | f = (x > .5) ? 1/sqrt(x*y*z + 1e-5) : sqrt(x*y*z); 52 | #else 53 | f = (rsq < 1) ? 1 : 0; 54 | #endif 55 | 56 | return 0; 57 | } 58 | 59 | /*********************************************************************/ 60 | 61 | #define NDIM 3 62 | #define NCOMP 1 63 | #define USERDATA NULL 64 | #define NVEC 1 65 | #define EPSREL 1e-3 66 | #define EPSABS 1e-12 67 | #define VERBOSE 2 68 | #define LAST 4 69 | #define SEED 0 70 | #define MINEVAL 0 71 | #define MAXEVAL 50000 72 | 73 | #define NSTART 1000 74 | #define NINCREASE 500 75 | #define NBATCH 1000 76 | #define GRIDNO 0 77 | #define STATEFILE NULL 78 | #define SPIN NULL 79 | 80 | #define NNEW 1000 81 | #define NMIN 2 82 | #define FLATNESS 25. 83 | 84 | #define KEY1 47 85 | #define KEY2 1 86 | #define KEY3 1 87 | #define MAXPASS 5 88 | #define BORDER 0. 89 | #define MAXCHISQ 10. 90 | #define MINDEVIATION .25 91 | #define NGIVEN 0 92 | #define LDXGIVEN NDIM 93 | #define NEXTRA 0 94 | 95 | #define KEY 0 96 | 97 | int main() { 98 | int comp, nregions, neval, fail; 99 | double integral[NCOMP], error[NCOMP], prob[NCOMP]; 100 | 101 | #if 1 102 | printf("-------------------- Vegas test --------------------\n"); 103 | 104 | Vegas(NDIM, NCOMP, Integrand, USERDATA, NVEC, 105 | EPSREL, EPSABS, VERBOSE, SEED, 106 | MINEVAL, MAXEVAL, NSTART, NINCREASE, NBATCH, 107 | GRIDNO, STATEFILE, SPIN, 108 | &neval, &fail, integral, error, prob); 109 | 110 | printf("VEGAS RESULT:\tneval %d\tfail %d\n", 111 | neval, fail); 112 | for( comp = 0; comp < NCOMP; ++comp ) 113 | printf("VEGAS RESULT:\t%.8f +- %.8f\tp = %.3f\n", 114 | integral[comp], error[comp], prob[comp]); 115 | #endif 116 | 117 | #if 1 118 | printf("\n-------------------- Suave test --------------------\n"); 119 | 120 | Suave(NDIM, NCOMP, Integrand, USERDATA, NVEC, 121 | EPSREL, EPSABS, VERBOSE | LAST, SEED, 122 | MINEVAL, MAXEVAL, NNEW, NMIN, FLATNESS, 123 | STATEFILE, SPIN, 124 | &nregions, &neval, &fail, integral, error, prob); 125 | 126 | printf("SUAVE RESULT:\tnregions %d\tneval %d\tfail %d\n", 127 | nregions, neval, fail); 128 | for( comp = 0; comp < NCOMP; ++comp ) 129 | printf("SUAVE RESULT:\t%.8f +- %.8f\tp = %.3f\n", 130 | integral[comp], error[comp], prob[comp]); 131 | #endif 132 | 133 | #if 1 134 | printf("\n------------------- Divonne test -------------------\n"); 135 | 136 | Divonne(NDIM, NCOMP, Integrand, USERDATA, NVEC, 137 | EPSREL, EPSABS, VERBOSE, SEED, 138 | MINEVAL, MAXEVAL, KEY1, KEY2, KEY3, MAXPASS, 139 | BORDER, MAXCHISQ, MINDEVIATION, 140 | NGIVEN, LDXGIVEN, NULL, NEXTRA, NULL, 141 | STATEFILE, SPIN, 142 | &nregions, &neval, &fail, integral, error, prob); 143 | 144 | printf("DIVONNE RESULT:\tnregions %d\tneval %d\tfail %d\n", 145 | nregions, neval, fail); 146 | for( comp = 0; comp < NCOMP; ++comp ) 147 | printf("DIVONNE RESULT:\t%.8f +- %.8f\tp = %.3f\n", 148 | integral[comp], error[comp], prob[comp]); 149 | #endif 150 | 151 | #if 1 152 | printf("\n-------------------- Cuhre test --------------------\n"); 153 | 154 | Cuhre(NDIM, NCOMP, Integrand, USERDATA, NVEC, 155 | EPSREL, EPSABS, VERBOSE | LAST, 156 | MINEVAL, MAXEVAL, KEY, 157 | STATEFILE, SPIN, 158 | &nregions, &neval, &fail, integral, error, prob); 159 | 160 | printf("CUHRE RESULT:\tnregions %d\tneval %d\tfail %d\n", 161 | nregions, neval, fail); 162 | for( comp = 0; comp < NCOMP; ++comp ) 163 | printf("CUHRE RESULT:\t%.8f +- %.8f\tp = %.3f\n", 164 | integral[comp], error[comp], prob[comp]); 165 | #endif 166 | 167 | return 0; 168 | } 169 | 170 | -------------------------------------------------------------------------------- /tools/mkdist.c: -------------------------------------------------------------------------------- 1 | /* 2 | mkdist.c 3 | 4 | Usage: mkdist cvfz packagename.tar.gz packagedir files 5 | 6 | Creates packagename.tar.gz for distribution which unpacks 7 | into the directory "packagedir". 8 | 1) Sets up a temporary tree in which 9 | - symlinks are preserved if they point to files in the tree, 10 | - all other files are hardlinked. 11 | 2) Tars that tree. 12 | 3) Removes the temporary tree. 13 | 14 | last modified 4 Dec 14 th 15 | */ 16 | 17 | #include 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include 23 | #include 24 | #include 25 | #include 26 | 27 | char path[PATH_MAX], *path_end; 28 | 29 | 30 | static inline char *copydir(char *d, const char *s) { 31 | const char *dir = strrchr(s, '/'); 32 | const ssize_t n = (dir) ? dir - s + 1 : 0; 33 | return memcpy(d, s, n) + n; 34 | } 35 | 36 | 37 | static int depth(const char *path) 38 | { 39 | int n = 0; 40 | for( ; ; ) { 41 | if( strncmp(path, "./", 2) == 0 ) path += 2; 42 | else if( strncmp(path, "../", 3) == 0 ) { 43 | path += 3; 44 | if( --n < 0 ) return n; 45 | } 46 | else if( (path = strchr(path, '/')) ) ++n; 47 | else return n; 48 | path = path + strspn(path, "/"); 49 | } 50 | } 51 | 52 | 53 | static void mkdirhier(char *file) 54 | { 55 | struct stat st; 56 | char *s = file; 57 | const char *e = strrchr(file, '/'); 58 | 59 | while( s < e ) { 60 | s = strchr(s, '/'); 61 | *s = 0; 62 | if( stat(file, &st) ) mkdir(file, 0777); 63 | else if( !S_ISDIR(st.st_mode) ) { 64 | fprintf(stderr, "Cannot create %s\n", file); 65 | exit(1); 66 | } 67 | *s++ = '/'; 68 | } 69 | } 70 | 71 | 72 | static void inspect(const char *file, const int phase) 73 | { 74 | struct stat st; 75 | if( lstat(file, &st) ) { 76 | fprintf(stderr, "Cannot stat %s\n", file); 77 | return; 78 | } 79 | 80 | strcpy(path_end, file); 81 | if( phase == 0 ) mkdirhier(path); 82 | 83 | if( S_ISREG(st.st_mode) ) { 84 | if( phase == 0 ) link(file, path); 85 | return; 86 | } 87 | 88 | if( S_ISDIR(st.st_mode) ) { 89 | char sub[PATH_MAX], *sub_end; 90 | struct dirent *entry; 91 | 92 | DIR *cwd = opendir(file); 93 | if( cwd == NULL ) { 94 | fprintf(stderr, "Cannot read directory %s\n", file); 95 | exit(1); 96 | } 97 | 98 | strcpy(sub, file); 99 | sub_end = sub + strlen(sub); 100 | *sub_end++ = '/'; 101 | 102 | while( (entry = readdir(cwd)) ) 103 | if( *entry->d_name != '.' ) { 104 | strcpy(sub_end, entry->d_name); 105 | inspect(sub, phase); 106 | } 107 | 108 | closedir(cwd); 109 | return; 110 | } 111 | 112 | if( S_ISLNK(st.st_mode) ) { 113 | char src[PATH_MAX], tmp[PATH_MAX]; 114 | char *lnrel = copydir(src, file), *lnabs; 115 | ssize_t n = readlink(file, lnrel, PATH_MAX); 116 | if( n < 0 ) { 117 | fprintf(stderr, "Cannot read link %s\n", file); 118 | exit(1); 119 | } 120 | lnrel[n++] = 0; 121 | 122 | if( *(lnabs = lnrel) != '/' && 123 | depth(lnabs = src) >= 0 ) { /* not out-of-tree */ 124 | if( phase == 0 ) return; 125 | memcpy(copydir(tmp, path), lnrel, n); 126 | if( stat(tmp, &st) == 0 ) { 127 | symlink(lnrel, path); 128 | return; 129 | } 130 | } else if( phase == 1 ) return; 131 | 132 | if( realpath(lnabs, tmp) == NULL || 133 | link(tmp, path) == -1 ) 134 | fprintf(stderr, "Dangling link %s\n", file); 135 | } 136 | } 137 | 138 | 139 | int main(int argc, char **argv) 140 | { 141 | char cmd[PATH_MAX]; 142 | struct stat st; 143 | int c; 144 | 145 | if( argc < 5 ) { 146 | fprintf(stderr, 147 | "Usage:\t%s tarflags packagename.tar[.gz] packagedir files\n\n" 148 | "Creates packagename.tar[.gz] for distribution which contains\n" 149 | "\"files\" and unpacks into the directory \"packagedir\".\n" 150 | "Symlinks are preserved if they point to files in the package.\n\n", 151 | argv[0]); 152 | exit(1); 153 | } 154 | 155 | if( strstr(argv[2], ".tar") == NULL ) { 156 | fprintf(stderr, "%s is not a tar file\n", argv[2]); 157 | exit(1); 158 | } 159 | 160 | if( stat(argv[3], &st) == 0 ) { 161 | fprintf(stderr, "%s exists already\n", argv[3]); 162 | exit(1); 163 | } 164 | strcpy(path, argv[3]); 165 | path_end = path + strlen(path); 166 | *path_end++ = '/'; 167 | 168 | sprintf(cmd, "rm -fr %s %s", path, argv[2]); 169 | system(cmd); 170 | 171 | for( c = 4; c < argc; ++c ) inspect(argv[c], 0); 172 | for( c = 4; c < argc; ++c ) inspect(argv[c], 1); 173 | 174 | sprintf(cmd, "tar %s %s --owner=root --group=root %s", 175 | argv[1], argv[2], argv[3]); 176 | system(cmd); 177 | 178 | sprintf(cmd, "rm -fr %s", argv[3]); 179 | system(cmd); 180 | 181 | return 0; 182 | } 183 | 184 | -------------------------------------------------------------------------------- /src/suave/Sample.c: -------------------------------------------------------------------------------- 1 | /* 2 | Sample.c 3 | the sampling step of Suave 4 | this file is part of Suave 5 | last modified 28 Nov 14 th 6 | */ 7 | 8 | 9 | typedef struct { 10 | real sum, sqsum; 11 | real weight, weightsum, avg, avgsum; 12 | real guess, chisum, chisqsum; 13 | } Cumulants; 14 | 15 | /*********************************************************************/ 16 | 17 | static void Sample(This *t, cnumber nnew, Region *region, 18 | real *lastw, real *lastx, real *lastf) 19 | { 20 | count comp, df; 21 | number n; 22 | Vector(Cumulants, cumul, NCOMP); 23 | Cumulants *C = cumul + t->ncomp, *c; 24 | Bounds *bounds = RegionBounds(region), *B = bounds + t->ndim, *b; 25 | Result *res; 26 | char **ss = NULL, *s = NULL; 27 | ccount chars = 128*(region->div + 1); 28 | 29 | creal jacobian = 1/ldexp((real)nnew, region->div); 30 | real *w = lastw, *f = lastx; 31 | bin_t *bin = (bin_t *)(lastf + nnew*t->ncomp); 32 | 33 | for( n = nnew; n; --n ) { 34 | real weight = jacobian; 35 | 36 | t->rng.getrandom(t, f); 37 | 38 | for( b = bounds; b < B; ++b ) { 39 | creal pos = *f*NBINS; 40 | ccount ipos = (count)pos; 41 | creal prev = (ipos == 0) ? 0 : b->grid[ipos - 1]; 42 | creal diff = b->grid[ipos] - prev; 43 | *f++ = b->lower + (prev + (pos - ipos)*diff)*(b->upper - b->lower); 44 | *bin++ = ipos; 45 | weight *= diff*NBINS; 46 | } 47 | 48 | *w++ = weight; 49 | } 50 | 51 | DoSample(t, nnew, lastx, lastf, lastw, region->div + 1); 52 | 53 | w[-1] = -w[-1]; 54 | lastw = w; 55 | w = RegionW(region); 56 | region->n = lastw - w; 57 | 58 | if( VERBOSE > 2 ) { 59 | char *p0; 60 | MemAlloc(ss, t->ndim*64 + t->ncomp*(sizeof(char *) + chars)); 61 | s = (char *)(ss + t->ncomp); 62 | p0 = s + t->ndim*64; 63 | for( comp = 0; comp < t->ncomp; ++comp ) { 64 | ss[comp] = p0; 65 | p0 += chars; 66 | } 67 | } 68 | 69 | FClear(cumul); 70 | df = n = 0; 71 | 72 | while( w < lastw ) { 73 | cbool final = (*w < 0); 74 | creal weight = fabs(*w++); 75 | ++n; 76 | 77 | for( c = cumul, comp = 0; c < C; ++c ) { 78 | creal wfun = weight*(*f++); 79 | c->sum += wfun; 80 | c->sqsum += Sq(wfun); 81 | 82 | if( final ) { 83 | if( n >= t->nmin ) { 84 | real w = Weight(c->sum, c->sqsum, n); 85 | c->weightsum += c->weight = w; 86 | c->avgsum += c->avg = w*c->sum; 87 | 88 | if( VERBOSE > 2 ) { 89 | creal sig = sqrt(1/w); 90 | ss[comp] += (df == 0) ? 91 | sprintf(ss[comp], "\n[" COUNT "] " 92 | REAL " +- " REAL " (" NUMBER ")", comp + 1, 93 | c->sum, sig, n) : 94 | sprintf(ss[comp], "\n " 95 | REAL " +- " REAL " (" NUMBER ")", 96 | c->sum, sig, n); 97 | } 98 | 99 | if( df == 0 ) c->guess = c->sum; 100 | else { 101 | c->chisum += w *= c->sum - c->guess; 102 | c->chisqsum += w*c->sum; 103 | } 104 | } 105 | 106 | c->sum = c->sqsum = 0; 107 | } 108 | } 109 | 110 | if( final ) df -= NegQ(t->nmin - n - 1), n = 0; 111 | } 112 | 113 | region->df = --df; 114 | 115 | for( c = cumul, res = region->result; c < C; ++c, ++res ) { 116 | creal sigsq = 1/c->weightsum; 117 | creal avg = sigsq*c->avgsum; 118 | 119 | if( LAST ) { 120 | res->sigsq = 1/c->weight; 121 | res->avg = res->sigsq*c->avg; 122 | } 123 | else { 124 | res->sigsq = sigsq; 125 | res->avg = avg; 126 | } 127 | res->err = sqrt(res->sigsq); 128 | 129 | res->chisq = (sigsq < .9*NOTZERO) ? 0 : c->chisqsum - avg*c->chisum; 130 | /* This catches the special case where the integrand is constant 131 | over the entire region. Unless that constant is zero, only the 132 | first set of samples will have zero variance, and hence weight 133 | (n - 1) 1e30 (see above). All other sets have been sampled 134 | from a non-constant weight function and therefore inevitably 135 | show some variance. This is an artificial effect, brought about 136 | by the fact that the constancy of the integrand in the region is 137 | seen only in this subdivision, and can degrade the chi-square 138 | score quite a bit. If the constancy was determined from more 139 | than two samples (hence .9*NOTZERO), the chi-squares from the 140 | other sets are removed here. */ 141 | } 142 | 143 | if( VERBOSE > 2 ) { 144 | char *p = s; 145 | char *p0 = p + t->ndim*64; 146 | char *msg = "\nRegion (" REALF ") - (" REALF ")"; 147 | 148 | for( b = bounds; b < B; ++b ) { 149 | p += sprintf(p, msg, b->lower, b->upper); 150 | msg = "\n (" REALF ") - (" REALF ")"; 151 | } 152 | 153 | for( comp = 0, res = region->result; 154 | comp < t->ncomp; ++comp, ++res ) { 155 | p += sprintf(p, "%s \tchisq " REAL " (" COUNT " df)", 156 | p0, res->chisq, df); 157 | p0 += chars; 158 | } 159 | 160 | Print(s); 161 | free(ss); 162 | } 163 | } 164 | 165 | -------------------------------------------------------------------------------- /cuba.h: -------------------------------------------------------------------------------- 1 | /* 2 | cuba.h 3 | Prototypes for the Cuba library 4 | this file is part of Cuba 5 | last modified 28 Nov 14 th 6 | */ 7 | 8 | #ifdef __cplusplus 9 | extern "C" { 10 | #endif 11 | 12 | /* integrand_t is intentionally a minimalistic integrand type. 13 | It includes neither the nvec and core arguments nor the 14 | extra arguments passed by Vegas/Suave (weight, iter) and 15 | Divonne (phase). 16 | In most cases, integrand_t is just what you want, otherwise 17 | simply use an explicit typecast to integrand_t in the Cuba 18 | invocation. */ 19 | typedef int (*integrand_t)(const int *ndim, const double x[], 20 | const int *ncomp, double f[], void *userdata); 21 | 22 | typedef void (*peakfinder_t)(const int *ndim, const double b[], 23 | int *n, double x[], void *userdata); 24 | 25 | void Vegas(const int ndim, const int ncomp, 26 | integrand_t integrand, void *userdata, const int nvec, 27 | const double epsrel, const double epsabs, 28 | const int flags, const int seed, 29 | const int mineval, const int maxeval, 30 | const int nstart, const int nincrease, const int nbatch, 31 | const int gridno, const char *statefile, void *spin, 32 | int *neval, int *fail, 33 | double integral[], double error[], double prob[]); 34 | 35 | void llVegas(const int ndim, const int ncomp, 36 | integrand_t integrand, void *userdata, const long long int nvec, 37 | const double epsrel, const double epsabs, 38 | const int flags, const int seed, 39 | const long long int mineval, const long long int maxeval, 40 | const long long int nstart, const long long int nincrease, 41 | const long long int nbatch, 42 | const int gridno, const char *statefile, void *spin, 43 | long long int *neval, int *fail, 44 | double integral[], double error[], double prob[]); 45 | 46 | void Suave(const int ndim, const int ncomp, 47 | integrand_t integrand, void *userdata, const int nvec, 48 | const double epsrel, const double epsabs, 49 | const int flags, const int seed, 50 | const int mineval, const int maxeval, 51 | const int nnew, const int nmin, 52 | const double flatness, const char *statefile, void *spin, 53 | int *nregions, int *neval, int *fail, 54 | double integral[], double error[], double prob[]); 55 | 56 | void llSuave(const int ndim, const int ncomp, 57 | integrand_t integrand, void *userdata, const long long int nvec, 58 | const double epsrel, const double epsabs, 59 | const int flags, const int seed, 60 | const long long int mineval, const long long int maxeval, 61 | const long long int nnew, const long long int nmin, 62 | const double flatness, const char *statefile, void *spin, 63 | int *nregions, long long int *neval, int *fail, 64 | double integral[], double error[], double prob[]); 65 | 66 | void Divonne(const int ndim, const int ncomp, 67 | integrand_t integrand, void *userdata, const int nvec, 68 | const double epsrel, const double epsabs, 69 | const int flags, const int seed, 70 | const int mineval, const int maxeval, 71 | const int key1, const int key2, const int key3, const int maxpass, 72 | const double border, const double maxchisq, const double mindeviation, 73 | const int ngiven, const int ldxgiven, double xgiven[], 74 | const int nextra, peakfinder_t peakfinder, 75 | const char *statefile, void *spin, 76 | int *nregions, int *neval, int *fail, 77 | double integral[], double error[], double prob[]); 78 | 79 | void llDivonne(const int ndim, const int ncomp, 80 | integrand_t integrand, void *userdata, const long long int nvec, 81 | const double epsrel, const double epsabs, 82 | const int flags, const int seed, 83 | const long long int mineval, const long long int maxeval, 84 | const int key1, const int key2, const int key3, const int maxpass, 85 | const double border, const double maxchisq, const double mindeviation, 86 | const long long int ngiven, const int ldxgiven, double xgiven[], 87 | const long long int nextra, peakfinder_t peakfinder, 88 | const char *statefile, void *spin, 89 | int *nregions, long long int *neval, int *fail, 90 | double integral[], double error[], double prob[]); 91 | 92 | void Cuhre(const int ndim, const int ncomp, 93 | integrand_t integrand, void *userdata, const int nvec, 94 | const double epsrel, const double epsabs, 95 | const int flags, const int mineval, const int maxeval, 96 | const int key, 97 | const char *statefile, void *spin, 98 | int *nregions, int *neval, int *fail, 99 | double integral[], double error[], double prob[]); 100 | 101 | void llCuhre(const int ndim, const int ncomp, 102 | integrand_t integrand, void *userdata, const long long int nvec, 103 | const double epsrel, const double epsabs, 104 | const int flags, 105 | const long long int mineval, const long long int maxeval, 106 | const int key, 107 | const char *statefile, void *spin, 108 | int *nregions, long long int *neval, int *fail, 109 | double integral[], double error[], double prob[]); 110 | 111 | void cubafork(void *pspin); 112 | void cubawait(void *pspin); 113 | 114 | void cubacores(const int n, const int p); 115 | void cubaaccel(const int n, const int p); 116 | 117 | void cubainit(void (*f)(), void *arg); 118 | void cubaexit(void (*f)(), void *arg); 119 | 120 | #ifdef __cplusplus 121 | } 122 | #endif 123 | 124 | -------------------------------------------------------------------------------- /demo/demo-fortran.F: -------------------------------------------------------------------------------- 1 | * demo-fortran.F 2 | * test program for the Cuba library 3 | * last modified 28 Nov 14 th 4 | 5 | 6 | program CubaTest 7 | implicit none 8 | 9 | integer ndim, ncomp, nvec, last, seed, mineval, maxeval 10 | double precision epsrel, epsabs, userdata 11 | parameter (ndim = 3) 12 | parameter (ncomp = 1) 13 | parameter (userdata = 0) 14 | parameter (nvec = 1) 15 | parameter (epsrel = 1D-3) 16 | parameter (epsabs = 1D-12) 17 | parameter (last = 4) 18 | parameter (seed = 0) 19 | parameter (mineval = 0) 20 | parameter (maxeval = 50000) 21 | 22 | integer nstart, nincrease, nbatch, gridno 23 | integer*8 spin 24 | character*(*) statefile 25 | parameter (nstart = 1000) 26 | parameter (nincrease = 500) 27 | parameter (nbatch = 1000) 28 | parameter (gridno = 0) 29 | parameter (statefile = "") 30 | parameter (spin = -1) 31 | 32 | integer nnew, nmin 33 | double precision flatness 34 | parameter (nnew = 1000) 35 | parameter (nmin = 2) 36 | parameter (flatness = 25D0) 37 | 38 | integer key1, key2, key3, maxpass 39 | double precision border, maxchisq, mindeviation 40 | integer ngiven, ldxgiven, nextra 41 | parameter (key1 = 47) 42 | parameter (key2 = 1) 43 | parameter (key3 = 1) 44 | parameter (maxpass = 5) 45 | parameter (border = 0D0) 46 | parameter (maxchisq = 10D0) 47 | parameter (mindeviation = .25D0) 48 | parameter (ngiven = 0) 49 | parameter (ldxgiven = ndim) 50 | parameter (nextra = 0) 51 | 52 | integer key 53 | parameter (key = 0) 54 | 55 | external integrand 56 | 57 | double precision integral(ncomp), error(ncomp), prob(ncomp) 58 | integer verbose, nregions, neval, fail 59 | character*16 env 60 | 61 | integer c 62 | 63 | call getenv("CUBAVERBOSE", env) 64 | verbose = 2 65 | read(env, *, iostat=fail, end=999, err=999) verbose 66 | 999 continue 67 | 68 | print *, "-------------------- Vegas test --------------------" 69 | 70 | call vegas(ndim, ncomp, integrand, userdata, nvec, 71 | & epsrel, epsabs, verbose, seed, 72 | & mineval, maxeval, nstart, nincrease, nbatch, 73 | & gridno, statefile, spin, 74 | & neval, fail, integral, error, prob) 75 | 76 | print *, "neval =", neval 77 | print *, "fail =", fail 78 | print '(F20.12," +- ",F20.12," p = ",F8.3)', 79 | & (integral(c), error(c), prob(c), c = 1, ncomp) 80 | 81 | print *, " " 82 | print *, "-------------------- Suave test --------------------" 83 | 84 | call suave(ndim, ncomp, integrand, userdata, nvec, 85 | & epsrel, epsabs, verbose + last, seed, 86 | & mineval, maxeval, nnew, nmin, flatness, 87 | & statefile, spin, 88 | & nregions, neval, fail, integral, error, prob) 89 | 90 | print *, "nregions =", nregions 91 | print *, "neval =", neval 92 | print *, "fail =", fail 93 | print '(F20.12," +- ",F20.12," p = ",F8.3)', 94 | & (integral(c), error(c), prob(c), c = 1, ncomp) 95 | 96 | print *, " " 97 | print *, "------------------- Divonne test -------------------" 98 | 99 | call divonne(ndim, ncomp, integrand, userdata, nvec, 100 | & epsrel, epsabs, verbose, seed, 101 | & mineval, maxeval, key1, key2, key3, maxpass, 102 | & border, maxchisq, mindeviation, 103 | & ngiven, ldxgiven, 0, nextra, 0, 104 | & statefile, spin, 105 | & nregions, neval, fail, integral, error, prob) 106 | 107 | print *, "nregions =", nregions 108 | print *, "neval =", neval 109 | print *, "fail =", fail 110 | print '(F20.12," +- ",F20.12," p = ",F8.3)', 111 | & (integral(c), error(c), prob(c), c = 1, ncomp) 112 | 113 | print *, " " 114 | print *, "-------------------- Cuhre test --------------------" 115 | 116 | call cuhre(ndim, ncomp, integrand, userdata, nvec, 117 | & epsrel, epsabs, verbose + last, 118 | & mineval, maxeval, key, 119 | & statefile, spin, 120 | & nregions, neval, fail, integral, error, prob) 121 | 122 | print *, "nregions =", nregions 123 | print *, "neval =", neval 124 | print *, "fail =", fail 125 | print '(F20.12," +- ",F20.12," p = ",F8.3)', 126 | & (integral(c), error(c), prob(c), c = 1, ncomp) 127 | end 128 | 129 | 130 | ************************************************************************ 131 | 132 | integer function integrand(ndim, xx, ncomp, ff) 133 | implicit none 134 | integer ndim, ncomp 135 | double precision xx(*), ff(*) 136 | 137 | #define x xx(1) 138 | #define y xx(2) 139 | #define z xx(3) 140 | #define f ff(1) 141 | 142 | #ifndef FUN 143 | #define FUN 1 144 | #endif 145 | 146 | double precision pi, rsq 147 | parameter (pi = 3.14159265358979323846D0) 148 | 149 | rsq = x**2 + y**2 + z**2 150 | 151 | #if FUN == 1 152 | f = sin(x)*cos(y)*exp(z) 153 | #elif FUN == 2 154 | f = 1/((x + y)**2 + .003D0)*cos(y)*exp(z) 155 | #elif FUN == 3 156 | f = 1/(3.75D0 - cos(pi*x) - cos(pi*y) - cos(pi*z)) 157 | #elif FUN == 4 158 | f = abs(rsq - .125D0) 159 | #elif FUN == 5 160 | f = exp(-rsq) 161 | #elif FUN == 6 162 | f = 1/(1 - x*y*z + 1D-10) 163 | #elif FUN == 7 164 | f = sqrt(abs(x - y - z)) 165 | #elif FUN == 8 166 | f = exp(-x*y*z) 167 | #elif FUN == 9 168 | f = x**2/(cos(x + y + z + 1) + 5) 169 | #elif FUN == 10 170 | if( x .gt. .5D0 ) then 171 | f = 1/sqrt(x*y*z + 1D-5) 172 | else 173 | f = sqrt(x*y*z) 174 | endif 175 | #else 176 | if( rsq .lt. 1 ) then 177 | f = 1 178 | else 179 | f = 0 180 | endif 181 | #endif 182 | 183 | integrand = 0 184 | end 185 | 186 | -------------------------------------------------------------------------------- /src/vegas/Integrate.c: -------------------------------------------------------------------------------- 1 | /* 2 | Integrate.c 3 | integrate over the unit hypercube 4 | this file is part of Vegas 5 | last modified 23 May 14 th 6 | */ 7 | 8 | 9 | typedef struct { 10 | signature_t signature; 11 | count niter; 12 | number nsamples, neval; 13 | Cumulants cumul[]; 14 | } State; 15 | 16 | static int Integrate(This *t, real *integral, real *error, real *prob) 17 | { 18 | bin_t *bins; 19 | count dim, comp; 20 | int fail; 21 | 22 | StateDecl; 23 | csize_t statesize = sizeof(State) + 24 | NCOMP*sizeof(Cumulants) + NDIM*sizeof(Grid); 25 | Sized(State, state, statesize); 26 | Cumulants *c, *C = state->cumul + t->ncomp; 27 | Grid *state_grid = (Grid *)C; 28 | Array(Grid, margsum, NCOMP, NDIM); 29 | Vector(char, out, 128*NCOMP + 256); 30 | 31 | if( VERBOSE > 1 ) { 32 | sprintf(out, "Vegas input parameters:\n" 33 | " ndim " COUNT "\n ncomp " COUNT "\n" 34 | ML_NOT(" nvec " NUMBER "\n") 35 | " epsrel " REAL "\n epsabs " REAL "\n" 36 | " flags %d\n seed %d\n" 37 | " mineval " NUMBER "\n maxeval " NUMBER "\n" 38 | " nstart " NUMBER "\n nincrease " NUMBER "\n" 39 | " nbatch " NUMBER "\n gridno %d\n" 40 | " statefile \"%s\"", 41 | t->ndim, t->ncomp, 42 | ML_NOT(t->nvec,) 43 | t->epsrel, t->epsabs, 44 | t->flags, t->seed, 45 | t->mineval, t->maxeval, 46 | t->nstart, t->nincrease, t->nbatch, 47 | t->gridno, t->statefile); 48 | Print(out); 49 | } 50 | 51 | if( BadComponent(t) ) return -2; 52 | if( BadDimension(t) ) return -1; 53 | 54 | FrameAlloc(t, Master); 55 | ForkCores(t); 56 | Alloc(bins, t->nbatch*t->ndim); 57 | 58 | if( (fail = setjmp(t->abort)) ) goto abort; 59 | 60 | IniRandom(t); 61 | 62 | StateSetup(t); 63 | 64 | if( StateReadTest(t) ) { 65 | StateReadOpen(t, fd) { 66 | if( read(fd, state, statesize) != statesize || 67 | state->signature != StateSignature(t, 1) ) break; 68 | } StateReadClose(t, fd); 69 | t->neval = state->neval; 70 | t->rng.skiprandom(t, t->neval); 71 | } 72 | 73 | if( ini ) { 74 | state->niter = 0; 75 | state->nsamples = t->nstart; 76 | FClear(state->cumul); 77 | GetGrid(t, state_grid); 78 | t->neval = 0; 79 | } 80 | 81 | /* main iteration loop */ 82 | for( ; ; ) { 83 | number nsamples = state->nsamples; 84 | creal jacobian = 1./nsamples; 85 | 86 | FClear(margsum); 87 | 88 | for( ; nsamples > 0; nsamples -= t->nbatch ) { 89 | cnumber n = IMin(t->nbatch, nsamples); 90 | real *w = t->frame; 91 | real *x = w + n; 92 | real *f = x + n*t->ndim; 93 | real *lastf = f + n*t->ncomp; 94 | bin_t *bin = bins; 95 | 96 | while( x < f ) { 97 | real weight = jacobian; 98 | 99 | t->rng.getrandom(t, x); 100 | 101 | for( dim = 0; dim < t->ndim; ++dim ) { 102 | creal pos = *x*NBINS; 103 | ccount ipos = (count)pos; 104 | creal prev = (ipos == 0) ? 0 : state_grid[dim][ipos - 1]; 105 | creal diff = state_grid[dim][ipos] - prev; 106 | *x++ = prev + (pos - ipos)*diff; 107 | *bin++ = ipos; 108 | weight *= diff*NBINS; 109 | } 110 | 111 | *w++ = weight; 112 | } 113 | 114 | DoSample(t, n, w, f, t->frame, state->niter + 1); 115 | 116 | bin = bins; 117 | w = t->frame; 118 | 119 | while( f < lastf ) { 120 | creal weight = *w++; 121 | Grid *m = &margsum[0][0]; 122 | 123 | for( c = state->cumul; c < C; ++c ) { 124 | real wfun = weight*(*f++); 125 | if( wfun ) { 126 | c->sum += wfun; 127 | c->sqsum += wfun *= wfun; 128 | for( dim = 0; dim < t->ndim; ++dim ) 129 | m[dim][bin[dim]] += wfun; 130 | } 131 | m += t->ndim; 132 | } 133 | 134 | bin += t->ndim; 135 | } 136 | } 137 | 138 | fail = 0; 139 | 140 | /* compute the integral and error values */ 141 | 142 | for( c = state->cumul; c < C; ++c ) { 143 | real w = Weight(c->sum, c->sqsum, state->nsamples); 144 | real sigsq = 1/(c->weightsum += w); 145 | real avg = sigsq*(c->avgsum += w*c->sum); 146 | 147 | c->avg = LAST ? (sigsq = 1/w, c->sum) : avg; 148 | c->err = sqrt(sigsq); 149 | fail |= (c->err > MaxErr(c->avg)); 150 | 151 | if( state->niter == 0 ) c->guess = c->sum; 152 | else { 153 | c->chisum += w *= c->sum - c->guess; 154 | c->chisqsum += w*c->sum; 155 | } 156 | c->chisq = c->chisqsum - avg*c->chisum; 157 | 158 | c->sum = c->sqsum = 0; 159 | } 160 | 161 | if( VERBOSE ) { 162 | char *oe = out + sprintf(out, "\n" 163 | "Iteration " COUNT ": " NUMBER " integrand evaluations so far", 164 | state->niter + 1, t->neval); 165 | for( c = state->cumul, comp = 0; c < C; ++c ) 166 | oe += sprintf(oe, "\n[" COUNT "] " 167 | REAL " +- " REAL " \tchisq " REAL " (" COUNT " df)", 168 | ++comp, c->avg, c->err, c->chisq, state->niter); 169 | Print(out); 170 | } 171 | 172 | if( fail == 0 && t->neval >= t->mineval ) break; 173 | 174 | if( t->neval >= t->maxeval && !StateWriteTest(t) ) break; 175 | 176 | if( t->ncomp == 1 ) 177 | for( dim = 0; dim < t->ndim; ++dim ) 178 | RefineGrid(t, state_grid[dim], margsum[0][dim]); 179 | else { 180 | for( dim = 0; dim < t->ndim; ++dim ) { 181 | Grid wmargsum; 182 | Zap(wmargsum); 183 | for( comp = 0; comp < t->ncomp; ++comp ) { 184 | real w = state->cumul[comp].avg; 185 | if( w != 0 ) { 186 | creal *m = margsum[comp][dim]; 187 | count bin; 188 | w = 1/Sq(w); 189 | for( bin = 0; bin < NBINS; ++bin ) 190 | wmargsum[bin] += w*m[bin]; 191 | } 192 | } 193 | RefineGrid(t, state_grid[dim], wmargsum); 194 | } 195 | } 196 | 197 | ++state->niter; 198 | state->nsamples += t->nincrease; 199 | 200 | if( StateWriteTest(t) ) { 201 | state->signature = StateSignature(t, 1); 202 | state->neval = t->neval; 203 | StateWriteOpen(t, fd) { 204 | StateWrite(fd, state, statesize); 205 | } StateWriteClose(t, fd); 206 | if( t->neval >= t->maxeval ) break; 207 | } 208 | } 209 | 210 | for( comp = 0; comp < t->ncomp; ++comp ) { 211 | cCumulants *c = &state->cumul[comp]; 212 | integral[comp] = c->avg; 213 | error[comp] = c->err; 214 | prob[comp] = ChiSquare(c->chisq, state->niter); 215 | } 216 | 217 | abort: 218 | PutGrid(t, state_grid); 219 | free(bins); 220 | FrameFree(t, Master); 221 | 222 | StateRemove(t); 223 | 224 | return fail; 225 | } 226 | 227 | -------------------------------------------------------------------------------- /tools/partview.cpp: -------------------------------------------------------------------------------- 1 | /* 2 | partview.cpp 3 | Partition viewer for Cuba 4 | last modified 18 Dec 13 th 5 | */ 6 | 7 | 8 | #include 9 | #include 10 | #include 11 | 12 | #include 13 | #include 14 | #include 15 | #include 16 | #include 17 | #include 18 | #include 19 | #include 20 | #include 21 | #include 22 | 23 | #include 24 | 25 | #include "quit.xpm" 26 | #include "print.xpm" 27 | 28 | // -------------------------------------------------------------- 29 | 30 | class PartitionPlane : public QWidget 31 | { 32 | public: 33 | PartitionPlane( const int dimx, const int dimy, QWidget *parent = 0 ) 34 | : QWidget(parent), m_dimx(dimx), m_dimy(dimy), m_got(0) { 35 | } 36 | 37 | void addBound( const int dim, const double lower, const double upper ); 38 | 39 | void drawRegion( QPainter *p, const QRect &r ); 40 | void drawRegions( QPainter *p ); 41 | 42 | QSize sizeHint() const { 43 | return QSize(InitialSize, InitialSize); 44 | } 45 | 46 | QString filename() const { 47 | return QString("%1-%2.ps").arg(m_dimx).arg(m_dimy); 48 | } 49 | 50 | protected: 51 | void paintEvent( QPaintEvent * ) { 52 | QPainter p(this); 53 | drawRegions( &p ); 54 | } 55 | 56 | private: 57 | int m_dimx, m_dimy, m_got; 58 | int m_xlower, m_xupper, m_ylower, m_yupper; 59 | 60 | typedef std::list regionList; 61 | typedef regionList::iterator regionIt; 62 | regionList m_regions; 63 | 64 | enum { 65 | Hue = 0, // red 66 | InitialSize = 400, 67 | CoordScale = 4*InitialSize }; 68 | }; 69 | 70 | 71 | void PartitionPlane::addBound( const int dim, 72 | const double lower, const double upper ) 73 | { 74 | if( dim == m_dimx ) { 75 | m_xlower = int(CoordScale*lower); 76 | m_xupper = int(CoordScale*upper); 77 | m_got |= 1; 78 | } 79 | if( dim == m_dimy ) { 80 | m_ylower = int(CoordScale*lower); 81 | m_yupper = int(CoordScale*upper); 82 | m_got |= 2; 83 | } 84 | 85 | if( m_got == 3 ) { 86 | m_got = 0; 87 | 88 | const QRect rect = QRect(m_xlower, CoordScale - m_yupper, 89 | m_xupper - m_xlower + 1, m_yupper - m_ylower + 1); 90 | 91 | const int area = rect.width()*rect.height(); 92 | regionIt r; 93 | 94 | for( r = m_regions.begin(); r != m_regions.end(); ++r ) { 95 | if( rect == *r ) return; 96 | if( area > (*r).width()*(*r).height() ) break; 97 | } 98 | m_regions.insert(r, rect); 99 | 100 | // QPainter p(this); 101 | // drawRegion( &p, rect ); 102 | this->update(rect); 103 | } 104 | } 105 | 106 | 107 | void PartitionPlane::drawRegion( QPainter *p, const QRect &r ) 108 | { 109 | p->setWindow(0, 0, CoordScale, CoordScale); 110 | 111 | QColor c; 112 | const double ratio = r.width()*r.height()/ 113 | double(CoordScale*CoordScale); 114 | const int saturation = int(255/(M_PI/2)*asin(1 - ratio)); 115 | c.setHsv( Hue, saturation, 255 ); 116 | p->setBrush(c); 117 | 118 | p->setPen(palette().foreground().color()); 119 | 120 | p->drawRect(r); 121 | } 122 | 123 | 124 | void PartitionPlane::drawRegions( QPainter *p ) 125 | { 126 | for( regionIt r = m_regions.begin(); r != m_regions.end(); ++r ) 127 | drawRegion( p, *r ); 128 | } 129 | 130 | 131 | // -------------------------------------------------------------- 132 | 133 | class PartitionViewer : public QMainWindow 134 | { 135 | Q_OBJECT 136 | 137 | public: 138 | PartitionViewer( QWidget *parent = 0 ); 139 | void addPlane( const int dimx, const int dimy ); 140 | void addBound( const int dim, const double lower, const double upper ); 141 | int count() const { return m_tabs->count(); } 142 | void tabupdate() { 143 | if( m_tabs->currentWidget() != 0 ) m_tabs->currentWidget()->update(); 144 | } 145 | 146 | public slots: 147 | void print(); 148 | 149 | private: 150 | QTabWidget *m_tabs; 151 | QPrinter *m_printer; 152 | }; 153 | 154 | 155 | PartitionViewer::PartitionViewer( QWidget *parent ) 156 | : QMainWindow(parent) 157 | { 158 | setWindowTitle(tr("Cuba Partition Viewer")); 159 | 160 | QToolBar *toolbar = new QToolBar(this); 161 | addToolBar(Qt::LeftToolBarArea, toolbar); 162 | 163 | QAction *quit = new QAction( QPixmap(quit_xpm), tr("&Quit"), this ); 164 | quit->setShortcut(QKeySequence(tr("Ctrl+Q"))); 165 | connect( quit, SIGNAL(activated()), qApp, SLOT(quit()) ); 166 | toolbar->addAction(quit); 167 | 168 | #ifndef QT_NO_PRINTER 169 | QAction *print = new QAction( QPixmap(print_xpm), tr("&Print..."), this ); 170 | print->setShortcut(QKeySequence(tr("Ctrl+P"))); 171 | connect( print, SIGNAL(activated()), this, SLOT(print()) ); 172 | toolbar->addAction(print); 173 | 174 | m_printer = new QPrinter; 175 | #endif 176 | 177 | m_tabs = new QTabWidget(this); 178 | setCentralWidget(m_tabs); 179 | } 180 | 181 | 182 | void PartitionViewer::addPlane( const int dimx, const int dimy ) 183 | { 184 | PartitionPlane *plane = new PartitionPlane(dimx, dimy, this); 185 | m_tabs->addTab( plane, tr("%1-%2 plane").arg(dimx).arg(dimy) ); 186 | } 187 | 188 | 189 | void PartitionViewer::addBound( const int dim, 190 | const double lower, const double upper ) 191 | { 192 | for( int index = 0; index < m_tabs->count(); ++index ) { 193 | PartitionPlane *plane = (PartitionPlane *)m_tabs->widget(index); 194 | if( plane ) plane->addBound(dim, lower, upper); 195 | } 196 | } 197 | 198 | 199 | void PartitionViewer::print() 200 | { 201 | #ifndef QT_NO_PRINTER 202 | PartitionPlane *plane = (PartitionPlane *)m_tabs->currentWidget(); 203 | if( !plane ) return; 204 | 205 | QPrintDialog printDialog(m_printer, this); 206 | if( printDialog.exec() == QDialog::Accepted ) { 207 | QPainter p; 208 | if( p.begin(m_printer) ) { 209 | p.setViewport( QRect(QPoint(0, 0), plane->sizeHint()) ); 210 | // plane->drawRegions( &p ); 211 | this->update(); 212 | } 213 | } 214 | #endif 215 | } 216 | 217 | 218 | #include "partview.moc" 219 | 220 | // -------------------------------------------------------------- 221 | 222 | int main( int argc, char **argv ) 223 | { 224 | QApplication app(argc, argv); 225 | PartitionViewer partview; 226 | 227 | argc = (argc - 1) & -2; 228 | 229 | for( int arg = 0; arg < argc; ) { 230 | const int dimx = atoi(argv[++arg]); 231 | const int dimy = atoi(argv[++arg]); 232 | if( dimx > 0 && dimy > 0 ) partview.addPlane(dimx, dimy); 233 | } 234 | 235 | if( partview.count() == 0 ) { 236 | fprintf(stderr, "Usage: %s dimx dimy ...\n" 237 | "reads Cuba's verbose = 3 output from stdin and displays\n" 238 | "the dimx-dimy plane of the tessellation on screen.\n" 239 | "Each pair of dimensions is shown in a separate window.\n\n", 240 | argv[0]); 241 | exit(1); 242 | } 243 | 244 | partview.show(); 245 | 246 | int dim = 0; 247 | char line[128]; 248 | 249 | while( fgets(line, sizeof line, stdin) ) { 250 | double lower, upper; 251 | 252 | fputs(line, stdout); 253 | 254 | if( sscanf(line, "%*[^(](%lf) - (%lf)", &lower, &upper) == 2 ) 255 | partview.addBound(++dim, lower, upper); 256 | else dim = 0; 257 | 258 | app.processEvents(); 259 | } 260 | 261 | fflush(stdout); 262 | partview.tabupdate(); 263 | return app.exec(); 264 | } 265 | 266 | -------------------------------------------------------------------------------- /src/cuhre/Cuhre.tm: -------------------------------------------------------------------------------- 1 | :Evaluate: BeginPackage["Cuba`"] 2 | 3 | :Evaluate: Cuhre::usage = 4 | "Cuhre[f, {x, xmin, xmax}..] computes a numerical approximation to the integral of the real scalar or vector function f. 5 | The output is a list with entries of the form {integral, error, chi-square probability} for each component of the integrand." 6 | 7 | :Evaluate: MinPoints::usage = "MinPoints is an option of Cuhre. 8 | It specifies the minimum number of points to sample." 9 | 10 | :Evaluate: Key::usage = "Key is an option of Cuhre. 11 | It specifies the basic integration rule:\n 12 | 7 = use a degree-7 rule,\n 13 | 9 = use a degree-9 rule,\n 14 | 11 = use a degree-11 rule (available only in 3 dimensions),\n 15 | 13 = use a degree-13 rule (available only in 2 dimensions),\n 16 | otherwise the default rule is used: the degree-13 rule in 2 dimensions, the degree-11 rule in 3 dimensions, else the degree-9 rule." 17 | 18 | :Evaluate: StateFile::usage = "StateFile is an option of Cuhre. 19 | It specifies a file in which the internal state is stored after each iteration and from which it can be restored on a subsequent run. 20 | The state file is removed once the prescribed accuracy has been reached." 21 | 22 | :Evaluate: Final::usage = "Final is an option of Cuhre. 23 | It can take the values Last or All which determine whether only the last (largest) or all sets of samples collected on a subregion over the iterations contribute to the final result." 24 | 25 | :Evaluate: RetainStateFile::usage = "RetainStateFile is an option of Cuhre. 26 | It determines whether a chosen state file is kept even if the integration terminates normally." 27 | 28 | :Evaluate: Regions::usage = "Regions is an option of Cuhre. 29 | It specifies whether the regions into which the integration region has been cut are returned together with the integration results." 30 | 31 | :Evaluate: Region::usage = "Region[ll, ur, res] describes a subregion: 32 | ll and ur are multidimensional equivalents of the region's lower left and upper right corner. 33 | res gives the integration results for the region in a list with entries of the form {integral, error} for each component of the integrand." 34 | 35 | :Evaluate: MapSample::usage = "MapSample is a function used to map the integrand over the points to be sampled." 36 | 37 | 38 | :Evaluate: Begin["`Cuhre`"] 39 | 40 | :Begin: 41 | :Function: Cuhre 42 | :Pattern: MLCuhre[ndim_, ncomp_, 43 | epsrel_, epsabs_, flags_, mineval_, maxeval_, 44 | key_, statefile_] 45 | :Arguments: {ndim, ncomp, 46 | epsrel, epsabs, flags, mineval, maxeval, 47 | key, statefile} 48 | :ArgumentTypes: {Integer, Integer, 49 | Real, Real, Integer, Integer, Integer, 50 | Integer, String} 51 | :ReturnType: Manual 52 | :End: 53 | 54 | :Evaluate: Attributes[Cuhre] = {HoldFirst} 55 | 56 | :Evaluate: Options[Cuhre] = {PrecisionGoal -> 3, AccuracyGoal -> 12, 57 | MinPoints -> 0, MaxPoints -> 50000, Key -> 0, StateFile -> "", 58 | Verbose -> 1, Final -> Last, RetainStateFile -> False, 59 | Regions -> False, Compiled -> True} 60 | 61 | :Evaluate: Cuhre[f_, v:{_, _, _}.., opt___Rule] := 62 | Block[ {ff = HoldForm[f], ndim = Length[{v}], ncomp, 63 | tags, vars, lower, range, jac, tmp, defs, intT, 64 | rel, abs, mineval, maxeval, key, state, verbose, final, 65 | retain, regions, compiled}, 66 | Message[Cuhre::optx, #, Cuhre]&/@ 67 | Complement[First/@ {opt}, tags = First/@ Options[Cuhre]]; 68 | {rel, abs, mineval, maxeval, key, state, 69 | verbose, final, retain, regions, compiled} = 70 | tags /. {opt} /. Options[Cuhre]; 71 | {vars, lower, range} = Transpose[{v}]; 72 | jac = Simplify[Times@@ (range -= lower)]; 73 | tmp = Array[tmpvar, ndim]; 74 | defs = Simplify[lower + range tmp]; 75 | Block[{Set}, define[compiled, tmp, Thread[vars = defs], jac]]; 76 | intT = integrandT[f]; 77 | Block[#, 78 | ncomp = Length[intT@@ RandomReal[1, ndim]]; 79 | MLCuhre[ndim, ncomp, 10.^-rel, 10.^-abs, 80 | Min[Max[verbose, 0], 3] + 81 | If[final === Last, 4, 0] + 82 | If[TrueQ[retain], 16, 0] + 83 | If[TrueQ[regions], 128, 0], 84 | mineval, maxeval, key, state] 85 | ]& @ vars 86 | ] 87 | 88 | :Evaluate: tmpvar[n_] := ToExpression["Cuba`Cuhre`t" <> ToString[n]] 89 | 90 | :Evaluate: Attributes[foo] = {HoldAll} 91 | 92 | :Evaluate: define[True, tmp_, defs_, jac_] := ( 93 | TtoX := TtoX = Compile[tmp, defs]; 94 | integrandT[f_] := Compile[tmp, eval[defs, N[f jac]], 95 | {{_eval, _Real, 1}}] ) 96 | 97 | :Evaluate: define[_, tmp_, defs_, jac_] := ( 98 | TtoX := TtoX = Function[tmp, defs]; 99 | integrandT[f_] := Function[tmp, eval[defs, N[f jac]]] ) 100 | 101 | :Evaluate: eval[_, f_Real] = {f} 102 | 103 | :Evaluate: eval[_, f:{__Real}] = f 104 | 105 | :Evaluate: eval[x_, _] := (Message[Cuhre::badsample, ff, x]; {}) 106 | 107 | :Evaluate: sample[x_] := 108 | Check[Flatten @ MapSample[intT@@ # &, Partition[x, ndim]], {}] 109 | 110 | :Evaluate: ValueQ[MapSample] || (MapSample = Map) 111 | 112 | :Evaluate: region[bounds_, r___] := Region[##, r]&@@ 113 | MapThread[TtoX, Partition[bounds, 2]] 114 | 115 | :Evaluate: Cuhre::badsample = "`` is not a real-valued function at ``." 116 | 117 | :Evaluate: Cuhre::baddim = "Cannot integrate in `` dimensions." 118 | 119 | :Evaluate: Cuhre::badcomp = "Cannot integrate `` components." 120 | 121 | :Evaluate: Cuhre::accuracy = 122 | "Desired accuracy was not reached within `` function evaluations on `` subregions." 123 | 124 | :Evaluate: Cuhre::success = "Needed `` function evaluations on `` subregions." 125 | 126 | :Evaluate: End[] 127 | 128 | :Evaluate: EndPackage[] 129 | 130 | 131 | /* 132 | Cuhre.tm 133 | Adaptive integration using cubature rules 134 | by Thomas Hahn 135 | last modified 27 Aug 14 th 136 | */ 137 | 138 | 139 | #define CUHRE 140 | #define ROUTINE "Cuhre" 141 | 142 | #include "mathlink.h" 143 | #include "decl.h" 144 | #include "MSample.c" 145 | 146 | /*********************************************************************/ 147 | 148 | static void Status(MLCONST char *msg, cint n1, cint n2) 149 | { 150 | MLPutFunction(stdlink, "CompoundExpression", 2); 151 | MLPutFunction(stdlink, "Message", 3); 152 | MLPutFunction(stdlink, "MessageName", 2); 153 | MLPutSymbol(stdlink, "Cuhre"); 154 | MLPutString(stdlink, msg); 155 | MLPutInteger(stdlink, n1); 156 | MLPutInteger(stdlink, n2); 157 | } 158 | 159 | /*********************************************************************/ 160 | 161 | static inline void DoIntegrate(This *t) 162 | { 163 | real integral[NCOMP], error[NCOMP], prob[NCOMP]; 164 | cint fail = Integrate(t, integral, error, prob); 165 | 166 | if( fail < 0 ) { 167 | switch( fail ) { 168 | case -99: 169 | MLPutFunction(stdlink, "Abort", 0); 170 | return; 171 | case -1: 172 | Status("baddim", t->ndim, 0); 173 | break; 174 | case -2: 175 | Status("badcomp", t->ncomp, 0); 176 | break; 177 | } 178 | MLPutSymbol(stdlink, "$Failed"); 179 | } 180 | else { 181 | Status(fail ? "accuracy" : "success", t->neval, t->nregions); 182 | MLPutFunction(stdlink, "Thread", 1); 183 | MLPutFunction(stdlink, "List", 3); 184 | MLPutRealList(stdlink, integral, t->ncomp); 185 | MLPutRealList(stdlink, error, t->ncomp); 186 | MLPutRealList(stdlink, prob, t->ncomp); 187 | } 188 | } 189 | 190 | /*********************************************************************/ 191 | 192 | void Cuhre(cint ndim, cint ncomp, 193 | creal epsrel, creal epsabs, 194 | cint flags, cnumber mineval, cnumber maxeval, 195 | cint key, cchar *statefile) 196 | { 197 | This t; 198 | t.ndim = ndim; 199 | t.ncomp = ncomp; 200 | t.epsrel = epsrel; 201 | t.epsabs = epsabs; 202 | t.flags = flags; 203 | t.mineval = mineval; 204 | t.maxeval = maxeval; 205 | t.key = key; 206 | t.statefile = statefile; 207 | 208 | DoIntegrate(&t); 209 | MLEndPacket(stdlink); 210 | } 211 | 212 | /*********************************************************************/ 213 | 214 | int main(int argc, char **argv) 215 | { 216 | return MLMain(argc, argv); 217 | } 218 | 219 | -------------------------------------------------------------------------------- /src/divonne/Sample.c: -------------------------------------------------------------------------------- 1 | /* 2 | Sample.c 3 | most of what is related to sampling 4 | this file is part of Divonne 5 | last modified 25 Mar 14 th 6 | */ 7 | 8 | 9 | #define MARKMASK NUMBER_MAX 10 | #define Marked(x) ((x) & ~MARKMASK) 11 | #define Unmark(x) ((x) & MARKMASK) 12 | 13 | #define NWANTMAX NUMBER_MAX 14 | 15 | #define EXTRAPOLATE_EPS (.25*t->border.lower) 16 | /*#define EXTRAPOLATE_EPS 0x1p-26*/ 17 | 18 | /*********************************************************************/ 19 | 20 | static inline void SamplesIni(Samples *samples) 21 | { 22 | samples->x = NULL; 23 | samples->n = 0; 24 | } 25 | 26 | /*********************************************************************/ 27 | 28 | static inline bool SamplesIniQ(cSamples *samples) 29 | { 30 | return samples->x == NULL; 31 | } 32 | 33 | /*********************************************************************/ 34 | 35 | static inline void SamplesFree(cSamples *samples) 36 | { 37 | free(samples->x); 38 | } 39 | 40 | /*********************************************************************/ 41 | 42 | static void SampleSobol(This *t, ccount iregion) 43 | { 44 | SAMPLERDEFS; 45 | Vector(real, avg, NCOMP); 46 | real norm; 47 | number i; 48 | count dim, comp; 49 | 50 | for( i = 0; i < n; ++i ) { 51 | t->rng.getrandom(t, x); 52 | for( dim = 0; dim < t->ndim; ++x, ++dim ) 53 | *x = b[dim].lower + *x*(b[dim].upper - b[dim].lower); 54 | } 55 | 56 | t->nrand += n; 57 | 58 | DoSample(t, n, samples->x, f); 59 | 60 | FCopy(avg, f); 61 | f += t->ncomp; 62 | for( i = 2; i < n; ++i ) 63 | for( comp = 0; comp < t->ncomp; ++comp ) 64 | avg[comp] += *f++; 65 | 66 | norm = region->vol/samples->neff; 67 | for( comp = 0; comp < t->ncomp; ++comp ) { 68 | res[comp].avg = norm*avg[comp]; 69 | res[comp].err = 0; 70 | } 71 | } 72 | 73 | /*********************************************************************/ 74 | 75 | static void SampleKorobov(This *t, ccount iregion) 76 | { 77 | SAMPLERDEFS; 78 | real *xlast = x + t->ndim, *flast = f + t->ncomp; 79 | Vector(real, avg, NCOMP); 80 | real norm; 81 | cnumber neff = samples->neff; 82 | number nextra = 0, i; 83 | real dist = 0; 84 | count dim, comp; 85 | 86 | for( i = 1; i < n; ++i ) { 87 | number c = i; 88 | for( dim = 0; dim < t->ndim; ++dim ) { 89 | creal dx = abs(2*c - neff)/(real)neff; 90 | *xlast++ = b[dim].lower + dx*(b[dim].upper - b[dim].lower); 91 | c = c*samples->coeff % neff; 92 | } 93 | } 94 | 95 | for( dim = 0; dim < t->ndim; ++dim ) { 96 | creal dx = (x[dim] = b[dim].upper) - t->border.upper; 97 | if( dx > 0 ) dist += Sq(dx); 98 | } 99 | 100 | if( dist > 0 ) { 101 | dist = sqrt(dist)/EXTRAPOLATE_EPS; 102 | for( dim = 0; dim < t->ndim; ++dim ) { 103 | real x2 = x[dim], dx = x2 - t->border.upper; 104 | if( dx > 0 ) { 105 | x[dim] = t->border.upper; 106 | x2 = t->border.upper - dx/dist; 107 | } 108 | xlast[dim] = x2; 109 | } 110 | nextra = 1; 111 | } 112 | 113 | DoSample(t, n + nextra, x, f); 114 | 115 | FCopy(avg, flast); 116 | flast += t->ncomp; 117 | for( i = 2; i < n; ++i ) 118 | for( comp = 0; comp < t->ncomp; ++comp ) 119 | avg[comp] += *flast++; 120 | 121 | if( nextra ) { 122 | for( comp = 0; comp < t->ncomp; ++comp ) 123 | f[comp] += dist*(f[comp] - flast[comp]); 124 | for( dim = 0; dim < t->ndim; ++dim ) 125 | x[dim] = b[dim].upper; 126 | } 127 | 128 | norm = region->vol/samples->neff; 129 | for( comp = 0; comp < t->ncomp; ++comp ) { 130 | res[comp].avg = norm*(avg[comp] + avg[comp] + f[comp]); 131 | res[comp].err = 0; 132 | } 133 | } 134 | 135 | /*********************************************************************/ 136 | 137 | #define IsSobol(k) NegQ(k) 138 | #define IsRule(k, d) (k == 9 || k == 7 || (k == 11 && d == 3) || (k == 13 && d == 2)) 139 | 140 | /* The following coding is used for key1, key2, key3: 141 | 0 = for key1, key2: use default, 142 | for key3: do nothing, 143 | 1 = for key3: split region again, 144 | 7 = degree-7 cubature rule, 145 | 9 = degree-9 cubature rule, 146 | 11 = degree-11 cubature rule (only in 3 dims), 147 | 13 = degree-13 cubature rule (only in 2 dims), 148 | -inf..-40 = absolute # of points, Sobol numbers, 149 | -39..-1 = multiplicator, Sobol numbers, 150 | 1..39 = multiplicator, Korobov numbers, 151 | 40..inf = absolute # of points, Korobov numbers. */ 152 | 153 | static number SamplesLookup(This *t, Samples *samples, cint key, 154 | cnumber nwant, cnumber nmax, number nmin) 155 | { 156 | number n; 157 | 158 | if( key == 13 && t->ndim == 2 ) { 159 | samples->rule = &t->rule13; 160 | samples->n = n = nmin = t->rule13.n; 161 | samples->sampler = SampleRule; 162 | } 163 | else if( key == 11 && t->ndim == 3 ) { 164 | samples->rule = &t->rule11; 165 | samples->n = n = nmin = t->rule11.n; 166 | samples->sampler = SampleRule; 167 | } 168 | else if( key == 9 ) { 169 | samples->rule = &t->rule9; 170 | samples->n = n = nmin = t->rule9.n; 171 | samples->sampler = SampleRule; 172 | } 173 | else if( key == 7 ) { 174 | samples->rule = &t->rule7; 175 | samples->n = n = nmin = t->rule7.n; 176 | samples->sampler = SampleRule; 177 | } 178 | else { 179 | n = Abs1(key); 180 | if( n < 40 ) n *= nwant; 181 | samples->sampler = (key < 0) ? SampleSobol : 182 | (n = n/2 + 1, SampleKorobov); 183 | samples->n = IMin(n, nmax); 184 | } 185 | 186 | samples->neff = samples->n; 187 | 188 | return IDim(n - nmax) | Marked(nmax - nmin); 189 | } 190 | 191 | /*********************************************************************/ 192 | 193 | static void SamplesAlloc(cThis *t, Samples *samples) 194 | { 195 | #define FIRST -INT_MAX 196 | #define MarkLast(x) ((x) | 0x40000000) 197 | #define UnmarkLast(x) ((x) & 0x3fffffff) 198 | 199 | #include "KorobovCoeff.c" 200 | 201 | number nx, nf; 202 | 203 | if( samples->sampler == SampleKorobov ) { 204 | enum { max = Elements(prime) - 2 }; 205 | cint n = IMin(2*samples->n - 1, MAXPRIME); 206 | int i = Hash(n), p; 207 | count shift = 2 + NegQ(n - 1000); 208 | 209 | while( i = IMin(IDim(i), max), 210 | n > (p = prime[i + 1]) || n <= prime[i] ) { 211 | cint d = (n - UnmarkLast(p)) >> ++shift; 212 | i += Min1(d); 213 | } 214 | 215 | samples->coeff = coeff[i][t->ndim - KOROBOV_MINDIM]; 216 | samples->neff = p = UnmarkLast(p); 217 | samples->n = p/2 + 1; 218 | } 219 | 220 | nx = t->ndim*(samples->n + 1); /* need 1 for extrapolation */ 221 | nf = t->ncomp*(samples->n + 1); 222 | 223 | Alloc(samples->x, nx + nf + t->ncomp + t->ncomp); 224 | samples->f = samples->x + nx; 225 | } 226 | 227 | /*********************************************************************/ 228 | 229 | static real Sample(This *t, creal *x0) 230 | { 231 | Vector(real, xtmp, 2*NDIM); 232 | Vector(real, ftmp, 2*NCOMP); 233 | real *xlast = xtmp, f; 234 | real dist = 0; 235 | count dim, comp; 236 | number n = 1; 237 | 238 | for( dim = 0; dim < t->ndim; ++dim ) { 239 | creal x1 = *xlast++ = Min(Max(*x0++, 0.), 1.); 240 | real dx; 241 | if( (dx = x1 - t->border.lower) < 0 || 242 | (dx = x1 - t->border.upper) > 0 ) dist += Sq(dx); 243 | } 244 | 245 | if( dist > 0 ) { 246 | dist = sqrt(dist)/EXTRAPOLATE_EPS; 247 | for( dim = 0; dim < t->ndim; ++dim ) { 248 | real x2 = xtmp[dim], dx, b; 249 | if( (dx = x2 - (b = t->border.lower)) < 0 || 250 | (dx = x2 - (b = t->border.upper)) > 0 ) { 251 | xtmp[dim] = b; 252 | x2 = b - dx/dist; 253 | } 254 | *xlast++ = x2; 255 | } 256 | n = 2; 257 | } 258 | 259 | DoSample(t, n, xtmp, ftmp); 260 | 261 | #define fin(x) Min(Max(x, -.5*INFTY), .5*INFTY) 262 | 263 | comp = Untag(t->selectedcomp); 264 | f = fin(ftmp[comp]); 265 | if( n > 1 ) f += dist*(f - fin(ftmp[comp + t->ncomp])); 266 | 267 | return Sign(t->selectedcomp)*f; 268 | } 269 | 270 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | 9 | This version of the GNU Lesser General Public License incorporates 10 | the terms and conditions of version 3 of the GNU General Public 11 | License, supplemented by the additional permissions listed below. 12 | 13 | 0. Additional Definitions. 14 | 15 | As used herein, "this License" refers to version 3 of the GNU Lesser 16 | General Public License, and the "GNU GPL" refers to version 3 of the GNU 17 | General Public License. 18 | 19 | "The Library" refers to a covered work governed by this License, 20 | other than an Application or a Combined Work as defined below. 21 | 22 | An "Application" is any work that makes use of an interface provided 23 | by the Library, but which is not otherwise based on the Library. 24 | Defining a subclass of a class defined by the Library is deemed a mode 25 | of using an interface provided by the Library. 26 | 27 | A "Combined Work" is a work produced by combining or linking an 28 | Application with the Library. The particular version of the Library 29 | with which the Combined Work was made is also called the "Linked 30 | Version". 31 | 32 | The "Minimal Corresponding Source" for a Combined Work means the 33 | Corresponding Source for the Combined Work, excluding any source code 34 | for portions of the Combined Work that, considered in isolation, are 35 | based on the Application, and not on the Linked Version. 36 | 37 | The "Corresponding Application Code" for a Combined Work means the 38 | object code and/or source code for the Application, including any data 39 | and utility programs needed for reproducing the Combined Work from the 40 | Application, but excluding the System Libraries of the Combined Work. 41 | 42 | 1. Exception to Section 3 of the GNU GPL. 43 | 44 | You may convey a covered work under sections 3 and 4 of this License 45 | without being bound by section 3 of the GNU GPL. 46 | 47 | 2. Conveying Modified Versions. 48 | 49 | If you modify a copy of the Library, and, in your modifications, a 50 | facility refers to a function or data to be supplied by an Application 51 | that uses the facility (other than as an argument passed when the 52 | facility is invoked), then you may convey a copy of the modified 53 | version: 54 | 55 | a) under this License, provided that you make a good faith effort to 56 | ensure that, in the event an Application does not supply the 57 | function or data, the facility still operates, and performs 58 | whatever part of its purpose remains meaningful, or 59 | 60 | b) under the GNU GPL, with none of the additional permissions of 61 | this License applicable to that copy. 62 | 63 | 3. Object Code Incorporating Material from Library Header Files. 64 | 65 | The object code form of an Application may incorporate material from 66 | a header file that is part of the Library. You may convey such object 67 | code under terms of your choice, provided that, if the incorporated 68 | material is not limited to numerical parameters, data structure 69 | layouts and accessors, or small macros, inline functions and templates 70 | (ten or fewer lines in length), you do both of the following: 71 | 72 | a) Give prominent notice with each copy of the object code that the 73 | Library is used in it and that the Library and its use are 74 | covered by this License. 75 | 76 | b) Accompany the object code with a copy of the GNU GPL and this license 77 | document. 78 | 79 | 4. Combined Works. 80 | 81 | You may convey a Combined Work under terms of your choice that, 82 | taken together, effectively do not restrict modification of the 83 | portions of the Library contained in the Combined Work and reverse 84 | engineering for debugging such modifications, if you also do each of 85 | the following: 86 | 87 | a) Give prominent notice with each copy of the Combined Work that 88 | the Library is used in it and that the Library and its use are 89 | covered by this License. 90 | 91 | b) Accompany the Combined Work with a copy of the GNU GPL and this license 92 | document. 93 | 94 | c) For a Combined Work that displays copyright notices during 95 | execution, include the copyright notice for the Library among 96 | these notices, as well as a reference directing the user to the 97 | copies of the GNU GPL and this license document. 98 | 99 | d) Do one of the following: 100 | 101 | 0) Convey the Minimal Corresponding Source under the terms of this 102 | License, and the Corresponding Application Code in a form 103 | suitable for, and under terms that permit, the user to 104 | recombine or relink the Application with a modified version of 105 | the Linked Version to produce a modified Combined Work, in the 106 | manner specified by section 6 of the GNU GPL for conveying 107 | Corresponding Source. 108 | 109 | 1) Use a suitable shared library mechanism for linking with the 110 | Library. A suitable mechanism is one that (a) uses at run time 111 | a copy of the Library already present on the user's computer 112 | system, and (b) will operate properly with a modified version 113 | of the Library that is interface-compatible with the Linked 114 | Version. 115 | 116 | e) Provide Installation Information, but only if you would otherwise 117 | be required to provide such information under section 6 of the 118 | GNU GPL, and only to the extent that such information is 119 | necessary to install and execute a modified version of the 120 | Combined Work produced by recombining or relinking the 121 | Application with a modified version of the Linked Version. (If 122 | you use option 4d0, the Installation Information must accompany 123 | the Minimal Corresponding Source and Corresponding Application 124 | Code. If you use option 4d1, you must provide the Installation 125 | Information in the manner specified by section 6 of the GNU GPL 126 | for conveying Corresponding Source.) 127 | 128 | 5. Combined Libraries. 129 | 130 | You may place library facilities that are a work based on the 131 | Library side by side in a single library together with other library 132 | facilities that are not Applications and are not covered by this 133 | License, and convey such a combined library under terms of your 134 | choice, if you do both of the following: 135 | 136 | a) Accompany the combined library with a copy of the same work based 137 | on the Library, uncombined with any other library facilities, 138 | conveyed under the terms of this License. 139 | 140 | b) Give prominent notice with the combined library that part of it 141 | is a work based on the Library, and explaining where to find the 142 | accompanying uncombined form of the same work. 143 | 144 | 6. Revised Versions of the GNU Lesser General Public License. 145 | 146 | The Free Software Foundation may publish revised and/or new versions 147 | of the GNU Lesser General Public License from time to time. Such new 148 | versions will be similar in spirit to the present version, but may 149 | differ in detail to address new problems or concerns. 150 | 151 | Each version is given a distinguishing version number. If the 152 | Library as you received it specifies that a certain numbered version 153 | of the GNU Lesser General Public License "or any later version" 154 | applies to it, you have the option of following the terms and 155 | conditions either of that published version or of any later version 156 | published by the Free Software Foundation. If the Library as you 157 | received it does not specify a version number of the GNU Lesser 158 | General Public License, you may choose any version of the GNU Lesser 159 | General Public License ever published by the Free Software Foundation. 160 | 161 | If the Library as you received it specifies that a proxy can decide 162 | whether future versions of the GNU Lesser General Public License shall 163 | apply, that proxy's public statement of acceptance of any version is 164 | permanent authorization for you to choose that version for the 165 | Library. 166 | -------------------------------------------------------------------------------- /src/cuhre/Integrate.c: -------------------------------------------------------------------------------- 1 | /* 2 | Integrate.c 3 | integrate over the unit hypercube 4 | this file is part of Cuhre 5 | checkpointing by B. Chokoufe 6 | last modified 23 May 14 th 7 | */ 8 | 9 | 10 | #define POOLSIZE 1024 11 | 12 | typedef struct pool { 13 | struct pool *next; 14 | char region[]; 15 | } Pool; 16 | 17 | typedef struct { 18 | signature_t signature; 19 | count nregions, ncur; 20 | number neval; 21 | Totals totals[]; 22 | } State; 23 | 24 | static int Integrate(This *t, real *integral, real *error, real *prob) 25 | { 26 | StateDecl; 27 | csize_t statesize = sizeof(State) + NCOMP*sizeof(Totals); 28 | Sized(State, state, statesize); 29 | csize_t regionsize = RegionSize; 30 | csize_t poolsize = sizeof(Pool) + POOLSIZE*regionsize; 31 | Vector(Result, result, NCOMP); 32 | Vector(char, out, 128*NCOMP + 256); 33 | 34 | Totals *tot, *Tot = state->totals + t->ncomp; 35 | Result *res, *resL, *resR; 36 | Bounds *b, *B; 37 | Pool *cur = NULL, *pool; 38 | Region *region; 39 | count comp, ipool, npool; 40 | int fail; 41 | 42 | if( VERBOSE > 1 ) { 43 | sprintf(out, "Cuhre input parameters:\n" 44 | " ndim " COUNT "\n ncomp " COUNT "\n" 45 | ML_NOT(" nvec " NUMBER "\n") 46 | " epsrel " REAL "\n epsabs " REAL "\n" 47 | " flags %d\n mineval " NUMBER "\n maxeval " NUMBER "\n" 48 | " key " COUNT "\n" 49 | " statefile \"%s\"", 50 | t->ndim, t->ncomp, 51 | ML_NOT(t->nvec,) 52 | t->epsrel, t->epsabs, 53 | t->flags, t->mineval, t->maxeval, 54 | t->key, 55 | t->statefile); 56 | Print(out); 57 | } 58 | 59 | if( BadComponent(t) ) return -2; 60 | if( BadDimension(t) ) return -1; 61 | 62 | t->epsabs = Max(t->epsabs, NOTZERO); 63 | 64 | RuleAlloc(t); 65 | t->mineval = IMax(t->mineval, t->rule.n + 1); 66 | FrameAlloc(t, Master); 67 | ForkCores(t); 68 | 69 | if( (fail = setjmp(t->abort)) ) goto abort; 70 | 71 | StateSetup(t); 72 | 73 | if( StateReadTest(t) ) { 74 | StateReadOpen(t, fd) { 75 | Pool *prev = NULL; 76 | int size; 77 | if( read(fd, state, statesize) != statesize || 78 | state->signature != StateSignature(t, 4) ) break; 79 | t->neval = state->neval; 80 | t->nregions = state->nregions; 81 | do { 82 | MemAlloc(cur, poolsize); 83 | cur->next = prev; 84 | prev = cur; 85 | size = read(fd, cur, poolsize); 86 | } while( size == poolsize ); 87 | if( size != state->ncur*regionsize ) break; 88 | } StateReadClose(t, fd); 89 | } 90 | 91 | if( ini ) { 92 | MemAlloc(cur, poolsize); 93 | cur->next = NULL; 94 | state->ncur = t->nregions = 1; 95 | 96 | region = (Region *)cur->region; 97 | region->div = 0; 98 | for( B = (b = region->bounds) + t->ndim; b < B; ++b ) { 99 | b->lower = 0; 100 | b->upper = 1; 101 | } 102 | 103 | t->neval = 0; 104 | Sample(t, region); 105 | 106 | for( res = RegionResult(region), tot = state->totals; 107 | tot < Tot; ++res, ++tot ) { 108 | tot->avg = tot->lastavg = tot->guess = res->avg; 109 | tot->err = tot->lasterr = res->err; 110 | tot->weightsum = 1/Max(Sq(res->err), NOTZERO); 111 | tot->avgsum = tot->weightsum*res->avg; 112 | tot->chisq = tot->chisqsum = tot->chisum = 0; 113 | } 114 | } 115 | 116 | /* main iteration loop */ 117 | for( ; ; ) { 118 | count maxcomp, bisectdim; 119 | real maxratio, maxerr; 120 | Region *regionL, *regionR; 121 | Bounds *bL, *bR; 122 | 123 | if( VERBOSE ) { 124 | char *oe = out + sprintf(out, "\n" 125 | "Iteration " COUNT ": " NUMBER " integrand evaluations so far", 126 | t->nregions, t->neval); 127 | for( tot = state->totals, comp = 0; tot < Tot; ++tot ) 128 | oe += sprintf(oe, "\n[" COUNT "] " 129 | REAL " +- " REAL " \tchisq " REAL " (" COUNT " df)", 130 | ++comp, tot->avg, tot->err, tot->chisq, t->nregions - 1); 131 | Print(out); 132 | } 133 | 134 | maxratio = -INFTY; 135 | maxcomp = 0; 136 | for( tot = state->totals, comp = 0; tot < Tot; ++tot, ++comp ) { 137 | creal ratio = tot->err/MaxErr(tot->avg); 138 | if( ratio > maxratio ) { 139 | maxratio = ratio; 140 | maxcomp = comp; 141 | } 142 | } 143 | 144 | if( maxratio <= 1 && t->neval >= t->mineval ) break; 145 | 146 | if( t->neval >= t->maxeval ) { 147 | fail = 1; 148 | break; 149 | } 150 | 151 | maxerr = -INFTY; 152 | regionL = (Region *)cur->region; 153 | npool = state->ncur; 154 | for( pool = cur; pool; npool = POOLSIZE, pool = pool->next ) 155 | for( ipool = 0; ipool < npool; ++ipool ) { 156 | Region *region = RegionPtr(pool, ipool); 157 | creal err = RegionResult(region)[maxcomp].err; 158 | if( err > maxerr ) { 159 | maxerr = err; 160 | regionL = region; 161 | } 162 | } 163 | 164 | if( state->ncur == POOLSIZE ) { 165 | Pool *prev = cur; 166 | MemAlloc(cur, poolsize); 167 | cur->next = prev; 168 | state->ncur = 0; 169 | } 170 | regionR = RegionPtr(cur, state->ncur++); 171 | 172 | regionR->div = ++regionL->div; 173 | FCopy(result, RegionResult(regionL)); 174 | XCopy(regionR->bounds, regionL->bounds); 175 | 176 | bisectdim = result[maxcomp].bisectdim; 177 | bL = ®ionL->bounds[bisectdim]; 178 | bR = ®ionR->bounds[bisectdim]; 179 | bL->upper = bR->lower = .5*(bL->upper + bL->lower); 180 | 181 | Sample(t, regionL); 182 | Sample(t, regionR); 183 | 184 | for( res = result, 185 | resL = RegionResult(regionL), 186 | resR = RegionResult(regionR), 187 | tot = state->totals; 188 | tot < Tot; ++res, ++resL, ++resR, ++tot ) { 189 | real diff, err, w, avg, sigsq; 190 | 191 | tot->lastavg += diff = resL->avg + resR->avg - res->avg; 192 | 193 | diff = fabs(.25*diff); 194 | err = resL->err + resR->err; 195 | if( err > 0 ) { 196 | creal c = 1 + 2*diff/err; 197 | resL->err *= c; 198 | resR->err *= c; 199 | } 200 | resL->err += diff; 201 | resR->err += diff; 202 | tot->lasterr += resL->err + resR->err - res->err; 203 | 204 | tot->weightsum += w = 1/Max(Sq(tot->lasterr), NOTZERO); 205 | sigsq = 1/tot->weightsum; 206 | tot->avgsum += w*tot->lastavg; 207 | avg = sigsq*tot->avgsum; 208 | tot->chisum += w *= tot->lastavg - tot->guess; 209 | tot->chisqsum += w*tot->lastavg; 210 | tot->chisq = tot->chisqsum - avg*tot->chisum; 211 | 212 | if( LAST ) { 213 | tot->avg = tot->lastavg; 214 | tot->err = tot->lasterr; 215 | } 216 | else { 217 | tot->avg = avg; 218 | tot->err = sqrt(sigsq); 219 | } 220 | } 221 | ++t->nregions; 222 | 223 | if( StateWriteTest(t) ) { 224 | StateWriteOpen(t, fd) { 225 | Pool *prev = cur; 226 | state->signature = StateSignature(t, 4); 227 | state->nregions = t->nregions; 228 | state->neval = t->neval; 229 | StateWrite(fd, state, statesize); 230 | while( (prev = prev->next) ) StateWrite(fd, prev, poolsize); 231 | StateWrite(fd, cur, state->ncur*regionsize); 232 | } StateWriteClose(t, fd); 233 | } 234 | } 235 | 236 | for( tot = state->totals, comp = 0; tot < Tot; ++tot, ++comp ) { 237 | integral[comp] = tot->avg; 238 | error[comp] = tot->err; 239 | prob[comp] = ChiSquare(tot->chisq, t->nregions - 1); 240 | } 241 | 242 | #ifdef MLVERSION 243 | if( REGIONS ) { 244 | MLPutFunction(stdlink, "List", 2); 245 | MLPutFunction(stdlink, "List", t->nregions); 246 | 247 | npool = state->ncur; 248 | for( pool = cur; pool; npool = POOLSIZE, pool = pool->next ) 249 | for( ipool = 0; ipool < npool; ++ipool ) { 250 | Region const *region = RegionPtr(pool, ipool); 251 | Result *Res; 252 | 253 | MLPutFunction(stdlink, "Cuba`Cuhre`region", 2); 254 | MLPutRealList(stdlink, (real *)region->bounds, 2*t->ndim); 255 | 256 | MLPutFunction(stdlink, "List", t->ncomp); 257 | for( Res = (res = RegionResult(region)) + t->ncomp; 258 | res < Res; ++res ) { 259 | real r[] = {res->avg, res->err}; 260 | MLPutRealList(stdlink, r, Elements(r)); 261 | } 262 | } 263 | } 264 | #endif 265 | 266 | abort: 267 | while( (pool = cur) ) { 268 | cur = cur->next; 269 | free(pool); 270 | } 271 | FrameFree(t, Master); 272 | RuleFree(t); 273 | 274 | StateRemove(t); 275 | 276 | return fail; 277 | } 278 | 279 | -------------------------------------------------------------------------------- /src/divonne/Split.c: -------------------------------------------------------------------------------- 1 | /* 2 | Split.c 3 | determine optimal cuts for splitting a region 4 | this file is part of Divonne 5 | last modified 28 May 14 th 6 | */ 7 | 8 | 9 | #define BNDTOL .05 10 | #define FRACT .5 11 | #define SMALL 1e-10 12 | #define SINGTOL 1e-4 13 | 14 | #define LHSTOL .1 15 | #define GAMMATOL .1 16 | 17 | /* the next four macros must be in sync with the typedef of Bounds! */ 18 | #define Lower(d) (2*d) 19 | #define Upper(d) (2*d + 1) 20 | #define Dim(i) ((i) >> 1) 21 | #define SignedDelta(i) (2*(i & 1) - 1)*delta[i] 22 | 23 | typedef struct { 24 | count i; 25 | real save, delta; 26 | real f, df, fold; 27 | real lhs, row, sol; 28 | } Cut; 29 | 30 | /*********************************************************************/ 31 | 32 | static inline real Div(creal a, creal b) 33 | { 34 | return (b != 0 /*&& fabs(a) > SMALL*fabs(b)*/) ? a/b : a; 35 | } 36 | 37 | /*********************************************************************/ 38 | 39 | static void SomeCut(This *t, Cut *cut, Bounds *b) 40 | { 41 | Vector(real, xmid, NDIM); 42 | real ymid, maxdev; 43 | count dim, maxdim; 44 | static count nextdim = 0; 45 | 46 | for( dim = 0; dim < t->ndim; ++dim ) 47 | xmid[dim] = .5*(b[dim].upper + b[dim].lower); 48 | ymid = Sample(t, xmid); 49 | 50 | maxdev = 0; 51 | maxdim = 0; 52 | for( dim = 0; dim < t->ndim; ++dim ) { 53 | real ylower, yupper, dev; 54 | creal x = xmid[dim]; 55 | xmid[dim] = b[dim].lower; 56 | ylower = Sample(t, xmid); 57 | xmid[dim] = b[dim].upper; 58 | yupper = Sample(t, xmid); 59 | xmid[dim] = x; 60 | 61 | dev = fabs(ymid - .5*(ylower + yupper)); 62 | if( dev >= maxdev ) { 63 | maxdev = dev; 64 | maxdim = dim; 65 | } 66 | } 67 | 68 | if( maxdev > 0 ) nextdim = 0; 69 | else maxdim = nextdim++ % t->ndim; 70 | 71 | cut->i = Upper(maxdim); 72 | cut->save = b[maxdim].upper; 73 | b[maxdim].upper = xmid[maxdim]; 74 | } 75 | 76 | /*********************************************************************/ 77 | 78 | static inline real Volume(cThis *t, creal *delta) 79 | { 80 | real vol = 1; 81 | count dim; 82 | for( dim = 0; dim < t->ndim; ++dim ) 83 | vol *= delta[Lower(dim)] + delta[Upper(dim)]; 84 | return vol; 85 | } 86 | 87 | /*********************************************************************/ 88 | 89 | static inline real SetupEqs(Cut *cut, ccount ncuts, real f) 90 | { 91 | real sqsum = 0; 92 | Cut *c = &cut[ncuts]; 93 | while( --c >= cut ) { 94 | sqsum += Sq(c->lhs = f - c->f); 95 | f = c->f; 96 | } 97 | return sqsum; 98 | } 99 | 100 | /*********************************************************************/ 101 | 102 | static inline void SolveEqs(Cut *cut, count ncuts, 103 | creal *delta, creal diff) 104 | { 105 | real last = 0; 106 | real r = 1; 107 | Cut *c; 108 | 109 | for( c = cut; ; ++c ) { 110 | ccount dim = Dim(c->i); 111 | c->row = r -= 112 | Div(diff, (delta[Lower(dim)] + delta[Upper(dim)])*c->df); 113 | if( --ncuts == 0 ) break; 114 | last += r*c->lhs; 115 | } 116 | 117 | last = Div(c->lhs - last, r); 118 | 119 | for( ; c >= cut; last += (--c)->lhs ) { 120 | creal delmin = -(c->delta = delta[c->i]); 121 | creal delmax = FRACT*(delmin + c->save); 122 | c->sol = Div(last, c->df); 123 | if( c->sol > delmax ) c->sol = .75*delmax; 124 | if( c->sol < delmin ) c->sol = .75*delmin; 125 | } 126 | } 127 | 128 | /*********************************************************************/ 129 | 130 | static count FindCuts(This *t, Cut *cut, Bounds *bounds, creal vol, 131 | real *xmajor, creal fmajor, creal fdiff) 132 | { 133 | cint sign = (fdiff < 0) ? -1 : 1; 134 | 135 | count ncuts = 0, icut; 136 | Vector(real, delta, 2*NDIM); 137 | real gamma, fgamma, lhssq; 138 | count dim, div; 139 | 140 | for( dim = 0; dim < t->ndim; ++dim ) { 141 | cBounds *b = &bounds[dim]; 142 | creal xsave = xmajor[dim]; 143 | real dist = b->upper - xsave; 144 | if( dist >= BNDTOL*(b->upper - b->lower) ) { 145 | Cut *c = &cut[ncuts++]; 146 | c->i = Upper(dim); 147 | c->save = dist; 148 | xmajor[dim] += dist *= FRACT; 149 | c->f = Sample(t, xmajor); 150 | xmajor[dim] = xsave; 151 | } 152 | delta[Upper(dim)] = dist; 153 | } 154 | 155 | for( dim = 0; dim < t->ndim; ++dim ) { 156 | cBounds *b = &bounds[dim]; 157 | creal xsave = xmajor[dim]; 158 | real dist = xsave - b->lower; 159 | if( dist >= BNDTOL*(b->upper - b->lower) ) { 160 | Cut *c = &cut[ncuts++]; 161 | c->i = Lower(dim); 162 | c->save = dist; 163 | xmajor[dim] -= dist *= FRACT; 164 | c->f = Sample(t, xmajor); 165 | xmajor[dim] = xsave; 166 | } 167 | delta[Lower(dim)] = dist; 168 | } 169 | 170 | if( ncuts == 0 ) { 171 | SomeCut(t, cut, bounds); 172 | return 1; 173 | } 174 | 175 | for( ; ; ) { 176 | real mindiff = INFTY; 177 | Cut *mincut = cut; 178 | 179 | for( icut = 0; icut < ncuts; ++icut ) { 180 | Cut *c = &cut[icut]; 181 | creal diff = fabs(fmajor - c->f); 182 | if( diff <= mindiff ) { 183 | mindiff = diff; 184 | mincut = c; 185 | } 186 | } 187 | 188 | gamma = Volume(t, delta)/vol; 189 | fgamma = fmajor + (gamma - 1)*fdiff; 190 | 191 | if( sign*(mincut->f - fgamma) < 0 ) break; 192 | 193 | if( --ncuts == 0 ) { 194 | SomeCut(t, cut, bounds); 195 | return 1; 196 | } 197 | 198 | delta[mincut->i] = mincut->save; 199 | memmove(mincut, mincut + 1, (char *)&cut[ncuts] - (char *)mincut); 200 | } 201 | 202 | for( icut = 0; icut < ncuts; ++icut ) { 203 | Cut *c = &cut[icut]; 204 | c->fold = c->f; 205 | c->df = (c->f - fmajor)/delta[c->i]; 206 | } 207 | 208 | lhssq = SetupEqs(cut, ncuts, fgamma); 209 | 210 | repeat: 211 | SolveEqs(cut, ncuts, delta, gamma*fdiff); 212 | 213 | for( div = 1; div <= 16; div *= 4 ) { 214 | real gammanew, lhssqnew; 215 | 216 | for( icut = 0; icut < ncuts; ++icut ) { 217 | Cut *c = &cut[icut]; 218 | real *x = &xmajor[Dim(c->i)]; 219 | creal xsave = *x; 220 | delta[c->i] = c->delta + c->sol/div; 221 | *x += SignedDelta(c->i); 222 | c->f = Sample(t, xmajor); 223 | *x = xsave; 224 | } 225 | 226 | gammanew = Volume(t, delta)/vol; 227 | fgamma = fmajor + (gammanew - 1)*fdiff; 228 | lhssqnew = SetupEqs(cut, ncuts, fgamma); 229 | 230 | if( lhssqnew <= lhssq ) { 231 | real fmax; 232 | 233 | if( fabs(gammanew - gamma) < GAMMATOL*gamma ) break; 234 | gamma = gammanew; 235 | 236 | fmax = fabs(fgamma); 237 | for( icut = 0; icut < ncuts; ++icut ) { 238 | Cut *c = &cut[icut]; 239 | creal dfmin = SINGTOL*c->df; 240 | creal sol = c->sol/div; 241 | real df = c->f - c->fold; 242 | df = (fabs(df) > SMALL*fabs(sol)) ? df/sol : 1; 243 | c->df = (fabs(df) < fabs(dfmin)) ? dfmin : df; 244 | fmax = Max(fmax, fabs(c->f)); 245 | c->fold = c->f; 246 | } 247 | 248 | if( lhssqnew < Sq((1 + fmax)*LHSTOL) ) break; 249 | lhssq = lhssqnew; 250 | goto repeat; 251 | } 252 | } 253 | 254 | for( icut = 0; icut < ncuts; ++icut ) { 255 | Cut *c = &cut[icut]; 256 | real *b = (real *)bounds + c->i; 257 | c->save = *b; 258 | *b = xmajor[Dim(c->i)] + SignedDelta(c->i); 259 | } 260 | 261 | return ncuts; 262 | } 263 | 264 | /*********************************************************************/ 265 | 266 | static void Split(This *t, ccount iregion) 267 | { 268 | csize_t regionsize = RegionSize; 269 | Region *region = RegionPtr(iregion); 270 | Vector(Cut, cut, 2*NDIM); 271 | Cut *c; 272 | count ncuts, succ; 273 | int depth; 274 | real *b; 275 | 276 | t->selectedcomp = region->cutcomp; 277 | t->neval_cut -= t->neval; 278 | ncuts = FindCuts(t, cut, region->bounds, region->vol, 279 | RegionMinMax(region) + region->xmajor, region->fmajor, 280 | region->fmajor - region->fminor); 281 | t->neval_cut += t->neval; 282 | 283 | depth = region->depth - ncuts; 284 | 285 | EnlargeRegions(t, ++ncuts); 286 | region = RegionPtr(iregion); 287 | region->depth = -ncuts; 288 | succ = iregion + region->next; 289 | region->next = t->nregions - iregion; 290 | b = (real *)region->bounds; 291 | 292 | region = RegionPtr(t->nregions); 293 | XCopy(region->bounds, b); 294 | region->depth = IDim(depth) + 1; 295 | region->next = 1; 296 | region->isamples = 0; 297 | for( c = cut; --ncuts; ++c ) { 298 | ccount ci = c->i; 299 | creal tmp = b[ci ^ 1]; 300 | b[ci ^ 1] = b[ci]; 301 | b[ci] = c->save; 302 | region = RegionPtr(++t->nregions); 303 | XCopy(region->bounds, b); 304 | region->depth = IDim(depth) + 1; 305 | region->next = 1; 306 | region->isamples = 0; 307 | ++depth; 308 | b[ci ^ 1] = tmp; 309 | } 310 | region->next = succ - t->nregions++; 311 | } 312 | 313 | -------------------------------------------------------------------------------- /tools/print.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static const char * print_xpm[] = { 3 | "48 48 207 2", 4 | " c None", 5 | ". c #929292", 6 | "+ c #A0A0A0", 7 | "@ c #9E9E9E", 8 | "# c #9D9D9D", 9 | "$ c #9C9C9C", 10 | "% c #9B9B9B", 11 | "& c #9A9A9A", 12 | "* c #999999", 13 | "= c #DADADA", 14 | "- c #FFFFFF", 15 | "; c #FCFCFC", 16 | "> c #F9F9F9", 17 | ", c #F7F7F7", 18 | "' c #F4F4F4", 19 | ") c #EBEBEB", 20 | "! c #323232", 21 | "~ c #D7D7D7", 22 | "{ c #F1F1F1", 23 | "] c #EFEFEF", 24 | "^ c #ECECEC", 25 | "/ c #E3E3E3", 26 | "( c #313131", 27 | "_ c #FEFEFE", 28 | ": c #F6F6F6", 29 | "< c #EEEEEE", 30 | "[ c #E9E9E9", 31 | "} c #E1E1E1", 32 | "| c #333333", 33 | "1 c #D8D8D8", 34 | "2 c #F3F3F3", 35 | "3 c #E6E6E6", 36 | "4 c #DEDEDE", 37 | "5 c #E7E7E7", 38 | "6 c #E4E4E4", 39 | "7 c #DDDDDD", 40 | "8 c #343434", 41 | "9 c #DBDBDB", 42 | "0 c #363636", 43 | "a c #DCDCDC", 44 | "b c #373737", 45 | "c c #DFDFDF", 46 | "d c #393939", 47 | "e c #D9D9D9", 48 | "f c #D5D5D5", 49 | "g c #E0E0E0", 50 | "h c #D6D6D6", 51 | "i c #D3D3D3", 52 | "j c #3B3B3B", 53 | "k c #E2E2E2", 54 | "l c #D4D4D4", 55 | "m c #D1D1D1", 56 | "n c #3C3C3C", 57 | "o c #D0D0D0", 58 | "p c #CECECE", 59 | "q c #3E3E3E", 60 | "r c #CDCDCD", 61 | "s c #797979", 62 | "t c #F0F0F0", 63 | "u c #EDEDED", 64 | "v c #E8E8E8", 65 | "w c #E5E5E5", 66 | "x c #737373", 67 | "y c #6C6C6C", 68 | "z c #959595", 69 | "A c #C5C5C5", 70 | "B c #757575", 71 | "C c #8B8B8B", 72 | "D c #878787", 73 | "E c #858585", 74 | "F c #838383", 75 | "G c #828282", 76 | "H c #808080", 77 | "I c #7E7E7E", 78 | "J c #7D7D7D", 79 | "K c #7B7B7B", 80 | "L c #7A7A7A", 81 | "M c #777777", 82 | "N c #767676", 83 | "O c #747474", 84 | "P c #717171", 85 | "Q c #707070", 86 | "R c #6E6E6E", 87 | "S c #6D6D6D", 88 | "T c #6B6B6B", 89 | "U c #606060", 90 | "V c #D2D2D2", 91 | "W c #5E5E5E", 92 | "X c #5A5A5A", 93 | "Y c #5B5B5B", 94 | "Z c #595959", 95 | "` c #585858", 96 | " . c #565656", 97 | ".. c #555555", 98 | "+. c #545454", 99 | "@. c #535353", 100 | "#. c #515151", 101 | "$. c #4F4F4F", 102 | "%. c #4E4E4E", 103 | "&. c #4D4D4D", 104 | "*. c #494949", 105 | "=. c #8F8F8F", 106 | "-. c #FBFBFB", 107 | ";. c #EAEAEA", 108 | ">. c #B3B3B3", 109 | ",. c #FDFDFD", 110 | "'. c #FAFAFA", 111 | "). c #CCCCCC", 112 | "!. c #CACACA", 113 | "~. c #BDBDBD", 114 | "{. c #3A3A3A", 115 | "]. c #676767", 116 | "^. c #F8F8F8", 117 | "/. c #C4C4C4", 118 | "(. c #B0B0B0", 119 | "_. c #A1A1A1", 120 | ":. c #B8B8B8", 121 | "<. c #F8F6F8", 122 | "[. c #B5B5B5", 123 | "}. c #E9F2E9", 124 | "|. c #ACCEAC", 125 | "1. c #B9D3B9", 126 | "2. c #F5F7F5", 127 | "3. c #7C7C7C", 128 | "4. c #FDFAFD", 129 | "5. c #7CC57C", 130 | "6. c #5BD55B", 131 | "7. c #39C339", 132 | "8. c #FFFBFF", 133 | "9. c #76C776", 134 | "0. c #05BF05", 135 | "a. c #07B507", 136 | "b. c #8CCB8C", 137 | "c. c #4B4B4B", 138 | "d. c #F5F6F5", 139 | "e. c #B2D1B2", 140 | "f. c #CADFCA", 141 | "g. c #FCFAFC", 142 | "h. c #2E2E2E", 143 | "i. c #F9F8F9", 144 | "j. c #FFFCFF", 145 | "k. c #C0C0C0", 146 | "l. c #A6A6A6", 147 | "m. c #C2C2C2", 148 | "n. c #AAAAAA", 149 | "o. c #C3C3C3", 150 | "p. c #ABABAB", 151 | "q. c #A3A3A3", 152 | "r. c #CFCFCF", 153 | "s. c #C8C8C8", 154 | "t. c #C7C7C7", 155 | "u. c #C9C9C9", 156 | "v. c #909090", 157 | "w. c #8D8D8D", 158 | "x. c #8E8E8E", 159 | "y. c #626262", 160 | "z. c #A2A2A2", 161 | "A. c #BFBFBF", 162 | "B. c #000000", 163 | "C. c #464646", 164 | "D. c #B1B1B1", 165 | "E. c #BBBBBB", 166 | "F. c #252525", 167 | "G. c #3D3D3D", 168 | "H. c #010101", 169 | "I. c #727272", 170 | "J. c #BEBEBE", 171 | "K. c #292929", 172 | "L. c #BABABA", 173 | "M. c #B6B6B6", 174 | "N. c #030303", 175 | "O. c #888888", 176 | "P. c #C1C1C1", 177 | "Q. c #9F9F9F", 178 | "R. c #131313", 179 | "S. c #B7B7B7", 180 | "T. c #B9B9B9", 181 | "U. c #8C8C8C", 182 | "V. c #B4B4B4", 183 | "W. c #BCBCBC", 184 | "X. c #111111", 185 | "Y. c #303030", 186 | "Z. c #474747", 187 | "`. c #101010", 188 | " + c #505050", 189 | ".+ c #ACACAC", 190 | "++ c #AEAEAE", 191 | "@+ c #616161", 192 | "#+ c #8A8A8A", 193 | "$+ c #A5A5A5", 194 | "%+ c #F5F5F5", 195 | "&+ c #F2F2F2", 196 | "*+ c #272727", 197 | "=+ c #1B1B1B", 198 | "-+ c #454545", 199 | ";+ c #949494", 200 | ">+ c #121212", 201 | ",+ c #AFAFAF", 202 | "'+ c #979797", 203 | ")+ c #404040", 204 | "!+ c #787878", 205 | "~+ c #646464", 206 | "{+ c #5F5F5F", 207 | "]+ c #5D5D5D", 208 | "^+ c #5C5C5C", 209 | "/+ c #575757", 210 | "(+ c #434343", 211 | " . + @ @ @ @ @ @ @ @ @ @ @ # $ % & * * * * ", 212 | " = - - - - - - - - - - - - - - ; > , ' ' ) ! ", 213 | " ~ - - - - - - - - - - - ; > , ' { ] ^ ^ / ( ", 214 | " ~ - - - - - - - - - _ ; > : ' { < ^ [ [ } | ", 215 | " 1 - - - - - - - - _ ; > : 2 { < ) [ 3 3 4 | ", 216 | " = - - - - - - - - ; > , ' { ] ^ [ 5 6 6 7 8 ", 217 | " 9 - - - - - - _ ; > : ' { < ^ [ 3 6 } } 9 0 ", 218 | " a - - - - - _ ; > : 2 { < ) [ 3 / } 4 7 1 b ", 219 | " 4 - - - - - ; > , ' { ] ^ [ 5 6 } c a 9 ~ d ", 220 | " c - - - _ ; > : ' { < ^ [ 3 6 } 4 a e 1 f d ", 221 | " g - - _ ; > : 2 { < ) [ 3 / } 4 9 e h f i j ", 222 | " k - - ; > , ' { ] ^ [ 5 6 } c a e ~ l i m n ", 223 | " / - ; > : ' { < ^ [ 3 6 } 4 a e h l m o p q ", 224 | " / - > : 2 { < ) [ 3 / } 4 9 e h i m p r r b ", 225 | " s ) - - - _ ; > : ' t u ) v w / c a = ~ f m x y ", 226 | " z A d B C D E F G H I J K L s M N O x P Q R S T | F a U ", 227 | " V 6 W X X X X X X X Y Y Z ` ` ...+.@.#.#.$.%.&.*.=.c % ", 228 | " ) - - - - - - - - - - - - _ -., ' { < ;.5 6 g 7 9 i o >.( ", 229 | " #.2 - - - - - - - - - ,.'.: 2 t u [ 3 / g 7 = h i o ).!.~.{. ", 230 | " ].C ^.- - - - - - - - ; > : 2 t < ;.5 6 } 4 a 1 f V o ).!./.I .. ", 231 | " x (.i ] - - - - - - - - - - - _ _ _ _ _ ,.,.,.,.,.,.; ; ; ; -.-.; ,.] m _... ", 232 | " Q :.<.- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ' [.Z ", 233 | " 1 - }.|.1.2.- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - A ", 234 | " 3.,.4.5.6.7.5.- _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ - u Y ", 235 | " (._ 8.9.0.a.b.- ,.; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ,._ @ ", 236 | " c.9 '.-.d.e.f.g.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.'.,.9 h. ", 237 | " K ] , , i.j.8.^., , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ^.] X ", 238 | " _.{ { ' ' ' 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 ' ' ' 2 u F ", 239 | " :.;./ 5 u ] t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t ] u v 6 5 % ", 240 | " k.6 4 7 4 g / w v ;.) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ;.[ 3 / } c 4 4 6 l. ", 241 | " m.4 = = = = e e = 9 c g k k / 6 w w w w w w w w w w w w w w 6 / k k } c a = e e e = = = g n. ", 242 | " o.e f f f f f f f f l l f f f f h h ~ ~ 1 1 1 1 1 1 1 ~ h h f f f f l l f f f f f f f f a p. ", 243 | " ~.f m m m m m m m m m m m m m m m m m o o o o o o o o m m m m m m m m m m m m m m m m m h l. ", 244 | " [.m r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r ).m + ", 245 | " q.r.s.s.s.t.o h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h r t.s.s.u.).v. ", 246 | " w.!./././.u.x.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.y.z.u././.A u.O ", 247 | " ].m.k.A.A.!.&.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.B.N !.A.A.k.A C. ", 248 | " c.D.~.E.E.A @.B.B.B.B.F.G.j j j j j j j j j j j j j j {.{.{.{.{.{.n ( H.B.B.B.I./.E.E.J.p.K. ", 249 | " & L.M.M.k.$.B.B.B.N.O.= f l l l l l l l l f l i o p ).!.s.A m.P./.Q.R.B.B.B.].~.S.S.T.U. ", 250 | " U ~.M.V.W.Z X.X.X.Y.V 3 k k k k k k k k k k g 7 = e h i m p ).!.s.k.Z.`.X.X.].>.[.S.S. + ", 251 | " L n.:.T.W.A.~.:.n.; _ _ _ _ _ _ _ _ _ _ -.> : 2 { < ;.v w k g 7 4 Q..+A.J.++V.:.l.y ", 252 | " ! @+#+$+[.E.# J.- - - - - - - - - - ,.'.^.%+&+t ^ [ 5 6 } c a a m.z.L.V.z.E W *+ ", 253 | " =+-+S U.&+- - - - - - - - - ,.'., %+&+] ^ [ 3 6 } 4 a 1 h m ;+].q >+ ", 254 | " ,+- - - - - - - - - ; '., ' &+] ^ [ 3 / } 4 9 1 f V f '+ ", 255 | " [ - - - - - - - - _ '.^.%+&+t u [ 5 6 } c a e h i o m J.)+ ", 256 | " z.- - - - - - - - - - - _ -.^.%+&+] u ;.5 w } 4 a = ~ f 1 !+ ", 257 | " @.~+y.y.y.y.y.y.y.@+{+{+{+{+W ]+^+^+X X X Z Z ` ` /+..../+(+ ", 258 | " "}; 259 | -------------------------------------------------------------------------------- /src/vegas/Vegas.tm: -------------------------------------------------------------------------------- 1 | :Evaluate: BeginPackage["Cuba`"] 2 | 3 | :Evaluate: Vegas::usage = "Vegas[f, {x, xmin, xmax}..] computes a numerical approximation to the integral of the real scalar or vector function f. 4 | The output is a list with entries of the form {integral, error, chi-square probability} for each component of the integrand." 5 | 6 | :Evaluate: NStart::usage = "NStart is an option of Vegas. 7 | It specifies the number of integrand evaluations per iteration to start with." 8 | 9 | :Evaluate: NIncrease::usage = "NIncrease is an option of Vegas. 10 | It specifies the increase in the number of integrand evaluations per iteration." 11 | 12 | :Evaluate: NBatch::usage = "NBatch is an option of Vegas. 13 | It specifies how many points are sent in one MathLink packet to be sampled by Mathematica." 14 | 15 | :Evaluate: MinPoints::usage = "MinPoints is an option of Vegas. 16 | It specifies the minimum number of points to sample." 17 | 18 | :Evaluate: GridNo::usage = "GridNo is an option of Vegas. 19 | Vegas maintains an internal table in which it can memorize up to 10 grids, to be used in subsequent integrations. 20 | A GridNo between 1 and 10 selects the slot in this internal table. 21 | For other values the grid is initialized from scratch and discarded at the end of the integration." 22 | 23 | :Evaluate: StateFile::usage = "StateFile is an option of Vegas. 24 | It specifies a file in which the internal state is stored after each iteration and from which it can be restored on a subsequent run. 25 | The state file is removed once the prescribed accuracy has been reached." 26 | 27 | :Evaluate: Final::usage = "Final is an option of Vegas. 28 | It can take the values Last or All which determine whether only the last (largest) or all of the samples collected on a subregion over the iterations contribute to the final result." 29 | 30 | :Evaluate: PseudoRandom::usage = "PseudoRandom is an option of Vegas. 31 | It can take the following values: 32 | False for Sobol quasi-random numbers (default), 33 | True or 0 for Mersenne Twister pseudo-random numbers, 34 | any other integer value n for Ranlux pseudo-random numbers of luxury level n." 35 | 36 | :Evaluate: PseudoRandomSeed::usage = "PseudoRandomSeed is an option of Vegas. 37 | It specifies the seed for the pseudo-random number generator." 38 | 39 | :Evaluate: SharpEdges::usage = "SharpEdges is an option of Vegas. 40 | It turns off smoothing of the importance function for integrands with sharp edges." 41 | 42 | :Evaluate: RetainStateFile::usage = "RetainStateFile is an option of Vegas. 43 | It determines whether a chosen state file is kept even if the integration terminates normally." 44 | 45 | :Evaluate: $Weight::usage = "$Weight is a global variable set by Vegas during the evaluation of the integrand to the weight of the point being sampled." 46 | 47 | :Evaluate: $Iteration::usage = "$Iteration is a global variable set by Suave during the evaluation of the integrand to the present iteration number." 48 | 49 | :Evaluate: MapSample::usage = "MapSample is a function used to map the integrand over the points to be sampled." 50 | 51 | 52 | :Evaluate: Begin["`Vegas`"] 53 | 54 | :Begin: 55 | :Function: Vegas 56 | :Pattern: MLVegas[ndim_, ncomp_, 57 | epsrel_, epsabs_, flags_, seed_, 58 | mineval_, maxeval_, 59 | nstart_, nincrease_, nbatch_, 60 | gridno_, statefile_] 61 | :Arguments: {ndim, ncomp, 62 | epsrel, epsabs, flags, seed, 63 | mineval, maxeval, 64 | nstart, nincrease, nbatch, 65 | gridno, statefile} 66 | :ArgumentTypes: {Integer, Integer, 67 | Real, Real, Integer, Integer, 68 | Integer, Integer, 69 | Integer, Integer, Integer, 70 | Integer, String} 71 | :ReturnType: Manual 72 | :End: 73 | 74 | :Evaluate: Attributes[Vegas] = {HoldFirst} 75 | 76 | :Evaluate: Options[Vegas] = {PrecisionGoal -> 3, AccuracyGoal -> 12, 77 | MinPoints -> 0, MaxPoints -> 50000, 78 | NStart -> 1000, NIncrease -> 500, 79 | NBatch -> 1000, GridNo -> 0, StateFile -> "", 80 | Verbose -> 1, Final -> All, 81 | PseudoRandom -> False, PseudoRandomSeed -> 5489, 82 | SharpEdges -> False, RetainStateFile -> False, 83 | Compiled -> True} 84 | 85 | :Evaluate: Vegas[f_, v:{_, _, _}.., opt___Rule] := 86 | Block[ {ff = HoldForm[f], ndim = Length[{v}], ncomp, 87 | tags, vars, lower, range, jac, tmp, defs, intT, 88 | rel, abs, mineval, maxeval, nstart, nincrease, nbatch, 89 | gridno, state, verbose, final, level, seed, edges, retain, 90 | compiled, $Weight, $Iteration}, 91 | Message[Vegas::optx, #, Vegas]&/@ 92 | Complement[First/@ {opt}, tags = First/@ Options[Vegas]]; 93 | {rel, abs, mineval, maxeval, nstart, nincrease, nbatch, 94 | gridno, state, verbose, final, level, seed, edges, retain, 95 | compiled} = tags /. {opt} /. Options[Vegas]; 96 | {vars, lower, range} = Transpose[{v}]; 97 | jac = Simplify[Times@@ (range -= lower)]; 98 | tmp = Array[tmpvar, ndim]; 99 | defs = Simplify[lower + range tmp]; 100 | Block[{Set}, define[compiled, tmp, Thread[vars = defs], jac]]; 101 | intT = integrandT[f]; 102 | Block[#, 103 | ncomp = Length[intT@@ RandomReal[1, ndim]]; 104 | MLVegas[ndim, ncomp, 10.^-rel, 10.^-abs, 105 | Min[Max[verbose, 0], 3] + 106 | If[final === Last, 4, 0] + 107 | If[TrueQ[edges], 8, 0] + 108 | If[TrueQ[retain], 16, 0] + 109 | If[IntegerQ[level], 256 level, 0], 110 | If[level =!= False && IntegerQ[seed], seed, 0], 111 | mineval, maxeval, 112 | nstart, nincrease, nbatch, 113 | gridno, state] 114 | ]& @ vars 115 | ] 116 | 117 | :Evaluate: tmpvar[n_] := ToExpression["Cuba`Vegas`t" <> ToString[n]] 118 | 119 | :Evaluate: Attributes[foo] = {HoldAll} 120 | 121 | :Evaluate: define[True, tmp_, defs_, jac_] := 122 | integrandT[f_] := Compile[tmp, eval[defs, N[f jac]], 123 | {{_eval, _Real, 1}}] 124 | 125 | :Evaluate: define[_, tmp_, defs_, jac_] := 126 | integrandT[f_] := Function[tmp, eval[defs, N[f jac]]] 127 | 128 | :Evaluate: eval[_, f_Real] = {f} 129 | 130 | :Evaluate: eval[_, f:{__Real}] = f 131 | 132 | :Evaluate: eval[x_, _] := (Message[Vegas::badsample, ff, x]; {}) 133 | 134 | :Evaluate: sample[x_, w_, iter_] := ( 135 | $Iteration = iter; 136 | Check[Flatten @ MapSample[ 137 | ($Weight = #[[1]]; intT@@ #[[2]])&, 138 | Transpose[{w, Partition[x, ndim]}] ], {}] ) 139 | 140 | :Evaluate: ValueQ[MapSample] || (MapSample = Map) 141 | 142 | :Evaluate: Vegas::badsample = "`` is not a real-valued function at ``." 143 | 144 | :Evaluate: Vegas::baddim = "Cannot integrate in `` dimensions." 145 | 146 | :Evaluate: Vegas::badcomp = "Cannot integrate `` components." 147 | 148 | :Evaluate: Vegas::accuracy = 149 | "Desired accuracy was not reached within `` function evaluations." 150 | 151 | :Evaluate: Vegas::success = "Needed `` function evaluations." 152 | 153 | :Evaluate: End[] 154 | 155 | :Evaluate: EndPackage[] 156 | 157 | 158 | /* 159 | Vegas.tm 160 | Vegas Monte Carlo integration 161 | by Thomas Hahn 162 | last modified 27 Aug 14 th 163 | */ 164 | 165 | 166 | #define VEGAS 167 | #define ROUTINE "Vegas" 168 | 169 | #include "mathlink.h" 170 | #include "decl.h" 171 | #include "MSample.c" 172 | 173 | /*********************************************************************/ 174 | 175 | static void Status(MLCONST char *msg, cint n) 176 | { 177 | MLPutFunction(stdlink, "CompoundExpression", 2); 178 | MLPutFunction(stdlink, "Message", 2); 179 | MLPutFunction(stdlink, "MessageName", 2); 180 | MLPutSymbol(stdlink, "Vegas"); 181 | MLPutString(stdlink, msg); 182 | MLPutInteger(stdlink, n); 183 | } 184 | 185 | /*********************************************************************/ 186 | 187 | static inline void DoIntegrate(This *t) 188 | { 189 | real integral[NCOMP], error[NCOMP], prob[NCOMP]; 190 | cint fail = Integrate(t, integral, error, prob); 191 | 192 | if( fail < 0 ) { 193 | switch( fail ) { 194 | case -99: 195 | MLPutFunction(stdlink, "Abort", 0); 196 | return; 197 | case -1: 198 | Status("baddim", t->ndim); 199 | break; 200 | case -2: 201 | Status("badcomp", t->ncomp); 202 | break; 203 | } 204 | MLPutSymbol(stdlink, "$Failed"); 205 | } 206 | else { 207 | Status(fail ? "accuracy" : "success", t->neval); 208 | MLPutFunction(stdlink, "Thread", 1); 209 | MLPutFunction(stdlink, "List", 3); 210 | MLPutRealList(stdlink, integral, t->ncomp); 211 | MLPutRealList(stdlink, error, t->ncomp); 212 | MLPutRealList(stdlink, prob, t->ncomp); 213 | } 214 | } 215 | 216 | /*********************************************************************/ 217 | 218 | void Vegas(cint ndim, cint ncomp, 219 | creal epsrel, creal epsabs, 220 | cint flags, cint seed, 221 | cnumber mineval, cnumber maxeval, 222 | cnumber nstart, cnumber nincrease, cint nbatch, 223 | cint gridno, cchar *statefile) 224 | { 225 | This t; 226 | t.ndim = ndim; 227 | t.ncomp = ncomp; 228 | t.epsrel = epsrel; 229 | t.epsabs = epsabs; 230 | t.flags = flags; 231 | t.seed = seed; 232 | t.mineval = mineval; 233 | t.maxeval = maxeval; 234 | t.nstart = nstart; 235 | t.nincrease = nincrease; 236 | t.nbatch = nbatch; 237 | t.gridno = gridno; 238 | t.statefile = statefile; 239 | 240 | DoIntegrate(&t); 241 | MLEndPacket(stdlink); 242 | } 243 | 244 | /*********************************************************************/ 245 | 246 | int main(int argc, char **argv) 247 | { 248 | return MLMain(argc, argv); 249 | } 250 | 251 | -------------------------------------------------------------------------------- /src/common/DoSample.c: -------------------------------------------------------------------------------- 1 | /* 2 | DoSample.c 3 | the actual sampling routine, serial and parallel, 4 | for the C versions of the Cuba routines 5 | by Thomas Hahn 6 | last modified 24 Nov 11 th 7 | */ 8 | 9 | #define MINSLICE 10 10 | #define MINCORES 1 11 | //#define MINCORES 2 12 | 13 | #if defined(VEGAS) || defined(SUAVE) 14 | #define VEG_ONLY(...) __VA_ARGS__ 15 | #else 16 | #define VEG_ONLY(...) 17 | #endif 18 | 19 | #ifdef DIVONNE 20 | #define DIV_ONLY(...) __VA_ARGS__ 21 | #define LDX(ldx) ldx 22 | #else 23 | #define DIV_ONLY(...) 24 | #define LDX(ldx) t->ndim 25 | #endif 26 | 27 | typedef struct { 28 | real *f; 29 | number n; 30 | VEG_ONLY(count iter;) 31 | DIV_ONLY(number neval_opt, neval_cut; 32 | count ldx, phase, iregion;) 33 | #define NREGIONS ldx 34 | #define NEVAL n 35 | #define RETVAL phase 36 | } Slice; 37 | 38 | /*********************************************************************/ 39 | 40 | #ifndef MSG_WAITALL 41 | /* Windows */ 42 | #define MSG_WAITALL 0 43 | #endif 44 | 45 | static inline int readsock(int fd, void *data, size_t n) 46 | { 47 | ssize_t got; 48 | size_t remain = n; 49 | do got = recv(fd, data, remain, MSG_WAITALL); 50 | while( got > 0 && (data += got, remain -= got) > 0 ); 51 | return got; 52 | } 53 | 54 | static inline int writesock(int fd, const void *data, size_t n) 55 | { 56 | ssize_t got; 57 | size_t remain = n; 58 | do got = send(fd, data, remain, MSG_WAITALL); 59 | while( got > 0 && (data += got, remain -= got) > 0 ); 60 | return got; 61 | } 62 | 63 | /*********************************************************************/ 64 | 65 | static inline bool SampleSerial(cThis *t, number n, creal *x, real *f 66 | VEG_ONLY(, creal *w, ccount iter) 67 | DIV_ONLY(, ccount ldx)) 68 | { 69 | while( n-- ) { 70 | if( t->integrand(&t->ndim, x, &t->ncomp, f, t->userdata 71 | VEG_ONLY(, w++, &iter) 72 | DIV_ONLY(, &t->phase)) == ABORT ) return true; 73 | x += LDX(ldx); 74 | f += t->ncomp; 75 | } 76 | return false; 77 | } 78 | 79 | /*********************************************************************/ 80 | 81 | static void DoSample(This *t, number n, creal *x, real *f 82 | VEG_ONLY(, creal *w, ccount iter) 83 | DIV_ONLY(, ccount ldx)) 84 | { 85 | char s[128]; 86 | Slice slice; 87 | int ncores; 88 | 89 | t->neval += n; 90 | 91 | ncores = IMin(t->ncores, n/MINSLICE); 92 | 93 | if( ncores < MINCORES ) { 94 | if( VERBOSE > 2 ) { 95 | sprintf(s, "sampling " NUMBER " points serially", n); 96 | Print(s); 97 | } 98 | 99 | if( SampleSerial(t, n, x, f 100 | VEG_ONLY(, w, iter) 101 | DIV_ONLY(, ldx)) ) longjmp(t->abort, -99); 102 | } 103 | else { 104 | int core, abort; 105 | 106 | slice.n = (n + ncores - 1)/ncores; 107 | 108 | if( VERBOSE > 2 ) { 109 | sprintf(s, "sampling " NUMBER " points each on %d cores", 110 | slice.n, ncores); 111 | Print(s); 112 | } 113 | 114 | slice.f = f; 115 | VEG_ONLY(slice.iter = iter;) 116 | DIV_ONLY(slice.ldx = ldx;) 117 | DIV_ONLY(slice.phase = t->phase;) 118 | 119 | for( core = 0; core < ncores; ++core ) { 120 | cint fd = t->child[core]; 121 | writesock(fd, &slice, sizeof slice); 122 | VEG_ONLY(writesock(fd, w, slice.n*sizeof *w);) 123 | writesock(fd, x, slice.n*LDX(ldx)*sizeof *x); 124 | 125 | VEG_ONLY(w += n;) 126 | x += slice.n*LDX(ldx); 127 | slice.f += slice.n*t->ncomp; 128 | n -= slice.n; 129 | slice.n = IMin(slice.n, n); 130 | } 131 | 132 | abort = 0; 133 | for( core = ncores; --core >= 0; ) { 134 | cint fd = t->child[core]; 135 | readsock(fd, &slice, sizeof slice); 136 | if( slice.n == 0 ) abort = 1; 137 | else readsock(fd, slice.f, slice.n*t->ncomp*sizeof *f); 138 | } 139 | if( abort ) longjmp(t->abort, -99); 140 | } 141 | } 142 | 143 | /*********************************************************************/ 144 | 145 | #ifdef DIVONNE 146 | static inline int ReadyCore(cThis *t) 147 | { 148 | int core; 149 | fd_set ready; 150 | 151 | memcpy(&ready, &t->children, sizeof ready); 152 | select(t->nchildren, &ready, NULL, NULL, NULL); 153 | 154 | for( core = 0; core < t->ncores; ++core ) 155 | if( FD_ISSET(t->child[core], &ready) ) break; 156 | 157 | return core; 158 | } 159 | 160 | /*********************************************************************/ 161 | 162 | static int ExploreParent(This *t, cint iregion) 163 | { 164 | TYPEDEFREGION; 165 | Region *region; 166 | Slice slice; 167 | int ireg = iregion, core = t->running; 168 | 169 | if( t->ncores < MINCORES ) return Explore(t, iregion); 170 | 171 | if( t->running >= ((iregion < 0) ? 1 : t->ncores) ) { 172 | Totals totals[t->ncomp]; 173 | count comp, succ; 174 | cint fd = t->child[core = ReadyCore(t)]; 175 | 176 | --t->running; 177 | readsock(fd, &slice, sizeof slice); 178 | //DEBSLICE("parent read", fd, slice); 179 | ireg = slice.iregion; 180 | region = RegionPtr(ireg); 181 | succ = ireg + region->next; 182 | readsock(fd, region, sizeof(Region)); 183 | if( --slice.NREGIONS > 0 ) { 184 | region->next = t->nregions - ireg; 185 | EnlargeRegions(t, slice.NREGIONS); 186 | readsock(fd, RegionPtr(t->nregions), slice.NREGIONS*sizeof(Region)); 187 | t->nregions += slice.NREGIONS; 188 | RegionPtr(t->nregions-1)->next = succ - t->nregions + 1; 189 | } 190 | 191 | readsock(fd, totals, sizeof totals); 192 | for( comp = 0; comp < t->ncomp; ++comp ) 193 | t->totals[comp].secondspread = 194 | Max(t->totals[comp].secondspread, totals[comp].secondspread); 195 | 196 | t->neval += slice.NEVAL; 197 | t->neval_opt += slice.neval_opt; 198 | t->neval_cut += slice.neval_cut; 199 | 200 | if( slice.RETVAL == -1 ) return -1; 201 | } 202 | 203 | if( iregion >= 0 ) { 204 | region = RegionPtr(iregion); 205 | cint fd = t->child[core]; 206 | slice.n = 0; 207 | slice.phase = t->phase; 208 | slice.iregion = iregion; 209 | //DEBSLICE(" parent write", fd, slice); 210 | writesock(fd, &slice, sizeof slice); 211 | writesock(fd, &t->samples[region->isamples], sizeof(Samples)); 212 | writesock(fd, region, sizeof *region); 213 | writesock(fd, t->totals, sizeof *t->totals); 214 | region->depth = 0; 215 | ++t->running; 216 | } 217 | 218 | return ireg; 219 | } 220 | #endif 221 | 222 | /*********************************************************************/ 223 | 224 | static inline void DoChild(This *t, cint fd) 225 | { 226 | Slice slice; 227 | 228 | #ifdef DIVONNE 229 | TYPEDEFREGION; 230 | Totals totals[t->ncomp]; 231 | 232 | t->totals = totals; 233 | t->ncores = 0; /* no recursive forks */ 234 | AllocRegions(t); 235 | SamplesIni(&t->samples[0]); 236 | t->samples[0].n = 0; 237 | SamplesIni(&t->samples[1]); 238 | t->samples[1].n = 0; 239 | SamplesIni(&t->samples[2]); 240 | t->samples[2].n = 0; 241 | #endif 242 | 243 | while( readsock(fd, &slice, sizeof slice) ) { 244 | number n = slice.n; 245 | DIV_ONLY(t->phase = slice.phase;) 246 | //DEBSLICE(" child read", fd, slice); 247 | if( n > 0 ) { 248 | VEG_ONLY(real w[n];) 249 | real x[n*LDX(slice.ldx)]; 250 | real f[n*t->ncomp]; 251 | 252 | VEG_ONLY(readsock(fd, w, sizeof w);) 253 | readsock(fd, x, sizeof x); 254 | 255 | if( SampleSerial(t, n, x, f 256 | VEG_ONLY(, w, slice.iter) 257 | DIV_ONLY(, slice.ldx)) ) slice.n = 0; 258 | writesock(fd, &slice, sizeof slice); 259 | if( slice.n ) writesock(fd, f, sizeof f); 260 | } 261 | #ifdef DIVONNE 262 | else { 263 | Samples *samples, psamples; 264 | 265 | readsock(fd, &psamples, sizeof psamples); 266 | readsock(fd, RegionPtr(0), sizeof(Region)); 267 | readsock(fd, totals, sizeof totals); 268 | t->nregions = 1; 269 | t->neval = t->neval_opt = t->neval_cut = 0; 270 | 271 | samples = &t->samples[RegionPtr(0)->isamples]; 272 | if( psamples.n != samples->n ) { 273 | SamplesFree(samples); 274 | *samples = psamples; 275 | SamplesAlloc(t, samples); 276 | } 277 | 278 | slice.RETVAL = Explore(t, 0); 279 | slice.NREGIONS = t->nregions; 280 | slice.NEVAL = t->neval; 281 | slice.neval_opt = t->neval_opt; 282 | slice.neval_cut = t->neval_cut; 283 | //DEBSLICE("child write", fd, slice); 284 | writesock(fd, &slice, sizeof slice); 285 | writesock(fd, RegionPtr(0), t->nregions*sizeof(Region)); 286 | writesock(fd, totals, sizeof totals); 287 | } 288 | #endif 289 | } 290 | 291 | exit(0); 292 | } 293 | 294 | /*********************************************************************/ 295 | 296 | static inline void ForkCores(This *t) 297 | { 298 | int core; 299 | cchar *env = getenv("CUBACORES"); 300 | 301 | t->ncores = env ? atoi(env) : sysconf(_SC_NPROCESSORS_ONLN); 302 | #ifdef HAVE_GETLOADAVG 303 | if( env == NULL || t->ncores < 0 ) { 304 | double load = 0; 305 | getloadavg(&load, 1); 306 | t->ncores = abs(t->ncores) - floor(load); 307 | } 308 | #endif 309 | 310 | #ifdef DIVONNE 311 | t->nchildren = t->running = 0; 312 | #endif 313 | 314 | if( t->ncores < MINCORES ) return; 315 | if( VERBOSE ) printf("using %d cores\n", t->ncores); 316 | fflush(stdout); 317 | 318 | Alloc(t->child, t->ncores); 319 | for( core = 0; core < t->ncores; ++core ) { 320 | int fd[2]; 321 | pid_t pid; 322 | assert( 323 | socketpair(AF_LOCAL, SOCK_STREAM, 0, fd) != -1 && 324 | (pid = fork()) != -1 ); 325 | if( pid == 0 ) { 326 | close(fd[0]); 327 | DoChild(t, fd[1]); 328 | } 329 | close(fd[1]); 330 | t->child[core] = fd[0]; 331 | #ifdef DIVONNE 332 | FD_SET(fd[0], &t->children); 333 | t->nchildren = IMax(t->nchildren, fd[0] + 1); 334 | #endif 335 | } 336 | } 337 | 338 | /*********************************************************************/ 339 | 340 | static inline void WaitCores(cThis *t) 341 | { 342 | if( t->ncores >= MINCORES ) { 343 | int core; 344 | pid_t pid; 345 | for( core = 0; core < t->ncores; ++core ) 346 | close(t->child[core]); 347 | free(t->child); 348 | for( core = 0; core < t->ncores; ++core ) 349 | wait(&pid); 350 | } 351 | } 352 | 353 | -------------------------------------------------------------------------------- /src/suave/Suave.tm: -------------------------------------------------------------------------------- 1 | :Evaluate: BeginPackage["Cuba`"] 2 | 3 | :Evaluate: Suave::usage = 4 | "Suave[f, {x, xmin, xmax}..] computes a numerical approximation to the integral of the real scalar or vector function f. 5 | The output is a list with entries of the form {integral, error, chi-square probability} for each component of the integrand." 6 | 7 | :Evaluate: MinPoints::usage = "MinPoints is an option of Suave. 8 | It specifies the minimum number of points to sample." 9 | 10 | :Evaluate: NNew::usage = "NNew is an option of Suave. 11 | It specifies the number of new integrand evaluations in each subdivision." 12 | 13 | :Evaluate: NMin::usage = "NMin is an option of Suave. 14 | It specifies the minimum number of samples a former pass must contribute to a subregion to be considered in that region's compound integral value. 15 | Increasing NMin may reduce jumps in the chi^2 value." 16 | 17 | :Evaluate: Flatness::usage = "Flatness is an option of Suave. 18 | It determines how prominently individual samples with a large fluctuation figure in the total fluctuation, which in turn determines how a region is split up. 19 | Explicitly, if F[i] is the individual fluctuation of sample i, the total fluctuation is computed as Sum[(1 + F[i])^p, {i, nsamples}]^(2/3/p), i.e. as the p-norm of the fluctuation vector to the power 2/3, where p is the number given by Flatness. 20 | Thus with increasing p, the fluctuation becomes more and more dominated by outliers, i.e. points with a large fluctuation. 21 | As suggested by the name Flatness, p should be chosen large for `flat' integrands and small for `volatile' integrands with high peaks. 22 | Note that since p appears in the exponent, one should not use too large values (say, no more than a few hundred) lest terms be truncated internally to prevent overflow." 23 | 24 | :Evaluate: StateFile::usage = "StateFile is an option of Suave. 25 | It specifies a file in which the internal state is stored after each iteration and from which it can be restored on a subsequent run. 26 | The state file is removed once the prescribed accuracy has been reached." 27 | 28 | :Evaluate: Final::usage = "Final is an option of Suave. 29 | It can take the values Last or All which determine whether only the last (largest) or all sets of samples collected on a subregion over the iterations contribute to the final result." 30 | 31 | :Evaluate: PseudoRandom::usage = "PseudoRandom is an option of Suave. 32 | It can take the following values: 33 | False for Sobol quasi-random numbers (default), 34 | True or 0 for Mersenne Twister pseudo-random numbers, 35 | any other integer value n for Ranlux pseudo-random numbers of luxury level n." 36 | 37 | :Evaluate: PseudoRandomSeed::usage = "PseudoRandomSeed is an option of Suave. 38 | It specifies the seed for the pseudo-random number generator." 39 | 40 | :Evaluate: SharpEdges::usage = "SharpEdges is an option of Suave. 41 | It turns off smoothing of the importance function for integrands with sharp edges." 42 | 43 | :Evaluate: RetainStateFile::usage = "RetainStateFile is an option of Suave. 44 | It determines whether a chosen state file is kept even if the integration terminates normally." 45 | 46 | :Evaluate: Regions::usage = "Regions is an option of Suave. 47 | It specifies whether the regions into which the integration region has been cut are returned together with the integration results." 48 | 49 | :Evaluate: Region::usage = "Region[ll, ur, res, df] describes a subregion: 50 | ll and ur are multidimensional equivalents of the region's lower left and upper right corner. 51 | res gives the integration results for the region in a list with entries of the form {integral, error, chi-square} for each component of the integrand. 52 | df is the number of degrees of freedom corresponding to the chi-square values in res." 53 | 54 | :Evaluate: $Weight::usage = "$Weight is a global variable set by Suave during the evaluation of the integrand to the weight of the point being sampled." 55 | 56 | :Evaluate: $Iteration::usage = "$Iteration is a global variable set by Suave during the evaluation of the integrand to the present iteration number." 57 | 58 | :Evaluate: MapSample::usage = "MapSample is a function used to map the integrand over the points to be sampled." 59 | 60 | 61 | :Evaluate: Begin["`Suave`"] 62 | 63 | :Begin: 64 | :Function: Suave 65 | :Pattern: MLSuave[ndim_, ncomp_, 66 | epsrel_, epsabs_, flags_, seed_, 67 | mineval_, maxeval_, 68 | nnew_, flatness_, statefile_] 69 | :Arguments: {ndim, ncomp, 70 | epsrel, epsabs, flags, seed, 71 | mineval, maxeval, 72 | nnew, flatness, statefile} 73 | :ArgumentTypes: {Integer, Integer, 74 | Real, Real, Integer, Integer, 75 | Integer, Integer, 76 | Integer, Real, String} 77 | :ReturnType: Manual 78 | :End: 79 | 80 | :Evaluate: Attributes[Suave] = {HoldFirst} 81 | 82 | :Evaluate: Options[Suave] = {PrecisionGoal -> 3, AccuracyGoal -> 12, 83 | MinPoints -> 0, MaxPoints -> 50000, 84 | NNew -> 1000, NMin -> 2, Flatness -> 50, 85 | StateFile -> "", Verbose -> 1, Final -> Last, 86 | PseudoRandom -> False, PseudoRandomSeed -> 5489, 87 | SharpEdges -> False, RetainStateFile -> False, 88 | Regions -> False, Compiled -> True} 89 | 90 | :Evaluate: Suave[f_, v:{_, _, _}.., opt___Rule] := 91 | Block[ {ff = HoldForm[f], ndim = Length[{v}], ncomp, 92 | tags, vars, lower, range, jac, tmp, defs, intT, 93 | rel, abs, mineval, maxeval, nnew, nmin, flatness, state, 94 | verbose, final, level, seed, edges, retain, 95 | regions, compiled, $Weight, $Iteration}, 96 | Message[Suave::optx, #, Suave]&/@ 97 | Complement[First/@ {opt}, tags = First/@ Options[Suave]]; 98 | {rel, abs, mineval, maxeval, nnew, nmin, flatness, state, 99 | verbose, final, level, seed, edges, retain, 100 | regions, compiled} = 101 | tags /. {opt} /. Options[Suave]; 102 | {vars, lower, range} = Transpose[{v}]; 103 | jac = Simplify[Times@@ (range -= lower)]; 104 | tmp = Array[tmpvar, ndim]; 105 | defs = Simplify[lower + range tmp]; 106 | Block[{Set}, define[compiled, tmp, Thread[vars = defs], jac]]; 107 | intT = integrandT[f]; 108 | Block[#, 109 | ncomp = Length[intT@@ RandomReal[1, ndim]]; 110 | MLSuave[ndim, ncomp, 10.^-rel, 10.^-abs, 111 | Min[Max[verbose, 0], 3] + 112 | If[final === Last, 4, 0] + 113 | If[TrueQ[edges], 8, 0] + 114 | If[TrueQ[retain], 16, 0] + 115 | If[TrueQ[regions], 128, 0] + 116 | If[IntegerQ[level], 256 level, 0], 117 | If[level =!= False && IntegerQ[seed], seed, 0], 118 | mineval, maxeval, 119 | nnew, nmin, flatness, state] 120 | ]& @ vars 121 | ] 122 | 123 | :Evaluate: tmpvar[n_] := ToExpression["Cuba`Suave`t" <> ToString[n]] 124 | 125 | :Evaluate: Attributes[foo] = {HoldAll} 126 | 127 | :Evaluate: define[True, tmp_, defs_, jac_] := ( 128 | TtoX := TtoX = Compile[tmp, defs]; 129 | integrandT[f_] := Compile[tmp, eval[defs, N[f jac]], 130 | {{_eval, _Real, 1}}] ) 131 | 132 | :Evaluate: define[_, tmp_, defs_, jac_] := ( 133 | TtoX := TtoX = Function[tmp, defs]; 134 | integrandT[f_] := Function[tmp, eval[defs, N[f jac]]] ) 135 | 136 | :Evaluate: eval[_, f_Real] = {f} 137 | 138 | :Evaluate: eval[_, f:{__Real}] = f 139 | 140 | :Evaluate: eval[x_, _] := (Message[Suave::badsample, ff, x]; {}) 141 | 142 | :Evaluate: sample[x_, w_, iter_] := ( 143 | $Iteration = iter; 144 | Check[Flatten @ MapSample[ 145 | ($Weight = #[[1]]; intT@@ #[[2]])&, 146 | Transpose[{w, Partition[x, ndim]}] ], {}] ) 147 | 148 | :Evaluate: ValueQ[MapSample] || (MapSample = Map) 149 | 150 | :Evaluate: region[bounds_, r___] := Region[##, r]&@@ 151 | MapThread[TtoX, Partition[bounds, 2]] 152 | 153 | :Evaluate: Suave::badsample = "`` is not a real-valued function at ``." 154 | 155 | :Evaluate: Suave::baddim = "Cannot integrate in `` dimensions." 156 | 157 | :Evaluate: Suave::badcomp = "Cannot integrate `` components." 158 | 159 | :Evaluate: Suave::accuracy = 160 | "Desired accuracy was not reached within `` function evaluations on `` subregions." 161 | 162 | :Evaluate: Suave::success = "Needed `` function evaluations on `` subregions." 163 | 164 | :Evaluate: End[] 165 | 166 | :Evaluate: EndPackage[] 167 | 168 | 169 | /* 170 | Suave.tm 171 | Subregion-adaptive Vegas Monte Carlo integration 172 | by Thomas Hahn 173 | last modified 28 Nov 14 th 174 | */ 175 | 176 | 177 | #define SUAVE 178 | #define ROUTINE "Suave" 179 | 180 | #include "mathlink.h" 181 | #include "decl.h" 182 | #include "MSample.c" 183 | 184 | /*********************************************************************/ 185 | 186 | static void Status(MLCONST char *msg, cint n1, cint n2) 187 | { 188 | MLPutFunction(stdlink, "CompoundExpression", 2); 189 | MLPutFunction(stdlink, "Message", 3); 190 | MLPutFunction(stdlink, "MessageName", 2); 191 | MLPutSymbol(stdlink, "Suave"); 192 | MLPutString(stdlink, msg); 193 | MLPutInteger(stdlink, n1); 194 | MLPutInteger(stdlink, n2); 195 | } 196 | 197 | /*********************************************************************/ 198 | 199 | static inline void DoIntegrate(This *t) 200 | { 201 | real integral[NCOMP], error[NCOMP], prob[NCOMP]; 202 | cint fail = Integrate(t, integral, error, prob); 203 | 204 | if( fail < 0 ) { 205 | switch( fail ) { 206 | case -99: 207 | MLPutFunction(stdlink, "Abort", 0); 208 | return; 209 | case -1: 210 | Status("baddim", t->ndim, 0); 211 | break; 212 | case -2: 213 | Status("badcomp", t->ncomp, 0); 214 | break; 215 | } 216 | MLPutSymbol(stdlink, "$Failed"); 217 | } 218 | else { 219 | Status(fail ? "accuracy" : "success", t->neval, t->nregions); 220 | MLPutFunction(stdlink, "Thread", 1); 221 | MLPutFunction(stdlink, "List", 3); 222 | MLPutRealList(stdlink, integral, t->ncomp); 223 | MLPutRealList(stdlink, error, t->ncomp); 224 | MLPutRealList(stdlink, prob, t->ncomp); 225 | } 226 | } 227 | 228 | /*********************************************************************/ 229 | 230 | void Suave(cint ndim, cint ncomp, 231 | creal epsrel, creal epsabs, 232 | cint flags, cint seed, 233 | cnumber mineval, cnumber maxeval, 234 | cnumber nnew, creal flatness, cchar *statefile) 235 | { 236 | This t; 237 | t.ndim = ndim; 238 | t.ncomp = ncomp; 239 | t.epsrel = epsrel; 240 | t.epsabs = epsabs; 241 | t.flags = flags; 242 | t.seed = seed; 243 | t.mineval = mineval; 244 | t.maxeval = maxeval; 245 | t.nnew = nnew; 246 | t.flatness = flatness; 247 | t.statefile = statefile; 248 | 249 | DoIntegrate(&t); 250 | MLEndPacket(stdlink); 251 | } 252 | 253 | /*********************************************************************/ 254 | 255 | int main(int argc, char **argv) 256 | { 257 | return MLMain(argc, argv); 258 | } 259 | 260 | -------------------------------------------------------------------------------- /install-sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # install - install a program, script, or datafile 3 | 4 | scriptversion=2004-10-22.00 5 | 6 | # This originates from X11R5 (mit/util/scripts/install.sh), which was 7 | # later released in X11R6 (xc/config/util/install.sh) with the 8 | # following copyright and license. 9 | # 10 | # Copyright (C) 1994 X Consortium 11 | # 12 | # Permission is hereby granted, free of charge, to any person obtaining a copy 13 | # of this software and associated documentation files (the "Software"), to 14 | # deal in the Software without restriction, including without limitation the 15 | # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 16 | # sell copies of the Software, and to permit persons to whom the Software is 17 | # furnished to do so, subject to the following conditions: 18 | # 19 | # The above copyright notice and this permission notice shall be included in 20 | # all copies or substantial portions of the Software. 21 | # 22 | # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 23 | # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 24 | # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 25 | # X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN 26 | # AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- 27 | # TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 28 | # 29 | # Except as contained in this notice, the name of the X Consortium shall not 30 | # be used in advertising or otherwise to promote the sale, use or other deal- 31 | # ings in this Software without prior written authorization from the X Consor- 32 | # tium. 33 | # 34 | # 35 | # FSF changes to this file are in the public domain. 36 | # 37 | # Calling this script install-sh is preferred over install.sh, to prevent 38 | # `make' implicit rules from creating a file called install from it 39 | # when there is no Makefile. 40 | # 41 | # This script is compatible with the BSD install script, but was written 42 | # from scratch. It can only install one file at a time, a restriction 43 | # shared with many OS's install programs. 44 | 45 | # set DOITPROG to echo to test this script 46 | 47 | # Don't use :- since 4.3BSD and earlier shells don't like it. 48 | doit="${DOITPROG-}" 49 | 50 | # put in absolute paths if you don't have them in your path; or use env. vars. 51 | 52 | mvprog="${MVPROG-mv}" 53 | cpprog="${CPPROG-cp}" 54 | chmodprog="${CHMODPROG-chmod}" 55 | chownprog="${CHOWNPROG-chown}" 56 | chgrpprog="${CHGRPPROG-chgrp}" 57 | stripprog="${STRIPPROG-strip}" 58 | rmprog="${RMPROG-rm}" 59 | mkdirprog="${MKDIRPROG-mkdir}" 60 | 61 | chmodcmd="$chmodprog 0755" 62 | chowncmd= 63 | chgrpcmd= 64 | stripcmd= 65 | rmcmd="$rmprog -f" 66 | mvcmd="$mvprog" 67 | src= 68 | dst= 69 | dir_arg= 70 | dstarg= 71 | no_target_directory= 72 | 73 | usage="Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE 74 | or: $0 [OPTION]... SRCFILES... DIRECTORY 75 | or: $0 [OPTION]... -t DIRECTORY SRCFILES... 76 | or: $0 [OPTION]... -d DIRECTORIES... 77 | 78 | In the 1st form, copy SRCFILE to DSTFILE. 79 | In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. 80 | In the 4th, create DIRECTORIES. 81 | 82 | Options: 83 | -c (ignored) 84 | -d create directories instead of installing files. 85 | -g GROUP $chgrpprog installed files to GROUP. 86 | -m MODE $chmodprog installed files to MODE. 87 | -o USER $chownprog installed files to USER. 88 | -s $stripprog installed files. 89 | -t DIRECTORY install into DIRECTORY. 90 | -T report an error if DSTFILE is a directory. 91 | --help display this help and exit. 92 | --version display version info and exit. 93 | 94 | Environment variables override the default commands: 95 | CHGRPPROG CHMODPROG CHOWNPROG CPPROG MKDIRPROG MVPROG RMPROG STRIPPROG 96 | " 97 | 98 | while test -n "$1"; do 99 | case $1 in 100 | -c) shift 101 | continue;; 102 | 103 | -d) dir_arg=true 104 | shift 105 | continue;; 106 | 107 | -g) chgrpcmd="$chgrpprog $2" 108 | shift 109 | shift 110 | continue;; 111 | 112 | --help) echo "$usage"; exit 0;; 113 | 114 | -m) chmodcmd="$chmodprog $2" 115 | shift 116 | shift 117 | continue;; 118 | 119 | -o) chowncmd="$chownprog $2" 120 | shift 121 | shift 122 | continue;; 123 | 124 | -s) stripcmd=$stripprog 125 | shift 126 | continue;; 127 | 128 | -t) dstarg=$2 129 | shift 130 | shift 131 | continue;; 132 | 133 | -T) no_target_directory=true 134 | shift 135 | continue;; 136 | 137 | --version) echo "$0 $scriptversion"; exit 0;; 138 | 139 | *) # When -d is used, all remaining arguments are directories to create. 140 | # When -t is used, the destination is already specified. 141 | test -n "$dir_arg$dstarg" && break 142 | # Otherwise, the last argument is the destination. Remove it from $@. 143 | for arg 144 | do 145 | if test -n "$dstarg"; then 146 | # $@ is not empty: it contains at least $arg. 147 | set fnord "$@" "$dstarg" 148 | shift # fnord 149 | fi 150 | shift # arg 151 | dstarg=$arg 152 | done 153 | break;; 154 | esac 155 | done 156 | 157 | if test -z "$1"; then 158 | if test -z "$dir_arg"; then 159 | echo "$0: no input file specified." >&2 160 | exit 1 161 | fi 162 | # It's OK to call `install-sh -d' without argument. 163 | # This can happen when creating conditional directories. 164 | exit 0 165 | fi 166 | 167 | for src 168 | do 169 | # Protect names starting with `-'. 170 | case $src in 171 | -*) src=./$src ;; 172 | esac 173 | 174 | if test -n "$dir_arg"; then 175 | dst=$src 176 | src= 177 | 178 | if test -d "$dst"; then 179 | mkdircmd=: 180 | chmodcmd= 181 | else 182 | mkdircmd=$mkdirprog 183 | fi 184 | else 185 | # Waiting for this to be detected by the "$cpprog $src $dsttmp" command 186 | # might cause directories to be created, which would be especially bad 187 | # if $src (and thus $dsttmp) contains '*'. 188 | if test ! -f "$src" && test ! -d "$src"; then 189 | echo "$0: $src does not exist." >&2 190 | exit 1 191 | fi 192 | 193 | if test -z "$dstarg"; then 194 | echo "$0: no destination specified." >&2 195 | exit 1 196 | fi 197 | 198 | dst=$dstarg 199 | # Protect names starting with `-'. 200 | case $dst in 201 | -*) dst=./$dst ;; 202 | esac 203 | 204 | # If destination is a directory, append the input filename; won't work 205 | # if double slashes aren't ignored. 206 | if test -d "$dst"; then 207 | if test -n "$no_target_directory"; then 208 | echo "$0: $dstarg: Is a directory" >&2 209 | exit 1 210 | fi 211 | dst=$dst/`basename "$src"` 212 | fi 213 | fi 214 | 215 | # This sed command emulates the dirname command. 216 | dstdir=`echo "$dst" | sed -e 's,/*$,,;s,[^/]*$,,;s,/*$,,;s,^$,.,'` 217 | 218 | # Make sure that the destination directory exists. 219 | 220 | # Skip lots of stat calls in the usual case. 221 | if test ! -d "$dstdir"; then 222 | defaultIFS=' 223 | ' 224 | IFS="${IFS-$defaultIFS}" 225 | 226 | oIFS=$IFS 227 | # Some sh's can't handle IFS=/ for some reason. 228 | IFS='%' 229 | set x `echo "$dstdir" | sed -e 's@/@%@g' -e 's@^%@/@'` 230 | shift 231 | IFS=$oIFS 232 | 233 | pathcomp= 234 | 235 | while test $# -ne 0 ; do 236 | pathcomp=$pathcomp$1 237 | shift 238 | if test ! -d "$pathcomp"; then 239 | $mkdirprog "$pathcomp" 240 | # mkdir can fail with a `File exist' error in case several 241 | # install-sh are creating the directory concurrently. This 242 | # is OK. 243 | test -d "$pathcomp" || exit 244 | fi 245 | pathcomp=$pathcomp/ 246 | done 247 | fi 248 | 249 | if test -n "$dir_arg"; then 250 | $doit $mkdircmd "$dst" \ 251 | && { test -z "$chowncmd" || $doit $chowncmd "$dst"; } \ 252 | && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } \ 253 | && { test -z "$stripcmd" || $doit $stripcmd "$dst"; } \ 254 | && { test -z "$chmodcmd" || $doit $chmodcmd "$dst"; } 255 | 256 | else 257 | dstfile=`basename "$dst"` 258 | 259 | # Make a couple of temp file names in the proper directory. 260 | dsttmp=$dstdir/_inst.$$_ 261 | rmtmp=$dstdir/_rm.$$_ 262 | 263 | # Trap to clean up those temp files at exit. 264 | trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 265 | trap '(exit $?); exit' 1 2 13 15 266 | 267 | # Copy the file name to the temp name. 268 | $doit $cpprog "$src" "$dsttmp" && 269 | 270 | # and set any options; do chmod last to preserve setuid bits. 271 | # 272 | # If any of these fail, we abort the whole thing. If we want to 273 | # ignore errors from any of these, just make sure not to ignore 274 | # errors from the above "$doit $cpprog $src $dsttmp" command. 275 | # 276 | { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } \ 277 | && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } \ 278 | && { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } \ 279 | && { test -z "$chmodcmd" || $doit $chmodcmd "$dsttmp"; } && 280 | 281 | # Now rename the file to the real destination. 282 | { $doit $mvcmd -f "$dsttmp" "$dstdir/$dstfile" 2>/dev/null \ 283 | || { 284 | # The rename failed, perhaps because mv can't rename something else 285 | # to itself, or perhaps because mv is so ancient that it does not 286 | # support -f. 287 | 288 | # Now remove or move aside any old file at destination location. 289 | # We try this two ways since rm can't unlink itself on some 290 | # systems and the destination file might be busy for other 291 | # reasons. In this case, the final cleanup might fail but the new 292 | # file should still install successfully. 293 | { 294 | if test -f "$dstdir/$dstfile"; then 295 | $doit $rmcmd -f "$dstdir/$dstfile" 2>/dev/null \ 296 | || $doit $mvcmd -f "$dstdir/$dstfile" "$rmtmp" 2>/dev/null \ 297 | || { 298 | echo "$0: cannot unlink or rename $dstdir/$dstfile" >&2 299 | (exit 1); exit 300 | } 301 | else 302 | : 303 | fi 304 | } && 305 | 306 | # Now rename the file to the real destination. 307 | $doit $mvcmd "$dsttmp" "$dstdir/$dstfile" 308 | } 309 | } 310 | fi || { (exit 1); exit; } 311 | done 312 | 313 | # The final little trick to "correctly" pass the exit status to the exit trap. 314 | { 315 | (exit 0); exit 316 | } 317 | 318 | # Local variables: 319 | # eval: (add-hook 'write-file-hooks 'time-stamp) 320 | # time-stamp-start: "scriptversion=" 321 | # time-stamp-format: "%:y-%02m-%02d.%02H" 322 | # time-stamp-end: "$" 323 | # End: 324 | -------------------------------------------------------------------------------- /src/common/Random.c: -------------------------------------------------------------------------------- 1 | /* 2 | Random.c 3 | quasi- and pseudo-random-number generation 4 | last modified 18 Mar 14 th 5 | */ 6 | 7 | 8 | /* 9 | PART 1: Sobol quasi-random-number generator 10 | adapted from ACM TOMS algorithm 659 11 | */ 12 | 13 | static void SobolGet(This *t, real *x) 14 | { 15 | number seq = t->rng.sobol.seq++; 16 | count zerobit = 0, dim; 17 | 18 | while( seq & 1 ) { 19 | ++zerobit; 20 | seq >>= 1; 21 | } 22 | 23 | for( dim = 0; dim < t->ndim; ++dim ) { 24 | t->rng.sobol.prev[dim] ^= t->rng.sobol.v[dim][zerobit]; 25 | x[dim] = t->rng.sobol.prev[dim]*t->rng.sobol.norm; 26 | } 27 | } 28 | 29 | 30 | static void SobolSkip(This *t, number n) 31 | { 32 | while( n-- ) { 33 | number seq = t->rng.sobol.seq++; 34 | count zerobit = 0, dim; 35 | 36 | while( seq & 1 ) { 37 | ++zerobit; 38 | seq >>= 1; 39 | } 40 | 41 | for( dim = 0; dim < t->ndim; ++dim ) 42 | t->rng.sobol.prev[dim] ^= t->rng.sobol.v[dim][zerobit]; 43 | } 44 | } 45 | 46 | 47 | static inline void SobolIni(This *t) 48 | { 49 | static number ini[9*40] = { 50 | 3, 1, 0, 0, 0, 0, 0, 0, 0, 51 | 7, 1, 1, 0, 0, 0, 0, 0, 0, 52 | 11, 1, 3, 7, 0, 0, 0, 0, 0, 53 | 13, 1, 1, 5, 0, 0, 0, 0, 0, 54 | 19, 1, 3, 1, 1, 0, 0, 0, 0, 55 | 25, 1, 1, 3, 7, 0, 0, 0, 0, 56 | 37, 1, 3, 3, 9, 9, 0, 0, 0, 57 | 59, 1, 3, 7, 13, 3, 0, 0, 0, 58 | 47, 1, 1, 5, 11, 27, 0, 0, 0, 59 | 61, 1, 3, 5, 1, 15, 0, 0, 0, 60 | 55, 1, 1, 7, 3, 29, 0, 0, 0, 61 | 41, 1, 3, 7, 7, 21, 0, 0, 0, 62 | 67, 1, 1, 1, 9, 23, 37, 0, 0, 63 | 97, 1, 3, 3, 5, 19, 33, 0, 0, 64 | 91, 1, 1, 3, 13, 11, 7, 0, 0, 65 | 109, 1, 1, 7, 13, 25, 5, 0, 0, 66 | 103, 1, 3, 5, 11, 7, 11, 0, 0, 67 | 115, 1, 1, 1, 3, 13, 39, 0, 0, 68 | 131, 1, 3, 1, 15, 17, 63, 13, 0, 69 | 193, 1, 1, 5, 5, 1, 27, 33, 0, 70 | 137, 1, 3, 3, 3, 25, 17, 115, 0, 71 | 145, 1, 1, 3, 15, 29, 15, 41, 0, 72 | 143, 1, 3, 1, 7, 3, 23, 79, 0, 73 | 241, 1, 3, 7, 9, 31, 29, 17, 0, 74 | 157, 1, 1, 5, 13, 11, 3, 29, 0, 75 | 185, 1, 3, 1, 9, 5, 21, 119, 0, 76 | 167, 1, 1, 3, 1, 23, 13, 75, 0, 77 | 229, 1, 3, 3, 11, 27, 31, 73, 0, 78 | 171, 1, 1, 7, 7, 19, 25, 105, 0, 79 | 213, 1, 3, 5, 5, 21, 9, 7, 0, 80 | 191, 1, 1, 1, 15, 5, 49, 59, 0, 81 | 253, 1, 1, 1, 1, 1, 33, 65, 0, 82 | 203, 1, 3, 5, 15, 17, 19, 21, 0, 83 | 211, 1, 1, 7, 11, 13, 29, 3, 0, 84 | 239, 1, 3, 7, 5, 7, 11, 113, 0, 85 | 247, 1, 1, 5, 3, 15, 19, 61, 0, 86 | 285, 1, 3, 1, 1, 9, 27, 89, 7, 87 | 369, 1, 1, 3, 7, 31, 15, 45, 23, 88 | 299, 1, 3, 3, 9, 9, 25, 107, 39 }; 89 | 90 | count dim, bit, nbits; 91 | number *pini = ini, max; 92 | 93 | for( nbits = 0, max = t->maxeval; max; max >>= 1 ) ++nbits; 94 | t->rng.sobol.norm = ldexp(.5, -nbits); 95 | 96 | for( bit = 0; bit <= nbits; ++bit ) 97 | t->rng.sobol.v[0][bit] = (number)1 << (nbits - bit); 98 | 99 | for( dim = 1; dim < t->ndim; ++dim ) { 100 | number *pv = t->rng.sobol.v[dim], *pvv = pv; 101 | number powers = *pini++, j; 102 | int inibits = -1, bit; 103 | for( j = powers; j; j >>= 1 ) ++inibits; 104 | 105 | memcpy(pv, pini, inibits*sizeof *pini); 106 | pini += 8; 107 | 108 | for( bit = inibits; bit <= nbits; ++bit ) { 109 | number newv = *pvv, j = powers; 110 | int b; 111 | for( b = 0; b < inibits; ++b ) { 112 | if( j & 1 ) newv ^= pvv[b] << (inibits - b); 113 | j >>= 1; 114 | } 115 | pvv[inibits] = newv; 116 | ++pvv; 117 | } 118 | 119 | for( bit = 0; bit < nbits; ++bit ) 120 | pv[bit] <<= nbits - bit; 121 | } 122 | 123 | t->rng.sobol.seq = 0; 124 | XClear(t->rng.sobol.prev); 125 | 126 | t->rng.getrandom = SobolGet; 127 | t->rng.skiprandom = SobolSkip; 128 | } 129 | 130 | 131 | /* 132 | PART 2: Mersenne Twister pseudo-random-number generator 133 | adapted from T. Nishimura's and M. Matsumoto's C code at 134 | http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/emt.html 135 | */ 136 | 137 | /* 32 or 53 random bits */ 138 | #define RANDOM_BITS 32 139 | 140 | 141 | static inline state_t Twist(state_t a, state_t b) 142 | { 143 | state_t mixbits = (a & 0x80000000) | (b & 0x7fffffff); 144 | state_t matrixA = (-(b & 1)) & 0x9908b0df; 145 | return (mixbits >> 1) ^ matrixA; 146 | } 147 | 148 | 149 | static inline void MersenneReload(state_t *state) 150 | { 151 | state_t *s = state; 152 | int j; 153 | 154 | for( j = MERSENNE_N - MERSENNE_M + 1; --j; ++s ) 155 | *s = s[MERSENNE_M] ^ Twist(s[0], s[1]); 156 | for( j = MERSENNE_M; --j; ++s ) 157 | *s = s[MERSENNE_M - MERSENNE_N] ^ Twist(s[0], s[1]); 158 | *s = s[MERSENNE_M - MERSENNE_N] ^ Twist(s[0], state[0]); 159 | } 160 | 161 | 162 | static inline state_t MersenneInt(state_t s) 163 | { 164 | s ^= s >> 11; 165 | s ^= (s << 7) & 0x9d2c5680; 166 | s ^= (s << 15) & 0xefc60000; 167 | return s ^ (s >> 18); 168 | } 169 | 170 | 171 | static void MersenneGet(This *t, real *x) 172 | { 173 | count next = t->rng.mersenne.next, dim; 174 | 175 | for( dim = 0; dim < t->ndim; ++dim ) { 176 | #if RANDOM_BITS == 53 177 | state_t a, b; 178 | #endif 179 | 180 | if( next >= MERSENNE_N ) { 181 | MersenneReload(t->rng.mersenne.state); 182 | next = 0; 183 | } 184 | 185 | #if RANDOM_BITS == 53 186 | a = MersenneInt(t->rng.mersenne.state[next++]) >> 5; 187 | b = MersenneInt(t->rng.mersenne.state[next++]) >> 6; 188 | x[dim] = (67108864.*a + b)/9007199254740992.; 189 | #else 190 | x[dim] = MersenneInt(t->rng.mersenne.state[next++])/4294967296.; 191 | #endif 192 | } 193 | 194 | t->rng.mersenne.next = next; 195 | } 196 | 197 | 198 | static void MersenneSkip(This *t, number n) 199 | { 200 | #if RANDOM_BITS == 53 201 | n = 2*n*t->ndim + t->rng.mersenne.next; 202 | #else 203 | n = n*t->ndim + t->rng.mersenne.next; 204 | #endif 205 | t->rng.mersenne.next = n % MERSENNE_N; 206 | n /= MERSENNE_N; 207 | while( n-- ) MersenneReload(t->rng.mersenne.state); 208 | } 209 | 210 | 211 | static inline void MersenneIni(This *t) 212 | { 213 | state_t seed = t->seed; 214 | state_t *next = t->rng.mersenne.state; 215 | count j; 216 | 217 | for( j = 1; j <= MERSENNE_N; ++j ) { 218 | *next++ = seed; 219 | seed = 0x6c078965*(seed ^ (seed >> 30)) + j; 220 | /* see Knuth TAOCP Vol 2, 3rd Ed, p. 106 for multiplier */ 221 | } 222 | 223 | MersenneReload(t->rng.mersenne.state); 224 | t->rng.mersenne.next = 0; 225 | 226 | t->rng.getrandom = MersenneGet; 227 | t->rng.skiprandom = MersenneSkip; 228 | } 229 | 230 | 231 | /* 232 | PART 3: Ranlux subtract-and-borrow random-number generator 233 | proposed by Marsaglia and Zaman, implemented by F. James with 234 | the name RCARRY in 1991, and later improved by Martin Luescher 235 | in 1993 to produce "Luxury Pseudorandom Numbers". 236 | Adapted from the CERNlib Fortran 77 code by F. James, 1993. 237 | 238 | The available luxury levels are: 239 | 240 | level 0 (p = 24): equivalent to the original RCARRY of Marsaglia 241 | and Zaman, very long period, but fails many tests. 242 | level 1 (p = 48): considerable improvement in quality over level 0, 243 | now passes the gap test, but still fails spectral test. 244 | level 2 (p = 97): passes all known tests, but theoretically still 245 | defective. 246 | level 3 (p = 223): DEFAULT VALUE. Any theoretically possible 247 | correlations have very small chance of being observed. 248 | level 4 (p = 389): highest possible luxury, all 24 bits chaotic. 249 | */ 250 | 251 | 252 | static inline int RanluxInt(This *t, count n) 253 | { 254 | int s = 0; 255 | 256 | while( n-- ) { 257 | s = t->rng.ranlux.state[t->rng.ranlux.j24] - 258 | t->rng.ranlux.state[t->rng.ranlux.i24] + t->rng.ranlux.carry; 259 | s += (t->rng.ranlux.carry = NegQ(s)) & (1 << 24); 260 | t->rng.ranlux.state[t->rng.ranlux.i24] = s; 261 | --t->rng.ranlux.i24; 262 | t->rng.ranlux.i24 += NegQ(t->rng.ranlux.i24) & 24; 263 | --t->rng.ranlux.j24; 264 | t->rng.ranlux.j24 += NegQ(t->rng.ranlux.j24) & 24; 265 | } 266 | 267 | return s; 268 | } 269 | 270 | 271 | static void RanluxGet(This *t, real *x) 272 | { 273 | /* The Generator proper: "Subtract-with-borrow", 274 | as proposed by Marsaglia and Zaman, FSU, March 1989 */ 275 | 276 | count dim; 277 | 278 | for( dim = 0; dim < t->ndim; ++dim ) { 279 | cint nskip = (--t->rng.ranlux.n24 >= 0) ? 0 : 280 | (t->rng.ranlux.n24 = 24, t->rng.ranlux.nskip); 281 | cint s = RanluxInt(t, 1 + nskip); 282 | x[dim] = ldexp(s, -24); 283 | /* small numbers (with less than 12 significant bits) are "padded" */ 284 | if( s < (1 << 12) ) 285 | x[dim] += ldexp(t->rng.ranlux.state[t->rng.ranlux.j24], -48); 286 | } 287 | } 288 | 289 | 290 | static void RanluxSkip(This *t, cnumber n) 291 | { 292 | RanluxInt(t, n + t->rng.ranlux.nskip*(n/24)); 293 | t->rng.ranlux.n24 = 24 - n % 24; 294 | } 295 | 296 | 297 | static inline void RanluxIni(This *t) 298 | { 299 | cint skip[] = {24, 48, 97, 223, 389, 300 | 223, 223, 223, 223, 223, 223, 223, 223, 223, 223, 301 | 223, 223, 223, 223, 223, 223, 223, 223, 223, 223}; 302 | int seed = t->seed; 303 | int level = RNG; 304 | count i; 305 | 306 | if( level < Elements(skip) ) level = skip[level]; 307 | t->rng.ranlux.nskip = level - 24; 308 | 309 | t->rng.ranlux.i24 = 23; 310 | t->rng.ranlux.j24 = 9; 311 | t->rng.ranlux.n24 = 24; 312 | 313 | for( i = 0; i < 24; ++i ) { 314 | cint k = seed/53668; 315 | seed = 40014*(seed - k*53668) - k*12211; 316 | seed += NegQ(seed) & 2147483563; 317 | t->rng.ranlux.state[i] = seed & ((1 << 24) - 1); 318 | } 319 | 320 | t->rng.ranlux.carry = ~TrueQ(t->rng.ranlux.state[23]) & (1 << 24); 321 | 322 | t->rng.getrandom = RanluxGet; 323 | t->rng.skiprandom = RanluxSkip; 324 | } 325 | 326 | 327 | /* 328 | PART 4: User routines: 329 | 330 | - IniRandom sets up the random-number generator to produce a 331 | sequence of at least n ndim-dimensional random vectors. 332 | 333 | - GetRandom retrieves one random vector. 334 | 335 | - SkipRandom skips over n random vectors. 336 | */ 337 | 338 | static inline void IniRandom(This *t) 339 | { 340 | if( t->seed == 0 ) SobolIni(t); 341 | else if( RNG == 0 ) MersenneIni(t); 342 | else RanluxIni(t); 343 | } 344 | 345 | --------------------------------------------------------------------------------