Mercurial > octave-nkf
changeset 14660:7925a7d6547b gui
main: Periodic merge of default to gui
| author | Jordi Gutiérrez Hermoso <jordigh@octave.org> |
|---|---|
| date | Sat, 19 May 2012 03:15:00 -0400 |
| parents | c8d0095b3744 (current diff) 97e3d1769be0 (diff) |
| children | 6573ba8f094f |
| files | NEWS configure.ac src/mkgendoc |
| diffstat | 21 files changed, 920 insertions(+), 295 deletions(-) [+] |
line wrap: on
line diff
--- a/Makefile.am Fri May 18 09:59:23 2012 +0200 +++ b/Makefile.am Sat May 19 03:15:00 2012 -0400 @@ -86,7 +86,9 @@ CLEANFILES = $(BUILT_SOURCES) -DISTCLEANFILES = .gdbinit +DISTCLEANFILES = \ + .gdbinit \ + ChangeLog MAINTAINERCLEANFILES = $(BUILT_DISTFILES)
--- a/NEWS Fri May 18 09:59:23 2012 +0200 +++ b/NEWS Sat May 19 03:15:00 2012 -0400 @@ -64,6 +64,12 @@ Octave:array-as-scalar => Octave:array-to-scalar Octave:array-as-vector => Octave:array-to-vector + ** The colormap function now provides new options--"list", "register", + and "unregister"--to list all available colormap functions, and to + add or remove a function name from the list of known colormap + functions. Packages that implement extra colormaps should use these + commands with PKG_ADD and PKG_DEL statements. + ** Other new functions added in 3.8.0: colorcube splinefit @@ -94,12 +100,6 @@ static - ** The colormap function now provides new options "list", "register", - and "unregister" to list all available colormap functions, and to - add or remove a function name from teh list of known colormap - functions. Packages that implement extra colormaps should use these - commands with PKG_ADD and PKG_DEL statements. - Summary of important user-visible changes for version 3.6: ---------------------------------------------------------
--- a/configure.ac Fri May 18 09:59:23 2012 +0200 +++ b/configure.ac Sat May 19 03:15:00 2012 -0400 @@ -2888,8 +2888,9 @@ if $warn_msg_printed; then AC_MSG_NOTICE([]) - AC_MSG_NOTICE([NOTE: libraries may be skipped if a library is not found OR]) - AC_MSG_NOTICE([NOTE: if the library on your system is missing required features.]) + AC_MSG_NOTICE([NOTE: Libraries or auxiliary programs may be skipped if they are]) + AC_MSG_NOTICE([NOTE: not found OR if they are missing required features on your]) + AC_MSG_NOTICE([NOTE: system. ]) fi ### End of configure.
--- a/doc/interpreter/Makefile.am Fri May 18 09:59:23 2012 +0200 +++ b/doc/interpreter/Makefile.am Sat May 19 03:15:00 2012 -0400 @@ -198,6 +198,10 @@ ../../AUTHORS: preface.texi contributors.texi rm -f AUTHORS + if [ "x$(srcdir)" != "x." ] && [ -f $(srcdir)/contributors.texi ] && [ ! -f contributors.texi ]; then \ + cp $(srcdir)/contributors.texi contributors.texi; \ + touch -r $(srcdir)/contributors.texi contributors.texi; \ + fi -$(MAKEINFO) -D AUTHORSONLY \ --no-validate --no-headers --no-split --output AUTHORS $< mv AUTHORS ../../AUTHORS @@ -245,6 +249,7 @@ images \ images.awk \ images.mk \ + macros.texi \ mk_doc_cache.m \ mkcontrib.awk \ munge-texi.pl \
--- a/libcruft/misc/lo-error.c Fri May 18 09:59:23 2012 +0200 +++ b/libcruft/misc/lo-error.c Sat May 19 03:15:00 2012 -0400 @@ -110,6 +110,7 @@ void liboctave_fatal_with_id (const char *id, const char *fmt, ...) { + (void) id; /*unused*/ va_list args; va_start (args, fmt); verror ("fatal", fmt, args); @@ -130,6 +131,7 @@ void liboctave_warning_with_id (const char *id, const char *fmt, ...) { + (void) id; /*unused*/ va_list args; va_start (args, fmt); verror ("warning", fmt, args);
--- a/liboctave/DiagArray2.h Fri May 18 09:59:23 2012 +0200 +++ b/liboctave/DiagArray2.h Sat May 19 03:15:00 2012 -0400 @@ -127,7 +127,7 @@ T operator () (octave_idx_type r, octave_idx_type c) const { #if defined (BOUNDS_CHECKING) - checkelem (r, c); + return checkelem (r, c); #else return elem (r, c); #endif
--- a/liboctave/Sparse.cc Fri May 18 09:59:23 2012 +0200 +++ b/liboctave/Sparse.cc Sat May 19 03:15:00 2012 -0400 @@ -235,7 +235,7 @@ (*current_liboctave_error_handler) ("Sparse::Sparse (const dim_vector&): dimension mismatch"); else - rep = new typename Sparse<T>::SparseRep (dv(0), dv(1)); + rep = new typename Sparse<T>::SparseRep (dv(0), dv(1), 0); } template <class T> @@ -301,11 +301,10 @@ (*current_liboctave_error_handler) ("sparse: column index %d out of bound %d", r.extent (nc), nc); - rep = new SparseRep (nr, nc); + rep = new typename Sparse<T>::SparseRep (nr, nc, (nzm > 0 ? nzm : 0)); dimensions = dim_vector (nr, nc); - octave_idx_type n = a.numel (), rl = r.length (nr), cl = c.length (nc); bool a_scalar = n == 1; if (a_scalar) @@ -324,6 +323,7 @@ if (n == 1 && a(0) != T ()) { change_capacity (nzm > 1 ? nzm : 1); + xcidx(0) = 0; xridx(0) = r(0); xdata(0) = a(0); for (octave_idx_type j = 0; j < nc; j++) @@ -352,6 +352,7 @@ new_nz += rd[i-1] != rd[i]; // Allocate result. change_capacity (nzm > new_nz ? nzm : new_nz); + xcidx (0) = 0; xcidx (1) = new_nz; octave_idx_type *rri = ridx (); T *rrd = data (); @@ -494,6 +495,7 @@ new_nz += rd[i-1] != rd[i]; // Allocate result. change_capacity (nzm > new_nz ? nzm : new_nz); + xcidx(0) = 0; xcidx(1) = new_nz; octave_idx_type *rri = ridx (); T *rrd = data ();
--- a/liboctave/oct-rand.cc Fri May 18 09:59:23 2012 +0200 +++ b/liboctave/oct-rand.cc Sat May 19 03:15:00 2012 -0400 @@ -419,19 +419,120 @@ return retval; } -Matrix -octave_rand::do_matrix (octave_idx_type n, octave_idx_type m, double a) +float +octave_rand::do_float_scalar (float a) { - Matrix retval; + float retval = 0.0; + + if (use_old_generators) + { + double da = a; + double dretval; + switch (current_distribution) + { + case uniform_dist: + F77_FUNC (dgenunf, DGENUNF) (0.0, 1.0, dretval); + break; + + case normal_dist: + F77_FUNC (dgennor, DGENNOR) (0.0, 1.0, dretval); + break; + + case expon_dist: + F77_FUNC (dgenexp, DGENEXP) (1.0, dretval); + break; - if (n >= 0 && m >= 0) - { - retval.clear (n, m); + case poisson_dist: + if (da < 0.0 || xisnan(da) || xisinf(da)) + dretval = octave_NaN; + else + { + // workaround bug in ignpoi, by calling with different Mu + F77_FUNC (dignpoi, DIGNPOI) (da + 1, dretval); + F77_FUNC (dignpoi, DIGNPOI) (da, dretval); + } + break; - if (n > 0 && m > 0) - fill (retval.capacity(), retval.fortran_vec(), a); + case gamma_dist: + if (da <= 0.0 || xisnan(da) || xisinf(da)) + retval = octave_NaN; + else + F77_FUNC (dgengam, DGENGAM) (1.0, da, dretval); + break; + + default: + (*current_liboctave_error_handler) + ("rand: invalid distribution ID = %d", current_distribution); + break; + } + retval = dretval; } else + { + switch (current_distribution) + { + case uniform_dist: + retval = oct_float_randu (); + break; + + case normal_dist: + retval = oct_float_randn (); + break; + + case expon_dist: + retval = oct_float_rande (); + break; + + case poisson_dist: + // Keep poisson distribution in double precision for accuracy + retval = oct_randp (a); + break; + + case gamma_dist: + retval = oct_float_randg (a); + break; + + default: + (*current_liboctave_error_handler) + ("rand: invalid distribution ID = %d", current_distribution); + break; + } + + save_state (); + } + + return retval; +} + +Array<double> +octave_rand::do_vector (octave_idx_type n, double a) +{ + Array<double> retval; + + if (n > 0) + { + retval.clear (n, 1); + + fill (retval.capacity(), retval.fortran_vec(), a); + } + else if (n < 0) + (*current_liboctave_error_handler) ("rand: invalid negative argument"); + + return retval; +} + +Array<float> +octave_rand::do_float_vector (octave_idx_type n, float a) +{ + Array<float> retval; + + if (n > 0) + { + retval.clear (n, 1); + + fill (retval.capacity(), retval.fortran_vec(), a); + } + else if (n < 0) (*current_liboctave_error_handler) ("rand: invalid negative argument"); return retval; @@ -452,19 +553,17 @@ return retval; } -Array<double> -octave_rand::do_vector (octave_idx_type n, double a) +FloatNDArray +octave_rand::do_float_nd_array (const dim_vector& dims, float a) { - Array<double> retval; + FloatNDArray retval; - if (n > 0) + if (! dims.all_zero ()) { - retval.clear (n, 1); + retval.clear (dims); - fill (retval.capacity (), retval.fortran_vec (), a); + fill (retval.capacity(), retval.fortran_vec(), a); } - else if (n < 0) - (*current_liboctave_error_handler) ("rand: invalid negative argument"); return retval; } @@ -693,3 +792,94 @@ return; } + +void +octave_rand::fill (octave_idx_type len, float *v, float a) +{ + if (len < 1) + return; + + switch (current_distribution) + { + case uniform_dist: + if (use_old_generators) + { +#define RAND_FUNC(x) F77_FUNC (dgenunf, DGENUNF) (0.0, 1.0, x) + MAKE_RAND (len); +#undef RAND_FUNC + } + else + oct_fill_float_randu (len, v); + break; + + case normal_dist: + if (use_old_generators) + { +#define RAND_FUNC(x) F77_FUNC (dgennor, DGENNOR) (0.0, 1.0, x) + MAKE_RAND (len); +#undef RAND_FUNC + } + else + oct_fill_float_randn (len, v); + break; + + case expon_dist: + if (use_old_generators) + { +#define RAND_FUNC(x) F77_FUNC (dgenexp, DGENEXP) (1.0, x) + MAKE_RAND (len); +#undef RAND_FUNC + } + else + oct_fill_float_rande (len, v); + break; + + case poisson_dist: + if (use_old_generators) + { + double da = a; + if (da < 0.0 || xisnan(da) || xisinf(da)) +#define RAND_FUNC(x) x = octave_NaN; + MAKE_RAND (len); +#undef RAND_FUNC + else + { + // workaround bug in ignpoi, by calling with different Mu + double tmp; + F77_FUNC (dignpoi, DIGNPOI) (da + 1, tmp); +#define RAND_FUNC(x) F77_FUNC (dignpoi, DIGNPOI) (da, x) + MAKE_RAND (len); +#undef RAND_FUNC + } + } + else + oct_fill_float_randp (a, len, v); + break; + + case gamma_dist: + if (use_old_generators) + { + double da = a; + if (da <= 0.0 || xisnan(da) || xisinf(da)) +#define RAND_FUNC(x) x = octave_NaN; + MAKE_RAND (len); +#undef RAND_FUNC + else +#define RAND_FUNC(x) F77_FUNC (dgengam, DGENGAM) (1.0, da, x) + MAKE_RAND (len); +#undef RAND_FUNC + } + else + oct_fill_float_randg (a, len, v); + break; + + default: + (*current_liboctave_error_handler) + ("rand: invalid distribution ID = %d", current_distribution); + break; + } + + save_state (); + + return; +}
--- a/liboctave/oct-rand.h Fri May 18 09:59:23 2012 +0200 +++ b/liboctave/oct-rand.h Sat May 19 03:15:00 2012 -0400 @@ -27,8 +27,8 @@ #include <string> #include "dColVector.h" -#include "dMatrix.h" #include "dNDArray.h" +#include "fNDArray.h" #include "lo-ieee.h" class @@ -136,13 +136,24 @@ return instance_ok () ? instance->do_scalar (a) : octave_NaN; } - // Return a matrix of numbers from the sequence, filled in column - // major order. - static Matrix matrix (octave_idx_type r, octave_idx_type c, double a = 1.0) + // Return the next number from the sequence. + static float float_scalar (float a = 1.0) { - return instance_ok () ? instance->do_matrix (r, c, a) : Matrix (); + return instance_ok () ? instance->do_float_scalar (a) : octave_Float_NaN; } + // Return an array of numbers from the sequence. + static Array<double> vector (octave_idx_type n, double a = 1.0) + { + return instance_ok () ? instance->do_vector (n, a) : Array<double> (); + } + + // Return an array of numbers from the sequence. + static Array<float> float_vector (octave_idx_type n, float a = 1.0) + { + return instance_ok () ? instance->do_float_vector (n, a) : Array<float> (); + } + // Return an N-dimensional array of numbers from the sequence, // filled in column major order. static NDArray nd_array (const dim_vector& dims, double a = 1.0) @@ -150,10 +161,12 @@ return instance_ok () ? instance->do_nd_array (dims, a) : NDArray (); } - // Return an array of numbers from the sequence. - static Array<double> vector (octave_idx_type n, double a = 1.0) + + // Return an N-dimensional array of numbers from the sequence, + // filled in column major order. + static FloatNDArray float_nd_array (const dim_vector& dims, float a = 1.0) { - return instance_ok () ? instance->do_vector (n, a) : Array<double> (); + return instance_ok () ? instance->do_float_nd_array (dims, a) : FloatNDArray (); } private: @@ -220,16 +233,22 @@ // Return the next number from the sequence. double do_scalar (double a = 1.); - // Return a matrix of numbers from the sequence, filled in column - // major order. - Matrix do_matrix (octave_idx_type r, octave_idx_type c, double a = 1.); + // Return the next number from the sequence. + float do_float_scalar (float a = 1.); + + // Return an array of numbers from the sequence. + Array<double> do_vector (octave_idx_type n, double a = 1.); + + // Return an array of numbers from the sequence. + Array<float> do_float_vector (octave_idx_type n, float a = 1.); // Return an N-dimensional array of numbers from the sequence, // filled in column major order. NDArray do_nd_array (const dim_vector& dims, double a = 1.); - // Return an array of numbers from the sequence. - Array<double> do_vector (octave_idx_type n, double a = 1.); + // Return an N-dimensional array of numbers from the sequence, + // filled in column major order. + FloatNDArray do_float_nd_array (const dim_vector& dims, float a = 1.); // Some helper functions. @@ -248,6 +267,8 @@ void switch_to_generator (int dist); void fill (octave_idx_type len, double *v, double a); + + void fill (octave_idx_type len, float *v, float a); }; #endif
--- a/liboctave/randgamma.c Fri May 18 09:59:23 2012 +0200 +++ b/liboctave/randgamma.c Sat May 19 03:15:00 2012 -0400 @@ -141,3 +141,59 @@ oct_fill_randg(a,1,&ret); return ret; } + +#undef NAN +#undef RUNI +#undef RNOR +#undef REXP +#define NAN octave_Float_NaN +#define RUNI oct_float_randu() +#define RNOR oct_float_randn() +#define REXP oct_float_rande() + +void +oct_fill_float_randg (float a, octave_idx_type n, float *r) +{ + octave_idx_type i; + /* If a < 1, start by generating gamma(1+a) */ + const float d = (a < 1. ? 1.+a : a) - 1./3.; + const float c = 1./sqrt(9.*d); + + /* Handle invalid cases */ + if (a <= 0 || INFINITE(a)) + { + for (i=0; i < n; i++) + r[i] = NAN; + return; + } + + for (i=0; i < n; i++) + { + float x, xsq, v, u; + frestart: + x = RNOR; + v = (1+c*x); + v *= v*v; + if (v <= 0) + goto frestart; /* rare, so don't bother moving up */ + u = RUNI; + xsq = x*x; + if (u >= 1.-0.0331*xsq*xsq && log(u) >= 0.5*xsq + d*(1-v+log(v))) + goto frestart; + r[i] = d*v; + } + if (a < 1) + { /* Use gamma(a) = gamma(1+a)*U^(1/a) */ + /* Given REXP = -log(U) then U^(1/a) = exp(-REXP/a) */ + for (i = 0; i < n; i++) + r[i] *= exp(-REXP/a); + } +} + +float +oct_float_randg (float a) +{ + float ret; + oct_fill_float_randg(a,1,&ret); + return ret; +}
--- a/liboctave/randgamma.h Fri May 18 09:59:23 2012 +0200 +++ b/liboctave/randgamma.h Sat May 19 03:15:00 2012 -0400 @@ -32,6 +32,9 @@ extern OCTAVE_API double oct_randg (double a); extern OCTAVE_API void oct_fill_randg (double a, octave_idx_type n, double *p); +extern OCTAVE_API float oct_float_randg (float a); +extern OCTAVE_API void oct_fill_float_randg (float a, octave_idx_type n, float *p); + #ifdef __cplusplus } #endif
--- a/liboctave/randmtzig.c Fri May 18 09:59:23 2012 +0200 +++ b/liboctave/randmtzig.c Sat May 19 03:15:00 2012 -0400 @@ -64,10 +64,6 @@ http://www.math.keio.ac.jp/matumoto/emt.html email: matumoto@math.keio.ac.jp - * 2006-04-01 David Bateman - * * convert for use in octave, declaring static functions only used - * here and adding oct_ to functions visible externally - * * inverse sense of ALLBITS * 2004-01-19 Paul Kienzle * * comment out main * add init_by_entropy, get_state, set_state @@ -87,6 +83,15 @@ * * 2005-02-23 Paul Kienzle * * fix -DHAVE_X86_32 flag and add -DUSE_X86_32=0|1 for explicit control + * + * 2006-04-01 David Bateman + * * convert for use in octave, declaring static functions only used + * here and adding oct_ to functions visible externally + * * inverse sense of ALLBITS + * + * 2012-05-18 David Bateman + * * Remove randu64 and ALLBIT option + * * Add the single precision generators */ /* @@ -96,9 +101,6 @@ available. This is not necessary if your architecture has /dev/urandom defined. - Compile with -DALLBITS to disable 53-bit random numbers. This is about - 50% slower than using 32-bit random numbers. - Uses implicit -Di386 or explicit -DHAVE_X86_32 to determine if CPU=x86. You can force X86 behaviour with -DUSE_X86_32=1, or suppress it with -DUSE_X86_32=0. You should also consider -march=i686 or similar for @@ -126,21 +128,28 @@ static uint32_t randi32(void) returns 32-bit unsigned int static uint64_t randi53(void) returns 53-bit unsigned int static uint64_t randi54(void) returns 54-bit unsigned int - static uint64_t randi64(void) returns 64-bit unsigned int - static double randu32(void) returns 32-bit uniform in (0,1) + static float randu32(void) returns 32-bit uniform in (0,1) static double randu53(void) returns 53-bit uniform in (0,1) double oct_randu(void) returns M-bit uniform in (0,1) double oct_randn(void) returns M-bit standard normal double oct_rande(void) returns N-bit standard exponential + float oct_float_randu(void) returns M-bit uniform in (0,1) + float oct_float_randn(void) returns M-bit standard normal + float oct_float_rande(void) returns N-bit standard exponential + === Array generators === void oct_fill_randi32(octave_idx_type, uint32_t []) void oct_fill_randi64(octave_idx_type, uint64_t []) + void oct_fill_randu(octave_idx_type, double []) void oct_fill_randn(octave_idx_type, double []) void oct_fill_rande(octave_idx_type, double []) + void oct_fill_float_randu(octave_idx_type, float []) + void oct_fill_float_randn(octave_idx_type, float []) + void oct_fill_float_rande(octave_idx_type, float []) */ #if defined (HAVE_CONFIG_H) @@ -180,6 +189,7 @@ static int left = 1; static int initf = 0; static int initt = 1; +static int inittf = 1; /* initializes state[MT_N] with a seed */ void @@ -378,34 +388,14 @@ #endif } -#if 0 -// FIXME -- this doesn't seem to be used anywhere; should it be removed? -static uint64_t -randi64 (void) -{ - const uint32_t lo = randi32(); - const uint32_t hi = randi32(); -#if HAVE_X86_32 - uint64_t u; - uint32_t *p = (uint32_t *)&u; - p[0] = lo; - p[1] = hi; - return u; -#else - return (((uint64_t)hi<<32)|lo); -#endif -} -#endif - -#ifdef ALLBITS /* generates a random number on (0,1)-real-interval */ -static double +static float randu32 (void) { - return ((double)randi32() + 0.5) * (1.0/4294967296.0); + return ((float)randi32() + 0.5) * (1.0/4294967296.0); /* divided by 2^32 */ } -#else + /* generates a random number on (0,1) with 53-bit resolution */ static double randu53 (void) @@ -414,35 +404,22 @@ const uint32_t b=randi32()>>6; return (a*67108864.0+b+0.4) * (1.0/9007199254740992.0); } -#endif /* Determine mantissa for uniform doubles */ double oct_randu (void) { -#ifdef ALLBITS + return randu53 (); +} + +/* Determine mantissa for uniform floats */ +float +oct_float_randu (void) +{ return randu32 (); -#else - return randu53 (); -#endif } /* ===== Ziggurat normal and exponential generators ===== */ -#ifdef ALLBITS -# define ZIGINT uint32_t -# define EMANTISSA 4294967296.0 /* 32 bit mantissa */ -# define ERANDI randi32() /* 32 bits for mantissa */ -# define NMANTISSA 2147483648.0 /* 31 bit mantissa */ -# define NRANDI randi32() /* 31 bits for mantissa + 1 bit sign */ -# define RANDU randu32() -#else -# define ZIGINT uint64_t -# define EMANTISSA 9007199254740992.0 /* 53 bit mantissa */ -# define ERANDI randi53() /* 53 bits for mantissa */ -# define NMANTISSA EMANTISSA -# define NRANDI randi54() /* 53 bits for mantissa + 1 bit sign */ -# define RANDU randu53() -#endif #define ZIGGURAT_TABLE_SIZE 256 @@ -454,6 +431,13 @@ #define ZIGGURAT_EXP_INV_R 0.129918765548341586 #define EXP_SECTION_AREA 0.0039496598225815571993 +#define ZIGINT uint64_t +#define EMANTISSA 9007199254740992.0 /* 53 bit mantissa */ +#define ERANDI randi53() /* 53 bits for mantissa */ +#define NMANTISSA EMANTISSA +#define NRANDI randi54() /* 53 bits for mantissa + 1 bit sign */ +#define RANDU randu53() + static ZIGINT ki[ZIGGURAT_TABLE_SIZE]; static double wi[ZIGGURAT_TABLE_SIZE], fi[ZIGGURAT_TABLE_SIZE]; static ZIGINT ke[ZIGGURAT_TABLE_SIZE]; @@ -592,7 +576,6 @@ * Of course, different compilers and operating systems may * have something to do with this. */ -#if !defined(ALLBITS) # if HAVE_X86_32 /* 53-bit mantissa, 1-bit sign, x86 32-bit architecture */ double x; @@ -615,14 +598,6 @@ const double x = ( r&1 ? -rabs : rabs) * wi[idx]; # endif /* !HAVE_X86_32 */ if (rabs < (int64_t)ki[idx]) -#else /* ALLBITS */ - /* 32-bit mantissa */ - const uint32_t r = randi32(); - const uint32_t rabs = r&LMASK; - const int idx = (int)(r&0xFF); - const double x = ((int32_t)r) * wi[idx]; - if (rabs < ki[idx]) -#endif /* ALLBITS */ return x; /* 99.3% of the time we return here 1st try */ else if (idx == 0) { @@ -677,6 +652,173 @@ } } +#undef ZIGINT +#undef EMANTISSA +#undef ERANDI +#undef NMANTISSA +#undef NRANDI +#undef RANDU + +#define ZIGINT uint32_t +#define EMANTISSA 4294967296.0 /* 32 bit mantissa */ +#define ERANDI randi32() /* 32 bits for mantissa */ +#define NMANTISSA 2147483648.0 /* 31 bit mantissa */ +#define NRANDI randi32() /* 31 bits for mantissa + 1 bit sign */ +#define RANDU randu32() + +static ZIGINT fki[ZIGGURAT_TABLE_SIZE]; +static float fwi[ZIGGURAT_TABLE_SIZE], ffi[ZIGGURAT_TABLE_SIZE]; +static ZIGINT fke[ZIGGURAT_TABLE_SIZE]; +static float fwe[ZIGGURAT_TABLE_SIZE], ffe[ZIGGURAT_TABLE_SIZE]; + + +static void +create_ziggurat_float_tables (void) +{ + int i; + float x, x1; + + /* Ziggurat tables for the normal distribution */ + x1 = ZIGGURAT_NOR_R; + fwi[255] = x1 / NMANTISSA; + ffi[255] = exp (-0.5 * x1 * x1); + + /* Index zero is special for tail strip, where Marsaglia and Tsang + * defines this as + * k_0 = 2^31 * r * f(r) / v, w_0 = 0.5^31 * v / f(r), f_0 = 1, + * where v is the area of each strip of the ziggurat. + */ + fki[0] = (ZIGINT) (x1 * ffi[255] / NOR_SECTION_AREA * NMANTISSA); + fwi[0] = NOR_SECTION_AREA / ffi[255] / NMANTISSA; + ffi[0] = 1.; + + for (i = 254; i > 0; i--) + { + /* New x is given by x = f^{-1}(v/x_{i+1} + f(x_{i+1})), thus + * need inverse operator of y = exp(-0.5*x*x) -> x = sqrt(-2*ln(y)) + */ + x = sqrt(-2. * log(NOR_SECTION_AREA / x1 + ffi[i+1])); + fki[i+1] = (ZIGINT)(x / x1 * NMANTISSA); + fwi[i] = x / NMANTISSA; + ffi[i] = exp (-0.5 * x * x); + x1 = x; + } + + fki[1] = 0; + + /* Zigurrat tables for the exponential distribution */ + x1 = ZIGGURAT_EXP_R; + fwe[255] = x1 / EMANTISSA; + ffe[255] = exp (-x1); + + /* Index zero is special for tail strip, where Marsaglia and Tsang + * defines this as + * k_0 = 2^32 * r * f(r) / v, w_0 = 0.5^32 * v / f(r), f_0 = 1, + * where v is the area of each strip of the ziggurat. + */ + fke[0] = (ZIGINT) (x1 * ffe[255] / EXP_SECTION_AREA * EMANTISSA); + fwe[0] = EXP_SECTION_AREA / ffe[255] / EMANTISSA; + ffe[0] = 1.; + + for (i = 254; i > 0; i--) + { + /* New x is given by x = f^{-1}(v/x_{i+1} + f(x_{i+1})), thus + * need inverse operator of y = exp(-x) -> x = -ln(y) + */ + x = - log(EXP_SECTION_AREA / x1 + ffe[i+1]); + fke[i+1] = (ZIGINT)(x / x1 * EMANTISSA); + fwe[i] = x / EMANTISSA; + ffe[i] = exp (-x); + x1 = x; + } + fke[1] = 0; + + inittf = 0; +} + +/* + * Here is the guts of the algorithm. As Marsaglia and Tsang state the + * algorithm in their paper + * + * 1) Calculate a random signed integer j and let i be the index + * provided by the rightmost 8-bits of j + * 2) Set x = j * w_i. If j < k_i return x + * 3) If i = 0, then return x from the tail + * 4) If [f(x_{i-1}) - f(x_i)] * U < f(x) - f(x_i), return x + * 5) goto step 1 + * + * Where f is the functional form of the distribution, which for a normal + * distribution is exp(-0.5*x*x) + */ + +float +oct_float_randn (void) +{ + if (inittf) + create_ziggurat_float_tables(); + + while (1) + { + /* 32-bit mantissa */ + const uint32_t r = randi32(); + const uint32_t rabs = r&LMASK; + const int idx = (int)(r&0xFF); + const float x = ((int32_t)r) * fwi[idx]; + if (rabs < fki[idx]) + return x; /* 99.3% of the time we return here 1st try */ + else if (idx == 0) + { + /* As stated in Marsaglia and Tsang + * + * For the normal tail, the method of Marsaglia[5] provides: + * generate x = -ln(U_1)/r, y = -ln(U_2), until y+y > x*x, + * then return r+x. Except that r+x is always in the positive + * tail!!!! Any thing random might be used to determine the + * sign, but as we already have r we might as well use it + * + * [PAK] but not the bottom 8 bits, since they are all 0 here! + */ + float xx, yy; + do + { + xx = - ZIGGURAT_NOR_INV_R * log (RANDU); + yy = - log (RANDU); + } + while ( yy+yy <= xx*xx); + return (rabs&0x100 ? -ZIGGURAT_NOR_R-xx : ZIGGURAT_NOR_R+xx); + } + else if ((ffi[idx-1] - ffi[idx]) * RANDU + ffi[idx] < exp(-0.5*x*x)) + return x; + } +} + +float +oct_float_rande (void) +{ + if (inittf) + create_ziggurat_float_tables(); + + while (1) + { + ZIGINT ri = ERANDI; + const int idx = (int)(ri & 0xFF); + const float x = ri * fwe[idx]; + if (ri < fke[idx]) + return x; // 98.9% of the time we return here 1st try + else if (idx == 0) + { + /* As stated in Marsaglia and Tsang + * + * For the exponential tail, the method of Marsaglia[5] provides: + * x = r - ln(U); + */ + return ZIGGURAT_EXP_R - log(RANDU); + } + else if ((ffe[idx-1] - ffe[idx]) * RANDU + ffe[idx] < exp(-x)) + return x; + } +} + /* Array generators */ void oct_fill_randu (octave_idx_type n, double *p) @@ -701,3 +843,27 @@ for (i = 0; i < n; i++) p[i] = oct_rande(); } + +void +oct_fill_float_randu (octave_idx_type n, float *p) +{ + octave_idx_type i; + for (i = 0; i < n; i++) + p[i] = oct_float_randu(); +} + +void +oct_fill_float_randn (octave_idx_type n, float *p) +{ + octave_idx_type i; + for (i = 0; i < n; i++) + p[i] = oct_float_randn(); +} + +void +oct_fill_float_rande (octave_idx_type n, float *p) +{ + octave_idx_type i; + for (i = 0; i < n; i++) + p[i] = oct_float_rande(); +}
--- a/liboctave/randmtzig.h Fri May 18 09:59:23 2012 +0200 +++ b/liboctave/randmtzig.h Sat May 19 03:15:00 2012 -0400 @@ -82,11 +82,19 @@ extern OCTAVE_API double oct_randn (void); extern OCTAVE_API double oct_rande (void); +extern OCTAVE_API float oct_float_randu (void); +extern OCTAVE_API float oct_float_randn (void); +extern OCTAVE_API float oct_float_rande (void); + /* === Array generators === */ extern OCTAVE_API void oct_fill_randu (octave_idx_type n, double *p); extern OCTAVE_API void oct_fill_randn (octave_idx_type n, double *p); extern OCTAVE_API void oct_fill_rande (octave_idx_type n, double *p); +extern OCTAVE_API void oct_fill_float_randu (octave_idx_type n, float *p); +extern OCTAVE_API void oct_fill_float_randn (octave_idx_type n, float *p); +extern OCTAVE_API void oct_fill_float_rande (octave_idx_type n, float *p); + #ifdef __cplusplus } #endif
--- a/liboctave/randpoisson.c Fri May 18 09:59:23 2012 +0200 +++ b/liboctave/randpoisson.c Sat May 19 03:15:00 2012 -0400 @@ -368,6 +368,46 @@ } } +static void +poisson_cdf_lookup_float(double lambda, float *p, size_t n) +{ + double t[TABLESIZE]; + + /* Precompute the table for the u up to and including 0.458. + * We will almost certainly need it. */ + int intlambda = (int)floor(lambda); + double P; + int tableidx; + size_t i = n; + + t[0] = P = exp(-lambda); + for (tableidx = 1; tableidx <= intlambda; tableidx++) { + P = P*lambda/(double)tableidx; + t[tableidx] = t[tableidx-1] + P; + } + + while (i-- > 0) { + double u = RUNI; + int k = (u > 0.458 ? intlambda : 0); + nextk: + if ( u <= t[k] ) { + p[i] = (float) k; + continue; + } + if (++k < tableidx) goto nextk; + + while (tableidx < TABLESIZE) { + P = P*lambda/(double)tableidx; + t[tableidx] = t[tableidx-1] + P; + if (t[tableidx] == t[tableidx-1]) t[tableidx] = 1.0; + tableidx++; + if (u <= t[tableidx-1]) break; + } + + p[i] = (float)(tableidx-1); + } +} + /* From Press, et al., Numerical Recipes */ static void poisson_rejection (double lambda, double *p, size_t n) @@ -392,6 +432,30 @@ } } +/* From Press, et al., Numerical Recipes */ +static void +poisson_rejection_float (double lambda, float *p, size_t n) +{ + double sq = sqrt(2.0*lambda); + double alxm = log(lambda); + double g = lambda*alxm - LGAMMA(lambda+1.0); + size_t i; + + for (i = 0; i < n; i++) + { + double y, em, t; + do { + do { + y = tan(M_PI*RUNI); + em = sq * y + lambda; + } while (em < 0.0); + em = floor(em); + t = 0.9*(1.0+y*y)*exp(em*alxm-flogfak(em)-g); + } while (RUNI > t); + p[i] = em; + } +} + /* The cutoff of L <= 1e8 in the following two functions before using * the normal approximation is based on: * > L=1e8; x=floor(linspace(0,2*L,1000)); @@ -463,3 +527,68 @@ } return ret; } + +/* Generate a set of poisson numbers with the same distribution */ +void +oct_fill_float_randp (float FL, octave_idx_type n, float *p) +{ + double L = FL; + octave_idx_type i; + if (L < 0.0 || INFINITE(L)) + { + for (i=0; i<n; i++) + p[i] = NAN; + } + else if (L <= 10.0) + { + poisson_cdf_lookup_float(L, p, n); + } + else if (L <= 1e8) + { + for (i=0; i<n; i++) + p[i] = pprsc(L); + } + else + { + /* normal approximation: from Phys. Rev. D (1994) v50 p1284 */ + const double sqrtL = sqrt(L); + for (i = 0; i < n; i++) + { + p[i] = floor(RNOR*sqrtL + L + 0.5); + if (p[i] < 0.0) + p[i] = 0.0; /* will probably never happen */ + } + } +} + +/* Generate one poisson variate */ +float +oct_float_randp (float FL) +{ + double L = FL; + float ret; + if (L < 0.0) ret = NAN; + else if (L <= 12.0) { + /* From Press, et al. Numerical recipes */ + double g = exp(-L); + int em = -1; + double t = 1.0; + do { + ++em; + t *= RUNI; + } while (t > g); + ret = em; + } else if (L <= 1e8) { + /* numerical recipes */ + poisson_rejection_float(L, &ret, 1); + } else if (INFINITE(L)) { + /* FIXME R uses NaN, but the normal approx. suggests that as + * limit should be inf. Which is correct? */ + ret = NAN; + } else { + /* normal approximation: from Phys. Rev. D (1994) v50 p1284 */ + ret = floor(RNOR*sqrt(L) + L + 0.5); + if (ret < 0.0) ret = 0.0; /* will probably never happen */ + } + return ret; +}
--- a/liboctave/randpoisson.h Fri May 18 09:59:23 2012 +0200 +++ b/liboctave/randpoisson.h Sat May 19 03:15:00 2012 -0400 @@ -32,6 +32,9 @@ extern OCTAVE_API double oct_randp (double L); extern OCTAVE_API void oct_fill_randp (double L, octave_idx_type n, double *p); +extern OCTAVE_API float oct_float_randp (float L); +extern OCTAVE_API void oct_fill_float_randp (float L, octave_idx_type n, float *p); + #ifdef __cplusplus } #endif
--- a/m4/acinclude.m4 Fri May 18 09:59:23 2012 +0200 +++ b/m4/acinclude.m4 Sat May 19 03:15:00 2012 -0400 @@ -522,8 +522,12 @@ ;; *) LEX='$(top_srcdir)/build-aux/missing flex' - warn_flex="I didn't find flex, but it's only a problem if you need to reconstruct lex.cc" - AC_MSG_WARN([$warn_flex]) + warn_flex=" + +I didn't find flex, but it's only a problem if you need to reconstruct +lex.cc, which is the case if you're building from VCS sources. +" + OCTAVE_CONFIGURE_WARNING([warn_flex]) ;; esac AC_SUBST(LFLAGS) @@ -538,8 +542,14 @@ ;; *) YACC='$(top_srcdir)/build-aux/missing bison' - warn_bison="I didn't find bison, but it's only a problem if you need to reconstruct parse.cc" - AC_MSG_WARN([$warn_bison]) + warn_bison=" + +I didn't find bison, but it's only a problem if you need to +reconstruct parse.cc, which is the case if you're building from VCS +sources. + +" + OCTAVE_CONFIGURE_WARNING([warn_bison]) ;; esac ]) @@ -562,7 +572,7 @@ AC_CHECK_PROGS(DEFAULT_PAGER, $octave_possible_pagers, []) if test -z "$DEFAULT_PAGER"; then warn_less="I couldn't find \`less', \`more', \`page', or \`pg'" - AC_MSG_WARN([$warn_less]) + OCTAVE_CONFIGURE_WARNING([warn_less]) fi fi ]) @@ -581,10 +591,14 @@ warn_gnuplot=yes GNUPLOT="$gp_default" + warn_gnuplot = " - AC_MSG_WARN([gnuplot not found. It isn't necessary to have gnuplot]) - AC_MSG_WARN([installed, but without native graphics or gnuplot]) - AC_MSG_WARN([you won't be able to use any of Octave's plotting commands.]) +gnuplot not found. It isn't necessary to have gnuplot installed, but +without native graphics or gnuplot you won't be able to use any of +Octave's plotting commands. + +" + OCTAVE_CONFIGURE_WARNING([warn_gnuplot]) fi fi AC_SUBST(GNUPLOT) @@ -597,8 +611,12 @@ AC_CHECK_PROG(GPERF, gperf, gperf, []) if test -z "$GPERF"; then GPERF='$(top_srcdir)/build-aux/missing gperf' - warn_gperf="I didn't find gperf, but it's only a problem if you need to reconstruct oct-gperf.h" - AC_MSG_WARN([$warn_gperf]) + warn_gperf=" + +I didn't find gperf, but it's only a problem if you need to +reconstruct oct-gperf.h +" + OCTAVE_CONFIGURE_WARNING([warn_gperf]) fi AC_SUBST(GPERF) ]) @@ -618,8 +636,14 @@ AC_CHECK_PROGS(GHOSTSCRIPT, [$gs_names]) if test -z "$GHOSTSCRIPT"; then GHOSTSCRIPT='$(top_srcdir)/build-aux/missing gs' - warn_ghostscript="I didn't find ghostscript, so reconstructing figures for the manual will fail, and saving graphics in some output formats will fail when using Octave" - AC_MSG_WARN([$warn_ghostscript]) + warn_ghostscript=" + +I didn't find ghostscript, so reconstructing figures for the manual +will fail, and saving graphics in some output formats will fail when +using Octave +" + + OCTAVE_CONFIGURE_WARNING([warn_ghostscript]) fi AC_SUBST(GHOSTSCRIPT) ]) @@ -631,8 +655,12 @@ AC_CHECK_PROG(TEXI2DVI, texi2dvi, texi2dvi, []) if test -z "$TEXI2DVI"; then TEXI2DVI='$(top_srcdir)/build-aux/missing texi2dvi' - warn_texi2dvi="I didn't find texi2dvi, but it's only a problem if you need to reconstruct the DVI version of the manual" - AC_MSG_WARN([$warn_texi2dvi]) + warn_texi2dvi=" + +I didn't find texi2dvi, but it's only a problem if you need to +reconstruct the DVI version of the manual +" + OCTAVE_CONFIGURE_WARNING([warn_texi2dvi]) fi AC_SUBST(TEXI2DVI) ]) @@ -654,8 +682,12 @@ fi if $missing; then TEXI2PDF='$(top_srcdir)/build-aux/missing texi2pdf' - warn_texi2pdf="I didn't find texi2pdf, but it's only a problem if you need to reconstruct the PDF version of the manual" - AC_MSG_WARN([$warn_texi2pdf]) + warn_texi2pdf=" + +I didn't find texi2pdf, but it's only a problem if you need to +reconstruct the PDF version of the manual +" + OCTAVE_CONFIGURE_WARNING([warn_texi2pdf]) fi AC_SUBST(TEXI2PDF) ]) @@ -1501,31 +1533,33 @@ else AC_MSG_RESULT([no]) if test "$FT2_CONFIG" = "no" ; then - AC_MSG_WARN([ + warn_ft2_config = " - The freetype-config script installed by FreeType 2 could not be found. - If FreeType 2 was installed in PREFIX, make sure PREFIX/bin is in - your path, or set the FT2_CONFIG environment variable to the - full path to freetype-config. - ]) +The freetype-config script installed by FreeType 2 could not be found. +If FreeType 2 was installed in PREFIX, make sure PREFIX/bin is in your +path, or set the FT2_CONFIG environment variable to the full path to +freetype-config. +" + OCTAVE_CONFIGURE_WARNING([warn_ft2_config]) else if test x$ft_config_is_lt = xyes ; then - AC_MSG_WARN([ + warn_ft2_too_old=" - Your installed version of the FreeType 2 library is too old. - If you have different versions of FreeType 2, make sure that - correct values for --with-ft-prefix or --with-ft-exec-prefix - are used, or set the FT2_CONFIG environment variable to the - full path to freetype-config. - ]) +Your installed version of the FreeType 2 library is too old. If you +have different versions of FreeType 2, make sure that correct values +for --with-ft-prefix or --with-ft-exec-prefix are used, or set the +FT2_CONFIG environment variable to the full path to freetype-config. +" + OCTAVE_CONFIGURE_WARNING([warn_ft2_too_old]) else - AC_MSG_WARN([ + warn_ft2_failed=" - The FreeType test program failed to run. If your system uses - shared libraries and they are installed outside the normal - system library path, make sure the variable LD_LIBRARY_PATH - (or whatever is appropiate for your system) is correctly set. - ]) +The FreeType test program failed to run. If your system uses shared +libraries and they are installed outside the normal system library +path, make sure the variable LD_LIBRARY_PATH (or whatever is +appropiate for your system) is correctly set. +" + OCTAVE_CONFIGURE_WARNING([warn_ft2_failed]) fi fi
--- a/scripts/polynomial/module.mk Fri May 18 09:59:23 2012 +0200 +++ b/scripts/polynomial/module.mk Sat May 19 03:15:00 2012 -0400 @@ -1,7 +1,7 @@ FCN_FILE_DIRS += polynomial polynomial_PRIVATE_FCN_FILES = \ - polynomial/private/__splinefit__.m + polynomial/private/__splinefit__.m polynomial_FCN_FILES = \ polynomial/compan.m \ @@ -28,7 +28,8 @@ polynomial/roots.m \ polynomial/spline.m \ polynomial/splinefit.m \ - polynomial/unmkpp.m + polynomial/unmkpp.m \ + $(polynomial_PRIVATE_FCN_FILES) FCN_FILES += $(polynomial_FCN_FILES)
--- a/src/DLD-FUNCTIONS/rand.cc Fri May 18 09:59:23 2012 +0200 +++ b/src/DLD-FUNCTIONS/rand.cc Sat May 19 03:15:00 2012 -0400 @@ -1,3 +1,4 @@ + /* Copyright (C) 1996-2012 John W. Eaton @@ -60,6 +61,7 @@ NDArray a; int idx = 0; dim_vector dims; + bool is_single = false; unwind_protect frame; // Restore current distribution on any exit. @@ -68,6 +70,19 @@ octave_rand::distribution (distribution); + if (nargin > 0 && args(nargin-1).is_string()) + { + std::string s_arg = args(nargin-1).string_value (); + + if (s_arg == "single") + { + is_single = true; + nargin--; + } + else if (s_arg == "double") + nargin--; + } + if (additional_arg) { if (nargin == 0) @@ -298,27 +313,54 @@ dims.chop_trailing_singletons (); - if (additional_arg) + if (is_single) { - if (a.length() == 1) - return octave_rand::nd_array (dims, a(0)); - else + if (additional_arg) { - if (a.dims() != dims) + if (a.length() == 1) + return octave_rand::float_nd_array (dims, a(0)); + else { - error ("%s: mismatch in argument size", fcn); - return retval; + if (a.dims() != dims) + { + error ("%s: mismatch in argument size", fcn); + return retval; + } + octave_idx_type len = a.length (); + FloatNDArray m (dims); + float *v = m.fortran_vec (); + for (octave_idx_type i = 0; i < len; i++) + v[i] = octave_rand::float_scalar (a(i)); + return m; } - octave_idx_type len = a.length (); - NDArray m (dims); - double *v = m.fortran_vec (); - for (octave_idx_type i = 0; i < len; i++) - v[i] = octave_rand::scalar (a(i)); - return m; } + else + return octave_rand::float_nd_array (dims); } else - return octave_rand::nd_array (dims); + { + if (additional_arg) + { + if (a.length() == 1) + return octave_rand::nd_array (dims, a(0)); + else + { + if (a.dims() != dims) + { + error ("%s: mismatch in argument size", fcn); + return retval; + } + octave_idx_type len = a.length (); + NDArray m (dims); + double *v = m.fortran_vec (); + for (octave_idx_type i = 0; i < len; i++) + v[i] = octave_rand::scalar (a(i)); + return m; + } + } + else + return octave_rand::nd_array (dims); + } } DEFUN_DLD (rand, args, , @@ -332,6 +374,8 @@ @deftypefnx {Loadable Function} {@var{v} =} rand (\"seed\")\n\ @deftypefnx {Loadable Function} {} rand (\"seed\", @var{v})\n\ @deftypefnx {Loadable Function} {} rand (\"seed\", \"reset\")\n\ +@deftypefnx {Loadable Function} {} rand (@dots{}, \"single\")\n\ +@deftypefnx {Loadable Function} {} rand (@dots{}, \"double\")\n\ Return a matrix with random elements uniformly distributed on the\n\ interval (0, 1). The arguments are handled the same as the arguments\n\ for @code{eye}.\n\ @@ -402,6 +446,9 @@ \n\ The state or seed of the generator can be reset to a new random value\n\ using the \"reset\" keyword.\n\ +\n\ +The class of the value returned can be controlled by a trailing \"double\"\n\ +or \"single\" argument. These are the only valid classes.\n\ @seealso{randn, rande, randg, randp}\n\ @end deftypefn") { @@ -499,6 +546,8 @@ @deftypefnx {Loadable Function} {@var{v} =} randn (\"seed\")\n\ @deftypefnx {Loadable Function} {} randn (\"seed\", @var{v})\n\ @deftypefnx {Loadable Function} {} randn (\"seed\", \"reset\")\n\ +@deftypefnx {Loadable Function} {} randn (@dots{}, \"single\")\n\ +@deftypefnx {Loadable Function} {} randn (@dots{}, \"double\")\n\ Return a matrix with normally distributed random\n\ elements having zero mean and variance one. The arguments are\n\ handled the same as the arguments for @code{rand}.\n\ @@ -506,6 +555,9 @@ By default, @code{randn} uses the Marsaglia and Tsang ``Ziggurat technique''\n\ to transform from a uniform to a normal distribution.\n\ \n\ +The class of the value returned can be controlled by a trailing \"double\"\n\ +or \"single\" argument. These are the only valid classes.\n\ +\n\ Reference: G. Marsaglia and W.W. Tsang,\n\ @cite{Ziggurat Method for Generating Random Variables},\n\ J. Statistical Software, vol 5, 2000,\n\ @@ -565,12 +617,17 @@ @deftypefnx {Loadable Function} {@var{v} =} rande (\"seed\")\n\ @deftypefnx {Loadable Function} {} rande (\"seed\", @var{v})\n\ @deftypefnx {Loadable Function} {} rande (\"seed\", \"reset\")\n\ +@deftypefnx {Loadable Function} {} rande (@dots{}, \"single\")\n\ +@deftypefnx {Loadable Function} {} rande (@dots{}, \"double\")\n\ Return a matrix with exponentially distributed random elements. The\n\ arguments are handled the same as the arguments for @code{rand}.\n\ \n\ By default, @code{randn} uses the Marsaglia and Tsang ``Ziggurat technique''\n\ to transform from a uniform to an exponential distribution.\n\ \n\ +The class of the value returned can be controlled by a trailing \"double\"\n\ +or \"single\" argument. These are the only valid classes.\n\ +\n\ Reference: G. Marsaglia and W.W. Tsang,\n\ @cite{Ziggurat Method for Generating Random Variables},\n\ J. Statistical Software, vol 5, 2000,\n\ @@ -632,6 +689,8 @@ @deftypefnx {Loadable Function} {@var{v} =} randg (\"seed\")\n\ @deftypefnx {Loadable Function} {} randg (\"seed\", @var{v})\n\ @deftypefnx {Loadable Function} {} randg (\"seed\", \"reset\")\n\ +@deftypefnx {Loadable Function} {} randg (@dots{}, \"single\")\n\ +@deftypefnx {Loadable Function} {} randg (@dots{}, \"double\")\n\ Return a matrix with @code{gamma(@var{a},1)} distributed random elements.\n\ The arguments are handled the same as the arguments for @code{rand},\n\ except for the argument @var{a}.\n\ @@ -711,6 +770,9 @@ @end example\n\ \n\ @end table\n\ +\n\ +The class of the value returned can be controlled by a trailing \"double\"\n\ +or \"single\" argument. These are the only valid classes.\n\ @seealso{rand, randn, rande, randp}\n\ @end deftypefn") { @@ -898,6 +960,8 @@ @deftypefnx {Loadable Function} {@var{v} =} randp (\"seed\")\n\ @deftypefnx {Loadable Function} {} randp (\"seed\", @var{v})\n\ @deftypefnx {Loadable Function} {} randp (\"seed\", \"reset\")\n\ +@deftypefnx {Loadable Function} {} randp (@dots{}, \"single\")\n\ +@deftypefnx {Loadable Function} {} randp (@dots{}, \"double\")\n\ Return a matrix with Poisson distributed random elements with mean value\n\ parameter given by the first argument, @var{l}. The arguments\n\ are handled the same as the arguments for @code{rand}, except for the\n\ @@ -928,6 +992,9 @@ L. Montanet, et al., @cite{Review of Particle Properties}, Physical Review\n\ D 50 p1284, 1994.\n\ @end table\n\ +\n\ +The class of the value returned can be controlled by a trailing \"double\"\n\ +or \"single\" argument. These are the only valid classes.\n\ @seealso{rand, randn, rande, randg}\n\ @end deftypefn") {
--- a/src/Makefile.am Fri May 18 09:59:23 2012 +0200 +++ b/src/Makefile.am Sat May 19 03:15:00 2012 -0400 @@ -100,6 +100,7 @@ defaults.in.h \ DOCSTRINGS \ find-defun-files.sh \ + gendoc.pl \ genprops.awk \ gl2ps.c \ graphics.in.h \ @@ -107,7 +108,6 @@ mk-pkg-add \ mkbuiltins \ mkdefs \ - mkgendoc \ mkoctfile.in.cc \ mkoctfile.in.sh \ mkops \ @@ -662,27 +662,16 @@ AM_CXXFLAGS := $(filter-out $(DLL_CXXDEFS), $(AM_CXXFLAGS) $(GRAPHICS_CFLAGS)) if AMCOND_BUILD_DOCS -.DOCSTRINGS: gendoc$(BUILD_EXEEXT) +.DOCSTRINGS: $(ALL_DEF_FILES) gendoc.pl if [ "x$(srcdir)" != "x." ] && [ -f $(srcdir)/DOCSTRINGS ] && [ ! -f DOCSTRINGS ]; then \ cp $(srcdir)/DOCSTRINGS DOCSTRINGS; \ touch -r $(srcdir)/DOCSTRINGS DOCSTRINGS; \ fi @echo "creating .DOCSTRINGS from .cc source files" - @./gendoc > $@ + @$(PERL) $(srcdir)/gendoc.pl $(ALL_DEF_FILES) > $@ $(top_srcdir)/build-aux/move-if-change $@ DOCSTRINGS touch $@ -doc-files: $(ALL_DEF_FILES) - echo $(ALL_DEF_FILES) > $@-t - mv $@-t $@ - -gendoc.cc: doc-files mkgendoc - $(srcdir)/mkgendoc doc-files > $@-t - mv $@-t $@ - -gendoc$(BUILD_EXEEXT): gendoc.cc - $(BUILD_CXX) $(BUILD_CXXFLAGS) -o $@ $^ $(BUILD_LDFLAGS) - all-local: $(OCT_STAMP_FILES) $(DLD_FUNCTIONS_PKG_ADD_FILE) .DOCSTRINGS else all-local: $(OCT_STAMP_FILES) $(DLD_FUNCTIONS_PKG_ADD_FILE) @@ -769,9 +758,6 @@ CLEANFILES = \ $(bin_SCRIPTS) \ $(DLD_FUNCTIONS_PKG_ADD_FILE) \ - doc-files \ - gendoc.cc \ - gendoc$(BUILD_EXEEXT) \ graphics-props.cc \ oct-parse.output
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/gendoc.pl Sat May 19 03:15:00 2012 -0400 @@ -0,0 +1,73 @@ +#! /usr/bin/perl -w +# +# Copyright (C) 2012 Rik Wehbring +# +# This file is part of Octave. +# +# Octave is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation; either version 3 of the License, or (at +# your option) any later version. +# +# Octave is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# +# You should have received a copy of the GNU General Public License +# along with Octave; see the file COPYING. If not, see +# <http://www.gnu.org/licenses/>. + +unless (@ARGV > 1) { die "Usage: $0 df-file1 ..." } + +print <<__END_OF_MSG__; +### DO NOT EDIT! +### +### This file is generated automatically from Octave source files. +### Edit source files directly and run make to update this file. + +__END_OF_MSG__ + +DFFILE: foreach $df_fname (@ARGV) +{ + open (DF_FH, $df_fname) or die "Unable to open $df_fname"; + + $src_fname = ""; + @func_list = (); + @docstr = (); + + LINE: while (<DF_FH>) + { + if (/XDEFUN_FILE_NAME \("([^"]+)"/) + { + $src_fname = $1; + next LINE; + } + if (/XDEF/ and ! /XDEFALIAS/) + { + ## Decode 4 or 5 part macro definition. + ($func, $str) = /\("?(\w+)"?,[^,]+,[^,]+,(?:[^,]+,)?\s*"(.*)"\)\s*$/ ; + + unless ($func) { die "Unable to parse $df_fname at line $.\n" } + + push (@func_list, $func); + ## Do escape sequence expansion + $str =~ s/(?<!\\)\\n/\n/g; + $str =~ s/\\([^\\])/$1/g; + $str =~ s/\\\\/\\/g; + push (@docstr, $str); + } + } + close (DF_FH); + + ## Print results in DOCSTRING format + foreach $i (0 .. $#func_list) + { + $func = $func_list[$i]; + print " $func\n"; + print "\@c $func $src_fname\n"; + print $docstr[$i],"\n"; + } + +} +
--- a/src/mkgendoc Fri May 18 09:59:23 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,124 +0,0 @@ -#! /bin/sh -# -# Copyright (C) 1999-2012 John W. Eaton -# -# This file is part of Octave. -# -# Octave is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3 of the License, or (at -# your option) any later version. -# -# Octave is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License -# along with Octave; see the file COPYING. If not, see -# <http://www.gnu.org/licenses/>. - -SED=${SED:-'sed'} - -if test $# -ne 1; then - echo "usage: mkgendoc f1" 1>&2 - exit 1 -fi - -DOC_FILES=`cat $1` - -if test -z "$DOC_FILES"; then - echo "mkgendoc: DOC_FILES is empty!" 1>&2 - exit 1 -fi - -cat << \EOF -// DO NOT EDIT! Generated automatically by mkgendoc - -#if defined (__DECCXX) -#define __USE_STD_IOSTREAM -#endif - -#include <iostream> -#include <string> - -#define XDEFUN_FILE_NAME(name) \ - std::string file_name = name; - -#define XDEFUN_DLD_INTERNAL(name, args_name, nargout_name, doc) \ - print_doc_string (#name, file_name, doc); - -#define XDEFUNX_DLD_INTERNAL(name, fname, args_name, nargout_name, doc) \ - print_doc_string (name, file_name, doc); - -#define XDEFUN_INTERNAL(name, args_name, nargout_name, doc) \ - print_doc_string (#name, file_name, doc); - -#define XDEFCONSTFUN_INTERNAL(name, args_name, nargout_name, doc) \ - print_doc_string (#name, file_name, doc); - -#define XDEFUNX_INTERNAL(name, fname, args_name, nargout_name, doc) \ - print_doc_string (name, file_name, doc); - -#define XDEFALIAS_INTERNAL(alias, name) - -#define XDEFVAR_INTERNAL(name, sname, defn, protect, chg_fcn, doc) \ - print_doc_string (#name, file_name, doc); - -#define XDEFCONST_INTERNAL(name, defn, doc) \ - print_doc_string (#name, file_name, doc); - -static void -print_doc_string (const std::string& name, const std::string& file_name, - const std::string& doc) -{ - std::cout << " "; - - size_t len = name.length (); - - if (name[0] == '"' && name[len-1] == '"') - std::cout << name.substr (1, len-2) << "\n"; - else - std::cout << name << "\n"; - - std::cout << "@c " << name << " " << file_name << "\n" << doc << "\n"; -} - -EOF - -for file in $DOC_FILES; do - fcn=`echo $file | $SED 's,.*/,,; s/\.df//; s/-/_/g;'` - echo "static void" - echo "print_${fcn}_doc_strings (void)" - echo "{" - cat $file - echo "}" - echo "" -done - -cat << \EOF - -int -main (void) -{ - std::cout - << "### DO NOT EDIT!\n" - << "###\n" - << "### This file is generated automatically from the Octave sources.\n" - << "### Edit those files instead and run make to update this file.\n" - << std::endl; - -EOF - -for file in $DOC_FILES; do - fcn=`echo $file | $SED 's,.*/,,; s/\.df//; s/-/_/g;'` - echo " print_${fcn}_doc_strings ();" -done - -cat << \EOF - - return 0; -} -EOF - -exit 0