Mercurial > hg > octave-lojdl
changeset 14137:a74954d70c18
Merge in Iain Murray's changes
| author | Jordi Gutiérrez Hermoso <jordigh@octave.org> |
|---|---|
| date | Mon, 02 Jan 2012 13:12:54 -0500 |
| parents | 20cb178716ee (current diff) 42581c3b5cb4 (diff) |
| children | 8758dfa21cac |
| files | CHECKLIST ChangeLog ChangeLog.1 HACKING NEWS.1 NEWS.2 NEWS.3 PROJECTS README.Cygwin README.Linux README.MacOS README.MinGW README.Windows README.devel README.ftp README.gnuplot README.kpathsea README.mirrors README.snapshots acinclude.m4 bootstrap bootstrap.conf common.mk config.guess config.sub diff-template doc/ChangeLog doc/interpreter/dir doc/interpreter/eos.txi gdbinit libcruft/ChangeLog libcruft/arpack/src/dnaupe.f libcruft/arpack/src/snaupe.f liboctave/ChangeLog liboctave/regex-match.cc liboctave/regex-match.h missing mk-opts.pl mkinstalldirs mkoctfile.cc.in mkoctfile.in move-if-change octave-config.cc.in octave-config.in octave-sh scripts/ChangeLog scripts/elfun/lcm.m scripts/general/arrayfun.m scripts/general/perror.m scripts/general/runlength.m scripts/general/strerror.m scripts/geometry/trimesh.m scripts/geometry/triplot.m scripts/geometry/trisurf.m scripts/help/__strip_html_tags__.m scripts/miscellaneous/unimplemented.m scripts/pkg/get_forge_pkg.m scripts/plot/__fltk_ginput__.m scripts/plot/__fltk_print__.m scripts/plot/__gnuplot_get_var__.m scripts/plot/__gnuplot_ginput__.m scripts/plot/__gnuplot_has_feature__.m scripts/plot/__gnuplot_open_stream__.m scripts/plot/__gnuplot_print__.m scripts/plot/__gnuplot_version__.m scripts/plot/__go_close_all__.m scripts/plot/__go_draw_axes__.m scripts/plot/__go_draw_figure__.m scripts/plot/__marching_cube__.m scripts/plot/__next_line_color__.m scripts/plot/__next_line_style__.m scripts/plot/__print_parse_opts__.m scripts/polynomial/polyderiv.m scripts/signal/rectangle_lw.m scripts/signal/rectangle_sw.m scripts/signal/triangle_lw.m scripts/signal/triangle_sw.m scripts/special-matrix/sylvester_matrix.m scripts/statistics/base/cor.m scripts/statistics/base/corrcoef.m scripts/statistics/base/cut.m scripts/statistics/base/studentize.m scripts/statistics/models/logistic_regression_derivatives.m scripts/statistics/models/logistic_regression_likelihood.m src/ChangeLog src/DLD-FUNCTIONS/onCleanup.cc src/base-list.h src/ov-usr-fcn.cc test/@Blork/Blork.m test/@Blork/bleek.m test/@Blork/display.m test/@Blork/get.m test/@Blork/module.mk test/@Blork/set.m test/@Cork/Cork.m test/@Cork/click.m test/@Cork/display.m test/@Cork/get.m test/@Cork/module.mk test/@Cork/set.m test/@Dork/Dork.m test/@Dork/bling.m test/@Dork/display.m test/@Dork/gack.m test/@Dork/get.m test/@Dork/getStash.m test/@Dork/module.mk test/@Dork/private/myStash.m test/@Dork/set.m test/@Gork/Gork.m test/@Gork/cork.m test/@Gork/display.m test/@Gork/gark.m test/@Gork/get.m test/@Gork/module.mk test/@Gork/set.m test/@Gork/subsasgn.m test/@Gork/subsref.m test/@Pork/Pork.m test/@Pork/bling.m test/@Pork/display.m test/@Pork/get.m test/@Pork/gurk.m test/@Pork/module.mk test/@Pork/private/myStash.m test/@Pork/set.m test/@Sneetch/Sneetch.m test/@Sneetch/display.m test/@Sneetch/module.mk test/@Snork/Snork.m test/@Snork/cack.m test/@Snork/display.m test/@Snork/end.m test/@Snork/get.m test/@Snork/getStash.m test/@Snork/gick.m test/@Snork/loadobj.m test/@Snork/module.mk test/@Snork/private/myStash.m test/@Snork/saveobj.m test/@Snork/set.m test/@Snork/subsasgn.m test/@Snork/subsindex.m test/@Snork/subsref.m test/@Spork/Spork.m test/@Spork/cack.m test/@Spork/display.m test/@Spork/geek.m test/@Spork/get.m test/@Spork/getStash.m test/@Spork/loadobj.m test/@Spork/module.mk test/@Spork/private/myStash.m test/@Spork/saveobj.m test/@Spork/set.m test/ChangeLog test/test_classes.m test/test_index-wfi-f.m test/test_index-wfi-t.m test/test_logical-wfi-f.m test/test_logical-wfi-t.m test/test_string.m |
| diffstat | 1247 files changed, 44413 insertions(+), 23999 deletions(-) [+] |
line wrap: on
line diff
--- a/.dir-locals.el +++ b/.dir-locals.el @@ -1,5 +1,10 @@ -((nil . ((indent-tabs-mode . nil) - (fill-column . 72))) - (c-default-mode "gnu") +((nil . + ((c-file-style . "gnu") + (indent-tabs-mode . nil) + (fill-column . 72) + (eval . (when (string-match "\\.h\\'" (buffer-file-name)) + (unless (string-match "/gnulib/" (buffer-file-name)) + (c++-mode) + (c-set-style "gnu")))))) (change-log-mode . ((indent-tabs-mode . t))) (makefile-mode . ((indent-tabs-mode . t))))
new file mode 100644 --- /dev/null +++ b/.hgsub @@ -0,0 +1,1 @@ +gnulib = [git]git://git.sv.gnu.org/gnulib
new file mode 100644 --- /dev/null +++ b/.hgsubstate @@ -0,0 +1,1 @@ +bb052d4a7416accaad0747e84bd2a0accbfcf923 gnulib
--- a/.hgtags +++ b/.hgtags @@ -50,3 +50,8 @@ 3cbc0d77db48aec32bcb202d09a036d2cb9cc3b9 ss-3-3-53 bd2643f0ce57d070963bedd48857405f6924aa85 ss-3-3-54 695141f1c05cf1b240592bdd18e7a1503bb2a539 ss-3-3-55 +901d466ee55ac902a875ec0ade6f1eccef0841dc release-3-4-1 +3666e8e6f96e6899b8306d6ea9614aadf0500d67 release-3-4-2 +b0e70a71647b671ebcfa7a79af1ae6d3c0f52065 release-3-4-3 +3781981be535e80d44c85373b8fdaa60ca5cd097 ss-3-5-90 +ff5588774680d4f54567311fc109c8e351950f1c ss-3-5-91
--- a/Makefile.am +++ b/Makefile.am @@ -18,7 +18,7 @@ # along with Octave; see the file COPYING. If not, see # <http://www.gnu.org/licenses/>. -include common.mk +include build-aux/common.mk ## Avoid making multiple subdirs in parallel which can lead ## to a confusing error message stream @@ -26,40 +26,43 @@ ACLOCAL_AMFLAGS = -I m4 -BUILT_DISTFILES = AUTHORS BUGS INSTALL.OCTAVE +BUILT_DISTFILES = AUTHORS BUGS ChangeLog INSTALL.OCTAVE EXTRA_DIST = \ AUTHORS \ BUGS \ COPYING \ ChangeLog \ - ChangeLog.1 \ INSTALL \ INSTALL.OCTAVE \ NEWS \ - NEWS.1 \ - NEWS.2 \ - NEWS.3 \ - PROJECTS \ README \ - README.Cygwin \ - README.Linux \ - README.MacOS \ - README.Windows \ - README.kpathsea \ autogen.sh \ - bootstrap \ - bootstrap.conf \ - gdbinit \ - missing \ - mk-opts.pl \ - mkinstalldirs \ - mkoctfile.cc.in \ - mkoctfile.in \ - move-if-change \ - octave-config.cc.in \ - octave-config.in \ - octave-sh \ + build-aux/bootstrap \ + build-aux/bootstrap.conf \ + build-aux/mk-opts.pl \ + build-aux/mkinstalldirs \ + build-aux/move-if-change \ + etc/NEWS.1 \ + etc/NEWS.2 \ + etc/NEWS.3 \ + etc/OLD-ChangeLogs/ChangeLog \ + etc/OLD-ChangeLogs/ChangeLog.1 \ + etc/OLD-ChangeLogs/doc-ChangeLog \ + etc/OLD-ChangeLogs/libcruft-ChangeLog \ + etc/OLD-ChangeLogs/liboctave-ChangeLog \ + etc/OLD-ChangeLogs/scripts-ChangeLog \ + etc/OLD-ChangeLogs/src-ChangeLog \ + etc/OLD-ChangeLogs/test-ChangeLog \ + etc/PROJECTS \ + etc/README.Cygwin \ + etc/README.Linux \ + etc/README.MacOS \ + etc/README.MinGW \ + etc/README.Windows \ + etc/README.gnuplot \ + etc/README.kpathsea \ + etc/gdbinit \ run-octave.in include m4/module.mk @@ -73,30 +76,7 @@ echo "Documentation disabled. Cannot package distribution!" ; exit 1; endif -if AMCOND_BUILD_COMPILED_AUX_PROGRAMS -bin_PROGRAMS = \ - mkoctfile \ - octave-config - -mkoctfile_SOURCES = -nodist_mkoctfile_SOURCES = mkoctfile.cc - -octave_config_SOURCES = -nodist_octave_config_SOURCES = octave-config.cc - -BUILT_SOURCES = \ - mkoctfile.cc \ - octave-config.cc \ - run-octave - -else -bin_SCRIPTS = \ - mkoctfile \ - octave-config - -BUILT_SOURCES = \ - run-octave -endif +BUILT_SOURCES = run-octave noinst_SCRIPTS = run-octave @@ -105,15 +85,17 @@ BUGS \ INSTALL.OCTAVE -CLEANFILES = $(bin_PROGRAMS) $(bin_SCRIPTS) $(BUILT_SOURCES) +CLEANFILES = $(BUILT_SOURCES) -DISTCLEANFILES = $(INFO_FILES) .gdbinit +DISTCLEANFILES = .gdbinit + +MAINTAINERCLEANFILES = $(BUILT_DISTFILES) CONFIG_FILES = @ac_config_headers@ @ac_config_files@ nodist_octinclude_HEADERS = config.h -all-local: $(bin_PROGRAMS) $(bin_SCRIPTS) $(noinst_SCRIPTS) $(INFO_FILES) .gdbinit +all-local: $(noinst_SCRIPTS) $(INFO_FILES) .gdbinit @echo "" @echo "Octave successfully built. Now choose from the following:" @echo "" @@ -125,30 +107,15 @@ check: all $(MAKE) -C test check -if AMCOND_BUILD_COMPILED_AUX_PROGRAMS -octave-config.cc: octave-config.cc.in Makefile - @$(do_subst_default_vals) - -mkoctfile.cc: mkoctfile.cc.in Makefile - @$(do_subst_config_vals) -else -octave-config: octave-config.in Makefile - @$(do_subst_default_vals) - chmod a+rx $@ - -mkoctfile: mkoctfile.in Makefile - @$(do_subst_config_vals) - chmod a+rx $@ -endif - run-octave: run-octave.in Makefile @$(do_subst_script_vals) chmod a+rx "$@" -.gdbinit: gdbinit - if [ -f .gdbinit ]; then \ +.gdbinit: etc/gdbinit + @if [ -f .gdbinit ]; then \ echo "refusing to overwrite .gdbinit with newer version from $<" 1>&2; \ else \ + echo "Installing .gdbinit from version at $<" ; \ cp $< $@; \ fi @@ -156,6 +123,11 @@ $(MAKE) -C doc/interpreter ../../$@ .PHONY: AUTHORS BUGS INSTALL.OCTAVE +ChangeLog: + (cd $(srcdir); hg log --style=build-aux/changelog.tmpl --prune=b0e60ad4ae26 --only-branch=`hg branch`; echo ""; echo "See the files in the directory etc/OLD-ChangeLogs for changes before 2011-04-19") > $@.t + mv $@.t $@ +.PHONY: ChangeLog + octetc_DATA = NEWS DIRS_TO_MAKE = \ @@ -173,36 +145,3 @@ $(MKDIR_P) $(addprefix $(DESTDIR), $(DIRS_TO_MAKE)) install-data-local: installdirs-local - -install-exec-hook: make-version-links - -uninstall-local: remove-version-links - -if AMCOND_BUILD_COMPILED_AUX_PROGRAMS -make-version-links: - cd $(DESTDIR)$(bindir) && \ - for f in $(basename $(bin_PROGRAMS)); do \ - mv $$f$(EXEEXT) $$f-$(version)$(EXEEXT) && \ - $(LN_S) $$f-$(version)$(EXEEXT) $$f$(EXEEXT); \ - done - -remove-version-links: - for f in $(basename $(bin_PROGRAMS)); do \ - rm -f $(DESTDIR)$(bindir)/$$f-$(version)$(EXEEXT); \ - done -else -make-version-links: - cd $(DESTDIR)$(bindir) && \ - for f in $(basename $(bin_SCRIPTS)); do \ - mv $$f $$f-$(version) && \ - $(LN_S) $$f-$(version) $$f; \ - done - -remove-version-links: - for f in $(basename $(bin_SCRIPTS)); do \ - rm -f $(DESTDIR)$(bindir)/$$f-$(version); \ - done -endif - -.PHONY: make-version-links remove-version-links -
--- a/NEWS +++ b/NEWS @@ -3,11 +3,174 @@ ** The PCRE library is now required to build Octave. - ** New functions added. + ** Many of Octave's binary operators (.*, .^, +, -, ...) now perform + automatic broadcasting for array operations that allows you to use + operator notation instead of calling bsxfun or expanding arrays (and + unnecessarily wasting memory) with repmat or similar idioms. For + example, to scale the columns of a matrix by the elements of a row + vector, you may now write + + rv .* M + + In this expression, the number of elements of rv must match the + number of columns of M. The following operators are affected: + + plus + .+ + minus - .- + times .* + rdivide ./ + ldivide .\ + power .^ .** + lt < + le <= + eq == + gt > + ge >= + ne != ~= + and & + or | + atan2 + hypot + max + min + mod + rem + xor + + additionally, since the A op= B assginment operators are equivalent + to A = A op B, the following operators are also affected: + + += -= .+= .-= .*= ./= .\= .^= .**= &= |= + + See the "Broadcasting" section in the new "Vectorization and Faster + Code Execution" chapter of the manual for more details. + + ** Octave now features a profiler, thanks to the work of Daniel Kraft + under the Google Summer of Code mentorship program. The manual has + been updated to reflect this addition. The new user-visible + functions are profexplore, profile, and profshow. + + ** Overhaul of statistical distribution functions + + Functions now return "single" outputs for inputs of class "single". + + 75% reduction in memory usage through use of logical indexing. + + Random sample functions now use the same syntax as rand() and accept + a comma separated list of dimensions or a dimension vector. + + Functions have been made Matlab-compatible with regard to special + cases (probability on boundaries, probabilities for values outside + distribution, etc.). This may cause subtle changes to existing + scripts. + + negative binomial function has been extended to real, non-integer inputs. + discrete_inv() now returns v(1) for 0 instead of NaN. + nbincdf() recoded to use closed form solution with betainc(). + + ** strread, textscan, and textread have been completely revamped. + + They now support nearly all Matlab functionality including: + + * Matlab-compatible whitespace and delimiter defaults + + * Matlab-compatible options: 'whitespace', treatasempty', format + string repeat count, user-specified comment style, uneven-length + output arrays, %n and %u conversion specifiers (provisionally) + + ** All .m string functions have been modified for better performance or + greater Matlab compatibility. Performance gains of 15X-30X have + been demonstrated. Operations on cell array of strings no longer pay + quite as high a penalty as those on 2-D character arrays. + + deblank: Now requires character or cellstr input. - iscolumn - issrow - + strtrim: Now requires character or cellstr input. + No longer trims nulls ("\0") from string for Matlab + compatibility. + + strmatch: Follows documentation precisely and ignores trailing spaces + in pattern and in string. Note that this is documented + Matlab behavior but the implementation apparently does + not always follow it. + + substr: Now possible to specify a negative LEN option which + extracts to within LEN of the end of the string. + + strtok: Now accepts cellstr input. + + base2dec, bin2dec, hex2dec: + Now accept cellstr inputs. + + dec2base, dec2bin, dec2hex: + Now accept cellstr inputs. + + index, rindex: + Now accept 2-D character array input. + + strsplit: Now accepts 2-D character array input. + + ** Geometry functions derived from Qhull (convhull, delaunay, voronoi) + have been revamped. The options passed to the underlying qhull + command have been changed for better results or for Matlab + compatibility. + + convhull: Default options are "Qt" for 2D, 3D, 4D inputs + Default options are "Qt Qx" for 5D and higher + + delaunay: Default options are "Qt Qbb Qc Qz" for 2D and 3D inputs + Default options are "Qt Qbb Qc Qx" for 4D and higher + + voronoi: No default arguments + + ** Date/Time functions updated. Millisecond support with FFF format + string now supported. + + datestr: Numerical formats 21, 22, 29 changed to match Matlab. + Now accepts cellstr inputs. + + ** The following warning IDs have been removed: + + Octave:associativity-change + Octave:complex-cmp-ops + Octave:empty-list-elements + Octave:fortran-indexing + Octave:precedence-change + + ** The warning ID Octave:string-concat has been renamed to + Octave:mixed-string-concat. + + ** Octave now includes the following Matlab-compatible preference + functions: + + addpref getpref ispref rmpref setpref + + ** The following Matlab-compatible handle graphics functions have been + added: + + guidata uipanel uitoolbar + guihandles uipushtool uiwait + uicontextmenu uiresume waitfor + uicontrol uitoggletool + + The uiXXX functions above are experimental. + + Except for uiwait and uiresume, the uiXXX functions are not + supported with the the FLTK+OpenGL graphics toolkit. + + The gnuplot graphics toolkit does not support any of the uiXXX + functions nor the waitfor function. + + ** New keyword parfor (parallel for loop) is now recognized as a valid + keyword. Implementation, however, is still mapped to an ordinary + for loop. + + ** Other new functions added in 3.6.0: + + is_dq_string nthargout usejava + is_sq_string python waitbar + narginchk recycle zscore + ** Deprecated functions. The following functions were deprecated in Octave 3.2 and have been @@ -29,8 +192,73 @@ be removed from Octave 3.10 (or whatever version is the second major release after 3.6): - is_duplicate_entry - + cut is_duplicate_entry + cor polyderiv + corrcoef shell_cmd + __error_text__ studentize + error_text sylvester_matrix + +Summary of important user-visible changes for version 3.4.3: +----------------------------------------------------------- + + ** Octave 3.4.3 is a bug fixing release. + +Summary of important user-visible changes for version 3.4.2: +----------------------------------------------------------- + + ** Octave 3.4.2 fixes some minor installation problems that affected + version 3.4.1. + +Summary of important user-visible changes for version 3.4.1: +----------------------------------------------------------- + + ** Octave 3.4.1 is primarily a bug fixing release. + + ** IMPORTANT note about binary incompatibility in this release: + + Binary compatibility for all 3.4.x releases was originally planned, + but this is impossible for the 3.4.1 release due to a bug in the way + shared libraries were built in Octave 3.4.0. Because of this bug, + .oct files built for Octave 3.4.0 must be recompiled before they + will work with Octave 3.4.1. + + Given that there would be binary incompatibilities with shared + libraries going from Octave 3.4.0 to 3.4.1, the following + incompatible changes were also made in this release: + + * The Perl Compatible Regular Expression (PCRE) library is now + required to build Octave. + + * Octave's libraries and .oct files are now installed in + subdirectories of $libdir instead of $libexecdir. + + Any future Octave 3.4.x release versions should remain binary + compatible with Octave 3.4.1 as proper library versioning is now + being used as recommended by the libtool manual. + + ** The following functions have been deprecated in Octave 3.4.1 and will + be removed from Octave 3.8 (or whatever version is the second major + release after 3.4): + + cquad is_duplicate_entry perror strerror + + ** The following functions are new in 3.4.1: + + colstyle gmres iscolumn isrow mgorth nproc rectangle + + ** The get_forge_pkg function is now private. + + ** The rectangle_lw, rectangle_sw, triangle_lw, and triangle_sw + functions are now private. + + ** The logistic_regression_derivatives and logistic_regression_likelihood + functions are now private. + + ** ChangeLog files in the Octave sources are no longer maintained + by hand. Instead, there is a single ChangeLog file generated from + the Mercurial version control commit messages. Older ChangeLog + information can be found in the etc/OLD-ChangeLogs directory in the + source distribution. Summary of important user-visible changes for version 3.4: --------------------------------------------------------- @@ -162,7 +390,7 @@ Moreover, when unary operators occur in expressions, Octave will also try to do the operation in-place if it's argument is a - temporary expresssion. + temporary expression. ** The effect of comparison operators (<, >, <=, and >=) applied to complex numbers has changed to be consistent with the strict @@ -251,6 +479,11 @@ of `strcat' has been vectorized and is now much more efficient when many strings are concatenated. The `strcmpi' and `strncmpi' functions are now built-in functions, providing better performance. + + ** 'str2double' now has a compiled implementation and the API conforms + to Matlab. The additional Octave-specific features of returning a + boolean matrix indicating which elements were successfully converted + has been removed. ** Matlab-style ignoring input and output function arguments using tilde (~) is now supported. Ignored output arguments may be @@ -285,7 +518,7 @@ which is no longer a mere dummy. Consequently, nzmax and nnz are no longer always equal in Octave. Octave may also produce a matrix with nnz < nzmax as a result of other operations, so you should - consistently use nnz unless you really want to use nzmax (i.e. the + consistently use nnz unless you really want to use nzmax (i.e., the space allocated for nonzero elements). Sparse concatenation is also affected, and concatenating sparse @@ -322,7 +555,7 @@ pkg install -forge general will automatically download the latest release of the general - package and attempt to install it. No automatic resolving of + package and attempt to install it. No automatic resolving of dependencies is provided. Further, pkg list -forge @@ -350,16 +583,15 @@ exponent where the exponent is a multiple of 3. ** The following functions are new in Octave 3.4: - - accumdim erfcx nfields pqpnonneg uigetdir - bitpack fileread nth_element quadcc uigetfile - bitunpack fminbnd onCleanup randi uiputfile - blkmm fskipl pbaspect repelems uimenu - cbrt ifelse pie3 reset whitebg - curl ishermitian powerset rsf2csf - chop isindex ppder saveas - daspect luupdate ppint strread - divergence merge ppjumps textread + accumdim erfcx nfields pqpnonneg uigetdir + bitpack fileread nth_element quadcc uigetfile + bitunpack fminbnd onCleanup randi uiputfile + blkmm fskipl pbaspect repelems uimenu + cbrt ifelse pie3 reset whitebg + curl ishermitian powerset rsf2csf + chop isindex ppder saveas + daspect luupdate ppint strread + divergence merge ppjumps textread ** Using the image function to view images with external programs such as display, xv, and xloadimage is no longer supported. The @@ -461,9 +693,9 @@ be removed from Octave 3.8 (or whatever version is the second major release after 3.4): - autocor cellidx gammai krylovb values - autocov dispatch glpkmex replot - betai fstat is_global saveimage + autocor cellidx gammai krylovb saveimage + autocov dispatch glpkmex perror strerror + betai fstat is_global replot values Summary of important user-visible changes for version 3.2: --------------------------------------------------------- @@ -687,7 +919,7 @@ The performance of sort has been improved, especially when sorting indices are requested. An efficient built-in issorted implementation was added. The sortrows function now uses a more - efficient algorithm, especially in the homegeneous case. The lookup + efficient algorithm, especially in the homogeneous case. The lookup function is now a built-in function performing a binary search, optimized for long runs of close elements. Lookup also works with cell arrays of strings. @@ -696,7 +928,7 @@ For some operations on ranges, Octave will attempt to keep the result as a range. These include negation, adding a scalar, - subtracting a scalar, and multiplying by a scalar. Ranges with zero + subtracting a scalar, and multiplying by a scalar. Ranges with zero increment are allowed and can be constructed using the built-in function `ones'.
--- a/README +++ b/README @@ -49,9 +49,9 @@ features of GNU Make that are not present in other versions of make. GNU Make is very portable and easy to install. -See the notes in the files INSTALL and INSTALL.OCTAVE for more -specific installation instructions, including directions for -installing Octave from a binary distribution. +See the notes in the files INSTALL and the system-specific README files +in the etc directory of the Octave source distribution for more specific +installation instructions. Bugs and Patches ---------------- @@ -78,4 +78,4 @@ maintainers mailing lists. -Last updated: Sat, 07 Mar 2009 11:18:14 EST +Last updated: Fri, 10 Jun 2011 14:02:32 EDT
--- a/autogen.sh +++ b/autogen.sh @@ -15,7 +15,7 @@ ## building the rest of Octave, and INSTALL, which is linked from ## gnulib/doc/INSTALL by the bootstrap script. -for f in NEWS README ChangeLog COPYING; do +for f in NEWS README COPYING; do if ! test -f $f; then echo "required file $f is missing" 2>&1 exit 1 @@ -36,4 +36,4 @@ echo "bootstrapping..." -./bootstrap "$@" +build-aux/bootstrap "$@"
rename from bootstrap rename to build-aux/bootstrap --- a/bootstrap +++ b/build-aux/bootstrap @@ -1,6 +1,6 @@ #! /bin/sh # Print a version string. -scriptversion=2011-01-21.16; # UTC +scriptversion=2011-08-11.17; # UTC # Bootstrap this package from checked-out sources. @@ -130,18 +130,7 @@ m4_base=m4 doc_base=doc tests_base=tests - -# Extra files from gnulib, which override files from other sources. -gnulib_extra_files=" - $build_aux/install-sh - $build_aux/missing - $build_aux/mdate-sh - $build_aux/texinfo.tex - $build_aux/depcomp - $build_aux/config.guess - $build_aux/config.sub - doc/INSTALL -" +gnulib_extra_files='' # Additional gnulib-tool options to use. Use "\newline" to break lines. gnulib_tool_option_extras= @@ -180,8 +169,10 @@ # default. bootstrap_sync=false -# Use git to update gnulib sources -use_git=true +# Don't use git to update gnulib sources. We keep gnulib under a +# Mercurial subrepository instead +use_git=false +GNULIB_SRCDIR=gnulib/ # find_tool ENVVAR NAMES... # ------------------------- @@ -229,6 +220,18 @@ *) test -r "$0.conf" && . ./"$0.conf" ;; esac +# Extra files from gnulib, which override files from other sources. +test -z "${gnulib_extra_files}" && \ + gnulib_extra_files=" + $build_aux/install-sh + $build_aux/missing + $build_aux/mdate-sh + $build_aux/texinfo.tex + $build_aux/depcomp + $build_aux/config.guess + $build_aux/config.sub + doc/INSTALL +" if test "$vc_ignore" = auto; then vc_ignore= @@ -278,14 +281,29 @@ exit 1 fi +# Ensure that lines starting with ! sort last, per gitignore conventions +# for whitelisting exceptions after a more generic blacklist pattern. +sort_patterns() { + sort -u "$@" | sed '/^!/ { + H + d + } + $ { + P + x + s/^\n// + }' | sed '/^$/d' +} + # If $STR is not already on a line by itself in $FILE, insert it, # sorting the new contents of the file and replacing $FILE with the result. insert_sorted_if_absent() { file=$1 str=$2 test -f $file || touch $file - echo "$str" | sort -u - $file | cmp - $file > /dev/null \ - || echo "$str" | sort -u - $file -o $file \ + echo "$str" | sort_patterns - $file | cmp - $file > /dev/null \ + || { echo "$str" | sort_patterns - $file > $file.bak \ + && mv $file.bak $file; } \ || exit 1 } @@ -405,18 +423,32 @@ # Honor $APP variables ($TAR, $AUTOCONF, etc.) appvar=`echo $app | tr '[a-z]-' '[A-Z]_'` test "$appvar" = TAR && appvar=AMTAR - eval "app=\${$appvar-$app}" - inst_ver=$(get_version $app) - if [ ! "$inst_ver" ]; then - echo "$me: Error: '$app' not found" >&2 - ret=1 - elif [ ! "$req_ver" = "-" ]; then - latest_ver=$(sort_ver $req_ver $inst_ver | cut -d' ' -f2) - if [ ! "$latest_ver" = "$inst_ver" ]; then - echo "$me: Error: '$app' version == $inst_ver is too old" >&2 - echo " '$app' version >= $req_ver is required" >&2 + case $appvar in + GZIP) ;; # Do not use $GZIP: it contains gzip options. + *) eval "app=\${$appvar-$app}" ;; + esac + if [ "$req_ver" = "-" ]; then + # Merely require app to exist; not all prereq apps are well-behaved + # so we have to rely on $? rather than get_version. + $app --version >/dev/null 2>&1 + if [ 126 -le $? ]; then + echo "$me: Error: '$app' not found" >&2 ret=1 fi + else + # Require app to produce a new enough version string. + inst_ver=$(get_version $app) + if [ ! "$inst_ver" ]; then + echo "$me: Error: '$app' not found" >&2 + ret=1 + else + latest_ver=$(sort_ver $req_ver $inst_ver | cut -d' ' -f2) + if [ ! "$latest_ver" = "$inst_ver" ]; then + echo "$me: Error: '$app' version == $inst_ver is too old" >&2 + echo " '$app' version >= $req_ver is required" >&2 + ret=1 + fi + fi fi done @@ -640,10 +672,18 @@ cp -fp "$src" "$dst" } else + # Leave any existing symlink alone, if it already points to the source, + # so that broken build tools that care about symlink times + # aren't confused into doing unnecessary builds. Conversely, if the + # existing symlink's time stamp is older than the source, make it afresh, + # so that broken tools aren't confused into skipping needed builds. See + # <http://lists.gnu.org/archive/html/bug-gnulib/2011-05/msg00326.html>. test -h "$dst" && src_ls=`ls -diL "$src" 2>/dev/null` && set $src_ls && src_i=$1 && dst_ls=`ls -diL "$dst" 2>/dev/null` && set $dst_ls && dst_i=$1 && - test "$src_i" = "$dst_i" || { + test "$src_i" = "$dst_i" && + both_ls=`ls -dt "$src" "$dst"` && + test "X$both_ls" = "X$dst$nl$src" || { dot_dots= case $src in /*) ;; @@ -762,20 +802,7 @@ echo "$me: $dir/$file overrides $1/$dir/$file" else copied=$copied$sep$file; sep=$nl - if test $file = gettext.m4; then - echo "$me: patching m4/gettext.m4 to remove need for intl/* ..." - rm -f $dir/$file - sed ' - /^AC_DEFUN(\[AM_INTL_SUBDIR],/,/^]/c\ - AC_DEFUN([AM_INTL_SUBDIR], []) - /^AC_DEFUN(\[gt_INTL_SUBDIR_CORE],/,/^]/c\ - AC_DEFUN([gt_INTL_SUBDIR_CORE], []) - $a\ - AC_DEFUN([gl_LOCK_EARLY], []) - ' $1/$dir/$file >$dir/$file - else - cp_mark_as_generated $1/$dir/$file $dir/$file - fi + cp_mark_as_generated $1/$dir/$file $dir/$file fi || exit done @@ -874,7 +901,7 @@ for command in \ libtool \ - "${ACLOCAL-aclocal} --force -I m4 $ACLOCAL_FLAGS" \ + "${ACLOCAL-aclocal} --force -I '$m4_base' $ACLOCAL_FLAGS" \ "${AUTOCONF-autoconf} --force" \ "${AUTOHEADER-autoheader} --force" \ "${AUTOMAKE-automake} --add-missing --copy --force-missing" @@ -885,7 +912,7 @@ command="${LIBTOOLIZE-libtoolize} -c -f" fi echo "$0: $command ..." - $command || exit + eval "$command" || exit done
rename from bootstrap.conf rename to build-aux/bootstrap.conf --- a/bootstrap.conf +++ b/build-aux/bootstrap.conf @@ -20,10 +20,17 @@ gnulib_modules=" c-strcase copysign + copysignf + closedir crypto/md5 + fclose fcntl filemode fnmatch + fopen + fflush + fseek + ftell getcwd gethostname getopt-gnu @@ -33,9 +40,12 @@ lstat mkdir mkfifo + mkostemp mkstemp mktime nanosleep + nproc + opendir pathmax progname readlink @@ -50,6 +60,7 @@ sleep stat stdint + stdio strftime strptime symlink @@ -58,11 +69,12 @@ sys_times time times + tmpfile trunc truncf unistd unlink - vsnprintf + vasprintf " # Additional xgettext options to use. Use "\\\newline" to break lines. @@ -110,7 +122,7 @@ git 1.5.5 tar - " -checkout_only_file=HACKING +checkout_only_file=etc/HACKING gnulib_tool_option_extras="--libtool" gnulib_name="libgnu" source_base="libgnu"
new file mode 100644 --- /dev/null +++ b/build-aux/changelog.tmpl @@ -0,0 +1,2 @@ +header = '{date|shortdate} {author|person} <{author|email}>\n\n' +changeset = '\t{desc|tabindent|strip}\n\n\tFiles: {files|stringify|fill68|tabindent|strip}\n\n'
rename from common.mk rename to build-aux/common.mk --- a/common.mk +++ b/build-aux/common.mk @@ -1,5 +1,3 @@ -SHELL = /bin/sh - AWK = @AWK@ export AWK @@ -164,8 +162,6 @@ RDYNAMIC_FLAG = @RDYNAMIC_FLAG@ -RLD_FLAG = @RLD_FLAG@ - FLIBS = @FLIBS@ LIBOCTINTERP = @LIBOCTINTERP@ @@ -423,7 +419,7 @@ define simple_move_if_change_rule if [ -s $@-t ]; then \ - $(top_srcdir)/move-if-change $@-t $@; \ + $(top_srcdir)/build-aux/move-if-change $@-t $@; \ else \ echo "$@-t is empty!" 1>&2; \ rm -f $@-t; \ @@ -537,8 +533,12 @@ -e "s|%OCTAVE_CONF_MAGICK_LDFLAGS%|\"${MAGICK_LDFLAGS}\"|" \ -e "s|%OCTAVE_CONF_MAGICK_LIBS%|\"${MAGICK_LIBS}\"|" \ -e 's|%OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS%|\"@MKOCTFILE_DL_LDFLAGS@\"|' \ + -e "s|%OCTAVE_CONF_OCTAVE_LINK_DEPS%|\"${OCTAVE_LINK_DEPS}\"|" \ + -e "s|%OCTAVE_CONF_OCTAVE_LINK_OPTS%|\"${OCTAVE_LINK_OPTS}\"|" \ -e "s|%OCTAVE_CONF_OCTINCLUDEDIR%|\"${octincludedir}\"|" \ -e "s|%OCTAVE_CONF_OCTLIBDIR%|\"${octlibdir}\"|" \ + -e "s|%OCTAVE_CONF_OCT_LINK_DEPS%|\"${OCT_LINK_DEPS}\"|" \ + -e "s|%OCTAVE_CONF_OCT_LINK_OPTS%|\"${OCT_LINK_OPTS}\"|" \ -e "s|%OCTAVE_CONF_OPENGL_LIBS%|\"${OPENGL_LIBS}\"|" \ -e "s|%OCTAVE_CONF_PREFIX%|\"${prefix}\"|" \ -e "s|%OCTAVE_CONF_PTHREAD_CFLAGS%|\"${PTHREAD_CFLAGS}\"|" \ @@ -553,7 +553,6 @@ -e "s|%OCTAVE_CONF_RDYNAMIC_FLAG%|\"${RDYNAMIC_FLAG}\"|" \ -e "s|%OCTAVE_CONF_READLINE_LIBS%|\"${READLINE_LIBS}\"|" \ -e "s|%OCTAVE_CONF_REGEX_LIBS%|\"${REGEX_LIBS}\"|" \ - -e "s|%OCTAVE_CONF_RLD_FLAG%|\"${RLD_FLAG}\"|" \ -e "s|%OCTAVE_CONF_SED%|\"${SED}\"|" \ -e "s|%OCTAVE_CONF_SHARED_LIBS%|\"${SHARED_LIBS}\"|" \ -e "s|%OCTAVE_CONF_SHLEXT%|\"${SHLEXT}\"|" \ @@ -647,7 +646,7 @@ endef define do_script_install -$(top_srcdir)/mkinstalldirs $(DESTDIR)$(fcnfiledir)/$(script_sub_dir) +$(top_srcdir)/build-aux/mkinstalldirs $(DESTDIR)$(fcnfiledir)/$(script_sub_dir) for f in $(FCN_FILES); do \ fbase=`basename $$f`; \ rm -f $(DESTDIR)$(fcnfiledir)/$(script_sub_dir)/$$fbase; \
rename from mk-opts.pl rename to build-aux/mk-opts.pl --- a/mk-opts.pl +++ b/build-aux/mk-opts.pl @@ -126,6 +126,7 @@ die "mk-opts.pl: unknown command: $_\n" } } + $INCLUDE = "" if not defined $INCLUDE; # Initialize value if required } sub parse_option_block @@ -230,11 +231,12 @@ if (not defined $DOC_STRING) { - $DOC_STRING = "When called with two arguments, this function\\n\\ -allows you set options parameters for the function \@code{$FCN_NAME}.\\n\\ -Given one argument, \@code{$OPT_FCN_NAME} returns the value of the\\n\\ -corresponding option. If no arguments are supplied, the names of all\\n\\ -the available options and their current values are displayed.\\n\\\n"; + $DOC_STRING = "Query or set options for the function \@code{$FCN_NAME}.\\n\\ +When called with no arguments, the names of all available options and\\n\\ +their current values are displayed.\\n\\ +Given one argument, return the value of the corresponding option.\\n\\ +When called with two arguments, \@code{$OPT_FCN_NAME} set the option\\n\\ +\@var{opt} to value \@var{val}."; } } @@ -909,8 +911,11 @@ print <<"_END_EMIT_OPTIONS_FUNCTION_HDR_"; DEFUN_DLD ($OPT_FCN_NAME, args, , "-*- texinfo -*-\\n\\ -\@deftypefn {Loadable Function} {} $OPT_FCN_NAME (\@var{opt}, \@var{val})\\n\\ +\@deftypefn {Loadable Function} {} $OPT_FCN_NAME ()\\n\\ +\@deftypefnx {Loadable Function} {val =} $OPT_FCN_NAME (\@var{opt})\\n\\ +\@deftypefnx {Loadable Function} {} $OPT_FCN_NAME (\@var{opt}, \@var{val})\\n\\ $DOC_STRING\\n\\ +\\n\\ Options include\\n\\ \\n\\ \@table \@code\\n\\
rename from mkinstalldirs rename to build-aux/mkinstalldirs --- a/mkinstalldirs +++ b/build-aux/mkinstalldirs @@ -1,36 +1,162 @@ -#!/bin/sh +#! /bin/sh # mkinstalldirs --- make directory hierarchy -# Author: Noah Friedman <friedman@gnu.org> + +scriptversion=2009-04-28.21; # UTC + +# Original author: Noah Friedman <friedman@prep.ai.mit.edu> # Created: 1993-05-16 -# Last modified: Wed Jan 25 09:35:21 1995 -# Public domain +# Public domain. +# +# This file is maintained in Automake, please report +# bugs to <bug-automake@gnu.org> or send patches to +# <automake-patches@gnu.org>. + +nl=' +' +IFS=" "" $nl" +errstatus=0 +dirmode= + +usage="\ +Usage: mkinstalldirs [-h] [--help] [--version] [-m MODE] DIR ... + +Create each directory DIR (with mode MODE, if specified), including all +leading file name components. + +Report bugs to <bug-automake@gnu.org>." -errstatus=0 - -dirmode=0755 +# process command line arguments +while test $# -gt 0 ; do + case $1 in + -h | --help | --h*) # -h for help + echo "$usage" + exit $? + ;; + -m) # -m PERM arg + shift + test $# -eq 0 && { echo "$usage" 1>&2; exit 1; } + dirmode=$1 + shift + ;; + --version) + echo "$0 $scriptversion" + exit $? + ;; + --) # stop option processing + shift + break + ;; + -*) # unknown option + echo "$usage" 1>&2 + exit 1 + ;; + *) # first non-opt arg + break + ;; + esac +done -for file in ${1+"$@"} ; do - set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'` - shift +for file +do + if test -d "$file"; then + shift + else + break + fi +done + +case $# in + 0) exit 0 ;; +esac - pathcomp= - for d in ${1+"$@"} ; do - pathcomp="$pathcomp$d" - case "$pathcomp" in - -* ) pathcomp=./$pathcomp ;; - esac +# Solaris 8's mkdir -p isn't thread-safe. If you mkdir -p a/b and +# mkdir -p a/c at the same time, both will detect that a is missing, +# one will create a, then the other will try to create a and die with +# a "File exists" error. This is a problem when calling mkinstalldirs +# from a parallel make. We use --version in the probe to restrict +# ourselves to GNU mkdir, which is thread-safe. +case $dirmode in + '') + if mkdir -p --version . >/dev/null 2>&1 && test ! -d ./--version; then + echo "mkdir -p -- $*" + exec mkdir -p -- "$@" + else + # On NextStep and OpenStep, the `mkdir' command does not + # recognize any option. It will interpret all options as + # directories to create, and then abort because `.' already + # exists. + test -d ./-p && rmdir ./-p + test -d ./--version && rmdir ./--version + fi + ;; + *) + if mkdir -m "$dirmode" -p --version . >/dev/null 2>&1 && + test ! -d ./--version; then + echo "mkdir -m $dirmode -p -- $*" + exec mkdir -m "$dirmode" -p -- "$@" + else + # Clean up after NextStep and OpenStep mkdir. + for d in ./-m ./-p ./--version "./$dirmode"; + do + test -d $d && rmdir $d + done + fi + ;; +esac - if test ! -d "$pathcomp"; then - echo "mkdir $pathcomp" 1>&2 - mkdir "$pathcomp" || errstatus=$? - echo "chmod $dirmode $pathcomp" 1>&2 - chmod $dirmode "$pathcomp" || errstatus=$? - fi +for file +do + case $file in + /*) pathcomp=/ ;; + *) pathcomp= ;; + esac + oIFS=$IFS + IFS=/ + set fnord $file + shift + IFS=$oIFS + + for d + do + test "x$d" = x && continue + + pathcomp=$pathcomp$d + case $pathcomp in + -*) pathcomp=./$pathcomp ;; + esac - pathcomp="$pathcomp/" - done + if test ! -d "$pathcomp"; then + echo "mkdir $pathcomp" + + mkdir "$pathcomp" || lasterr=$? + + if test ! -d "$pathcomp"; then + errstatus=$lasterr + else + if test ! -z "$dirmode"; then + echo "chmod $dirmode $pathcomp" + lasterr= + chmod "$dirmode" "$pathcomp" || lasterr=$? + + if test ! -z "$lasterr"; then + errstatus=$lasterr + fi + fi + fi + fi + + pathcomp=$pathcomp/ + done done exit $errstatus -# mkinstalldirs ends here +# Local Variables: +# mode: shell-script +# sh-indentation: 2 +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-time-zone: "UTC" +# time-stamp-end: "; # UTC" +# End:
deleted file mode 100755 --- a/config.guess +++ /dev/null @@ -1,1542 +0,0 @@ -#! /bin/sh -# Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 -# Free Software Foundation, Inc. - -timestamp='2008-11-15' - -# This file 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 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <per@bothner.com>. -# Please send patches to <config-patches@gnu.org>. Submit a context -# diff and a properly formatted ChangeLog entry. -# -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. -# -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. - -me=`echo "$0" | sed -e 's,.*/,,'` - -usage="\ -Usage: $0 [OPTION] - -Output the configuration name of the system \`$me' is run on. - -Operation modes: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit - -Report bugs and patches to <config-patches@gnu.org>." - -version="\ -GNU config.guess ($timestamp) - -Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, -2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -help=" -Try \`$me --help' for more information." - -# Parse command line -while test $# -gt 0 ; do - case $1 in - --time-stamp | --time* | -t ) - echo "$timestamp" ; exit ;; - --version | -v ) - echo "$version" ; exit ;; - --help | --h* | -h ) - echo "$usage"; exit ;; - -- ) # Stop option processing - shift; break ;; - - ) # Use stdin as input. - break ;; - -* ) - echo "$me: invalid option $1$help" >&2 - exit 1 ;; - * ) - break ;; - esac -done - -if test $# != 0; then - echo "$me: too many arguments$help" >&2 - exit 1 -fi - -trap 'exit 1' 1 2 15 - -# CC_FOR_BUILD -- compiler used by this script. Note that the use of a -# compiler to aid in system detection is discouraged as it requires -# temporary files to be created and, as you can see below, it is a -# headache to deal with in a portable fashion. - -# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still -# use `HOST_CC' if defined, but it is deprecated. - -# Portable tmp directory creation inspired by the Autoconf team. - -set_cc_for_build=' -trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; -trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; -: ${TMPDIR=/tmp} ; - { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || - { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || - { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || - { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; -dummy=$tmp/dummy ; -tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; -case $CC_FOR_BUILD,$HOST_CC,$CC in - ,,) echo "int x;" > $dummy.c ; - for c in cc gcc c89 c99 ; do - if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then - CC_FOR_BUILD="$c"; break ; - fi ; - done ; - if test x"$CC_FOR_BUILD" = x ; then - CC_FOR_BUILD=no_compiler_found ; - fi - ;; - ,,*) CC_FOR_BUILD=$CC ;; - ,*,*) CC_FOR_BUILD=$HOST_CC ;; -esac ; set_cc_for_build= ;' - -# This is needed to find uname on a Pyramid OSx when run in the BSD universe. -# (ghazi@noc.rutgers.edu 1994-08-24) -if (test -f /.attbin/uname) >/dev/null 2>&1 ; then - PATH=$PATH:/.attbin ; export PATH -fi - -UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown -UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown -UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown -UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown - -# Note: order is significant - the case branches are not exclusive. - -case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - *:NetBSD:*:*) - # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, - # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently - # switched to ELF, *-*-netbsd* would select the old - # object file format. This provides both forward - # compatibility and a consistent mechanism for selecting the - # object file format. - # - # Note: NetBSD doesn't particularly care about the vendor - # portion of the name. We always set it to "unknown". - sysctl="sysctl -n hw.machine_arch" - UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ - /usr/sbin/$sysctl 2>/dev/null || echo unknown)` - case "${UNAME_MACHINE_ARCH}" in - armeb) machine=armeb-unknown ;; - arm*) machine=arm-unknown ;; - sh3el) machine=shl-unknown ;; - sh3eb) machine=sh-unknown ;; - sh5el) machine=sh5le-unknown ;; - *) machine=${UNAME_MACHINE_ARCH}-unknown ;; - esac - # The Operating System including object format, if it has switched - # to ELF recently, or will in the future. - case "${UNAME_MACHINE_ARCH}" in - arm*|i386|m68k|ns32k|sh3*|sparc|vax) - eval $set_cc_for_build - if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null - then - # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). - # Return netbsd for either. FIX? - os=netbsd - else - os=netbsdelf - fi - ;; - *) - os=netbsd - ;; - esac - # The OS release - # Debian GNU/NetBSD machines have a different userland, and - # thus, need a distinct triplet. However, they do not need - # kernel version information, so it can be replaced with a - # suitable tag, in the style of linux-gnu. - case "${UNAME_VERSION}" in - Debian*) - release='-gnu' - ;; - *) - release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` - ;; - esac - # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: - # contains redundant information, the shorter form: - # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. - echo "${machine}-${os}${release}" - exit ;; - *:OpenBSD:*:*) - UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` - echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} - exit ;; - *:ekkoBSD:*:*) - echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} - exit ;; - *:SolidBSD:*:*) - echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} - exit ;; - macppc:MirBSD:*:*) - echo powerpc-unknown-mirbsd${UNAME_RELEASE} - exit ;; - *:MirBSD:*:*) - echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} - exit ;; - alpha:OSF1:*:*) - case $UNAME_RELEASE in - *4.0) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` - ;; - *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` - ;; - esac - # According to Compaq, /usr/sbin/psrinfo has been available on - # OSF/1 and Tru64 systems produced since 1995. I hope that - # covers most systems running today. This code pipes the CPU - # types through head -n 1, so we only detect the type of CPU 0. - ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` - case "$ALPHA_CPU_TYPE" in - "EV4 (21064)") - UNAME_MACHINE="alpha" ;; - "EV4.5 (21064)") - UNAME_MACHINE="alpha" ;; - "LCA4 (21066/21068)") - UNAME_MACHINE="alpha" ;; - "EV5 (21164)") - UNAME_MACHINE="alphaev5" ;; - "EV5.6 (21164A)") - UNAME_MACHINE="alphaev56" ;; - "EV5.6 (21164PC)") - UNAME_MACHINE="alphapca56" ;; - "EV5.7 (21164PC)") - UNAME_MACHINE="alphapca57" ;; - "EV6 (21264)") - UNAME_MACHINE="alphaev6" ;; - "EV6.7 (21264A)") - UNAME_MACHINE="alphaev67" ;; - "EV6.8CB (21264C)") - UNAME_MACHINE="alphaev68" ;; - "EV6.8AL (21264B)") - UNAME_MACHINE="alphaev68" ;; - "EV6.8CX (21264D)") - UNAME_MACHINE="alphaev68" ;; - "EV6.9A (21264/EV69A)") - UNAME_MACHINE="alphaev69" ;; - "EV7 (21364)") - UNAME_MACHINE="alphaev7" ;; - "EV7.9 (21364A)") - UNAME_MACHINE="alphaev79" ;; - esac - # A Pn.n version is a patched version. - # A Vn.n version is a released version. - # A Tn.n version is a released field test version. - # A Xn.n version is an unreleased experimental baselevel. - # 1.2 uses "1.2" for uname -r. - echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; - Alpha\ *:Windows_NT*:*) - # How do we know it's Interix rather than the generic POSIX subsystem? - # Should we change UNAME_MACHINE based on the output of uname instead - # of the specific Alpha model? - echo alpha-pc-interix - exit ;; - 21064:Windows_NT:50:3) - echo alpha-dec-winnt3.5 - exit ;; - Amiga*:UNIX_System_V:4.0:*) - echo m68k-unknown-sysv4 - exit ;; - *:[Aa]miga[Oo][Ss]:*:*) - echo ${UNAME_MACHINE}-unknown-amigaos - exit ;; - *:[Mm]orph[Oo][Ss]:*:*) - echo ${UNAME_MACHINE}-unknown-morphos - exit ;; - *:OS/390:*:*) - echo i370-ibm-openedition - exit ;; - *:z/VM:*:*) - echo s390-ibm-zvmoe - exit ;; - *:OS400:*:*) - echo powerpc-ibm-os400 - exit ;; - arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) - echo arm-acorn-riscix${UNAME_RELEASE} - exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) - echo arm-unknown-riscos - exit ;; - SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) - echo hppa1.1-hitachi-hiuxmpp - exit ;; - Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) - # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. - if test "`(/bin/universe) 2>/dev/null`" = att ; then - echo pyramid-pyramid-sysv3 - else - echo pyramid-pyramid-bsd - fi - exit ;; - NILE*:*:*:dcosx) - echo pyramid-pyramid-svr4 - exit ;; - DRS?6000:unix:4.0:6*) - echo sparc-icl-nx6 - exit ;; - DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) - case `/usr/bin/uname -p` in - sparc) echo sparc-icl-nx7; exit ;; - esac ;; - sun4H:SunOS:5.*:*) - echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) - echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) - eval $set_cc_for_build - SUN_ARCH="i386" - # If there is a compiler, see if it is configured for 64-bit objects. - # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. - # This test works for both compilers. - if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then - if echo '\n#ifdef __amd64\nIS_64BIT_ARCH\n#endif' | \ - (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then - SUN_ARCH="x86_64" - fi - fi - echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4*:SunOS:6*:*) - # According to config.sub, this is the proper way to canonicalize - # SunOS6. Hard to guess exactly what SunOS6 will be like, but - # it's likely to be more like Solaris than SunOS4. - echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4*:SunOS:*:*) - case "`/usr/bin/arch -k`" in - Series*|S4*) - UNAME_RELEASE=`uname -v` - ;; - esac - # Japanese Language versions have a version number like `4.1.3-JL'. - echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` - exit ;; - sun3*:SunOS:*:*) - echo m68k-sun-sunos${UNAME_RELEASE} - exit ;; - sun*:*:4.2BSD:*) - UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` - test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 - case "`/bin/arch`" in - sun3) - echo m68k-sun-sunos${UNAME_RELEASE} - ;; - sun4) - echo sparc-sun-sunos${UNAME_RELEASE} - ;; - esac - exit ;; - aushp:SunOS:*:*) - echo sparc-auspex-sunos${UNAME_RELEASE} - exit ;; - # The situation for MiNT is a little confusing. The machine name - # can be virtually everything (everything which is not - # "atarist" or "atariste" at least should have a processor - # > m68000). The system name ranges from "MiNT" over "FreeMiNT" - # to the lowercase version "mint" (or "freemint"). Finally - # the system name "TOS" denotes a system which is actually not - # MiNT. But MiNT is downward compatible to TOS, so this should - # be no problem. - atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit ;; - atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit ;; - *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit ;; - milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; - hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; - *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; - m68k:machten:*:*) - echo m68k-apple-machten${UNAME_RELEASE} - exit ;; - powerpc:machten:*:*) - echo powerpc-apple-machten${UNAME_RELEASE} - exit ;; - RISC*:Mach:*:*) - echo mips-dec-mach_bsd4.3 - exit ;; - RISC*:ULTRIX:*:*) - echo mips-dec-ultrix${UNAME_RELEASE} - exit ;; - VAX*:ULTRIX*:*:*) - echo vax-dec-ultrix${UNAME_RELEASE} - exit ;; - 2020:CLIX:*:* | 2430:CLIX:*:*) - echo clipper-intergraph-clix${UNAME_RELEASE} - exit ;; - mips:*:*:UMIPS | mips:*:*:RISCos) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c -#ifdef __cplusplus -#include <stdio.h> /* for printf() prototype */ - int main (int argc, char *argv[]) { -#else - int main (argc, argv) int argc; char *argv[]; { -#endif - #if defined (host_mips) && defined (MIPSEB) - #if defined (SYSTYPE_SYSV) - printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_SVR4) - printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) - printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); - #endif - #endif - exit (-1); - } -EOF - $CC_FOR_BUILD -o $dummy $dummy.c && - dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && - SYSTEM_NAME=`$dummy $dummyarg` && - { echo "$SYSTEM_NAME"; exit; } - echo mips-mips-riscos${UNAME_RELEASE} - exit ;; - Motorola:PowerMAX_OS:*:*) - echo powerpc-motorola-powermax - exit ;; - Motorola:*:4.3:PL8-*) - echo powerpc-harris-powermax - exit ;; - Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) - echo powerpc-harris-powermax - exit ;; - Night_Hawk:Power_UNIX:*:*) - echo powerpc-harris-powerunix - exit ;; - m88k:CX/UX:7*:*) - echo m88k-harris-cxux7 - exit ;; - m88k:*:4*:R4*) - echo m88k-motorola-sysv4 - exit ;; - m88k:*:3*:R3*) - echo m88k-motorola-sysv3 - exit ;; - AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` - if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] - then - if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ - [ ${TARGET_BINARY_INTERFACE}x = x ] - then - echo m88k-dg-dgux${UNAME_RELEASE} - else - echo m88k-dg-dguxbcs${UNAME_RELEASE} - fi - else - echo i586-dg-dgux${UNAME_RELEASE} - fi - exit ;; - M88*:DolphinOS:*:*) # DolphinOS (SVR3) - echo m88k-dolphin-sysv3 - exit ;; - M88*:*:R3*:*) - # Delta 88k system running SVR3 - echo m88k-motorola-sysv3 - exit ;; - XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) - echo m88k-tektronix-sysv3 - exit ;; - Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) - echo m68k-tektronix-bsd - exit ;; - *:IRIX*:*:*) - echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` - exit ;; - ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. - echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id - exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' - i*86:AIX:*:*) - echo i386-ibm-aix - exit ;; - ia64:AIX:*:*) - if [ -x /usr/bin/oslevel ] ; then - IBM_REV=`/usr/bin/oslevel` - else - IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} - fi - echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} - exit ;; - *:AIX:2:3) - if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <sys/systemcfg.h> - - main() - { - if (!__power_pc()) - exit(1); - puts("powerpc-ibm-aix3.2.5"); - exit(0); - } -EOF - if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` - then - echo "$SYSTEM_NAME" - else - echo rs6000-ibm-aix3.2.5 - fi - elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then - echo rs6000-ibm-aix3.2.4 - else - echo rs6000-ibm-aix3.2 - fi - exit ;; - *:AIX:*:[456]) - IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` - if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then - IBM_ARCH=rs6000 - else - IBM_ARCH=powerpc - fi - if [ -x /usr/bin/oslevel ] ; then - IBM_REV=`/usr/bin/oslevel` - else - IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} - fi - echo ${IBM_ARCH}-ibm-aix${IBM_REV} - exit ;; - *:AIX:*:*) - echo rs6000-ibm-aix - exit ;; - ibmrt:4.4BSD:*|romp-ibm:BSD:*) - echo romp-ibm-bsd4.4 - exit ;; - ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and - echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to - exit ;; # report: romp-ibm BSD 4.3 - *:BOSX:*:*) - echo rs6000-bull-bosx - exit ;; - DPX/2?00:B.O.S.:*:*) - echo m68k-bull-sysv3 - exit ;; - 9000/[34]??:4.3bsd:1.*:*) - echo m68k-hp-bsd - exit ;; - hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) - echo m68k-hp-bsd4.4 - exit ;; - 9000/[34678]??:HP-UX:*:*) - HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` - case "${UNAME_MACHINE}" in - 9000/31? ) HP_ARCH=m68000 ;; - 9000/[34]?? ) HP_ARCH=m68k ;; - 9000/[678][0-9][0-9]) - if [ -x /usr/bin/getconf ]; then - sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; - '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac - fi - if [ "${HP_ARCH}" = "" ]; then - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> - - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); - - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } -EOF - (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` - test -z "$HP_ARCH" && HP_ARCH=hppa - fi ;; - esac - if [ ${HP_ARCH} = "hppa2.0w" ] - then - eval $set_cc_for_build - - # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating - # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler - # generating 64-bit code. GNU and HP use different nomenclature: - # - # $ CC_FOR_BUILD=cc ./config.guess - # => hppa2.0w-hp-hpux11.23 - # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess - # => hppa64-hp-hpux11.23 - - if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null - then - HP_ARCH="hppa2.0w" - else - HP_ARCH="hppa64" - fi - fi - echo ${HP_ARCH}-hp-hpux${HPUX_REV} - exit ;; - ia64:HP-UX:*:*) - HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` - echo ia64-hp-hpux${HPUX_REV} - exit ;; - 3050*:HI-UX:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <unistd.h> - int - main () - { - long cpu = sysconf (_SC_CPU_VERSION); - /* The order matters, because CPU_IS_HP_MC68K erroneously returns - true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct - results, however. */ - if (CPU_IS_PA_RISC (cpu)) - { - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; - case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; - default: puts ("hppa-hitachi-hiuxwe2"); break; - } - } - else if (CPU_IS_HP_MC68K (cpu)) - puts ("m68k-hitachi-hiuxwe2"); - else puts ("unknown-hitachi-hiuxwe2"); - exit (0); - } -EOF - $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && - { echo "$SYSTEM_NAME"; exit; } - echo unknown-hitachi-hiuxwe2 - exit ;; - 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) - echo hppa1.1-hp-bsd - exit ;; - 9000/8??:4.3bsd:*:*) - echo hppa1.0-hp-bsd - exit ;; - *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) - echo hppa1.0-hp-mpeix - exit ;; - hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) - echo hppa1.1-hp-osf - exit ;; - hp8??:OSF1:*:*) - echo hppa1.0-hp-osf - exit ;; - i*86:OSF1:*:*) - if [ -x /usr/sbin/sysversion ] ; then - echo ${UNAME_MACHINE}-unknown-osf1mk - else - echo ${UNAME_MACHINE}-unknown-osf1 - fi - exit ;; - parisc*:Lites*:*:*) - echo hppa1.1-hp-lites - exit ;; - C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) - echo c1-convex-bsd - exit ;; - C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit ;; - C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) - echo c34-convex-bsd - exit ;; - C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) - echo c38-convex-bsd - exit ;; - C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) - echo c4-convex-bsd - exit ;; - CRAY*Y-MP:*:*:*) - echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*[A-Z]90:*:*:*) - echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ - | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ - -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ - -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*TS:*:*:*) - echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*T3E:*:*:*) - echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*SV1:*:*:*) - echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - *:UNICOS/mp:*:*) - echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) - FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; - 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; - i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) - echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} - exit ;; - sparc*:BSD/OS:*:*) - echo sparc-unknown-bsdi${UNAME_RELEASE} - exit ;; - *:BSD/OS:*:*) - echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} - exit ;; - *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; - amd64) - echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; - *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; - esac - exit ;; - i*:CYGWIN*:*) - echo ${UNAME_MACHINE}-pc-cygwin - exit ;; - *:MINGW*:*) - echo ${UNAME_MACHINE}-pc-mingw32 - exit ;; - i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 - exit ;; - i*:PW*:*) - echo ${UNAME_MACHINE}-pc-pw32 - exit ;; - *:Interix*:[3456]*) - case ${UNAME_MACHINE} in - x86) - echo i586-pc-interix${UNAME_RELEASE} - exit ;; - EM64T | authenticamd | genuineintel) - echo x86_64-unknown-interix${UNAME_RELEASE} - exit ;; - IA64) - echo ia64-unknown-interix${UNAME_RELEASE} - exit ;; - esac ;; - [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) - echo i${UNAME_MACHINE}-pc-mks - exit ;; - i*:Windows_NT*:* | Pentium*:Windows_NT*:*) - # How do we know it's Interix rather than the generic POSIX subsystem? - # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we - # UNAME_MACHINE based on the output of uname instead of i386? - echo i586-pc-interix - exit ;; - i*:UWIN*:*) - echo ${UNAME_MACHINE}-pc-uwin - exit ;; - amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) - echo x86_64-unknown-cygwin - exit ;; - p*:CYGWIN*:*) - echo powerpcle-unknown-cygwin - exit ;; - prep*:SunOS:5.*:*) - echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - *:GNU:*:*) - # the GNU system - echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` - exit ;; - *:GNU/*:*:*) - # other systems with GNU libc and userland - echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu - exit ;; - i*86:Minix:*:*) - echo ${UNAME_MACHINE}-pc-minix - exit ;; - arm*:Linux:*:*) - eval $set_cc_for_build - if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ARM_EABI__ - then - echo ${UNAME_MACHINE}-unknown-linux-gnu - else - echo ${UNAME_MACHINE}-unknown-linux-gnueabi - fi - exit ;; - avr32*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - cris:Linux:*:*) - echo cris-axis-linux-gnu - exit ;; - crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu - exit ;; - frv:Linux:*:*) - echo frv-unknown-linux-gnu - exit ;; - ia64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - m32r*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - m68*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips64 - #undef mips64el - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu - exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu - exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu - exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} - exit ;; - padre:Linux:*:*) - echo sparc-unknown-linux-gnu - exit ;; - parisc:Linux:*:* | hppa:Linux:*:*) - # Look for CPU level - case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in - PA7*) echo hppa1.1-unknown-linux-gnu ;; - PA8*) echo hppa2.0-unknown-linux-gnu ;; - *) echo hppa-unknown-linux-gnu ;; - esac - exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu - exit ;; - s390:Linux:*:* | s390x:Linux:*:*) - echo ${UNAME_MACHINE}-ibm-linux - exit ;; - sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - sh*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - sparc:Linux:*:* | sparc64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - vax:Linux:*:*) - echo ${UNAME_MACHINE}-dec-linux-gnu - exit ;; - x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu - exit ;; - xtensa*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; - i*86:DYNIX/ptx:4*:*) - # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. - # earlier versions are messed up and put the nodename in both - # sysname and nodename. - echo i386-sequent-sysv4 - exit ;; - i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, - # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. - echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} - exit ;; - i*86:OS/2:*:*) - # If we were able to find `uname', then EMX Unix compatibility - # is probably installed. - echo ${UNAME_MACHINE}-pc-os2-emx - exit ;; - i*86:XTS-300:*:STOP) - echo ${UNAME_MACHINE}-unknown-stop - exit ;; - i*86:atheos:*:*) - echo ${UNAME_MACHINE}-unknown-atheos - exit ;; - i*86:syllable:*:*) - echo ${UNAME_MACHINE}-pc-syllable - exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) - echo i386-unknown-lynxos${UNAME_RELEASE} - exit ;; - i*86:*DOS:*:*) - echo ${UNAME_MACHINE}-pc-msdosdjgpp - exit ;; - i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) - UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` - if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then - echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} - else - echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} - fi - exit ;; - i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. - case `/bin/uname -X | grep "^Machine"` in - *486*) UNAME_MACHINE=i486 ;; - *Pentium) UNAME_MACHINE=i586 ;; - *Pent*|*Celeron) UNAME_MACHINE=i686 ;; - esac - echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} - exit ;; - i*86:*:3.2:*) - if test -f /usr/options/cb.name; then - UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name` - echo ${UNAME_MACHINE}-pc-isc$UNAME_REL - elif /bin/uname -X 2>/dev/null >/dev/null ; then - UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` - (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 - (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ - && UNAME_MACHINE=i586 - (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ - && UNAME_MACHINE=i686 - (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ - && UNAME_MACHINE=i686 - echo ${UNAME_MACHINE}-pc-sco$UNAME_REL - else - echo ${UNAME_MACHINE}-pc-sysv32 - fi - exit ;; - pc:*:*:*) - # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; - Intel:Mach:3*:*) - echo i386-pc-mach3 - exit ;; - paragon:*:*:*) - echo i860-intel-osf1 - exit ;; - i860:*:4.*:*) # i860-SVR4 - if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then - echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 - else # Add other i860-SVR4 vendors below as they are discovered. - echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 - fi - exit ;; - mini*:CTIX:SYS*5:*) - # "miniframe" - echo m68010-convergent-sysv - exit ;; - mc68k:UNIX:SYSTEM5:3.51m) - echo m68k-convergent-sysv - exit ;; - M680?0:D-NIX:5.3:*) - echo m68k-diab-dnix - exit ;; - M68*:*:R3V[5678]*:*) - test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; - 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) - OS_REL='' - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4.3${OS_REL}; exit; } - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; - 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; - m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) - echo m68k-unknown-lynxos${UNAME_RELEASE} - exit ;; - mc68030:UNIX_System_V:4.*:*) - echo m68k-atari-sysv4 - exit ;; - TSUNAMI:LynxOS:2.*:*) - echo sparc-unknown-lynxos${UNAME_RELEASE} - exit ;; - rs6000:LynxOS:2.*:*) - echo rs6000-unknown-lynxos${UNAME_RELEASE} - exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) - echo powerpc-unknown-lynxos${UNAME_RELEASE} - exit ;; - SM[BE]S:UNIX_SV:*:*) - echo mips-dde-sysv${UNAME_RELEASE} - exit ;; - RM*:ReliantUNIX-*:*:*) - echo mips-sni-sysv4 - exit ;; - RM*:SINIX-*:*:*) - echo mips-sni-sysv4 - exit ;; - *:SINIX-*:*:*) - if uname -p 2>/dev/null >/dev/null ; then - UNAME_MACHINE=`(uname -p) 2>/dev/null` - echo ${UNAME_MACHINE}-sni-sysv4 - else - echo ns32k-sni-sysv - fi - exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <Richard.M.Bartel@ccMail.Census.GOV> - echo i586-unisys-sysv4 - exit ;; - *:UNIX_System_V:4*:FTX*) - # From Gerald Hewes <hewes@openmarket.com>. - # How about differentiating between stratus architectures? -djm - echo hppa1.1-stratus-sysv4 - exit ;; - *:*:*:FTX*) - # From seanf@swdc.stratus.com. - echo i860-stratus-sysv4 - exit ;; - i*86:VOS:*:*) - # From Paul.Green@stratus.com. - echo ${UNAME_MACHINE}-stratus-vos - exit ;; - *:VOS:*:*) - # From Paul.Green@stratus.com. - echo hppa1.1-stratus-vos - exit ;; - mc68*:A/UX:*:*) - echo m68k-apple-aux${UNAME_RELEASE} - exit ;; - news*:NEWS-OS:6*:*) - echo mips-sony-newsos6 - exit ;; - R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) - if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} - else - echo mips-unknown-sysv${UNAME_RELEASE} - fi - exit ;; - BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. - echo powerpc-be-beos - exit ;; - BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. - echo powerpc-apple-beos - exit ;; - BePC:BeOS:*:*) # BeOS running on Intel PC compatible. - echo i586-pc-beos - exit ;; - BePC:Haiku:*:*) # Haiku running on Intel PC compatible. - echo i586-pc-haiku - exit ;; - SX-4:SUPER-UX:*:*) - echo sx4-nec-superux${UNAME_RELEASE} - exit ;; - SX-5:SUPER-UX:*:*) - echo sx5-nec-superux${UNAME_RELEASE} - exit ;; - SX-6:SUPER-UX:*:*) - echo sx6-nec-superux${UNAME_RELEASE} - exit ;; - SX-7:SUPER-UX:*:*) - echo sx7-nec-superux${UNAME_RELEASE} - exit ;; - SX-8:SUPER-UX:*:*) - echo sx8-nec-superux${UNAME_RELEASE} - exit ;; - SX-8R:SUPER-UX:*:*) - echo sx8r-nec-superux${UNAME_RELEASE} - exit ;; - Power*:Rhapsody:*:*) - echo powerpc-apple-rhapsody${UNAME_RELEASE} - exit ;; - *:Rhapsody:*:*) - echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} - exit ;; - *:Darwin:*:*) - UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown - case $UNAME_PROCESSOR in - unknown) UNAME_PROCESSOR=powerpc ;; - esac - echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} - exit ;; - *:procnto*:*:* | *:QNX:[0123456789]*:*) - UNAME_PROCESSOR=`uname -p` - if test "$UNAME_PROCESSOR" = "x86"; then - UNAME_PROCESSOR=i386 - UNAME_MACHINE=pc - fi - echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} - exit ;; - *:QNX:*:4*) - echo i386-pc-qnx - exit ;; - NSE-?:NONSTOP_KERNEL:*:*) - echo nse-tandem-nsk${UNAME_RELEASE} - exit ;; - NSR-?:NONSTOP_KERNEL:*:*) - echo nsr-tandem-nsk${UNAME_RELEASE} - exit ;; - *:NonStop-UX:*:*) - echo mips-compaq-nonstopux - exit ;; - BS2000:POSIX*:*:*) - echo bs2000-siemens-sysv - exit ;; - DS/*:UNIX_System_V:*:*) - echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} - exit ;; - *:Plan9:*:*) - # "uname -m" is not consistent, so use $cputype instead. 386 - # is converted to i386 for consistency with other x86 - # operating systems. - if test "$cputype" = "386"; then - UNAME_MACHINE=i386 - else - UNAME_MACHINE="$cputype" - fi - echo ${UNAME_MACHINE}-unknown-plan9 - exit ;; - *:TOPS-10:*:*) - echo pdp10-unknown-tops10 - exit ;; - *:TENEX:*:*) - echo pdp10-unknown-tenex - exit ;; - KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) - echo pdp10-dec-tops20 - exit ;; - XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) - echo pdp10-xkl-tops20 - exit ;; - *:TOPS-20:*:*) - echo pdp10-unknown-tops20 - exit ;; - *:ITS:*:*) - echo pdp10-unknown-its - exit ;; - SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} - exit ;; - *:DragonFly:*:*) - echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` - exit ;; - *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` - case "${UNAME_MACHINE}" in - A*) echo alpha-dec-vms ; exit ;; - I*) echo ia64-dec-vms ; exit ;; - V*) echo vax-dec-vms ; exit ;; - esac ;; - *:XENIX:*:SysV) - echo i386-pc-xenix - exit ;; - i*86:skyos:*:*) - echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' - exit ;; - i*86:rdos:*:*) - echo ${UNAME_MACHINE}-pc-rdos - exit ;; -esac - -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - -eval $set_cc_for_build -cat >$dummy.c <<EOF -#ifdef _SEQUENT_ -# include <sys/types.h> -# include <sys/utsname.h> -#endif -main () -{ -#if defined (sony) -#if defined (MIPSEB) - /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, - I don't know.... */ - printf ("mips-sony-bsd\n"); exit (0); -#else -#include <sys/param.h> - printf ("m68k-sony-newsos%s\n", -#ifdef NEWSOS4 - "4" -#else - "" -#endif - ); exit (0); -#endif -#endif - -#if defined (__arm) && defined (__acorn) && defined (__unix) - printf ("arm-acorn-riscix\n"); exit (0); -#endif - -#if defined (hp300) && !defined (hpux) - printf ("m68k-hp-bsd\n"); exit (0); -#endif - -#if defined (NeXT) -#if !defined (__ARCHITECTURE__) -#define __ARCHITECTURE__ "m68k" -#endif - int version; - version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; - if (version < 4) - printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); - else - printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); - exit (0); -#endif - -#if defined (MULTIMAX) || defined (n16) -#if defined (UMAXV) - printf ("ns32k-encore-sysv\n"); exit (0); -#else -#if defined (CMU) - printf ("ns32k-encore-mach\n"); exit (0); -#else - printf ("ns32k-encore-bsd\n"); exit (0); -#endif -#endif -#endif - -#if defined (__386BSD__) - printf ("i386-pc-bsd\n"); exit (0); -#endif - -#if defined (sequent) -#if defined (i386) - printf ("i386-sequent-dynix\n"); exit (0); -#endif -#if defined (ns32000) - printf ("ns32k-sequent-dynix\n"); exit (0); -#endif -#endif - -#if defined (_SEQUENT_) - struct utsname un; - - uname(&un); - - if (strncmp(un.version, "V2", 2) == 0) { - printf ("i386-sequent-ptx2\n"); exit (0); - } - if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ - printf ("i386-sequent-ptx1\n"); exit (0); - } - printf ("i386-sequent-ptx\n"); exit (0); - -#endif - -#if defined (vax) -# if !defined (ultrix) -# include <sys/param.h> -# if defined (BSD) -# if BSD == 43 - printf ("vax-dec-bsd4.3\n"); exit (0); -# else -# if BSD == 199006 - printf ("vax-dec-bsd4.3reno\n"); exit (0); -# else - printf ("vax-dec-bsd\n"); exit (0); -# endif -# endif -# else - printf ("vax-dec-bsd\n"); exit (0); -# endif -# else - printf ("vax-dec-ultrix\n"); exit (0); -# endif -#endif - -#if defined (alliant) && defined (i860) - printf ("i860-alliant-bsd\n"); exit (0); -#endif - - exit (1); -} -EOF - -$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && - { echo "$SYSTEM_NAME"; exit; } - -# Apollos put the system type in the environment. - -test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } - -# Convex versions that predate uname can use getsysinfo(1) - -if [ -x /usr/convex/getsysinfo ] -then - case `getsysinfo -f cpu_type` in - c1*) - echo c1-convex-bsd - exit ;; - c2*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit ;; - c34*) - echo c34-convex-bsd - exit ;; - c38*) - echo c38-convex-bsd - exit ;; - c4*) - echo c4-convex-bsd - exit ;; - esac -fi - -cat >&2 <<EOF -$0: unable to guess system type - -This script, last modified $timestamp, has failed to recognize -the operating system you are using. It is advised that you -download the most up to date version of the config scripts from - - http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD -and - http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD - -If the version you run ($0) is already up to date, please -send the following data and any information you think might be -pertinent to <config-patches@gnu.org> in order to provide the needed -information to handle your system. - -config.guess timestamp = $timestamp - -uname -m = `(uname -m) 2>/dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` - -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null` - -hostinfo = `(hostinfo) 2>/dev/null` -/bin/universe = `(/bin/universe) 2>/dev/null` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` -/bin/arch = `(/bin/arch) 2>/dev/null` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` - -UNAME_MACHINE = ${UNAME_MACHINE} -UNAME_RELEASE = ${UNAME_RELEASE} -UNAME_SYSTEM = ${UNAME_SYSTEM} -UNAME_VERSION = ${UNAME_VERSION} -EOF - -exit 1 - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" -# time-stamp-end: "'" -# End:
deleted file mode 100755 --- a/config.sub +++ /dev/null @@ -1,1685 +0,0 @@ -#! /bin/sh -# Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 -# Free Software Foundation, Inc. - -timestamp='2009-03-07' - -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file 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 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Please send patches to <config-patches@gnu.org>. Submit a context -# diff and a properly formatted ChangeLog entry. -# -# Configuration subroutine to validate and canonicalize a configuration type. -# Supply the specified configuration type as an argument. -# If it is invalid, we print an error message on stderr and exit with code 1. -# Otherwise, we print the canonical config type on stdout and succeed. - -# This file is supposed to be the same for all GNU packages -# and recognize all the CPU types, system types and aliases -# that are meaningful with *any* GNU software. -# Each package is responsible for reporting which valid configurations -# it does not support. The user should be able to distinguish -# a failure to support a valid configuration from a meaningless -# configuration. - -# The goal of this file is to map all the various variations of a given -# machine specification into a single specification in the form: -# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM -# or in some cases, the newer four-part form: -# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM -# It is wrong to echo any other type of specification. - -me=`echo "$0" | sed -e 's,.*/,,'` - -usage="\ -Usage: $0 [OPTION] CPU-MFR-OPSYS - $0 [OPTION] ALIAS - -Canonicalize a configuration name. - -Operation modes: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit - -Report bugs and patches to <config-patches@gnu.org>." - -version="\ -GNU config.sub ($timestamp) - -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, -2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -help=" -Try \`$me --help' for more information." - -# Parse command line -while test $# -gt 0 ; do - case $1 in - --time-stamp | --time* | -t ) - echo "$timestamp" ; exit ;; - --version | -v ) - echo "$version" ; exit ;; - --help | --h* | -h ) - echo "$usage"; exit ;; - -- ) # Stop option processing - shift; break ;; - - ) # Use stdin as input. - break ;; - -* ) - echo "$me: invalid option $1$help" - exit 1 ;; - - *local*) - # First pass through any local machine types. - echo $1 - exit ;; - - * ) - break ;; - esac -done - -case $# in - 0) echo "$me: missing argument$help" >&2 - exit 1;; - 1) ;; - *) echo "$me: too many arguments$help" >&2 - exit 1;; -esac - -# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). -# Here we must recognize all the valid KERNEL-OS combinations. -maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` -case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ - uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ - kopensolaris*-gnu* | \ - storm-chaos* | os2-emx* | rtmk-nova*) - os=-$maybe_os - basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` - ;; - *) - basic_machine=`echo $1 | sed 's/-[^-]*$//'` - if [ $basic_machine != $1 ] - then os=`echo $1 | sed 's/.*-/-/'` - else os=; fi - ;; -esac - -### Let's recognize common machines as not being operating systems so -### that things like config.sub decstation-3100 work. We also -### recognize some manufacturers as not being operating systems, so we -### can provide default operating systems below. -case $os in - -sun*os*) - # Prevent following clause from handling this invalid input. - ;; - -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ - -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ - -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ - -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ - -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ - -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray) - os= - basic_machine=$1 - ;; - -sim | -cisco | -oki | -wec | -winbond) - os= - basic_machine=$1 - ;; - -scout) - ;; - -wrs) - os=-vxworks - basic_machine=$1 - ;; - -chorusos*) - os=-chorusos - basic_machine=$1 - ;; - -chorusrdb) - os=-chorusrdb - basic_machine=$1 - ;; - -hiux*) - os=-hiuxwe2 - ;; - -sco6) - os=-sco5v6 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco5) - os=-sco3.2v5 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco4) - os=-sco3.2v4 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco3.2.[4-9]*) - os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco3.2v[4-9]*) - # Don't forget version if it is 3.2v4 or newer. - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco5v6*) - # Don't forget version if it is 3.2v4 or newer. - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco*) - os=-sco3.2v2 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -udk*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -isc) - os=-isc2.2 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -clix*) - basic_machine=clipper-intergraph - ;; - -isc*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -lynx*) - os=-lynxos - ;; - -ptx*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` - ;; - -windowsnt*) - os=`echo $os | sed -e 's/windowsnt/winnt/'` - ;; - -psos*) - os=-psos - ;; - -mint | -mint[0-9]*) - basic_machine=m68k-atari - os=-mint - ;; -esac - -# Decode aliases for certain CPU-COMPANY combinations. -case $basic_machine in - # Recognize the basic CPU types without company name. - # Some are omitted here because they have special meanings below. - 1750a | 580 \ - | a29k \ - | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ - | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ - | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ - | bfin \ - | c4x | clipper \ - | d10v | d30v | dlx | dsp16xx \ - | fido | fr30 | frv \ - | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ - | i370 | i860 | i960 | ia64 \ - | ip2k | iq2000 \ - | lm32 \ - | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | mcore | mep | metag \ - | mips | mipsbe | mipseb | mipsel | mipsle \ - | mips16 \ - | mips64 | mips64el \ - | mips64octeon | mips64octeonel \ - | mips64orion | mips64orionel \ - | mips64r5900 | mips64r5900el \ - | mips64vr | mips64vrel \ - | mips64vr4100 | mips64vr4100el \ - | mips64vr4300 | mips64vr4300el \ - | mips64vr5000 | mips64vr5000el \ - | mips64vr5900 | mips64vr5900el \ - | mipsisa32 | mipsisa32el \ - | mipsisa32r2 | mipsisa32r2el \ - | mipsisa64 | mipsisa64el \ - | mipsisa64r2 | mipsisa64r2el \ - | mipsisa64sb1 | mipsisa64sb1el \ - | mipsisa64sr71k | mipsisa64sr71kel \ - | mipstx39 | mipstx39el \ - | mn10200 | mn10300 \ - | mt \ - | msp430 \ - | nios | nios2 \ - | ns16k | ns32k \ - | or32 \ - | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ - | pyramid \ - | score \ - | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ - | sh64 | sh64le \ - | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ - | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu | strongarm \ - | tahoe | thumb | tic4x | tic80 | tron \ - | v850 | v850e \ - | we32k \ - | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ - | z8k | z80) - basic_machine=$basic_machine-unknown - ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. - basic_machine=$basic_machine-unknown - os=-none - ;; - m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) - ;; - ms1) - basic_machine=mt-unknown - ;; - - # We use `pc' rather than `unknown' - # because (1) that's what they normally are, and - # (2) the word "unknown" tends to confuse beginning users. - i*86 | x86_64) - basic_machine=$basic_machine-pc - ;; - # Object if more than one company name word. - *-*-*) - echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 - exit 1 - ;; - # Recognize the basic CPU types with company name. - 580-* \ - | a29k-* \ - | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ - | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ - | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ - | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ - | avr-* | avr32-* \ - | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ - | clipper-* | craynv-* | cydra-* \ - | d10v-* | d30v-* | dlx-* \ - | elxsi-* \ - | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ - | h8300-* | h8500-* \ - | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ - | i*86-* | i860-* | i960-* | ia64-* \ - | ip2k-* | iq2000-* \ - | lm32-* \ - | m32c-* | m32r-* | m32rle-* \ - | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ - | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ - | mips16-* \ - | mips64-* | mips64el-* \ - | mips64octeon-* | mips64octeonel-* \ - | mips64orion-* | mips64orionel-* \ - | mips64r5900-* | mips64r5900el-* \ - | mips64vr-* | mips64vrel-* \ - | mips64vr4100-* | mips64vr4100el-* \ - | mips64vr4300-* | mips64vr4300el-* \ - | mips64vr5000-* | mips64vr5000el-* \ - | mips64vr5900-* | mips64vr5900el-* \ - | mipsisa32-* | mipsisa32el-* \ - | mipsisa32r2-* | mipsisa32r2el-* \ - | mipsisa64-* | mipsisa64el-* \ - | mipsisa64r2-* | mipsisa64r2el-* \ - | mipsisa64sb1-* | mipsisa64sb1el-* \ - | mipsisa64sr71k-* | mipsisa64sr71kel-* \ - | mipstx39-* | mipstx39el-* \ - | mmix-* \ - | mt-* \ - | msp430-* \ - | nios-* | nios2-* \ - | none-* | np1-* | ns16k-* | ns32k-* \ - | orion-* \ - | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ - | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ - | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ - | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ - | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ - | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* | tile-* \ - | tron-* \ - | v850-* | v850e-* | vax-* \ - | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ - | xstormy16-* | xtensa*-* \ - | ymp-* \ - | z8k-* | z80-*) - ;; - # Recognize the basic CPU types without company name, with glob match. - xtensa*) - basic_machine=$basic_machine-unknown - ;; - # Recognize the various machine names and aliases which stand - # for a CPU type and a company and sometimes even an OS. - 386bsd) - basic_machine=i386-unknown - os=-bsd - ;; - 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) - basic_machine=m68000-att - ;; - 3b*) - basic_machine=we32k-att - ;; - a29khif) - basic_machine=a29k-amd - os=-udi - ;; - abacus) - basic_machine=abacus-unknown - ;; - adobe68k) - basic_machine=m68010-adobe - os=-scout - ;; - alliant | fx80) - basic_machine=fx80-alliant - ;; - altos | altos3068) - basic_machine=m68k-altos - ;; - am29k) - basic_machine=a29k-none - os=-bsd - ;; - amd64) - basic_machine=x86_64-pc - ;; - amd64-*) - basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - amdahl) - basic_machine=580-amdahl - os=-sysv - ;; - amiga | amiga-*) - basic_machine=m68k-unknown - ;; - amigaos | amigados) - basic_machine=m68k-unknown - os=-amigaos - ;; - amigaunix | amix) - basic_machine=m68k-unknown - os=-sysv4 - ;; - apollo68) - basic_machine=m68k-apollo - os=-sysv - ;; - apollo68bsd) - basic_machine=m68k-apollo - os=-bsd - ;; - aros) - basic_machine=i386-pc - os=-aros - ;; - aux) - basic_machine=m68k-apple - os=-aux - ;; - balance) - basic_machine=ns32k-sequent - os=-dynix - ;; - blackfin) - basic_machine=bfin-unknown - os=-linux - ;; - blackfin-*) - basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` - os=-linux - ;; - c90) - basic_machine=c90-cray - os=-unicos - ;; - cegcc) - basic_machine=arm-unknown - os=-cegcc - ;; - convex-c1) - basic_machine=c1-convex - os=-bsd - ;; - convex-c2) - basic_machine=c2-convex - os=-bsd - ;; - convex-c32) - basic_machine=c32-convex - os=-bsd - ;; - convex-c34) - basic_machine=c34-convex - os=-bsd - ;; - convex-c38) - basic_machine=c38-convex - os=-bsd - ;; - cray | j90) - basic_machine=j90-cray - os=-unicos - ;; - craynv) - basic_machine=craynv-cray - os=-unicosmp - ;; - cr16) - basic_machine=cr16-unknown - os=-elf - ;; - crds | unos) - basic_machine=m68k-crds - ;; - crisv32 | crisv32-* | etraxfs*) - basic_machine=crisv32-axis - ;; - cris | cris-* | etrax*) - basic_machine=cris-axis - ;; - crx) - basic_machine=crx-unknown - os=-elf - ;; - da30 | da30-*) - basic_machine=m68k-da30 - ;; - decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) - basic_machine=mips-dec - ;; - decsystem10* | dec10*) - basic_machine=pdp10-dec - os=-tops10 - ;; - decsystem20* | dec20*) - basic_machine=pdp10-dec - os=-tops20 - ;; - delta | 3300 | motorola-3300 | motorola-delta \ - | 3300-motorola | delta-motorola) - basic_machine=m68k-motorola - ;; - delta88) - basic_machine=m88k-motorola - os=-sysv3 - ;; - dicos) - basic_machine=i686-pc - os=-dicos - ;; - djgpp) - basic_machine=i586-pc - os=-msdosdjgpp - ;; - dpx20 | dpx20-*) - basic_machine=rs6000-bull - os=-bosx - ;; - dpx2* | dpx2*-bull) - basic_machine=m68k-bull - os=-sysv3 - ;; - ebmon29k) - basic_machine=a29k-amd - os=-ebmon - ;; - elxsi) - basic_machine=elxsi-elxsi - os=-bsd - ;; - encore | umax | mmax) - basic_machine=ns32k-encore - ;; - es1800 | OSE68k | ose68k | ose | OSE) - basic_machine=m68k-ericsson - os=-ose - ;; - fx2800) - basic_machine=i860-alliant - ;; - genix) - basic_machine=ns32k-ns - ;; - gmicro) - basic_machine=tron-gmicro - os=-sysv - ;; - go32) - basic_machine=i386-pc - os=-go32 - ;; - h3050r* | hiux*) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - h8300hms) - basic_machine=h8300-hitachi - os=-hms - ;; - h8300xray) - basic_machine=h8300-hitachi - os=-xray - ;; - h8500hms) - basic_machine=h8500-hitachi - os=-hms - ;; - harris) - basic_machine=m88k-harris - os=-sysv3 - ;; - hp300-*) - basic_machine=m68k-hp - ;; - hp300bsd) - basic_machine=m68k-hp - os=-bsd - ;; - hp300hpux) - basic_machine=m68k-hp - os=-hpux - ;; - hp3k9[0-9][0-9] | hp9[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hp9k2[0-9][0-9] | hp9k31[0-9]) - basic_machine=m68000-hp - ;; - hp9k3[2-9][0-9]) - basic_machine=m68k-hp - ;; - hp9k6[0-9][0-9] | hp6[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hp9k7[0-79][0-9] | hp7[0-79][0-9]) - basic_machine=hppa1.1-hp - ;; - hp9k78[0-9] | hp78[0-9]) - # FIXME: really hppa2.0-hp - basic_machine=hppa1.1-hp - ;; - hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) - # FIXME: really hppa2.0-hp - basic_machine=hppa1.1-hp - ;; - hp9k8[0-9][13679] | hp8[0-9][13679]) - basic_machine=hppa1.1-hp - ;; - hp9k8[0-9][0-9] | hp8[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hppa-next) - os=-nextstep3 - ;; - hppaosf) - basic_machine=hppa1.1-hp - os=-osf - ;; - hppro) - basic_machine=hppa1.1-hp - os=-proelf - ;; - i370-ibm* | ibm*) - basic_machine=i370-ibm - ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? - i*86v32) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv32 - ;; - i*86v4*) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv4 - ;; - i*86v) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv - ;; - i*86sol2) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-solaris2 - ;; - i386mach) - basic_machine=i386-mach - os=-mach - ;; - i386-vsta | vsta) - basic_machine=i386-unknown - os=-vsta - ;; - iris | iris4d) - basic_machine=mips-sgi - case $os in - -irix*) - ;; - *) - os=-irix4 - ;; - esac - ;; - isi68 | isi) - basic_machine=m68k-isi - os=-sysv - ;; - m68knommu) - basic_machine=m68k-unknown - os=-linux - ;; - m68knommu-*) - basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` - os=-linux - ;; - m88k-omron*) - basic_machine=m88k-omron - ;; - magnum | m3230) - basic_machine=mips-mips - os=-sysv - ;; - merlin) - basic_machine=ns32k-utek - os=-sysv - ;; - mingw32) - basic_machine=i386-pc - os=-mingw32 - ;; - mingw32ce) - basic_machine=arm-unknown - os=-mingw32ce - ;; - miniframe) - basic_machine=m68000-convergent - ;; - *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) - basic_machine=m68k-atari - os=-mint - ;; - mips3*-*) - basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` - ;; - mips3*) - basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown - ;; - monitor) - basic_machine=m68k-rom68k - os=-coff - ;; - morphos) - basic_machine=powerpc-unknown - os=-morphos - ;; - msdos) - basic_machine=i386-pc - os=-msdos - ;; - ms1-*) - basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` - ;; - mvs) - basic_machine=i370-ibm - os=-mvs - ;; - ncr3000) - basic_machine=i486-ncr - os=-sysv4 - ;; - netbsd386) - basic_machine=i386-unknown - os=-netbsd - ;; - netwinder) - basic_machine=armv4l-rebel - os=-linux - ;; - news | news700 | news800 | news900) - basic_machine=m68k-sony - os=-newsos - ;; - news1000) - basic_machine=m68030-sony - os=-newsos - ;; - news-3600 | risc-news) - basic_machine=mips-sony - os=-newsos - ;; - necv70) - basic_machine=v70-nec - os=-sysv - ;; - next | m*-next ) - basic_machine=m68k-next - case $os in - -nextstep* ) - ;; - -ns2*) - os=-nextstep2 - ;; - *) - os=-nextstep3 - ;; - esac - ;; - nh3000) - basic_machine=m68k-harris - os=-cxux - ;; - nh[45]000) - basic_machine=m88k-harris - os=-cxux - ;; - nindy960) - basic_machine=i960-intel - os=-nindy - ;; - mon960) - basic_machine=i960-intel - os=-mon960 - ;; - nonstopux) - basic_machine=mips-compaq - os=-nonstopux - ;; - np1) - basic_machine=np1-gould - ;; - nsr-tandem) - basic_machine=nsr-tandem - ;; - op50n-* | op60c-*) - basic_machine=hppa1.1-oki - os=-proelf - ;; - openrisc | openrisc-*) - basic_machine=or32-unknown - ;; - os400) - basic_machine=powerpc-ibm - os=-os400 - ;; - OSE68000 | ose68000) - basic_machine=m68000-ericsson - os=-ose - ;; - os68k) - basic_machine=m68k-none - os=-os68k - ;; - pa-hitachi) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - paragon) - basic_machine=i860-intel - os=-osf - ;; - parisc) - basic_machine=hppa-unknown - os=-linux - ;; - parisc-*) - basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` - os=-linux - ;; - pbd) - basic_machine=sparc-tti - ;; - pbb) - basic_machine=m68k-tti - ;; - pc532 | pc532-*) - basic_machine=ns32k-pc532 - ;; - pc98) - basic_machine=i386-pc - ;; - pc98-*) - basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentium | p5 | k5 | k6 | nexgen | viac3) - basic_machine=i586-pc - ;; - pentiumpro | p6 | 6x86 | athlon | athlon_*) - basic_machine=i686-pc - ;; - pentiumii | pentium2 | pentiumiii | pentium3) - basic_machine=i686-pc - ;; - pentium4) - basic_machine=i786-pc - ;; - pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) - basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentiumpro-* | p6-* | 6x86-* | athlon-*) - basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) - basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentium4-*) - basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pn) - basic_machine=pn-gould - ;; - power) basic_machine=power-ibm - ;; - ppc) basic_machine=powerpc-unknown - ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ppcle | powerpclittle | ppc-le | powerpc-little) - basic_machine=powerpcle-unknown - ;; - ppcle-* | powerpclittle-*) - basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ppc64) basic_machine=powerpc64-unknown - ;; - ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ppc64le | powerpc64little | ppc64-le | powerpc64-little) - basic_machine=powerpc64le-unknown - ;; - ppc64le-* | powerpc64little-*) - basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ps2) - basic_machine=i386-ibm - ;; - pw32) - basic_machine=i586-unknown - os=-pw32 - ;; - rdos) - basic_machine=i386-pc - os=-rdos - ;; - rom68k) - basic_machine=m68k-rom68k - os=-coff - ;; - rm[46]00) - basic_machine=mips-siemens - ;; - rtpc | rtpc-*) - basic_machine=romp-ibm - ;; - s390 | s390-*) - basic_machine=s390-ibm - ;; - s390x | s390x-*) - basic_machine=s390x-ibm - ;; - sa29200) - basic_machine=a29k-amd - os=-udi - ;; - sb1) - basic_machine=mipsisa64sb1-unknown - ;; - sb1el) - basic_machine=mipsisa64sb1el-unknown - ;; - sde) - basic_machine=mipsisa32-sde - os=-elf - ;; - sei) - basic_machine=mips-sei - os=-seiux - ;; - sequent) - basic_machine=i386-sequent - ;; - sh) - basic_machine=sh-hitachi - os=-hms - ;; - sh5el) - basic_machine=sh5le-unknown - ;; - sh64) - basic_machine=sh64-unknown - ;; - sparclite-wrs | simso-wrs) - basic_machine=sparclite-wrs - os=-vxworks - ;; - sps7) - basic_machine=m68k-bull - os=-sysv2 - ;; - spur) - basic_machine=spur-unknown - ;; - st2000) - basic_machine=m68k-tandem - ;; - stratus) - basic_machine=i860-stratus - os=-sysv4 - ;; - sun2) - basic_machine=m68000-sun - ;; - sun2os3) - basic_machine=m68000-sun - os=-sunos3 - ;; - sun2os4) - basic_machine=m68000-sun - os=-sunos4 - ;; - sun3os3) - basic_machine=m68k-sun - os=-sunos3 - ;; - sun3os4) - basic_machine=m68k-sun - os=-sunos4 - ;; - sun4os3) - basic_machine=sparc-sun - os=-sunos3 - ;; - sun4os4) - basic_machine=sparc-sun - os=-sunos4 - ;; - sun4sol2) - basic_machine=sparc-sun - os=-solaris2 - ;; - sun3 | sun3-*) - basic_machine=m68k-sun - ;; - sun4) - basic_machine=sparc-sun - ;; - sun386 | sun386i | roadrunner) - basic_machine=i386-sun - ;; - sv1) - basic_machine=sv1-cray - os=-unicos - ;; - symmetry) - basic_machine=i386-sequent - os=-dynix - ;; - t3e) - basic_machine=alphaev5-cray - os=-unicos - ;; - t90) - basic_machine=t90-cray - os=-unicos - ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff - ;; - tile*) - basic_machine=tile-unknown - os=-linux-gnu - ;; - tx39) - basic_machine=mipstx39-unknown - ;; - tx39el) - basic_machine=mipstx39el-unknown - ;; - toad1) - basic_machine=pdp10-xkl - os=-tops20 - ;; - tower | tower-32) - basic_machine=m68k-ncr - ;; - tpf) - basic_machine=s390x-ibm - os=-tpf - ;; - udi29k) - basic_machine=a29k-amd - os=-udi - ;; - ultra3) - basic_machine=a29k-nyu - os=-sym1 - ;; - v810 | necv810) - basic_machine=v810-nec - os=-none - ;; - vaxv) - basic_machine=vax-dec - os=-sysv - ;; - vms) - basic_machine=vax-dec - os=-vms - ;; - vpp*|vx|vx-*) - basic_machine=f301-fujitsu - ;; - vxworks960) - basic_machine=i960-wrs - os=-vxworks - ;; - vxworks68) - basic_machine=m68k-wrs - os=-vxworks - ;; - vxworks29k) - basic_machine=a29k-wrs - os=-vxworks - ;; - w65*) - basic_machine=w65-wdc - os=-none - ;; - w89k-*) - basic_machine=hppa1.1-winbond - os=-proelf - ;; - xbox) - basic_machine=i686-pc - os=-mingw32 - ;; - xps | xps100) - basic_machine=xps100-honeywell - ;; - ymp) - basic_machine=ymp-cray - os=-unicos - ;; - z8k-*-coff) - basic_machine=z8k-unknown - os=-sim - ;; - z80-*-coff) - basic_machine=z80-unknown - os=-sim - ;; - none) - basic_machine=none-none - os=-none - ;; - -# Here we handle the default manufacturer of certain CPU types. It is in -# some cases the only manufacturer, in others, it is the most popular. - w89k) - basic_machine=hppa1.1-winbond - ;; - op50n) - basic_machine=hppa1.1-oki - ;; - op60c) - basic_machine=hppa1.1-oki - ;; - romp) - basic_machine=romp-ibm - ;; - mmix) - basic_machine=mmix-knuth - ;; - rs6000) - basic_machine=rs6000-ibm - ;; - vax) - basic_machine=vax-dec - ;; - pdp10) - # there are many clones, so DEC is not a safe bet - basic_machine=pdp10-unknown - ;; - pdp11) - basic_machine=pdp11-dec - ;; - we32k) - basic_machine=we32k-att - ;; - sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) - basic_machine=sh-unknown - ;; - sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) - basic_machine=sparc-sun - ;; - cydra) - basic_machine=cydra-cydrome - ;; - orion) - basic_machine=orion-highlevel - ;; - orion105) - basic_machine=clipper-highlevel - ;; - mac | mpw | mac-mpw) - basic_machine=m68k-apple - ;; - pmac | pmac-mpw) - basic_machine=powerpc-apple - ;; - *-unknown) - # Make sure to match an already-canonicalized machine name. - ;; - *) - echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 - exit 1 - ;; -esac - -# Here we canonicalize certain aliases for manufacturers. -case $basic_machine in - *-digital*) - basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` - ;; - *-commodore*) - basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` - ;; - *) - ;; -esac - -# Decode manufacturer-specific aliases for certain operating systems. - -if [ x"$os" != x"" ] -then -case $os in - # First match some system type aliases - # that might get confused with valid system types. - # -solaris* is a basic system type, with this one exception. - -solaris1 | -solaris1.*) - os=`echo $os | sed -e 's|solaris1|sunos4|'` - ;; - -solaris) - os=-solaris2 - ;; - -svr4*) - os=-sysv4 - ;; - -unixware*) - os=-sysv4.2uw - ;; - -gnu/linux*) - os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` - ;; - # First accept the basic system types. - # The portable systems comes first. - # Each alternative MUST END IN A *, to match a version number. - # -sysv* is not here because it comes later, after sysvr4. - -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ - | -kopensolaris* \ - | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* | -aros* \ - | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ - | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ - | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -openbsd* | -solidbsd* \ - | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ - | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ - | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ - | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* | -cegcc* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ - | -uxpv* | -beos* | -mpeix* | -udk* \ - | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ - | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ - | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ - | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ - | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ - | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) - # Remember, each alternative MUST END IN *, to match a version number. - ;; - -qnx*) - case $basic_machine in - x86-* | i*86-*) - ;; - *) - os=-nto$os - ;; - esac - ;; - -nto-qnx*) - ;; - -nto*) - os=`echo $os | sed -e 's|nto|nto-qnx|'` - ;; - -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ - | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ - | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) - ;; - -mac*) - os=`echo $os | sed -e 's|mac|macos|'` - ;; - -linux-dietlibc) - os=-linux-dietlibc - ;; - -linux*) - os=`echo $os | sed -e 's|linux|linux-gnu|'` - ;; - -sunos5*) - os=`echo $os | sed -e 's|sunos5|solaris2|'` - ;; - -sunos6*) - os=`echo $os | sed -e 's|sunos6|solaris3|'` - ;; - -opened*) - os=-openedition - ;; - -os400*) - os=-os400 - ;; - -wince*) - os=-wince - ;; - -osfrose*) - os=-osfrose - ;; - -osf*) - os=-osf - ;; - -utek*) - os=-bsd - ;; - -dynix*) - os=-bsd - ;; - -acis*) - os=-aos - ;; - -atheos*) - os=-atheos - ;; - -syllable*) - os=-syllable - ;; - -386bsd) - os=-bsd - ;; - -ctix* | -uts*) - os=-sysv - ;; - -nova*) - os=-rtmk-nova - ;; - -ns2 ) - os=-nextstep2 - ;; - -nsk*) - os=-nsk - ;; - # Preserve the version number of sinix5. - -sinix5.*) - os=`echo $os | sed -e 's|sinix|sysv|'` - ;; - -sinix*) - os=-sysv4 - ;; - -tpf*) - os=-tpf - ;; - -triton*) - os=-sysv3 - ;; - -oss*) - os=-sysv3 - ;; - -svr4) - os=-sysv4 - ;; - -svr3) - os=-sysv3 - ;; - -sysvr4) - os=-sysv4 - ;; - # This must come after -sysvr4. - -sysv*) - ;; - -ose*) - os=-ose - ;; - -es1800*) - os=-ose - ;; - -xenix) - os=-xenix - ;; - -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) - os=-mint - ;; - -aros*) - os=-aros - ;; - -kaos*) - os=-kaos - ;; - -zvmoe) - os=-zvmoe - ;; - -dicos*) - os=-dicos - ;; - -none) - ;; - *) - # Get rid of the `-' at the beginning of $os. - os=`echo $os | sed 's/[^-]*-//'` - echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 - exit 1 - ;; -esac -else - -# Here we handle the default operating systems that come with various machines. -# The value should be what the vendor currently ships out the door with their -# machine or put another way, the most popular os provided with the machine. - -# Note that if you're going to try to match "-MANUFACTURER" here (say, -# "-sun"), then you have to tell the case statement up towards the top -# that MANUFACTURER isn't an operating system. Otherwise, code above -# will signal an error saying that MANUFACTURER isn't an operating -# system, and we'll never get to this point. - -case $basic_machine in - score-*) - os=-elf - ;; - spu-*) - os=-elf - ;; - *-acorn) - os=-riscix1.2 - ;; - arm*-rebel) - os=-linux - ;; - arm*-semi) - os=-aout - ;; - c4x-* | tic4x-*) - os=-coff - ;; - # This must come before the *-dec entry. - pdp10-*) - os=-tops20 - ;; - pdp11-*) - os=-none - ;; - *-dec | vax-*) - os=-ultrix4.2 - ;; - m68*-apollo) - os=-domain - ;; - i386-sun) - os=-sunos4.0.2 - ;; - m68000-sun) - os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 - ;; - m68*-cisco) - os=-aout - ;; - mep-*) - os=-elf - ;; - mips*-cisco) - os=-elf - ;; - mips*-*) - os=-elf - ;; - or32-*) - os=-coff - ;; - *-tti) # must be before sparc entry or we get the wrong os. - os=-sysv3 - ;; - sparc-* | *-sun) - os=-sunos4.1.1 - ;; - *-be) - os=-beos - ;; - *-haiku) - os=-haiku - ;; - *-ibm) - os=-aix - ;; - *-knuth) - os=-mmixware - ;; - *-wec) - os=-proelf - ;; - *-winbond) - os=-proelf - ;; - *-oki) - os=-proelf - ;; - *-hp) - os=-hpux - ;; - *-hitachi) - os=-hiux - ;; - i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) - os=-sysv - ;; - *-cbm) - os=-amigaos - ;; - *-dg) - os=-dgux - ;; - *-dolphin) - os=-sysv3 - ;; - m68k-ccur) - os=-rtu - ;; - m88k-omron*) - os=-luna - ;; - *-next ) - os=-nextstep - ;; - *-sequent) - os=-ptx - ;; - *-crds) - os=-unos - ;; - *-ns) - os=-genix - ;; - i370-*) - os=-mvs - ;; - *-next) - os=-nextstep3 - ;; - *-gould) - os=-sysv - ;; - *-highlevel) - os=-bsd - ;; - *-encore) - os=-bsd - ;; - *-sgi) - os=-irix - ;; - *-siemens) - os=-sysv4 - ;; - *-masscomp) - os=-rtu - ;; - f30[01]-fujitsu | f700-fujitsu) - os=-uxpv - ;; - *-rom68k) - os=-coff - ;; - *-*bug) - os=-coff - ;; - *-apple) - os=-macos - ;; - *-atari*) - os=-mint - ;; - *) - os=-none - ;; -esac -fi - -# Here we handle the case where we know the os, and the CPU type, but not the -# manufacturer. We pick the logical manufacturer. -vendor=unknown -case $basic_machine in - *-unknown) - case $os in - -riscix*) - vendor=acorn - ;; - -sunos*) - vendor=sun - ;; - -aix*) - vendor=ibm - ;; - -beos*) - vendor=be - ;; - -hpux*) - vendor=hp - ;; - -mpeix*) - vendor=hp - ;; - -hiux*) - vendor=hitachi - ;; - -unos*) - vendor=crds - ;; - -dgux*) - vendor=dg - ;; - -luna*) - vendor=omron - ;; - -genix*) - vendor=ns - ;; - -mvs* | -opened*) - vendor=ibm - ;; - -os400*) - vendor=ibm - ;; - -ptx*) - vendor=sequent - ;; - -tpf*) - vendor=ibm - ;; - -vxsim* | -vxworks* | -windiss*) - vendor=wrs - ;; - -aux*) - vendor=apple - ;; - -hms*) - vendor=hitachi - ;; - -mpw* | -macos*) - vendor=apple - ;; - -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) - vendor=atari - ;; - -vos*) - vendor=stratus - ;; - esac - basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` - ;; -esac - -echo $basic_machine$os -exit - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" -# time-stamp-end: "'" -# End:
--- a/configure.ac +++ b/configure.ac @@ -27,13 +27,13 @@ EXTERN_CFLAGS="$CFLAGS" EXTERN_CXXFLAGS="$CXXFLAGS" -AC_INIT([GNU Octave], [3.5.0+], [bug@octave.org], [octave]) +AC_INIT([GNU Octave], [3.5.91+], [http://octave.org/bugs.html], [octave]) dnl PACKAGE_VERSION is set by the AC_INIT VERSION arg OCTAVE_VERSION="$PACKAGE_VERSION" -OCTAVE_API_VERSION_NUMBER="44" +OCTAVE_API_VERSION_NUMBER="46" OCTAVE_API_VERSION="api-v$OCTAVE_API_VERSION_NUMBER+" -OCTAVE_RELEASE_DATE="2011-01-22" +OCTAVE_RELEASE_DATE="2011-12-23" OCTAVE_COPYRIGHT="Copyright (C) 2011 John W. Eaton and others." AC_SUBST(OCTAVE_VERSION) AC_SUBST(OCTAVE_API_VERSION_NUMBER) @@ -80,10 +80,11 @@ ;; *-*-mingw*) AC_MSG_CHECKING([for MSVC compiler]) - AC_PREPROC_IFELSE([ + AC_PREPROC_IFELSE([AC_LANG_SOURCE([ #ifndef _MSC_VER #error "Not MSVC compiler" -#endif], have_msvc=yes, have_msvc=no) +#endif +])], have_msvc=yes, have_msvc=no) AC_MSG_RESULT([$have_msvc]) ;; esac @@ -125,7 +126,7 @@ '$(datadir)/octave/site/$(api_version)/m') OCTAVE_SET_DEFAULT(localverfcnfiledir, '$(datadir)/octave/$(version)/site/m') OCTAVE_SET_DEFAULT(octetcdir, '$(datadir)/octave/$(version)/etc') -OCTAVE_SET_DEFAULT(octlibdir, '$(libdir)/octave-$(version)') +OCTAVE_SET_DEFAULT(octlibdir, '$(libdir)/octave/$(version)') OCTAVE_SET_DEFAULT(archlibdir, '$(libexecdir)/octave/$(version)/exec/$(canonical_host_type)') OCTAVE_SET_DEFAULT(localarchlibdir, @@ -135,13 +136,13 @@ OCTAVE_SET_DEFAULT(localverarchlibdir, '$(libexecdir)/octave/$(version)/site/exec/$(canonical_host_type)') OCTAVE_SET_DEFAULT(octfiledir, - '$(libexecdir)/octave/$(version)/oct/$(canonical_host_type)') + '$(libdir)/octave/$(version)/oct/$(canonical_host_type)') OCTAVE_SET_DEFAULT(localoctfiledir, - '$(libexecdir)/octave/site/oct/$(canonical_host_type)') + '$(libdir)/octave/site/oct/$(canonical_host_type)') OCTAVE_SET_DEFAULT(localapioctfiledir, - '$(libexecdir)/octave/site/oct/$(api_version)/$(canonical_host_type)') + '$(libdir)/octave/site/oct/$(api_version)/$(canonical_host_type)') OCTAVE_SET_DEFAULT(localveroctfiledir, - '$(libexecdir)/octave/$(version)/site/oct/$(canonical_host_type)') + '$(libdir)/octave/$(version)/site/oct/$(canonical_host_type)') OCTAVE_SET_DEFAULT(imagedir, '$(datadir)/octave/$(version)/imagelib') ### Find pkg-config executable (sets $PKG_CONFIG) @@ -166,6 +167,24 @@ AC_DEFINE(BOUNDS_CHECKING, 1, [Define to use internal bounds checking.]) fi +USE_OCTAVE_ALLOCATOR=false +AC_ARG_ENABLE(octave-allocator, + [AS_HELP_STRING([--enable-octave-allocator], + [use the obsolete octave_allocator class for many of Octave's objects (mostly octave_value types). You probably do NOT want to enable this feature. (default is no)])], + [if test "$enableval" = yes; then USE_OCTAVE_ALLOCATOR=true; fi], []) +if $USE_OCTAVE_ALLOCATOR; then + AC_DEFINE(USE_OCTAVE_ALLOCATOR, 1, [Define to use octave_allocator class.]) +fi + +USE_ATOMIC_REFCOUNT=false +AC_ARG_ENABLE(atomic-refcount, + [AS_HELP_STRING([--enable-atomic-refcount], + [use atomic operations for internal reference counting. This is required for thread-safe behavior. (default is no)])], + [if test "$enableval" = yes; then USE_ATOMIC_REFCOUNT=true; fi], []) +if $USE_ATOMIC_REFCOUNT; then + AC_DEFINE(USE_ATOMIC_REFCOUNT, 1, [Define to use atomic operations for reference counting.]) +fi + ### Make it possible to disable running Make in the doc directory. ### Useful for building on systems without TeX, for example. DOCDIR=doc @@ -630,7 +649,7 @@ OCTAVE_CHECK_LIBRARY(qhull, QHull, [Qhull library not found -- this will result in loss of functionality of some geometry functions.], - [qhull/qhull_a.h], [qh_qhull], [], [], + [qhull/libqhull.h libqhull.h qhull/qhull.h qhull.h], [qh_qhull], [], [], [warn_qhull= OCTAVE_CHECK_QHULL_VERSION OCTAVE_CHECK_QHULL_OK([TEXINFO_QHULL="@set HAVE_QHULL" @@ -643,12 +662,17 @@ pcre_fail_msg="to build Octave, you must have the PCRE library and header files installed" -## NB: no need to do separate check for pcre.h header -- checking -## macros is good enough +AC_CHECK_HEADERS([pcre.h pcre/pcre.h]) + AC_CACHE_CHECK([whether pcre.h defines the macros we need], [ac_cv_pcre_h_macros_present], [AC_EGREP_CPP([PCRE_HAS_MACROS_WE_NEED], [ +#if defined (HAVE_PCRE_H) #include <pcre.h> +#elif defined (HAVE_PCRE_PCRE_H) +#include <pcre.h> +#error "NO PCRE HEADER" +#endif #if defined (PCRE_INFO_NAMECOUNT) \ && defined (PCRE_INFO_NAMEENTRYSIZE) \ && defined (PCRE_INFO_NAMETABLE) @@ -899,7 +923,7 @@ save_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS $FLTK_CFLAGS" AC_COMPILE_IFELSE( - AC_LANG_PROGRAM([[#include <FL/gl.h>]], [[int nothing = 0;]]), + [AC_LANG_PROGRAM([[#include <FL/gl.h>]], [[int nothing = 0;]])], [ AC_MSG_RESULT([no]) warn_fltk_opengl="FLTK does not have OpenGL support. Native graphics will be disabled." @@ -962,6 +986,64 @@ ## Restore FFLAGS. FFLAGS="$save_FFLAGS" +## Try again with -ff2c in FFLAGS +if test "x$ax_blas_f77_func_ok" = "xno"; then + save_FFLAGS="$FFLAGS" + FFLAGS="-ff2c $FFLAGS $F77_INTEGER_8_FLAG" + + AX_BLAS_WITH_F77_FUNC([:], [:]) + AX_LAPACK([:], [:]) + + ## Restore FFLAGS, with -ff2c if that was helpful + + if test "x$ax_blas_f77_func_ok" = "xno"; then + FFLAGS="$save_FFLAGS" + else + FFLAGS="-ff2c $save_FFLAGS" + fi +fi + +## On OSX, try again with a wrapper library (without -ff2c!) +if test "x$ax_blas_f77_func_ok" = "xno"; then + case "$canonical_host_type" in + *-*-darwin*) + ## test if wrapper functions help + octave_blaswrap_save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -DUSE_BLASWRAP" + AC_LANG_PUSH(C) + AC_COMPILE_IFELSE([AC_LANG_SOURCE([ +#include "libcruft/misc/blaswrap.c" +])], + [mv conftest.$ac_objext blaswrap.$ac_objext + octave_blaswrap_save_BLAS_LIBS="$BLAS_LIBS" + BLAS_LIBS="blaswrap.$ac_objext -framework vecLib" + + save_FFLAGS="$FFLAGS" + FFLAGS="$FFLAGS $F77_INTEGER_8_FLAG" + + AX_BLAS_WITH_F77_FUNC([:], [:]) + AX_LAPACK([:], [:]) + + ## Restore FFLAGS. + FFLAGS="$save_FFLAGS" + + ## remove temp file + rm -f blaswrap.$ac_objext], + [AC_MSG_FAILURE([cannot compile libcruft/misc/blaswrap.c])]) + AC_LANG_POP(C) + CFLAGS="$octave_blaswrap_save_CFLAGS" + + if test "x$ax_blas_f77_func_ok" = "xno"; then + BLAS_LIBS="$octave_blaswrap_save_BLAS_LIBS" + else + ## wrapper in libcruft, remove from BLAS_LIBS + BLAS_LIBS="`echo $BLAS_LIBS | sed -e 's/blaswrap.[[^ ]]* //g'`" + AC_DEFINE(USE_BLASWRAP, [1], [Define this if BLAS functions need to be wrapped (potentially needed for 64-bit OSX only).]) + fi + ;; + esac +fi + if test "x$ax_blas_f77_func_ok" = "xno"; then if $USE_64_BIT_IDX_T && test "$ax_blas_integer_size_ok" = "no" ; then ## Attempt to be more informative. @@ -1098,7 +1180,7 @@ AC_ARG_ENABLE([dl], [AS_HELP_STRING([--enable-dl], - [create shared libraries (not all systems)])], [ + [allow loading of dynamically linked modules (not all systems)])], [ case "${enableval}" in yes) ENABLE_DYNAMIC_LINKING=true ;; no) ENABLE_DYNAMIC_LINKING=false ;; @@ -1111,16 +1193,6 @@ AC_MSG_ERROR([You can't disable building static AND shared libraries!]) fi -AC_ARG_ENABLE(rpath, - [AS_HELP_STRING([--enable-rpath], - [override the default link options for rpath; e.g., --enable-rpath='-rpath $(octlibdir)'])], - [ if test "$enableval" = no; then use_rpath=false; - else - use_rpath=true - if test "$enableval" = yes; then true; - else enable_rpath_arg="$enableval"; fi - fi], [use_rpath=true]) - CPICFLAG=-fPIC CXXPICFLAG=-fPIC FPICFLAG=-fPIC @@ -1141,7 +1213,6 @@ DL_LDFLAGS='$(SH_LDFLAGS)' MKOCTFILE_DL_LDFLAGS='$(DL_LDFLAGS)' SONAME_FLAGS= -RLD_FLAG= NO_OCT_FILE_STRIP=false TEMPLATE_AR='$(AR)' TEMPLATE_ARFLAGS="$ARFLAGS" @@ -1162,14 +1233,12 @@ ;; *-*-freebsd*) SH_LDFLAGS="-shared -Wl,-x" - RLD_FLAG='-Wl,-rpath -Wl,$(octlibdir)' ;; alpha*-dec-osf*) CPICFLAG= CXXPICFLAG= FPICFLAG= SH_LDFLAGS="-shared -Wl,-expect_unresolved -Wl,'*'" - RLD_FLAG='-Wl,-rpath -Wl,$(octlibdir)' ;; *-*-darwin*) DL_LDFLAGS='-bundle -bundle_loader $(top_builddir)/src/octave $(LDFLAGS)' @@ -1276,11 +1345,9 @@ *-*-linux* | *-*-gnu*) MKOCTFILE_DL_LDFLAGS="-shared -Wl,-Bsymbolic" SONAME_FLAGS='-Wl,-soname -Wl,$@' - RLD_FLAG='-Wl,-rpath -Wl,$(octlibdir)' ;; i[[3456]]86-*-sco3.2v5*) SONAME_FLAGS='-Wl,-h -Wl,$@' - RLD_FLAG= SH_LDFLAGS=-G ;; rs6000-ibm-aix* | powerpc-ibm-aix*) @@ -1297,7 +1364,6 @@ fi SHLEXT=sl SH_LDFLAGS="-shared -fPIC" - RLD_FLAG='-Wl,+b -Wl,$(octlibdir)' library_path_var=SHLIB_PATH ;; ia64*-hp-hpux*) @@ -1307,13 +1373,11 @@ FPICFLAG=+Z fi SH_LDFLAGS="-shared -fPIC" - RLD_FLAG='-Wl,+b -Wl,$(octlibdir)' ;; *-sgi-*) CPICFLAG= CXXPICFLAG= FPICFLAG= - RLD_FLAG='-rpath $(octlibdir)' ;; sparc-sun-sunos4*) if test "$ac_cv_f77_compiler_gnu" = yes; then @@ -1323,7 +1387,6 @@ fi SH_LD=ld SH_LDFLAGS="-assert nodefinitions" - RLD_FLAG='-L$(octlibdir)' ;; sparc-sun-solaris2* | i386-pc-solaris2*) if test "$ac_cv_f77_compiler_gnu" = yes; then @@ -1343,7 +1406,6 @@ CXXPICFLAG=-KPIC SH_LDFLAGS=-G fi - RLD_FLAG='-R $(octlibdir)' ## Template closures in archive libraries need a different mechanism. if test "$GXX" = yes; then true @@ -1357,14 +1419,6 @@ AM_CONDITIONAL([AMCOND_BUILD_COMPILED_AUX_PROGRAMS], [test x$BUILD_COMPILED_AUX_PROGRAMS = xtrue]) -if $use_rpath; then - if test -n "$enable_rpath_arg"; then - RLD_FLAG="$enable_rpath_arg" - fi -else - RLD_FLAG="" -fi - AC_MSG_NOTICE([defining FPICFLAG to be $FPICFLAG]) AC_MSG_NOTICE([defining CPICFLAG to be $CPICFLAG]) AC_MSG_NOTICE([defining CXXPICFLAG to be $CXXPICFLAG]) @@ -1386,7 +1440,6 @@ AC_MSG_NOTICE([defining MKOCTFILE_DL_LDFLAGS to be $MKOCTFILE_DL_LDFLAGS]) AC_MSG_NOTICE([defining SONAME_FLAGS to be $SONAME_FLAGS]) AC_MSG_NOTICE([defining NO_OCT_FILE_STRIP to be $NO_OCT_FILE_STRIP]) -AC_MSG_NOTICE([defining RLD_FLAG to be $RLD_FLAG]) AC_MSG_NOTICE([defining TEMPLATE_AR to be $TEMPLATE_AR]) AC_MSG_NOTICE([defining TEMPLATE_ARFLAGS to be $TEMPLATE_ARFLAGS]) AC_MSG_NOTICE([defining CRUFT_DLL_DEFS to be $CRUFT_DLL_DEFS]) @@ -1415,7 +1468,6 @@ AC_SUBST(MKOCTFILE_DL_LDFLAGS) AC_SUBST(SONAME_FLAGS) AC_SUBST(NO_OCT_FILE_STRIP) -AC_SUBST(RLD_FLAG) AC_SUBST(TEMPLATE_AR) AC_SUBST(TEMPLATE_ARFLAGS) AC_SUBST(CRUFT_DLL_DEFS) @@ -1429,28 +1481,42 @@ AC_CHECK_FUNCS(getpwnam, [], [AC_CHECK_LIB(sun, getpwnam)]) -NO_UNDEFINED_LDFLAG= case "$canonical_host_type" in *-*-mingw*) if test "$have_msvc" = "yes"; then AC_CHECK_LIB(dirent, opendir) LIBS="$LIBS -ladvapi32 -lgdi32 -lws2_32 -luser32 -lkernel32" - NO_UNDEFINED_LDFLAG=-no-undefined else LIBS="$LIBS -lgdi32 -lws2_32 -luser32 -lkernel32" - NO_UNDEFINED_LDFLAG=-no-undefined fi LIBS="$LIBS -lgdi32 -lws2_32 -luser32 -lkernel32" - NO_UNDEFINED_LDFLAG=-no-undefined ;; *-*-msdosmsvc*) AC_CHECK_LIB(dirent, opendir) LIBS="$LIBS -ladvapi32 -lgdi32 -lws2_32 -luser32 -lkernel32" - NO_UNDEFINED_LDFLAG=-no-undefined ;; esac + +AC_ARG_ENABLE([no-undefined], + [AS_HELP_STRING([--enable-no-undefined], + [pass -no-undefined to libtool when linking Octave and its shared libraries (on by default)])], + [case "${enableval}" in + yes) NO_UNDEFINED_LDFLAG="-no-undefined" ;; + no) NO_UNDEFINED_LDFLAG="" ;; + *) AC_MSG_ERROR([bad value ${enableval} for --enable-link-all-depenencies]) ;; + esac], [NO_UNDEFINED_LDFLAG="-no-undefined"]) AC_SUBST(NO_UNDEFINED_LDFLAG) +AC_ARG_ENABLE([link-all-dependencies], + [AS_HELP_STRING([--enable-link-all-dependencies], + [link Octave and its shared libraries with all dependencies, not just those immediately referenced (should not be needed on most systems)])], + [case "${enableval}" in + yes) link_all_deps=true ;; + no) link_all_deps=false ;; + *) AC_MSG_ERROR([bad value ${enableval} for --enable-link-all-depenencies]) ;; + esac], [link_all_deps=false]) +AM_CONDITIONAL([AMCOND_LINK_ALL_DEPS], [test x$link_all_deps = xtrue]) + ### Type stuff. AC_TYPE_MODE_T @@ -1505,6 +1571,26 @@ AC_LANG_PUSH(C++) AC_CHECK_HEADERS(sstream) +AC_CHECK_HEADERS([unordered_map], [], [ + AC_CHECK_HEADERS([tr1/unordered_map])]) +AC_MSG_CHECKING([whether unordered_map requires tr1 namespace]) +unordered_map_requires_tr1_namespace=no +if test "$ac_cv_header_unordered_map" = "yes"; then + ### Have <unordered_map>, but still have to check whether + ### tr1 namespace is required (like MSVC, for instance). + AC_COMPILE_IFELSE([ + AC_LANG_PROGRAM([ + #include <unordered_map> + ], [ + std::unordered_map m; + ])], [], [unordered_map_requires_tr1_namespace=yes]) +elif test "$ac_cv_header_tr1_unordered_map" = "yes"; then + unordered_map_requires_tr1_namespace=yes +fi +if test "$unordered_map_requires_tr1_namespace" = "yes"; then + AC_DEFINE(USE_UNORDERED_MAP_WITH_TR1, 1, [Defines whether unordered_map requires the use of tr1 namespace.]) +fi +AC_MSG_RESULT([$unordered_map_requires_tr1_namespace]) AC_LANG_POP(C++) have_termios_h=no @@ -1585,17 +1671,17 @@ case "$canonical_host_type" in *-*-msdosmsvc | *-*-mingw*) AC_MSG_CHECKING([for required _WIN32_WINNT]) - AC_COMPILE_IFELSE(AC_LANG_PROGRAM([[ + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <windows.h> #if _WIN32_WINNT < 0x0403 #error "Wrong version" -#endif]], []), +#endif]], [])], AC_MSG_RESULT([none]), [ AC_DEFINE(_WIN32_WINNT, 0x0403, [Define to 0x0403 to access InitializeCriticalSectionAndSpinCount]) AC_MSG_RESULT([0x0403])]) AC_MSG_CHECKING([whether _USE_MATH_DEFINES needs to be defined]) - AC_COMPILE_IFELSE(AC_LANG_PROGRAM([[#include <math.h>]], -[[int x = M_LN2;]]), + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <math.h>]], +[[int x = M_LN2;]])], AC_MSG_RESULT([no]), [ AC_DEFINE(_USE_MATH_DEFINES, 1, [Define if your system needs it to define math constants like M_LN2]) AC_MSG_RESULT([yes])]) @@ -1645,12 +1731,18 @@ DL_LIBS="$lt_cv_dlopen_libs" AC_SUBST(DL_LIBS) + ## Disable dynamic linking if capability is not present. if $dlopen_api || $shl_load_api || $loadlibrary_api || $dyld_api; then - ENABLE_DYNAMIC_LINKING=true - AC_DEFINE(ENABLE_DYNAMIC_LINKING, 1, [Define if using dynamic linking]) + true + else + ENABLE_DYNAMIC_LINKING=false fi fi +if $ENABLE_DYNAMIC_LINKING; then + AC_DEFINE(ENABLE_DYNAMIC_LINKING, 1, [Define if using dynamic linking]) +fi + AM_CONDITIONAL([AMCOND_ENABLE_DYNAMIC_LINKING], [test x$ENABLE_DYNAMIC_LINKING = xtrue]) @@ -2011,6 +2103,9 @@ typedef OCTAVE_IDX_TYPE octave_idx_type; #include <stdint.h> + +/* Tag indicating octave config.h has been included */ +#define OCTAVE_CONFIG_INCLUDED 1 ]) ### Do the substitutions in all the Makefiles. @@ -2119,6 +2214,7 @@ gnuplot: $GNUPLOT Do internal array bounds checking: $BOUNDS_CHECKING + Use octave_allocator: $USE_OCTAVE_ALLOCATOR Build static libraries: $STATIC_LIBS Build shared libraries: $SHARED_LIBS Dynamic Linking: $ENABLE_DYNAMIC_LINKING $DL_API_MSG @@ -2386,6 +2482,22 @@ warn_msg_printed=true fi +if $USE_ATOMIC_REFCOUNT; then + AC_MSG_WARN([]) + AC_MSG_WARN([Using atomic reference counting.]) + AC_MSG_WARN([This feature allows to access octave data safely from]) + AC_MSG_WARN([another thread, for instance from a GUI. However this]) + AC_MSG_WARN([results in a small performance penalty in the octave]) + AC_MSG_WARN([interpreter.]) + AC_MSG_WARN([]) + if $USE_OCTAVE_ALLOCATOR; then + AC_MSG_WARN([Thread-safe behavior is not guaranteed unless you also]) + AC_MSG_WARN([disable the use of the octave_allocator class.]) + AC_MSG_WARN([]) + fi + warn_msg_printed=true +fi + if $warn_msg_printed; then AC_MSG_NOTICE([]) AC_MSG_NOTICE([NOTE: libraries may be skipped if a library is not found OR])
deleted file mode 100644 --- a/diff-template +++ /dev/null @@ -1,59 +0,0 @@ -#!/bin/sh -# -# To apply this patch, cd to the top level Octave source directory and -# run this file through /bin/sh. It will first remove any files that -# have been deleted from the source distribution since the last -# release and then update the sources with patch(1). -# -# Diffs for updating *.ps, *.dvi, and *.info* files are not included -# because they can be recreated from the Texinfo files using TeX and -# makeinfo. -# -# Diffs for updating parse.cc and y.tab.h are not included because -# they can be recreated from the file parse.y using bison. -# -# Diffs for updating lex.cc are not included because it can be -# recreated from lex.l using flex. -# -# Diffs for updating the configure script are not included because -# it can be recreated from configure.in using autoconf. -# -# John W. Eaton -# jwe@octave.org - -if test -f src/octave.cc ; then - true -else - echo '***********************************************************' 1>&2 - echo 'You must run this script in the top-level octave directory!' 1>&2 - echo '***********************************************************' 1>&2 - exit 1 -fi - -echo 'removing the bsd-math directory' -rm -rf bsd-math - -echo 'creating libcruft/slatec-fn directory' -mkdir libcruft/slatec-fn - -echo 'removing old test files' -rm -f test/octave.test/index.exp -rm -f test/octave.test/prefer.exp -rm -f test/octave.test/zero-one.exp - -echo 'creating directories for new test files' -mkdir test/octave.test/index/dfi-f -mkdir test/octave.test/index/dfi-t -mkdir test/octave.test/prefer -mkdir test/octave.test/zero-one/fff -mkdir test/octave.test/zero-one/fft -mkdir test/octave.test/zero-one/ftf -mkdir test/octave.test/zero-one/tff -mkdir test/octave.test/zero-one/ftt -mkdir test/octave.test/zero-one/tft -mkdir test/octave.test/zero-one/ttf -mkdir test/octave.test/zero-one/ttt - -echo 'patching existing files' -patch -p1 << \PATCH_EOF -PATCH_EOF
--- a/doc/Makefile.am +++ b/doc/Makefile.am @@ -18,14 +18,13 @@ # along with Octave; see the file COPYING. If not, see # <http://www.gnu.org/licenses/>. -include $(top_srcdir)/common.mk +include $(top_srcdir)/build-aux/common.mk ## Avoid making multiple subdirs in parallel which can lead ## to a confusing error message stream .NOTPARALLEL: EXTRA_DIST = \ - ChangeLog \ Makefile.am \ texinfo.tex \ texmf.cnf
--- a/doc/faq/Makefile.am +++ b/doc/faq/Makefile.am @@ -18,7 +18,7 @@ # along with Octave; see the file COPYING. If not, see # <http://www.gnu.org/licenses/>. -include $(top_srcdir)/common.mk +include $(top_srcdir)/build-aux/common.mk ## Automake generated rules for documentation are not parallel-safe. ## Restrict current directory to run serially
--- a/doc/faq/OctaveFAQ.texi +++ b/doc/faq/OctaveFAQ.texi @@ -63,7 +63,7 @@ * Getting Octave:: * Installation:: * Common problems:: -* How do I ...?:: +* Using Octave:: * @sc{Matlab} compatibility:: * Index:: @end menu @@ -242,7 +242,7 @@ No. Instead of asking us to change the licensing terms for Octave, we recommend that you release your program under terms that are compatible with the GPL so that the free software community can benefit from your -work the same as you have benefitted from the work of all the people who +work the same as you have benefited from the work of all the people who have contributed to Octave. @node How can I cite Octave? @@ -384,7 +384,7 @@ @menu * Functions defined on the command-line:: * Comments with #:: -* Strings delimitted by double quotes ":: +* Strings delimited by double quotes ":: * Line continuation by backslash:: * Informative block closing:: * Coherent syntax:: @@ -424,8 +424,8 @@ files, any file that starts with a string like @samp{#! /usr/bin/octave -q} will be treated as an octave script and be executed by octave. -@node Strings delimitted by double quotes " -@section Strings delimitted by double quotes " +@node Strings delimited by double quotes " +@section Strings delimited by double quotes " The double quote, @samp{"}, may be used to delimit strings, in addition to the single quote @samp{'}. See the previous example. Also, double-quoted strings include backslash interpretation (like C++, C, and @@ -513,7 +513,7 @@ @cindex Unwind-protect -Octave supports a limited form of exception handling modelled after the +Octave supports a limited form of exception handling modeled after the unwind-protect form of Lisp. The general form of an @code{unwind_protect} block looks like this: @@ -644,7 +644,7 @@ @item @url{ftp://ftp.octave.org/pub/octave/} @end itemize -Since Octave is distrubted under the terms of the GPL, you can get +Since Octave is distributed under the terms of the GPL, you can get Octave from a friend who has a copy, or from the Octave website. @node Pre-compiled binary packages @@ -780,15 +780,16 @@ @end itemize @end itemize -@node How do I ...? -@chapter How do I ...? +@node Using Octave +@chapter Using Octave @menu * How do I set the number of displayed decimals?:: +* How does Octave solve linear systems?:: @end menu @cindex Tips and tricks -@cindex How do I @dots{} ? +@cindex Using Octave @node How do I set the number of displayed decimals? @section How do I set the number of displayed decimals? @@ -804,6 +805,18 @@ @end group @end example +@node How does Octave solve linear systems? +@section How does Octave solve linear systems? + +@cindex backslash operator + +In addition to consulting Octave's source for the precise details, the +Octave manual contains a complete high-level description of the +algorithm that Octave uses to decide how to solve a particular linear +system, e.g. how the backslash operator @code{A\x} will be interpreted. +Sections ``Techniques Used for Linear Algebra'' and ``Linear Algebra on +Sparse Matrices'' from the manual describe this procedure. + @node @sc{Matlab} compatibility @chapter Porting programs from @sc{Matlab} to Octave @@ -886,7 +899,7 @@ The authors of Octave consider the nested function scoping rules of @sc{Matlab} to be more problems than they are worth as they introduce -diffiult to find bugs as inadvertantly modifying a variable in a +difficult to find bugs as inadvertently modifying a variable in a nested function that is also used in the parent is particularly easy. @item Differences in core syntax @@ -1020,7 +1033,7 @@ @item Short-circuit & and | operators The @code{&} and @code{|} operators in @sc{Matlab} short-circuit when -included in an if statemant and not otherwise. In Octave only the +included in an if statement and not otherwise. In Octave only the @code{&&} and @code{||} short circuit. Note that this means that @example @@ -1286,7 +1299,7 @@ difference is important on Windows platforms where the "\" character is used in path names, and so single quoted strings should be used in paths. @sc{Matlab} doesn't have double quoted strings and so they should -be avoided if the code will be transfered to a @sc{Matlab} user. +be avoided if the code will be transferred to a @sc{Matlab} user. @end itemize @end itemize
--- a/doc/icons/Makefile.am +++ b/doc/icons/Makefile.am @@ -18,7 +18,7 @@ # along with Octave; see the file COPYING. If not, see # <http://www.gnu.org/licenses/>. -include $(top_srcdir)/common.mk +include $(top_srcdir)/build-aux/common.mk IMAGE_FILES = \ octave-logo.ico \
--- a/doc/interpreter/Makefile.am +++ b/doc/interpreter/Makefile.am @@ -18,7 +18,7 @@ # along with Octave; see the file COPYING. If not, see # <http://www.gnu.org/licenses/>. -include $(top_srcdir)/common.mk +include $(top_srcdir)/build-aux/common.mk ## Automake generated rules for documentation are not parallel-safe. ## Restrict current directory to run serially @@ -118,6 +118,7 @@ fn-idx.texi \ func.texi \ geometry.texi \ + gui.texi \ gpl.texi \ grammar.texi \ image.texi \ @@ -147,7 +148,8 @@ system.texi \ testfun.texi \ tips.texi \ - var.texi + var.texi \ + vectorize.texi TXI_SRC = $(MUNGED_TEXI_SRC:.texi=.txi) @@ -224,6 +226,24 @@ .PHONY: undocumented_list +SPELLCHECK_FILES = $(MUNGED_TEXI_SRC:.texi=.scheck) + +%.scheck: %.texi + $(srcdir)/doccheck/spellcheck $< > $@-t + mv $@-t $@ + [ -s $@ ] || rm -f $@ + +spellcheck: $(SPELLCHECK_FILES) + @if ls *.scheck >/dev/null 2>&1 ; then \ + echo "Spellcheck failed"; \ + echo "Review the following files:"; \ + ls *.scheck ; \ + exit 1 ; \ + else \ + echo "Spellcheck passed"; \ + fi +.PHONY: spellcheck + EXTRA_DIST = \ config-images.sh \ contributors.in \
--- a/doc/interpreter/arith.txi +++ b/doc/interpreter/arith.txi @@ -189,40 +189,18 @@ @DOCSTRING(sumsq) -@DOCSTRING(accumarray) - -@DOCSTRING(accumdim) - @node Utility Functions @section Utility Functions @DOCSTRING(ceil) -@DOCSTRING(curl) - -@DOCSTRING(cross) - -@DOCSTRING(del2) - -@DOCSTRING(divergence) - -@DOCSTRING(factor) - -@DOCSTRING(factorial) - @DOCSTRING(fix) @DOCSTRING(floor) -@DOCSTRING(gcd) - -@DOCSTRING(gradient) +@DOCSTRING(round) -@DOCSTRING(hypot) - -@DOCSTRING(lcm) - -@DOCSTRING(list_primes) +@DOCSTRING(roundb) @DOCSTRING(max) @@ -232,15 +210,37 @@ @DOCSTRING(cummin) +@DOCSTRING(hypot) + +@DOCSTRING(gradient) + +@DOCSTRING(dot) + +@DOCSTRING(cross) + +@DOCSTRING(divergence) + +@DOCSTRING(curl) + +@DOCSTRING(del2) + +@DOCSTRING(factorial) + +@DOCSTRING(factor) + +@DOCSTRING(gcd) + +@DOCSTRING(lcm) + +@DOCSTRING(chop) + +@DOCSTRING(rem) + @DOCSTRING(mod) @DOCSTRING(primes) -@DOCSTRING(rem) - -@DOCSTRING(round) - -@DOCSTRING(roundb) +@DOCSTRING(list_primes) @DOCSTRING(sign)
--- a/doc/interpreter/basics.txi +++ b/doc/interpreter/basics.txi @@ -215,6 +215,7 @@ confirm_recursive_rmdir = false crash_dumps_octave_core = false default_save_options = "-mat-binary" +do_braindead_shortcircuit_evaluation = true fixed_point_format = true history_timestamp_format_string = "%%-- %D %I:%M %p --%%" page_screen_output = false @@ -336,6 +337,11 @@ invoke Octave with the @option{--verbose} option but without the @option{--silent} option. +The @code{dump_prefs} function is useful for determining what customizations +to Octave are possible and which are in effect. + +@DOCSTRING(dump_prefs) + @node Quitting Octave @section Quitting Octave @cindex exiting octave @@ -387,6 +393,18 @@ @DOCSTRING(suppress_verbose_help_message) +The following functions are principally used internally by Octave for +generating the documentation. They are documented here for completeness +and because they may occasionally be useful for users. + +@DOCSTRING(gen_doc_cache) + +@DOCSTRING(get_help_text) + +@DOCSTRING(get_help_text_from_file) + +@DOCSTRING(get_first_help_sentence) + @node Command Line Editing @section Command Line Editing @cindex command-line editing @@ -1040,6 +1058,9 @@ will produce a very quick countdown from '3' to 'Blast Off' as the lines "@code{disp(2);}" and "@code{disp(1);}" won't be executed. +The block comment markers must appear alone as the only characters on a line +(excepting whitespace) in order to be parsed correctly. + @node Comments and the Help System @subsection Comments and the Help System @cindex documenting functions
--- a/doc/interpreter/config-images.sh +++ b/doc/interpreter/config-images.sh @@ -10,8 +10,10 @@ top_srcdir="../.." fi +move_if_change="$top_srcdir/build-aux/move-if-change" + interp_dir=$top_srcdir/doc/interpreter $AWK -f $interp_dir/images.awk < $interp_dir/images > $interp_dir/images.mk-t -$top_srcdir/move-if-change $interp_dir/images.mk-t $interp_dir/images.mk +$move_if_change $interp_dir/images.mk-t $interp_dir/images.mk
--- a/doc/interpreter/container.txi +++ b/doc/interpreter/container.txi @@ -28,13 +28,13 @@ another data container, the comma separated list. @menu -* Data Structures:: +* Structures:: * Cell Arrays:: * Comma Separated Lists:: @end menu -@node Data Structures -@section Data Structures +@node Structures +@section Structures @cindex structures @cindex data structures @@ -370,12 +370,51 @@ @node Creating Structures @subsection Creating Structures +@cindex dynamic naming -As well as indexing a structure with ".", Octave can create a structure -with the @code{struct} command. @code{struct} takes pairs of arguments, -where the first argument in the pair is the fieldname to include in the -structure and the second is a scalar or cell array, representing the -values to include in the structure or structure array. For example: +Besides the index operator ".", Octave can use dynamic naming "(var)" or the +@code{struct} function to create structures. Dynamic naming uses the string +value of a variable as the field name. For example: + +@example +@group +a = "field2"; +x.a = 1; +x.(a) = 2; +x + @result{} x = + @{ + a = 1 + field2 = 2 + @} +@end group +@end example + +More realistically, all of the functions that operate on strings can be used +to build the correct field name before it is entered into the data structure. + +@example +@group +names = ["Bill"; "Mary"; "John"]; +ages = [37; 26; 31]; +for i = 1:rows (names) + database.(names(i,:)) = ages(i); +endfor +database + @result{} database = + @{ + Bill = 37 + Mary = 26 + John = 31 + @} +@end group +@end example + +The third way to create structures is the @code{struct} command. @code{struct} +takes pairs of arguments, where the first argument in the pair is the fieldname +to include in the structure and the second is a scalar or cell array, +representing the values to include in the structure or structure array. For +example: @example @group @@ -414,7 +453,7 @@ @end example If you want to create a struct which contains a cell array as an -individual field, you have to put it into another cell array like in +individual field, you must wrap it in another cell array as shown in the following example: @example @@ -468,9 +507,7 @@ The simplest way to process data in a structure is within a @code{for} loop (@pxref{Looping Over Structure Elements}). A similar effect can be achieved with the @code{structfun} function, where a user defined -function is applied to each field of the structure. - -@DOCSTRING(structfun) +function is applied to each field of the structure. @xref{doc-structfun}. Alternatively, to process the data in a structure, the structure might be converted to another type of container before being treated. @@ -525,16 +562,11 @@ @example @group c@{1:2@} + @result{} ans = a string @result{} ans = - (, - [1] = a string - [2] = - 0.593993 0.627732 0.377037 0.033643 - - ,) @end group @end example @@ -779,6 +811,12 @@ @end group @end example +The indexing operations operate on the cell array and not on the objects +within the cell array. By contrast, @code{cellindexmat} applies matrix indexing +to the objects within each cell array entry and returns the requested values. + +@DOCSTRING(cellindexmat) + @node Cell Arrays of Strings @subsection Cell Arrays of Strings @@ -847,9 +885,7 @@ is to iterate through it using one or more @code{for} loops. The same idea can be implemented more easily through the use of the @code{cellfun} function that calls a user-specified function on all elements of a cell -array. - -@DOCSTRING(cellfun) +array. @xref{doc-cellfun}. An alternative is to convert the data to a different container, such as a matrix or a data structure. Depending on the data this is possible @@ -930,7 +966,7 @@ a = @{1, [2, 3], 4, 5, 6@}; b = [a@{1:4@}] @result{} b = - 1 2 3 4 + 1 2 3 4 5 @end group @end example
--- a/doc/interpreter/contrib.txi +++ b/doc/interpreter/contrib.txi @@ -6,12 +6,12 @@ @c under the terms of the GNU General Public License as published by the @c Free Software Foundation; either version 3 of the License, or (at @c your option) any later version. -@c +@c @c Octave is distributed in the hope that it will be useful, but WITHOUT @c ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or @c FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License @c for more details. -@c +@c @c You should have received a copy of the GNU General Public License @c along with Octave; see the file COPYING. If not, see @c <http://www.gnu.org/licenses/>. @@ -23,7 +23,7 @@ This chapter is dedicated to those who wish to contribute code to Octave. -@menu +@menu * How to Contribute:: * General Guidelines:: * Octave Sources (m-files):: @@ -56,7 +56,7 @@ @example @group hg clone http://www.octave.org/hg/octave - # make a local copy of the octave + # make a local copy of the octave # source repository cd octave # change some sources@dots{} @@ -71,13 +71,13 @@ @end example You may want to get familiar with Mercurial queues to manage your -changesets. Here is a slightly less simple example using Mercurial -queues, where you work on two unrelated changesets in parallel and -update one of the changesets after discussion in the maintainers mailing -list: +changesets. Here is a slightly more complex example using Mercurial +queues, where work on two unrelated changesets is done in parallel and +one of the changesets is updated after discussion on the maintainers +mailing list: @example -hg qnew nasty_bug # create a new patch +hg qnew nasty_bug # create a new patch # change sources@dots{} hg qref # save the changes into the patch # change even more@dots{} @@ -89,7 +89,7 @@ hg qpop # undo the application of the patch # and remove the changes from the # source tree -hg qnew doc_improvements # create an unrelated patch +hg qnew doc_improvements # create an unrelated patch # change doc sources@dots{} hg qref -m "could not find myfav.m in the doc" # save the changes into the patch @@ -115,14 +115,14 @@ comment header (use appropriate year, name and comment marks): @example -## Copyright (C) 1996, 1997, 2007 John W. Eaton <jwe@@octave.org> +## Copyright (C) 1996-2011 John W. Eaton <jwe@@octave.org> ## ## 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 +## either version 3 of the License, or (at your option) any ## later version. ## ## Octave is distributed in the hope that it will be useful, @@ -136,29 +136,52 @@ ## see <http://www.gnu.org/licenses/>. @end example -Always include ChangeLog entries in changesets. After making your -source changes, record and briefly describe the changes in the nearest -ChangeLog file upwards in the directory tree. Use the previous entries -as a template. Your entry should contain your name and email, and the -path to the modified source file relative to the parent directory of the -ChangeLog file. If there are more functions in the file, you should -also include the name of the modified function (in parentheses after -file path). Example: +Always include commit messages in changesets. After making your source +changes, record and briefly describe the changes in your commit message. +You should have previously configured your @file{.hgrc} (or +@file{Mercurial.ini} on Windows) with your name and email, which will +get automatically added to your commit message. Your commit message +should have a brief one-line explanation of what the commit does. If you +are patching a bug, this one-line explanation should mention the bug +number at the end. If your change is small and only touches one file, +this is typically sufficient. If you are modifying several files or +several parts of one file, you should enumerate your changes roughly +following the GNU coding standards on changelogs, like the following +example: @example @group -2010-04-13 David Bateman <dbateman@@free.fr> +look for methods before constructors - * DLD-FUNCTIONS/regexp.cc (octregexp_list): Handle repeated matches - in the list of matches returned by pcre. +* symtab.cc (symbol_table::fcn_info::fcn_info_rep::find): +Look for class methods before constructors, contrary to @sc{matlab} +documentation. + +* test/ctor-vs-method: New directory of test classes. +* test/test_ctor_vs_method.m: New file. +* test/Makefile.am: Include ctor-vs-method/module.mk. +(FCN_FILES): Include test_ctor_vs_method.m in the list. @end group @end example @noindent -The ChangeLog entries should describe what is changed, not why. Any -explanation of why a change is needed should appear as comments in the -code, particularly if there is something that might not be obvious to -someone reading it later. +In this example, the names of files is mentioned, and in parentheses the +name of the function in that file that was modified. There is no need to +mention the function for m-files that only contain one function. The +commit message should describe what is changed, not why. Any explanation +of why a change is needed should appear as comments in the code, +particularly if there is something that might not be obvious to someone +reading it later. + +When submitting code which addresses a known bug on the Octave bug +tracker (@url{http://bugs.octave.org}), please add '(bug #XXXXX)' to the +first line of the commit messages. For example: + +@example +@group +Fix bug for complex input for gradient (bug #34292). +@end group +@end example The preferred comment mark for places that may need further attention is FIXME. @@ -195,7 +218,7 @@ @end example @noindent -but +but @example A([1:i-1;i+1:n], XI(:,2:n-1)) @@ -210,7 +233,7 @@ @code{endswitch}) rather than generic @code{end}. Enclose the @code{if}, @code{while}, @code{until} and @code{switch} -conditions in parentheses, like in C: +conditions in parentheses, like in C: @example @group @@ -254,7 +277,7 @@ for both function definitions and function calls. Recommended indent is 2 spaces. When indenting, indent the statement -after control structures (like @code{if}, @code{while}, etc.). If there +after control structures (like @code{if}, @code{while}, etc.). If there is a compound statement, indent @emph{both} the curly braces and the body of the statement (so that the body gets indented by @emph{two} indents). Example: @@ -273,7 +296,7 @@ @noindent If you have nested @code{if} statements, use extra braces for extra -clarification. +clarification. Split long expressions in such a way that a continuation line starts with an operator rather than identifier. If the split occurs inside
--- a/doc/interpreter/contributors.in +++ b/doc/interpreter/contributors.in @@ -1,5 +1,6 @@ Ben Abbott Andy Adler +Giles Anderson Joel Andersson Muthiah Annamalai Shai Ayal @@ -8,6 +9,7 @@ Alexander Barth David Bateman Heinz Bauschke +Roman Belov Karl Berry David Billinghurst Don Bindner @@ -111,6 +113,7 @@ Heine Kolltveit Ken Kouno Kacper Kowalik +Daniel Kraft Oyvind Kristiansen Piotr Krzyzanowski Volker Kuhlmann @@ -142,14 +145,17 @@ G. D. McBain Alexander Mamonov Christoph Mayer +Júlio Hoffimann Mendes Thorsten Meyer Petr Mikulik Stefan Monnier Antoine Moreau Kai P. Mueller +Hannes Müller Victor Munoz Carmen Navarrete Todd Neal +Philip Nienhuis Al Niessner Rick Niles Takuji Nishimura @@ -204,7 +210,9 @@ Thomas L. Scofield Daniel J. Sebald Dmitri A. Sergatskov +Vanya Sergeev Baylis Shanks +Andriy Shinkarchuck Joseph P. Skudlarek John Smith Julius Smith @@ -231,6 +239,7 @@ Frederick Umminger Utkarsh Upadhyay Stefan van der Walt +David Wells Peter Van Wieren James R. Van Zandt Gregory Vanuxem @@ -243,6 +252,7 @@ Andreas Weingessel Michael Weitzel Fook Fah Yap +Sean Young Michael Zeising Federico Zenith Alex Zvoleff
--- a/doc/interpreter/data.txi +++ b/doc/interpreter/data.txi @@ -146,7 +146,7 @@ with indices limited to strings, but the syntax is more like C-style structures. -@xref{Data Structures}, for more information. +@xref{Structures}, for more information. @node Cell Array Objects @subsection Cell Array Objects
--- a/doc/interpreter/debug.txi +++ b/doc/interpreter/debug.txi @@ -35,6 +35,8 @@ * Breakpoints:: * Debug Mode:: * Call Stack:: +* Profiling:: +* Profiler Example:: @end menu @node Entering Debug Mode @@ -89,7 +91,7 @@ @example @group dbstop ("asind", 1) -@result{} 27 +@result{} 28 @end group @end example @@ -102,7 +104,7 @@ @noindent Taking the above as an example, @code{dbstatus ("asind")} should return -27. The breakpoints can then be cleared with the @code{dbclear} function +28. The breakpoints can then be cleared with the @code{dbclear} function @DOCSTRING(dbclear) @@ -182,3 +184,258 @@ @DOCSTRING(dbup) @DOCSTRING(dbdown) + +@node Profiling +@section Profiling +@cindex profiler +@cindex code profiling + +Octave supports profiling of code execution on a per-function level. If +profiling is enabled, each call to a function (supporting built-ins, +operators, functions in oct- and mex-files, user-defined functions in +Octave code and anonymous functions) is recorded while running Octave +code. After that, this data can aid in analyzing the code behavior, and +is in particular helpful for finding ``hot spots'' in the code which use +up a lot of computation time and are the best targets to spend +optimization efforts on. + +The main command for profiling is @code{profile}, which can be used to +start or stop the profiler and also to query collected data afterwards. +The data is returned in an Octave data structure which can then be +examined or further processed by other routines or tools. + +@DOCSTRING(profile) + +An easy way to get an overview over the collected data is +@code{profshow}. This function takes the profiler data returned by +@code{profile} as input and prints a flat profile, for instance: + +@example +@group + Function Attr Time (s) Calls +---------------------------------------- + >myfib R 2.195 13529 +binary <= 0.061 13529 + binary - 0.050 13528 + binary + 0.026 6764 +@end group +@end example + +This shows that most of the run time was spent executing the function +@samp{myfib}, and some minor proportion evaluating the listed binary +operators. Furthermore, it is shown how often the function was called +and the profiler also records that it is recursive. + +@DOCSTRING(profshow) + +@DOCSTRING(profexplore) + +@node Profiler Example +@section Profiler Example + +Below, we will give a short example of a profiler session. See also +@ref{Profiling} for the documentation of the profiler functions in +detail. Consider the code: + +@example +global N A; + +N = 300; +A = rand (N, N); + +function xt = timesteps (steps, x0, expM) + global N; + + if (steps == 0) + xt = NA (N, 0); + else + xt = NA (N, steps); + x1 = expM * x0; + xt(:, 1) = x1; + xt(:, 2 : end) = timesteps (steps - 1, x1, expM); + endif +endfunction + +function foo () + global N A; + + initial = @@(x) sin (x); + x0 = (initial (linspace (0, 2 * pi, N)))'; + + expA = expm (A); + xt = timesteps (100, x0, expA); +endfunction + +function fib = bar (N) + if (N <= 2) + fib = 1; + else + fib = bar (N - 1) + bar (N - 2); + endif +endfunction +@end example + +If we execute the two main functions, we get: + +@example +@group +tic; foo; toc; +@result{} Elapsed time is 2.37338 seconds. + +tic; bar (20); toc; +@result{} Elapsed time is 2.04952 seconds. +@end group +@end example + +But this does not give much information about where this time is spent; +for instance, whether the single call to @code{expm} is more expensive +or the recursive time-stepping itself. To get a more detailed picture, +we can use the profiler. + +@example +@group +profile on; +foo; +profile off; + +data = profile ('info'); +profshow (data, 10); +@end group +@end example + +This prints a table like: + +@example +@group + # Function Attr Time (s) Calls +--------------------------------------------- + 7 expm 1.034 1 + 3 binary * 0.823 117 + 41 binary \ 0.188 1 + 38 binary ^ 0.126 2 + 43 timesteps R 0.111 101 + 44 NA 0.029 101 + 39 binary + 0.024 8 + 34 norm 0.011 1 + 40 binary - 0.004 101 + 33 balance 0.003 1 +@end group +@end example + +The entries are the individual functions which have been executed (only +the 10 most important ones), together with some information for each of +them. The entries like @samp{binary *} denote operators, while other +entries are ordinary functions. They include both built-ins like +@code{expm} and our own routines (for instance @code{timesteps}). From +this profile, we can immediately deduce that @code{expm} uses up the +largest proportion of the processing time, even though it is only called +once. The second expensive operation is the matrix-vector product in the +routine @code{timesteps}. @footnote{We only know it is the binary +multiplication operator, but fortunately this operator appears only at +one place in the code and thus we know which occurrence takes so much +time. If there were multiple places, we would have to use the +hierarchical profile to find out the exact place which uses up the time +which is not covered in this example.} + +Timing, however, is not the only information available from the profile. +The attribute column shows us that @code{timesteps} calls itself +recursively. This may not be that remarkable in this example (since it's +clear anyway), but could be helpful in a more complex setting. As to the +question of why is there a @samp{binary \} in the output, we can easily +shed some light on that too. Note that @code{data} is a structure array +(@ref{Structure Arrays}) which contains the field @code{FunctionTable}. +This stores the raw data for the profile shown. The number in the first +column of the table gives the index under which the shown function can +be found there. Looking up @code{data.FunctionTable(41)} gives: + +@example +@group + scalar structure containing the fields: + + FunctionName = binary \ + TotalTime = 0.18765 + NumCalls = 1 + IsRecursive = 0 + Parents = 7 + Children = [](1x0) +@end group +@end example + +Here we see the information from the table again, but have additional +fields @code{Parents} and @code{Children}. Those are both arrays, which +contain the indices of functions which have directly called the function +in question (which is entry 7, @code{expm}, in this case) or been called +by it (no functions). Hence, the backslash operator has been used +internally by @code{expm}. + +Now let's take a look at @code{bar}. For this, we start a fresh +profiling session (@code{profile on} does this; the old data is removed +before the profiler is restarted): + +@example +@group +profile on; +bar (20); +profile off; + +profshow (profile ('info')); +@end group +@end example + +This gives: + +@example +@group + # Function Attr Time (s) Calls +------------------------------------------------------- + 1 bar R 2.091 13529 + 2 binary <= 0.062 13529 + 3 binary - 0.042 13528 + 4 binary + 0.023 6764 + 5 profile 0.000 1 + 8 false 0.000 1 + 6 nargin 0.000 1 + 7 binary != 0.000 1 + 9 __profiler_enable__ 0.000 1 +@end group +@end example + +Unsurprisingly, @code{bar} is also recursive. It has been called 13,529 +times in the course of recursively calculating the Fibonacci number in a +suboptimal way, and most of the time was spent in @code{bar} itself. + +Finally, let's say we want to profile the execution of both @code{foo} +and @code{bar} together. Since we already have the run-time data +collected for @code{bar}, we can restart the profiler without clearing +the existing data and collect the missing statistics about @code{foo}. +This is done by: + +@example +@group +profile resume; +foo; +profile off; + +profshow (profile ('info'), 10); +@end group +@end example + +As you can see in the table below, now we have both profiles mixed +together. + +@example +@group + # Function Attr Time (s) Calls +--------------------------------------------- + 1 bar R 2.091 13529 + 16 expm 1.122 1 + 12 binary * 0.798 117 + 46 binary \ 0.185 1 + 45 binary ^ 0.124 2 + 48 timesteps R 0.115 101 + 2 binary <= 0.062 13529 + 3 binary - 0.045 13629 + 4 binary + 0.041 6772 + 49 NA 0.036 101 +@end group +@end example
--- a/doc/interpreter/diffeq.txi +++ b/doc/interpreter/diffeq.txi @@ -28,7 +28,7 @@ * Differential-Algebraic Equations:: @end menu -@cindex Differential Equations +@cindex differential equations @cindex ODE @cindex DAE
deleted file mode 100644 --- a/doc/interpreter/dir +++ /dev/null @@ -1,14 +0,0 @@ --*- Text -*- -This is the file .../info/dir, which contains the topmost node of the -Info hierarchy. The first time you invoke Info you start off -looking at that node, which is (dir)Top. - -File: dir Node: Top This is the top of the INFO tree - This (the Directory node) gives a menu of major topics. - Typing "d" returns here, "q" exits, "?" lists all INFO commands, "h" - gives a primer for first-timers, "mItem<Return>" visits the menu - item named `Item', etc. - -* Menu: The list of major topics begins on the next line. - -* Octave: (octave). Interactive language for numerical computations.
--- a/doc/interpreter/doccheck/aspell-octave.en.pws +++ b/doc/interpreter/doccheck/aspell-octave.en.pws @@ -1,11 +1,12 @@ personal_ws-1.1 en 1 Abramowitz accumarray +Acknowledgements acknowledgements -Acknowledgements ACM adams Affero +afterwards Ahalt aifm AIX @@ -15,11 +16,12 @@ alnum alphanum amd +ANOVA anova -ANOVA Anymap API approximant +arg ARMA arpack ascii @@ -31,15 +33,17 @@ Autoconf autocorrelations autocovariances +autoload Autoload -autoload autoloaded autoloading Autoloading autoregression autoregressions autoscaled +AutoScaling AWK +awt backend Backends backends @@ -49,6 +53,7 @@ bdf betacdf betainv +betaln betapdf betarnd BFGS @@ -78,6 +83,7 @@ breakpoint Brenan Brockwell +BSX builtin builtins ButtonDownFcn @@ -102,6 +108,7 @@ ceil cellstr ChangeLog +changelogs changeset changesets Chaves @@ -126,12 +133,14 @@ cof coffset colamd +collectoutput colorbar colormap colperm Comint Commandline commentstyle +ComplexEqn cond condest conformant @@ -149,9 +158,15 @@ cov CPLEX CreateFcn +CRLF csymamd ctranspose +CTRL CTS +cummax +cummin +cumprod +cumsum cURL Cuthill cxsparse @@ -164,6 +179,8 @@ dataset datasets datasource +datestr +datestrings davis ddd dddd @@ -172,11 +189,12 @@ deallocated deconv deftypefn +Delaunay delaunay -Delaunay delaunayn DeleteFcn delim +deltaX demi Demmel DeskJet @@ -213,6 +231,7 @@ eigenvectors eigs Ekerdt +elementwise Elfers elseif emacs @@ -221,15 +240,18 @@ endian Endian endif +endofline Engle's eof EOF +EOLs EOS eps eq equidistributed equispaced erf +erfc errno Errorbar errorbar @@ -252,8 +274,9 @@ facevertexcdata fcdf femmodel +FFF +FFT fft -FFT fftn fftpack FFTs @@ -264,15 +287,18 @@ filename filenames Filesystem +FinDiffType finv FIRfilter FIXME FlashPix FLTK fltk +fminunc fontconfig fontname forall +foregroundcolor formfeed Fortran fpdf @@ -285,6 +311,7 @@ Frobenius Fs FSF +FunValCheck gamcdf gaminv gampdf @@ -312,23 +339,25 @@ globbing glpk GLS +gnuplot Gnuplot -gnuplot gnuplot's Golub Gonnet +goto Goto -goto gotos GPL gplot grabdemo +GradObj GraphicsMagick Graymap grayscale Graz griddata gswin +GUIs gunzipped gz gzip @@ -339,6 +368,7 @@ Hankel Hanning hardcode +hardcoding Hauberg HDF hdf @@ -358,9 +388,11 @@ holomorphic Horner's horzcat +hostname hotelling Hotelling's HSV +html Hudak Huhdanpaa hygecdf @@ -368,9 +400,10 @@ hygepdf hygernd Hyndman +Hypergeometric hypergeometric -Hypergeometric IEEE +ifelse iff ifft ifftn @@ -388,6 +421,7 @@ inline Inline inpolygon +internet interp interpderiv interpft @@ -400,6 +434,8 @@ ishandle ishghandle isolines +isosurface +isovalue isreal issparse isvector @@ -411,6 +447,7 @@ jpeg JPEG jpg +jvm keybindings keypress Kolmogorov @@ -434,13 +471,14 @@ ldivide ldots le +Leftarrow leftarrow -Leftarrow Leftrightarrow leftrightarrow Lehoucq leq Levinson +LF lfloor li libcruft @@ -451,12 +489,13 @@ lineanchors linefeeds linesearch +linespec linespoints linkprop literalspacing Liu +LM lm -LM loadpath Lobatto logit @@ -494,8 +533,10 @@ matchcase matlab Matsumoto +MaxFunEvals maxima MaxIntervalCount +MaxIter mcnemar McNemar's meansq @@ -503,14 +544,15 @@ Mersenne meshgrid meshgridded +metafile Metafile -metafile metafiles Metafont mex Michelsen Microsystems minima +Minimizers Minitab minval MIP @@ -535,8 +577,11 @@ multi multibyte multiline +multipledelimsasone +MultiSelect mxArray myclass +myfun nabla NaN NaNs @@ -563,6 +608,8 @@ nocompute nolabel noncommercially +nonconformant +nonsmooth nonzeros noperm normcdf @@ -572,24 +619,30 @@ normrnd NorthOutside noscal +noshare notin +nthargout NTSC nul +Numpy Nx nzmax oct octaverc ODEPACK OLS +onCleanup online OpenGL oplus Oppenheim oregonator +Orthogonalize oslash otimes OutputFcn outputfcn +overridable paperorientation paperposition papersize @@ -606,13 +659,14 @@ PCRE PCX pcx +pdf PDF -pdf periodogram perp Petzold's PGF pgm +PGMRES PHP pict pinv @@ -640,6 +694,8 @@ presolver printf priori +Profiler +profiler propto proven ps @@ -656,11 +712,15 @@ qhull QP QQ +qrupdate QRUPDATE -qrupdate +quadcc +quadgk +quadl quadpack +quadv +quantile Quantile -quantile quantiles Quickhull qz @@ -678,12 +738,14 @@ Readline readline recursing +reentrant regex regressor reimported Reindent relicensing ren +repelems repmat resampled resampling @@ -693,6 +755,7 @@ resnorm resparsify RET +returnonerror rfloor RGB Riccati @@ -728,6 +791,7 @@ SIGNUM sim SIMAX +SIMD simplechol simplecholperm simplematrix @@ -766,9 +830,10 @@ Stadlober stairstep Stallman +startup Startup -startup stdnormal +stdout Stegun Stepleman stepsize @@ -787,19 +852,22 @@ subexpressions subfunction Subfunction +subfunctions Subfunctions -subfunctions subinterval +Subintervals +subintervals sublicenses Sublicensing submatrices submatrix +submenu subprocess subprocesses Subprocesses subsasgn +Subscripted subscripted -Subscripted subscripting subseteq subsindex @@ -807,6 +875,7 @@ substring substrings SuiteSparse +sumsq SunOS superiorto supradiagonal @@ -829,8 +898,9 @@ Tcv terminal's tex +texinfo Texinfo -texinfo +textscan th ths tif @@ -849,6 +919,8 @@ tp tpdf traceback +trapz +treatasempty treelayout treeplot tridiagonal @@ -859,11 +931,14 @@ Tx txi typedefs +TypicalX ub UB uchar UID +uimenu uint +uiputfile ulong Ultrix umfpack @@ -918,22 +993,24 @@ voronoi Voronoi Wa +waitbar +waitbars wallis wblcdf wblinv wblpdf wblrnd Weibull +Welch welch -Welch WestOutside whitespace Whitespace whos wienrnd Wikipedia +wilcoxon Wilcoxon -wilcoxon wildcard Wildcards wildcards @@ -969,10 +1046,10 @@ ydata yerrorbar yerrorbars +yy YY -yy +yyyy YYYY -yyyy yyyymmdd yyyymmddTHHMMSS Zechner
--- a/doc/interpreter/doccheck/mk_undocumented_list +++ b/doc/interpreter/doccheck/mk_undocumented_list @@ -87,6 +87,7 @@ F_GETFD F_GETFL finite +fmod fntests F_SETFD F_SETFL @@ -103,6 +104,7 @@ lower lstat nan +octave_tmp_file_name O_APPEND O_ASYNC O_CREAT @@ -118,7 +120,6 @@ SEEK_END semicolon setenv -shell_cmd toc triu unimplemented
--- a/doc/interpreter/dynamic.txi +++ b/doc/interpreter/dynamic.txi @@ -108,11 +108,11 @@ @end example This example although short introduces the basics of writing a C++ -function that can be dynamically linked to Octave. The easiest way to +function that can be dynamically linked to Octave. The easiest way to make available most of the definitions that might be necessary for a C++ oct-file in Octave is to use the @code{#include <octave/oct.h>} header. Note that @file{octave/oct.h} is a C++ header and cannot be directly -@code{#include}'ed in a C source file, nor any other language. What +@code{#include}'ed in a C source file, nor any other language. What follows is mostly C++, with a discussion of other languages in section @ref{Calling External Code from Oct-Files}.
deleted file mode 100644 --- a/doc/interpreter/eos.txi +++ /dev/null @@ -1,515 +0,0 @@ -@c Copyright (C) 1996-2011 Kurt Hornik -@c -@c This file is part of Octave. -@c -@c Octave is free software; you can redistribute it and/or modify it -@c under the terms of the GNU General Public License as published by the -@c Free Software Foundation; either version 3 of the License, or (at -@c your option) any later version. -@c -@c Octave is distributed in the hope that it will be useful, but WITHOUT -@c ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -@c FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -@c for more details. -@c -@c You should have received a copy of the GNU General Public License -@c along with Octave; see the file COPYING. If not, see -@c <http://www.gnu.org/licenses/>. - -@c Written by Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> on 1996/05/17. -@c Last updated by KH on 1997/07/31. - -@node Emacs -@chapter Emacs Octave Support - -The development of Octave code can greatly be facilitated using Emacs -with Octave mode -automatically indent the code, do some of the typing (with Abbrev mode) -and show keywords, comments, strings, etc.@: in different faces (with -Font-lock mode on devices that support it). - -It is also possible to run Octave from within Emacs, either by directly -entering commands at the prompt in a buffer in Inferior Octave mode, or -by interacting with Octave from within a file with Octave code. This is -useful in particular for debugging Octave code. - -Finally, you can convince Octave to use the Emacs info reader for -@kbd{help -i}. - -All functionality is provided by the Emacs Lisp package EOS (for ``Emacs -Octave Support''). This chapter describes how to set up and use this -package. - -Please contact @email{Kurt.Hornik@@wu-wien.ac.at} if you have any questions -or suggestions on using EOS. - -@menu -* Installing EOS:: -* Using Octave Mode:: -* Running Octave From Within Emacs:: -* Using the Emacs Info Reader for Octave:: -@end menu - -@node Installing EOS -@section Installing EOS - -The Emacs package EOS consists of the three files @file{octave-mod.el}, -@file{octave-inf.el}, and @file{octave-hlp.el}. These files, or better -yet their byte-compiled versions, should be somewhere in your Emacs -load-path. - -If you have GNU Emacs with a version number at least as high as 19.35, -you are all set up, because EOS is respectively will be part of GNU -Emacs as of version 19.35. - -Otherwise, copy the three files from the @file{emacs} subdirectory of -the Octave distribution to a place where Emacs can find them (this -depends on how your Emacs was installed). Byte-compile them for speed -if you want. - -@node Using Octave Mode -@section Using Octave Mode - -If you are lucky, your sysadmins have already arranged everything so -that Emacs automatically goes into Octave mode whenever you visit an -Octave code file as characterized by its extension @file{.m}. If not, -proceed as follows. - -@enumerate -@item -To begin using Octave mode for all @file{.m} files you visit, add the -following lines to a file loaded by Emacs at startup time, typically -your @file{~/.emacs} file: - -@lisp -(autoload 'octave-mode "octave-mod" nil t) -(setq auto-mode-alist - (cons '(\"\\\\.m$\" . octave-mode) auto-mode-alist)) -@end lisp - -@item -Finally, to turn on the abbrevs, auto-fill and font-lock features -automatically, also add the following lines to one of the Emacs startup -files: -@lisp -(add-hook 'octave-mode-hook - (lambda () - (abbrev-mode 1) - (auto-fill-mode 1) - (if (eq window-system 'x) - (font-lock-mode 1)))) -@end lisp -See the Emacs manual for more information about how to customize -Font-lock mode. -@end enumerate - -In Octave mode, the following special Emacs commands can be used in -addition to the standard Emacs commands. - -@table @kbd -@item C-h m -Describe the features of Octave mode. - -@item LFD -Reindent the current Octave line, insert a newline and indent the new -line (@code{octave-reindent-then-newline-and-indent}). An abbrev before -point is expanded if @code{abbrev-mode} is non-@code{nil}. - -@item TAB -Indents current Octave line based on its contents and on previous -lines (@code{indent-according-to-mode}). - -@item ; -Insert an ``electric'' semicolon (@code{octave-electric-semi}). If -@code{octave-auto-indent} is non-@code{nil}, reindent the current line. -If @code{octave-auto-newline} is non-@code{nil}, automagically insert a -newline and indent the new line. - -@item ` -Start entering an abbreviation (@code{octave-abbrev-start}). If Abbrev -mode is turned on, typing @kbd{`C-h} or @kbd{`?} lists all abbrevs. -Any other key combination is executed normally. Note that all Octave -abbrevs start with a grave accent. - -@item M-LFD -Break line at point and insert continuation marker and alignment -(@code{octave-split-line}). - -@item M-TAB -Perform completion on Octave symbol preceding point, comparing that -symbol against Octave's reserved words and built-in variables -(@code{octave-complete-symbol}). - -@item M-C-a -Move backward to the beginning of a function -(@code{octave-beginning-of-defun}). -With prefix argument @var{N}, do it that many times if @var{N} is -positive; otherwise, move forward to the @var{N}-th following beginning -of a function. - -@item M-C-e -Move forward to the end of a function (@code{octave-end-of-defun}). -With prefix argument @var{N}, do it that many times if @var{N} is -positive; otherwise, move back to the @var{N}-th preceding end of a -function. - -@item M-C-h -Puts point at beginning and mark at the end of the current Octave -function, i.e., the one containing point or following point -(@code{octave-mark-defun}). - -@item M-C-q -Properly indents the Octave function which contains point -(@code{octave-indent-defun}). - -@item M-; -If there is no comment already on this line, create a code-level comment -(started by two comment characters) if the line is empty, or an in-line -comment (started by one comment character) otherwise -(@code{octave-indent-for-comment}). -Point is left after the start of the comment which is properly aligned. - -@item C-c ; -Puts the comment character @samp{#} (more precisely, the string value of -@code{octave-comment-start}) at the beginning of every line in the -region (@code{octave-comment-region}). With just @kbd{C-u} prefix -argument, uncomment each line in the region. A numeric prefix argument -@var{N} means use @var{N} comment characters. - -@item C-c : -Uncomments every line in the region (@code{octave-uncomment-region}). - -@item C-c C-p -Move one line of Octave code backward, skipping empty and comment lines -(@code{octave-previous-code-line}). With numeric prefix argument -@var{N}, move that many code lines backward (forward if @var{N} is -negative). - -@item C-c C-n -Move one line of Octave code forward, skipping empty and comment lines -(@code{octave-next-code-line}). With numeric prefix argument @var{N}, -move that many code lines forward (backward if @var{N} is negative). - -@item C-c C-a -Move to the `real' beginning of the current line -(@code{octave-beginning-of-line}). If point is in an empty or comment -line, simply go to its beginning; otherwise, move backwards to the -beginning of the first code line which is not inside a continuation -statement, i.e., which does not follow a code line ending in @samp{...} -or @samp{\}, or is inside an open parenthesis list. - -@item C-c C-e -Move to the `real' end of the current line (@code{octave-end-of-line}). -If point is in a code line, move forward to the end of the first Octave -code line which does not end in @samp{...} or @samp{\} or is inside an -open parenthesis list. Otherwise, simply go to the end of the current -line. - -@item C-c M-C-n -Move forward across one balanced begin-end block of Octave code -(@code{octave-forward-block}). With numeric prefix argument @var{N}, -move forward across @var{n} such blocks (backward if @var{N} is -negative). - -@item C-c M-C-p -Move back across one balanced begin-end block of Octave code -(@code{octave-backward-block}). With numeric prefix argument @var{N}, -move backward across @var{N} such blocks (forward if @var{N} is -negative). - -@item C-c M-C-d -Move forward down one begin-end block level of Octave code -(@code{octave-down-block}). With numeric prefix argument, do it that -many times; a negative argument means move backward, but still go down -one level. - -@item C-c M-C-u -Move backward out of one begin-end block level of Octave code -(@code{octave-backward-up-block}). With numeric prefix argument, do it -that many times; a negative argument means move forward, but still to a -less deep spot. - -@item C-c M-C-h -Put point at the beginning of this block, mark at the end -(@code{octave-mark-block}). -The block marked is the one that contains point or follows point. - -@item C-c ] -Close the current block on a separate line (@code{octave-close-block}). -An error is signaled if no block to close is found. - -@item C-c f -Insert a function skeleton, prompting for the function's name, arguments -and return values which have to be entered without parentheses -(@code{octave-insert-defun}). - -@item C-c C-h -Search the function, operator and variable indices of all info files -with documentation for Octave for entries (@code{octave-help}). If used -interactively, the entry is prompted for with completion. If multiple -matches are found, one can cycle through them using the standard -@samp{,} (@code{Info-index-next}) command of the Info reader. - -The variable @code{octave-help-files} is a list of files to search -through and defaults to @code{'("octave")}. If there is also an Octave -Local Guide with corresponding info file, say, @file{octave-LG}, you can -have @code{octave-help} search both files by -@lisp -(setq octave-help-files '("octave" "octave-LG")) -@end lisp -@noindent -in one of your Emacs startup files. - -@end table - -A common problem is that the @key{RET} key does @emph{not} indent the -line to where the new text should go after inserting the newline. This -is because the standard Emacs convention is that @key{RET} (aka -@kbd{C-m}) just adds a newline, whereas @key{LFD} (aka @kbd{C-j}) adds a -newline and indents it. This is particularly inconvenient for users with -keyboards which do not have a special @key{LFD} key at all; in such -cases, it is typically more convenient to use @key{RET} as the @key{LFD} -key (rather than typing @kbd{C-j}). - -You can make @key{RET} do this by adding -@lisp -(define-key octave-mode-map "\C-m" - 'octave-reindent-then-newline-and-indent) -@end lisp -@noindent -to one of your Emacs startup files. Another, more generally applicable -solution is -@lisp -(defun RET-behaves-as-LFD () - (let ((x (key-binding "\C-j"))) - (local-set-key "\C-m" x))) -(add-hook 'octave-mode-hook 'RET-behaves-as-LFD) -@end lisp -@noindent -(this works for all modes by adding to the startup hooks, without having -to know the particular binding of @key{RET} in that mode!). Similar -considerations apply for using @key{M-RET} as @key{M-LFD}. As Barry -A. Warsaw @email{bwarsaw@@cnri.reston.va.us} says in the documentation for his -@code{cc-mode}, ``This is a very common question. @code{:-)} If you want -this to be the default behavior, don't lobby me, lobby RMS!'' - -The following variables can be used to customize Octave mode. - -@table @code -@item octave-auto-indent -Non-@code{nil} means auto-indent the current line after a semicolon or -space. Default is @code{nil}. - -@item octave-auto-newline -Non-@code{nil} means auto-insert a newline and indent after semicolons -are typed. The default value is @code{nil}. - -@item octave-blink-matching-block -Non-@code{nil} means show matching begin of block when inserting a space, -newline or @samp{;} after an else or end keyword. Default is @code{t}. -This is an extremely useful feature for automatically verifying that the -keywords match---if they don't, an error message is displayed. - -@item octave-block-offset -Extra indentation applied to statements in block structures. -Default is 2. - -@item octave-continuation-offset -Extra indentation applied to Octave continuation lines. -Default is 4. - -@item octave-continuation-string -String used for Octave continuation lines. -Normally @samp{\}. - -@item octave-mode-startup-message -If @code{t} (default), a startup message is displayed when Octave mode -is called. - -@end table - -If Font Lock mode is enabled, Octave mode will display -@itemize @bullet -@item -strings in @code{font-lock-string-face} - -@item -comments in @code{font-lock-comment-face} - -@item -the Octave reserved words (such as all block keywords) and the text -functions (such as @samp{cd} or @samp{who}) which are also reserved -using @code{font-lock-keyword-face} - -@item -the built-in operators (@samp{&&}, @samp{==}, @dots{}) using -@code{font-lock-reference-face} - -@item -and the function names in function declarations in -@code{font-lock-function-name-face}. -@end itemize - -There is also rudimentary support for Imenu (currently, function names -can be indexed). - -Customization of Octave mode can be performed by modification of the -variable @code{octave-mode-hook}. It the value of this variable is -non-@code{nil}, turning on Octave mode calls its value. - -If you discover a problem with Octave mode, you can conveniently send a -bug report using @kbd{C-c C-b} (@code{octave-submit-bug-report}). This -automatically sets up a mail buffer with version information already -added. You just need to add a description of the problem, including a -reproducible test case and send the message. - -@node Running Octave From Within Emacs -@section Running Octave From Within Emacs - -The package @file{octave} provides commands for running an inferior -Octave process in a special Emacs buffer. Use -@lisp -M-x run-octave -@end lisp -@noindent -to directly start an inferior Octave process. If Emacs does not know -about this command, add the line -@lisp -(autoload 'run-octave "octave-inf" nil t) -@end lisp -@noindent -to your @file{.emacs} file. - -This will start Octave in a special buffer the name of which is -specified by the variable @code{inferior-octave-buffer} and defaults to -@code{"*Inferior Octave*"}. From within this buffer, you can -interact with the inferior Octave process `as usual', i.e., by entering -Octave commands at the prompt. The buffer is in Inferior Octave mode, -which is derived from the standard Comint mode, a major mode for -interacting with an inferior interpreter. See the documentation for -@code{comint-mode} for more details, and use @kbd{C-h b} to find out -about available special keybindings. - -You can also communicate with an inferior Octave process from within -files with Octave code (i.e., buffers in Octave mode), using the -following commands. - -@table @kbd -@item C-c i l -Send the current line to the inferior Octave process -(@code{octave-send-line}). -With positive prefix argument @var{N}, send that many lines. -If @code{octave-send-line-auto-forward} is non-@code{nil}, go to the -next unsent code line. - -@item C-c i b -Send the current block to the inferior Octave process -(@code{octave-send-block}). - -@item C-c i f -Send the current function to the inferior Octave process -(@code{octave-send-defun}). - -@item C-c i r -Send the region to the inferior Octave process -(@code{octave-send-region}). - -@item C-c i s -Make sure that `inferior-octave-buffer' is displayed -(@code{octave-show-process-buffer}). - -@item C-c i h -Delete all windows that display the inferior Octave buffer -(@code{octave-hide-process-buffer}). - -@item C-c i k -Kill the inferior Octave process and its buffer -(@code{octave-kill-process}). -@end table - -The effect of the commands which send code to the Octave process can be -customized by the following variables. -@table @code -@item octave-send-echo-input -Non-@code{nil} means echo input sent to the inferior Octave process. -Default is @code{t}. - -@item octave-send-show-buffer -Non-@code{nil} means display the buffer running the Octave process after -sending a command (but without selecting it). -Default is @code{t}. -@end table - -If you send code and there is no inferior Octave process yet, it will be -started automatically. - -The startup of the inferior Octave process is highly customizable. -The variable @code{inferior-octave-startup-args} can be used for -specifying command lines arguments to be passed to Octave on startup -as a list of strings. For example, to suppress the startup message and -use `traditional' mode, set this to @code{'("-q" "--traditional")}. -You can also specify a startup file of Octave commands to be loaded on -startup; note that these commands will not produce any visible output -in the process buffer. Which file to use is controlled by the variable -@code{inferior-octave-startup-file}. If this is @code{nil}, the file -@file{~/.emacs-octave} is used if it exists. - -And finally, @code{inferior-octave-mode-hook} is run after starting the -process and putting its buffer into Inferior Octave mode. Hence, if you -like the up and down arrow keys to behave in the interaction buffer as -in the shell, and you want this buffer to use nice colors, add -@lisp -(add-hook 'inferior-octave-mode-hook - (lambda () - (turn-on-font-lock) - (define-key inferior-octave-mode-map [up] - 'comint-previous-input) - (define-key inferior-octave-mode-map [down] - 'comint-next-input))) -@end lisp -@noindent -to your @file{.emacs} file. You could also swap the roles of @kbd{C-a} -(@code{beginning-of-line}) and @code{C-c C-a} (@code{comint-bol}) using -this hook. - -@quotation -@strong{Note:} -If you set your Octave prompts to something different from the defaults, -make sure that @code{inferior-octave-prompt} matches them. -Otherwise, @emph{nothing} will work, because Emacs will have no idea -when Octave is waiting for input, or done sending output. -@end quotation - -@node Using the Emacs Info Reader for Octave -@section Using the Emacs Info Reader for Octave - -You can also set up the Emacs Info reader for dealing with the results -of Octave's @samp{help -i}. For this, the package @file{gnuserv} needs -to be installed, which unfortunately still does not come with GNU Emacs -(it does with XEmacs). It can be retrieved from any GNU Emacs Lisp Code -Directory archive, e.g.@: -@url{ftp://ftp.cis.ohio-state.edu/pub/gnu/emacs/elisp-archive}, -in the @file{packages} subdirectory. The alpha version of an enhanced -version of gnuserv is available at -@url{ftp://ftp.wellfleet.com/netman/psmith/emacs/gnuserv-2.1alpha.tar.gz}. - -If @file{gnuserv} is installed, add the lines -@lisp -(autoload 'octave-help "octave-hlp" nil t) -(require 'gnuserv) -(gnuserv-start) -@end lisp -@noindent -to your @file{.emacs} file. - -You can use either `plain' Emacs Info or the function @code{octave-help} -as your Octave info reader (for @samp{help -i}). In the former case, -set the Octave variable @w{@env{INFO_PROGRAM}} to @code{"info-emacs-info"}. -The latter is perhaps more attractive because it allows to look up keys -in the indices of @emph{several} info files related to Octave (provided -that the Emacs variable @code{octave-help-files} is set correctly). In -this case, set @w{@env{INFO_PROGRAM}} to @code{"info-emacs-octave-help"}. - -If you use Octave from within Emacs, these settings are best done in the -@file{~/.emacs-octave} startup file (or the file pointed to by the Emacs -variable @code{inferior-octave-startup-file}).
--- a/doc/interpreter/errors.txi +++ b/doc/interpreter/errors.txi @@ -49,6 +49,7 @@ @menu * Raising Errors:: * Catching Errors:: +* Recovering From Errors:: @end menu @node Raising Errors @@ -212,6 +213,38 @@ @DOCSTRING(errno_list) +@node Recovering From Errors +@subsection Recovering From Errors + +Octave provides several ways of recovering from errors. There are +@code{try}/@code{catch} blocks, +@code{unwind_protect}/@code{unwind_protect_cleanup} blocks, +and finally the @code{onCleanup} command. + +The @code{onCleanup} command associates an ordinary Octave variable (the +trigger) with an arbitrary function (the action). Whenever the Octave variable +ceases to exist---whether due to a function return, an error, or simply because +the variable has been removed with @code{clear}---then the assigned function +is executed. + +The function can do anything necessary for cleanup such as closing open file +handles, printing an error message, or restoring global variables to their +initial values. The last example is a very convenient idiom for Octave code. +For example: + +@example +@group +function rand42 + old_state = rand ('state'); + restore_state = onCleanup (@@() rand ('state', old_state); + rand ('state', 42); + @dots{} +endfunction # rand generator state restored by onCleanup +@end group +@end example + +@DOCSTRING(onCleanup) + @node Handling Warnings @section Handling Warnings
--- a/doc/interpreter/eval.txi +++ b/doc/interpreter/eval.txi @@ -48,8 +48,6 @@ Newton's method. @example -@cindex Fordyce, A. P. -@findex newtroot function result = newtroot (fname, x) # usage: newtroot (fname, x)
--- a/doc/interpreter/expr.txi +++ b/doc/interpreter/expr.txi @@ -55,28 +55,38 @@ Indices may be scalars, vectors, ranges, or the special operator @samp{:}, which may be used to select entire rows or columns. -Vectors are indexed using a single index expression. Matrices may be -indexed using one or two indices. When using a single index -expression, the elements of the matrix are taken in column-first order; -the dimensions of the output match those of the index expression. For -example, +Vectors are indexed using a single index expression. Matrices (2-D) +and higher multi-dimensional arrays are indexed using either one index +or @math{N} indices where @math{N} is the dimension of the array. +When using a single index expression to index 2-D or higher data the +elements of the array are taken in column-first order (like Fortran). + +The output from indexing assumes the dimensions of the index +expression. For example: @example @group -a (2) # a scalar -a (1:2) # a row vector -a ([1; 2]) # a column vector +a(2) # result is a scalar +a(1:2) # result is a row vector +a([1; 2]) # result is a column vector @end group @end example As a special case, when a colon is used as a single index, the output -is a column vector containing all the elements of the vector or matrix. -For example: +is a column vector containing all the elements of the vector or +matrix. For example: @example -a (:) # a column vector +@group +a(:) # result is a column vector +a(:)' # result is a row vector +@end group @end example +The above two code idioms are often used in place of @code{reshape} +when a simple vector, rather than an arbitrarily sized array, is +needed. + Given the matrix @example @@ -84,68 +94,140 @@ @end example @noindent -all of the following expressions are equivalent +all of the following expressions are equivalent and select the first +row of the matrix. @example @group -a (1, [1, 2]) -a (1, 1:2) -a (1, :) +a(1, [1, 2]) # row 1, columns 1 and 2 +a(1, 1:2) # row 1, columns in range 1-2 +a(1, :) # row 1, all columns +@end group +@end example + +@cindex @code{end}, indexing +@cindex :end + +In index expressions the keyword @code{end} automatically refers to +the last entry for a particular dimension. This magic index can also +be used in ranges and typically eliminates the needs to call +@code{size} or @code{length} to gather array bounds before indexing. +For example: + +@example +@group +a = [1, 2, 3, 4]; + +a(1:end/2) # first half of a => [1, 2] +a(end + 1) = 5; # append element +a(end) = []; # delete element +a(1:2:end) # odd elements of a => [1, 3] +a(2:2:end) # even elements of a => [2, 4] +a(end:-1:1) # reversal of a => [4, 3, 2 , 1] @end group @end example -@noindent -and select the first row of the matrix. +@menu +* Advanced Indexing:: +@end menu + +@node Advanced Indexing +@subsection Advanced Indexing + +An array with @samp{n} dimensions can be indexed using @samp{m} +indices. More generally, the set of index tuples determining the +result is formed by the Cartesian product of the index vectors (or +ranges or scalars). + +For the ordinary and most common case, @w{@code{m == n}}, and each +index corresponds to its respective dimension. If @w{@code{m < n}} +and every index is less than the size of the array in the +@math{i^{th}} dimension, @code{m(i) < n(i)}, then the index expression +is padded with trailing singleton dimensions (@code{[ones (m-n, 1)]}). +If @w{@code{m < n}} but one of the indices @code{m(i)} is outside the +size of the current array, then the last @w{@code{n-m+1}} dimensions +are folded into a single dimension with an extent equal to the product +of extents of the original dimensions. This is easiest to understand +with an example. -In general, an array with @samp{n} dimensions can be indexed using @samp{m} -indices. If @code{n == m}, each index corresponds to its respective dimension. -The set of index tuples determining the result is formed by the Cartesian -product of the index vectors (or ranges or scalars). If @code{n < m}, then the -array is padded by trailing singleton dimensions. If @code{n > m}, the last -@code{n-m+1} dimensions are folded into a single dimension with extent equal to -product of extents of the original dimensions. +@example +a = reshape (1:8, 2, 2, 2) # Create 3-D array +a = + +ans(:,:,1) = + + 1 3 + 2 4 + +ans(:,:,2) = + + 5 7 + 6 8 -@c FIXED -- sections on variable prefer_zero_one_indexing were removed +a(2,1,2); # Case (m == n): ans = 6 +a(2,1); # Case (m < n), idx within array: + # equivalent to a(2,1,1), ans = 2 +a(2,4); # Case (m < n), idx outside array: + # Dimension 2 & 3 folded into new dimension of size 2x2 = 4 + # Select 2nd row, 4th element of [2, 4, 6, 8], ans = 8 +@end example -Indexing a scalar with a vector of ones can be used to create a -vector the same size as the index vector, with each element equal to -the value of the original scalar. For example, the following statements +One advanced use of indexing is to create arrays filled with a single +value. This can be done by using an index of ones on a scalar value. +The result is an object with the dimensions of the index expression +and every element equal to the original scalar. For example, the +following statements @example @group a = 13; -a (ones (1, 4)) +a(ones (1, 4)) @end group @end example @noindent produce a vector whose four elements are all equal to 13. -Similarly, indexing a scalar with two vectors of ones can be used to -create a matrix. For example the following statements +Similarly, by indexing a scalar with two vectors of ones it is +possible to create a matrix. The following statements @example @group a = 13; -a (ones (1, 2), ones (1, 3)) +a(ones (1, 2), ones (1, 3)) @end group @end example @noindent -create a 2 by 3 matrix with all elements equal to 13. +create a 2x3 matrix with all elements equal to 13. The last example could also be written as @example @group -13 (ones (2, 3)) +13(ones (2, 3)) @end group @end example -It should be, noted that @code{ones (1, n)} (a row vector of ones) results in a -range (with zero increment), and is therefore more efficient when used in index -expression than other forms of @dfn{ones}. In particular, when @samp{r} is a -row vector, the expressions +It is more efficient to use indexing rather than the code construction +@code{scalar * ones (N, M, @dots{})} because it avoids the unnecessary +multiplication operation. Moreover, multiplication may not be +defined for the object to be replicated whereas indexing an array is +always defined. The following code shows how to create a 2x3 cell +array from a base unit which is not itself a scalar. + +@example +@group +@{"Hello"@}(ones (2, 3)) +@end group +@end example + +It should be, noted that @code{ones (1, n)} (a row vector of ones) +results in a range (with zero increment). A range is stored +internally as a starting value, increment, end value, and total number +of values; hence, it is more efficient for storage than a vector or +matrix of ones whenever the number of elements is greater than 4. In +particular, when @samp{r} is a row vector, the expressions @example r(ones (1, n), :) @@ -156,17 +238,22 @@ @end example @noindent -will produce identical results, but the first one will be significantly -faster, at least for @samp{r} and @samp{n} large enough. The reason is that -in the first case the index is kept in a compressed form, which allows Octave -to choose a more efficient algorithm to handle the expression. +will produce identical results, but the first one will be +significantly faster, at least for @samp{r} and @samp{n} large enough. +In the first case the index is held in compressed form as a range +which allows Octave to choose a more efficient algorithm to handle the +expression. -In general, for an user unaware of these subtleties, it is best to use -the function @dfn{repmat} for spreading arrays into bigger ones. +A general recommendation, for a user unaware of these subtleties, is +to use the function @code{repmat} for replicating smaller arrays into +bigger ones. -It is also possible to create a matrix with different values. The -following example creates a 10 dimensional row vector @math{a} containing -the values +A second use of indexing is to speed up code. Indexing is a fast +operation and judicious use of it can reduce the requirement for +looping over individual array elements which is a slow operation. + +Consider the following example which creates a 10-element row vector +@math{a} containing the values @tex $a_i = \sqrt{i}$. @end tex @@ -183,20 +270,22 @@ @end example @noindent -Note that it is quite inefficient to create a vector using a loop like -the one shown in the example above. In this particular case, it would -have been much more efficient to use the expression +It is quite inefficient to create a vector using a loop like this. In +this case, it would have been much more efficient to use the +expression @example a = sqrt (1:10); @end example @noindent -thus avoiding the loop entirely. In cases where a loop is still -required, or a number of values must be combined to form a larger -matrix, it is generally much faster to set the size of the matrix first, -and then insert elements using indexing commands. For example, given a -matrix @code{a}, +which avoids the loop entirely. + +In cases where a loop cannot be avoided, or a number of values must be +combined to form a larger matrix, it is generally faster to set the +size of the matrix first (pre-allocate storage), and then insert +elements using indexing commands. For example, given a matrix +@code{a}, @example @group @@ -221,8 +310,8 @@ @end example @noindent -particularly for large matrices because Octave does not have to -repeatedly resize the result. +because Octave does not have to repeatedly resize the intermediate +result. @DOCSTRING(sub2ind) @@ -230,6 +319,8 @@ @DOCSTRING(isindex) +@DOCSTRING(allow_noninteger_range_as_index) + @node Calling Functions @section Calling Functions @@ -421,9 +512,10 @@ @cindex complex-conjugate transpose The following arithmetic operators are available, and work on scalars -and matrices. +and matrices. The element-by-element operators and functions broadcast +(@pxref{Broadcasting}). -@table @code +@table @asis @item @var{x} + @var{y} @opindex + Addition. If both operands are matrices, the number of rows and columns @@ -624,7 +716,8 @@ All of Octave's comparison operators return a value of 1 if the comparison is true, or 0 if it is false. For matrix values, they all -work on an element-by-element basis. For example: +work on an element-by-element basis. Broadcasting rules apply. +@xref{Broadcasting}. For example: @example @group @@ -634,9 +727,9 @@ @end group @end example -If one operand is a scalar and the other is a matrix, the scalar is -compared to each element of the matrix in turn, and the result is the -same size as the matrix. +According to broadcasting rules, if one operand is a scalar and the +other is a matrix, the scalar is compared to each element of the matrix +in turn, and the result is the same size as the matrix. @table @code @item @var{x} < @var{y} @@ -771,8 +864,8 @@ @var{boolean} is false. @end table -For matrix operands, these operators work on an element-by-element -basis. For example, the expression +These operators work on an element-by-element basis. For example, the +expression @example [1, 0; 0, 1] & [1, 0; 2, 3] @@ -781,8 +874,8 @@ @noindent returns a two by two identity matrix. -For the binary operators, the dimensions of the operands must conform if -both are matrices. If one of the operands is a scalar and the other a +For the binary operators, broadcasting rules apply. @xref{Broadcasting}. +In particular, if one of the operands is a scalar and the other a matrix, the operator is applied to the scalar and each element of the matrix. @@ -907,8 +1000,16 @@ arguments because Octave would be forced to try to evaluate both of the operands for the operator @samp{&}. -The ternary operator (?:) is not supported in Octave. If short-circuiting is -not important, it can be replaced by the @code{ifelse} function. +@sc{matlab} has special behavior that allows the operators @samp{&} and +@samp{|} to short-circuit when used in the truth expression for @code{if} and +@code{while} statements. The Octave parser may be instructed to behave in the +same manner, but its use is strongly discouraged. + +@DOCSTRING(do_braindead_shortcircuit_evaluation) + +Finally, the ternary operator (?:) is not supported in Octave. If +short-circuiting is not important, it can be replaced by the @code{ifelse} +function. @DOCSTRING(merge) @@ -1229,51 +1330,62 @@ any such mistake. When operators of equal precedence are used together, the leftmost -operator groups first, except for the assignment and exponentiation -operators, which group in the opposite order. Thus, the expression -@code{a - b + c} groups as @code{(a - b) + c}, but the expression -@code{a = b = c} groups as @code{a = (b = c)}. +operator groups first, except for the assignment operators, which group +in the opposite order. Thus, the expression @code{a - b + c} groups as +@code{(a - b) + c}, but the expression @code{a = b = c} groups as +@code{a = (b = c)}. The precedence of prefix unary operators is important when another operator follows the operand. For example, @code{-x^2} means @code{-(x^2)}, because @samp{-} has lower precedence than @samp{^}. -Here is a table of the operators in Octave, in order of increasing -precedence. +Here is a table of the operators in Octave, in order of decreasing +precedence. Unless noted, all operators group left to right. @table @code -@item statement separators -@samp{;}, @samp{,}. +@item function call and array indexing, cell array indexing, and structure element indexing +@samp{()} @samp{@{@}} @samp{.} + +@item postfix increment, and postfix decrement +@samp{++} @samp{--} + +These operators group right to left. + +@item transpose and exponentiation +@samp{'} @samp{.'} @samp{^} @samp{**} @samp{.^} @samp{.**} -@item assignment -@samp{=}, @samp{+=}, @samp{-=}, @samp{*=},@samp{/=}. This operator -groups right to left. +@item unary plus, unary minus, prefix increment, prefix decrement, and logical "not" +@samp{+} @samp{-} @samp{++} @samp{--} @samp{~} @samp{!} + +@item multiply and divide +@samp{*} @samp{/} @samp{\} @samp{.\} @samp{.*} @samp{./} -@item logical "or" and "and" -@samp{||}, @samp{&&}. +@item add, subtract +@samp{+} @samp{-} -@item element-wise "or" and "and" -@samp{|}, @samp{&}. +@item colon +@samp{:} @item relational -@samp{<}, @samp{<=}, @samp{==}, @samp{>=}, @samp{>}, @samp{!=}, -@samp{~=}. +@samp{<} @samp{<=} @samp{==} @samp{>=} @samp{>} @samp{!=} +@samp{~=} -@item colon -@samp{:}. +@item element-wise "and" +@samp{&} -@item add, subtract -@samp{+}, @samp{-}. +@item element-wise "or" +@samp{|} -@item multiply, divide -@samp{*}, @samp{/}, @samp{\}, @samp{.\}, @samp{.*}, @samp{./}. +@item logical "and" +@samp{&&} -@item transpose -@samp{'}, @samp{.'} +@item logical "or" +@samp{||} -@item unary plus, minus, increment, decrement, and ``not'' -@samp{+}, @samp{-}, @samp{++}, @samp{--}, @samp{!}, @samp{~}. +@item assignment +@samp{=} @samp{+=} @samp{-=} @samp{*=} @samp{/=} @samp{\=} +@samp{^=} @samp{.*=} @samp{./=} @samp{.\=} @samp{.^=} @samp{|=} +@samp{&=} -@item exponentiation -@samp{^}, @samp{**}, @samp{.^}, @samp{.**}. +These operators group right to left. @end table
--- a/doc/interpreter/func.txi +++ b/doc/interpreter/func.txi @@ -289,6 +289,12 @@ dimensions, and it is often desirable to give the individual return values distinct names. +It is possible to use the @code{nthargout} function to obtain only some +of the return values or several at once in a cell array. +@ref{Cell Array Objects} + +@DOCSTRING(nthargout) + In addition to setting @code{nargin} each time a function is called, Octave also automatically initializes @code{nargout} to the number of values that are expected to be returned. This allows you to write @@ -338,12 +344,30 @@ @DOCSTRING(nargout) +It is good practice at the head of a function to verify that it has been called +correctly. In Octave the following idiom is seen frequently + +@example +@group +if (nargin < min_#_inputs || nargin > max_#_inputs) + print_usage (); +endif +@end group +@end example + +@noindent +which stops the function execution and prints a message about the correct +way to call the function whenever the number of inputs is wrong. + +For compatibility with @sc{matlab}, @code{nargchk}, @code{narginchk} and +@code{nargoutchk} are available which provide similar error checking. + @DOCSTRING(nargchk) +@DOCSTRING(narginchk) + @DOCSTRING(nargoutchk) -@DOCSTRING(isargout) - @anchor{doc-varargin} @anchor{doc-varargout} @node Variable-length Argument Lists @section Variable-length Argument Lists @@ -456,6 +480,26 @@ The value of @code{nargin} is not affected by using this declaration. +Return arguments can also be ignored using the same syntax. Functions may +take advantage of ignored outputs to reduce the number of calculations +performed. To do so, use the @code{isargout} function to query whether the +output argument is wanted. For example: + +@example +@group +function [out1, out2] = long_function (x, y, z) + if (isargout (1)) + ## Long calculation + @dots{} + out1 = result; + endif + @dots{} +endfunction +@end group +@end example + +@DOCSTRING(isargout) + @node Variable-length Return Lists @section Variable-length Return Lists @cindex variable-length return lists @@ -1181,8 +1225,6 @@ @DOCSTRING(formula) -@DOCSTRING(vectorize) - @DOCSTRING(symvar) @node Commands @@ -1259,21 +1301,26 @@ @item audio Functions for playing and recording sounds. -@item control -Functions for design and simulation of automatic control systems. +@item deprecated +Out-of-date functions which will eventually be removed from Octave. @item elfun -Elementary functions. +Elementary functions, principally trigonometric. -@item finance -Functions for computing interest payments, investment values, and rates -of return. +@item @@ftp +Class functions for the FTP object. @item general Miscellaneous matrix manipulations, like @code{flipud}, @code{rot90}, and @code{triu}, as well as other basic functions, like @code{ismatrix}, @code{nargchk}, etc. +@item geometry +Functions related to Delaunay triangulation. + +@item help +Functions for Octave's built-in help system. + @item image Image processing tools. These functions require the X Window System. @@ -1287,13 +1334,13 @@ Functions that don't really belong anywhere else. @item optimization -Minimization of functions. +Functions related to minimization, optimization, and root finding. @item path Functions to manage the directory path Octave uses to find functions. @item pkg -Install external packages of functions in Octave. +Package manager for installing external packages of functions in Octave. @item plot Functions for displaying and printing two- and three-dimensional graphs. @@ -1311,10 +1358,11 @@ Functions for handling sparse matrices. @item specfun -Special functions. +Special functions such as @code{bessel} or @code{factor}. @item special-matrix -Functions that create special matrix forms. +Functions that create special matrix forms such as Hilbert or Vandermonde +matrices. @item startup Octave's system-wide startup file. @@ -1326,8 +1374,8 @@ Miscellaneous string-handling functions. @item testfun -Perform unit tests on other functions. +Functions for performing unit tests on other functions. @item time -Functions related to time keeping. +Functions related to time and date processing. @end table
--- a/doc/interpreter/grammar.txi +++ b/doc/interpreter/grammar.txi @@ -16,16 +16,17 @@ @c along with Octave; see the file COPYING. If not, see @c <http://www.gnu.org/licenses/>. -@node Grammar -@appendix Grammar +@node Grammar and Parser +@appendix Grammar and Parser @cindex grammar rules @cindex language definition -This appendix should eventually contain a semi-formal description of +This appendix will eventually contain a semi-formal description of Octave's language. @menu * Keywords:: +* Parser:: @end menu @node Keywords @@ -40,16 +41,46 @@ @item @code{case} @tab @code{catch} @tab @code{classdef} @item @code{continue} @tab @code{do} @tab @code{else} @item @code{elseif} @tab @code{end} @tab @code{end_try_catch} -@item @code{end_unwind_protect} @tab @code{endclassdef} @tab @code{endevents} -@item @code{endfor} @tab @code{endfunction} @tab @code{endif} -@item @code{endmethods} @tab @code{endproperties} @tab @code{endswitch} -@item @code{endwhile} @tab @code{events} @tab @code{for} +@item @code{end_unwind_protect} @tab @code{endclassdef} @tab @code{endenumeration} +@item @code{endevents} @tab @code{endfor} @tab @code{endfunction} +@item @code{endif} @tab @code{endmethods} @tab @code{endparfor} +@item @code{endproperties} @tab @code{endswitch} @tab @code{endwhile} +@item @code{enumeration} @tab @code{events} @tab @code{for} @item @code{function} @tab @code{get} @tab @code{global} @item @code{if} @tab @code{methods} @tab @code{otherwise} -@item @code{persistent} @tab @code{properties} @tab @code{return} -@item @code{set} @tab @code{static} @tab @code{switch} -@item @code{try} @tab @code{until} @tab @code{unwind_protect} -@item @code{unwind_protect_cleanup}@tab @code{while} +@item @code{parfor} @tab @code{persistent} @tab @code{properties} +@item @code{return} @tab @code{set} @tab @code{static} +@item @code{switch} @tab @code{try} @tab @code{until} +@item @code{unwind_protect} @tab @code{unwind_protect_cleanup} @tab @code{while} @end multitable +The function @code{iskeyword} can be used to quickly check whether an +identifier is reserved by Octave. + @DOCSTRING(iskeyword) + +@node Parser +@section Parser +@cindex parser + +The parser has a number of variables that affect its internal operation. +These variables are generally documented in the manual alongside the code that +they affect. For example, @code{allow_noninteger_range_as_index} is discussed +in the section on index expressions. + +In addition, there are three non-specific parser customization functions. +@code{add_input_event_hook} can be used to schedule a user function for +periodic evaluation. @code{remove_input_event_hook} will stop a user function +from being evaluated periodically. + +@DOCSTRING(add_input_event_hook) + +@DOCSTRING(remove_input_event_hook) + +Finally, when the parser cannot identify an input token it calls a particular +function to handle this. By default, this is the function "unimplemented" +which makes suggestions about possible Octave substitutes for @sc{matlab} +functions. + +@DOCSTRING(missing_function_hook) +
new file mode 100644 --- /dev/null +++ b/doc/interpreter/gui.txi @@ -0,0 +1,93 @@ +@c Copyright (C) 2011 Rik Wehbring +@c +@c This file is part of Octave. +@c +@c Octave is free software; you can redistribute it and/or modify it +@c under the terms of the GNU General Public License as published by the +@c Free Software Foundation; either version 3 of the License, or (at +@c your option) any later version. +@c +@c Octave is distributed in the hope that it will be useful, but WITHOUT +@c ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +@c FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +@c for more details. +@c +@c You should have received a copy of the GNU General Public License +@c along with Octave; see the file COPYING. If not, see +@c <http://www.gnu.org/licenses/>. + +@node GUI Development +@chapter GUI Development + +Octave is principally a batch or command-line language. However, it does +offer some limited features for constructing graphical interfaces for +interacting with users. + +The GUI elements available are I/O dialogs and a progress bar. For example, +rather than hardcoding a filename for output results a script can open a dialog +box and allow the user to choose a file. Similarly, if a calculation is +expected to take a long time a script can display a progress bar. + +Several utility functions make it possible to store private data for use with +a GUI which will not pollute the user's variable space. + +Finally, a program written in Octave might want to have long term storage of +preferences or state variables. This can be done with user-defined +preferences. + +@menu +* I/O Dialogs:: +* Progress Bar:: +* GUI Utility Functions:: +* User-Defined Preferences:: +@end menu + +@node I/O Dialogs +@section I/O Dialogs + +Simple dialog menus are available for choosing directories or files. They +return a string variable which can then be used with any command requiring +a file name. + +@DOCSTRING(uigetdir) + +@DOCSTRING(uigetfile) + +@DOCSTRING(uiputfile) + +@node Progress Bar +@section Progress Bar +@cindex Progress Bar + +@DOCSTRING(waitbar) + +@node GUI Utility Functions +@section GUI Utility Functions + +These functions do not implement a GUI element but are useful when developing +programs that do. @strong{Warning:} The functions @code{uiwait}, +@code{uiresume}, and @code{waitfor} are only available for the FLTK tooolkit. + +@DOCSTRING(guidata) + +@DOCSTRING(guihandles) + +@DOCSTRING(uiwait) + +@DOCSTRING(uiresume) + +@DOCSTRING(waitfor) + +@node User-Defined Preferences +@section User-Defined Preferences + +@DOCSTRING(addpref) + +@DOCSTRING(getpref) + +@DOCSTRING(ispref) + +@DOCSTRING(rmpref) + +@DOCSTRING(setpref) +
--- a/doc/interpreter/install.txi +++ b/doc/interpreter/install.txi @@ -32,7 +32,7 @@ under the terms of the GNU General Public License as published by the Free Software Foundation. -@strong{Note:} This file is automatically generated from +@strong{Note}: This file is automatically generated from @file{doc/interpreter/install.txi} in the Octave sources. To update the documentation make changes to the .txi source file rather than this derived file. @@ -82,7 +82,7 @@ @item --disable-docs Disable building all forms of the documentation (Info, PDF, HTML). The default is to build documentation, but your system will need functioning -Texinfo and Tex installs for this to succeed. +Texinfo and @TeX{} installs for this to succeed. @item --enable-float-truncate This option allows for truncation of intermediate floating point results @@ -127,7 +127,7 @@ library that Octave should use. @item --with-magick=<lib> -Select the library to use for image I/O. The two possible values are +Select the library to use for image I/O@. The two possible values are "GraphicsMagick" (default) or "ImageMagick". @item --with-sepchar=<char> @@ -220,10 +220,10 @@ There are currently two options for plotting in Octave: (1) the external program gnuplot, or (2) the internal graphics engine using OpenGL and -FLTK. Gnuplot is a command-driven interactive function plotting +FLTK@. Gnuplot is a command-driven interactive function plotting program. Gnuplot is copyrighted, but freely distributable. As of Octave release 3.4, gnuplot is the default option for plotting. But, -the internal graphics engine is nearly 100% compatibile, certainly for +the internal graphics engine is nearly 100% compatible, certainly for most ordinary plots, and users are encouraged to test it. It is anticipated that the internal engine will become the default option at the next major release of Octave. @@ -548,7 +548,7 @@ You must ensure that all Fortran sources except those in the @file{libcruft/ranlib} directory are compiled such that INTEGERS are 8-bytes wide. If you are using gfortan, the configure script should -automatically set the Makefile variable @code{F77_INTEGER_8_FLAG} to +automatically set the Makefile variable @w{@env{F77_INTEGER_8_FLAG}} to @option{-fdefault-integer-8}. If you are using another compiler, you must set this variable yourself. You should NOT set this flag in @env{FFLAGS}, otherwise the files in @file{libcruft/ranlib} will be @@ -747,7 +747,7 @@ these files without @option{-g}. @item -Some people have reported that calls to shell_cmd and the pager do not +Some people have reported that calls to system() and the pager do not work on SunOS systems. This is apparently due to having @w{@code{G_HAVE_SYS_WAIT}} defined to be 0 instead of 1 when compiling @code{libg++}.
--- a/doc/interpreter/intro.txi +++ b/doc/interpreter/intro.txi @@ -385,7 +385,7 @@ In order to get good help you first need to know the name of the command that you want to use. This name of the function may not always be -obvious, but a good place to start is to just type @code{help --list}. +obvious, but a good place to start is to type @code{help --list}. This will show you all the operators, keywords, built-in functions, and loadable functions available in the current session of Octave. An alternative is to search the documentation using the @code{lookfor} @@ -562,7 +562,9 @@ Here is a description of an imaginary function @code{foo}: -@deftypefn {Function} {} foo (@var{x}, @var{y}, @dots{}) +@deftypefn {Function File} {} foo (@var{x}) +@deftypefnx {Function File} {} foo (@var{x}, @var{y}) +@deftypefnx {Function File} {} foo (@var{x}, @var{y}, @dots{}) The function @code{foo} subtracts @var{x} from @var{y}, then adds the remaining arguments to the result. If @var{y} is not supplied, then the number 19 is used by default.
--- a/doc/interpreter/io.txi +++ b/doc/interpreter/io.txi @@ -21,7 +21,7 @@ Octave supports several ways of reading and writing data to or from the prompt or a file. The simplest functions for data Input and Output -(I/O) are easy to use, but only provides limited control of how +(I/O) are easy to use, but only provide limited control of how data is processed. For more control, a set of functions modelled after the C standard library are also provided by Octave. @@ -66,6 +66,10 @@ @DOCSTRING(disp) +@DOCSTRING(list_in_columns) + +@DOCSTRING(terminal_size) + @DOCSTRING(format) @menu @@ -176,6 +180,8 @@ @DOCSTRING(load) +@DOCSTRING(fileread) + There are three functions that modify the behavior of @code{save}. @DOCSTRING(default_save_options) @@ -576,7 +582,7 @@ @item @samp{%x}, @samp{%X} Print an integer as an unsigned hexadecimal number. @samp{%x} uses -lower-case letters and @samp{%X} uses upper-case. @xref{Integer +lowercase letters and @samp{%X} uses uppercase. @xref{Integer Conversions}, for details. @item @samp{%f} @@ -585,13 +591,13 @@ @item @samp{%e}, @samp{%E} Print a floating-point number in exponential notation. @samp{%e} uses -lower-case letters and @samp{%E} uses upper-case. @xref{Floating-Point +lowercase letters and @samp{%E} uses uppercase. @xref{Floating-Point Conversions}, for details. @item @samp{%g}, @samp{%G} Print a floating-point number in either normal (fixed-point) or exponential notation, whichever is more appropriate for its magnitude. -@samp{%g} uses lower-case letters and @samp{%G} uses upper-case. +@samp{%g} uses lowercase letters and @samp{%G} uses uppercase. @xref{Floating-Point Conversions}, for details. @item @samp{%c}
--- a/doc/interpreter/linalg.txi +++ b/doc/interpreter/linalg.txi @@ -88,8 +88,6 @@ @DOCSTRING(det) -@DOCSTRING(dot) - @DOCSTRING(eig) @DOCSTRING(givens) @@ -106,6 +104,8 @@ @DOCSTRING(orth) +@DOCSTRING(mgorth) + @DOCSTRING(pinv) @DOCSTRING(rank) @@ -180,11 +180,17 @@ @DOCSTRING(kron) +@DOCSTRING(blkmm) + @DOCSTRING(syl) @node Specialized Solvers @section Specialized Solvers +@DOCSTRING(bicg) + @DOCSTRING(bicgstab) @DOCSTRING(cgs) + +@DOCSTRING(gmres)
--- a/doc/interpreter/matrix.txi +++ b/doc/interpreter/matrix.txi @@ -29,7 +29,6 @@ @menu * Finding Elements and Checking Conditions:: * Rearranging Matrices:: -* Applying a Function to an Array:: * Special Utility Matrices:: * Famous Matrices:: @end menu @@ -75,11 +74,14 @@ @DOCSTRING(isfinite) +@DOCSTRING(common_size) + @DOCSTRING(find) @DOCSTRING(lookup) - -@DOCSTRING(common_size) + +If you wish to check if a variable exists at all, instead of properties +its elements may have, consult @ref{Status of Variables}. @node Rearranging Matrices @section Rearranging Matrices @@ -110,9 +112,9 @@ @DOCSTRING(circshift) -@DOCSTRING(shiftdim) +@DOCSTRING(shift) -@DOCSTRING(shift) +@DOCSTRING(shiftdim) @DOCSTRING(sort) @@ -120,26 +122,7 @@ @DOCSTRING(issorted) -Since the @code{sort} function does not allow sort keys to be specified, -it can't be used to order the rows of a matrix according to the values -of the elements in various columns@footnote{For example, to first sort -based on the values in column 1, and then, for any values that are -repeated in column 1, sort based on the values found in column 2, etc.} -in a single call. Using the second output, however, it is possible to -sort all rows based on the values in a given column. Here's an example -that sorts the rows of a matrix based on the values in the second -column. - -@example -@group -a = [1, 2; 2, 3; 3, 1]; -[s, i] = sort (a (:, 2)); -a (i, :) - @result{} 3 1 - 1 2 - 2 3 -@end group -@end example +@DOCSTRING(nth_element) @anchor{doc-triu} @DOCSTRING(tril) @@ -156,13 +139,6 @@ @DOCSTRING(blkdiag) -@node Applying a Function to an Array -@section Applying a Function to an Array - -@DOCSTRING(arrayfun) - -@DOCSTRING(bsxfun) - @node Special Utility Matrices @section Special Utility Matrices @@ -176,6 +152,14 @@ @DOCSTRING(repelems) +The functions @code{linspace} and @code{logspace} make it very easy to +create vectors with evenly or logarithmically spaced elements. +@xref{Ranges}. + +@DOCSTRING(linspace) + +@DOCSTRING(logspace) + @DOCSTRING(rand) @DOCSTRING(randi) @@ -246,14 +230,6 @@ @DOCSTRING(randperm) -The functions @code{linspace} and @code{logspace} make it very easy to -create vectors with evenly or logarithmically spaced elements. -@xref{Ranges}. - -@DOCSTRING(linspace) - -@DOCSTRING(logspace) - @node Famous Matrices @section Famous Matrices @@ -273,8 +249,6 @@ @DOCSTRING(rosser) -@DOCSTRING(sylvester_matrix) - @DOCSTRING(toeplitz) @DOCSTRING(vander)
--- a/doc/interpreter/mk_doc_cache.m +++ b/doc/interpreter/mk_doc_cache.m @@ -30,7 +30,7 @@ ## It is more efficient to fork to shell for makeinfo only once on large data nfiles = numel (docstrings_files); -text = cell (1, nfiles+1); +text = cell (1, nfiles); for i = 1:nfiles file = docstrings_files{i}; fid = fopen (file, "r"); @@ -39,16 +39,17 @@ else tmp = fread (fid, Inf, "*char")'; ## Strip off header lines - [null, text{i}] = strtok (tmp, doc_delim); + [~, text{i}] = strtok (tmp, doc_delim); endif endfor text = [text{:}, doc_delim]; ## Modify Octave-specific macros before passing to makeinfo +text = regexprep (text, "-\\*- texinfo -\\*-[ \t]*[\r\n]*", ""); text = regexprep (text, '@seealso *\{([^}]*)\}', "See also: $1."); text = regexprep (text, '@nospell *\{([^}]*)\}', "$1"); -text = regexprep (text, "-\\*- texinfo -\\*-[ \t]*[\r\n]*", ""); -text = regexprep (text, ' @', " @@"); +text = regexprep (text, '@xcode *\{([^}]*)\}', "$1"); +text = strrep (text, ' @', " @@"); ## Write data to temporary file for input to makeinfo [fid, name, msg] = mkstemp ("octave_doc_XXXXXX", true); @@ -58,17 +59,14 @@ fwrite (fid, text, "char"); fclose (fid); -cmd = sprintf ("%s --no-headers --no-warn --force --no-validate --fill-column=1024 %s", - makeinfo_program (), name); +cmd = [makeinfo_program() " --no-headers --no-warn --force --no-validate --fill-column=1024 " name]; [status, formatted_text] = system (cmd); ## Did we get the help text? if (status != 0) error ("makeinfo failed with exit status %d!", status); -endif - -if (isempty (formatted_text)) +elseif (isempty (formatted_text)) error ("makeinfo produced no output!"); endif @@ -85,42 +83,32 @@ [symbol, doc] = strtok (block, "\r\n"); - doc = regexprep (doc, "^[\r\n]+", ''); - ## Skip internal functions that start with __ as these aren't ## indexed by lookfor. if (length (symbol) > 2 && regexp (symbol, '^__.+__$')) continue; endif + doc = regexprep (doc, "^[\r\n]+", '', 'once'); + if (isempty (doc)) continue; endif - tmp = doc; - found = 0; - do - [s, e] = regexp (tmp, "^ -- [^\r\n]*[\r\n]"); - if (! isempty(s)) - found = 1; - tmp = tmp(e+1:end); - endif - until (isempty (s)) + tmp = regexprep (doc, "^ -- .*$[\r\n]", '', 'lineanchors', 'dotexceptnewline'); - if (! found) + if (isempty (tmp)) continue; endif end_of_first_sentence = regexp (tmp, "(\\.|[\r\n][\r\n])", "once"); if (isempty (end_of_first_sentence)) end_of_first_sentence = length (tmp); - else - end_of_first_sentence = end_of_first_sentence; endif first_sentence = tmp(1:end_of_first_sentence); first_sentence = regexprep (first_sentence, "([\r\n]| {2,})", " "); - first_sentence = regexprep (first_sentence, '^ +', ""); + first_sentence = regexprep (first_sentence, '^ +', "", 'once'); cache{1,k} = symbol; cache{2,k} = doc;
--- a/doc/interpreter/mkoctfile.1 +++ b/doc/interpreter/mkoctfile.1 @@ -95,28 +95,29 @@ Print configuration variable \fIVAR\fP. Recognized variables are: .RS .Vb - ALL_CFLAGS FFTW3F_LDFLAGS - ALL_CXXFLAGS FFTW3F_LIBS - ALL_FFLAGS FLIBS - ALL_LDFLAGS FPICFLAG - BLAS_LIBS INCFLAGS - CC LAPACK_LIBS - CFLAGS LDFLAGS - CPICFLAG LD_CXX - CPPFLAGS LD_STATIC_FLAG - CXX LFLAGS - CXXFLAGS LIBCRUFT - CXXPICFLAG LIBOCTAVE - DEPEND_EXTRA_SED_PATTERN LIBOCTINTERP - DEPEND_FLAGS LIBS - DL_LD OCTAVE_LIBS - DL_LDFLAGS RDYNAMIC_FLAG - EXEEXT READLINE_LIBS - F77 RLD_FLAG - F77_INTEGER_8_FLAG SED - FFLAGS XTRA_CFLAGS - FFTW3_LDFLAGS XTRA_CXXFLAGS - FFTW3_LIBS + ALL_CFLAGS FFTW3F_LIBS + ALL_CXXFLAGS FLIBS + ALL_FFLAGS FPICFLAG + ALL_LDFLAGS INCFLAGS + BLAS_LIBS LAPACK_LIBS + CC LDFLAGS + CFLAGS LD_CXX + CPICFLAG LD_STATIC_FLAG + CPPFLAGS LFLAGS + CXX LIBCRUFT + CXXFLAGS LIBOCTAVE + CXXPICFLAG LIBOCTINTERP + DEPEND_EXTRA_SED_PATTERN LIBS + DEPEND_FLAGS OCTAVE_LIBS + DL_LD OCTAVE_LINK_DEPS + DL_LDFLAGS OCT_LINK_DEPS + EXEEXT RDYNAMIC_FLAG + F77 READLINE_LIBS + F77_INTEGER_8_FLAG SED + FFLAGS XTRA_CFLAGS + FFTW3_LDFLAGS XTRA_CXXFLAGS + FFTW3_LIBS + FFTW3F_LDFLAGS .Ve .RE .TP
--- a/doc/interpreter/nonlin.txi +++ b/doc/interpreter/nonlin.txi @@ -21,6 +21,14 @@ @cindex nonlinear equations @cindex equations, nonlinear +@menu +* Solvers:: +* Minimizers:: +@end menu + +@node Solvers +@section Solvers + Octave can solve sets of nonlinear equations of the form @tex $$ @@ -36,14 +44,14 @@ @end ifnottex @noindent -using the function @code{fsolve}, which is based on the @sc{Minpack} +using the function @code{fsolve}, which is based on the @sc{minpack} subroutine @code{hybrd}. This is an iterative technique so a starting -point will have to be provided. This also has the consequence that +point must be provided. This also has the consequence that convergence is not guaranteed even if a solution exists. @DOCSTRING(fsolve) -Here is a complete example. To solve the set of equations +The following is a complete example. To solve the set of equations @tex $$ \eqalign{-2x^2 + 3xy + 4\sin(y) - 6 &= 0\cr @@ -105,16 +113,6 @@ @noindent A value of @code{info = 1} indicates that the solution has converged. -The function @code{perror} may be used to print English messages -corresponding to the numeric error codes. For example: - -@example -@group -perror ("fsolve", 1) - @print{} solution converged to requested tolerance -@end group -@end example - When no Jacobian is supplied (as in the example above) it is approximated numerically. This requires more function evaluations, and hence is less efficient. In the example above we could compute the Jacobian @@ -164,3 +162,27 @@ which gives the same solution as before. @DOCSTRING(fzero) + +@node Minimizers +@section Minimizers +@cindex local minimum +@cindex finding minimums + +Often it is useful to find the minimum value of a function rather than just +the zeroes where it crosses the x-axis. @code{fminbnd} is designed for the +simpler, but very common, case of a univariate function where the interval +to search is bounded. For unbounded minimization of a function with +potentially many variables use @code{fminunc}. @xref{Optimization}, for +minimization with the presence of constraint functions. Note that searches +can be made for maxima by simply inverting the objective function +@tex +($F_{max} = -F_{min}$). +@end tex +@ifnottex +(@code{Fto_max = -Fto_min}). +@end ifnottex + +@DOCSTRING(fminbnd) + +@DOCSTRING(fminunc) +
--- a/doc/interpreter/numbers.txi +++ b/doc/interpreter/numbers.txi @@ -809,9 +809,9 @@ @DOCSTRING(isnumeric) -@DOCSTRING(isreal) +@DOCSTRING(isfloat) -@DOCSTRING(isfloat) +@DOCSTRING(isreal) @DOCSTRING(iscomplex) @@ -836,3 +836,7 @@ @DOCSTRING(islogical) @DOCSTRING(isprime) + +If instead of knowing properties of variables, you wish to know which +variables are defined and to gather other information about the +workspace itself, see @ref{Status of Variables}.
--- a/doc/interpreter/obsolete.txi +++ b/doc/interpreter/obsolete.txi @@ -118,4 +118,37 @@ @item @code{weibull_pdf} @tab @code{wblpdf} @tab 3.4.0 @item @code{weibull_rnd} @tab @code{wblrnd} @tab 3.4.0 @item @code{wiener_rnd} @tab @code{wienrnd} @tab 3.4.0 +@item @code{create_set} @tab @code{unique} @tab 3.6.0 +@item @code{dmult} @tab @code{diag (A) * B} @tab 3.6.0 +@item @code{iscommand} @tab None @tab 3.6.0 +@item @code{israwcommand} @tab None @tab 3.6.0 +@item @code{lchol} @tab @code{chol (@dots{}, "lower")} @tab 3.6.0 +@item @code{loadimage} @tab @code{load} or @code{imread} @tab 3.6.0 +@item @code{mark_as_command} @tab None @tab 3.6.0 +@item @code{mark_as_rawcommand} @tab None @tab 3.6.0 +@item @code{spatan2} @tab @code{atan2} @tab 3.6.0 +@item @code{spchol} @tab @code{chol} @tab 3.6.0 +@item @code{spchol2inv} @tab @code{chol2inv} @tab 3.6.0 +@item @code{spcholinv} @tab @code{cholinv} @tab 3.6.0 +@item @code{spcumprod} @tab @code{cumprod} @tab 3.6.0 +@item @code{spcumsum} @tab @code{cumsum} @tab 3.6.0 +@item @code{spdet} @tab @code{det} @tab 3.6.0 +@item @code{spdiag} @tab @code{sparse (diag (@dots{}))} @tab 3.6.0 +@item @code{spfind} @tab @code{find} @tab 3.6.0 +@item @code{sphcat} @tab @code{horzcat} @tab 3.6.0 +@item @code{spinv} @tab @code{inv} @tab 3.6.0 +@item @code{spkron} @tab @code{kron} @tab 3.6.0 +@item @code{splchol} @tab @code{chol (@dots{}, "lower")} @tab 3.6.0 +@item @code{split} @tab @code{char (strsplit (s, t))} @tab 3.6.0 +@item @code{splu} @tab @code{lu} @tab 3.6.0 +@item @code{spmax} @tab @code{max} @tab 3.6.0 +@item @code{spmin} @tab @code{min} @tab 3.6.0 +@item @code{spprod} @tab @code{prod} @tab 3.6.0 +@item @code{spqr} @tab @code{qr} @tab 3.6.0 +@item @code{spsum} @tab @code{sum} @tab 3.6.0 +@item @code{spsumsq} @tab @code{sumsq} @tab 3.6.0 +@item @code{spvcat} @tab @code{vertcat} @tab 3.6.0 +@item @code{str2mat} @tab @code{char} @tab 3.6.0 +@item @code{unmark_command} @tab None @tab 3.6.0 +@item @code{unmark_rawcommand} @tab None @tab 3.6.0 @end multitable
--- a/doc/interpreter/octave.texi +++ b/doc/interpreter/octave.texi @@ -46,6 +46,20 @@ \arg\ @end macro +@c The following macro works around a situation where the Info/plain text +@c expansion of the @code{XXX} macro is `XXX'. The use of the apostrophe +@c can be confusing if the code segment itself ends with a transpose operator. +@ifinfo +@macro xcode{arg} +\arg\ +@end macro +@end ifinfo +@ifnotinfo +@macro xcode{arg} +@code{\arg\} +@end macro +@end ifnotinfo + @ifinfo @format START-INFO-DIR-ENTRY @@ -183,8 +197,9 @@ * Plotting:: * Matrix Manipulation:: * Arithmetic:: -* Linear Algebra:: -* Nonlinear Equations:: +* Linear Algebra:: +* Vectorization and Faster Code Execution:: +* Nonlinear Equations:: * Diagonal and Permutation Matrices:: * Sparse Matrices:: * Numerical Integration:: @@ -199,6 +214,7 @@ * Image Processing:: * Audio Processing:: * Object Oriented Programming:: +* GUI Development:: * System Utilities:: * Packages:: * Dynamically Linked Functions:: @@ -209,7 +225,7 @@ * Trouble:: If you have trouble installing Octave. * Installation:: How to configure, compile and install Octave. * Emacs Octave Support:: -@c * Grammar:: +* Grammar and Parser:: * Copying:: The GNU General Public License. * Concept Index:: An item for each concept. * Function Index:: An item for each documented function. @@ -326,11 +342,11 @@ Data Containers -* Data Structures:: +* Structures:: * Cell Arrays:: * Comma Separated Lists:: -Data Structures +Structures * Basic Usage and Examples:: * Structure Arrays:: @@ -368,6 +384,10 @@ * Increment Ops:: * Operator Precedence:: +Index Expressions + +* Advanced Indexing:: + Calling Functions * Call by Value:: @@ -443,6 +463,7 @@ * Raising Errors:: * Catching Errors:: +* Recovering From Errors:: Handling Warnings @@ -509,7 +530,7 @@ High-Level Plotting * Two-Dimensional Plots:: -* Three-Dimensional Plotting:: +* Three-Dimensional Plots:: * Plot Annotations:: * Multiple Plots on One Page:: * Multiple Plot Windows:: @@ -519,10 +540,13 @@ Two-Dimensional Plots +* Axis Configuration:: * Two-dimensional Function Plotting:: +* Two-dimensional Geometric Shapes:: -Three-Dimensional Plotting +Three-Dimensional Plots +* Aspect Ratio:: * Three-dimensional Function Plotting:: * Three-dimensional Geometric Shapes:: @@ -551,6 +575,7 @@ * Line Styles:: * Marker Styles:: * Callbacks:: +* Application-defined Data * Object Groups:: * Graphics Toolkits:: @@ -576,7 +601,6 @@ * Finding Elements and Checking Conditions:: * Rearranging Matrices:: -* Applying a Function to an Array:: * Special Utility Matrices:: * Famous Matrices:: @@ -600,6 +624,20 @@ * Functions of a Matrix:: * Specialized Solvers:: +Vectorization and Faster Code Execution + +* Basic Vectorization:: +* Broadcasting:: +* Function Application:: +* Accumulation:: +* Miscellaneous Techniques:: +* Examples:: + +Nonlinear Equations + +* Solvers:: +* Minimizers:: + Diagonal and Permutation Matrices * Basic Usage:: Creation and Manipulation of Diagonal and Permutation Matrices @@ -647,8 +685,8 @@ Numerical Integration * Functions of One Variable:: +* Orthogonal Collocation:: * Functions of Multiple Variables:: -* Orthogonal Collocation:: Differential Equations @@ -729,6 +767,13 @@ * Operator Overloading:: * Precedence of Objects:: +GUI Development + +* I/O Dialogs:: +* Progress Bar:: +* GUI Utility Functions:: +* User-Defined Preferences:: + System Utilities * Timing Utilities:: @@ -808,7 +853,6 @@ Tips and Standards * Style Tips:: Writing clean and robust programs. -* Coding Tips:: Making code run faster. * Comment Tips:: Conventions for writing comments. * Function Headers:: Standard headers for functions. * Documentation Tips:: Writing readable documentation strings. @@ -830,7 +874,7 @@ Reporting Bugs * Bug Criteria:: -* Bug Tracker::ff Where to submit your bug report. +* Bug Tracker:: Where to submit your bug report. * Bug Reporting:: How to report a bug effectively. * Sending Patches:: How to send a patch for Octave. @@ -844,6 +888,12 @@ * Using Octave Mode:: * Running Octave from Within Emacs:: * Using the Emacs Info Reader for Octave:: + +Grammar and Parser + +* Keywords:: +* Parser:: + @end detailmenu @end menu @@ -868,6 +918,7 @@ @include matrix.texi @include arith.texi @include linalg.texi +@include vectorize.texi @include nonlin.texi @include diagperm.texi @include sparse.texi @@ -883,6 +934,7 @@ @include image.texi @include audio.texi @include oop.texi +@include gui.texi @include system.texi @include package.texi @@ -902,7 +954,7 @@ @include bugs.texi @include install.texi @include emacs.texi -@c @include grammar.texi +@include grammar.texi @include gpl.texi @c ------------------------------------------------------------------------
--- a/doc/interpreter/oop.txi +++ b/doc/interpreter/oop.txi @@ -54,18 +54,18 @@ fully grasp the techniques described. The polynomial class is used to represent polynomials of the form +@tex +$$ +a_0 + a_1 x + a_2 x^2 + \ldots a_n x^n +$$ +@end tex +@ifnottex @example -@group -@tex -$a_0 + a_1 x + a_2 x^2 + \ldots a_n x^n$ -@end tex -@ifnottex a0 + a1 * x + a2 * x^2 + @dots{} + an * x^n -@end ifnottex -@end group @end example +@end ifnottex @noindent where @tex @@ -130,9 +130,9 @@ @group p = polynomial ([1, 0, 1]); isobject (p) -@result{} 1 + @result{} 1 isa (p, "polynomial") -@result{} 1 + @result{} 1 @end group @end example @@ -157,7 +157,7 @@ @group p = polynomial ([1, 0, 1]); ismethod (p, "roots") -@result{} 1 + @result{} 1 @end group @end example @@ -292,6 +292,8 @@ @DOCSTRING(subsasgn) +@DOCSTRING(optimize_subsasgn_calls) + Note that the @code{subsref} and @code{subsasgn} methods always receive the whole index chain, while they usually handle only the first element. It is the responsibility of these methods to handle the rest of the chain (if needed), @@ -317,7 +319,7 @@ @group p = polynomial([1,2,3,4]); p(end-1) -@result{} 3 + @result{} 3 @end group @end example @@ -576,8 +578,8 @@ @item @tab a / b @tab mrdivide (a, b) @tab Matrix right division operator @tab @item @tab a .\ b @tab ldivide (a, b) @tab Element-wise left division operator @tab @item @tab a \ b @tab mldivide (a, b) @tab Matrix left division operator @tab -@item @tab a .^ b @tab ldivide (a, b) @tab Element-wise power operator @tab -@item @tab a ^ b @tab mldivide (a, b) @tab Matrix power operator @tab +@item @tab a .^ b @tab power (a, b) @tab Element-wise power operator @tab +@item @tab a ^ b @tab mpower (a, b) @tab Matrix power operator @tab @item @tab a < b @tab lt (a, b) @tab Less than operator @tab @item @tab a <= b @tab le (a, b) @tab Less than or equal to operator @tab @item @tab a > b @tab gt (a, b) @tab Greater than operator @tab
--- a/doc/interpreter/package.txi +++ b/doc/interpreter/package.txi @@ -179,27 +179,39 @@ Internally a package is simply a gzipped tar file that contains a top level directory of any given name. This directory will in the following be referred to as @code{package} and may contain the -following files +following files: @noindent @table @code -@item package/DESCRIPTION -This is a required file containing information about the package. -@xref{The DESCRIPTION File}, for details on this file. - @item package/COPYING This is a required file containing the license of the package. No restrictions is made on the license in general. If however the package contains dynamically linked functions the license must be compatible with the GNU General Public License. +@item package/DESCRIPTION +This is a required file containing information about the package. +@xref{The DESCRIPTION File}, for details on this file. + +@item package/ChangeLog +This is an optional file describing all the changes made to the +package source files. + @item package/INDEX This is an optional file describing the functions provided by the package. If this file is not given then one with be created automatically from the functions in the package and the -@code{Categories} keyword in the @code{DESCRIPTION} file. +@code{Categories} keyword in the @file{DESCRIPTION} file. @xref{The INDEX File}, for details on this file. +@item package/NEWS +This is an optional file describing all user-visible changes worth +mentioning. As this file increases on size, old entries can be moved +into @file{package/ONEWS}. + +@item package/ONEWS +This is an optional file describing old entries from the @file{NEWS} file. + @anchor{doc-PKG_ADD} @item package/PKG_ADD An optional file that includes commands that are run when the package @@ -246,7 +258,7 @@ @end table Besides the above mentioned files, a package can also contain on or -more of the following directories +more of the following directories: @noindent @table @code @@ -289,7 +301,7 @@ @node The DESCRIPTION File @subsection The DESCRIPTION File -The @code{DESCRIPTION} file contains various information about the +The @file{DESCRIPTION} file contains various information about the package, such as its name, author, and version. This file has a very simple format @@ -307,7 +319,7 @@ @end itemize @noindent -The following is a simple example of a @code{DESCRIPTION} file +The following is a simple example of a @file{DESCRIPTION} file @example @group @@ -334,7 +346,8 @@ Name of the package. @item Version -Version of the package. +Version of the package. A package version must be 3 numbers separated +by a dot. @item Date Date of last update. @@ -352,7 +365,7 @@ A one paragraph description of the package. @item Categories -Optional keyword describing the package (if no @code{INDEX} file is +Optional keyword describing the package (if no @file{INDEX} file is given this is mandatory). @item Problems @@ -385,7 +398,7 @@ @item License An optional short description of the used license (e.g., GPL version 3 -or newer). This is optional since the file @code{COPYING} is mandatory. +or newer). This is optional since the file @file{COPYING} is mandatory. @item SystemRequirements These are the external install dependencies of the package and are not @@ -407,7 +420,7 @@ @noindent The developer is free to add additional arguments to the -@code{DESCRIPTION} file for their own purposes. One further detail to +@file{DESCRIPTION} file for their own purposes. One further detail to aid the packager is that the @code{SystemRequirements} and @code{BuildRequires} keywords can have a distribution dependent section, and the automatic build process will use these. An example of the @@ -425,7 +438,7 @@ @node The INDEX File @subsection The INDEX File -The optional @code{INDEX} file provides a categorical view of the +The optional @file{INDEX} file provides a categorical view of the functions in the package. This file has a very simple format @noindent
--- a/doc/interpreter/plot.txi +++ b/doc/interpreter/plot.txi @@ -42,6 +42,10 @@ gnuplot system. The two systems may be used selectively through the use of the @code{graphics_toolkit} property of the graphics handle for each figure. This is explained in @ref{Graphics Data Structures}. +@strong{Caution:} The FLTK toolkit uses single precision variables internally +which limits the maximum value that can be displayed to approximately +@math{10^{38}}. If your data contains larger values you must use the gnuplot +toolkit which supports values up to @math{10^{308}}. @node High-Level Plotting @section High-Level Plotting @@ -54,7 +58,7 @@ @menu * Two-Dimensional Plots:: -* Three-Dimensional Plotting:: +* Three-Dimensional Plots:: * Plot Annotations:: * Multiple Plots on One Page:: * Multiple Plot Windows:: @@ -66,6 +70,12 @@ @node Two-Dimensional Plots @subsection Two-Dimensional Plots +@menu +* Axis Configuration:: +* Two-dimensional Function Plotting:: +* Two-dimensional Geometric Shapes:: +@end menu + The @code{plot} function allows you to create simple x-y plots with linear axes. For example, @@ -219,6 +229,9 @@ @DOCSTRING(comet3) +@node Axis Configuration +@subsubsection Axis Configuration + The axis function may be used to change the axis limits of an existing plot and various other axis properties, such as the aspect ratio and the appearance of tic marks. @@ -237,10 +250,6 @@ @anchor{doc-zlim} @DOCSTRING(xlim) -@menu -* Two-dimensional Function Plotting:: -@end menu - @node Two-dimensional Function Plotting @subsubsection Two-dimensional Function Plotting @@ -275,8 +284,13 @@ @DOCSTRING(ezpolar) -@node Three-Dimensional Plotting -@subsection Three-Dimensional Plotting +@node Two-dimensional Geometric Shapes +@subsubsection Two-dimensional Geometric Shapes + +@DOCSTRING(rectangle) + +@node Three-Dimensional Plots +@subsection Three-Dimensional Plots The function @code{mesh} produces mesh surface plots. For example, @@ -343,6 +357,12 @@ @DOCSTRING(surfnorm) +@DOCSTRING(isosurface) + +@DOCSTRING(isonormals) + +@DOCSTRING(isocolors) + @DOCSTRING(diffuse) @DOCSTRING(specular) @@ -364,10 +384,23 @@ @DOCSTRING(scatter3) @menu +* Aspect Ratio:: * Three-dimensional Function Plotting:: * Three-dimensional Geometric Shapes:: @end menu +@node Aspect Ratio +@subsubsection Aspect Ratio + +For three-dimensional plots the aspect ratio can be set for data with +@code{daspect} and for the plot box with @code{pbaspect}. +See @ref{Axis Configuration} for controlling the x-, y-, and z-limits for +plotting. + +@DOCSTRING(daspect) + +@DOCSTRING(pbaspect) + @node Three-dimensional Function Plotting @subsubsection Three-dimensional Function Plotting @@ -823,7 +856,8 @@ The user can select points on a plot with the @code{ginput} function or selection the position at which to place text on the plot with the -@code{gtext} function using the mouse. +@code{gtext} function using the mouse. Menus may also be created +and populated with specific user commands via the @code{uimenu} function. @DOCSTRING(ginput) @@ -831,6 +865,8 @@ @DOCSTRING(gtext) +@DOCSTRING(uimenu) + @node Test Plotting Functions @subsection Test Plotting Functions @@ -1772,6 +1808,7 @@ @item deletefcn @item displayname +The text of the legend entry corresponding to this line. @item erasemode @@ -1783,11 +1820,6 @@ @item interruptible -@item keylabel -The text of the legend entry corresponding to this line. Note that this -property is not compatible with @sc{matlab} and may be removed in a -future version of Octave. - @item ldata The lower errorbar in the y direction to be plotted. @@ -1889,6 +1921,7 @@ @item deletefcn @item displayname +The text of the legend entry corresponding to this line. @item edgecolor @@ -2096,6 +2129,9 @@ @item diffusestrength +@item displayname +The text of the legend entry corresponding to this line. + @item edgealpha @item edgecolor @@ -2127,8 +2163,6 @@ @item interruptible -@item keylabel - @item linestyle @xref{Line Styles}. @@ -2246,6 +2280,9 @@ @item diffusestrength +@item displayname +The text of the legend entry corresponding to this surface. + @item edgealpha @item edgecolor @@ -2268,11 +2305,6 @@ @item interruptible -@item keylabel -The text of the legend entry corresponding to this surface. Note that -this property is not compatible with @sc{matlab} and may be removed in a -future version of Octave. - @item linestyle @item linewidth @@ -2360,7 +2392,11 @@ may override the factory defaults. Although default values may be set for any object, they are set in -parent objects and apply to child objects. For example, +parent objects and apply to child objects, of the specified object type. +For example, setting the default @code{color} property of @code{line} +objects to "green", for the @code{root} object, will result in all +@code{line} objects inheriting the @code{color} "green" as the default +value. @example set (0, "defaultlinecolor", "green"); @@ -2444,11 +2480,13 @@ @node Advanced Plotting @section Advanced Plotting + @menu * Colors:: * Line Styles:: * Marker Styles:: * Callbacks:: +* Application-defined Data:: * Object Groups:: * Graphics Toolkits:: @end menu @@ -2476,16 +2514,19 @@ May be one of @table @code @item "-" -Solid lines. +Solid line. [default] @item "--" -Dashed lines. +Dashed line. @item ":" -Points. +Dotted line. @item "-." A dash-dot line. + +@item "none" +No line. Points will still be marked using the current Marker Style. @end table @item linewidth @@ -2517,6 +2558,11 @@ of 2 is twice as large as the default, etc. @end table +The @code{colstyle} function will parse a @code{plot}-style specification +and will return the color, line, and marker values that would result. + +@DOCSTRING(colstyle) + @node Callbacks @subsection Callbacks @cindex callbacks @@ -2591,6 +2637,22 @@ Callbacks can equally be added to properties with the @code{addlistener} function described below. +@node Application-defined Data +@subsection Application-defined Data +@cindex application-defined data + +Octave has a provision for attaching application-defined data to a graphics +handle. The data can be anything which is meaningful to the application, and +will be completely ignored by Octave. + +@DOCSTRING(setappdata) + +@DOCSTRING(getappdata) + +@DOCSTRING(rmappdata) + +@DOCSTRING(isappdata) + @node Object Groups @subsection Object Groups @cindex object groups
--- a/doc/interpreter/poly.txi +++ b/doc/interpreter/poly.txi @@ -107,7 +107,7 @@ @section Derivatives / Integrals / Transforms Octave comes with functions for computing the derivative and the integral -of a polynomial. The functions @code{polyderiv} and @code{polyint} +of a polynomial. The functions @code{polyder} and @code{polyint} both return new polynomials describing the result. As an example we'll compute the definite integral of @math{p(x) = x^2 + 1} from 0 to 3. @@ -120,8 +120,6 @@ @end group @end example -@DOCSTRING(polyderiv) - @DOCSTRING(polyder) @DOCSTRING(polyint)
--- a/doc/interpreter/quad.txi +++ b/doc/interpreter/quad.txi @@ -20,19 +20,19 @@ @chapter Numerical Integration Octave comes with several built-in functions for computing the integral -of a function numerically. These functions all solve 1-dimensional -integration problems. +of a function numerically (termed quadrature). These functions all solve +1-dimensional integration problems. @menu * Functions of One Variable:: +* Orthogonal Collocation:: * Functions of Multiple Variables:: -* Orthogonal Collocation:: @end menu @node Functions of One Variable @section Functions of One Variable -Octave supports three different algorithms for computing the integral +Octave supports five different algorithms for computing the integral @tex $$ \int_a^b f(x) d x @@ -45,30 +45,42 @@ @item quad Numerical integration based on Gaussian quadrature. +@item quadv +Numerical integration using an adaptive vectorized Simpson's rule. + @item quadl Numerical integration using an adaptive Lobatto rule. @item quadgk Numerical integration using an adaptive Gauss-Konrod rule. -@item quadv -Numerical integration using an adaptive vectorized Simpson's rule. - @item quadcc Numerical integration using adaptive Clenshaw-Curtis rules. -@item trapz -Numerical integration using the trapezoidal method. +@item trapz, cumtrapz +Numerical integration of data using the trapezoidal method. @end table @noindent -Besides these functions Octave also allows you to perform cumulative -numerical integration using the trapezoidal method through the -@code{cumtrapz} function. +The best quadrature algorithm to use depends on the integrand. If you have +empirical data, rather than a function, the choice is @code{trapz} or +@code{cumtrapz}. If you are uncertain about the characteristics of the +integrand, @code{quadcc} will be the most robust as it can handle +discontinuities, singularities, oscillatory functions, and infinite intervals. +When the integrand is smooth @code{quadgk} may be the fastest of the +algorithms. -@DOCSTRING(quad) +@multitable @columnfractions 0.05 0.15 .80 +@headitem @tab Function @tab Characteristics +@item @tab quad @tab Low accuracy with nonsmooth integrands +@item @tab quadv @tab Medium accuracy with smooth integrands +@item @tab quadl @tab Medium accuracy with smooth integrands. Slower than quadgk. +@item @tab quadgk @tab Medium accuracy (@math{1e^{-6}}--@math{1e^{-9}}) with smooth integrands. +@item @tab @tab Handles oscillatory functions and infinite bounds +@item @tab quadcc @tab Low to High accuracy with nonsmooth/smooth integrands +@item @tab @tab Handles oscillatory functions, singularities, and infinite bounds +@end multitable -@DOCSTRING(quad_options) Here is an example of using @code{quad} to integrate the function @tex @@ -95,21 +107,22 @@ @example @group function y = f (x) - y = x .* sin (1 ./ x) .* sqrt (abs (1 - x)); + y = x .* sin (1./x) .* sqrt (abs (1 - x)); endfunction @end group @end example -Note the use of the `dot' forms of the operators. This is not necessary -for the call to @code{quad}, but it makes it much easier to generate a -set of points for plotting (because it makes it possible to call the -function with a vector argument to produce a vector result). +Note the use of the `dot' forms of the operators. This is not necessary for +the @code{quad} integrator, but is required by the other integrators. In any +case, it makes it much easier to generate a set of points for plotting because +it is possible to call the function with a vector argument to produce a vector +result. -Then we simply call quad: +The second step is to call quad with the limits of integration: @example @group -[v, ier, nfun, err] = quad ("f", 0, 3) +[q, ier, nfun, err] = quad ("f", 0, 3) @result{} 1.9819 @result{} 1 @result{} 5061 @@ -121,13 +134,83 @@ is reasonably accurate (to see why, examine what happens to the result if you move the lower bound to 0.1, then 0.01, then 0.001, etc.). +The function "f" can be the string name of a function, a function handle, or +an inline function. These options make it quite easy to do integration +without having to fully define a function in an m-file. For example: + +@example +@group +# Verify integral (x^3) = x^4/4 +f = inline ("x.^3"); +quadgk (f, 0, 1) + @result{} 0.25000 + +# Verify gamma function = (n-1)! for n = 4 +f = @@(x) x.^3 .* exp (-x); +quadcc (f, 0, Inf) + @result{} 6.0000 +@end group +@end example + +@DOCSTRING(quad) + +@DOCSTRING(quad_options) + +@DOCSTRING(quadv) + @DOCSTRING(quadl) @DOCSTRING(quadgk) -@DOCSTRING(quadv) +@DOCSTRING(quadcc) + +Sometimes one does not have the function, but only the raw (x, y) points from +which to perform an integration. This can occur when collecting data in an +experiment. The @code{trapz} function can integrate these values as shown in +the following example where "data" has been collected on the cosine function +over the range [0, pi/2). + +@example +@group +x = 0:0.1:pi/2; # Uniformly spaced points +y = cos (x); +trapz (x, y) + @result{} 0.99666 +@end group +@end example + +The answer is reasonably close to the exact value of 1. Ordinary quadrature +is sensitive to the characteristics of the integrand. Empirical integration +depends not just on the integrand, but also on the particular points chosen to +represent the function. Repeating the example above with the sine function +over the range [0, pi/2) produces far inferior results. -@DOCSTRING(quadcc) +@example +@group +x = 0:0.1:pi/2; # Uniformly spaced points +y = sin (x); +trapz (x, y) + @result{} 0.92849 +@end group +@end example + +However, a slightly different choice of data points can change the result +significantly. The same integration, with the same number of points, but +spaced differently produces a more accurate answer. + +@example +@group +x = linspace (0, pi/2, 16); # Uniformly spaced, but including endpoint +y = sin (x); +trapz (x, y) + @result{} 0.99909 +@end group +@end example + +In general there may be no way of knowing the best distribution of points ahead +of time. Or the points may come from an experiment where there is no freedom to +select the best distribution. In any case, one must remain aware of this +issue when using @code{trapz}. @DOCSTRING(trapz) @@ -183,9 +266,9 @@ @section Functions of Multiple Variables Octave does not have built-in functions for computing the integral of -functions of multiple variables directly. It is however possible to +functions of multiple variables directly. It is possible, however, to compute the integral of a function of multiple variables using the -functions for one-dimensional integrals. +existing functions for one-dimensional integrals. To illustrate how the integration can be performed, we will integrate the function @@ -205,23 +288,23 @@ The first approach creates a function that integrates @math{f} with respect to @math{x}, and then integrates that function with respect to -@math{y}. Since @code{quad} is written in Fortran it cannot be called +@math{y}. Because @code{quad} is written in Fortran it cannot be called recursively. This means that @code{quad} cannot integrate a function that calls @code{quad}, and hence cannot be used to perform the double -integration. It is however possible with @code{quadl}, which is what -the following code does. +integration. Any of the other integrators, however, can be used which is +what the following code demonstrates. @example @group -function I = g(y) - I = ones(1, length(y)); - for i = 1:length(y) - f = @@(x) sin(pi.*x.*y(i)).*sqrt(x.*y(i)); - I(i) = quadl(f, 0, 1); +function q = g(y) + q = ones (size (y)); + for i = 1:length (y) + f = @@(x) sin (pi*x.*y(i)) .* sqrt (x.*y(i)); + q(i) = quadgk (f, 0, 1); endfor endfunction -I = quadl("g", 0, 1) +I = quadgk ("g", 0, 1) @result{} 0.30022 @end group @end example @@ -232,7 +315,7 @@ @example @group -I = dblquad (@@(x, y) sin(pi.*x.*y).*sqrt(x.*y), 0, 1, 0, 1) +I = dblquad (@@(x, y) sin (pi*x.*y) .* sqrt (x.*y), 0, 1, 0, 1) @result{} 0.30022 @end group @end example @@ -241,12 +324,12 @@ @DOCSTRING(triplequad) -The above mentioned approach works but is fairly slow, and that problem -increases exponentially with the dimensionality the problem. Another +The above mentioned approach works, but is fairly slow, and that problem +increases exponentially with the dimensionality of the integral. Another possible solution is to use Orthogonal Collocation as described in the -previous section. The integral of a function @math{f(x,y)} for -@math{x} and @math{y} between 0 and 1 can be approximated using @math{n} -points by +previous section (@pxref{Orthogonal Collocation}). The integral of a function +@math{f(x,y)} for @math{x} and @math{y} between 0 and 1 can be approximated +using @math{n} points by @tex $$ \int_0^1 \int_0^1 f(x,y) d x d y \approx \sum_{i=1}^n \sum_{j=1}^n q_i q_j f(r_i, r_j), @@ -257,13 +340,13 @@ @end ifnottex where @math{q} and @math{r} is as returned by @code{colloc(n)}. The generalization to more than two variables is straight forward. The -following code computes the studied integral using @math{n=7} points. +following code computes the studied integral using @math{n=8} points. @example @group -f = @@(x,y) sin(pi*x*y').*sqrt(x*y'); -n = 7; -[t, A, B, q] = colloc(n); +f = @@(x,y) sin (pi*x*y') .* sqrt (x*y'); +n = 8; +[t, ~, ~, q] = colloc (n); I = q'*f(t,t)*q; @result{} 0.30022 @end group @@ -272,7 +355,5 @@ @noindent It should be noted that the number of points determines the quality of the approximation. If the integration needs to be performed between -@math{a} and @math{b} instead of 0 and 1, a change of variables is needed. +@math{a} and @math{b}, instead of 0 and 1, then a change of variables is needed. - -
--- a/doc/interpreter/sparse.txi +++ b/doc/interpreter/sparse.txi @@ -223,8 +223,6 @@ @DOCSTRING(speye) -@DOCSTRING(spfun) - @DOCSTRING(spones) @DOCSTRING(sprand) @@ -241,7 +239,7 @@ @group ri = ci = d = []; for j = 1:c - ri = [ri; randperm(r)(1:n)']; + ri = [ri; randperm(r,n)']; ci = [ci; j*ones(n,1)]; d = [d; rand(n,1)]; endfor
--- a/doc/interpreter/sparseimages.m +++ b/doc/interpreter/sparseimages.m @@ -200,7 +200,7 @@ E = size(elems,1); #No. of elements N = size(nodes,1); #No. of elements - D = size(elems,2); #dimentions+1 + D = size(elems,2); #dimensions+1 ## Plot FEM Geometry elemx = elems(:,[1,2,3,1])';
--- a/doc/interpreter/stats.txi +++ b/doc/interpreter/stats.txi @@ -96,6 +96,10 @@ @DOCSTRING(moment) +@DOCSTRING(quantile) + +@DOCSTRING(prctile) + A summary view of a data set can be generated quickly with the @code{statistics} function. @@ -110,12 +114,10 @@ @DOCSTRING(center) -@DOCSTRING(studentize) +@DOCSTRING(zscore) @DOCSTRING(histc) -@DOCSTRING(cut) - @c FIXME: really want to put a reference to unique here @c @DOCSTRING(values) @@ -127,6 +129,8 @@ @DOCSTRING(run_count) +@DOCSTRING(runlength) + @DOCSTRING(probit) @DOCSTRING(logit) @@ -162,9 +166,7 @@ @DOCSTRING(cov) -@DOCSTRING(cor) - -@DOCSTRING(corrcoef) +@DOCSTRING(corr) @DOCSTRING(spearman) @@ -301,9 +303,9 @@ @tab @code{poisscdf} @tab @code{poissinv} @item Standard Normal Distribution - @tab @code{stdtormal_pdf} - @tab @code{stdtormal_cdf} - @tab @code{stdtormal_inv} + @tab @code{stdnormal_pdf} + @tab @code{stdnormal_cdf} + @tab @code{stdnormal_inv} @item t (Student) Distribution @tab @code{tpdf} @tab @code{tcdf}
--- a/doc/interpreter/stmt.txi +++ b/doc/interpreter/stmt.txi @@ -580,7 +580,7 @@ @example @group -a = [1,3;2,4]; b = cat(3, a, 2*a); +a = [1,3;2,4]; c = cat(3, a, 2*a); for i = c i endfor
--- a/doc/interpreter/strings.txi +++ b/doc/interpreter/strings.txi @@ -147,6 +147,12 @@ @end group @end example +In scripts the two different string types can be distinguished if necessary +by using @code{is_dq_string} and @code{is_sq_string}. + +@DOCSTRING(is_dq_string) + +@DOCSTRING(is_sq_string) @node Character Arrays @section Character Arrays @@ -517,26 +523,26 @@ @DOCSTRING(isalpha) -@DOCSTRING(isascii) - -@DOCSTRING(iscntrl) - -@DOCSTRING(isdigit) - -@DOCSTRING(isgraph) - @DOCSTRING(isletter) @DOCSTRING(islower) -@DOCSTRING(isprint) +@DOCSTRING(isupper) + +@DOCSTRING(isdigit) + +@DOCSTRING(isxdigit) @DOCSTRING(ispunct) @DOCSTRING(isspace) -@DOCSTRING(isupper) +@DOCSTRING(iscntrl) + +@DOCSTRING(isgraph) -@DOCSTRING(isxdigit) +@DOCSTRING(isprint) + +@DOCSTRING(isascii) @DOCSTRING(isstrprop)
--- a/doc/interpreter/system.txi +++ b/doc/interpreter/system.txi @@ -149,7 +149,8 @@ @node Filesystem Utilities @section Filesystem Utilities -Octave includes many utility functions for copying, moving, renaming, and deleting files; for creating, reading, and deleting directories; for retrieving +Octave includes many utility functions for copying, moving, renaming, and +deleting files; for creating, reading, and deleting directories; for retrieving status information on files; and for manipulating file and path names. @DOCSTRING(movefile) @@ -229,6 +230,8 @@ @DOCSTRING(tempname) +@DOCSTRING(recycle) + @node File Archiving Utilities @section File Archiving Utilities @@ -246,8 +249,6 @@ @DOCSTRING(unzip) -@DOCSTRING(pack) - @DOCSTRING(unpack) @DOCSTRING(bzip2) @@ -260,6 +261,8 @@ * URL Manipulation:: @end menu +@DOCSTRING(gethostname) + @node FTP Objects @subsection FTP Objects @@ -301,6 +304,8 @@ @DOCSTRING(perl) +@DOCSTRING(python) + @DOCSTRING(popen) @DOCSTRING(pclose) @@ -470,6 +475,8 @@ @DOCSTRING(uname) +@DOCSTRING(nproc) + @DOCSTRING(ispc) @DOCSTRING(isunix) @@ -478,6 +485,8 @@ @DOCSTRING(isieee) +@DOCSTRING(isdeployed) + @DOCSTRING(OCTAVE_HOME) @DOCSTRING(matlabroot) @@ -494,6 +503,8 @@ @DOCSTRING(octave_config_info) +@DOCSTRING(usejava) + @DOCSTRING(getrusage) @node Hashing Functions
--- a/doc/interpreter/testfun.txi +++ b/doc/interpreter/testfun.txi @@ -34,20 +34,20 @@ @DOCSTRING(test) -@code{test} scans the named script file looking for lines which -start with @code{%!}. The prefix is stripped off and the rest of the -line is processed through the Octave interpreter. If the code +@code{test} scans the named script file looking for lines which start +with the identifier @samp{%!}. The prefix is stripped off and the rest +of the line is processed through the Octave interpreter. If the code generates an error, then the test is said to fail. Since @code{eval()} will stop at the first error it encounters, you must divide your tests up into blocks, with anything in a separate block evaluated separately. Blocks are introduced by the keyword -@code{test} immediately following the @code{%!}. For example: +@code{test} immediately following @samp{%!}. For example: @example @group - %!test error ("this test fails!"); - %!test "test doesn't fail. it doesn't generate an error"; +%!test error ("this test fails!"); +%!test "test doesn't fail. it doesn't generate an error"; @end group @end example @@ -55,9 +55,9 @@ @example @group - ***** test error ('this test fails!') - !!!!! test failed - this test fails! + ***** test error ("this test fails!") +!!!!! test failed +this test fails! @end group @end example @@ -66,16 +66,16 @@ @example @group - %!test - %! @var{a} = [1, 2, 3; 4, 5, 6]; B = [1; 2]; - %! expect = [ @var{a} ; 2*@var{a} ]; - %! get = kron (@var{b}, @var{a}); - %! if (any(size(expect) != size(get))) - %! error ("wrong size: expected %d,%d but got %d,%d", - %! size(expect), size(get)); - %! elseif (any(any(expect!=get))) - %! error ("didn't get what was expected."); - %! endif +%!test +%! @var{a} = [1, 2, 3; 4, 5, 6]; B = [1; 2]; +%! expect = [ @var{a} ; 2*@var{a} ]; +%! get = kron (@var{b}, @var{a}); +%! if (any (size (expect) != size (get))) +%! error ("wrong size: expected %d,%d but got %d,%d", +%! size(expect), size(get)); +%! elseif (any (any (expect != get))) +%! error ("didn't get what was expected."); +%! endif @end group @end example @@ -84,9 +84,9 @@ @example @group - %!test - %! @var{a} = [1, 2, 3; 4, 5, 6]; @var{b} = [1; 2]; - %! assert (kron (@var{b}, @var{a}), [ @var{a}; 2*@var{a} ]); +%!test +%! @var{a} = [1, 2, 3; 4, 5, 6]; @var{b} = [1; 2]; +%! assert (kron (@var{b}, @var{a}), [ @var{a}; 2*@var{a} ]); @end group @end example @@ -95,8 +95,8 @@ @example @group - %!test assert (1+eps, 1, 2*eps) # absolute error - %!test assert (100+100*eps, 100, -2*eps) # relative error +%!test assert (1+eps, 1, 2*eps) # absolute error +%!test assert (100+100*eps, 100, -2*eps) # relative error @end group @end example @@ -105,8 +105,8 @@ @example @group - %!test assert (isempty([])) - %!test assert ([ 1,2; 3,4 ] > 0) +%!test assert (isempty ([])) +%!test assert ([1, 2; 3, 4] > 0) @end group @end example @@ -114,16 +114,32 @@ is a shorthand form: @example - %!assert (@dots{}) +%!assert (@dots{}) @end example @noindent which is equivalent to: @example - %!test assert (@dots{}) +%!test assert (@dots{}) @end example +Occasionally a block of tests will depend on having optional +functionality in Octave. Before testing such blocks the availability of +the required functionality must be checked. A @code{%!testif HAVE_XXX} +block will only be run if Octave was compiled with functionality +@samp{HAVE_XXX}. For example, the sparse single value decomposition, +@code{svds()}, depends on having the @sc{arpack} library. All of the tests +for @code{svds} begin with + +@example +%!testif HAVE_ARPACK +@end example + +@noindent +Review @file{config.h} or @code{octave_config_info ("DEFS")} to see some +of the possible values to check. + Sometimes during development there is a test that should work but is known to fail. You still want to leave the test in because when the final code is ready the test should pass, but you may not be able to @@ -132,44 +148,49 @@ @example @group - %!xtest assert (1==0) - %!xtest fail ('success=1','error')) +%!xtest assert (1==0) +%!xtest fail ("success=1", "error") @end group @end example -Another use of @code{xtest} is for statistical tests which should -pass most of the time but are known to fail occasionally. +@noindent +In this case, the test will run and any failure will be reported. +However, testing is not aborted and subsequent test blocks will be +processed normally. Another use of @code{xtest} is for statistical +tests which should pass most of the time but are known to fail +occasionally. Each block is evaluated in its own function environment, which means that variables defined in one block are not automatically shared with other blocks. If you do want to share variables, then you must declare them as @code{shared} before you use them. For example, the following declares the variable @var{a}, gives it an initial value (default -is empty), then uses it in several subsequent tests. +is empty), and then uses it in several subsequent tests. @example @group - %!shared @var{a} - %! @var{a} = [1, 2, 3; 4, 5, 6]; - %!assert (kron ([1; 2], @var{a}), [ @var{a}; 2*@var{a} ]); - %!assert (kron ([1, 2], @var{a}), [ @var{a}, 2*@var{a} ]); - %!assert (kron ([1,2; 3,4], @var{a}), [ @var{a},2*@var{a}; 3*@var{a},4*@var{a} ]); +%!shared @var{a} +%! @var{a} = [1, 2, 3; 4, 5, 6]; +%!assert (kron ([1; 2], @var{a}), [ @var{a}; 2*@var{a} ]); +%!assert (kron ([1, 2], @var{a}), [ @var{a}, 2*@var{a} ]); +%!assert (kron ([1,2; 3,4], @var{a}), [ @var{a},2*@var{a}; 3*@var{a},4*@var{a} ]); @end group @end example You can share several variables at the same time: @example - %!shared @var{a}, @var{b} +%!shared @var{a}, @var{b} @end example You can also share test functions: @example @group - %!function @var{a} = fn(@var{b}) - %! @var{a} = 2*@var{b}; - %!assert (@var{a}(2),4); +%!function @var{a} = fn (@var{b}) +%! @var{a} = 2*@var{b}; +%!endfunction +%!assert (fn(2), 4); @end group @end example @@ -182,13 +203,13 @@ For example: @example - %!error <passes!> error('this test passes!'); +%!error <passes!> error ("this test passes!"); @end example If the code doesn't generate an error, the test fails. For example: @example - %!error "this is an error because it succeeds."; +%!error "this is an error because it succeeds."; @end example @noindent @@ -196,23 +217,23 @@ @example @group - ***** error "this is an error because it succeeds."; - !!!!! test failed: no error + ***** error "this is an error because it succeeds."; +!!!!! test failed: no error @end group @end example It is important to automate the tests as much as possible, however some tests require user interaction. These can be isolated into demo blocks, which if you are in batch mode, are only run when -called with @code{demo} or @code{verbose}. The code is displayed before -it is executed. For example, +called with @code{demo} or the @code{verbose} option to @code{test}. +The code is displayed before it is executed. For example, @example @group - %!demo - %! @var{t}=[0:0.01:2*pi]; @var{x}=sin(@var{t}); - %! plot(@var{t},@var{x}); - %! you should now see a sine wave in your figure window +%!demo +%! @var{t} = [0:0.01:2*pi]; @var{x} = sin (@var{t}); +%! plot (@var{t}, @var{x}); +%! # you should now see a sine wave in your figure window @end group @end example @@ -221,10 +242,12 @@ @example @group - > @var{t}=[0:0.01:2*pi]; @var{x}=sin(@var{t}); - > plot(@var{t},@var{x}); - > you should now see a sine wave in your figure window - Press <enter> to continue: +funcname example 1: + @var{t} = [0:0.01:2*pi]; @var{x} = sin (@var{t}); + plot (@var{t}, @var{x}); + # you should now see a sine wave in your figure window + +Press <enter> to continue: @end group @end example @@ -233,23 +256,29 @@ If you want to temporarily disable a test block, put @code{#} in place of the block type. This creates a comment block which is echoed -in the log file, but is not executed. For example: +in the log file but not executed. For example: @example @group - %!#demo - %! @var{t}=[0:0.01:2*pi]; @var{x}=sin(@var{t}); - %! plot(@var{t},@var{x}); - %! you should now see a sine wave in your figure window +%!#demo +%! @var{t} = [0:0.01:2*pi]; @var{x} = sin (@var{t}); +%! plot (@var{t}, @var{x}); +%! # you should now see a sine wave in your figure window @end group @end example -Block type summary: +@subsubheading Block type summary: @table @code @item %!test check that entire block is correct +@item %!testif HAVE_XXX +check block only if Octave was compiled with feature HAVE_XXX. + +@item %!xtest +check block, report a test failure but do not abort testing. + @item %!error check for correct error message @@ -263,25 +292,29 @@ comment: ignore everything within the block @item %!shared x,y,z -declares variables for use in multiple tests +declare variables for use in multiple tests @item %!function -defines a function value for a shared variable +define a function for use in multiple tests + +@item %!endfunction +close a function definition @item %!assert (x, y, tol) -shorthand for %!test assert (x, y, tol) +shorthand for @code{%!test assert (x, y, tol)} @end table You can also create test scripts for builtins and your own C++ -functions. Just put a file of the function name on your path without -any extension and it will be picked up by the test procedure. You -can even embed tests directly in your C++ code: +functions. To do so put a file with the bare function name (no .m +extension) in a directory in the load path and it will be discovered by +the @code{test} function. Alternatively, you can embed tests directly in your +C++ code: @example @group - #if 0 - %!test disp('this is a test') - #endif +/* +%!test disp ("this is a test") +*/ @end group @end example @@ -290,21 +323,16 @@ @example @group - /* - %!test disp('this is a test') - */ +#if 0 +%!test disp ("this is a test") +#endif @end group @end example @noindent -but then the code will have to be on the load path and the user -will have to remember to type test('name.cc'). Conversely, you -can separate the tests from normal Octave script files by putting -them in plain files with no extension rather than in script files. -@c DO I WANT TO INCLUDE THE EDITOR SPECIFIC STATEMENT BELOW??? -@c Don't forget to tell emacs that the plain text file you are using -@c is actually octave code, using something like: -@c -*-octave-*- +However, in this case the raw source code will need to be on the load +path and the user will have to remember to type +@code{test ("funcname.cc")}. @DOCSTRING(assert) @@ -315,10 +343,10 @@ @DOCSTRING(demo) +@DOCSTRING(example) + @DOCSTRING(rundemos) @DOCSTRING(runtests) -@DOCSTRING(example) - @DOCSTRING(speed)
--- a/doc/interpreter/tips.txi +++ b/doc/interpreter/tips.txi @@ -28,7 +28,6 @@ @menu * Style Tips:: Writing clean and robust programs. -* Coding Tips:: Making code run faster. * Comment Tips:: Conventions for writing comments. * Function Headers:: Standard headers for functions. * Documentation Tips:: Writing readable documentation strings. @@ -75,203 +74,6 @@ copyright to anyone else, then place your name in the copyright notice. @end itemize -@node Coding Tips -@section Tips for Making Code Run Faster. -@cindex execution speed -@cindex speedups - -Here are some ways of improving the execution speed of Octave programs. - -@itemize @bullet -@item -Vectorize loops. For instance, rather than - -@example -@group -for i = 1:n-1 - a(i) = b(i+1) - b(i); -endfor -@end group -@end example - -@noindent -write - -@example -a = b(2:n) - b(1:n-1); -@end example - -This is especially important for loops with "cheap" bodies. Often it suffices -to vectorize just the innermost loop to get acceptable performance. A general -rule of thumb is that the "order" of the vectorized body should be greater or -equal to the "order" of the enclosing loop. - -@item -Use built-in and library functions if possible. Built-in and compiled functions -are very fast. Even with a m-file library function, chances are good that it is -already optimized, or will be optimized more in a future release. - -For instance, even better than - -@example -a = b(2:n) - b(1:n-1); -@end example - -@noindent -is - -@example -a = diff (b); -@end example - - -@item -Avoid computing costly intermediate results multiple times. Octave currently -does not eliminate common subexpressions. -Also, certain internal computation results are cached for variables. -For instance, if a matrix variable is used multiple times as an index, -checking the indices (and internal conversion to integers) is only done once. - -@item -Be aware of lazy copies (copy-on-write). When a copy of an object -is created, the data is not immediately copied, but rather shared. The actual -copying is postponed until the copied data needs to be modified. For example: - -@example -@group -a = zeros (1000); # create a 1000x1000 matrix -b = a; # no copying done here -b(1) = 1; # copying done here -@end group -@end example - -Lazy copying applies to whole Octave objects such as matrices, cells, struct, -and also individual cell or struct elements (not array elements). - -Additionally, index expressions also use lazy copying when Octave can determine -that the indexed portion is contiguous in memory. For example: - -@example -@group -a = zeros (1000); # create a 1000x1000 matrix -b = a(:,10:100); # no copying done here -b = a(10:100,:); # copying done here -@end group -@end example - -This applies to arrays (matrices), cell arrays, and structs indexed using (). -Index expressions generating cs-lists can also benefit of shallow copying -in some cases. In particular, when @var{a} is a struct array, expressions like -@code{@{a.x@}, @{a(:,2).x@}} will use lazy copying, so that data can be shared -between a struct array and a cell array. - -Most indexing expressions do not live longer than their `parent' objects. -In rare cases, however, a lazily copied slice outlasts its parent, in which -case it becomes orphaned, still occupying unnecessarily more memory than needed. -To provide a remedy working in most real cases, -Octave checks for orphaned lazy slices at certain situations, when a value -is stored into a "permanent" location, such as a named variable or cell or -struct element, and possibly economizes them. For example: - -@example -@group -a = zeros (1000); # create a 1000x1000 matrix -b = a(:,10:100); # lazy slice -a = []; # the original a array is still allocated -c@{1@} = b; # b is reallocated at this point -@end group -@end example - -@item -Avoid deep recursion. Function calls to m-file functions carry a relatively -significant overhead, so rewriting a recursion as a loop often helps. Also, -note that the maximum level of recursion is limited. - -@item -Avoid resizing matrices unnecessarily. When building a single result -matrix from a series of calculations, set the size of the result matrix -first, then insert values into it. Write - -@example -@group -result = zeros (big_n, big_m) -for i = over:and_over - r1 = @dots{} - r2 = @dots{} - result (r1, r2) = new_value (); -endfor -@end group -@end example - -@noindent -instead of - -@example -@group -result = []; -for i = ever:and_ever - result = [ result, new_value() ]; -endfor -@end group -@end example - -Sometimes the number of items can't be computed in advance, and stack-like -operations are needed. When elements are being repeatedly inserted at/removed -from the end of an array, Octave detects it as stack usage and attempts to use a -smarter memory management strategy pre-allocating the array in bigger chunks. -Likewise works for cell and struct arrays. - -@example -@group -a = []; -while (condition) - @dots{} - a(end+1) = value; # "push" operation - @dots{} - a(end) = []; # "pop" operation - @dots{} -endwhile -@end group -@end example - -@item -Use @code{cellfun} intelligently. The @code{cellfun} function is a useful tool -for avoiding loops. @xref{Processing Data in Cell Arrays}. -@code{cellfun} is often used with anonymous function handles; however, calling -an anonymous function involves an overhead quite comparable to the overhead -of an m-file function. Passing a handle to a built-in function is faster, -because the interpreter is not involved in the internal loop. For example: - -@example -@group -a = @{@dots{}@} -v = cellfun (@@(x) det(x), a); # compute determinants -v = cellfun (@@det, a); # faster -@end group -@end example - -@item -Octave includes a number of other functions that can replace common types of -loops, including @code{bsxfun}, @code{arrayfun}, @code{structfun}, -@code{accumarray}. These functions can take an arbitrary function as a handle. -Be sure to get familiar with them if you want to become an Octave expert. - -@item -Avoid calling @code{eval} or @code{feval} excessively, because -they require Octave to parse input or look up the name of a function in -the symbol table. - -If you are using @code{eval} as an exception handling mechanism and not -because you need to execute some arbitrary text, use the @code{try} -statement instead. @xref{The @code{try} Statement}. - -@item -If you are calling lots of functions but none of them will need to -change during your run, set the variable -@code{ignore_function_time_stamp} to @code{"all"} so that Octave doesn't -waste a lot of time checking to see if you have updated your function -files. -@end itemize @node Comment Tips @section Tips on Writing Comments @@ -463,16 +265,21 @@ @item Avoid using the word ``cause'' (or its equivalents) unnecessarily. -Instead of, ``Cause Octave to display text in boldface,'' write just +Instead of, ``Cause Octave to display text in boldface,'' just write ``Display text in boldface.'' @item +Use two spaces between the period marking the end of a sentence and the +word which opens the next sentence. This convention has no effect for +typeset formats like @TeX{}, but improves the readability of the documentation +in fixed-width environments such as the Info reader. + +@item Do not start or end a documentation string with whitespace. @item -Format the documentation string so that it fits in an Emacs window on an -80-column screen. It is a good idea for most lines to be no wider than -60 characters. +Format the documentation string so that it fits within an 80-column screen. +It is a good idea for most lines to be no wider than 60 characters. However, rather than simply filling the entire documentation string, you can make it much more readable by choosing line breaks with care. @@ -486,6 +293,26 @@ starting double-quote is not part of the string! @item +When choosing variable names try to adhere to the following guidelines. + +@table @asis +@item +vectors : x,y,z,t,w + +@item +matrices : A,B,M + +@item +strings : @nospell{str},s + +@item +filenames : @nospell{fname} + +@item +cells,@nospell{cellstrs} : c,@nospell{cstr} +@end table + +@item The documentation string for a variable that is a yes-or-no flag should start with words such as ``Nonzero means@dots{}'', to make it clear that all nonzero values are equivalent and indicate explicitly what zero and @@ -650,7 +477,7 @@ @example @group -*- texinfo -*- -@@deftypefn@{Function File@} @{@@var@{a@} =@} fn (@@var@{x@}, @dots{}) +@@deftypefn @{Function File@} @{@@var@{a@} =@} fn (@@var@{x@}, @dots{}) @@deftypefnx@{Function File@} @{@@var@{a@} =@} fn (@@var@{y@}, @dots{}) Help text in Texinfo format. @@end deftypefn @@ -664,15 +491,17 @@ @example -*- texinfo -*- -@@deftypefn @{Function File@} @{@} nchoosek (@@var@{n@}, @@var@{k@}) +@@deftypefn @{Function File@} @{@@var@{c@} =@} nchoosek (@@var@{n@}, @@var@{k@}) +@@deftypefnx @{Function File@} @{@@var@{c@} =@} nchoosek (@@var@{set@}, @@var@{k@}) -Compute the binomial coefficient or all combinations of -@@var@{n@}. If @@var@{n@} is a scalar then, calculate the -binomial coefficient of @@var@{n@} and @@var@{k@}, defined as +Compute the binomial coefficient or all combinations of a set of items. +If @@var@{n@} is a scalar then calculate the binomial coefficient +of @@var@{n@} and @@var@{k@} which is defined as @@tex $$ @{n \choose k@} = @{n (n-1) (n-2) \cdots (n-k+1) \over k!@} + = @{n! \over k! (n-k)!@} $$ @@end tex @@ifnottex @@ -680,86 +509,161 @@ @@example @@group / \ - | n | n (n-1) (n-2) @dots{} (n-k+1) - | | = ------------------------- - | k | k! + | n | n (n-1) (n-2) @@dots@{@} (n-k+1) n! + | | = ------------------------- = --------- + | k | k! k! (n-k)! \ / @@end group @@end example + @@end ifnottex +@@noindent +This is the number of combinations of @@var@{n@} items taken in groups of +size @@var@{k@}. + +If the first argument is a vector, @@var@{set@}, then generate all +combinations of the elements of @@var@{set@}, taken @@var@{k@} at a time, with +one row per combination. The result @@var@{c@} has @@var@{k@} columns and +@@w@{@@code@{nchoosek (length (@@var@{set@}), @@var@{k@})@}@} rows. + +For example: + +How many ways can three items be grouped into pairs? -If @@var@{n@} is a vector, this generates all combinations -of the elements of @@var@{n@}, taken @@var@{k@} at a time, -one row per combination. The resulting @@var@{c@} has size -@@code@{[nchoosek (length (@@var@{n@}),@@var@{k@}), @@var@{k@}]@}. +@@example +@@group +nchoosek (3, 2) + @@result@{@} 3 +@@end group +@@end example + +What are the possible pairs? -@@code@{nchoosek@} works only for non-negative integer arguments; use -@@code@{bincoeff@} for non-integer scalar arguments and for using vector -arguments to compute many coefficients at once. +@@example +@@group +nchoosek (1:3, 2) + @@result@{@} 1 2 + 1 3 + 2 3 +@@end group +@@end example -@@seealso@{bincoeff@} +@@code@{nchoosek@} works only for non-negative, integer arguments. Use +@@code@{bincoeff@} for non-integer and negative scalar arguments, or for +computing many binomial coefficients at once with vector inputs +for @@var@{n@} or @@var@{k@}. + +@@seealso@{bincoeff, perms@} @@end deftypefn @end example - +@noindent which demonstrates most of the concepts discussed above. @iftex This documentation string renders as -@c Note actually use the output of info below rather than try and -@c reproduce it here to prevent it looking different than how it would +@c Note: use the actual output of info below, rather than try and +@c reproduce it here to prevent it looking different from how it would @c appear with info. @example -@group -- Function File: C = nchoosek (N, K) - Compute the binomial coefficient or all combinations - of N. If N is a scalar then, calculate the binomial - coefficient of N and K, defined as + -- Function File: C = nchoosek (SET, K) + Compute the binomial coefficient or all combinations of a set of + items. + + If N is a scalar then calculate the binomial coefficient of N and + K which is defined as / \ - | n | n (n-1) (n-2) @dots{} (n-k+1) n! + | n | n (n-1) (n-2) ... (n-k+1) n! | | = ------------------------- = --------- | k | k! k! (n-k)! \ / - If N is a vector generate all combinations of the - elements of N, taken K at a time, one row per - combination. The resulting C has size `[nchoosek - (length (N), K), K]'. + This is the number of combinations of N items taken in groups of + size K. + + If the first argument is a vector, SET, then generate all + combinations of the elements of SET, taken K at a time, with one + row per combination. The result C has K columns and + `nchoosek (length (SET), K)' rows. - `nchoosek' works only for non-negative integer - arguments; use `bincoeff' for non-integer scalar - arguments and for using vector arguments to compute - many coefficients at once. + For example: + + How many ways can three items be grouped into pairs? + + nchoosek (3, 2) + => 3 + + What are the possible pairs? - See also: bincoeff. -@end group -@end example + nchoosek (1:3, 2) + => 1 2 + 1 3 + 2 3 + + `nchoosek' works only for non-negative, integer arguments. Use + `bincoeff' for non-integer and negative scalar arguments, or for + computing many binomial coefficients at once with vector inputs + for N or K. -using info, whereas in a printed documentation using @TeX{} it will appear -as + See also: bincoeff, perms +@end example +@noindent +using info, whereas in a printed documentation using @TeX{} it will +appear as -@deftypefn {Function File} {@var{c} =} nchoosek (@var{n}, @var{k}) +@deftypefn {Function File} {@var{c} =} nchoosek (@var{n}, @var{k}) +@deftypefnx {Function File} {@var{c} =} nchoosek (@var{set}, @var{k}) -Compute the binomial coefficient or all combinations of @var{n}. -If @var{n} is a scalar then, calculate the binomial coefficient -of @var{n} and @var{k}, defined as +Compute the binomial coefficient or all combinations of a set of items. + +If @var{n} is a scalar then calculate the binomial coefficient +of @var{n} and @var{k} which is defined as @tex $$ {n \choose k} = {n (n-1) (n-2) \cdots (n-k+1) \over k!} + = {n! \over k! (n-k)!} $$ @end tex -If @var{n} is a vector generate all combinations of the elements -of @var{n}, taken @var{k} at a time, one row per combination. The -resulting @var{c} has size @code{[nchoosek (length (@var{n}), -@var{k}), @var{k}]}. +@noindent +This is the number of combinations of @var{n} items taken in groups of +size @var{k}. + +If the first argument is a vector, @var{set}, then generate all +combinations of the elements of @var{set}, taken @var{k} at a time, with +one row per combination. The result @var{c} has @var{k} columns and +@w{@code{nchoosek (length (@var{set}), @var{k})}} rows. + +For example: + +How many ways can three items be grouped into pairs? -@code{nchoosek} works only for non-negative integer arguments; use -@code{bincoeff} for non-integer scalar arguments and for using vector -arguments to compute many coefficients at once. +@example +@group +nchoosek (3, 2) + @result{} 3 +@end group +@end example + +What are the possible pairs? -@seealso{bincoeff} +@example +@group +nchoosek (1:3, 2) + @result{} 1 2 + 1 3 + 2 3 +@end group +@end example + +@code{nchoosek} works only for non-negative, integer arguments. Use +@code{bincoeff} for non-integer and negative scalar arguments, or for +computing many binomial coefficients at once with vector inputs for @var{n} +or @var{k}. + +@seealso{bincoeff, perms} @end deftypefn @end iftex
--- a/doc/interpreter/var.txi +++ b/doc/interpreter/var.txi @@ -28,10 +28,6 @@ names, but it is seldom useful to have variables with names longer than about 30 characters. The following are all valid variable names -@cindex job hunting -@cindex getting a good job -@cindex flying high and fast - @example @group x @@ -362,6 +358,8 @@ @DOCSTRING(clear) +@DOCSTRING(pack) + Information about a function or variable such as its location in the file system can also be acquired from within Octave. This is usually only useful during development of programs, and not within a program.
new file mode 100644 --- /dev/null +++ b/doc/interpreter/vectorize.txi @@ -0,0 +1,678 @@ +@c Copyright (C) 2011 Jordi Gutiérrez Hermoso +@c +@c This file is part of Octave. +@c +@c Octave is free software; you can redistribute it and/or modify it +@c under the terms of the GNU General Public License as published by the +@c Free Software Foundation; either version 3 of the License, or (at +@c your option) any later version. +@c +@c Octave is distributed in the hope that it will be useful, but WITHOUT +@c ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +@c FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +@c for more details. +@c +@c You should have received a copy of the GNU General Public License +@c along with Octave; see the file COPYING. If not, see +@c <http://www.gnu.org/licenses/>. + +@node Vectorization and Faster Code Execution +@chapter Vectorization and Faster Code Execution +@cindex vectorization +@cindex vectorize + +Vectorization is a programming technique that uses vector operations +instead of element-by-element loop-based operations. Besides frequently +producing more succinct Octave code, vectorization also allows for better +optimization in the subsequent implementation. The optimizations may occur +either in Octave's own Fortran, C, or C++ internal implementation, or even at a +lower level depending on the compiler and external numerical libraries used to +build Octave. The ultimate goal is to make use of your hardware's vector +instructions if possible or to perform other optimizations in software. + +Vectorization is not a concept unique to Octave, but it is particularly +important because Octave is a matrix-oriented language. Vectorized +Octave code will see a dramatic speed up (10X--100X) in most cases. + +This chapter discusses vectorization and other techniques for writing faster +code. + +@menu +* Basic Vectorization:: Basic techniques for code optimization +* Broadcasting:: Broadcasting operations +* Function Application:: Applying functions to arrays, cells, and structs +* Accumulation:: Accumulation functions +* Miscellaneous Techniques:: Other techniques for speeding up code +* Examples:: +@end menu + +@node Basic Vectorization +@section Basic Vectorization + +To a very good first approximation, the goal in vectorization is to +write code that avoids loops and uses whole-array operations. As a +trivial example, consider + +@example +@group +for i = 1:n + for j = 1:m + c(i,j) = a(i,j) + b(i,j); + endfor +endfor +@end group +@end example + +@noindent +compared to the much simpler + +@example +c = a + b; +@end example + +@noindent +This isn't merely easier to write; it is also internally much easier to +optimize. Octave delegates this operation to an underlying +implementation which, among other optimizations, may use special vector +hardware instructions or could conceivably even perform the additions in +parallel. In general, if the code is vectorized, the underlying +implementation has more freedom about the assumptions it can make +in order to achieve faster execution. + +This is especially important for loops with "cheap" bodies. Often it +suffices to vectorize just the innermost loop to get acceptable +performance. A general rule of thumb is that the "order" of the +vectorized body should be greater or equal to the "order" of the +enclosing loop. + +As a less trivial example, instead of + +@example +@group +for i = 1:n-1 + a(i) = b(i+1) - b(i); +endfor +@end group +@end example + +@noindent +write + +@example +a = b(2:n) - b(1:n-1); +@end example + +This shows an important general concept about using arrays for indexing +instead of looping over an index variable. @xref{Index Expressions}. +Also use boolean indexing generously. If a condition needs to be tested, +this condition can also be written as a boolean index. For instance, +instead of + +@example +@group +for i = 1:n + if a(i) > 5 + a(i) -= 20 + endif +endfor +@end group +@end example + +@noindent +write + +@example +a(a>5) -= 20; +@end example + +@noindent +which exploits the fact that @code{a > 5} produces a boolean index. + +Use elementwise vector operators whenever possible to avoid looping +(operators like @code{.*} and @code{.^}). @xref{Arithmetic Ops}. For +simple inline functions, the @code{vectorize} function can do this +automatically. + +@DOCSTRING(vectorize) + +Also exploit broadcasting in these elementwise operators both to avoid +looping and unnecessary intermediate memory allocations. +@xref{Broadcasting}. + +Use built-in and library functions if possible. Built-in and compiled +functions are very fast. Even with an m-file library function, chances +are good that it is already optimized, or will be optimized more in a +future release. + +For instance, even better than + +@example +a = b(2:n) - b(1:n-1); +@end example + +@noindent +is + +@example +a = diff (b); +@end example + +Most Octave functions are written with vector and array arguments in +mind. If you find yourself writing a loop with a very simple operation, +chances are that such a function already exists. The following functions +occur frequently in vectorized code: + +@itemize @bullet +@item +Index manipulation + +@itemize +@item +find + +@item +sub2ind + +@item +ind2sub + +@item +sort + +@item +unique + +@item +lookup + +@item +ifelse / merge +@end itemize + +@item +Repetition +@itemize +@item +repmat + +@item +repelems +@end itemize + +@item +Vectorized arithmetic +@itemize +@item +sum + +@item +prod + +@item +cumsum + +@item +cumprod + +@item +sumsq + +@item +diff + +@item +dot + +@item +cummax + +@item +cummin +@end itemize + +@item +Shape of higher dimensional arrays +@itemize +@item +reshape + +@item +resize + +@item +permute + +@item +squeeze + +@item +deal +@end itemize + +@end itemize + +@node Broadcasting +@section Broadcasting +@cindex broadcast +@cindex broadcasting +@cindex BSX +@cindex recycling +@cindex SIMD + +Broadcasting refers to how Octave binary operators and functions behave +when their matrix or array operands or arguments differ in size. Since +version 3.6.0, Octave now automatically broadcasts vectors, matrices, +and arrays when using elementwise binary operators and functions. +Broadly speaking, smaller arrays are ``broadcast'' across the larger +one, until they have a compatible shape. The rule is that corresponding +array dimensions must either + +@enumerate +@item +be equal, or + +@item +one of them must be 1. +@end enumerate + +@noindent +In case all dimensions are equal, no broadcasting occurs and ordinary +element-by-element arithmetic takes place. For arrays of higher +dimensions, if the number of dimensions isn't the same, then missing +trailing dimensions are treated as 1. When one of the dimensions is 1, +the array with that singleton dimension gets copied along that dimension +until it matches the dimension of the other array. For example, consider + +@example +@group +x = [1 2 3; + 4 5 6; + 7 8 9]; + +y = [10 20 30]; + +x + y +@end group +@end example + +@noindent +Without broadcasting, @code{x + y} would be an error because the dimensions +do not agree. However, with broadcasting it is as if the following +operation were performed: + +@example +@group +x = [1 2 3 + 4 5 6 + 7 8 9]; + +y = [10 20 30 + 10 20 30 + 10 20 30]; + +x + y +@result{} 11 22 33 + 14 25 36 + 17 28 39 +@end group +@end example + +@noindent +That is, the smaller array of size @code{[1 3]} gets copied along the +singleton dimension (the number of rows) until it is @code{[3 3]}. No +actual copying takes place, however. The internal implementation reuses +elements along the necessary dimension in order to achieve the desired +effect without copying in memory. + +Both arrays can be broadcast across each other, for example, all +pairwise differences of the elements of a vector with itself: + +@example +@group +y - y' +@result{} 0 10 20 + -10 0 10 + -20 -10 0 +@end group +@end example + +@noindent +Here the vectors of size @code{[1 3]} and @code{[3 1]} both get +broadcast into matrices of size @code{[3 3]} before ordinary matrix +subtraction takes place. + +A special case of broadcasting that may be familiar is when all +dimensions of the array being broadcast are 1, i.e. the array is a +scalar. Thus for example, operations like @code{x - 42} and @code{max +(x, 2)} are basic examples of broadcasting. + +For a higher-dimensional example, suppose @code{img} is an RGB image of +size @code{[m n 3]} and we wish to multiply each color by a different +scalar. The following code accomplishes this with broadcasting, + +@example +img .*= permute ([0.8, 0.9, 1.2], [1, 3, 2]); +@end example + +@noindent +Note the usage of permute to match the dimensions of the +@code{[0.8, 0.9, 1.2]} vector with @code{img}. + +For functions that are not written with broadcasting semantics, +@code{bsxfun} can be useful for coercing them to broadcast. + +@DOCSTRING(bsxfun) + +Broadcasting is only applied if either of the two broadcasting +conditions hold. As usual, however, broadcasting does not apply when two +dimensions differ and neither is 1: + +@example +@group +x = [1 2 3 + 4 5 6]; +y = [10 20 + 30 40]; +x + y +@end group +@end example + +@noindent +This will produce an error about nonconformant arguments. + +Besides common arithmetic operations, several functions of two arguments +also broadcast. The full list of functions and operators that broadcast +is + +@example + plus + .+ + minus - .- + times .* + rdivide ./ + ldivide .\ + power .^ .** + lt < + le <= + eq == + gt > + ge >= + ne != ~= + and & + or | + atan2 + hypot + max + min + mod + rem + xor + + += -= .+= .-= .*= ./= .\= .^= .**= &= |= +@end example + +Beware of resorting to broadcasting if a simpler operation will suffice. +For matrices @var{a} and @var{b}, consider the following: + +@example +@var{c} = sum (permute (@var{a}, [1, 3, 2]) .* permute (@var{b}, [3, 2, 1]), 3); +@end example + +@noindent +This operation broadcasts the two matrices with permuted dimensions +across each other during elementwise multiplication in order to obtain a +larger 3-D array, and this array is then summed along the third dimension. +A moment of thought will prove that this operation is simply the much +faster ordinary matrix multiplication, @code{@var{c} = @var{a}*@var{b};}. + +A note on terminology: ``broadcasting'' is the term popularized by the +Numpy numerical environment in the Python programming language. In other +programming languages and environments, broadcasting may also be known +as @emph{binary singleton expansion} (BSX, in @sc{matlab}, and the +origin of the name of the @code{bsxfun} function), @emph{recycling} (R +programming language), @emph{single-instruction multiple data} (SIMD), +or @emph{replication}. + +@subsection Broadcasting and Legacy Code + +The new broadcasting semantics almost never affect code that worked +in previous versions of Octave. Consequently, all code inherited from +@sc{matlab} that worked in previous versions of Octave should still work +without change in Octave. The only exception is code such as + +@example +@group +try + c = a.*b; +catch + c = a.*a; +end_try_catch +@end group +@end example + +@noindent +that may have relied on matrices of different size producing an error. +Due to how broadcasting changes semantics with older versions of Octave, +by default Octave warns if a broadcasting operation is performed. To +disable this warning, refer to its ID (@pxref{doc-warning_ids}): + +@example +warning ("off", "Octave:broadcast"); +@end example + +@noindent +If you want to recover the old behavior and produce an error, turn this +warning into an error: + +@example +warning ("error", "Octave:broadcast"); +@end example + +@noindent +For broadcasting on scalars that worked in previous versions of Octave, +this warning will not be emitted. + +@node Function Application +@section Function Application +@cindex map +@cindex apply +@cindex function application + +As a general rule, functions should already be written with matrix +arguments in mind and should consider whole matrix operations in a +vectorized manner. Sometimes, writing functions in this way appears +difficult or impossible for various reasons. For those situations, +Octave provides facilities for applying a function to each element of an +array, cell, or struct. + +@DOCSTRING(arrayfun) + +@DOCSTRING(spfun) + +@DOCSTRING(cellfun) + +@DOCSTRING(structfun) + +@node Accumulation +@section Accumulation + +Whenever it's possible to categorize according to indices the elements +of an array when performing a computation, accumulation functions can be +useful. + +@DOCSTRING(accumarray) + +@DOCSTRING(accumdim) + +@node Miscellaneous Techniques +@section Miscellaneous Techniques +@cindex execution speed +@cindex speedups +@cindex optimization + +Here are some other ways of improving the execution speed of Octave +programs. + +@itemize @bullet + +@item Avoid computing costly intermediate results multiple times. +Octave currently does not eliminate common subexpressions. Also, certain +internal computation results are cached for variables. For instance, if +a matrix variable is used multiple times as an index, checking the +indices (and internal conversion to integers) is only done once. + +@item Be aware of lazy copies (copy-on-write). +@cindex copy-on-write +@cindex COW +@cindex memory management +When a copy of an object is created, the data is not immediately copied, but +rather shared. The actual copying is postponed until the copied data needs to +be modified. For example: + +@example +@group +a = zeros (1000); # create a 1000x1000 matrix +b = a; # no copying done here +b(1) = 1; # copying done here +@end group +@end example + +Lazy copying applies to whole Octave objects such as matrices, cells, +struct, and also individual cell or struct elements (not array +elements). + +Additionally, index expressions also use lazy copying when Octave can +determine that the indexed portion is contiguous in memory. For example: + +@example +@group +a = zeros (1000); # create a 1000x1000 matrix +b = a(:,10:100); # no copying done here +b = a(10:100,:); # copying done here +@end group +@end example + +This applies to arrays (matrices), cell arrays, and structs indexed +using @samp{()}. Index expressions generating comma-separated lists can also +benefit from shallow copying in some cases. In particular, when @var{a} is a +struct array, expressions like @code{@{a.x@}, @{a(:,2).x@}} will use lazy +copying, so that data can be shared between a struct array and a cell array. + +Most indexing expressions do not live longer than their parent +objects. In rare cases, however, a lazily copied slice outlasts its +parent, in which case it becomes orphaned, still occupying unnecessarily +more memory than needed. To provide a remedy working in most real cases, +Octave checks for orphaned lazy slices at certain situations, when a +value is stored into a "permanent" location, such as a named variable or +cell or struct element, and possibly economizes them. For example: + +@example +@group +a = zeros (1000); # create a 1000x1000 matrix +b = a(:,10:100); # lazy slice +a = []; # the original a array is still allocated +c@{1@} = b; # b is reallocated at this point +@end group +@end example + +@item Avoid deep recursion. +Function calls to m-file functions carry a relatively significant overhead, so +rewriting a recursion as a loop often helps. Also, note that the maximum level +of recursion is limited. + +@item Avoid resizing matrices unnecessarily. +When building a single result matrix from a series of calculations, set the +size of the result matrix first, then insert values into it. Write + +@example +@group +result = zeros (big_n, big_m) +for i = over:and_over + ridx = @dots{} + cidx = @dots{} + result(ridx, cidx) = new_value (); +endfor +@end group +@end example + +@noindent +instead of + +@example +@group +result = []; +for i = ever:and_ever + result = [ result, new_value() ]; +endfor +@end group +@end example + +Sometimes the number of items can not be computed in advance, and +stack-like operations are needed. When elements are being repeatedly +inserted or removed from the end of an array, Octave detects it as stack +usage and attempts to use a smarter memory management strategy by +pre-allocating the array in bigger chunks. This strategy is also applied +to cell and struct arrays. + +@example +@group +a = []; +while (condition) + @dots{} + a(end+1) = value; # "push" operation + @dots{} + a(end) = []; # "pop" operation + @dots{} +endwhile +@end group +@end example + +@item Avoid calling @code{eval} or @code{feval} excessively. +Parsing input or looking up the name of a function in the symbol table are +relatively expensive operations. + +If you are using @code{eval} merely as an exception handling mechanism, and not +because you need to execute some arbitrary text, use the @code{try} +statement instead. @xref{The @code{try} Statement}. + +@item Use @code{ignore_function_time_stamp} when appropriate. +If you are calling lots of functions, and none of them will need to change +during your run, set the variable @code{ignore_function_time_stamp} to +@code{"all"}. This will stop Octave from checking the time stamp of a function +file to see if it has been updated while the program is being run. +@end itemize + +@node Examples +@section Examples + +The following are examples of vectorization questions asked by actual +users of Octave and their solutions. + +@c FIXME: We need a lot more examples here. + +@itemize @bullet +@item +For a vector @code{A}, the following loop + +@example +@group +n = length (A); +B = zeros (n, 2); +for i = 1:length(A) + ## this will be two columns, the first is the difference and + ## the second the mean of the two elements used for the diff. + B(i,:) = [A(i+1)-A(i), (A(i+1) + A(i))/2)]; +endfor +@end group +@end example + +@noindent +can be turned into the following one-liner: + +@example +B = [diff(A)(:), 0.5*(A(1:end-1)+A(2:end))(:)] +@end example + +Note the usage of colon indexing to flatten an intermediate result into +a column vector. This is a common vectorization trick. + +@end itemize
--- a/doc/liboctave/Makefile.am +++ b/doc/liboctave/Makefile.am @@ -19,7 +19,7 @@ # along with Octave; see the file COPYING. If not, see # <http://www.gnu.org/licenses/>. -include $(top_srcdir)/common.mk +include $(top_srcdir)/build-aux/common.mk ## Automake generated rules for documentation are not parallel-safe. ## Restrict current directory to run serially
--- a/doc/liboctave/array.texi +++ b/doc/liboctave/array.texi @@ -177,7 +177,7 @@ @deftypefnx Constructor {} DiagArray<T> (const DiagArray<T> &@var{a}) @end deftypefn -@deftypeop Assginment DiagArray<T>& {} {operator =} (const DiagArray<T> &@var{a}) +@deftypeop Assignment DiagArray<T>& {} {operator =} (const DiagArray<T> &@var{a}) @end deftypeop @deftypemethod DiagArray<T> int dim1 (void) const
--- a/doc/refcard/Makefile.am +++ b/doc/refcard/Makefile.am @@ -18,7 +18,7 @@ # along with Octave; see the file COPYING. If not, see # <http://www.gnu.org/licenses/>. -include $(top_srcdir)/common.mk +include $(top_srcdir)/build-aux/common.mk TEX = \ refcard.tex \
--- a/doc/refcard/refcard.tex +++ b/doc/refcard/refcard.tex @@ -863,14 +863,14 @@ gray2ind ({\it i}, {\it n})&convert gray scale to Octave image\cr image ({\it img}, {\it zoom})&display an Octave image matrix\cr imagesc ({\it img}, {\it zoom})&display scaled matrix as image\cr +imread ({\it file})&load an image file\cr imshow ({\it img}, {\it map})&display Octave image\cr imshow ({\it i}, {\it n})&display gray scale image\cr imshow ({\it r}, {\it g}, {\it b})&display RGB image\cr +imwrite ({\it img}, {\it file})&write images in various file formats\cr ind2gray ({\it img}, {\it map})&convert Octave image to gray scale\cr ind2rgb ({\it img}, {\it map})&convert indexed image to RGB\cr -loadimage ({\it file})&load an image file\cr rgb2ind ({\it r}, {\it g}, {\it b})&convert RGB to Octave image\cr -\omit\tt saveimage ({\it file}, {\it img}, {\it fmt}, {\it map})\quad\rm save a matrix to {\it file}\span\cr \endsec
rename from CHECKLIST rename to etc/CHECKLIST --- a/CHECKLIST +++ b/etc/CHECKLIST @@ -1,18 +1,13 @@ Things to do before making a release: - * Ask testers for the type(s) of machines they are using. - - * Update the version number in src/version.h. - - * Update the version number in doc/refcard/refcard.tex. - - * Add a `Version M.N.P released.' line to the ChangeLog. + * Update the version number and release date in configure.ac. * Update the NEWS file. - * Check the README file. + * Update the NEWS-<VERSION>.html, index.in, news.in, and download.in + files for the web site. - * Run autoconf, autoheader, and configure before making tar files. + * Copy tarballs to ftp.gnu.org. - * Update the NEWS and README.octave files in the anonymous ftp - directory. + * Post a release announcement to the help@octave.org and + info-gnu@gnu.org lists.
rename from HACKING rename to etc/HACKING --- a/HACKING +++ b/etc/HACKING @@ -7,8 +7,7 @@ These notes are intended to help people working on sources checked-out from the savannah source code repository. -These requirements do not apply when building from a distribution -tarball. +These requirements do not apply when building from a distribution tarball. ** Requirements @@ -120,7 +119,7 @@ fftpack * subroutines for fast fourier transforms lapack-xtra * wrappers for lapack functions used in Octave misc * miscellaneous utilities - odepack * odinary differential equation solver + odepack * ordinary differential equation solver ordered-qz * code for ordering eigenvalues for QZ factorization quadpack * subroutines for numerical integration ranlib * random number generators @@ -137,8 +136,8 @@ @ftp * ftp object class general * utility functions geometry * geometry algorithms + help * help subsystem functions image * image processing - help * help subsystem functions io * input/output functions linear-algebra * linear algebra stuff miscellaneous * stuff that doesn't fit anywhere else @@ -147,6 +146,7 @@ pkg * the package manager plot * plotting functions polynomial * polynomial manipulation + prefs * user-defined preferences set * set manipulation signal * signal processing sparse * sparse matrix support @@ -158,7 +158,21 @@ testfun * unit testing time * time and date functions - src -- the interpreter itself + src -- the interpreter itself plus lots of infrastructure + around it. Octave's extensive octave_value class + hierarchy for polymorphically handling all Octave + types is defined here. The built-in functions are + also defined here, so if "help foo" tells you foo is + built-in, its source will be somewhere in this + directory. + DLD-FUNCTIONS * Dynamically linked oct files. If you see "help foo" + telling you that foo is defined in foo.oct, then + foo.cc will be found here and contain the source + code. + OPERATORS * Definitions and template instantiations for + operators for all possible Octave type + combinations. + TEMPLATE-INST * Some C++ template instantiations. test -- tests for the interpreter test_*.m * fixed tests for the interpreter @@ -170,7 +184,8 @@ jwe@octave.org -Last updated: Sat Jan 22 22:00:25 PST 2011 +Last updated: Tue Nov 22 20:51:34 PST 2011 + ################################################################################
rename from NEWS.1 rename to etc/NEWS.1 --- a/NEWS.1 +++ b/etc/NEWS.1 @@ -143,9 +143,9 @@ <structure: s u v> This feature should be considered experimental, but it seems to - work ok. Suggestions for ways to improve it are welcome. + work OK. Suggestions for ways to improve it are welcome. - * Octave now supports a limited form of exception handling modelled + * Octave now supports a limited form of exception handling modeled after the unwind-protect form of Lisp: unwind_protect @@ -198,7 +198,7 @@ * Both `...{whitespace}\n' and `\{whitespace}\n' can be used to introduce continuation lines, where {whitespace} may include - spaces, tabs and comemnts. + spaces, tabs and comments. * The script directory has been split up by topic. @@ -214,7 +214,7 @@ make nonessential built-in functions dynamically loaded, but there also seem to be some problems. For example, fsolve seems to always return info == 3. This is difficult to debug since - gdb won't seem to allow breakpoints to be set inside + GDB doesn't appear to allow breakpoints to be set inside dynamically loaded functions. -- Octave uses a lot of memory if the dynamically linked functions @@ -349,7 +349,7 @@ rgb2ntsc -- image format conversion saveimage -- save an image to a file - * New time and date funcitons: + * New time and date functions: tic -- set wall-clock timer toc -- get elapsed wall-clock time, since timer last set @@ -452,7 +452,7 @@ within functions that take a variable number of arguments. * If given a second argument, svd now returns an economy-sized - decomposition, eliminating the unecessary rows or columns of U or + decomposition, eliminating the unnecessary rows or columns of U or V. * The max and min functions correctly handle complex matrices in @@ -935,7 +935,7 @@ * Improved help. The command `help -i topic' now uses the GNU Info browser to display help for the given topic directly from the - Texinfo documenation. + Texinfo documentation. * New function: chol -- Cholesky factorization. @@ -1286,7 +1286,7 @@ prefer_column_vectors. * Things like [[1,2][3,4]] no longer cause core dumps, and invalid - input like [1,2;3,4,[5,6]] now produces a diagnositic message. + input like [1,2;3,4,[5,6]] now produces a diagnostic message. * The cd, save, and load commands now do tilde expansion. @@ -1380,7 +1380,7 @@ a = [1,2,3,4]; b = a([1,0,0,1]) - sets b to the first and fourth elememnts of a. + sets b to the first and fourth elements of a. Zero-one style indexing also works for indexing the left hand side of an assignment. For example, @@ -1401,7 +1401,7 @@ 'false'. * Using the new global variable `propagate_empty_matrices', it is - possible to have unary andy binary operations on empty matrices + possible to have unary and binary operations on empty matrices return an empty matrix. The default value of this variable is 'warn', so that empty matrices are propagated but you get a warning. Some functions, like eig and svd have also been changed @@ -1594,7 +1594,7 @@ * New files: - THANKS -- A list of people and organazations who have supported + THANKS -- A list of people and organizations who have supported the development of Octave. NEWS -- This file, listing recent changes.
rename from NEWS.2 rename to etc/NEWS.2 --- a/NEWS.2 +++ b/etc/NEWS.2 @@ -173,7 +173,7 @@ chisquare_cdf -- CDF of the chi-square distribution chisquare_inv -- Quantile function of the chi-square distribution - chisquare_pdf -- PDF of the chi-sqaure distribution + chisquare_pdf -- PDF of the chi-square distribution chisquare_rnd -- Random deviates from the chi-square distribution discrete_cdf -- CDF of a discrete distribution @@ -549,7 +549,7 @@ * It is now possible to use commands like ls, save, and cd as simple variable names. They still cannot be used as formal parameters for functions, or as the names of structure variables. Failed - assignments leave them undefined (you can recover the orginal + assignments leave them undefined (you can recover the original function definition using clear). * Is is now possible to invoke commands like ls, save, and cd as @@ -982,7 +982,7 @@ getgrent -- read entry from group-file stream, opening if necessary getgrgid -- search for group entry with matching group ID getgrnam -- search for group entry with matching group name - setgrent -- rewind the pgroup-file stream + setgrent -- rewind the group-file stream endgrent -- close the group-file stream * The New function octave_config_info returns a structure containing
rename from NEWS.3 rename to etc/NEWS.3 --- a/NEWS.3 +++ b/etc/NEWS.3 @@ -60,7 +60,7 @@ semilogx, etc.). + Plot property values are not extensively checked. Specifying - invalid property values may produce unpredictible results. + invalid property values may produce unpredictable results. + Octave now sends data over the same pipe that is used to send commands to gnuplot. While this avoids the problem of
rename from ChangeLog rename to etc/OLD-ChangeLogs/ChangeLog --- a/ChangeLog +++ b/etc/OLD-ChangeLogs/ChangeLog @@ -1,3 +1,29 @@ +2011-04-14 Rik <octave@nomad.inbox5.com> + + * NEWS: Add colstyle to list of new functions for 3.4 + +2011-04-08 Rik <octave@nomad.inbox5.com> + + * NEWS: Deprecate studentize(), add new function zscore(). + +2011-04-04 Rik <octave@nomad.inbox5.com> + + * NEWS: Add perror, strerror to list of functions deprecated in 3.4 + +2011-03-31 Rik <octave@nomad.inbox5.com> + + * NEWS: Add cquad to list of functions deprecated in 3.4 + +2011-03-24 Jarno Rajahalme <jarno.rajahalme@gmail.com> + + * configure.ac: Try again with "-ff2c" if fortran compiler is + found incompatible. On OSX, try again with + libcruft/misc/blaswrap.c, if "-ff2c" also fails. + +2011-03-17 Iain Murray <iain@iainmurray.net> + + * bootstrap.conf (gnulib_modules): Include nproc in the list. + 2011-03-08 Rik <octave@nomad.inbox5.com> * mk-opts.pl: Recode using more modern Perl syntax. @@ -62,7 +88,7 @@ * README.MacOS: Fix FFTW CCFLAGS. -2010-02-08 Rik <octave@nomad.inbox5.com> +2011-02-08 Rik <octave@nomad.inbox5.com> * NEWS: Use indentation of 2 spaces rather than 3 in code examples. @@ -84,21 +110,21 @@ * PROJECTS, README.devel: Use maintainers@octave.org instead of octave-maintainers@octave.org. -2010-02-05 Rik <octave@nomad.inbox5.com> +2011-02-05 Rik <octave@nomad.inbox5.com> * PROJECTS: Point to maintained list on Octave Wiki. -2010-02-05 Rik <octave@nomad.inbox5.com> +2011-02-05 Rik <octave@nomad.inbox5.com> * mkoctfile.in, octave-config.in: Update usage strings. -2010-02-04 Rik <octave@nomad.inbox5.com> +2011-02-04 Rik <octave@nomad.inbox5.com> * configure.ac: Add new doc/icons/Makefile to list of Makefiles to build * examples/Makefile.am: Move building of .desktop files and distribution of icons to doc/icons directory. -2010-01-30 Rik <octave@nomad.inbox5.com> +2011-01-30 Rik <octave@nomad.inbox5.com> * NEWS: Deprecate glpkmex function. @@ -111,7 +137,7 @@ * configure.ac: Remove code to print warning for missing ARPACK. * README.MacOS: Remove arpack from list of prerequisite software. -2010-01-29 Rik <octave@nomad.inbox5.com> +2011-01-29 Rik <octave@nomad.inbox5.com> * NEWS: Deprecate saveimage function. @@ -159,7 +185,7 @@ * acinclude.m4 (OPENGL_LIBS): Don't add -L/usr/X11R6/LIB to LDFLAGS in test. Bug #32160. -2010-01-25 Rik <octave@nomad.inbox5.com> +2011-01-25 Rik <octave@nomad.inbox5.com> * Makefile.am: Directly run makefile rules in doc/interpreter directory for AUTHORS, BUGS, INSTALL.OCTAVE files. @@ -174,7 +200,7 @@ * Makefile.am (EXTRA_DIST): Remove ROADMAP from the list. -2010-01-24 Rik <octave@nomad.inbox5.com> +2011-01-24 Rik <octave@nomad.inbox5.com> * AUTHORS: Remove. File now auto-generated from contributors.texi. * Makefile.am: Add rule for AUTHORS file. @@ -183,20 +209,20 @@ * NEWS: Note change in audio/mu2lin. -2010-01-22 Tatsuro MATSUOKA <tmacchant@yahoo.co.jp> +2011-01-22 Tatsuro MATSUOKA <tmacchant@yahoo.co.jp> * README.MinGW: Small corrections to documentation. -2010-01-22 Rik <octave@nomad.inbox5.com> +2011-01-22 Rik <octave@nomad.inbox5.com> * README.devel: Update for 3.4 release. -2010-01-22 Rik <octave@nomad.inbox5.com> +2011-01-22 Rik <octave@nomad.inbox5.com> * HACKING: Revise and incorporate all of file ROADMAP. * ROADMAP: Deleted. -2010-01-22 Rik <octave@nomad.inbox5.com> +2011-01-22 Rik <octave@nomad.inbox5.com> * README.Windows: Reference README.MinGW * README.MinGW: Replace placeholder with actual instructions @@ -208,7 +234,7 @@ (OCTAVE_RELEASE_DATE): Now 2011-01-22. (OCTAVE_COPYRIGHT): Update year. -2010-01-20 Rik <octave@nomad.inbox5.com> +2011-01-20 Rik <octave@nomad.inbox5.com> * README.Cygwin, README.MacOS, README.Windows, README.ftp: Update documentation files for 3.4 release. @@ -223,7 +249,7 @@ * configure.ac, NEWS: Update for backend -> graphics_toolkit change. -2010-01-17 Rik <octave@nomad.inbox5.com> +2011-01-17 Rik <octave@nomad.inbox5.com> * NEWS: Add quadcc to list of new functions added. @@ -241,7 +267,7 @@ * NEWS: Add krylovb to deprecated function list. -2010-01-14 Rik <octave@nomad.inbox5.com> +2011-01-14 Rik <octave@nomad.inbox5.com> * NEWS: Add replot to deprecated function list. @@ -289,15 +315,15 @@ * mk-opts.pl: Generate initialization lists and in-line code for copying. -2010-01-11 Rik <octave@nomad.inbox5.com> +2011-01-11 Rik <octave@nomad.inbox5.com> * ROADMAP: Update guide to Octave directory structure. -2010-01-11 Rik <octave@nomad.inbox5.com> +2011-01-11 Rik <octave@nomad.inbox5.com> * README.mirrors: Update ftp links. -2010-01-06 Rik <octave@nomad.inbox5.com> +2011-01-06 Rik <octave@nomad.inbox5.com> * README: Update links and disk space requirements. @@ -311,15 +337,15 @@ * mkoctfile.in, mkoctfile.cc.in: Substitute and use LAPACK_LIBS. Bug #32009. -2010-01-04 Rik <octave@nomad.inbox5.com> +2011-01-04 Rik <octave@nomad.inbox5.com> * README.MacOS: Update CFLAGS recommendation to use -O2. -2010-01-04 Rik <octave@nomad.inbox5.com> +2011-01-04 Rik <octave@nomad.inbox5.com> * README.gnuplot: Update recommendation to version 4.4. -2010-01-04 Marco Atzeri <marco_atzeri@yahoo.it> +2011-01-04 Marco Atzeri <marco_atzeri@yahoo.it> * README.Cygmin: Update build instructions before 3.4 release.
rename from doc/ChangeLog rename to etc/OLD-ChangeLogs/doc-ChangeLog --- a/doc/ChangeLog +++ b/etc/OLD-ChangeLogs/doc-ChangeLog @@ -1,8 +1,219 @@ -2010-03-03 Rik <octave@nomad.inbox5.com> +2011-04-16 Ben Abbott <bpabbott@mac.com> + + * interpreter/plot.txi: Clarify that inheritance of default property + values only applies to the named object type. +2011-04-14 Rik <octave@nomad.inbox5.com> + + * interpreter/plot.txi: Add colstyle function to documentation. + +2011-04-12 Rik <octave@nomad.inbox5.com> + + * interpreter/expr.txi: Correct use of it's -> its in documentation. + +2011-04-12 Ben Abbott <bpabbott@mac.com> + + * interpreter/data.txi: Replace xref{Data Structures} with + xref{Structures}. + +2011-04-11 Rik <octave@nomad.inbox5.com> + + * interpreter/func.txi: Add discussion of isargout to Ignoring + Arguments section of documentation. + +2011-04-08 Rik <octave@nomad.inbox5.com> + + * interpreter/stats.txi: Deprecate studentize(), replace with + zscore(). + +2011-04-07 Rik <octave@nomad.inbox5.com> + + * interpreter/Makefile.am: Add spellcheck target to documentation + Makefile. + +2011-04-06 Rik <octave@nomad.inbox5.com> + + * interpreter/numbers.txi, interpreter/strings.txi: Group commonly used + isXXX functions together in documentation. + +2011-04-06 Rik <octave@nomad.inbox5.com> + + * interpreter/system.txi, interpreter/var.txi: Move pack() function to + proper place in documentation. + +2011-04-06 Rik <octave@nomad.inbox5.com> + + * interpreter/diffeq.txi, interpreter/eval.txi, interpreter/plot.txi, + interpreter/var.txi: Clean up operator and function indices. + +2011-04-04 Rik <octave@nomad.inbox5.com> + + * interpreter/plot.txi: Add warning about single precision in FLTK. + +2011-04-04 Rik <octave@nomad.inbox5.com> + + * interpreter/doccheck/aspell-octave.en.pws, interpreter/nonlin.txi, + interpreter/tips.txi: Spellcheck documentation for 3.4.1 release. + +2011-04-04 Rik <octave@nomad.inbox5.com> + + * interpreter/container.txi, interpreter/dynamic.txi, + interpreter/install.txi, interpreter/system.txi, interpreter/tips.txi: + Grammarcheck files for 3.4.1 release. + +2011-04-04 Rik <octave@nomad.inbox5.com> + + * interpreter/grammar.txi: Remove reference to deprecated function + perror(). + +2011-04-03 Rik <octave@nomad.inbox5.com> + + * interpreter/grammar.txi, interpreter/octave.texi: Add new section + on parsing to documentation. Add functions add_input_event_hook, + remove_input_event_hook, missing_function_hook to documentation. + +2011-04-03 Rik <octave@nomad.inbox5.com> + + * interpreter/linalg.txi: Add blkmm function to documentation. + +2011-04-02 Rik <octave@nomad.inbox5.com> + + * interpreter/stats.txi: Add quantile, prctile functions to + documentation. + +2011-04-02 Rik <octave@nomad.inbox5.com> + + * interpreter/system.txi: Add isdeployed function to documentation. + +2011-03-31 Rik <octave@nomad.inbox5.com> + + * interpreter/io.txi: Add list_in_columns, terminal_size functions + to documentation. + +2011-03-31 Rik <octave@nomad.inbox5.com> + + * interpreter/errors.txi, interpreter/octave.texi: Add onCleanup + function to documentation. + +2011-03-31 Rik <octave@nomad.inbox5.com> + + * interpreter/contrib.txi: Add recommended format for commit messages + which reference the bug tracker. + +2011-03-28 Rik <octave@nomad.inbox5.com> + + * interpreter/expr.txi: Eliminate space between variable and + parenthesis when using indexing. + * interpreter/intro.txi, interpreter/io.txi: Fix typos in docstring. + * interpreter/tips.txi: Add new recommendations for double spaces at + start of sentences and suggested variable names. + +2011-03-28 Rik <octave@nomad.inbox5.com> + + * interpreter/basics.txi: Add do_braindead_shortcircuit_evaluation to + the list of variables set by --traditional option. + +2011-03-27 Rik <octave@nomad.inbox5.com> + + * interpreter/expr.txi: Add allow_noninteger_range_as_index to + documentation. + +2011-03-27 Rik <octave@nomad.inbox5.com> + + * interpreter/expr.txi: Add do_braindead_shortcircuit_evaluation to + documentation. + +2011-03-26 Rik <octave@nomad.inbox5.com> + + * interpreter/doccheck/mk_undocumented_list: Add error_text to list + of functions not requiring a docstring. + +2011-03-19 Rik <octave@nomad.inbox5.com> + + * interpreter/container.txi: Add cellindexmat function to documentation. + +2011-03-19 Rik <octave@nomad.inbox5.com> + + * interpreter/oop.txi: Add optimize_subsasgn_calls function to + documentation. + +2011-03-19 Rik <octave@nomad.inbox5.com> + + * interpreter/stats.txi: Add runlength function to documentation. + +2011-03-19 Rik <octave@nomad.inbox5.com> + + * interpreter/plot.txi: Add isocolors, isonormals, isosurface functions + to documentation. + +2011-03-19 Rik <octave@nomad.inbox5.com> + + * interpreter/basics.txi: Add dump_prefs to documentation. + +2011-03-19 Rik <octave@nomad.inbox5.com> + + * interpreter/octave.texi, interpreter/plot.txi: Add daspect, pbaspect + functions to documentation. + +2011-03-19 Rik <octave@nomad.inbox5.com> + + * interpreter/octave.texi, interpreter/plot.txi: Add getappdata, + setappdata, isappdata, rmappdata functions to documentation. + +2011-03-18 Rik <octave@nomad.inbox5.com> + + * interpreter/matrix.txi: Add nth_element function to documentation. + +2011-03-18 Rik <octave@nomad.inbox5.com> + + * interpreter/doccheck/aspell-octave.en.pws, interpreter/io.txi, + interpreter/octave.texi, interpreter/plot.txi: Add uimenu, uigetdir, + uigetfile, and uiputfile to documentation. + +2011-03-18 Rik <octave@nomad.inbox5.com> + + * interpreter/nonlin.txi, interpreter/octave.texi: Add fminbnd, + fminunc functions to documentation. + +2011-03-18 Rik <octave@nomad.inbox5.com> + + * interpreter/arith.txi, interpreter/linalg.txi: Add function chop + to documentation. Re-order Utility Functions and move function dot + from linear algebra section to be with other utility functions. + +2011-03-18 Rik <octave@nomad.inbox5.com> + + * interpreter/basics.txi: Add gen_doc_cache, get_help_text, + get_help_text_from_file, get_first_help_sentence to documentation. + +2011-03-17 Rik <octave@nomad.inbox5.com> + + * interpreter/io.txi: Add fileread to documentation. + +2011-03-17 Rik <octave@nomad.inbox5.com> + + * interpreter/system.txi: Add gethostname to documentation + +2011-03-17 Rik <octave@nomad.inbox5.com> + + * interpreter/doccheck/mk_undocumented_list: Add fmod, + octave_tmp_file_name to list of exceptions which are already + documented. + +2011-03-17 Iain Murray <iain@iainmurray.net> + + * interpreter/system.txi: Remove nprocs and nprocs_conf functions + from documentation and replace with nproc. + +2011-03-16 Rik <octave@nomad.inbox5.com> + + * interpreter/system.txi: Add nproc and nproc_conf functions to + documentation. + +2011-03-03 Rik <octave@nomad.inbox5.com> * interpreter/matrix.txi: Deprecate is_duplicate_entry. -2010-03-02 Rik <octave@nomad.inbox5.com> +2011-03-02 Rik <octave@nomad.inbox5.com> * interpreter/stats.txi: Correctly refer to discrete uniform distribution in documentation. @@ -29,7 +240,7 @@ Mention 3D patches in the OpenGL backend. Clarify Matlab-style short-circuiting. Specify that Octave also onCleanup. -2010-02-28 Rik <octave@nomad.inbox5.com> +2011-02-28 Rik <octave@nomad.inbox5.com> * interpreter/numbers.txi: Add isrow, iscolumn functions to manual. @@ -40,43 +251,48 @@ proofreading like removing trailing spaces and some minor spellchecking. -2010-02-19 Rik <octave@nomad.inbox5.com> +2011-02-19 Rik <octave@nomad.inbox5.com> * interpreter/install.txi: Remove reference to POSIX regex library. -2010-02-14 Rik <octave@nomad.inbox5.com> +2011-02-14 Rik <octave@nomad.inbox5.com> * interpreter/arith.txi, interpreter/io.txi, interpreter/oop.txi: Remove functions which have no DOCSTRING entries. +2011-02-10 Carlo de Falco <kingcrimson@tiscali.it> + + * interpreter/linalg.txi: Added gmres to the specialized solvers. + + 2011-02-06 John W. Eaton <jwe@octave.org> * interpreter/contributors.in: Add Fotios Kasolis to the list. -2010-02-05 Rik <octave@nomad.inbox5.com> +2011-02-05 Rik <octave@nomad.inbox5.com> * interpreter/doccheck/mk_undocumented_list: Add dbnext, alias for dbstep, to functions not requiring a docstring. -2010-02-05 Rik <octave@nomad.inbox5.com> +2011-02-05 Rik <octave@nomad.inbox5.com> * interpreter/doccheck/aspell-octave.en.pws: Add new spelling exceptions to Octave private dictionary. -2010-02-05 Rik <octave@nomad.inbox5.com> +2011-02-05 Rik <octave@nomad.inbox5.com> * interpreter/octave.texi: Update copyright on manual to 2011. -2010-02-05 Rik <octave@nomad.inbox5.com> +2011-02-05 Rik <octave@nomad.inbox5.com> * interpreter/mkoctfile.1, interpreter/octave-config.1, interpreter/octave.1: Overhaul man pages for release 3.4. -2010-02-04 Rik <octave@nomad.inbox5.com> +2011-02-04 Rik <octave@nomad.inbox5.com> * icons/octave-logo.ico: Add logo format left out of last changeset. -2010-02-04 Rik <octave@nomad.inbox5.com> +2011-02-04 Rik <octave@nomad.inbox5.com> * icons/: New directory for icons and .desktop files. * icons/octave-logo.png, icons/octave-logo.svg: Add new Octave O logo
rename from libcruft/ChangeLog rename to etc/OLD-ChangeLogs/libcruft-ChangeLog --- a/libcruft/ChangeLog +++ b/etc/OLD-ChangeLogs/libcruft-ChangeLog @@ -1,3 +1,8 @@ +2011-03-24 Jarno Rajahalme <jarno.rajahalme@gmail.com> + + * misc/blaswrap.c: New file. + * misc/module.mk (EXTRA_DIST): Add it to the list. + 2011-01-31 Rik <octave@nomad.inbox5.com> * arpack/src/dseupd.f, arpack/src/sseupd.f: Change GOTO target
rename from liboctave/ChangeLog rename to etc/OLD-ChangeLogs/liboctave-ChangeLog --- a/liboctave/ChangeLog +++ b/etc/OLD-ChangeLogs/liboctave-ChangeLog @@ -1,9 +1,29 @@ +2011-04-12 Rik <octave@nomad.inbox5.com> + + * LSODE.cc: Add semicolon to error messages to prevent run-together text. + +2011-04-01 Jordi Gutiérrez Hermoso <jordigh@gmail.com> + + * MatrixType (MatrixType::operator =): Plug memory leak due to + improper handling of perm array (bug #32804). + +2011-03-29 Rik <octave@nomad.inbox5.com> + + * Array.cc (diag): Treat empty vector (1x0 or 0x1) as valid input. + Improves Matlab compatibility (bug #32901). + 2011-02-13 David Bateman <dbateman@free.fr> * Sparse-perm-op-defs.h (template <typename SM> SM octinternal_do_mul_colpm_sm (const octave_idx_type *, const SM&)): Ensure that the row indices are sorted. +2011-03-14 Jordi Gutiérrez Hermoso <jordigh@gmail.com> + + * Sparse.cc (Sparse<T>::alloc) Change std::copy_backward to + std::copy, since the destination is at the back and not the + front. Bug #32747, cf. entry from 2010-11-25 + 2011-02-08 John W. Eaton <jwe@octave.org> * oct-alloc.h: Include <cstddef>. @@ -14,7 +34,7 @@ * PermMatrix.cc (operator*): Fix mixed row/column permutation case. Bug #32346. -2010-02-04 Rik <octave@nomad.inbox5.com> +2011-02-04 Rik <octave@nomad.inbox5.com> * Makefile.am: Undo accidental checkin
rename from scripts/ChangeLog rename to etc/OLD-ChangeLogs/scripts-ChangeLog --- a/scripts/ChangeLog +++ b/etc/OLD-ChangeLogs/scripts-ChangeLog @@ -1,8 +1,254 @@ +2011-04-18 Paul Boven <p.boven@xs4all.nl> + + * image/image.m: Fixed naming of variables in texinfo + +2011-04-17 Patrick Häcker <magicmuscleman> + + * strings/mat2str.m: Limit the number of digits to one less than + available for double. + +2011-04-15 Kai Habel <kai.habel@gmx.de> + + * general/interp1.m, polynomial/mkpp.m, polynomial/pchip.m, + polynomial/ppder.m, polynomial/ppint.m, polynomial/ppjumps.m, + polynomial/ppval.m, polynomial/spline.m, polynomial/unmkpp.m: + Make functions more compatible with respect to handling of + picewise polynoms (pp). Rename pp-struct elements. + Handle nD-arguments correctly. Tests added. + (bugs #32040, #32045) + +2011-04-13 David Bateman <dbateman@free.fr> + + * plot/colstyle.m : New function. + * plot/module.mk plot_FCN_FILES) : Add it here. + +2011-04-13 Rik <octave@nomad.inbox5.com> + + * help/__makeinfo__.m: Simplify function by using regular expressions. + Eliminate third input argument see_also function. + +2011-04-13 Rik <octave@nomad.inbox5.com> + + * general/isdir.m, general/isequal.m, general/isequalwithequalnans.m, + general/isscalar.m, general/issquare.m, general/isvector.m: Refactor + code to put input validation first. + + * general/iscolumn.m, general/isrow.m : Remove useless initialization + of output variable. + + * general/isa.m: Add additional tests for various classes. + +2011-04-13 Rik <octave@nomad.inbox5.com> + + * ChangeLog: Remove results of bad merge in ChangeLog. + +2011-04-12 Ben Abbott <bpabbott@mac.com> + + * miscellaneous/getappdata.m: If no property name is provided, return + a structure representing the appdata. + +2011-04-12 Marco Caliari <marco.caliari@univr.it> + + * general/quadgk.m: Fix problem with -Inf bound on integral (bug + #33055). + +2011-04-11 Ben Abbott <bpabbott@mac.com> + + * miscellaneous/getappdata.m: If appdata propery does not exist, return + an empty matrix. + +2011-04-08 Rik <octave@nomad.inbox5.com> + + * deprecated/module.mk, statistics/base/center.m, + statistics/base/module.mk: Deprecate studentize(), replace with + zscore(). + +2011-04-08 Rik <octave@nomad.inbox5.com> + + * linear-algebra/cond.m, linear-algebra/expm.m, linear-algebra/logm.m, + linear-algebra/null.m, linear-algebra/orth.m, linear-algebra/rank.m, + linear-algebra/rref.m: Improve docstrings. + +2011-04-08 Rik <octave@nomad.inbox5.com> + + * statistics/base/mode.m, statistics/base/quantile.m: Return output + of same class as input. + +2011-04-06 Rik <octave@nomad.inbox5.com> + + * miscellaneous/pack.m: Improve docstring. + +2011-04-06 Rik <octave@nomad.inbox5.com> + + * signal/module.mk: Make spectral density helper functions private. + (rectangle_sw, rectangle_lw, triangle_sw, triangle_lw) + +2011-04-06 Rik <octave@nomad.inbox5.com> + + * optimization/fminunc.m, plot/isocolors.m, plot/isonormals.m: + Clean up operator and function indices. + +2011-04-04 Rik <octave@nomad.inbox5.com> + + * miscellaneous/symvar.m, miscellaneous/warning_ids.m, + optimization/fminunc.m: Spellcheck documentation for 3.4.1 release. + +2011-04-04 Rik <octave@nomad.inbox5.com> + + * @ftp/mget.m, audio/loadaudio.m, audio/playaudio.m, audio/record.m, + audio/saveaudio.m, general/circshift.m, general/cumtrapz.m, + general/dblquad.m, general/quadgk.m, general/quadl.m, + general/shiftdim.m, general/triplequad.m, geometry/convhull.m, + geometry/delaunay3.m, geometry/dsearch.m, geometry/dsearchn.m, + geometry/tsearchn.m, geometry/voronoi.m, image/brighten.m, + io/textscan.m, miscellaneous/getappdata.m, + miscellaneous/namelengthmax.m, miscellaneous/rmappdata.m, + miscellaneous/setappdata.m, miscellaneous/swapbytes.m, + miscellaneous/symvar.m, miscellaneous/warning_ids.m, + pkg/private/get_forge_pkg.m, plot/clabel.m, plot/colorbar.m, + plot/cylinder.m, plot/daspect.m, plot/linkprop.m, plot/pbaspect.m, + plot/plotyy.m, plot/private/__add_default_menu__.m, plot/sphere.m, + plot/subplot.m, plot/view.m, polynomial/polyreduce.m, + polynomial/ppder.m, polynomial/ppint.m, signal/periodogram.m, + sparse/colperm.m, sparse/nonzeros.m, sparse/spaugment.m, + sparse/speye.m, sparse/treelayout.m, sparse/treeplot.m, + statistics/base/kurtosis.m, statistics/base/mean.m, + statistics/base/meansq.m, statistics/base/median.m, + statistics/base/mode.m, statistics/base/moment.m, + statistics/base/ranks.m, statistics/base/skewness.m, + statistics/base/statistics.m, statistics/base/var.m, time/datenum.m, + time/datetick.m, time/now.m: Grammarcheck m-files for 3.4.1 release. + +2011-04-04 Rik <octave@nomad.inbox5.com> + + * deprecated/module.mk, general/module.mk: Deprecate perror, strerror + functions. + +2011-04-02 Rik <octave@nomad.inbox5.com> + + * statistics/base/prctile.m, statistics/base/quantile.m: Improve + docstrings. + +2011-03-31 Rik <octave@nomad.inbox5.com> + + * pkg/module.mk, pkg/pkg.m, pkg/private/get_forge_pkg.m: Add + documentation for '-forge' option (bug #32464). Make get_forge_pkg + a private function. + +2011-03-31 Marco Caliari <marco.caliari@univr.it> + + * sparse/spdiags.m: Treat empty vector (1x0 or 0x1) the same as diag(). + +2011-03-31 Rik <octave@nomad.inbox5.com> + + * statistics/base/cor.m: Increase tolerance of %!tests using random + data to guarantee passage. + +2011-03-31 Rik <octave@nomad.inbox5.com> + + * deprecated/module.mk, deprecated/cquad.m: Add deprecated entry for + cquad() pointing to quadcc(). + +2011-03-31 Rik <octave@nomad.inbox5.com> + + * statistics/base/cor.m: Fix operation with only single input + (bug #32961) + +2011-03-29 John W. Eaton <jwe@octave.org> + + * special-matrix/wilkinson.m: Update test for 'wilkinson(1)' to reflect + changes to diag(). + +2011-03-29 Michael Creel <michael.creel@uab.es> + + * statistics/base/ols.m: Fix erroneous degrees of freedom when + computing the covariance estimator (closes: bug #32892). + +2011-03-28 Rik <octave@nomad.inbox5.com> + + * linear-algebra/cross.m, plot/ishold.m, signal/fftfilt.m: Improve + docstrings. + +2011-03-26 Robert T. Short <octave@phaselockedsystems.com.com> + + * signal/ifftshift.m: Add tests. + +2011-03-26 Robert T. Short <octave@phaselockedsystems.com.com> + + * signal/fftshift.m: Add tests. + +2011-03-21 Rik <octave@nomad.inbox5.com> + + * signal/ifftshift.m: Fix bug #32873, ifftshift fails. + +2011-03-19 Rik <octave@nomad.inbox5.com> + + * general/module.mk, statistics/base/module.mk: Move runlength.m + to statistics/base directory. + * statistics/base/runlength.m: Add input validation and tests. + Improve docstring. + +2011-03-19 Rik <octave@nomad.inbox5.com> + + * statistics/models/logistic_regression.m: Do not split function + declaration with line continuation. + * statistics/models/private/logistic_regression_likelihood.m, + statistics/models/private/logistic_regression_derivatives.m: Make + helper functions private. + * statistics/models/module.mk: Make helper functions private. + +2011-03-19 Rik <octave@nomad.inbox5.com> + + * plot/isocolors.m, plot/isonormals.m, plot/isosurface.m: Improve + docstrings. + +2011-03-19 Rik <octave@nomad.inbox5.com> + + * miscellaneous/dump_prefs.m: Close @deftypefn macro left open. + +2011-03-19 Rik <octave@nomad.inbox5.com> + + * miscellaneous/dump_prefs.m: Improve docstring. + +2011-03-19 Rik <octave@nomad.inbox5.com> + + * plot/daspect.m, plot/pbaspect.m: Use newline between @deftypefnx + macros to get correct appearance. + +2011-03-19 Ben Abbott <bpabbott@mac.com> + + * plot/patch.m: Add demo. + * geometry/trisurf.m: Set default edgecolor as Matlab does. Add demos. + +2011-03-18 Rik <octave@nomad.inbox5.com> + + * plot/uigetdir.m, plot/uigetfile.m, plot/uimenu.m, plot/uiputfile.m: + Improve docstrings. Check for error conditions (missing FLTK, wrong + number of arguments) at top of code. + +2011-03-18 Rik <octave@nomad.inbox5.com> + + * general/curl.m, general/divergence.m, linear-algebra/cross.m: + Update seealso cross references. + +2011-03-18 Rik <octave@nomad.inbox5.com> + + * help/get_first_help_sentence.m: Improve docstring. Add tests. + +2011-03-17 Rik <octave@nomad.inbox5.com> + + * scripts/sparse/svds.m: Fix bug #32818, nonconformant arguments + in svds. + +2011-03-17 Rik <octave@nomad.inbox5.com> + + * io/fileread.m: Add seealso reference to sscanf. + 2011-03-05 Ben Abbott <bpabbott@mac.com> * plot/colorbar.m: Allow location to be specified as a property. -2010-03-03 Rik <octave@nomad.inbox5.com> +2011-03-03 Rik <octave@nomad.inbox5.com> * miscellaneous/bunzip2.m, miscellaneous/bzip2.m, miscellaneous/gunzip.m, miscellaneous/gzip.m, miscellaneous/unpack.m, @@ -11,7 +257,7 @@ * miscellaneous/tar.m, miscellaneous/zip.m: Check for invalid arguments at the top, rather than bottom, of code. -2010-03-03 Rik <octave@nomad.inbox5.com> +2011-03-03 Rik <octave@nomad.inbox5.com> * miscellaneous/gzip.m: Use same functional form as bzip, zip, etc. * miscellaneous/private/__xzip__.m: Allow use of character arrays of @@ -21,16 +267,16 @@ Fix bug where unzip returned the archive name in addition to the list of files unzipped. -2010-03-03 Rik <octave@nomad.inbox5.com> +2011-03-03 Rik <octave@nomad.inbox5.com> * deprecated/module.mk, general/module.mk: Deprecate is_duplicate_entry. -2010-03-03 Rik <octave@nomad.inbox5.com> +2011-03-03 Rik <octave@nomad.inbox5.com> * miscellaneous/movefile.m: Fix copy&paste bug affecting Windows platform. (bug #32443) -2010-03-02 Rik <octave@nomad.inbox5.com> +2011-03-02 Rik <octave@nomad.inbox5.com> * statistics/distributions/unidcdf.m, statistics/distributions/unidinv.m, statistics/distributions/unidpdf.m, @@ -42,21 +288,21 @@ * plot/subplot.m: Remove redundant calls. For gnuplot set "activepositionproperty" to "position" always. -2010-03-01 Rik <octave@nomad.inbox5.com> +2011-03-01 Rik <octave@nomad.inbox5.com> * general/isscalar.m, general/isvector.m: Use modern warning function rather than deprecated built-in variable to set warning state. -2010-02-28 Rik <octave@nomad.inbox5.com> +2011-02-28 Rik <octave@nomad.inbox5.com> * general/iscolumn.m, general/isrow.m: Add 2 new utility functions to check for row or column vector. -2010-02-28 Rik <octave@nomad.inbox5.com> +2011-02-28 Rik <octave@nomad.inbox5.com> * sparse/treeplot.m: Use 'o' plot style as default for nodes -2010-02-27 Rik <octave@nomad.inbox5.com> +2011-02-27 Rik <octave@nomad.inbox5.com> * special-matrix/pascal.m: Fix incorrect statement in documentation for pascal.m. Bug #32523. @@ -74,7 +320,7 @@ * polynomial/polyval.m: Minor simplification in polynomial evaluation. -2010-02-22 Rik <octave@nomad.inbox5.com> +2011-02-22 Rik <octave@nomad.inbox5.com> * general/bitcmp.m, general/bitget.m, general/bitset.m, miscellaneous/license.m, special-matrix/pascal.m, @@ -105,16 +351,16 @@ 12467. Decrease spacing between subplots rows / columns. Clean up and add comments. -2010-02-22 Rik <octave@nomad.inbox5.com> +2011-02-22 Rik <octave@nomad.inbox5.com> * io/strread.m, plot/whitebg.m, strings/regexptranslate.m, testfun/runtests.m: Use single quotes around regexp patterns. -2010-02-20 Karsten Trulsen <karstent@math.uio.no> +2011-02-20 Karsten Trulsen <karstent@math.uio.no> * signal/fftshift.m: Fix broken function. Bug 32442. -2010-02-21 Carlo de Falco <kingcrimson@tiscali.it> +2011-02-21 Carlo de Falco <kingcrimson@tiscali.it> * pkg/get_forge_pkg.m: Fix typo in new PCRE style regular expression. @@ -123,7 +369,7 @@ * miscellaneous/warning_ids.m: Document Octave::autoload-relative-file-name warning. -2010-02-19 Rik <octave@nomad.inbox5.com> +2011-02-19 Rik <octave@nomad.inbox5.com> * io/dlmwrite.m, pkg/get_forge_pkg.m, plot/__gnuplot_ginput__.m, plot/__go_draw_axes__.m, testfun/runtests.m: Use PCRE regular @@ -158,7 +404,7 @@ * plot/__fltk_print__.m: Forward pipeline to drawnow instead of invoking a process here. Bug #32319. -2010-02-14 Rik <octave@nomad.inbox5.com> +2011-02-14 Rik <octave@nomad.inbox5.com> * plot/semilogxerr.m, plot/semilogyerr.m, special-matrix/pascal.m, special-matrix/rosser.m, special-matrix/wilkinson.m: Add missing @@ -192,6 +438,11 @@ * statistics/base/mean.m: Also accept logical values. +2011-02-10 Carlo de Falco <kingcrimson@tiscali.it> + + * linear-algebra/gmres.m: New file implementing the GMRES + iterative method for solving linear systems. + 2011-02-08 Ben Abbott <bpabbott@mac.com> * plot/__go_draw_axes__.m: Properly set fontspec for legends. @@ -242,11 +493,11 @@ * general/circshift.m: New tests. -2010-02-05 Rik <octave@nomad.inbox5.com> +2011-02-05 Rik <octave@nomad.inbox5.com> * miscellaneous/version.m, path/matlabroot.m: Correct spelling. -2010-02-05 Rik <octave@nomad.inbox5.com> +2011-02-05 Rik <octave@nomad.inbox5.com> * help/help.m, linear-algebra/onenormest.m, plot/graphics_toolkit.m, plot/pie3.m, plot/view.m, signal/periodogram.m: Grammarcheck docstrings. @@ -269,7 +520,7 @@ * plot/private/__plt__.m: Set initial values of hlgnd and tlgnd if a legend exists already. -2010-02-02 Rik <octave@nomad.inbox5.com> +2011-02-02 Rik <octave@nomad.inbox5.com> * sparse/svds.m: Use testif to only run some sparse tests when necessary libraries are installed. @@ -292,12 +543,12 @@ * plot/__fltk_ginput__.m: Remove line that should have been removed in previous change. -2010-01-31 Rik <octave@nomad.inbox5.com> +2011-01-31 Rik <octave@nomad.inbox5.com> * plot/private/__gnuplot_has_terminal__.m: Simplify regular expression to eliminate word-boundary assertion. -2010-01-30 Rik <octave@nomad.inbox5.com> +2011-01-30 Rik <octave@nomad.inbox5.com> * deprecated/module.mk, optimization/module.mk: Deprecate glpkmex function. @@ -314,24 +565,24 @@ Change all uses. (ginput_keypressfcn): Save keypress info. -2010-01-29 Rik <octave@nomad.inbox5.com> +2011-01-29 Rik <octave@nomad.inbox5.com> * plot/gnuplot_binary.in: Improve docstring -2010-01-29 Rik <octave@nomad.inbox5.com> +2011-01-29 Rik <octave@nomad.inbox5.com> * general/accumarray.m: Add seealso reference to accumdim. -2010-01-29 Rik <octave@nomad.inbox5.com> +2011-01-29 Rik <octave@nomad.inbox5.com> * set/powerset.m: Improve docstring. -2010-01-29 Rik <octave@nomad.inbox5.com> +2011-01-29 Rik <octave@nomad.inbox5.com> * miscellaneous/copyfile.m, miscellaneous/movefile.m, miscellaneous/tempname.m: Improve docstrings -2010-01-29 Rik <octave@nomad.inbox5.com> +2011-01-29 Rik <octave@nomad.inbox5.com> * deprecated/module.mk, image/module.mk: Deprecate saveimage.m. @@ -713,7 +964,7 @@ * statistics/distributions/betapdf.m: Untabify. -2010-01-20 Petr Mikulik <mikulik@physics.muni.cz> +2011-01-20 Petr Mikulik <mikulik@physics.muni.cz> * plot/uigetdir.m: Use correct variable name for argument check. Remove unneeded white spaces.
rename from src/ChangeLog rename to etc/OLD-ChangeLogs/src-ChangeLog --- a/src/ChangeLog +++ b/etc/OLD-ChangeLogs/src-ChangeLog @@ -1,3 +1,156 @@ +2011-04-19 Kai Habel <kai.habel@gmx.de> + + * src/DLD-FUNCTIONS/__init_fltk__.cc(plot_window::plot_window): + Instantiate canvas before uimenu. + +2011-04-13 Rik <octave@nomad.inbox5.com> + + * help.cc: Add spaces after commas in @seealso blocks. + +2011-04-12 Rik <octave@nomad.inbox5.com> + + * load-path.cc (restoredefaultpath): Correct use of it's -> its in + documentation. + +2011-04-10 John Eaton <jwe@octave.org> + + * graphics.cc (Fishandle) Accept vector of handles (bug #33025). + +2011-04-08 Rik <octave@nomad.inbox5.com> + + * DLD-FUNCTIONS/balance.cc, DLD-FUNCTIONS/eig.cc, + DLD-FUNCTIONS/hess.cc, DLD-FUNCTIONS/pinv.cc, DLD-FUNCTIONS/schur.cc, + DLD-FUNCTIONS/sqrtm.cc, DLD-FUNCTIONS/svd.cc, data.cc: Improve + docstrings. + +2011-04-06 Rik <octave@nomad.inbox5.com> + + * DLD-FUNCTIONS/dmperm.cc, data.cc: Clean up operator and function + indices. + +2011-04-04 Rik <octave@nomad.inbox5.com> + + * DLD-FUNCTIONS/nproc.cc: Spellcheck documentation for 3.4.1 release. + +2011-04-04 Rik <octave@nomad.inbox5.com> + + * DLD-FUNCTIONS/colamd.cc, data.cc, file-io.cc: Grammarcheck files + for 3.4.1 release. + +2011-04-03 Rik <octave@nomad.inbox5.com> + + * input.cc (add_input_event_hook, remove_input_event_hook): Improve + docstring. + * utils.cc (isvarname): Add seealso link to iskeyword(). + * variables.cc (missing_function_hook): Improve docstring. + +2011-04-03 Rik <octave@nomad.inbox5.com> + + * DLD-FUNCTIONS/dot.cc (blkmm): Improve docstring. + +2011-04-03 Rik <octave@nomad.inbox5.com> + + * data.cc (diag): Add documentation for 3-input form of diag. Add new + tests. + +2011-04-03 Rik <octave@nomad.inbox5.com> + + * data.cc (diag): Reverse previous changeset. Return 3-input form + of diag(). + +2011-04-01 Rik <octave@nomad.inbox5.com> + + * data.cc (diag): Remove archaic 3-input argument form of function. + Add all calling forms of function to docstring. + +2011-04-01 Rik <octave@nomad.inbox5.com> + + * DLD-FUNCTIONS/filter.cc: Fix orientation of initial conditions vector + (bug #32741). Revamp test vectors. + +2011-04-01 Rik <octave@nomad.inbox5.com> + + * DLD-FUNCTIONS/__fltk_uigetfile__.cc, DLD-FUNCTIONS/__init_fltk__.cc: + Correct typo in #include path (bug #32972). + +2011-03-31 Rik <octave@nomad.inbox5.com> + + * DLD-FUNCTIONS/onCleanup.cc: Remove non-existent @seealso link in + docstring. + +2011-03-31 Rik <octave@nomad.inbox5.com> + + * DLD-FUNCTIONS/quadcc.cc: Add reference to original paper in docstring. + +2011-03-30 Jordi Gutiérrez Hermoso <jordigh@gmail.com> + + * file-io.cc: Document the "all" parameter to fclose. + +2011-03-29 Ben Abbott <bpabbott@mac.com> + + * graphics.cc: Prevent ticks from being cropped by round-off errors + when limmode == auto (bug #32701). + +2011-03-28 Rik <octave@nomad.inbox5.com> + + * DLD-FUNCTIONS/inv.cc (inv, inverse), DLD-FUNCTIONS/tril.cc (tril), + data.cc (cumsum, szie), file-io.cc (fgets), ov-typeinfo.cc (typeinfo), + ov-usr-fcn.cc (nargout), utils.cc (make_absolute_filename), + variables.cc (who): Improve docstrings + +2011-03-25 John W. Eaton <jwe@octave.org> + + * file-io.cc (Fmkstemp): Use gnulib::mkstemp. + * DLD-FUNCTIONS/__init_fltk__.cc (f): Use gnulib::floor. + +2011-03-18 Rik <octave@nomad.inbox5.com> + + * dot.cc: Improve seealso cross references in docstring. + +2011-03-18 Rik <octave@nomad.inbox5.com> + + * help.cc (get_help_text, get_help_text_from_file): Improve docstrings. + +2011-03-17 John W. Eaton <jwe@octave.org> + + * ov-float.cc (octave_float_scalar::do_index_op): Widen to float + matrix, not double. + +2011-03-17 Rik <octave@nomad.inbox5.com> + + * syscalls.cc (gethostname): Redo documentation string. + +2011-03-17 Iain Murray <iain@iainmurray.net> + + * DLD-FUNCTIONS/nprocs.cc: Delete file. + * DLD-FUNCTIONS/nproc.cc: New file. New function nproc provided by + gnulib. + * DLD-FUNCTIONS/module-files: Add nproc.cc. + +2011-03-16 Iain Murray <iain@iainmurray.net> + + * DLD-FUNCTIONS/nprocs.cc: New file. + * DLD-FUNCTIONS/module-files: Add nprocs.cc. + Expose nprocs and nprocs_conf from gnulib. + +2011-03-15 Marco Caliari <marco.caliari@univr.it> + + * graphics.cc: Simplify calculation of number of tick labels. Fixes + bug #32692. + +2011-03-13 Konstantinos Poulios <logari81@googlemail.com> + + * DLD-FUNCTIONS/__init_fltk__.cc (plot_window::plot_window): + Revert changes from 2011-02-26. + +2011-03-10 Konstantinos Poulios <logari81@googlemail.com> + + * graphics.h.in: Add PERSISTENT mode to listener_mode. + (base_property::delete_listener): Take into account persistent + mode of a listener. + * graphics.cc (addlistener, dellistener): Accept a new optional + argument for persistent listeners. + 2011-03-07 Konstantinos Poulios <logari81@googlemail.com> Bug #32482. @@ -74,7 +227,7 @@ * DLD-FUNCTIONS/regexp.cc: Assume we have PCRE. -2010-02-19 Rik <octave@nomad.inbox5.com> +2011-02-19 Rik <octave@nomad.inbox5.com> * src/DLD-FUNCTIONS/regexp.cc: Use PCRE regular expressions everywhere now that Octave requires library for building. Remove testif PCRE @@ -89,7 +242,7 @@ Bug #32319. - * __init_fltk__.cc: Include sysdep.h. + * DLD-FUNCTIONS/__init_fltk__.cc: Include sysdep.h. (class OpenGL_fltk): Replace integer print_fid member with boolean print_mode. New class member print_cmd of type string. (OpenGL_fltk::print): Accept command string argument instead of @@ -167,6 +320,11 @@ * load-path.cc (strip_trailing_separators): Declare K as size_t rather than octave_idx_type. +2011-02-10 Carlo de Falco <kingcrimson@tiscali.it> + + * DLD-FUNCTIONS/mgorth.cc: New file implementing modified + Gram-Schmidt orthogonalization. + 2011-02-10 John W. Eaton <jwe@octave.org> * DLD-FUNCTIONS/regexp.cc (octregexp_list): Avoid deprecated @@ -270,7 +428,7 @@ converted to mxArray object, then simply create a clone of the mxArray_octave_value container. -2010-02-02 Rik <octave@nomad.inbox5.com> +2011-02-02 Rik <octave@nomad.inbox5.com> * DLD-FUNCTIONS/eigs.cc, DLD-FUNCTIONS/qr.cc: Use testif to only run some sparse tests when necessary libraries are installed.
rename from test/ChangeLog rename to etc/OLD-ChangeLogs/test-ChangeLog --- a/test/ChangeLog +++ b/etc/OLD-ChangeLogs/test-ChangeLog @@ -1,17 +1,37 @@ -2010-03-01 Rik <octave@nomad.inbox5.com> +2011-04-11 Rik <octave@nomad.inbox5.com> + + * fntests.m: Remove deprecated and private functions from list of + functions requiring tests. Count functions with %!demo blocks as + having tests. + +2011-04-03 Rik <octave@nomad.inbox5.com> + + * test_diag_perm.m: Reverse previous changeset. Return 3-input form + of diag(). + +2011-04-01 Rik <octave@nomad.inbox5.com> + + * test_diag_perm.m: Update diag tests to reflect removal of archaic + 3-input form of diag(). + +2011-03-18 Rik <octave@nomad.inbox5.com> + + * test_parser.m: Add operatore precedence tests. + +2011-03-01 Rik <octave@nomad.inbox5.com> * test/test_index-wfi-t.m: Use modern warning function rather than deprecated built-in variable to set warning state. -2010-02-22 Rik <octave@nomad.inbox5.com> +2011-02-22 Rik <octave@nomad.inbox5.com> * fntests.m: Use single quotes around regexp patterns. -2010-02-19 Rik <octave@nomad.inbox5.com> +2011-02-19 Rik <octave@nomad.inbox5.com> * fntests.m: Use PCRE regular expressions to simplify script. -2010-02-02 Rik <octave@nomad.inbox5.com> +2011-02-02 Rik <octave@nomad.inbox5.com> * build_sparse_tests.sh: Use testif to only run some sparse tests when necessary libraries are installed.
rename from README.MacOS rename to etc/README.MacOS --- a/README.MacOS +++ b/etc/README.MacOS @@ -269,7 +269,7 @@ After installing each of the dependencies, the sources are compiled by setting the proper environment variables and then following the standard build -sequence. The following is an example set of variables to for a 32-bit build +sequence. The following is an example set of variables for a 32-bit build using gcc-4.2. When building from the sources obtained from the mercurial archive, ./autogen.sh must be run prior to ./configure. @@ -334,67 +334,83 @@ includes a port file for octave-devel. To build and run the most recent development snapshots, enter the commands below. - sudo port selfupdate - sudo port install octave-devel + sudo port selfupdate + sudo port install octave-devel To build the developers sources in one's own way, or if MacPorts' version is outdated, a custom port file can be added. This requires setting up a local port file repository (link below). - http://guide.macports.org/#development.local-repositories + http://guide.macports.org/#development.local-repositories The octave-devel port file may be used as an initial starting point. The port file is accessible from the web at the link below. - http://trac.macports.org/browser/trunk/dports/math/octave-devel/Portfile + http://trac.macports.org/browser/trunk/dports/math/octave-devel/Portfile It is also available locally at the location below. The parameter ${prefix} is corresponds to where MacPorts is install, which by default is "/opt/local". - ${prefix}/var/macports/sources/rsync.macports.org/release/ports/math/octave-devel/Portfile + ${prefix}/var/macports/sources/rsync.macports.org/release/ports/math/octave-devel/Portfile + +If the Portfile is missing the dependencies, epstools, epstoedit, and transfig, +those should be installed manually or added to the Portfile. To install +manually, type the command below. + + sudo port install epstools epstoedit transfig The local source tarball must be placed in the location below, where ${name} and ${distname} are each specified in the port file. - ${prefix}/var/macports/distfiles/${name}/${disname}.tar.gz + ${prefix}/var/macports/distfiles/${name}/${disname}.tar.gz 2.4.2 Building for Active Development of Octave ----------------------------------------------- -To satisfy Octave's dependencies, first install the octave-devel port. - - sudo port selfupdate - sudo port install octave-devel +To satisfy most of Octave's dependencies, first install the octave-devel port. -Next run octave to determine the configure options needed to build Octave -using MacPorts. At Octave's prompt type the command below and make note of -the result, ${config_opts}. - - octave:1> octave_config_info.config_opts + sudo port selfupdate + sudo port install octave-devel Now uninstall the Octave port. - sudo port deactivate octave-devel + sudo port deactivate octave-devel + +This will remove Octave and leave its dependencies in place. Some additional +dependencies may be needed. + + sudo port install epstools epstoedit transfig + +Octave may now be built from a local mercurial archive by typing the commands +below (these assume gcc-4.4 is installed by macports). -This will remove Octave and leave its dependencies in place. Now Octave may -be built from the local mercurial archive by typing the commands below, where -the configure options mentioned above are substituted for the parameter -${config_opts}. If the sources being built are from the mercurial archive, -then ./autogen.sh must be run prior to ./configure. - - ./configure ${config_opts} - make + ./autogen.sh + export PREFIX=/opt/local + export CC=/opt/local/bin/gcc-mp-4.4 + export CXX=/opt/local/bin/g++-mp-4.4 + export CXXCPP="/opt/local/bin/g++-mp-4.4 -E" + export F77=/opt/local/bin/gfortran-mp-4.4 + export FC=/opt/local/bin/gfortran-mp-4.4 + export CXXFLAGS="-pipe -O2 -m64" + export FFLAGS="$CXXFLAGS -D_THREAD_SAFE -pthread" + export CFLAGS="$FFLAGS -lstdc++" + export LDFLAGS=-L$PREFIX/lib + export CPPFLAGS=-I$PREFIX/include + export BLAS_LIBS="-lcblas -lf77blas -latlas" + export LAPACK_LIBS=-llapack + ./configure --prefix="/opt/local" --without-framework-carbon --with-x + make Octave's integrated tests may be run. - make check + make check -However, "make install" should not be run as it may damage or corrupt the -MacPorts installation. To run Octave, type the command below from the root of -the mercurial archive. +"make install" should not be run as it will bypass the macports package +management. To run Octave, type the command below from the root of the +mercurial archive. - ./run-octave + ./run-octave John W. Eaton
rename from README.Windows rename to etc/README.Windows --- a/README.Windows +++ b/etc/README.Windows @@ -2,7 +2,7 @@ package of Octave for Cygwin. See the file README.MinGW for information about Octave on the MinGW platform -including installation of binaries or compiling Octave frome source. +including installation of binaries or compiling Octave from source. John W. Eaton
rename from gdbinit rename to etc/gdbinit --- a/gdbinit +++ b/etc/gdbinit @@ -1,5 +1,6 @@ ## Helpful macros for debugging Octave. +############################################################ ## Display a dim-vector object. define display-dims @@ -11,6 +12,12 @@ dont-repeat end +document display-dims +Usage: display-dims DIM_VECTOR +Display the contents of an Octave dimension vector. +end + +############################################################ ## Display a dense array object. define display-dense-array @@ -26,6 +33,15 @@ dont-repeat end +document display-dense-array +Usage: display-dense-array ARRAY +Display the contents of an ordinary, i.e., dense Octave array. + +See also [display-sparse-array] for showing the contents +of sparse Octave arrays. +end + +############################################################ ## Display a sparse array object. define display-sparse-array @@ -46,3 +62,28 @@ echo \n dont-repeat end + +document display-sparse-array +Usage: display-sparse-array SPARSE_ARRAY +Display the contents of a sparse Octave array. + +See also [display-dense-array] for showing the contents +of ordinary Octave arrays. +end + +############################################################ + +## Display Octave debugging stack + +define show-octave-dbstack + call show_octave_dbstack () +end + +document show-octave-dbstack +Usage: show-octave-dbstack +Display the contents of the current Octave debugging stack. + +This is the function stack that the Octave interpreter is processing +and will be different from the C++ stack being debugged with gdb. +end +
--- a/examples/@FIRfilter/FIRfilter.m +++ b/examples/@FIRfilter/FIRfilter.m @@ -1,9 +1,7 @@ ## -*- texinfo -*- -## @deftypefn {Function File} {} FIRfilter () +## @deftypefn {Function File} {} FIRfilter () ## @deftypefnx {Function File} {} FIRfilter (@var{p}) -## Creates an FIR filter with polynomial @var{p} as -## coefficient vector. -## +## Create a FIR filter with polynomial @var{p} as coefficient vector. ## @end deftypefn function f = FIRfilter (p)
--- a/examples/@FIRfilter/FIRfilter_aggregation.m +++ b/examples/@FIRfilter/FIRfilter_aggregation.m @@ -1,9 +1,7 @@ ## -*- texinfo -*- -## @deftypefn {Function File} {} FIRfilter () +## @deftypefn {Function File} {} FIRfilter () ## @deftypefnx {Function File} {} FIRfilter (@var{p}) -## Creates an FIR filter with polynomial @var{p} as -## coefficient vector. -## +## Create a FIR filter with polynomial @var{p} as coefficient vector. ## @end deftypefn function f = FIRfilter (p)
--- a/examples/@polynomial/polynomial.m +++ b/examples/@polynomial/polynomial.m @@ -1,13 +1,14 @@ ## -*- texinfo -*- -## @deftypefn {Function File} {} polynomial () +## @deftypefn {Function File} {} polynomial () ## @deftypefnx {Function File} {} polynomial (@var{a}) -## Creates a polynomial object representing the polynomial +## Create a polynomial object representing the polynomial ## ## @example ## a0 + a1 * x + a2 * x^2 + @dots{} + an * x^n ## @end example ## -## from a vector of coefficients [a0 a1 a2 ... an]. +## @noindent +## from a vector of coefficients [a0 a1 a2 @dots{} an]. ## @end deftypefn function p = polynomial (a)
--- a/examples/@polynomial/polynomial_superiorto.m +++ b/examples/@polynomial/polynomial_superiorto.m @@ -1,13 +1,14 @@ ## -*- texinfo -*- -## @deftypefn {Function File} {} polynomial () +## @deftypefn {Function File} {} polynomial () ## @deftypefnx {Function File} {} polynomial (@var{a}) -## Creates a polynomial object representing the polynomial +## Create a polynomial object representing the polynomial ## ## @example ## a0 + a1 * x + a2 * x^2 + @dots{} + an * x^n ## @end example ## -## from a vector of coefficients [a0 a1 a2 ... an]. +## @noindent +## from a vector of coefficients [a0 a1 a2 @dots{} an]. ## @end deftypefn function p = polynomial (a)
--- a/examples/COPYING +++ b/examples/COPYING @@ -1,3 +1,3 @@ -Copyright notices are intentionlly omitted from the files in the +Copyright notices are intentionally omitted from the files in the examples directory. We don't want copyright notices cluttering the manual.
--- a/examples/Makefile.am +++ b/examples/Makefile.am @@ -18,7 +18,7 @@ # along with Octave; see the file COPYING. If not, see # <http://www.gnu.org/licenses/>. -include $(top_srcdir)/common.mk +include $(top_srcdir)/build-aux/common.mk EXTRA_DIST =
--- a/libcruft/Makefile.am +++ b/libcruft/Makefile.am @@ -3,22 +3,22 @@ # Copyright (C) 1993-2011 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/>. -include $(top_srcdir)/common.mk +include $(top_srcdir)/build-aux/common.mk AM_CPPFLAGS = @CPPFLAGS@ -I../libgnu -I$(top_srcdir)/libgnu @@ -34,15 +34,27 @@ @CRUFT_DLL_DEFS@ \ $(AM_CPPFLAGS) -libcruft_la_LDFLAGS = \ - -release $(version) $(NO_UNDEFINED_LDFLAG) @XTRA_CRUFT_SH_LDFLAGS@ \ - -bindir $(bindir) +include link-deps.mk libcruft_la_LIBADD = \ + libranlib.la \ ../libgnu/libgnu.la \ - libranlib.la \ - $(LAPACK_LIBS) $(BLAS_LIBS) \ - $(FLIBS) + $(LIBCRUFT_LINK_DEPS) + +# Increment these as needed and according to the rules in the libtool +# manual: +libcruft_current = 0 +libcruft_revision = 0 +libcruft_age = 0 + +libcruft_version_info = $(libcruft_current):$(libcruft_revision):$(libcruft_age) + +libcruft_la_LDFLAGS = \ + -version-info $(libcruft_version_info) \ + $(NO_UNDEFINED_LDFLAG) \ + @XTRA_CRUFT_SH_LDFLAGS@ \ + -bindir $(bindir) \ + $(LIBCRUFT_LINK_OPTS) libcruft_la_DEPENDENCIES = cruft.def @@ -82,7 +94,7 @@ ./mkf77def $(srcdir) $(libranlib_la_SOURCES) > $@-t mv $@-t $@ -EXTRA_DIST += ChangeLog mkf77def.in +EXTRA_DIST += mkf77def.in DISTCLEANFILES = cruft.def ranlib.def
--- a/libcruft/arpack/module.mk +++ b/libcruft/arpack/module.mk @@ -29,7 +29,6 @@ arpack/src/dnapps.f \ arpack/src/dnaup2.f \ arpack/src/dnaupd.f \ - arpack/src/dnaupe.f \ arpack/src/dnconv.f \ arpack/src/dneigh.f \ arpack/src/dneupd.f \ @@ -54,7 +53,6 @@ arpack/src/snapps.f \ arpack/src/snaup2.f \ arpack/src/snaupd.f \ - arpack/src/snaupe.f \ arpack/src/snconv.f \ arpack/src/sneigh.f \ arpack/src/sneupd.f \
--- a/libcruft/blas-xtra/cdotc3.f +++ b/libcruft/blas-xtra/cdotc3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine cdotc3(m,n,k,a,b,c) -c purpose: a 3-dimensional dot product. +c purpose: a 3-dimensional dot product. c c = sum (conj (a) .* b, 2), where a and b are 3d arrays. c arguments: c m,n,k (in) the dimensions of a and b
--- a/libcruft/blas-xtra/cmatm3.f +++ b/libcruft/blas-xtra/cmatm3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine cmatm3(m,n,k,np,a,b,c) -c purpose: a 3-dimensional matrix product. +c purpose: a 3-dimensional matrix product. c given a (m,k,np) array a and (k,n,np) array b, c calculates a (m,n,np) array c such that c for i = 1:np @@ -28,8 +28,8 @@ c arguments: c m,n,k (in) the dimensions c np (in) number of multiplications -c a (in) a complex input array, size (m,k,np) -c b (in) a complex input array, size (k,n,np) +c a (in) a complex input array, size (m,k,np) +c b (in) a complex input array, size (k,n,np) c c (out) a complex output array, size (m,n,np) integer m,n,k,np complex a(m*k,np),b(k*n,np)
--- a/libcruft/blas-xtra/ddot3.f +++ b/libcruft/blas-xtra/ddot3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine ddot3(m,n,k,a,b,c) -c purpose: a 3-dimensional dot product. +c purpose: a 3-dimensional dot product. c c = sum (a .* b, 2), where a and b are 3d arrays. c arguments: c m,n,k (in) the dimensions of a and b
--- a/libcruft/blas-xtra/dmatm3.f +++ b/libcruft/blas-xtra/dmatm3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine dmatm3(m,n,k,np,a,b,c) -c purpose: a 3-dimensional matrix product. +c purpose: a 3-dimensional matrix product. c given a (m,k,np) array a and (k,n,np) array b, c calculates a (m,n,np) array c such that c for i = 1:np @@ -28,8 +28,8 @@ c arguments: c m,n,k (in) the dimensions c np (in) number of multiplications -c a (in) a double prec. input array, size (m,k,np) -c b (in) a double prec. input array, size (k,n,np) +c a (in) a double prec. input array, size (m,k,np) +c b (in) a double prec. input array, size (k,n,np) c c (out) a double prec. output array, size (m,n,np) integer m,n,k,np double precision a(m*k,np),b(k*n,np)
--- a/libcruft/blas-xtra/sdot3.f +++ b/libcruft/blas-xtra/sdot3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine sdot3(m,n,k,a,b,c) -c purpose: a 3-dimensional dot product. +c purpose: a 3-dimensional dot product. c c = sum (a .* b, 2), where a and b are 3d arrays. c arguments: c m,n,k (in) the dimensions of a and b
--- a/libcruft/blas-xtra/smatm3.f +++ b/libcruft/blas-xtra/smatm3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine smatm3(m,n,k,np,a,b,c) -c purpose: a 3-dimensional matrix product. +c purpose: a 3-dimensional matrix product. c given a (m,k,np) array a and (k,n,np) array b, c calculates a (m,n,np) array c such that c for i = 1:np @@ -28,8 +28,8 @@ c arguments: c m,n,k (in) the dimensions c np (in) number of multiplications -c a (in) a real input array, size (m,k,np) -c b (in) a real input array, size (k,n,np) +c a (in) a real input array, size (m,k,np) +c b (in) a real input array, size (k,n,np) c c (out) a real output array, size (m,n,np) integer m,n,k,np real a(m*k,np),b(k*n,np)
--- a/libcruft/blas-xtra/zdotc3.f +++ b/libcruft/blas-xtra/zdotc3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine zdotc3(m,n,k,a,b,c) -c purpose: a 3-dimensional dot product. +c purpose: a 3-dimensional dot product. c c = sum (conj (a) .* b, 2), where a and b are 3d arrays. c arguments: c m,n,k (in) the dimensions of a and b
--- a/libcruft/blas-xtra/zmatm3.f +++ b/libcruft/blas-xtra/zmatm3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine zmatm3(m,n,k,np,a,b,c) -c purpose: a 3-dimensional matrix product. +c purpose: a 3-dimensional matrix product. c given a (m,k,np) array a and (k,n,np) array b, c calculates a (m,n,np) array c such that c for i = 1:np @@ -28,8 +28,8 @@ c arguments: c m,n,k (in) the dimensions c np (in) number of multiplications -c a (in) a double complex input array, size (m,k,np) -c b (in) a double complex input array, size (k,n,np) +c a (in) a double complex input array, size (m,k,np) +c b (in) a double complex input array, size (k,n,np) c c (out) a double complex output array, size (m,n,np) integer m,n,k,np double complex a(m*k,np),b(k*n,np)
--- a/libcruft/lapack-xtra/crsf2csf.f +++ b/libcruft/lapack-xtra/crsf2csf.f @@ -32,7 +32,7 @@ y = t(j+1,j) if (y /= 0) then -c 2x2 block, form Givens rotation [c, i*s; i*s, c] +c 2x2 block, form Givens rotation [c, i*s; i*s, c] x = t(j,j) z = t(j,j+1) c(j) = sqrt(z/(z-y)) @@ -42,7 +42,7 @@ c apply all rotations to t(1:j+1,j+1) call crcrot1(j+1,t(1,j+1),c,s) c apply new rotation to columns j,j+1 - call crcrot2(j+1,t(1,j),t(1,j+1),c(j),s(j)) + call crcrot2(j+1,t(1,j),t(1,j+1),c(j),s(j)) c zero subdiagonal entry, skip next row t(j+1,j) = 0 c(j+1) = 1
--- a/libcruft/lapack-xtra/zrsf2csf.f +++ b/libcruft/lapack-xtra/zrsf2csf.f @@ -32,7 +32,7 @@ y = t(j+1,j) if (y /= 0) then -c 2x2 block, form Givens rotation [c, i*s; i*s, c] +c 2x2 block, form Givens rotation [c, i*s; i*s, c] x = t(j,j) z = t(j,j+1) c(j) = sqrt(z/(z-y)) @@ -42,7 +42,7 @@ c apply all rotations to t(1:j+1,j+1) call zrcrot1(j+1,t(1,j+1),c,s) c apply new rotation to columns j,j+1 - call zrcrot2(j+1,t(1,j),t(1,j+1),c(j),s(j)) + call zrcrot2(j+1,t(1,j),t(1,j+1),c(j),s(j)) c zero subdiagonal entry, skip next row t(j+1,j) = 0 c(j+1) = 1
new file mode 100644 --- /dev/null +++ b/libcruft/link-deps.mk @@ -0,0 +1,30 @@ +## The following libraries may be needed to satisfy gnulib dependencies: +## +## $(COPYSIGN_LIBM) +## $(FLOOR_LIBM) +## $(GETHOSTNAME_LIB) +## $(LIBSOCKET) +## $(LIB_NANOSLEEP) +## $(LTLIBINTL) +## $(ROUNDF_LIBM) +## $(ROUND_LIBM) +## $(TRUNCF_LIBM) +## $(TRUNC_LIBM) + +LIBCRUFT_LINK_DEPS = \ + $(COPYSIGN_LIBM) \ + $(FLOOR_LIBM) \ + $(GETHOSTNAME_LIB) \ + $(LIBSOCKET) \ + $(LIB_NANOSLEEP) \ + $(LTLIBINTL) \ + $(ROUNDF_LIBM) \ + $(ROUND_LIBM) \ + $(TRUNCF_LIBM) \ + $(TRUNC_LIBM) \ + $(LAPACK_LIBS) \ + $(BLAS_LIBS) \ + $(FLIBS) \ + $(LIBS) + +LIBCRUFT_LINK_OPTS =
new file mode 100644 --- /dev/null +++ b/libcruft/misc/blaswrap.c @@ -0,0 +1,290 @@ +/* + +Copyright (C) 2011 Jarno Rajahalme + +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/>. + +*/ + +/* + +Wrapper for Apple libBLAS.dylib and libLAPACK.dylib + +At least on the versions of OSX 10.6 so far (up and including 10.6.6) +these libraries are incompatible with 64 bit builds, as some functions +in libBLAS.dylib are not conforming to F2C calling conventions, as +they should. This breaks them in 64-bit builds on the x86_64 +architecture. + +Newer gfortran compoilers no longer default to the F2C calling +convention. These wrappers map the F2C conformant functions in +libBLAS and libLAPACK to the native gfortran calling convention, so +that the libraries can be used with software built for x86_64 +architecture. + + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> /* USE_BLASWRAP ? */ +#endif + +#ifdef USE_BLASWRAP + +/* + * vecLib is an Apple framework (collection of libraries) containing + * libBLAS and libLAPACK. The fortran stubs in these libraries are + * (mostly, but not completely) in the F2C calling convention. + * We access the libraries via the vecLib framework to make sure we + * get the Apple versions, rather than some other blas/lapack with the + * same name. + */ +#ifndef VECLIB_FILE +#define VECLIB_FILE "/System/Library/Frameworks/vecLib.framework/Versions/A/vecLib" +#endif + +/* + * Since this is a wrapper for fortran functions, we do not have prototypes for them. + */ +#pragma GCC diagnostic ignored "-Wmissing-prototypes" + +#include <dlfcn.h> +#include <stdlib.h> + +/* + * Apple LAPACK follows F2C calling convention, + * Convert to normal gfortran calling convention + */ + +static void (*f2c_blas_func[])(void); /* forward declaration for the wrapper */ +static void (*f2c_lapack_func[])(void); /* forward declaration for the wrapper */ + +/* + * LAPACK Wrappers, only need to convert the return value from double to float + */ + +typedef double (*F2C_CALL_0)(void); +typedef double (*F2C_CALL_1)(void *a1); +typedef double (*F2C_CALL_2)(void *a1, void *a2); +typedef double (*F2C_CALL_3)(void *a1, void *a2, void *a3); +typedef double (*F2C_CALL_4)(void *a1, void *a2, void *a3, void *a4); +typedef double (*F2C_CALL_5)(void *a1, void *a2, void *a3, void *a4, void *a5); +typedef double (*F2C_CALL_6)(void *a1, void *a2, void *a3, void *a4, void *a5, void *a6); +typedef double (*F2C_CALL_7)(void *a1, void *a2, void *a3, void *a4, void *a5, void *a6, void *a7); +typedef double (*F2C_CALL_8)(void *a1, void *a2, void *a3, void *a4, void *a5, void *a6, void *a7, void *a8); + +#define F2C_LAPACK_CALL_8(name) \ + float name (void *a1, void *a2, void *a3, void *a4, void *a5, void *a6, void *a7, void *a8) \ + { \ + return ((F2C_CALL_8)f2c_lapack_func[f2c_ ## name]) (a1, a2, a3, a4, a5, a6, a7, a8); \ + } + +#define F2C_LAPACK_CALL_7(name) \ + float name (void *a1, void *a2, void *a3, void *a4, void *a5, void *a6, void *a7) \ + { \ + return ((F2C_CALL_7)f2c_lapack_func[f2c_ ## name]) (a1, a2, a3, a4, a5, a6, a7); \ + } + +#define F2C_LAPACK_CALL_6(name) \ + float name (void *a1, void *a2, void *a3, void *a4, void *a5, void *a6) \ + { \ + return ((F2C_CALL_6)f2c_lapack_func[f2c_ ## name]) (a1, a2, a3, a4, a5, a6); \ + } + +#define F2C_LAPACK_CALL_5(name) \ + float name (void *a1, void *a2, void *a3, void *a4, void *a5) \ + { \ + return ((F2C_CALL_5)f2c_lapack_func[f2c_ ## name]) (a1, a2, a3, a4, a5); \ + } + +#define F2C_LAPACK_CALL_4(name) \ + float name (void *a1, void *a2, void *a3, void *a4) \ + { \ + return ((F2C_CALL_4)f2c_lapack_func[f2c_ ## name]) (a1, a2, a3, a4); \ + } + +#define F2C_LAPACK_CALL_3(name) \ + float name (void *a1, void *a2, void *a3) \ + { \ + return ((F2C_CALL_3)f2c_lapack_func[f2c_ ## name]) (a1, a2, a3); \ + } + +#define F2C_LAPACK_CALL_2(name) \ + float name (void *a1, void *a2) \ + { \ + return ((F2C_CALL_2)f2c_lapack_func[f2c_ ## name]) (a1, a2); \ + } + +#define F2C_LAPACK_CALL_1(name) \ + float name (void *a1) \ + { \ + return ((F2C_CALL_1)f2c_lapack_func[f2c_ ## name]) (a1); \ + } + +#define F2C_LAPACK_CALL_0(name) \ + float name (void) \ + { \ + return ((F2C_CALL_0)f2c_lapack_func[f2c_ ## name]) (); \ + } + +#define F2C_LAPACK_CALL_NONE(name) + +#define F2C_LAPACK_CALL(name, args) F2C_LAPACK_CALL_ ## args (name) + +#define ENUM_ITEM(name, args) \ + f2c_ ## name, + +#define NAME_TO_STRING_CASE(name, args) \ + case f2c_ ## name: return #name; + +#define DEFINE_LAPACK_ENUM(name, list) \ + typedef enum { \ + list(ENUM_ITEM) \ + } name; \ + static const char* \ + f2c_ ## name ## _name (name n) { \ + switch (n) { \ + list(NAME_TO_STRING_CASE) \ + default: return ""; \ + } \ + } \ + list(F2C_LAPACK_CALL) + +#define DEFINE_BLAS_ENUM(name, list) \ + typedef enum { \ + list(ENUM_ITEM) \ + } name; \ + static const char* \ + f2c_ ## name ## _name(name n) { \ + switch (n) { \ + list(NAME_TO_STRING_CASE) \ + default: return ""; \ + } \ + } + +/* + * Lapack functions (with argument count) that need the return value + * converted from double to float + */ +#define LAPACK_LIST(_) \ + _(clangb_,7) \ + _(clange_,6) \ + _(clangt_,5) \ + _(clanhb_,7) \ + _(clanhe_,6) \ + _(clanhp_,5) \ + _(clanhs_,5) \ + _(clanht_,4) \ + _(clansb_,7) \ + _(clansp_,5) \ + _(clansy_,6) \ + _(clantb_,8) \ + _(clantp_,6) \ + _(clantr_,8) \ + _(scsum1_,3) \ + _(second_,0) \ + _(slamc3_,2) \ + _(slamch_,1) \ + _(slangb_,7) \ + _(slange_,6) \ + _(slangt_,5) \ + _(slanhs_,5) \ + _(slansb_,7) \ + _(slansp_,5) \ + _(slanst_,4) \ + _(slansy_,6) \ + _(slantb_,8) \ + _(slantp_,6) \ + _(slantr_,8) \ + _(slapy2_,2) \ + _(slapy3_,3) \ + _(LAPACK_COUNT,NONE) + +/* + * These need a bit more complex wrappers + */ +#define BLAS_LIST(_) \ + _(cdotu_,6) \ + _(zdotu_,6) \ + _(cdotc_,6) \ + _(zdotc_,6) \ + _(BLAS_COUNT,NONE) + +DEFINE_BLAS_ENUM(blas, BLAS_LIST) + +DEFINE_LAPACK_ENUM(lapack, LAPACK_LIST) + +/* + * BLAS wrappers, F2C convention passes retuned complex as an extra first + * argument + */ +typedef struct { float r, i; } complex; +typedef struct { double r, i; } doublecomplex; + +typedef void (*F2C_BLAS_CALL_6)(void *c, void *a1, void *a2, void *a3, void *a4, void *a5); + +#define F2C_BLAS_CALL(type, name) \ +type name (void *a1, void *a2, void *a3, void *a4, void *a5) \ +{ \ + type cplx; \ + ((F2C_BLAS_CALL_6)f2c_blas_func[f2c_ ## name]) (&cplx, a1, a2, a3, a4, a5); \ + return cplx; \ +} + +F2C_BLAS_CALL(complex, cdotu_) +F2C_BLAS_CALL(doublecomplex, zdotu_) +F2C_BLAS_CALL(complex, cdotc_) +F2C_BLAS_CALL(doublecomplex, zdotc_) + + +/* + * Function pointer arrays, indexed by the enums + */ +static void (*f2c_blas_func[f2c_BLAS_COUNT])(void) = { 0 }; +static void (*f2c_lapack_func[f2c_LAPACK_COUNT])(void) = { 0 }; + +/* + * Initialization: This is called before main (). + * Get the function pointers to the wrapped functions in Apple vecLib + */ + +static void * apple_vecLib = 0; + +__attribute__((constructor)) +static void initVecLibWrappers (void) +{ + apple_vecLib = dlopen (VECLIB_FILE, RTLD_LOCAL | RTLD_NOLOAD | RTLD_FIRST); + if (0 == apple_vecLib) + abort (); + + int i; + for (i = 0; i < f2c_LAPACK_COUNT; i++) + if (0 == (f2c_lapack_func[i] = dlsym(apple_vecLib, f2c_lapack_name(i)))) + abort (); + for (i = 0; i < f2c_BLAS_COUNT; i++) + if (0 == (f2c_blas_func[i] = dlsym(apple_vecLib, f2c_blas_name(i)))) + abort (); +} + +__attribute__((destructor)) +static void finiVecLibWrappers (void) +{ + if (apple_vecLib) + dlclose (apple_vecLib); + apple_vecLib = 0; +} + +#endif /* USE_BLASWRAP */
--- a/libcruft/misc/module.mk +++ b/libcruft/misc/module.mk @@ -3,6 +3,7 @@ misc/d1mach-tst.for libcruft_la_SOURCES += \ + misc/blaswrap.c \ misc/cquit.c \ misc/d1mach.f \ misc/f77-extern.cc \
--- a/liboctave/Array.cc +++ b/liboctave/Array.cc @@ -84,7 +84,7 @@ void Array<T>::clear (void) { - if (--rep->count <= 0) + if (--rep->count == 0) delete rep; rep = nil_rep (); @@ -99,7 +99,7 @@ void Array<T>::clear (const dim_vector& dv) { - if (--rep->count <= 0) + if (--rep->count == 0) delete rep; rep = new ArrayRep (dv.safe_numel ()); @@ -1500,7 +1500,7 @@ Array<idx_vector> idx (dim_vector (a.ndims (), 1)); idx(0) = i; idx(1) = j; - for (int k = 0; k < a.ndims (); k++) + for (int k = 2; k < a.ndims (); k++) idx(k) = idx_vector (0, a.dimensions(k)); assign (idx, a); } @@ -2447,10 +2447,11 @@ octave_idx_type nnr = dv (0); octave_idx_type nnc = dv (1); - if (nnr == 0 || nnc == 0) - ; // do nothing + if (nnr == 0 && nnc == 0) + ; // do nothing for empty matrix else if (nnr != 1 && nnc != 1) { + // Extract diag from matrix if (k > 0) nnc -= k; else if (k < 0) @@ -2482,8 +2483,9 @@ (*current_liboctave_error_handler) ("diag: requested diagonal out of range"); } - else if (nnr != 0 && nnc != 0) + else { + // Create diag matrix from vector octave_idx_type roff = 0; octave_idx_type coff = 0; if (k > 0)
--- a/liboctave/Array.h +++ b/liboctave/Array.h @@ -110,8 +110,12 @@ { if (rep->count > 1) { - --rep->count; - rep = new ArrayRep (slice_data, slice_len); + ArrayRep *r = new ArrayRep (slice_data, slice_len); + + if (--rep->count == 0) + delete rep; + + rep = r; slice_data = rep->data; } } @@ -152,10 +156,12 @@ typename Array<T>::ArrayRep *nil_rep (void) const { - static typename Array<T>::ArrayRep *nr - = new typename Array<T>::ArrayRep (); + // NR was originally allocated with new, but that does not seem + // to be necessary since it will never be deleted. So just use + // a static object instead. - return nr; + static typename Array<T>::ArrayRep nr; + return &nr; } public: @@ -225,7 +231,7 @@ ~Array (void) { - if (--rep->count <= 0) + if (--rep->count == 0) delete rep; } @@ -233,7 +239,7 @@ { if (this != &a) { - if (--rep->count <= 0) + if (--rep->count == 0) delete rep; rep = a.rep;
--- a/liboctave/CColVector.cc +++ b/liboctave/CColVector.cc @@ -242,7 +242,7 @@ ComplexColumnVector conj (const ComplexColumnVector& a) { - return do_mx_unary_map<Complex, Complex, std::conj> (a); + return do_mx_unary_map<Complex, Complex, std::conj<double> > (a); } // resize is the destructive equivalent for this one
--- a/liboctave/CMatrix.cc +++ b/liboctave/CMatrix.cc @@ -921,7 +921,7 @@ ComplexMatrix conj (const ComplexMatrix& a) { - return do_mx_unary_map<Complex, Complex, std::conj> (a); + return do_mx_unary_map<Complex, Complex, std::conj<double> > (a); } // resize is the destructive equivalent for this one @@ -1571,6 +1571,9 @@ { ComplexDET retval (1.0); + info = 0; + rcon = 0.0; + octave_idx_type nr = rows (); octave_idx_type nc = cols (); @@ -1599,7 +1602,6 @@ ComplexMatrix atmp = *this; Complex *tmp_data = atmp.fortran_vec (); - info = 0; double anorm = 0; if (calc_cond) anorm = xnorm (*this, 1); @@ -3795,7 +3797,7 @@ octave_idx_type lda = a.rows (), tda = a.cols (); octave_idx_type ldb = b.rows (), tdb = b.cols (); - retval = ComplexMatrix (a_nr, b_nc); + retval = ComplexMatrix (a_nr, b_nc, 0.0); Complex *c = retval.fortran_vec (); if (b_nc == 1 && a_nr == 1)
--- a/liboctave/CNDArray.cc +++ b/liboctave/CNDArray.cc @@ -760,7 +760,7 @@ ComplexNDArray conj (const ComplexNDArray& a) { - return do_mx_unary_map<Complex, Complex, std::conj> (a); + return do_mx_unary_map<Complex, Complex, std::conj<double> > (a); } ComplexNDArray&
--- a/liboctave/CRowVector.cc +++ b/liboctave/CRowVector.cc @@ -234,7 +234,7 @@ ComplexRowVector conj (const ComplexRowVector& a) { - return do_mx_unary_map<Complex, Complex, std::conj> (a); + return do_mx_unary_map<Complex, Complex, std::conj<double> > (a); } // resize is the destructive equivalent for this one
--- a/liboctave/CRowVector.h +++ b/liboctave/CRowVector.h @@ -125,9 +125,9 @@ // row vector by column vector -> scalar -Complex operator * (const ComplexRowVector& a, const ColumnVector& b); +Complex OCTAVE_API operator * (const ComplexRowVector& a, const ColumnVector& b); -Complex operator * (const ComplexRowVector& a, const ComplexColumnVector& b); +Complex OCTAVE_API operator * (const ComplexRowVector& a, const ComplexColumnVector& b); // other operations
--- a/liboctave/CSparse.cc +++ b/liboctave/CSparse.cc @@ -579,7 +579,7 @@ SparseComplexMatrix::column (octave_idx_type i) const { octave_idx_type nr = rows (); - ComplexColumnVector retval (nr); + ComplexColumnVector retval (nr, 0); for (octave_idx_type k = cidx (i); k < cidx (i+1); k++) retval(ridx (k)) = data (k);
--- a/liboctave/DASPK-opts.in +++ b/liboctave/DASPK-opts.in @@ -1,17 +1,17 @@ # Copyright (C) 2002-2011 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/>. @@ -262,7 +262,7 @@ A vector of the same length as the state specifying the type of inequality constraint. Each element of the vector corresponds to an element of the state and should be assigned one of the following -codes +codes @table @asis @item -2
--- a/liboctave/DASRT-opts.in +++ b/liboctave/DASRT-opts.in @@ -1,17 +1,17 @@ # Copyright (C) 2002-2011 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/>.
--- a/liboctave/DASSL-opts.in +++ b/liboctave/DASSL-opts.in @@ -1,17 +1,17 @@ # Copyright (C) 2002-2011 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/>.
--- a/liboctave/DiagArray2.h +++ b/liboctave/DiagArray2.h @@ -43,7 +43,7 @@ public: - using Array<T>::element_type; + using typename Array<T>::element_type; DiagArray2 (void) : Array<T> (), d1 (0), d2 (0) { }
--- a/liboctave/LSODE-opts.in +++ b/liboctave/LSODE-opts.in @@ -1,17 +1,17 @@ # Copyright (C) 2002-2011 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/>.
--- a/liboctave/LSODE.cc +++ b/liboctave/LSODE.cc @@ -292,7 +292,7 @@ case -2: // excess accuracy requested (tolerances too small). case -3: // invalid input detected (see printed message). case -4: // repeated error test failures (check all inputs). - case -5: // repeated convergence failures (perhaps bad jacobian + case -5: // repeated convergence failures (perhaps bad Jacobian // supplied or wrong choice of mf or tolerances). case -6: // error weight became zero during problem. (solution // component i vanished, and atol or atol(i) = 0.) @@ -349,13 +349,13 @@ case -4: retval = std::string ("repeated error test failures (t = ") - + t_curr + "check all inputs)"; + + t_curr + "; check all inputs)"; break; case -5: retval = std::string ("repeated convergence failures (t = ") + t_curr - + "perhaps bad jacobian supplied or wrong choice of integration method or tolerances)"; + + "; perhaps bad Jacobian supplied or wrong choice of integration method or tolerances)"; break; case -6:
--- a/liboctave/MArray-i.cc +++ b/liboctave/MArray-i.cc @@ -34,6 +34,13 @@ template class OCTAVE_API MArray<int>; template class OCTAVE_API MArray<long>; +// Explicit instantiation, as this seems to be required by weird compilers +// like MSVC. This should be harmless on other compilers. +template int xmin<int> (int, int); +template int xmax<int> (int, int); +template long xmin<long> (long, long); +template long xmax<long> (long, long); + INSTANTIATE_MARRAY_FRIENDS (int, OCTAVE_API) INSTANTIATE_MARRAY_FRIENDS (long, OCTAVE_API)
--- a/liboctave/MArray-s.cc +++ b/liboctave/MArray-s.cc @@ -31,6 +31,11 @@ template class OCTAVE_API MArray<short>; +// Explicit instantiation, as this seems to be required by weird compilers +// like MSVC. This should be harmless on other compilers. +template short xmin<short> (short, short); +template short xmax<short> (short, short); + INSTANTIATE_MARRAY_FRIENDS (short, OCTAVE_API) #include "MDiagArray2.h"
--- a/liboctave/MArray.cc +++ b/liboctave/MArray.cc @@ -264,7 +264,7 @@ if (a.is_shared ()) a = a + b; else - do_mm_inplace_op<T, T> (a, b, mx_inline_add2, "+="); + do_mm_inplace_op<T, T> (a, b, mx_inline_add2, mx_inline_add2, "+="); return a; } @@ -275,7 +275,7 @@ if (a.is_shared ()) a = a - b; else - do_mm_inplace_op<T, T> (a, b, mx_inline_sub2, "-="); + do_mm_inplace_op<T, T> (a, b, mx_inline_sub2, mx_inline_sub2, "-="); return a; } @@ -287,7 +287,7 @@ if (a.is_shared ()) return a = product (a, b); else - do_mm_inplace_op<T, T> (a, b, mx_inline_mul2, ".*="); + do_mm_inplace_op<T, T> (a, b, mx_inline_mul2, mx_inline_mul2, ".*="); return a; } @@ -298,7 +298,7 @@ if (a.is_shared ()) return a = quotient (a, b); else - do_mm_inplace_op<T, T> (a, b, mx_inline_div2, "./="); + do_mm_inplace_op<T, T> (a, b, mx_inline_div2, mx_inline_div2, "./="); return a; } @@ -339,7 +339,7 @@ MArray<T> \ FCN (const MArray<T>& a, const MArray<T>& b) \ { \ - return do_mm_binary_op<T, T, T> (a, b, FN, #FCN); \ + return do_mm_binary_op<T, T, T> (a, b, FN, FN, FN, #FCN); \ } MARRAY_NDND_OP (operator +, +, mx_inline_add)
--- a/liboctave/MDiagArray2.cc +++ b/liboctave/MDiagArray2.cc @@ -82,7 +82,7 @@ { \ if (a.d1 != b.d1 || a.d2 != b.d2) \ gripe_nonconformant (#FCN, a.d1, a.d2, b.d1, b.d2); \ - return MDiagArray2<T> (do_mm_binary_op<T, T, T> (a, b, FN, #FCN), a.d1, a.d2); \ + return MDiagArray2<T> (do_mm_binary_op<T, T, T> (a, b, FN, FN, FN, #FCN), a.d1, a.d2); \ } MARRAY_DADA_OP (operator +, +, mx_inline_add)
--- a/liboctave/MSparse.cc +++ b/liboctave/MSparse.cc @@ -25,6 +25,8 @@ #include <config.h> #endif +#include <functional> + #include "quit.h" #include "lo-error.h" #include "MArray.h" @@ -37,9 +39,9 @@ // Element by element MSparse by MSparse ops. -template <class T> +template <class T, class OP> MSparse<T>& -operator += (MSparse<T>& a, const MSparse<T>& b) +plus_or_minus (MSparse<T>& a, const MSparse<T>& b, OP op, const char* op_name) { MSparse<T> r; @@ -50,80 +52,7 @@ octave_idx_type b_nc = b.cols (); if (a_nr != b_nr || a_nc != b_nc) - gripe_nonconformant ("operator +=" , a_nr, a_nc, b_nr, b_nc); - else - { - r = MSparse<T> (a_nr, a_nc, (a.nnz () + b.nnz ())); - - octave_idx_type jx = 0; - for (octave_idx_type i = 0 ; i < a_nc ; i++) - { - octave_idx_type ja = a.cidx(i); - octave_idx_type ja_max = a.cidx(i+1); - bool ja_lt_max= ja < ja_max; - - octave_idx_type jb = b.cidx(i); - octave_idx_type jb_max = b.cidx(i+1); - bool jb_lt_max = jb < jb_max; - - while (ja_lt_max || jb_lt_max ) - { - octave_quit (); - if ((! jb_lt_max) || - (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) - { - r.ridx(jx) = a.ridx(ja); - r.data(jx) = a.data(ja) + 0.; - jx++; - ja++; - ja_lt_max= ja < ja_max; - } - else if (( !ja_lt_max ) || - (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) - { - r.ridx(jx) = b.ridx(jb); - r.data(jx) = 0. + b.data(jb); - jx++; - jb++; - jb_lt_max= jb < jb_max; - } - else - { - if ((a.data(ja) + b.data(jb)) != 0.) - { - r.data(jx) = a.data(ja) + b.data(jb); - r.ridx(jx) = a.ridx(ja); - jx++; - } - ja++; - ja_lt_max= ja < ja_max; - jb++; - jb_lt_max= jb < jb_max; - } - } - r.cidx(i+1) = jx; - } - - a = r.maybe_compress (); - } - - return a; -} - -template <class T> -MSparse<T>& -operator -= (MSparse<T>& a, const MSparse<T>& b) -{ - MSparse<T> r; - - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - if (a_nr != b_nr || a_nc != b_nc) - gripe_nonconformant ("operator -=" , a_nr, a_nc, b_nr, b_nc); + gripe_nonconformant (op_name , a_nr, a_nc, b_nr, b_nc); else { r = MSparse<T> (a_nr, a_nc, (a.nnz () + b.nnz ())); @@ -146,7 +75,7 @@ (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) { r.ridx(jx) = a.ridx(ja); - r.data(jx) = a.data(ja) - 0.; + r.data(jx) = op (a.data(ja), 0.); jx++; ja++; ja_lt_max= ja < ja_max; @@ -155,16 +84,16 @@ (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) { r.ridx(jx) = b.ridx(jb); - r.data(jx) = 0. - b.data(jb); + r.data(jx) = op (0., b.data(jb)); jx++; jb++; jb_lt_max= jb < jb_max; } else { - if ((a.data(ja) - b.data(jb)) != 0.) + if (op (a.data(ja), b.data(jb)) != 0.) { - r.data(jx) = a.data(ja) - b.data(jb); + r.data(jx) = op (a.data(ja), b.data(jb)); r.ridx(jx) = a.ridx(ja); jx++; } @@ -183,435 +112,506 @@ return a; } +template <typename T> +MSparse<T>& +operator += (MSparse<T>& a, const MSparse<T>& b) +{ + return plus_or_minus (a, b, std::plus<T> (), "operator +="); +} + +template <typename T> +MSparse<T>& +operator -= (MSparse<T>& a, const MSparse<T>& b) +{ + return plus_or_minus (a, b, std::minus<T> (), "operator -="); +} + + // Element by element MSparse by scalar ops. -#define SPARSE_A2S_OP_1(OP) \ - template <class T> \ - MArray<T> \ - operator OP (const MSparse<T>& a, const T& s) \ - { \ - octave_idx_type nr = a.rows (); \ - octave_idx_type nc = a.cols (); \ - \ - MArray<T> r (dim_vector (nr, nc), (0.0 OP s)); \ - \ - for (octave_idx_type j = 0; j < nc; j++) \ - for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) \ - r.elem (a.ridx (i), j) = a.data (i) OP s; \ - return r; \ - } +template <class T, class OP> +MArray<T> +plus_or_minus (const MSparse<T>& a, const T& s, OP op) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + MArray<T> r (dim_vector (nr, nc), op (0.0, s)); -#define SPARSE_A2S_OP_2(OP) \ - template <class T> \ - MSparse<T> \ - operator OP (const MSparse<T>& a, const T& s) \ - { \ - octave_idx_type nr = a.rows (); \ - octave_idx_type nc = a.cols (); \ - octave_idx_type nz = a.nnz (); \ - \ - MSparse<T> r (nr, nc, nz); \ - \ - for (octave_idx_type i = 0; i < nz; i++) \ - { \ - r.data(i) = a.data(i) OP s; \ - r.ridx(i) = a.ridx(i); \ - } \ - for (octave_idx_type i = 0; i < nc + 1; i++) \ - r.cidx(i) = a.cidx(i); \ - r.maybe_compress (true); \ - return r; \ - } + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) + r.elem (a.ridx (i), j) = op (a.data (i), s); + return r; +} + +template <typename T> +MArray<T> +operator + (const MSparse<T>& a, const T& s) +{ + return plus_or_minus (a, s, std::plus<T> ()); +} + +template <typename T> +MArray<T> +operator - (const MSparse<T>& a, const T& s) +{ + return plus_or_minus (a, s, std::minus<T> ()); +} -SPARSE_A2S_OP_1 (+) -SPARSE_A2S_OP_1 (-) -SPARSE_A2S_OP_2 (*) -SPARSE_A2S_OP_2 (/) +template <class T, class OP> +MSparse<T> +times_or_divide (const MSparse<T>& a, const T& s, OP op) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + octave_idx_type nz = a.nnz (); + + MSparse<T> r (nr, nc, nz); + + for (octave_idx_type i = 0; i < nz; i++) + { + r.data(i) = op (a.data(i), s); + r.ridx(i) = a.ridx(i); + } + for (octave_idx_type i = 0; i < nc + 1; i++) + r.cidx(i) = a.cidx(i); + r.maybe_compress (true); + return r; +} + +template <typename T> +MSparse<T> +operator * (const MSparse<T>& a, const T& s) +{ + return times_or_divide (a, s, std::multiplies<T> ()); +} + +template <typename T> +MSparse<T> +operator / (const MSparse<T>& a, const T& s) +{ + return times_or_divide (a, s, std::divides<T> ()); +} + // Element by element scalar by MSparse ops. -#define SPARSE_SA2_OP_1(OP) \ - template <class T> \ - MArray<T> \ - operator OP (const T& s, const MSparse<T>& a) \ - { \ - octave_idx_type nr = a.rows (); \ - octave_idx_type nc = a.cols (); \ - \ - MArray<T> r (dim_vector (nr, nc), (s OP 0.0)); \ - \ - for (octave_idx_type j = 0; j < nc; j++) \ - for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) \ - r.elem (a.ridx (i), j) = s OP a.data (i); \ - return r; \ - } +template <class T, class OP> +MArray<T> +plus_or_minus (const T& s, const MSparse<T>& a, OP op) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + MArray<T> r (dim_vector (nr, nc), op (s, 0.0)); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) + r.elem (a.ridx (i), j) = op (s, a.data (i)); + return r; +} + +template <typename T> +MArray<T> +operator + (const T& s, const MSparse<T>& a) +{ + return plus_or_minus (s, a, std::plus<T> ()); +} + +template <typename T> +MArray<T> +operator - (const T& s, const MSparse<T>& a) +{ + return plus_or_minus (s, a, std::minus<T> ()); +} -#define SPARSE_SA2_OP_2(OP) \ - template <class T> \ - MSparse<T> \ - operator OP (const T& s, const MSparse<T>& a) \ - { \ - octave_idx_type nr = a.rows (); \ - octave_idx_type nc = a.cols (); \ - octave_idx_type nz = a.nnz (); \ - \ - MSparse<T> r (nr, nc, nz); \ - \ - for (octave_idx_type i = 0; i < nz; i++) \ - { \ - r.data(i) = s OP a.data(i); \ - r.ridx(i) = a.ridx(i); \ - } \ - for (octave_idx_type i = 0; i < nc + 1; i++) \ - r.cidx(i) = a.cidx(i); \ - r.maybe_compress (true); \ - return r; \ - } +template <class T, class OP> +MSparse<T> +times_or_divides (const T& s, const MSparse<T>& a, OP op) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + octave_idx_type nz = a.nnz (); + + MSparse<T> r (nr, nc, nz); -SPARSE_SA2_OP_1 (+) -SPARSE_SA2_OP_1 (-) -SPARSE_SA2_OP_2 (*) -SPARSE_SA2_OP_2 (/) + for (octave_idx_type i = 0; i < nz; i++) + { + r.data(i) = op (s, a.data(i)); + r.ridx(i) = a.ridx(i); + } + for (octave_idx_type i = 0; i < nc + 1; i++) + r.cidx(i) = a.cidx(i); + r.maybe_compress (true); + return r; +} + +template <class T> +MSparse<T> +operator * (const T& s, const MSparse<T>& a) +{ + return times_or_divides (s, a, std::multiplies<T> ()); +} + +template <class T> +MSparse<T> +operator / (const T& s, const MSparse<T>& a) +{ + return times_or_divides (s, a, std::divides<T> ()); +} + // Element by element MSparse by MSparse ops. -#define SPARSE_A2A2_OP(OP) \ - template <class T> \ - MSparse<T> \ - operator OP (const MSparse<T>& a, const MSparse<T>& b) \ - { \ - MSparse<T> r; \ - \ - octave_idx_type a_nr = a.rows (); \ - octave_idx_type a_nc = a.cols (); \ - \ - octave_idx_type b_nr = b.rows (); \ - octave_idx_type b_nc = b.cols (); \ - \ - if (a_nr == 1 && a_nc == 1) \ - { \ - if (a.elem(0,0) == 0.) \ - r = OP MSparse<T> (b); \ - else \ - { \ - r = MSparse<T> (b_nr, b_nc, a.data(0) OP 0.); \ - \ - for (octave_idx_type j = 0 ; j < b_nc ; j++) \ - { \ - octave_quit (); \ - octave_idx_type idxj = j * b_nr; \ - for (octave_idx_type i = b.cidx(j) ; i < b.cidx(j+1) ; i++) \ - { \ - octave_quit (); \ - r.data(idxj + b.ridx(i)) = a.data(0) OP b.data(i); \ - } \ - } \ - r.maybe_compress (); \ - } \ - } \ - else if (b_nr == 1 && b_nc == 1) \ - { \ - if (b.elem(0,0) == 0.) \ - r = MSparse<T> (a); \ - else \ - { \ - r = MSparse<T> (a_nr, a_nc, 0. OP b.data(0)); \ - \ - for (octave_idx_type j = 0 ; j < a_nc ; j++) \ - { \ - octave_quit (); \ - octave_idx_type idxj = j * a_nr; \ - for (octave_idx_type i = a.cidx(j) ; i < a.cidx(j+1) ; i++) \ - { \ - octave_quit (); \ - r.data(idxj + a.ridx(i)) = a.data(i) OP b.data(0); \ - } \ - } \ - r.maybe_compress (); \ - } \ - } \ - else if (a_nr != b_nr || a_nc != b_nc) \ - gripe_nonconformant ("operator " # OP, a_nr, a_nc, b_nr, b_nc); \ - else \ - { \ - r = MSparse<T> (a_nr, a_nc, (a.nnz () + b.nnz ())); \ - \ - octave_idx_type jx = 0; \ - r.cidx (0) = 0; \ - for (octave_idx_type i = 0 ; i < a_nc ; i++) \ - { \ - octave_idx_type ja = a.cidx(i); \ - octave_idx_type ja_max = a.cidx(i+1); \ - bool ja_lt_max= ja < ja_max; \ - \ - octave_idx_type jb = b.cidx(i); \ - octave_idx_type jb_max = b.cidx(i+1); \ - bool jb_lt_max = jb < jb_max; \ - \ - while (ja_lt_max || jb_lt_max ) \ - { \ - octave_quit (); \ - if ((! jb_lt_max) || \ - (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) \ - { \ - r.ridx(jx) = a.ridx(ja); \ - r.data(jx) = a.data(ja) OP 0.; \ - jx++; \ - ja++; \ - ja_lt_max= ja < ja_max; \ - } \ - else if (( !ja_lt_max ) || \ - (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) \ - { \ - r.ridx(jx) = b.ridx(jb); \ - r.data(jx) = 0. OP b.data(jb); \ - jx++; \ - jb++; \ - jb_lt_max= jb < jb_max; \ - } \ - else \ - { \ - if ((a.data(ja) OP b.data(jb)) != 0.) \ - { \ - r.data(jx) = a.data(ja) OP b.data(jb); \ - r.ridx(jx) = a.ridx(ja); \ - jx++; \ - } \ - ja++; \ - ja_lt_max= ja < ja_max; \ - jb++; \ - jb_lt_max= jb < jb_max; \ - } \ - } \ - r.cidx(i+1) = jx; \ - } \ - \ - r.maybe_compress (); \ - } \ - \ - return r; \ - } +template <class T, class OP> +MSparse<T> +plus_or_minus (const MSparse<T>& a, const MSparse<T>& b, OP op, + const char* op_name, bool negate) +{ + MSparse<T> r; + + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (a_nr == 1 && a_nc == 1) + { + if (a.elem(0,0) == 0.) + if (negate) + r = -MSparse<T> (b); + else + r = MSparse<T> (b); + else + { + r = MSparse<T> (b_nr, b_nc, op (a.data(0), 0.)); + + for (octave_idx_type j = 0 ; j < b_nc ; j++) + { + octave_quit (); + octave_idx_type idxj = j * b_nr; + for (octave_idx_type i = b.cidx(j) ; i < b.cidx(j+1) ; i++) + { + octave_quit (); + r.data(idxj + b.ridx(i)) = op (a.data(0), b.data(i)); + } + } + r.maybe_compress (); + } + } + else if (b_nr == 1 && b_nc == 1) + { + if (b.elem(0,0) == 0.) + r = MSparse<T> (a); + else + { + r = MSparse<T> (a_nr, a_nc, op (0.0, b.data(0))); + + for (octave_idx_type j = 0 ; j < a_nc ; j++) + { + octave_quit (); + octave_idx_type idxj = j * a_nr; + for (octave_idx_type i = a.cidx(j) ; i < a.cidx(j+1) ; i++) + { + octave_quit (); + r.data(idxj + a.ridx(i)) = op (a.data(i), b.data(0)); + } + } + r.maybe_compress (); + } + } + else if (a_nr != b_nr || a_nc != b_nc) + gripe_nonconformant (op_name, a_nr, a_nc, b_nr, b_nc); + else + { + r = MSparse<T> (a_nr, a_nc, (a.nnz () + b.nnz ())); + + octave_idx_type jx = 0; + r.cidx (0) = 0; + for (octave_idx_type i = 0 ; i < a_nc ; i++) + { + octave_idx_type ja = a.cidx(i); + octave_idx_type ja_max = a.cidx(i+1); + bool ja_lt_max= ja < ja_max; + + octave_idx_type jb = b.cidx(i); + octave_idx_type jb_max = b.cidx(i+1); + bool jb_lt_max = jb < jb_max; + + while (ja_lt_max || jb_lt_max ) + { + octave_quit (); + if ((! jb_lt_max) || + (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) + { + r.ridx(jx) = a.ridx(ja); + r.data(jx) = op (a.data(ja), 0.); + jx++; + ja++; + ja_lt_max= ja < ja_max; + } + else if (( !ja_lt_max ) || + (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) + { + r.ridx(jx) = b.ridx(jb); + r.data(jx) = op (0., b.data(jb)); + jx++; + jb++; + jb_lt_max= jb < jb_max; + } + else + { + if (op (a.data(ja), b.data(jb)) != 0.) + { + r.data(jx) = op (a.data(ja), b.data(jb)); + r.ridx(jx) = a.ridx(ja); + jx++; + } + ja++; + ja_lt_max= ja < ja_max; + jb++; + jb_lt_max= jb < jb_max; + } + } + r.cidx(i+1) = jx; + } + + r.maybe_compress (); + } + + return r; +} + +template <class T> +MSparse<T> +operator+ (const MSparse<T>& a, const MSparse<T>& b) +{ + return plus_or_minus (a, b, std::plus<T> (), "operator +", false); +} + +template <class T> +MSparse<T> +operator- (const MSparse<T>& a, const MSparse<T>& b) +{ + return plus_or_minus (a, b, std::minus<T> (), "operator -", true); +} + +template <class T> +MSparse<T> +product (const MSparse<T>& a, const MSparse<T>& b) +{ + MSparse<T> r; + + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (a_nr == 1 && a_nc == 1) + { + if (a.elem(0,0) == 0.) + r = MSparse<T> (b_nr, b_nc); + else + { + r = MSparse<T> (b); + octave_idx_type b_nnz = b.nnz(); + + for (octave_idx_type i = 0 ; i < b_nnz ; i++) + { + octave_quit (); + r.data (i) = a.data(0) * r.data(i); + } + r.maybe_compress (); + } + } + else if (b_nr == 1 && b_nc == 1) + { + if (b.elem(0,0) == 0.) + r = MSparse<T> (a_nr, a_nc); + else + { + r = MSparse<T> (a); + octave_idx_type a_nnz = a.nnz(); -#define SPARSE_A2A2_FCN_1(FCN, OP) \ - template <class T> \ - MSparse<T> \ - FCN (const MSparse<T>& a, const MSparse<T>& b) \ - { \ - MSparse<T> r; \ - \ - octave_idx_type a_nr = a.rows (); \ - octave_idx_type a_nc = a.cols (); \ - \ - octave_idx_type b_nr = b.rows (); \ - octave_idx_type b_nc = b.cols (); \ - \ - if (a_nr == 1 && a_nc == 1) \ - { \ - if (a.elem(0,0) == 0.) \ - r = MSparse<T> (b_nr, b_nc); \ - else \ - { \ - r = MSparse<T> (b); \ - octave_idx_type b_nnz = b.nnz(); \ - \ - for (octave_idx_type i = 0 ; i < b_nnz ; i++) \ - { \ - octave_quit (); \ - r.data (i) = a.data(0) OP r.data(i); \ - } \ - r.maybe_compress (); \ - } \ - } \ - else if (b_nr == 1 && b_nc == 1) \ - { \ - if (b.elem(0,0) == 0.) \ - r = MSparse<T> (a_nr, a_nc); \ - else \ - { \ - r = MSparse<T> (a); \ - octave_idx_type a_nnz = a.nnz(); \ - \ - for (octave_idx_type i = 0 ; i < a_nnz ; i++) \ - { \ - octave_quit (); \ - r.data (i) = r.data(i) OP b.data(0); \ - } \ - r.maybe_compress (); \ - } \ - } \ - else if (a_nr != b_nr || a_nc != b_nc) \ - gripe_nonconformant (#FCN, a_nr, a_nc, b_nr, b_nc); \ - else \ - { \ - r = MSparse<T> (a_nr, a_nc, (a.nnz () > b.nnz () ? a.nnz () : b.nnz ())); \ - \ - octave_idx_type jx = 0; \ - r.cidx (0) = 0; \ - for (octave_idx_type i = 0 ; i < a_nc ; i++) \ - { \ - octave_idx_type ja = a.cidx(i); \ - octave_idx_type ja_max = a.cidx(i+1); \ - bool ja_lt_max= ja < ja_max; \ - \ - octave_idx_type jb = b.cidx(i); \ - octave_idx_type jb_max = b.cidx(i+1); \ - bool jb_lt_max = jb < jb_max; \ - \ - while (ja_lt_max || jb_lt_max ) \ - { \ - octave_quit (); \ - if ((! jb_lt_max) || \ - (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) \ - { \ - ja++; ja_lt_max= ja < ja_max; \ - } \ - else if (( !ja_lt_max ) || \ - (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) \ - { \ - jb++; jb_lt_max= jb < jb_max; \ - } \ - else \ - { \ - if ((a.data(ja) OP b.data(jb)) != 0.) \ - { \ - r.data(jx) = a.data(ja) OP b.data(jb); \ - r.ridx(jx) = a.ridx(ja); \ - jx++; \ - } \ - ja++; ja_lt_max= ja < ja_max; \ - jb++; jb_lt_max= jb < jb_max; \ - } \ - } \ - r.cidx(i+1) = jx; \ - } \ - \ - r.maybe_compress (); \ - } \ - \ - return r; \ - } + for (octave_idx_type i = 0 ; i < a_nnz ; i++) + { + octave_quit (); + r.data (i) = r.data(i) * b.data(0); + } + r.maybe_compress (); + } + } + else if (a_nr != b_nr || a_nc != b_nc) + gripe_nonconformant ("product", a_nr, a_nc, b_nr, b_nc); + else + { + r = MSparse<T> (a_nr, a_nc, (a.nnz () > b.nnz () ? a.nnz () : b.nnz ())); + + octave_idx_type jx = 0; + r.cidx (0) = 0; + for (octave_idx_type i = 0 ; i < a_nc ; i++) + { + octave_idx_type ja = a.cidx(i); + octave_idx_type ja_max = a.cidx(i+1); + bool ja_lt_max= ja < ja_max; + + octave_idx_type jb = b.cidx(i); + octave_idx_type jb_max = b.cidx(i+1); + bool jb_lt_max = jb < jb_max; + + while (ja_lt_max || jb_lt_max ) + { + octave_quit (); + if ((! jb_lt_max) || + (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) + { + ja++; ja_lt_max= ja < ja_max; + } + else if (( !ja_lt_max ) || + (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) + { + jb++; jb_lt_max= jb < jb_max; + } + else + { + if ((a.data(ja) * b.data(jb)) != 0.) + { + r.data(jx) = a.data(ja) * b.data(jb); + r.ridx(jx) = a.ridx(ja); + jx++; + } + ja++; ja_lt_max= ja < ja_max; + jb++; jb_lt_max= jb < jb_max; + } + } + r.cidx(i+1) = jx; + } + + r.maybe_compress (); + } + + return r; +} + +template <class T> +MSparse<T> +quotient (const MSparse<T>& a, const MSparse<T>& b) +{ + MSparse<T> r; + T Zero = T (); + + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); -#define SPARSE_A2A2_FCN_2(FCN, OP) \ - template <class T> \ - MSparse<T> \ - FCN (const MSparse<T>& a, const MSparse<T>& b) \ - { \ - MSparse<T> r; \ - T Zero = T (); \ - \ - octave_idx_type a_nr = a.rows (); \ - octave_idx_type a_nc = a.cols (); \ - \ - octave_idx_type b_nr = b.rows (); \ - octave_idx_type b_nc = b.cols (); \ - \ - if (a_nr == 1 && a_nc == 1) \ - { \ - T val = a.elem (0,0); \ - T fill = val OP T(); \ - if (fill == T()) \ - { \ - octave_idx_type b_nnz = b.nnz(); \ - r = MSparse<T> (b); \ - for (octave_idx_type i = 0 ; i < b_nnz ; i++) \ - r.data (i) = val OP r.data(i); \ - r.maybe_compress (); \ - } \ - else \ - { \ - r = MSparse<T> (b_nr, b_nc, fill); \ - for (octave_idx_type j = 0 ; j < b_nc ; j++) \ - { \ - octave_quit (); \ - octave_idx_type idxj = j * b_nr; \ - for (octave_idx_type i = b.cidx(j) ; i < b.cidx(j+1) ; i++) \ - { \ - octave_quit (); \ - r.data(idxj + b.ridx(i)) = val OP b.data(i); \ - } \ - } \ - r.maybe_compress (); \ - } \ - } \ - else if (b_nr == 1 && b_nc == 1) \ - { \ - T val = b.elem (0,0); \ - T fill = T() OP val; \ - if (fill == T()) \ - { \ - octave_idx_type a_nnz = a.nnz(); \ - r = MSparse<T> (a); \ - for (octave_idx_type i = 0 ; i < a_nnz ; i++) \ - r.data (i) = r.data(i) OP val; \ - r.maybe_compress (); \ - } \ - else \ - { \ - r = MSparse<T> (a_nr, a_nc, fill); \ - for (octave_idx_type j = 0 ; j < a_nc ; j++) \ - { \ - octave_quit (); \ - octave_idx_type idxj = j * a_nr; \ - for (octave_idx_type i = a.cidx(j) ; i < a.cidx(j+1) ; i++) \ - { \ - octave_quit (); \ - r.data(idxj + a.ridx(i)) = a.data(i) OP val; \ - } \ - } \ - r.maybe_compress (); \ - } \ - } \ - else if (a_nr != b_nr || a_nc != b_nc) \ - gripe_nonconformant (#FCN, a_nr, a_nc, b_nr, b_nc); \ - else \ - { \ - r = MSparse<T>( a_nr, a_nc, (Zero OP Zero)); \ - \ - for (octave_idx_type i = 0 ; i < a_nc ; i++) \ - { \ - octave_idx_type ja = a.cidx(i); \ - octave_idx_type ja_max = a.cidx(i+1); \ - bool ja_lt_max= ja < ja_max; \ - \ - octave_idx_type jb = b.cidx(i); \ - octave_idx_type jb_max = b.cidx(i+1); \ - bool jb_lt_max = jb < jb_max; \ - \ - while (ja_lt_max || jb_lt_max ) \ - { \ - octave_quit (); \ - if ((! jb_lt_max) || \ - (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) \ - { \ - r.elem (a.ridx(ja),i) = a.data(ja) OP Zero; \ - ja++; ja_lt_max= ja < ja_max; \ - } \ - else if (( !ja_lt_max ) || \ - (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) \ - { \ - r.elem (b.ridx(jb),i) = Zero OP b.data(jb); \ - jb++; jb_lt_max= jb < jb_max; \ - } \ - else \ - { \ - r.elem (a.ridx(ja),i) = a.data(ja) OP b.data(jb); \ - ja++; ja_lt_max= ja < ja_max; \ - jb++; jb_lt_max= jb < jb_max; \ - } \ - } \ - } \ - \ - r.maybe_compress (true); \ - } \ - \ - return r; \ - } + if (a_nr == 1 && a_nc == 1) + { + T val = a.elem (0,0); + T fill = val / T(); + if (fill == T()) + { + octave_idx_type b_nnz = b.nnz(); + r = MSparse<T> (b); + for (octave_idx_type i = 0 ; i < b_nnz ; i++) + r.data (i) = val / r.data(i); + r.maybe_compress (); + } + else + { + r = MSparse<T> (b_nr, b_nc, fill); + for (octave_idx_type j = 0 ; j < b_nc ; j++) + { + octave_quit (); + octave_idx_type idxj = j * b_nr; + for (octave_idx_type i = b.cidx(j) ; i < b.cidx(j+1) ; i++) + { + octave_quit (); + r.data(idxj + b.ridx(i)) = val / b.data(i); + } + } + r.maybe_compress (); + } + } + else if (b_nr == 1 && b_nc == 1) + { + T val = b.elem (0,0); + T fill = T() / val; + if (fill == T()) + { + octave_idx_type a_nnz = a.nnz(); + r = MSparse<T> (a); + for (octave_idx_type i = 0 ; i < a_nnz ; i++) + r.data (i) = r.data(i) / val; + r.maybe_compress (); + } + else + { + r = MSparse<T> (a_nr, a_nc, fill); + for (octave_idx_type j = 0 ; j < a_nc ; j++) + { + octave_quit (); + octave_idx_type idxj = j * a_nr; + for (octave_idx_type i = a.cidx(j) ; i < a.cidx(j+1) ; i++) + { + octave_quit (); + r.data(idxj + a.ridx(i)) = a.data(i) / val; + } + } + r.maybe_compress (); + } + } + else if (a_nr != b_nr || a_nc != b_nc) + gripe_nonconformant ("quotient", a_nr, a_nc, b_nr, b_nc); + else + { + r = MSparse<T>( a_nr, a_nc, (Zero / Zero)); -SPARSE_A2A2_OP (+) -SPARSE_A2A2_OP (-) -SPARSE_A2A2_FCN_1 (product, *) -SPARSE_A2A2_FCN_2 (quotient, /) + for (octave_idx_type i = 0 ; i < a_nc ; i++) + { + octave_idx_type ja = a.cidx(i); + octave_idx_type ja_max = a.cidx(i+1); + bool ja_lt_max= ja < ja_max; + + octave_idx_type jb = b.cidx(i); + octave_idx_type jb_max = b.cidx(i+1); + bool jb_lt_max = jb < jb_max; + + while (ja_lt_max || jb_lt_max ) + { + octave_quit (); + if ((! jb_lt_max) || + (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) + { + r.elem (a.ridx(ja),i) = a.data(ja) / Zero; + ja++; ja_lt_max= ja < ja_max; + } + else if (( !ja_lt_max ) || + (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) + { + r.elem (b.ridx(jb),i) = Zero / b.data(jb); + jb++; jb_lt_max= jb < jb_max; + } + else + { + r.elem (a.ridx(ja),i) = a.data(ja) / b.data(jb); + ja++; ja_lt_max= ja < ja_max; + jb++; jb_lt_max= jb < jb_max; + } + } + } + + r.maybe_compress (true); + } + + return r; +} + + // Unary MSparse ops.
--- a/liboctave/MSparse.h +++ b/liboctave/MSparse.h @@ -65,6 +65,8 @@ explicit MSparse (octave_idx_type r, octave_idx_type c, T val) : Sparse<T> (r, c, val) { } + explicit MSparse (const PermMatrix& a) : Sparse<T>(a) { } + MSparse (octave_idx_type r, octave_idx_type c, octave_idx_type num_nz) : Sparse<T> (r, c, num_nz) { } ~MSparse (void) { }
--- a/liboctave/Makefile.am +++ b/liboctave/Makefile.am @@ -3,29 +3,28 @@ # Copyright (C) 1993-2011 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/>. -include $(top_srcdir)/common.mk +include $(top_srcdir)/build-aux/common.mk AM_CPPFLAGS = \ @CPPFLAGS@ -I../libgnu -I$(top_srcdir)/libgnu \ -I$(top_srcdir)/libcruft/misc EXTRA_DIST = \ - ChangeLog \ config-ops.sh \ mk-ops.awk \ mx-op-inc.mk \ @@ -188,7 +187,9 @@ Range.h \ base-dae.h \ base-de.h \ + base-list.h \ base-min.h \ + bsxfun.h \ byte-swap.h \ caseless-str.h \ cmd-edit.h \ @@ -243,7 +244,8 @@ randgamma.h \ randmtzig.h \ randpoisson.h \ - regex-match.h \ + regexp.h \ + singleton-cleanup.h \ sparse-sort.h \ sparse-util.h \ statdefs.h \ @@ -451,7 +453,8 @@ oct-time.cc \ oct-uname.cc \ pathsearch.cc \ - regex-match.cc \ + regexp.cc \ + singleton-cleanup.cc \ sparse-sort.cc \ sparse-util.cc \ str-vec.cc \ @@ -492,21 +495,6 @@ LIBOCT_READLINE_SOURCES = $(LIBOCT_READLINE_CXX_SOURCES) $(LIBOCT_READLINE_C_SOURCES) -LINK_DEPS = \ - $(RLD_FLAG) \ - ../libcruft/libcruft.la \ - ../libcruft/libranlib.la \ - ../libgnu/libgnu.la \ - $(SPARSE_XLIBS) \ - $(ARPACK_LIBS) \ - $(QRUPDATE_LIBS) \ - $(FFTW_XLIBS) \ - $(LAPACK_LIBS) $(BLAS_LIBS) \ - $(READLINE_LIBS) $(TERM_LIBS) \ - $(LIBGLOB) $(REGEX_LIBS) $(DL_LIBS) \ - $(FLIBS) \ - $(PTHREAD_LIBS) $(LIBS) - liboctave_la_SOURCES = \ $(LIBOCTAVE_CXX_SOURCES) \ $(LIBOCTAVE_C_SOURCES) \ @@ -517,7 +505,11 @@ nodist_liboctave_la_SOURCES = \ $(BUILT_LIBOCTAVE_CXX_SOURCES) -liboctave_la_LIBADD = $(LINK_DEPS) +include link-deps.mk + +liboctave_la_LIBADD = \ + ../libcruft/libcruft.la \ + $(LIBOCTAVE_LINK_DEPS) liboctave_la_CPPFLAGS = \ @OCTAVE_DLL_DEFS@ \ @@ -526,12 +518,19 @@ $(ARPACK_CPPFLAGS) \ $(AM_CPPFLAGS) -liboctave_la_LDFLAGS = -release $(version) $(NO_UNDEFINED_LDFLAG) \ +# Increment these as needed and according to the rules in the libtool +# manual: +liboctave_current = 0 +liboctave_revision = 0 +liboctave_age = 0 + +liboctave_version_info = $(liboctave_current):$(liboctave_revision):$(liboctave_age) + +liboctave_la_LDFLAGS = \ + -version-info $(liboctave_version_info) \ + $(NO_UNDEFINED_LDFLAG) \ -bindir $(bindir) \ - $(SPARSE_XLDFLAGS) \ - $(ARPACK_LDFLAGS) \ - $(QRUPDATE_LDFLAGS) \ - $(FFTW_XLDFLAGS) + $(LIBOCTAVE_LINK_OPTS) octinclude_HEADERS = \ $(INCS) \ @@ -542,9 +541,9 @@ nodist_octinclude_HEADERS = \ $(BUILT_INCS) -$(OPT_INC) : %.h : %.in $(top_srcdir)/mk-opts.pl +$(OPT_INC) : %.h : %.in $(top_srcdir)/build-aux/mk-opts.pl @echo making $@ from $< - @$(PERL) $(top_srcdir)/mk-opts.pl --opt-class-header $< > $@-t + @$(PERL) $(top_srcdir)/build-aux/mk-opts.pl --opt-class-header $< > $@-t mv $@-t $@ $(VX_OP_INC) $(VX_OP_SRC) : $(srcdir)/mk-ops.awk vx-ops
--- a/liboctave/MatrixType.cc +++ b/liboctave/MatrixType.cc @@ -456,11 +456,11 @@ ((typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) && nrows < ncols)) { - typ = MatrixType::Rectangular; if (typ == MatrixType::Permuted_Upper || typ == MatrixType::Permuted_Lower) delete [] perm; nperm = 0; + typ = MatrixType::Rectangular; } if (typ == MatrixType::Full && ncols != nrows) @@ -777,11 +777,11 @@ ((typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) && nrows < ncols)) { - typ = MatrixType::Rectangular; if (typ == MatrixType::Permuted_Upper || typ == MatrixType::Permuted_Lower) delete [] perm; nperm = 0; + typ = MatrixType::Rectangular; } if (typ == MatrixType::Full && ncols != nrows) @@ -921,14 +921,20 @@ lower_band = a.lower_band; dense = a.dense; full = a.full; - nperm = a.nperm; - if (nperm != 0) + if (nperm) { - perm = new octave_idx_type [nperm]; - for (octave_idx_type i = 0; i < nperm; i++) + delete[] perm; + } + + if (a.nperm != 0) + { + perm = new octave_idx_type [a.nperm]; + for (octave_idx_type i = 0; i < a.nperm; i++) perm[i] = a.perm[i]; } + + nperm = a.nperm; } return *this;
--- a/liboctave/Quad-opts.in +++ b/liboctave/Quad-opts.in @@ -1,17 +1,17 @@ # Copyright (C) 2002-2011 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/>. @@ -33,8 +33,8 @@ NAME = "relative tolerance" DOC_ITEM Non-negative relative tolerance. If the absolute tolerance is zero, -the relative tolerance must be greater than or equal to -@code{max (50*eps, 0.5e-28)}. +the relative tolerance must be greater than or equal to +@w{@code{max (50*eps, 0.5e-28)}}. END_DOC_ITEM TYPE = "double" @@ -45,7 +45,7 @@ OPTION NAME = "single precision absolute tolerance" DOC_ITEM -Absolute tolerance for single precision; may be zero for pure relative +Absolute tolerance for single precision; may be zero for pure relative error test. END_DOC_ITEM @@ -58,8 +58,8 @@ NAME = "single precision relative tolerance" DOC_ITEM Non-negative relative tolerance for single precision. If the absolute -tolerance is zero, the relative tolerance must be greater than or equal to -@code{max (50*eps, 0.5e-28)}. +tolerance is zero, the relative tolerance must be greater than or equal to +@w{@code{max (50*eps, 0.5e-28)}}. END_DOC_ITEM TYPE = "float" INIT_VALUE = "::sqrt (FLT_EPSILON)"
--- a/liboctave/Sparse-op-defs.h +++ b/liboctave/Sparse-op-defs.h @@ -1119,7 +1119,7 @@ gripe_nonconformant (#F, m1_nr, m1_nc, m2_nr, m2_nc); \ else \ { \ - if (do_mx_check (m1, mx_inline_all_finite)) \ + if (do_mx_check (m1, mx_inline_all_finite<M1::element_type>)) \ { \ /* Sparsity pattern is preserved. */ \ octave_idx_type m2_nz = m2.nnz (); \ @@ -1335,12 +1335,12 @@ } // sm .* m preserves sparsity if m contains no Infs nor Nans. -#define SPARSE_SMM_BIN_OP_2_CHECK_product \ - do_mx_check (m2, mx_inline_all_finite) +#define SPARSE_SMM_BIN_OP_2_CHECK_product(ET) \ + do_mx_check (m2, mx_inline_all_finite<ET>) // sm ./ m preserves sparsity if m contains no NaNs or zeros. -#define SPARSE_SMM_BIN_OP_2_CHECK_quotient \ - ! do_mx_check (m2, mx_inline_any_nan) && m2.nnz () == m2.numel () +#define SPARSE_SMM_BIN_OP_2_CHECK_quotient(ET) \ + ! do_mx_check (m2, mx_inline_any_nan<ET>) && m2.nnz () == m2.numel () #define SPARSE_SMM_BIN_OP_2(R, F, OP, M1, M2) \ R \ @@ -1360,7 +1360,7 @@ gripe_nonconformant (#F, m1_nr, m1_nc, m2_nr, m2_nc); \ else \ { \ - if (SPARSE_SMM_BIN_OP_2_CHECK_ ## F) \ + if (SPARSE_SMM_BIN_OP_2_CHECK_ ## F(M2::element_type)) \ { \ /* Sparsity pattern is preserved. */ \ octave_idx_type m1_nz = m1.nnz (); \
--- a/liboctave/Sparse-perm-op-defs.h +++ b/liboctave/Sparse-perm-op-defs.h @@ -42,14 +42,14 @@ for (octave_idx_type j = 0; j < nc; j++) { octave_quit (); - + OCTAVE_LOCAL_BUFFER (octave_idx_type, sidx, r.xcidx(j+1) - r.xcidx(j)); for (octave_idx_type i = r.xcidx(j), ii = 0; i < r.xcidx(j+1); i++) { sidx[ii++]=i; r.xridx (i) = pcol[a.ridx (i)]; } - sort.sort (r.xridx() + r.xcidx(j), sidx, r.xcidx(j+1) - r.xcidx(j)); + sort.sort (r.xridx() + r.xcidx(j), sidx, r.xcidx(j+1) - r.xcidx(j)); for (octave_idx_type i = r.xcidx(j), ii = 0; i < r.xcidx(j+1); i++) r.xdata(i) = a.data (sidx[ii++]); }
--- a/liboctave/Sparse.cc +++ b/liboctave/Sparse.cc @@ -50,6 +50,34 @@ #include "oct-spparms.h" #include "mx-inlines.cc" +#include "PermMatrix.h" + +template <class T> +Sparse<T>::Sparse (const PermMatrix& a) + : rep (new typename Sparse<T>::SparseRep (a.rows (), a.cols (), a.rows ())), + dimensions (dim_vector (a.rows (), a.cols())) +{ + octave_idx_type n = a.rows (); + for (octave_idx_type i = 0; i <= n; i++) + cidx (i) = i; + + const Array<octave_idx_type> pv = a.pvec (); + + if (a.is_row_perm ()) + { + for (octave_idx_type i = 0; i < n; i++) + ridx (pv (i)) = i; + } + else + { + for (octave_idx_type i = 0; i < n; i++) + ridx (i) = pv (i); + } + + for (octave_idx_type i = 0; i < n; i++) + data (i) = 1.0; +} + template <class T> T& Sparse<T>::SparseRep::elem (octave_idx_type _r, octave_idx_type _c) @@ -639,7 +667,7 @@ template <class T> Sparse<T>::~Sparse (void) { - if (--rep->count <= 0) + if (--rep->count == 0) delete rep; } @@ -649,7 +677,7 @@ { if (this != &a) { - if (--rep->count <= 0) + if (--rep->count == 0) delete rep; rep = a.rep; @@ -1458,9 +1486,6 @@ } else { - (*current_liboctave_warning_with_id_handler) - ("Octave:fortran-indexing", "single index used for sparse matrix"); - if (nr != 0 && idx.is_scalar ()) retval = Sparse<T> (1, 1, elem (idx(0) % nr, idx(0) / nr)); else @@ -1928,8 +1953,10 @@ if (new_nz > nz) { // Make room first. - std::copy_backward (data () + ui, data () + nz, data () + li + rnz); - std::copy_backward (ridx () + ui, ridx () + nz, ridx () + li + rnz); + std::copy (data () + ui, data () + nz, + data () + li + rnz); + std::copy (ridx () + ui, ridx () + nz, + ridx () + li + rnz); mx_inline_add2 (nc - ub, cidx () + ub + 1, new_nz - nz); }
--- a/liboctave/Sparse.h +++ b/liboctave/Sparse.h @@ -41,6 +41,7 @@ #include "oct-mem.h" class idx_vector; +class PermMatrix; // Two dimensional sparse class. Handles the reference counting for // all the derived classes. @@ -146,8 +147,12 @@ { if (rep->count > 1) { - --rep->count; - rep = new SparseRep (*rep); + SparseRep *r = new SparseRep (*rep); + + if (--rep->count == 0) + delete rep; + + rep = r; } } @@ -164,18 +169,17 @@ typename Sparse<T>::SparseRep *nil_rep (void) const { - static typename Sparse<T>::SparseRep *nr - = new typename Sparse<T>::SparseRep (); - - nr->count++; - - return nr; + static typename Sparse<T>::SparseRep nr; + return &nr; } public: Sparse (void) - : rep (nil_rep ()), dimensions (dim_vector(0,0)) { } + : rep (nil_rep ()), dimensions (dim_vector(0,0)) + { + rep->count++; + } explicit Sparse (octave_idx_type n) : rep (new typename Sparse<T>::SparseRep (n)), @@ -195,6 +199,10 @@ : rep (new typename Sparse<T>::SparseRep (nr, nc, nz)), dimensions (dim_vector (nr, nc)) { } + // Both SparseMatrix and SparseBoolMatrix need this ctor, and this + // is their only common ancestor. + explicit Sparse (const PermMatrix& a); + // Type conversion case. Preserves capacity (). template <class U> Sparse (const Sparse<U>& a)
--- a/liboctave/SparseCmplxQR.h +++ b/liboctave/SparseCmplxQR.h @@ -96,7 +96,7 @@ ~SparseComplexQR (void) { - if (--rep->count <= 0) + if (--rep->count == 0) delete rep; } @@ -104,7 +104,7 @@ { if (this != &a) { - if (--rep->count <= 0) + if (--rep->count == 0) delete rep; rep = a.rep;
--- a/liboctave/SparseQR.h +++ b/liboctave/SparseQR.h @@ -98,7 +98,7 @@ ~SparseQR (void) { - if (--rep->count <= 0) + if (--rep->count == 0) delete rep; } @@ -106,7 +106,7 @@ { if (this != &a) { - if (--rep->count <= 0) + if (--rep->count == 0) delete rep; rep = a.rep;
rename from src/base-list.h rename to liboctave/base-list.h --- a/src/base-list.h +++ b/liboctave/base-list.h @@ -36,7 +36,8 @@ bool empty (void) const { return lst.empty (); } - size_t length (void) const { return lst.size (); } + size_t size (void) const { return lst.size (); } + size_t length (void) const { return size (); } iterator erase (iterator pos) { return lst.erase (pos); } @@ -90,6 +91,8 @@ octave_base_list (void) : lst () { } + octave_base_list (const std::list<elt_type>& l) : lst (l) { } + octave_base_list (const octave_base_list& bl) : lst (bl.lst) { } octave_base_list& operator = (const octave_base_list& bl)
--- a/liboctave/base-lu.cc +++ b/liboctave/base-lu.cc @@ -173,14 +173,18 @@ bool base_lu<lu_type>::regular (void) const { + bool retval = true; + octave_idx_type k = std::min (a_fact.rows (), a_fact.columns ()); - bool retval = true; + for (octave_idx_type i = 0; i < k; i++) - if (a_fact(i, i) == lu_elt_type ()) - { - retval = false; - break; - } + { + if (a_fact(i, i) == lu_elt_type ()) + { + retval = false; + break; + } + } - return true; + return retval; }
--- a/liboctave/base-qr.cc +++ b/liboctave/base-qr.cc @@ -62,15 +62,19 @@ bool base_qr<qr_type>::regular (void) const { + bool retval = true; + octave_idx_type k = std::min (r.rows (), r.columns ()); - bool retval = true; + for (octave_idx_type i = 0; i < k; i++) - if (r(i, i) == qr_elt_type ()) - { - retval = false; - break; - } + { + if (r(i, i) == qr_elt_type ()) + { + retval = false; + break; + } + } - return true; + return retval; }
--- a/liboctave/boolNDArray.cc +++ b/liboctave/boolNDArray.cc @@ -40,7 +40,7 @@ boolNDArray boolNDArray::operator ! (void) const { - return do_mx_unary_op<bool> (*this, mx_inline_not); + return do_mx_unary_op<bool, bool> (*this, mx_inline_not); } boolNDArray& @@ -149,7 +149,8 @@ if (a.is_shared ()) a = mx_el_and (a, b); else - do_mm_inplace_op<bool, bool> (a, b, mx_inline_and2, "operator &="); + do_mm_inplace_op<bool, bool> (a, b, mx_inline_and2, mx_inline_and2, + "operator &="); return a; } @@ -160,7 +161,8 @@ if (a.is_shared ()) a = mx_el_or (a, b); else - do_mm_inplace_op<bool, bool> (a, b, mx_inline_or2, "operator |="); + do_mm_inplace_op<bool, bool> (a, b, mx_inline_or2, mx_inline_or2, + "operator |="); return a; }
--- a/liboctave/boolSparse.h +++ b/liboctave/boolSparse.h @@ -57,6 +57,8 @@ explicit SparseBoolMatrix (const boolNDArray& a) : Sparse<bool> (a) { } + explicit SparseBoolMatrix (const PermMatrix& a) : Sparse<bool> (a) { }; + SparseBoolMatrix (const Array<bool>& a, const idx_vector& r, const idx_vector& c, octave_idx_type nr = -1, octave_idx_type nc = -1, bool sum_terms = true,
--- a/liboctave/bsxfun-decl.h +++ b/liboctave/bsxfun-decl.h @@ -42,6 +42,12 @@ BSXFUN_OP_DECL (min, ARRAY, API) \ BSXFUN_OP_DECL (max, ARRAY, API) +#define BSXFUN_MIXED_INT_DECLS(INT_TYPE, API) \ + BSXFUN_OP2_DECL (pow, INT_TYPE, INT_TYPE, NDArray, API) \ + BSXFUN_OP2_DECL (pow, INT_TYPE, INT_TYPE, FloatNDArray, API) \ + BSXFUN_OP2_DECL (pow, INT_TYPE, NDArray, INT_TYPE, API) \ + BSXFUN_OP2_DECL (pow, INT_TYPE, FloatNDArray, INT_TYPE, API) + #define BSXFUN_STDREL_DECLS(ARRAY, API) \ BSXFUN_REL_DECL (eq, ARRAY, API) \ BSXFUN_REL_DECL (ne, ARRAY, API) \
--- a/liboctave/bsxfun-defs.cc +++ b/liboctave/bsxfun-defs.cc @@ -69,8 +69,7 @@ R *rvec = retval.fortran_vec (); // Fold the common leading dimensions. - int start; - octave_idx_type ldr = 1; + octave_idx_type start, ldr = 1; for (start = 0; start < nd; start++) { if (dvx(start) != dvy(start)) @@ -98,7 +97,7 @@ } dim_vector cdvx = dvx.cumulative (), cdvy = dvy.cumulative (); // Nullify singleton dims to achieve a spread effect. - for (int i = std::max (start, 1); i < nd; i++) + for (int i = std::max (start, octave_idx_type (1)); i < nd; i++) { if (dvx(i) == 1) cdvx(i-1) = 0; @@ -134,6 +133,77 @@ return retval; } +template <class R, class X> +void +do_inplace_bsxfun_op (Array<R>& r, const Array<X>& x, + void (*op_vv) (size_t, R *, const X *), + void (*op_vs) (size_t, R *, X)) +{ + dim_vector dvr = r.dims (), dvx = x.dims (); + octave_idx_type nd = r.ndims (); + dvx.redim (nd); + + const X* xvec = x.fortran_vec (); + R* rvec = r.fortran_vec (); + + // Fold the common leading dimensions. + octave_idx_type start, ldr = 1; + for (start = 0; start < nd; start++) + { + if (dvr(start) != dvx(start)) + break; + ldr *= dvr(start); + } + + if (r.is_empty ()) + ; // do nothing + else if (start == nd) + op_vv (r.numel (), rvec, xvec); + else + { + // Determine the type of the low-level loop. + bool xsing = false; + if (ldr == 1) + { + xsing = dvx(start) == 1; + if (xsing) + { + ldr *= dvr(start) * dvx(start); + start++; + } + } + + dim_vector cdvx = dvx.cumulative (); + // Nullify singleton dims to achieve a spread effect. + for (int i = std::max (start, octave_idx_type (1)); i < nd; i++) + { + if (dvx(i) == 1) + cdvx(i-1) = 0; + } + + octave_idx_type niter = dvr.numel (start); + // The index array. + OCTAVE_LOCAL_BUFFER_INIT (octave_idx_type, idx, nd, 0); + for (octave_idx_type iter = 0; iter < niter; iter++) + { + octave_quit (); + + // Compute indices. + // FIXME: performance impact noticeable? + octave_idx_type xidx = cdvx.cum_compute_index (idx); + octave_idx_type ridx = dvr.compute_index (idx); + + // Apply the low-level loop. + if (xsing) + op_vs (ldr, rvec + ridx, xvec[xidx]); + else + op_vv (ldr, rvec + ridx, xvec + xidx); + + dvr.increment_index (idx + start, start); + } + } +} + #define BSXFUN_OP_DEF(OP, ARRAY) \ ARRAY bsxfun_ ## OP (const ARRAY& x, const ARRAY& y) @@ -174,4 +244,11 @@ BSXFUN_REL_DEF_MXLOOP (gt, ARRAY, mx_inline_gt) \ BSXFUN_REL_DEF_MXLOOP (ge, ARRAY, mx_inline_ge) +//For bsxfun power with mixed integer/float types +#define BSXFUN_POW_MIXED_MXLOOP(INT_TYPE) \ + BSXFUN_OP2_DEF_MXLOOP (pow, INT_TYPE, INT_TYPE, NDArray, mx_inline_pow) \ + BSXFUN_OP2_DEF_MXLOOP (pow, INT_TYPE, INT_TYPE, FloatNDArray, mx_inline_pow)\ + BSXFUN_OP2_DEF_MXLOOP (pow, INT_TYPE, NDArray, INT_TYPE, mx_inline_pow) \ + BSXFUN_OP2_DEF_MXLOOP (pow, INT_TYPE, FloatNDArray, INT_TYPE, mx_inline_pow) + #endif
new file mode 100644 --- /dev/null +++ b/liboctave/bsxfun.h @@ -0,0 +1,79 @@ +/* + +Copyright (C) 2011 Jordi Gutiérrez Hermoso <jordigh@octave.org> + +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/>. + +*/ +#if !defined (bsxfun_h) +#define bsxfun_h 1 + +#include <algorithm> + +#include "Array.h" +#include "dim-vector.h" +#include "lo-error.h" + +inline +bool +is_valid_bsxfun (const std::string& name, const dim_vector& dx, + const dim_vector& dy) +{ + for (int i = 0; i < std::min (dx.length (), dy.length ()); i++) + { + octave_idx_type xk = dx(i), yk = dy(i); + // Check the three conditions for valid bsxfun dims + if (! ( (xk == yk) || (xk == 1 && yk > 1) || (xk > 1 && yk == 1))) + return false; + } + + (*current_liboctave_warning_with_id_handler) + ("Octave:broadcast", "%s: automatic broadcasting operation applied", name.c_str ()); + + return true; +} + +// since we can't change the size of the assigned-to matrix, we cannot +// apply singleton expansion to it, so the conditions to check are +// different here. +inline +bool +is_valid_inplace_bsxfun (const std::string& name, const dim_vector& dr, + const dim_vector& dx) +{ + octave_idx_type drl = dr.length (), dxl = dx.length (); + if (drl < dxl) + return false; + + for (int i = 0; i < drl; i++) + { + octave_idx_type rk = dr(i), xk = dx(i); + + // Only two valid canditions to check; can't stretch rk + if (! ( (rk == xk) || (rk > 1 && xk == 1))) + return false; + } + + (*current_liboctave_warning_with_id_handler) + ("Octave:broadcast", "%s: automatic broadcasting operation applied", name.c_str ()); + + return true; +} + +#include "bsxfun-defs.cc" + +#endif
--- a/liboctave/caseless-str.h +++ b/liboctave/caseless-str.h @@ -46,6 +46,30 @@ operator std::string (void) const { return *this; } + bool operator < (const std::string& s) const + { + const_iterator p1 = begin (); + const_iterator p2 = s.begin (); + + while (p1 != end () && p2 != s.end ()) + { + char lp1 = std::tolower (*p1), lp2 = std::tolower (*p2); + + if ( lp1 > lp2 ) + return false; + if ( lp1 < lp2) + return true; + + p1++; + p2++; + } + + if ( length () >= s.length ()) + return false; + else + return true; + } + // Case-insensitive comparison. bool compare (const std::string& s, size_t limit = std::string::npos) const { @@ -59,8 +83,8 @@ if (std::tolower (*p1) != std::tolower (*p2)) return false; - *p1++; - *p2++; + p1++; + p2++; } return (limit == std::string::npos) ? size () == s.size () : k == limit;
--- a/liboctave/chMatrix.cc +++ b/liboctave/chMatrix.cc @@ -74,8 +74,8 @@ elem (0, i) = s[i]; } -charMatrix::charMatrix (const string_vector& s) - : Array<char> (dim_vector (s.length (), s.max_length ()), 0) +charMatrix::charMatrix (const string_vector& s, char fill_value) + : Array<char> (dim_vector (s.length (), s.max_length ()), fill_value) { octave_idx_type nr = rows (); @@ -137,7 +137,7 @@ octave_idx_type nr = rows (); octave_idx_type nc = cols (); - if (r == 0 && nr == 0 && nc == 0) + if (r == 0 && (nr == 0 || nc == 0)) return retval; if (r < 0 || r >= nr)
--- a/liboctave/chMatrix.h +++ b/liboctave/chMatrix.h @@ -62,7 +62,7 @@ charMatrix (const std::string& s); - charMatrix (const string_vector& s); + charMatrix (const string_vector& s, char fill_value = '\0'); charMatrix& operator = (const charMatrix& a) {
--- a/liboctave/cmd-edit.cc +++ b/liboctave/cmd-edit.cc @@ -42,6 +42,7 @@ #include "oct-env.h" #include "oct-mutex.h" #include "oct-time.h" +#include "singleton-cleanup.h" command_editor *command_editor::instance = 0; @@ -765,7 +766,7 @@ default_command_editor::do_readline (const std::string& prompt, bool& eof) { gnulib::fputs (prompt.c_str (), output_stream); - fflush (output_stream); + gnulib::fflush (output_stream); return octave_fgetl (input_stream, eof); } @@ -831,7 +832,12 @@ bool retval = true; if (! instance) - make_command_editor (); + { + make_command_editor (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) { @@ -1227,6 +1233,12 @@ } void +command_editor::run_event_hooks (void) +{ + event_handler (); +} + +void command_editor::read_init_file (const std::string& file_arg) { if (instance_ok ())
--- a/liboctave/cmd-edit.h +++ b/liboctave/cmd-edit.h @@ -137,6 +137,8 @@ static void remove_event_hook (event_hook_fcn f); + static void run_event_hooks (void); + static void read_init_file (const std::string& file = std::string ()); static void re_read_init_file (void); @@ -182,6 +184,8 @@ // The real thing. static command_editor *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + protected: // To use something other than the GNU readline library, derive a new
--- a/liboctave/cmd-hist.cc +++ b/liboctave/cmd-hist.cc @@ -33,6 +33,7 @@ #include "cmd-hist.h" #include "file-ops.h" #include "lo-error.h" +#include "singleton-cleanup.h" #include "str-vec.h" command_history *command_history::instance = 0; @@ -467,7 +468,12 @@ bool retval = true; if (! instance) - make_command_history (); + { + make_command_history (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) {
--- a/liboctave/cmd-hist.h +++ b/liboctave/cmd-hist.h @@ -126,6 +126,8 @@ // The real thing. static command_history *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + protected: // To use something other than the GNU history library, derive a new
--- a/liboctave/config-ops.sh +++ b/liboctave/config-ops.sh @@ -22,6 +22,8 @@ top_srcdir="$1" fi +move_if_change="$top_srcdir/build-aux/move-if-change" + liboctave_dir="$top_srcdir/liboctave" mk_ops="$liboctave_dir/mk-ops.awk" @@ -33,7 +35,7 @@ inc | all) VX_INC=$($AWK -f $mk_ops prefix=vx list_h_files=1 $liboctave_dir/vx-ops) echo "VX_OP_INC = $(echo $VX_INC)" > $liboctave_dir/vx-op-inc.mk-t - $top_srcdir/move-if-change $liboctave_dir/vx-op-inc.mk-t $liboctave_dir/vx-op-inc.mk + $move_if_change $liboctave_dir/vx-op-inc.mk-t $liboctave_dir/vx-op-inc.mk ;; esac ;; @@ -45,7 +47,7 @@ src | all) VX_SRC=$($AWK -f $mk_ops prefix=vx list_cc_files=1 $liboctave_dir/vx-ops) echo "VX_OP_SRC = $(echo $VX_SRC)" > $liboctave_dir/vx-op-src.mk-t - $top_srcdir/move-if-change $liboctave_dir/vx-op-src.mk-t $liboctave_dir/vx-op-src.mk + $move_if_change $liboctave_dir/vx-op-src.mk-t $liboctave_dir/vx-op-src.mk ;; esac ;; @@ -57,7 +59,7 @@ inc | all) MX_INC=$($AWK -f $mk_ops prefix=mx list_h_files=1 $liboctave_dir/mx-ops) echo "MX_OP_INC = $(echo $MX_INC)" > $liboctave_dir/mx-op-inc.mk-t - $top_srcdir/move-if-change $liboctave_dir/mx-op-inc.mk-t $liboctave_dir/mx-op-inc.mk + $move_if_change $liboctave_dir/mx-op-inc.mk-t $liboctave_dir/mx-op-inc.mk ;; esac ;; @@ -69,7 +71,7 @@ src | all) MX_SRC=$($AWK -f $mk_ops prefix=mx list_cc_files=1 $liboctave_dir/mx-ops) echo "MX_OP_SRC = $(echo $MX_SRC)" > $liboctave_dir/mx-op-src.mk-t - $top_srcdir/move-if-change $liboctave_dir/mx-op-src.mk-t $liboctave_dir/mx-op-src.mk + $move_if_change $liboctave_dir/mx-op-src.mk-t $liboctave_dir/mx-op-src.mk ;; esac ;; @@ -81,7 +83,7 @@ inc | all) SMX_INC=$($AWK -f $sparse_mk_ops prefix=smx list_h_files=1 $liboctave_dir/sparse-mx-ops) echo "SMX_OP_INC = $(echo $SMX_INC)" > $liboctave_dir/smx-op-inc.mk-t - $top_srcdir/move-if-change $liboctave_dir/smx-op-inc.mk-t $liboctave_dir/smx-op-inc.mk + $move_if_change $liboctave_dir/smx-op-inc.mk-t $liboctave_dir/smx-op-inc.mk ;; esac ;; @@ -93,7 +95,7 @@ src | all) SMX_SRC=$($AWK -f $sparse_mk_ops prefix=smx list_cc_files=1 $liboctave_dir/sparse-mx-ops) echo "SMX_OP_SRC = $(echo $SMX_SRC)" > $liboctave_dir/smx-op-src.mk-t - $top_srcdir/move-if-change $liboctave_dir/smx-op-src.mk-t $liboctave_dir/smx-op-src.mk + $move_if_change $liboctave_dir/smx-op-src.mk-t $liboctave_dir/smx-op-src.mk ;; esac ;;
--- a/liboctave/dMatrix.cc +++ b/liboctave/dMatrix.cc @@ -1239,6 +1239,9 @@ { DET retval (1.0); + info = 0; + rcon = 0.0; + octave_idx_type nr = rows (); octave_idx_type nc = cols (); @@ -1267,7 +1270,6 @@ Matrix atmp = *this; double *tmp_data = atmp.fortran_vec (); - info = 0; double anorm = 0; if (calc_cond) anorm = xnorm (*this, 1); @@ -2655,6 +2657,13 @@ } bool +Matrix::any_element_is_positive (bool neg_zero) const +{ + return (neg_zero ? test_all (xpositive_sign) + : do_mx_check<double> (*this, mx_inline_any_positive)); +} + +bool Matrix::any_element_is_nan (void) const { return do_mx_check<double> (*this, mx_inline_any_nan); @@ -3111,15 +3120,19 @@ */ /* Test some simple identities -%!shared M, cv, rv -%! M = randn(10,10); +%!shared M, cv, rv, Mt, rvt +%! M = randn(10,10)+100*eye(10,10); +%! Mt = M'; %! cv = randn(10,1); %! rv = randn(1,10); -%!assert([M*cv,M*cv],M*[cv,cv],1e-14) -%!assert([M'*cv,M'*cv],M'*[cv,cv],1e-14) -%!assert([rv*M;rv*M],[rv;rv]*M,1e-14) -%!assert([rv*M';rv*M'],[rv;rv]*M',1e-14) -%!assert(2*rv*cv,[rv,rv]*[cv;cv],1e-14) +%! rvt = rv'; +%!assert([M*cv,M*cv],M*[cv,cv],1e-13) +%!assert([M'*cv,M'*cv],M'*[cv,cv],1e-13) +%!assert([rv*M;rv*M],[rv;rv]*M,1e-13) +%!assert([rv*M';rv*M'],[rv;rv]*M',1e-13) +%!assert(2*rv*cv,[rv,rv]*[cv;cv],1e-13) +%!assert(M'\cv,Mt\cv,1e-14) +%!assert(M'\rv',Mt\rvt,1e-14) */ static inline char
--- a/liboctave/dMatrix.h +++ b/liboctave/dMatrix.h @@ -296,6 +296,7 @@ // other operations bool any_element_is_negative (bool = false) const; + bool any_element_is_positive (bool = false) const; bool any_element_is_nan (void) const; bool any_element_is_inf_or_nan (void) const; bool any_element_not_one_or_zero (void) const;
--- a/liboctave/dNDArray.cc +++ b/liboctave/dNDArray.cc @@ -554,6 +554,13 @@ } bool +NDArray::any_element_is_positive (bool neg_zero) const +{ + return (neg_zero ? test_all (xpositive_sign) + : do_mx_check<double> (*this, mx_inline_any_positive)); +} + +bool NDArray::any_element_is_nan (void) const { return do_mx_check<double> (*this, mx_inline_any_nan); @@ -925,3 +932,5 @@ BSXFUN_OP_DEF_MXLOOP (pow, NDArray, mx_inline_pow) BSXFUN_OP2_DEF_MXLOOP (pow, ComplexNDArray, ComplexNDArray, NDArray, mx_inline_pow) +BSXFUN_OP2_DEF_MXLOOP (pow, ComplexNDArray, NDArray, + ComplexNDArray, mx_inline_pow)
--- a/liboctave/dNDArray.h +++ b/liboctave/dNDArray.h @@ -75,6 +75,7 @@ boolNDArray operator ! (void) const; bool any_element_is_negative (bool = false) const; + bool any_element_is_positive (bool = false) const; bool any_element_is_nan (void) const; bool any_element_is_inf_or_nan (void) const; bool any_element_not_one_or_zero (void) const; @@ -185,5 +186,7 @@ BSXFUN_OP_DECL (pow, NDArray, OCTAVE_API) BSXFUN_OP2_DECL (pow, ComplexNDArray, ComplexNDArray, NDArray, OCTAVE_API) +BSXFUN_OP2_DECL (pow, ComplexNDArray, NDArray, + ComplexNDArray, OCTAVE_API) #endif
--- a/liboctave/dSparse.cc +++ b/liboctave/dSparse.cc @@ -180,29 +180,6 @@ cidx(i) = j; } -SparseMatrix::SparseMatrix (const PermMatrix& a) - : MSparse<double> (a.rows (), a.cols (), a.rows ()) -{ - octave_idx_type n = a.rows (); - for (octave_idx_type i = 0; i <= n; i++) - cidx (i) = i; - const Array<octave_idx_type> pv = a.pvec (); - - if (a.is_row_perm ()) - { - for (octave_idx_type i = 0; i < n; i++) - ridx (pv (i)) = i; - } - else - { - for (octave_idx_type i = 0; i < n; i++) - ridx (i) = pv (i); - } - - for (octave_idx_type i = 0; i < n; i++) - data (i) = 1.0; -} - bool SparseMatrix::operator == (const SparseMatrix& a) const { @@ -608,7 +585,7 @@ SparseMatrix::column (octave_idx_type i) const { octave_idx_type nr = rows (); - ColumnVector retval (nr); + ColumnVector retval (nr, 0); for (octave_idx_type k = cidx (i); k < cidx (i+1); k++) retval(ridx (k)) = data (k);
--- a/liboctave/dSparse.h +++ b/liboctave/dSparse.h @@ -82,7 +82,7 @@ explicit SparseMatrix (const DiagMatrix& a); - explicit SparseMatrix (const PermMatrix& a); + explicit SparseMatrix (const PermMatrix& a) : MSparse<double>(a) { } SparseMatrix (octave_idx_type r, octave_idx_type c, octave_idx_type num_nz) : MSparse<double> (r, c, num_nz) { }
--- a/liboctave/dim-vector.h +++ b/liboctave/dim-vector.h @@ -32,6 +32,7 @@ #include "lo-error.h" #include "lo-macros.h" +#include "oct-refcount.h" // Rationale: This implementation is more tricky than Array, but the // big plus is that dim_vector requires only one allocation instead of @@ -128,8 +129,12 @@ { if (count () > 1) { - --count(); - rep = clonerep (); + octave_idx_type *new_rep = clonerep (); + + if (OCTREFCOUNT_ATOMIC_DECREMENT(&(count())) == 0) + freerep (); + + rep = new_rep; } } @@ -222,9 +227,11 @@ static octave_idx_type dim_max (void); - explicit dim_vector (void) : rep (nil_rep ()) { count()++; } + explicit dim_vector (void) : rep (nil_rep ()) + { OCTREFCOUNT_ATOMIC_INCREMENT (&(count())); } - dim_vector (const dim_vector& dv) : rep (dv.rep) { count()++; } + dim_vector (const dim_vector& dv) : rep (dv.rep) + { OCTREFCOUNT_ATOMIC_INCREMENT (&(count())); } static dim_vector alloc (int n) { @@ -235,11 +242,11 @@ { if (&dv != this) { - if (--count() <= 0) + if (OCTREFCOUNT_ATOMIC_DECREMENT (&(count())) == 0) freerep (); rep = dv.rep; - count()++; + OCTREFCOUNT_ATOMIC_INCREMENT (&(count())); } return *this; @@ -247,7 +254,7 @@ ~dim_vector (void) { - if (--count() <= 0) + if (OCTREFCOUNT_ATOMIC_DECREMENT (&(count())) == 0) freerep (); } @@ -265,7 +272,7 @@ { octave_idx_type *r = resizerep (n, fill_value); - if (--count() <= 0) + if (OCTREFCOUNT_ATOMIC_DECREMENT (&(count())) == 0) freerep (); rep = r;
--- a/liboctave/fCColVector.cc +++ b/liboctave/fCColVector.cc @@ -242,7 +242,7 @@ FloatComplexColumnVector conj (const FloatComplexColumnVector& a) { - return do_mx_unary_map<FloatComplex, FloatComplex, std::conj> (a); + return do_mx_unary_map<FloatComplex, FloatComplex, std::conj<float> > (a); } // resize is the destructive equivalent for this one
--- a/liboctave/fCMatrix.cc +++ b/liboctave/fCMatrix.cc @@ -923,7 +923,7 @@ FloatComplexMatrix conj (const FloatComplexMatrix& a) { - return do_mx_unary_map<FloatComplex, FloatComplex, std::conj> (a); + return do_mx_unary_map<FloatComplex, FloatComplex, std::conj<float> > (a); } // resize is the destructive equivalent for this one @@ -1567,6 +1567,9 @@ { FloatComplexDET retval (1.0); + info = 0; + rcon = 0.0; + octave_idx_type nr = rows (); octave_idx_type nc = cols (); @@ -1595,7 +1598,6 @@ FloatComplexMatrix atmp = *this; FloatComplex *tmp_data = atmp.fortran_vec (); - info = 0; float anorm = 0; if (calc_cond) anorm = xnorm (*this, 1); @@ -3791,7 +3793,7 @@ octave_idx_type lda = a.rows (), tda = a.cols (); octave_idx_type ldb = b.rows (), tdb = b.cols (); - retval = FloatComplexMatrix (a_nr, b_nc); + retval = FloatComplexMatrix (a_nr, b_nc, 0.0); FloatComplex *c = retval.fortran_vec (); if (b_nc == 1 && a_nr == 1)
--- a/liboctave/fCNDArray.cc +++ b/liboctave/fCNDArray.cc @@ -757,7 +757,7 @@ FloatComplexNDArray conj (const FloatComplexNDArray& a) { - return do_mx_unary_map<FloatComplex, FloatComplex, std::conj> (a); + return do_mx_unary_map<FloatComplex, FloatComplex, std::conj<float> > (a); } FloatComplexNDArray&
--- a/liboctave/fCRowVector.cc +++ b/liboctave/fCRowVector.cc @@ -234,7 +234,7 @@ FloatComplexRowVector conj (const FloatComplexRowVector& a) { - return do_mx_unary_map<FloatComplex, FloatComplex, std::conj> (a); + return do_mx_unary_map<FloatComplex, FloatComplex, std::conj<float> > (a); } // resize is the destructive equivalent for this one
--- a/liboctave/fCRowVector.h +++ b/liboctave/fCRowVector.h @@ -129,9 +129,9 @@ // row vector by column vector -> scalar -FloatComplex operator * (const FloatComplexRowVector& a, const ColumnVector& b); +FloatComplex OCTAVE_API operator * (const FloatComplexRowVector& a, const ColumnVector& b); -FloatComplex operator * (const FloatComplexRowVector& a, const FloatComplexColumnVector& b); +FloatComplex OCTAVE_API operator * (const FloatComplexRowVector& a, const FloatComplexColumnVector& b); // other operations
--- a/liboctave/fMatrix.cc +++ b/liboctave/fMatrix.cc @@ -1239,6 +1239,9 @@ { FloatDET retval (1.0); + info = 0; + rcon = 0.0; + octave_idx_type nr = rows (); octave_idx_type nc = cols (); @@ -1267,7 +1270,6 @@ FloatMatrix atmp = *this; float *tmp_data = atmp.fortran_vec (); - info = 0; float anorm = 0; if (calc_cond) anorm = xnorm (*this, 1); @@ -2655,6 +2657,13 @@ } bool +FloatMatrix::any_element_is_positive (bool neg_zero) const +{ + return (neg_zero ? test_all (xpositive_sign) + : do_mx_check<float> (*this, mx_inline_any_positive)); +} + +bool FloatMatrix::any_element_is_nan (void) const { return do_mx_check<float> (*this, mx_inline_any_nan);
--- a/liboctave/fMatrix.h +++ b/liboctave/fMatrix.h @@ -296,6 +296,7 @@ // other operations bool any_element_is_negative (bool = false) const; + bool any_element_is_positive (bool = false) const; bool any_element_is_nan (void) const; bool any_element_is_inf_or_nan (void) const; bool any_element_not_one_or_zero (void) const;
--- a/liboctave/fNDArray.cc +++ b/liboctave/fNDArray.cc @@ -514,6 +514,13 @@ } bool +FloatNDArray::any_element_is_positive (bool neg_zero) const +{ + return (neg_zero ? test_all (xpositive_sign) + : do_mx_check<float> (*this, mx_inline_any_positive)); +} + +bool FloatNDArray::any_element_is_nan (void) const { return do_mx_check<float> (*this, mx_inline_any_nan); @@ -885,3 +892,5 @@ BSXFUN_OP_DEF_MXLOOP (pow, FloatNDArray, mx_inline_pow) BSXFUN_OP2_DEF_MXLOOP (pow, FloatComplexNDArray, FloatComplexNDArray, FloatNDArray, mx_inline_pow) +BSXFUN_OP2_DEF_MXLOOP (pow, FloatComplexNDArray, FloatNDArray, + FloatComplexNDArray, mx_inline_pow)
--- a/liboctave/fNDArray.h +++ b/liboctave/fNDArray.h @@ -72,6 +72,7 @@ boolNDArray operator ! (void) const; bool any_element_is_negative (bool = false) const; + bool any_element_is_positive (bool = false) const; bool any_element_is_nan (void) const; bool any_element_is_inf_or_nan (void) const; bool any_element_not_one_or_zero (void) const; @@ -182,5 +183,7 @@ BSXFUN_OP_DECL (pow, FloatNDArray, OCTAVE_API) BSXFUN_OP2_DECL (pow, FloatComplexNDArray, FloatComplexNDArray, FloatNDArray, OCTAVE_API) +BSXFUN_OP2_DECL (pow, FloatComplexNDArray, FloatNDArray, + FloatComplexNDArray, OCTAVE_API) #endif
--- a/liboctave/file-ops.cc +++ b/liboctave/file-ops.cc @@ -42,11 +42,12 @@ #include "file-ops.h" #include "file-stat.h" #include "oct-env.h" +#include "oct-locbuf.h" #include "oct-passwd.h" #include "pathlen.h" #include "quit.h" +#include "singleton-cleanup.h" #include "str-vec.h" -#include "oct-locbuf.h" file_ops *file_ops::instance = 0; @@ -73,13 +74,16 @@ instance = new file_ops (system_dir_sep_char, system_dir_sep_str, system_dir_sep_chars); - if (! instance) - { - (*current_liboctave_error_handler) - ("unable to create file_ops object!"); + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } - retval = false; - } + if (! instance) + { + (*current_liboctave_error_handler) + ("unable to create file_ops object!"); + + retval = false; } return retval;
--- a/liboctave/file-ops.h +++ b/liboctave/file-ops.h @@ -99,6 +99,8 @@ static file_ops *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + // No copying! file_ops (const file_ops&);
--- a/liboctave/idx-vector.cc +++ b/liboctave/idx-vector.cc @@ -27,7 +27,6 @@ #endif #include <cstdlib> -#include <memory> #include <iostream> @@ -332,7 +331,10 @@ data = d; if (err) + { + delete [] data; gripe_invalid_index (); + } } }
--- a/liboctave/idx-vector.h +++ b/liboctave/idx-vector.h @@ -29,6 +29,7 @@ #include <algorithm> #include <iosfwd> +#include <memory> #include "dim-vector.h" #include "oct-inttypes.h" @@ -63,6 +64,8 @@ class_mask }; + template<class T> friend class std::auto_ptr; + private: class OCTAVE_API idx_base_rep
--- a/liboctave/int16NDArray.cc +++ b/liboctave/int16NDArray.cc @@ -54,3 +54,7 @@ BSXFUN_STDOP_DEFS_MXLOOP (int16NDArray) BSXFUN_STDREL_DEFS_MXLOOP (int16NDArray) + +BSXFUN_OP_DEF_MXLOOP (pow, int16NDArray, mx_inline_pow) + +BSXFUN_POW_MIXED_MXLOOP (int16NDArray)
--- a/liboctave/int16NDArray.h +++ b/liboctave/int16NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (int16NDArray, octave_int16, OCTAVE_API) BSXFUN_STDOP_DECLS (int16NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(int16NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (int16NDArray, OCTAVE_API) #endif
--- a/liboctave/int32NDArray.cc +++ b/liboctave/int32NDArray.cc @@ -54,3 +54,6 @@ BSXFUN_STDOP_DEFS_MXLOOP (int32NDArray) BSXFUN_STDREL_DEFS_MXLOOP (int32NDArray) + +BSXFUN_OP_DEF_MXLOOP (pow, int32NDArray, mx_inline_pow) +BSXFUN_POW_MIXED_MXLOOP (int32NDArray)
--- a/liboctave/int32NDArray.h +++ b/liboctave/int32NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (int32NDArray, octave_int32, OCTAVE_API) BSXFUN_STDOP_DECLS (int32NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(int32NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (int32NDArray, OCTAVE_API) #endif
--- a/liboctave/int64NDArray.cc +++ b/liboctave/int64NDArray.cc @@ -54,3 +54,7 @@ BSXFUN_STDOP_DEFS_MXLOOP (int64NDArray) BSXFUN_STDREL_DEFS_MXLOOP (int64NDArray) + +BSXFUN_OP_DEF_MXLOOP (pow, int64NDArray, mx_inline_pow) + +BSXFUN_POW_MIXED_MXLOOP (int64NDArray)
--- a/liboctave/int64NDArray.h +++ b/liboctave/int64NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (int64NDArray, octave_int64, OCTAVE_API) BSXFUN_STDOP_DECLS (int64NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(int64NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (int64NDArray, OCTAVE_API) #endif
--- a/liboctave/int8NDArray.cc +++ b/liboctave/int8NDArray.cc @@ -54,3 +54,6 @@ BSXFUN_STDOP_DEFS_MXLOOP (int8NDArray) BSXFUN_STDREL_DEFS_MXLOOP (int8NDArray) + +BSXFUN_OP_DEF_MXLOOP (pow, int8NDArray, mx_inline_pow) +BSXFUN_POW_MIXED_MXLOOP (int8NDArray)
--- a/liboctave/int8NDArray.h +++ b/liboctave/int8NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (int8NDArray, octave_int8, OCTAVE_API) BSXFUN_STDOP_DECLS (int8NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(int8NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (int8NDArray, OCTAVE_API) #endif
--- a/liboctave/intNDArray.h +++ b/liboctave/intNDArray.h @@ -33,7 +33,7 @@ { public: - using MArray<T>::element_type; + using typename MArray<T>::element_type; intNDArray (void) : MArray<T> () { }
--- a/liboctave/kpse.cc +++ b/liboctave/kpse.cc @@ -49,8 +49,8 @@ #include <fcntl.h> #include <dirent.h> #elif defined(WIN32) +#ifndef _MSC_VER #define __STDC__ 1 -#ifndef _MSC_VER #include "win32lib.h" #endif #endif /* not WIN32 */ @@ -212,7 +212,7 @@ /* A printf for the debugging. */ #define DEBUGF_START() do { gnulib::fputs ("kdebug:", stderr) -#define DEBUGF_END() fflush (stderr); } while (0) +#define DEBUGF_END() gnulib::fflush (stderr); } while (0) #define DEBUGF(str) \ DEBUGF_START (); gnulib::fputs (str, stderr); DEBUGF_END () @@ -432,7 +432,7 @@ } gnulib::putc ('\n', stderr); } - fflush (stderr); + gnulib::fflush (stderr); } #endif @@ -2428,7 +2428,7 @@ gnulib::fprintf (stderr, " %s", (STR_LLIST (*e)).c_str ()); } gnulib::putc ('\n', stderr); - fflush (stderr); + gnulib::fflush (stderr); } #endif /* KPSE_DEBUG */
new file mode 100644 --- /dev/null +++ b/liboctave/link-deps.mk @@ -0,0 +1,27 @@ +include ../libcruft/link-deps.mk + +LIBOCTAVE_LINK_DEPS = \ + $(SPARSE_XLIBS) \ + $(ARPACK_LIBS) \ + $(QRUPDATE_LIBS) \ + $(FFTW_XLIBS) \ + $(LAPACK_LIBS) \ + $(BLAS_LIBS) \ + $(READLINE_LIBS) \ + $(TERM_LIBS) \ + $(LIBGLOB) \ + $(REGEX_LIBS) \ + $(DL_LIBS) \ + $(PTHREAD_LIBS) \ + $(LIBS) + +LIBOCTAVE_LINK_OPTS = \ + $(SPARSE_XLDFLAGS) \ + $(ARPACK_LDFLAGS) \ + $(QRUPDATE_LDFLAGS) \ + $(FFTW_XLDFLAGS) + +if AMCOND_LINK_ALL_DEPS + LIBOCTAVE_LINK_DEPS += $(LIBCRUFT_LINK_DEPS) + LIBOCTAVE_LINK_OPTS += $(LIBCRUFT_LINK_OPTS) +endif
--- a/liboctave/lo-cieee.c +++ b/liboctave/lo-cieee.c @@ -47,11 +47,6 @@ #define HAVE_FINITE 1 #endif -#if ! defined (HAVE_COPYSIGN) && defined (HAVE__COPYSIGN) -#define copysign _copysign -#define HAVE_COPYSIGN 1 -#endif - #if defined (_AIX) && defined (__GNUG__) #undef finite #define finite(x) ((x) < DBL_MAX && (x) > -DBL_MAX)
--- a/liboctave/lo-mappers.cc +++ b/liboctave/lo-mappers.cc @@ -48,6 +48,12 @@ return gnulib::trunc (x); } +double +xcopysign (double x, double y) +{ + return gnulib::copysign (x, y); +} + double xfloor (double x) { return gnulib::floor (x); @@ -268,6 +274,12 @@ } float +xcopysign (float x, float y) +{ + return gnulib::copysignf (x, y); +} + +float xround (float x) { return gnulib::round (x);
--- a/liboctave/lo-mappers.h +++ b/liboctave/lo-mappers.h @@ -31,7 +31,7 @@ // Double Precision extern OCTAVE_API double xtrunc (double x); -inline double xcopysign (double x, double y) { return copysign (x, y); } +extern OCTAVE_API double xcopysign (double x, double y); inline double xceil (double x) { return ceil (x); } extern OCTAVE_API double xfloor (double x); inline double arg (double x) { return atan2 (0.0, x); } @@ -117,7 +117,7 @@ // Single Precision extern OCTAVE_API float xtrunc (float x); -inline float xcopysign (float x, float y) { return copysignf (x, y); } +extern OCTAVE_API float xcopysign (float x, float y); inline float xceil (float x) { return ceilf (x); } inline float xfloor (float x) { return floorf (x); } inline float arg (float x) { return atan2f (0.0f, x); } @@ -218,6 +218,10 @@ extern OCTAVE_API bool xnegative_sign (double x); extern OCTAVE_API bool xnegative_sign (float x); +// Test for positive sign. +inline bool xpositive_sign (double x) { return ! xnegative_sign (x); } +inline bool xpositive_sign (float x) { return ! xnegative_sign (x); } + // Some old rounding functions. extern OCTAVE_API octave_idx_type NINTbig (double x); @@ -227,7 +231,6 @@ extern OCTAVE_API int NINT (float x); template <typename T> -OCTAVE_API T X_NINT (T x) { @@ -305,7 +308,6 @@ } template <typename T> -OCTAVE_API T xmod (T x, T y) { @@ -353,7 +355,6 @@ } template <typename T> -OCTAVE_API T xrem (T x, T y) {
--- a/liboctave/lo-utils.cc +++ b/liboctave/lo-utils.cc @@ -124,7 +124,7 @@ do { - if (fgets (bufptr, grow_size, f)) + if (gnulib::fgets (bufptr, grow_size, f)) { len = strlen (bufptr); @@ -196,44 +196,57 @@ } static inline double -read_inf_nan_na (std::istream& is, char c, char sign = '+') +read_inf_nan_na (std::istream& is, char c0, char sign = '+') { double d = 0.0; - switch (c) + switch (c0) { case 'i': case 'I': { - c = is.get (); - if (c == 'n' || c == 'N') + char c1 = is.get (); + if (c1 == 'n' || c1 == 'N') { - c = is.get (); - if (c == 'f' || c == 'F') + char c2 = is.get (); + if (c2 == 'f' || c2 == 'F') d = sign == '-' ? -octave_Inf : octave_Inf; else - is.putback (c); + { + is.putback (c2); + is.putback (c1); + is.putback (c0); + is.setstate (std::ios::failbit); + } } else - is.putback (c); + { + is.putback (c1); + is.putback (c0); + is.setstate (std::ios::failbit); + } } break; case 'n': case 'N': { - c = is.get (); - if (c == 'a' || c == 'A') + char c1 = is.get (); + if (c1 == 'a' || c1 == 'A') { - c = is.get (); - if (c == 'n' || c == 'N') + char c2 = is.get (); + if (c2 == 'n' || c2 == 'N') d = octave_NaN; else { - is.putback (c); + is.putback (c2); d = octave_NA; } } else - is.putback (c); + { + is.putback (c1); + is.putback (c0); + is.setstate (std::ios::failbit); + } } break; @@ -244,6 +257,8 @@ return d; } +// Read a double value. Discard any sign on NaN and NA. + template <> double octave_read_value (std::istream& is) @@ -261,7 +276,7 @@ { char c2 = 0; c2 = is.get (); - if (c2 == 'i' || c2 == 'I') + if (c2 == 'i' || c2 == 'I' || c2 == 'n' || c2 == 'N') d = read_inf_nan_na (is, c2, c1); else { @@ -276,7 +291,7 @@ { char c2 = 0; c2 = is.get (); - if (c2 == 'i' || c2 == 'I') + if (c2 == 'i' || c2 == 'I' || c2 == 'n' || c2 == 'N') d = read_inf_nan_na (is, c2, c1); else { @@ -344,44 +359,57 @@ } static inline float -read_float_inf_nan_na (std::istream& is, char c, char sign = '+') +read_float_inf_nan_na (std::istream& is, char c0, char sign = '+') { float d = 0.0; - switch (c) + switch (c0) { case 'i': case 'I': { - c = is.get (); - if (c == 'n' || c == 'N') + char c1 = is.get (); + if (c1 == 'n' || c1 == 'N') { - c = is.get (); - if (c == 'f' || c == 'F') - d = sign == '-' ? -octave_Inf : octave_Inf; + char c2 = is.get (); + if (c2 == 'f' || c2 == 'F') + d = sign == '-' ? -octave_Float_Inf : octave_Float_Inf; else - is.putback (c); + { + is.putback (c2); + is.putback (c1); + is.putback (c0); + is.setstate (std::ios::failbit); + } } else - is.putback (c); + { + is.putback (c1); + is.putback (c0); + is.setstate (std::ios::failbit); + } } break; case 'n': case 'N': { - c = is.get (); - if (c == 'a' || c == 'A') + char c1 = is.get (); + if (c1 == 'a' || c1 == 'A') { - c = is.get (); - if (c == 'n' || c == 'N') - d = octave_NaN; + char c2 = is.get (); + if (c2 == 'n' || c2 == 'N') + d = octave_Float_NaN; else { - is.putback (c); - d = octave_NA; + is.putback (c2); + d = octave_Float_NA; } } else - is.putback (c); + { + is.putback (c1); + is.putback (c0); + is.setstate (std::ios::failbit); + } } break; @@ -392,6 +420,8 @@ return d; } +// Read a float value. Discard any sign on NaN and NA. + template <> float octave_read_value (std::istream& is) @@ -409,7 +439,7 @@ { char c2 = 0; c2 = is.get (); - if (c2 == 'i' || c2 == 'I') + if (c2 == 'i' || c2 == 'I' || c2 == 'n' || c2 == 'N') d = read_float_inf_nan_na (is, c2, c1); else { @@ -424,7 +454,7 @@ { char c2 = 0; c2 = is.get (); - if (c2 == 'i' || c2 == 'I') + if (c2 == 'i' || c2 == 'I' || c2 == 'n' || c2 == 'N') d = read_float_inf_nan_na (is, c2, c1); else {
--- a/liboctave/mach-info.cc +++ b/liboctave/mach-info.cc @@ -27,6 +27,7 @@ #include "f77-fcn.h" #include "lo-error.h" #include "mach-info.h" +#include "singleton-cleanup.h" extern "C" { @@ -163,7 +164,12 @@ bool retval = true; if (! instance) - instance = new oct_mach_info (); + { + instance = new oct_mach_info (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) {
--- a/liboctave/mach-info.h +++ b/liboctave/mach-info.h @@ -61,6 +61,8 @@ static oct_mach_info *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + // The floating point format for the current machine. mutable float_format native_float_fmt;
--- a/liboctave/mx-inlines.cc +++ b/liboctave/mx-inlines.cc @@ -37,6 +37,8 @@ #include "Array.h" #include "Array-util.h" +#include "bsxfun.h" + // Provides some commonly repeated, basic loop templates. template <class R, class S> @@ -167,6 +169,9 @@ for (size_t i = 0; i < n; i++) \ r[i] OP logical_value (x[i]); \ } \ +template <class X> \ +inline void F (size_t n, bool *r, X x) throw () \ +{ for (size_t i = 0; i < n; i++) r[i] OP x; } DEFMXBOOLOPEQ (mx_inline_and2, &=) DEFMXBOOLOPEQ (mx_inline_or2, |=) @@ -210,6 +215,19 @@ return false; } +template <class T> +inline bool +mx_inline_any_positive (size_t n, const T* x) throw () +{ + for (size_t i = 0; i < n; i++) + { + if (x[i] > 0) + return true; + } + + return false; +} + template<class T> inline bool mx_inline_all_real (size_t n, const std::complex<T>* x) throw () @@ -286,7 +304,10 @@ inline void F (size_t n, R *r, X x, const Y *y) throw () \ { for (size_t i = 0; i < n; i++) r[i] = FUN (x, y[i]); } -DEFMXMAPPER2X (mx_inline_pow, std::pow) +// Let the compiler decide which pow to use, whichever best matches the +// arguments provided. +using std::pow; +DEFMXMAPPER2X (mx_inline_pow, pow) // Arbitrary function appliers. The function is a template parameter to enable // inlining. @@ -336,11 +357,12 @@ return r; } - template <class R, class X, class Y> inline Array<R> do_mm_binary_op (const Array<X>& x, const Array<Y>& y, void (*op) (size_t, R *, const X *, const Y *) throw (), + void (*op1) (size_t, R *, X, const Y *) throw (), + void (*op2) (size_t, R *, const X *, Y) throw (), const char *opname) { dim_vector dx = x.dims (), dy = y.dims (); @@ -350,6 +372,10 @@ op (r.length (), r.fortran_vec (), x.data (), y.data ()); return r; } + else if (is_valid_bsxfun (opname, dx, dy)) + { + return do_bsxfun_op (x, y, op, op1, op2); + } else { gripe_nonconformant (opname, dx, dy); @@ -381,11 +407,18 @@ inline Array<R>& do_mm_inplace_op (Array<R>& r, const Array<X>& x, void (*op) (size_t, R *, const X *) throw (), + void (*op1) (size_t, R *, X) throw (), const char *opname) { dim_vector dr = r.dims (), dx = x.dims (); if (dr == dx) - op (r.length (), r.fortran_vec (), x.data ()); + { + op (r.length (), r.fortran_vec (), x.data ()); + } + else if (is_valid_inplace_bsxfun (opname, dr, dx)) + { + do_inplace_bsxfun_op (r, x, op, op1); + } else gripe_nonconformant (opname, dr, dx); return r;
--- a/liboctave/mx-op-defs.h +++ b/liboctave/mx-op-defs.h @@ -72,7 +72,7 @@ R \ F (const V1& v1, const V2& v2) \ { \ - return do_mm_binary_op<R::element_type, V1::element_type, V2::element_type> (v1, v2, OP, #F); \ + return do_mm_binary_op<R::element_type, V1::element_type, V2::element_type> (v1, v2, OP, OP, OP, #F); \ } #define VV_BIN_OPS(R, V1, V2) \ @@ -173,7 +173,7 @@ R \ OP (const M1& m1, const M2& m2) \ { \ - return do_mm_binary_op<R::element_type, M1::element_type, M2::element_type> (m1, m2, F, #OP); \ + return do_mm_binary_op<R::element_type, M1::element_type, M2::element_type> (m1, m2, F, F, F, #OP); \ } #define MM_BIN_OPS(R, M1, M2) \ @@ -186,7 +186,7 @@ boolMatrix \ F (const M1& m1, const M2& m2) \ { \ - return do_mm_binary_op<bool, M1::element_type, M2::element_type> (m1, m2, OP, #F); \ + return do_mm_binary_op<bool, M1::element_type, M2::element_type> (m1, m2, OP, OP, OP, #F); \ } #define MM_CMP_OPS(M1, M2) \ @@ -203,7 +203,7 @@ { \ MNANCHK (m1, M1::element_type); \ MNANCHK (m2, M2::element_type); \ - return do_mm_binary_op<bool, M1::element_type, M2::element_type> (m1, m2, OP, #F); \ + return do_mm_binary_op<bool, M1::element_type, M2::element_type> (m1, m2, OP, OP, OP, #F); \ } #define MM_BOOL_OPS(M1, M2) \ @@ -310,7 +310,7 @@ R \ OP (const ND1& m1, const ND2& m2) \ { \ - return do_mm_binary_op<R::element_type, ND1::element_type, ND2::element_type> (m1, m2, F, #OP); \ + return do_mm_binary_op<R::element_type, ND1::element_type, ND2::element_type> (m1, m2, F, F, F, #OP); \ } #define NDND_BIN_OPS(R, ND1, ND2) \ @@ -323,7 +323,7 @@ boolNDArray \ F (const ND1& m1, const ND2& m2) \ { \ - return do_mm_binary_op<bool, ND1::element_type, ND2::element_type> (m1, m2, OP, #F); \ + return do_mm_binary_op<bool, ND1::element_type, ND2::element_type> (m1, m2, OP, OP, OP, #F); \ } #define NDND_CMP_OPS(ND1, ND2) \ @@ -340,7 +340,7 @@ { \ MNANCHK (m1, ND1::element_type); \ MNANCHK (m2, ND2::element_type); \ - return do_mm_binary_op<bool, ND1::element_type, ND2::element_type> (m1, m2, OP, #F); \ + return do_mm_binary_op<bool, ND1::element_type, ND2::element_type> (m1, m2, OP, OP, OP, #F); \ } #define NDND_BOOL_OPS(ND1, ND2) \ @@ -583,7 +583,7 @@ T \ FCN (const T& a, const T& b) \ { \ - return do_mm_binary_op<T::element_type, T::element_type, T::element_type> (a, b, mx_inline_x##FCN, #FCN); \ + return do_mm_binary_op<T::element_type, T::element_type, T::element_type> (a, b, mx_inline_x##FCN, mx_inline_x##FCN, mx_inline_x##FCN, #FCN); \ } #define MINMAX_FCNS(T, S) \
--- a/liboctave/oct-alloc.h +++ b/liboctave/oct-alloc.h @@ -72,6 +72,8 @@ { ::operator delete (p); } #endif +#if defined (USE_OCTAVE_ALLOCATOR) + #define DECLARE_OCTAVE_ALLOCATOR \ public: \ void *operator new (size_t size, void *p) \ @@ -88,4 +90,12 @@ #define DEFINE_OCTAVE_ALLOCATOR2(t, s) \ octave_allocator t::allocator (sizeof (t), s) +#else + +#define DECLARE_OCTAVE_ALLOCATOR +#define DEFINE_OCTAVE_ALLOCATOR(t) +#define DEFINE_OCTAVE_ALLOCATOR2(t, s) + #endif + +#endif
--- a/liboctave/oct-binmap.h +++ b/liboctave/oct-binmap.h @@ -27,9 +27,13 @@ #include "Sparse.h" #include "Array-util.h" -// This source implements a general binary maping function for arrays. -// The syntax is binmap<type> (a, b, f, [name]). type denotes the expected -// return type of the operation. a, b, should be one of the 6 combinations: +#include "bsxfun.h" + +// This source file implements a general binary maping function for +// arrays. The syntax is binmap<type> (a, b, f, [name]). type denotes +// the expected return type of the operation. a, b, should be one of +// the 6 combinations: +// // Array-Array // Array-scalar // scalar-Array @@ -37,11 +41,12 @@ // Sparse-scalar // scalar-Sparse // -// If both operands are nonscalar, name must be supplied. It is used as the base for error message -// when operands are nonconforming. +// If both operands are nonscalar, name must be supplied. It is used +// as the base for error message when operands are nonconforming. // -// The operation needs not be homogeneous, i.e. a, b and the result may be of distinct types. -// f can have any of the four signatures: +// The operation needs not be homogeneous, i.e. a, b and the result +// may be of distinct types. f can have any of the four signatures: +// // U f (T, R) // U f (const T&, R) // U f (T, const R&) @@ -49,7 +54,51 @@ // // Additionally, f can be an arbitrary functor object. // -// octave_quit() is called at appropriate places, hence the operation is breakable. +// octave_quit() is called at appropriate places, hence the operation +// is breakable. + +// The following template wrappers are provided for automatic bsxfun +// calls (see the function signature for do_bsxfun_op). + +template<typename R, typename X, typename Y, typename F> +class bsxfun_wrapper +{ +private: + static F f; + +public: + static void + set_f (const F& f_in) + { + f = f_in; + } + + static void + op_mm (size_t n, R* r, const X* x , const Y* y) + { + for (size_t i = 0; i < n; i++) + r[i] = f (x[i], y[i]); + } + + static void + op_sm (size_t n, R* r, X x, const Y* y) + { + for (size_t i = 0; i < n; i++) + r[i] = f (x, y[i]); + } + + static void + op_ms (size_t n , R* r, const X* x, Y y) + { + for (size_t i = 0; i < n; i++) + r[i] = f (x[i], y); + } +}; + +// Static init +template<typename R, typename X, typename Y, typename F> +F bsxfun_wrapper<R, X, Y, F>::f; + // scalar-Array template <class U, class T, class R, class F> @@ -118,12 +167,24 @@ Array<U> binmap (const Array<T>& xa, const Array<R>& ya, F fcn, const char *name) { + dim_vector xad = xa.dims (), yad = ya.dims (); if (xa.numel () == 1) return binmap<U, T, R, F> (xa(0), ya, fcn); else if (ya.numel () == 1) return binmap<U, T, R, F> (xa, ya(0), fcn); - else if (xa.dims () != ya.dims ()) - gripe_nonconformant (name, xa.dims (), ya.dims ()); + else if (xad != yad) + { + if (is_valid_bsxfun (name, xad, yad)) + { + bsxfun_wrapper<U, T, R, F>::set_f(fcn); + return do_bsxfun_op (xa, ya, + bsxfun_wrapper<U, T, R, F>::op_mm, + bsxfun_wrapper<U, T, R, F>::op_sm, + bsxfun_wrapper<U, T, R, F>::op_ms); + } + else + gripe_nonconformant (name, xad, yad); + } octave_idx_type len = xa.numel (); @@ -273,134 +334,134 @@ fcn, name)); } -// Overloads for function references. +// Overloads for function pointers. // Signature (T, R) template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const Array<R>& ya, U (&fcn) (T, R), const char *name) -{ return binmap<U, T, R, U (&) (T, R)> (xa, ya, fcn, name); } +binmap (const Array<T>& xa, const Array<R>& ya, U (*fcn) (T, R), const char *name) +{ return binmap<U, T, R, U (*) (T, R)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Array<U> -binmap (const T& x, const Array<R>& ya, U (&fcn) (T, R)) -{ return binmap<U, T, R, U (&) (T, R)> (x, ya, fcn); } +binmap (const T& x, const Array<R>& ya, U (*fcn) (T, R)) +{ return binmap<U, T, R, U (*) (T, R)> (x, ya, fcn); } template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const R& y, U (&fcn) (T, R)) -{ return binmap<U, T, R, U (&) (T, R)> (xa, y, fcn); } +binmap (const Array<T>& xa, const R& y, U (*fcn) (T, R)) +{ return binmap<U, T, R, U (*) (T, R)> (xa, y, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (&fcn) (T, R), const char *name) -{ return binmap<U, T, R, U (&) (T, R)> (xa, ya, fcn, name); } +binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (*fcn) (T, R), const char *name) +{ return binmap<U, T, R, U (*) (T, R)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Sparse<U> -binmap (const T& x, const Sparse<R>& ya, U (&fcn) (T, R)) -{ return binmap<U, T, R, U (&) (T, R)> (x, ya, fcn); } +binmap (const T& x, const Sparse<R>& ya, U (*fcn) (T, R)) +{ return binmap<U, T, R, U (*) (T, R)> (x, ya, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const R& y, U (&fcn) (T, R)) -{ return binmap<U, T, R, U (&) (T, R)> (xa, y, fcn); } +binmap (const Sparse<T>& xa, const R& y, U (*fcn) (T, R)) +{ return binmap<U, T, R, U (*) (T, R)> (xa, y, fcn); } // Signature (const T&, const R&) template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const Array<R>& ya, U (&fcn) (const T&, const R&), const char *name) -{ return binmap<U, T, R, U (&) (const T&, const R&)> (xa, ya, fcn, name); } +binmap (const Array<T>& xa, const Array<R>& ya, U (*fcn) (const T&, const R&), const char *name) +{ return binmap<U, T, R, U (*) (const T&, const R&)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Array<U> -binmap (const T& x, const Array<R>& ya, U (&fcn) (const T&, const R&)) -{ return binmap<U, T, R, U (&) (const T&, const R&)> (x, ya, fcn); } +binmap (const T& x, const Array<R>& ya, U (*fcn) (const T&, const R&)) +{ return binmap<U, T, R, U (*) (const T&, const R&)> (x, ya, fcn); } template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const R& y, U (&fcn) (const T&, const R&)) -{ return binmap<U, T, R, U (&) (const T&, const R&)> (xa, y, fcn); } +binmap (const Array<T>& xa, const R& y, U (*fcn) (const T&, const R&)) +{ return binmap<U, T, R, U (*) (const T&, const R&)> (xa, y, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (&fcn) (const T&, const R&), const char *name) -{ return binmap<U, T, R, U (&) (const T&, const R&)> (xa, ya, fcn, name); } +binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (*fcn) (const T&, const R&), const char *name) +{ return binmap<U, T, R, U (*) (const T&, const R&)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Sparse<U> -binmap (const T& x, const Sparse<R>& ya, U (&fcn) (const T&, const R&)) -{ return binmap<U, T, R, U (&) (const T&, const R&)> (x, ya, fcn); } +binmap (const T& x, const Sparse<R>& ya, U (*fcn) (const T&, const R&)) +{ return binmap<U, T, R, U (*) (const T&, const R&)> (x, ya, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const R& y, U (&fcn) (const T&, const R&)) -{ return binmap<U, T, R, U (&) (const T&, const R&)> (xa, y, fcn); } +binmap (const Sparse<T>& xa, const R& y, U (*fcn) (const T&, const R&)) +{ return binmap<U, T, R, U (*) (const T&, const R&)> (xa, y, fcn); } // Signature (const T&, R) template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const Array<R>& ya, U (&fcn) (const T&, R), const char *name) -{ return binmap<U, T, R, U (&) (const T&, R)> (xa, ya, fcn, name); } +binmap (const Array<T>& xa, const Array<R>& ya, U (*fcn) (const T&, R), const char *name) +{ return binmap<U, T, R, U (*) (const T&, R)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Array<U> -binmap (const T& x, const Array<R>& ya, U (&fcn) (const T&, R)) -{ return binmap<U, T, R, U (&) (const T&, R)> (x, ya, fcn); } +binmap (const T& x, const Array<R>& ya, U (*fcn) (const T&, R)) +{ return binmap<U, T, R, U (*) (const T&, R)> (x, ya, fcn); } template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const R& y, U (&fcn) (const T&, R)) -{ return binmap<U, T, R, U (&) (const T&, R)> (xa, y, fcn); } +binmap (const Array<T>& xa, const R& y, U (*fcn) (const T&, R)) +{ return binmap<U, T, R, U (*) (const T&, R)> (xa, y, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (&fcn) (const T&, R), const char *name) -{ return binmap<U, T, R, U (&) (const T&, R)> (xa, ya, fcn, name); } +binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (*fcn) (const T&, R), const char *name) +{ return binmap<U, T, R, U (*) (const T&, R)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Sparse<U> -binmap (const T& x, const Sparse<R>& ya, U (&fcn) (const T&, R)) -{ return binmap<U, T, R, U (&) (const T&, R)> (x, ya, fcn); } +binmap (const T& x, const Sparse<R>& ya, U (*fcn) (const T&, R)) +{ return binmap<U, T, R, U (*) (const T&, R)> (x, ya, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const R& y, U (&fcn) (const T&, R)) -{ return binmap<U, T, R, U (&) (const T&, R)> (xa, y, fcn); } +binmap (const Sparse<T>& xa, const R& y, U (*fcn) (const T&, R)) +{ return binmap<U, T, R, U (*) (const T&, R)> (xa, y, fcn); } // Signature (T, const R&) template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const Array<R>& ya, U (&fcn) (T, const R&), const char *name) -{ return binmap<U, T, R, U (&) (T, const R&)> (xa, ya, fcn, name); } +binmap (const Array<T>& xa, const Array<R>& ya, U (*fcn) (T, const R&), const char *name) +{ return binmap<U, T, R, U (*) (T, const R&)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Array<U> -binmap (const T& x, const Array<R>& ya, U (&fcn) (T, const R&)) -{ return binmap<U, T, R, U (&) (T, const R&)> (x, ya, fcn); } +binmap (const T& x, const Array<R>& ya, U (*fcn) (T, const R&)) +{ return binmap<U, T, R, U (*) (T, const R&)> (x, ya, fcn); } template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const R& y, U (&fcn) (T, const R&)) -{ return binmap<U, T, R, U (&) (T, const R&)> (xa, y, fcn); } +binmap (const Array<T>& xa, const R& y, U (*fcn) (T, const R&)) +{ return binmap<U, T, R, U (*) (T, const R&)> (xa, y, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (&fcn) (T, const R&), const char *name) -{ return binmap<U, T, R, U (&) (T, const R&)> (xa, ya, fcn, name); } +binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (*fcn) (T, const R&), const char *name) +{ return binmap<U, T, R, U (*) (T, const R&)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Sparse<U> -binmap (const T& x, const Sparse<R>& ya, U (&fcn) (T, const R&)) -{ return binmap<U, T, R, U (&) (T, const R&)> (x, ya, fcn); } +binmap (const T& x, const Sparse<R>& ya, U (*fcn) (T, const R&)) +{ return binmap<U, T, R, U (*) (T, const R&)> (x, ya, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const R& y, U (&fcn) (T, const R&)) -{ return binmap<U, T, R, U (&) (T, const R&)> (xa, y, fcn); } +binmap (const Sparse<T>& xa, const R& y, U (*fcn) (T, const R&)) +{ return binmap<U, T, R, U (*) (T, const R&)> (xa, y, fcn); } #endif
--- a/liboctave/oct-env.cc +++ b/liboctave/oct-env.cc @@ -58,6 +58,7 @@ #include "oct-env.h" #include "oct-passwd.h" #include "oct-syscalls.h" +#include "singleton-cleanup.h" octave_env::octave_env (void) : follow_symbolic_links (true), verbatim_pwd (true), @@ -81,7 +82,12 @@ bool retval = true; if (! instance) - instance = new octave_env (); + { + instance = new octave_env (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) {
--- a/liboctave/oct-env.h +++ b/liboctave/oct-env.h @@ -115,6 +115,9 @@ // The real thing. static octave_env *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + // TRUE means follow symbolic links that point to directories just // as if they are real directories. bool follow_symbolic_links;
--- a/liboctave/oct-fftw.cc +++ b/liboctave/oct-fftw.cc @@ -33,27 +33,27 @@ #include "oct-fftw.h" #include "quit.h" #include "oct-locbuf.h" +#include "singleton-cleanup.h" octave_fftw_planner *octave_fftw_planner::instance = 0; -// Helper class to create and cache fftw plans for both 1d and -// 2d. This implementation defaults to using FFTW_ESTIMATE to create -// the plans, which in theory is suboptimal, but provides quit -// reasonable performance. +// Helper class to create and cache FFTW plans for both 1D and +// 2D. This implementation defaults to using FFTW_ESTIMATE to create +// the plans, which in theory is suboptimal, but provides quite +// reasonable performance in practice. -// Also note that if FFTW_ESTIMATE is not used the planner in FFTW3 -// destroys the input and output arrays. We must therefore create a +// Also note that if FFTW_ESTIMATE is not used then the planner in FFTW3 +// will destroy the input and output arrays. We must, therefore, create a // temporary input array with the same size and 16-byte alignment as -// the original array and use that for the planner. Note that we also -// use any wisdom that is available, either in a FFTW3 system wide file -// or as supplied by the user. +// the original array when using a different planner strategy. +// Note that we also use any wisdom that is available, either in a +// FFTW3 system wide file or as supplied by the user. // FIXME -- if we can ensure 16 byte alignment in Array<T> // (<T> *data) the FFTW3 can use SIMD instructions for further // acceleration. -// Note that it is profitable to store the FFTW3 plans, for small -// ffts. +// Note that it is profitable to store the FFTW3 plans, for small FFTs. octave_fftw_planner::octave_fftw_planner (void) : meth (ESTIMATE), rplan (0), rd (0), rs (0), rr (0), rh (0), rn (), @@ -69,13 +69,35 @@ fftw_import_system_wisdom (); } +octave_fftw_planner::~octave_fftw_planner (void) +{ + fftw_plan *plan_p; + + plan_p = &rplan; + if (*plan_p) + fftw_destroy_plan (*plan_p); + + plan_p = &plan[0]; + if (*plan_p) + fftw_destroy_plan (*plan_p); + + plan_p = &plan[1]; + if (*plan_p) + fftw_destroy_plan (*plan_p); +} + bool octave_fftw_planner::instance_ok (void) { bool retval = true; if (! instance) - instance = new octave_fftw_planner (); + { + instance = new octave_fftw_planner (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) { @@ -377,13 +399,35 @@ fftwf_import_system_wisdom (); } +octave_float_fftw_planner::~octave_float_fftw_planner (void) +{ + fftwf_plan *plan_p; + + plan_p = &rplan; + if (*plan_p) + fftwf_destroy_plan (*plan_p); + + plan_p = &plan[0]; + if (*plan_p) + fftwf_destroy_plan (*plan_p); + + plan_p = &plan[1]; + if (*plan_p) + fftwf_destroy_plan (*plan_p); +} + bool octave_float_fftw_planner::instance_ok (void) { bool retval = true; if (! instance) - instance = new octave_float_fftw_planner (); + { + instance = new octave_float_fftw_planner (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) {
--- a/liboctave/oct-fftw.h +++ b/liboctave/oct-fftw.h @@ -44,7 +44,7 @@ public: - ~octave_fftw_planner (void) { } + ~octave_fftw_planner (void); enum FftwMethod { @@ -108,6 +108,8 @@ static octave_fftw_planner *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + fftw_plan do_create_plan (int dir, const int rank, const dim_vector dims, octave_idx_type howmany, octave_idx_type stride, @@ -179,7 +181,7 @@ public: - ~octave_float_fftw_planner (void) { } + ~octave_float_fftw_planner (void); enum FftwMethod { @@ -243,6 +245,8 @@ static octave_float_fftw_planner *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + fftwf_plan do_create_plan (int dir, const int rank, const dim_vector dims, octave_idx_type howmany, octave_idx_type stride,
--- a/liboctave/oct-inttypes.cc +++ b/liboctave/oct-inttypes.cc @@ -578,6 +578,23 @@ template <class T> octave_int<T> +pow (const float& a, const octave_int<T>& b) +{ return octave_int<T> (pow (a, b.float_value ())); } + +template <class T> +octave_int<T> +pow (const octave_int<T>& a, const float& b) +{ + return ((b >= 0 && b < std::numeric_limits<T>::digits && b == xround (b)) + ? pow (a, octave_int<T> (static_cast<T> (b))) + : octave_int<T> (pow (a.double_value (), static_cast<double> (b)))); +} + +// FIXME: Do we really need a differently named single-precision +// function integer power function here instead of an overloaded +// one? +template <class T> +octave_int<T> powf (const float& a, const octave_int<T>& b) { return octave_int<T> (pow (a, b.float_value ())); } @@ -595,6 +612,8 @@ template OCTAVE_API octave_int<T> pow (const octave_int<T>&, const octave_int<T>&); \ template OCTAVE_API octave_int<T> pow (const double&, const octave_int<T>&); \ template OCTAVE_API octave_int<T> pow (const octave_int<T>&, const double&); \ + template OCTAVE_API octave_int<T> pow (const float&, const octave_int<T>&); \ + template OCTAVE_API octave_int<T> pow (const octave_int<T>&, const float&); \ template OCTAVE_API octave_int<T> powf (const float&, const octave_int<T>&); \ template OCTAVE_API octave_int<T> powf (const octave_int<T>&, const float&); \ template OCTAVE_API octave_int<T> \
--- a/liboctave/oct-inttypes.h +++ b/liboctave/oct-inttypes.h @@ -452,7 +452,7 @@ // Returns 1 for negative number, 0 otherwise. static T - signbit (T x) + __signbit (T x) { #ifdef HAVE_FAST_INT_OPS return static_cast<UT> (x) >> std::numeric_limits<T>::digits; @@ -496,7 +496,7 @@ signum (T x) { // With modest optimizations, this will compile without a jump. - return ((x > 0) ? 1 : 0) - signbit (x); + return ((x > 0) ? 1 : 0) - __signbit (x); } // FIXME -- we do not have an authority what signed shifts should @@ -544,7 +544,7 @@ T ux = u ^ x, uy = u ^ y; if ((ux & uy) < 0) { - u = octave_int_base<T>::max_val () + signbit (~u); + u = octave_int_base<T>::max_val () + __signbit (~u); } return u; #else @@ -585,7 +585,7 @@ T ux = u ^ x, uy = u ^ ~y; if ((ux & uy) < 0) { - u = octave_int_base<T>::max_val () + signbit (~u); + u = octave_int_base<T>::max_val () + __signbit (~u); } return u; #else @@ -651,7 +651,7 @@ z = x / y; T w = -octave_int_abs (x % y); // Can't overflow, but std::abs (x) can! if (w <= y - w) - z -= 1 - (signbit (x) << 1); + z -= 1 - (__signbit (x) << 1); } } else @@ -663,7 +663,7 @@ T w = octave_int_abs (x % y); if (w >= y - w) - z += 1 - (signbit (x) << 1); + z += 1 - (__signbit (x) << 1); } return z; } @@ -874,6 +874,17 @@ template <class T> extern OCTAVE_API octave_int<T> +pow (const float& a, const octave_int<T>& b); + +template <class T> +extern OCTAVE_API octave_int<T> +pow (const octave_int<T>& a, const float& b); + +// FIXME: Do we really need a differently named single-precision +// function integer power function here instead of an overloaded +// one? +template <class T> +extern OCTAVE_API octave_int<T> powf (const float& a, const octave_int<T>& b); template <class T>
--- a/liboctave/oct-locbuf.cc +++ b/liboctave/oct-locbuf.cc @@ -25,44 +25,55 @@ #endif #include <iostream> + +#include "lo-error.h" #include "oct-locbuf.h" -// Query for configured chunk size, and if not defined, set it to 32 MB. -// FIXME: 32MB is hard-coded. Maybe we could use something better, like -// querying for available physical memory. +// FIXME -- Maybe we should querying for available physical memory? + #ifndef OCTAVE_LOCBUF_CHUNKSIZE_MB #define OCTAVE_LOCBUF_CHUNKSIZE_MB 32 #endif // Each chunk will be at least this big. + const size_t octave_chunk_buffer::chunk_size = static_cast<size_t> (OCTAVE_LOCBUF_CHUNKSIZE_MB) << 20; -char *octave_chunk_buffer::top = 0, *octave_chunk_buffer::chunk = 0; +char *octave_chunk_buffer::top = 0; +char *octave_chunk_buffer::chunk = 0; size_t octave_chunk_buffer::left = 0; +size_t octave_chunk_buffer::active = 0; octave_chunk_buffer::octave_chunk_buffer (size_t size) : cnk (0), dat (0) { - // Alignment mask. The size of double or long int, whichever is greater. - // All data will be aligned to this size. If it's not enough for a type, - // that type should not be declared as POD. + // Alignment mask. The size of double or long int, whichever is + // greater. All data will be aligned to this size. If it's not + // enough for a type, that type should not be declared as POD. + static const size_t align_mask = (sizeof (long) < sizeof (double) ? sizeof (double) : sizeof (long)) - 1; - if (! size) return; + active++; + + if (! size) + return; + // Align size. Note that size_t is unsigned, so size-1 must correctly // wrap around. + size = ((size - 1) | align_mask) + 1; if (size > left) { // Big buffers (> 1/8 chunk) will be allocated as stand-alone and // won't disrupt the chain. + if (size > chunk_size >> 3) { - // Use new [] to get std::bad_alloc if out of memory. Could as - // well be std::malloc and handle that ourselves. + // Use new [] to get std::bad_alloc if out of memory. + dat = new char [size]; return; } @@ -73,6 +84,7 @@ } // Now allocate memory from the chunk and update state. + cnk = chunk; dat = top; left -= size; @@ -81,24 +93,55 @@ octave_chunk_buffer::~octave_chunk_buffer (void) { + active--; + if (cnk == chunk) { - // Our chunk is still the active one. Just restore the state. + // Our chunk is still the active one. Just restore the state. + left += top - dat; top = dat; } - else if (! cnk) + else { - // We were a stand-alone buffer. - delete [] dat; + if (cnk) + { + // Responsible for deletion. + + delete [] chunk; + chunk = cnk; + top = dat; + + // FIXME -- the following calcuation of remaining data will + // only work if each chunk has the same chunk_size. + + left = chunk_size - (dat - cnk); + } + else + { + // We were a stand-alone buffer. + + delete [] dat; + } + } +} + +// Clear the final chunk of allocated memory. + +void +octave_chunk_buffer::clear (void) +{ + if (active == 0) + { + delete [] chunk; + chunk = 0; + top = 0; + left = 0; } else { - // Responsible for deletion. - delete [] chunk; - chunk = cnk; - top = dat; - // FIXME: This will only work if chunk_size is constant. - left = chunk_size - (dat - cnk); + (*current_liboctave_warning_handler) + ("octave_chunk_buffer::clear: %d active allocations remain!", + active); } }
--- a/liboctave/oct-locbuf.h +++ b/liboctave/oct-locbuf.h @@ -26,8 +26,9 @@ #include <cstddef> #include "oct-cmplx.h" -// The default local buffer simply encapsulates an *array* pointer that gets -// delete[]d automatically. For common POD types, we provide specializations. +// The default local buffer simply encapsulates an *array* pointer +// that gets deleted automatically. For common POD types, we provide +// specializations. template <class T> class octave_local_buffer @@ -50,16 +51,17 @@ octave_local_buffer& operator = (const octave_local_buffer&); }; -// For buffers of POD types, we'll be more smart. There is one thing that -// differentiates a local buffer from a dynamic array - the local buffers, if -// not manipulated improperly, have a FIFO semantics, meaning that if buffer B -// is allocated after buffer A, B *must* be deallocated before A. This is -// *guaranteed* if you use local buffer exclusively through the -// OCTAVE_LOCAL_BUFFER macro, because the C++ standard *mandates* explicit -// local objects be destroyed in reverse order of declaration. -// Therefore, we can avoid memory fragmentation by allocating fairly large -// chunks of memory and serving local buffers from them in a stack-like manner. -// The first returning buffer in previous chunk will be responsible for +// For buffers of POD types, we'll be smarter. There is one thing +// that differentiates a local buffer from a dynamic array - the local +// buffers, if not manipulated improperly, have a FIFO semantics, +// meaning that if buffer B is allocated after buffer A, B *must* be +// deallocated before A. This is *guaranteed* if you use local buffer +// exclusively through the OCTAVE_LOCAL_BUFFER macro, because the C++ +// standard requires that explicit local objects be destroyed in +// reverse order of declaration. Therefore, we can avoid memory +// fragmentation by allocating fairly large chunks of memory and +// serving local buffers from them in a stack-like manner. The first +// returning buffer in previous chunk will be responsible for // deallocating the chunk. class octave_chunk_buffer @@ -72,13 +74,30 @@ char *data (void) const { return dat; } + static OCTAVE_API void clear (void); + private: + + // The number of bytes we allocate for each large chunk of memory we + // manage. static const size_t chunk_size; - static char *top, *chunk; + // Pointer to the end end of the last allocation. + static char *top; + + // Pointer to the current active chunk. + static char *chunk; + + // The number of bytes remaining in the active chunk. static size_t left; + // The number of active allocations. + static size_t active; + + // Pointer to the current chunk. char *cnk; + + // Pointer to the beginning of the most recent allocation. char *dat; // No copying! @@ -86,8 +105,8 @@ octave_chunk_buffer& operator = (const octave_chunk_buffer&); }; -// This specializes octave_local_buffer to use the chunked buffer mechanism -// for POD types. +// This specializes octave_local_buffer to use the chunked buffer +// mechanism for POD types. #define SPECIALIZE_POD_BUFFER(TYPE) \ template <> \ class octave_local_buffer<TYPE> : private octave_chunk_buffer \ @@ -143,32 +162,37 @@ } }; -// If the compiler supports dynamic stack arrays, we can use the attached hack -// to place small buffer arrays on the stack. It may be even faster than our -// obstack-like optimization, but is dangerous because stack is a very limited -// resource, so we disable it. -#if 0 //defined (HAVE_DYNAMIC_AUTO_ARRAYS) +// If the compiler supports dynamic stack arrays, we can use the +// attached hack to place small buffer arrays on the stack. It may be +// even faster than our obstack-like optimization, but is dangerous +// because stack is a very limited resource, so we disable it. + +#if 0 // defined (HAVE_DYNAMIC_AUTO_ARRAYS) // Maximum buffer size (in bytes) to be placed on the stack. #define OCTAVE_LOCAL_BUFFER_MAX_STACK_SIZE 8192 -// If we have automatic arrays, we use an automatic array if the size is small -// enough. To avoid possibly evaluating `size' multiple times, we first cache -// it. Note that we always construct both the stack array and the -// octave_local_buffer object, but only one of them will be nonempty. +// If we have automatic arrays, we use an automatic array if the size +// is small enough. To avoid possibly evaluating `size' multiple +// times, we first cache it. Note that we always construct both the +// stack array and the octave_local_buffer object, but only one of +// them will be nonempty. #define OCTAVE_LOCAL_BUFFER(T, buf, size) \ const size_t _bufsize_ ## buf = size; \ const bool _lbufaut_ ## buf = _bufsize_ ## buf * sizeof (T) \ <= OCTAVE_LOCAL_BUFFER_MAX_STACK_SIZE; \ T _bufaut_ ## buf [_lbufaut_ ## buf ? _bufsize_ ## buf : 0]; \ - octave_local_buffer<T> _bufheap_ ## buf (!_lbufaut_ ## buf ? _bufsize_ ## buf : 0); \ - T *buf = _lbufaut_ ## buf ? _bufaut_ ## buf : static_cast<T *> (_bufheap_ ## buf) + octave_local_buffer<T> _bufheap_ ## buf \ + (!_lbufaut_ ## buf ? _bufsize_ ## buf : 0); \ + T *buf = _lbufaut_ ## buf \ + ? _bufaut_ ## buf : static_cast<T *> (_bufheap_ ## buf) #else -// If we don't have automatic arrays, we simply always use octave_local_buffer. +// If we don't have automatic arrays, we simply always use +// octave_local_buffer. #define OCTAVE_LOCAL_BUFFER(T, buf, size) \ octave_local_buffer<T> _buffer_ ## buf (size); \ @@ -176,13 +200,14 @@ #endif -// Yeah overloading macros would be nice. -// Note: we use weird variables in the for loop to avoid warnings about -// shadowed parameters. +// Note: we use weird variables in the for loop to avoid warnings +// about shadowed parameters. + #define OCTAVE_LOCAL_BUFFER_INIT(T, buf, size, value) \ OCTAVE_LOCAL_BUFFER(T, buf, size); \ for (size_t _buf_iter = 0, _buf_size = size; \ - _buf_iter < _buf_size; _buf_iter++) buf[_buf_iter] = value + _buf_iter < _buf_size; _buf_iter++) \ + buf[_buf_iter] = value #endif
--- a/liboctave/oct-mutex.cc +++ b/liboctave/oct-mutex.cc @@ -45,6 +45,14 @@ (*current_liboctave_error_handler) ("mutex not supported on this platform"); } +bool +octave_base_mutex::try_lock (void) +{ + (*current_liboctave_error_handler) ("mutex not supported on this platform"); + + return false; +} + #if defined (__WIN32__) && ! defined (__CYGWIN__) class @@ -72,10 +80,29 @@ LeaveCriticalSection (&cs); } + bool try_lock (void) + { + return (TryEnterCriticalSection (&cs) != 0); + } + private: CRITICAL_SECTION cs; }; +static DWORD octave_thread_id = 0; + +void +octave_thread::init (void) +{ + octave_thread_id = GetCurrentThreadId (); +} + +bool +octave_thread::is_octave_thread (void) +{ + return (GetCurrentThreadId () == octave_thread_id); +} + #elif defined (HAVE_PTHREAD_H) class @@ -108,10 +135,29 @@ pthread_mutex_unlock (&pm); } + bool try_lock (void) + { + return (pthread_mutex_trylock (&pm) == 0); + } + private: pthread_mutex_t pm; }; +static pthread_t octave_thread_id = 0; + +void +octave_thread::init (void) +{ + octave_thread_id = pthread_self (); +} + +bool +octave_thread::is_octave_thread (void) +{ + return (pthread_equal (octave_thread_id, pthread_self ()) != 0); +} + #endif static octave_base_mutex *
--- a/liboctave/oct-mutex.h +++ b/liboctave/oct-mutex.h @@ -23,6 +23,8 @@ #if !defined (octave_octave_mutex_h) #define octave_octave_mutex_h 1 +#include "oct-refcount.h" + class octave_mutex; class @@ -39,8 +41,10 @@ virtual void unlock (void); + virtual bool try_lock (void); + private: - int count; + octave_refcount<int> count; }; class @@ -86,6 +90,11 @@ rep->unlock (); } + bool try_lock (void) + { + return rep->try_lock (); + } + protected: octave_base_mutex *rep; }; @@ -94,17 +103,28 @@ octave_autolock { public: - octave_autolock (const octave_mutex& m) - : mutex (m) + octave_autolock (const octave_mutex& m, bool block = true) + : mutex (m), lock_result (false) { - mutex.lock (); + if (block) + { + mutex.lock (); + lock_result = true; + } + else + lock_result = mutex.try_lock (); } ~octave_autolock (void) { - mutex.unlock (); + if (lock_result) + mutex.unlock (); } + bool ok (void) const { return lock_result; } + + operator bool (void) const { return ok (); } + private: // No copying or default constructor! @@ -114,6 +134,17 @@ private: octave_mutex mutex; + bool lock_result; +}; + +class +OCTAVE_API +octave_thread +{ +public: + static void init (void); + + static bool is_octave_thread (void); }; #endif
--- a/liboctave/oct-norm.cc +++ b/liboctave/oct-norm.cc @@ -57,9 +57,10 @@ #include "floatSVD.h" #include "fCmplxSVD.h" -// Theory: norm accumulator is an object that has an accum method able to handle -// both real and complex element, and a cast operator returning the intermediate -// norm. +// Theory: norm accumulator is an object that has an accum method able +// to handle both real and complex element, and a cast operator +// returning the intermediate norm. Reference: Higham, N. "Estimating +// the Matrix p-Norm." Numer. Math. 62, 539-555, 1992. // norm accumulator for the p-norm template <class R>
--- a/liboctave/oct-rand.cc +++ b/liboctave/oct-rand.cc @@ -29,18 +29,19 @@ #include <stdint.h> +#include "data-conv.h" #include "f77-fcn.h" +#include "lo-error.h" #include "lo-ieee.h" -#include "lo-error.h" #include "lo-mappers.h" +#include "mach-info.h" +#include "oct-locbuf.h" #include "oct-rand.h" #include "oct-time.h" -#include "data-conv.h" +#include "randgamma.h" #include "randmtzig.h" #include "randpoisson.h" -#include "randgamma.h" -#include "mach-info.h" -#include "oct-locbuf.h" +#include "singleton-cleanup.h" extern "C" { @@ -89,7 +90,12 @@ bool retval = true; if (! instance) - instance = new octave_rand (); + { + instance = new octave_rand (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) {
--- a/liboctave/oct-rand.h +++ b/liboctave/oct-rand.h @@ -160,6 +160,8 @@ static octave_rand *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + enum { unknown_dist,
--- a/liboctave/oct-refcount.h +++ b/liboctave/oct-refcount.h @@ -23,6 +23,30 @@ #if !defined (octave_refcount_h) #define octave_refcount_h 1 +#ifndef OCTAVE_CONFIG_INCLUDED +# error "The file <octave/config.h> must be included before oct-refcount.h." +#endif + +#if defined (USE_ATOMIC_REFCOUNT) && (defined (_MSC_VER) || defined (__GNUC__)) +# if defined (_MSC_VER) +# include <intrin.h> +# define OCTREFCOUNT_ATOMIC_INCREMENT(x) _InterlockedIncrement((long*)x) +# define OCTREFCOUNT_ATOMIC_DECREMENT(x) _InterlockedDecrement((long*)x) +# define OCTREFCOUNT_ATOMIC_INCREMENT_POST(x) _InterlockedExchangeAdd((long*)x, 1) +# define OCTREFCOUNT_ATOMIC_DECREMENT_POST(x) _InterlockedExchangeAdd((long*)x, -1) +# elif defined (__GNUC__) +# define OCTREFCOUNT_ATOMIC_INCREMENT(x) __sync_add_and_fetch(x, 1) +# define OCTREFCOUNT_ATOMIC_DECREMENT(x) __sync_add_and_fetch(x, -1) +# define OCTREFCOUNT_ATOMIC_INCREMENT_POST(x) __sync_fetch_and_add(x, 1) +# define OCTREFCOUNT_ATOMIC_DECREMENT_POST(x) __sync_fetch_and_add(x, -1) +# endif +#else // Generic non-locking versions +# define OCTREFCOUNT_ATOMIC_INCREMENT(x) ++(*(x)) +# define OCTREFCOUNT_ATOMIC_DECREMENT(x) --(*(x)) +# define OCTREFCOUNT_ATOMIC_INCREMENT_POST(x) (*(x))++ +# define OCTREFCOUNT_ATOMIC_DECREMENT_POST(x) (*(x))-- +#endif + // Encapsulates a reference counter. template <class T> class octave_refcount @@ -35,28 +59,28 @@ // Increment/Decrement. int is postfix. count_type operator++(void) { - return ++count; + return OCTREFCOUNT_ATOMIC_INCREMENT (&count); } count_type operator++(int) { - return count++; + return OCTREFCOUNT_ATOMIC_INCREMENT_POST (&count); } count_type operator--(void) { - return --count; + return OCTREFCOUNT_ATOMIC_DECREMENT (&count); } count_type operator--(int) { - return count--; + return OCTREFCOUNT_ATOMIC_DECREMENT_POST (&count); } - operator count_type (void) const { return count; } - - // For low-level optimizations only. - count_type& direct (void) const { return count; } + operator count_type (void) const + { + return static_cast<count_type const volatile&> (count); + } private: count_type count;
--- a/liboctave/oct-sort.cc +++ b/liboctave/oct-sort.cc @@ -1003,7 +1003,7 @@ octave_idx_type *idest; int result = -1; /* guilty until proved innocent */ T *basea, *baseb; - octave_idx_type *ibasea, *ibaseb; + octave_idx_type *ibaseb; octave_idx_type min_gallop = ms->min_gallop; ms->getmemi (nb); @@ -1012,7 +1012,7 @@ idest = ipb + nb - 1; std::copy (pb, pb + nb, ms->a); std::copy (ipb, ipb + nb, ms->ia); - basea = pa; ibasea = ipa; + basea = pa; baseb = ms->a; ibaseb = ms->ia; pb = ms->a + nb - 1; ipb = ms->ia + nb - 1; pa += na - 1; ipa += na - 1;
--- a/liboctave/oct-spparms.cc +++ b/liboctave/oct-spparms.cc @@ -29,6 +29,7 @@ #include "lo-ieee.h" #include "oct-spparms.h" +#include "singleton-cleanup.h" octave_sparse_params *octave_sparse_params::instance = 0; @@ -38,7 +39,12 @@ bool retval = true; if (! instance) - instance = new octave_sparse_params (); + { + instance = new octave_sparse_params (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) {
--- a/liboctave/oct-spparms.h +++ b/liboctave/oct-spparms.h @@ -95,6 +95,8 @@ static octave_sparse_params *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + void do_defaults (void); void do_tight (void);
--- a/liboctave/oct-time.cc +++ b/liboctave/oct-time.cc @@ -36,6 +36,7 @@ #include "lo-error.h" #include "lo-math.h" #include "lo-utils.h" +#include "oct-locbuf.h" #include "oct-time.h" octave_time::octave_time (const octave_base_tm& tm) @@ -53,6 +54,10 @@ t.tm_yday = tm.yday (); t.tm_isdst = tm.isdst (); +#if defined (HAVE_STRUCT_TM_GMTOFF) + t.tm_gmtoff = tm.gmtoff (); +#endif + #if defined (HAVE_STRUCT_TM_TM_ZONE) std::string s = tm.zone (); char *ps = strsave (s.c_str ()); @@ -98,29 +103,17 @@ // // So, we no longer check limits here. -#if 0 -#define DEFINE_SET_INT_FIELD_FCN(f, lo, hi) \ +#define DEFINE_SET_FIELD_FCN(type, f, lo, hi) \ octave_base_tm& \ - octave_base_tm::f (int v) \ - { \ - if (v < lo || v > hi) \ - (*current_liboctave_error_handler) \ - ("invalid value specified for " #f); \ - \ - tm_ ## f = v; \ - \ - return *this; \ - } -#else -#define DEFINE_SET_INT_FIELD_FCN(f, lo, hi) \ - octave_base_tm& \ - octave_base_tm::f (int v) \ + octave_base_tm::f (type v) \ { \ tm_ ## f = v; \ \ return *this; \ } -#endif + +#define DEFINE_SET_INT_FIELD_FCN(f, lo, hi) \ + DEFINE_SET_FIELD_FCN (int, f, lo, hi) DEFINE_SET_INT_FIELD_FCN (usec, 0, 1000000) DEFINE_SET_INT_FIELD_FCN (sec, 0, 61) @@ -132,6 +125,7 @@ DEFINE_SET_INT_FIELD_FCN (wday, 0, 6) DEFINE_SET_INT_FIELD_FCN (yday, 0, 365) DEFINE_SET_INT_FIELD_FCN (isdst, 0, 1) +DEFINE_SET_FIELD_FCN (long, gmtoff, -86400, 0) octave_base_tm& octave_base_tm::zone (const std::string& s) @@ -163,6 +157,10 @@ t.tm_yday = tm_yday; t.tm_isdst = tm_isdst; +#if defined (HAVE_STRUCT_TM_GMTOFF) + t.tm_gmtoff = tm_gmtoff; +#endif + #if defined (HAVE_STRUCT_TM_TM_ZONE) char *ps = strsave (tm_zone.c_str ()); t.tm_zone = ps; @@ -215,6 +213,10 @@ tm_yday = t->tm_yday; tm_isdst = t->tm_isdst; +#if defined (HAVE_STRUCT_TM_GMTOFF) + tm_gmtoff = t->tm_gmtoff; +#endif + #if defined (HAVE_STRUCT_TM_TM_ZONE) if (t->tm_zone) tm_zone = t->tm_zone; @@ -259,12 +261,16 @@ t.tm_yday = 0; t.tm_isdst = 0; +#if defined (HAVE_STRUCT_TM_GMTOFF) + t.tm_gmtoff = 0; +#endif + #if defined (HAVE_STRUCT_TM_TM_ZONE) char *ps = strsave (""); t.tm_zone = ps; #endif - char *p = strsave (str.c_str ()); + const char *p = str.c_str (); char *q = gnulib::strptime (p, fmt.c_str (), &t); @@ -287,8 +293,6 @@ else nchars = 0; - delete [] p; - octave_base_tm::init (&t); #if defined (HAVE_STRUCT_TM_TM_ZONE)
--- a/liboctave/oct-time.h +++ b/liboctave/oct-time.h @@ -174,14 +174,14 @@ octave_base_tm (void) : tm_usec (0), tm_sec (0), tm_min (0), tm_hour (0), tm_mday (0), tm_mon (0), tm_year (0), tm_wday (0), - tm_yday (0), tm_isdst (0), tm_zone ("unknown") + tm_yday (0), tm_isdst (0), tm_gmtoff (0), tm_zone ("unknown") { } octave_base_tm (const octave_base_tm& tm) : tm_usec (tm.tm_usec), tm_sec (tm.tm_sec), tm_min (tm.tm_min), tm_hour (tm.tm_hour), tm_mday (tm.tm_mday), tm_mon (tm.tm_mon), tm_year (tm.tm_year), tm_wday (tm.tm_wday), tm_yday (tm.tm_yday), - tm_isdst (tm.tm_isdst), tm_zone (tm.tm_zone) + tm_isdst (tm.tm_isdst), tm_gmtoff (tm.tm_gmtoff), tm_zone (tm.tm_zone) { } octave_base_tm& operator = (const octave_base_tm& tm) @@ -198,6 +198,7 @@ tm_wday = tm.tm_wday; tm_yday = tm.tm_yday; tm_isdst = tm.tm_isdst; + tm_gmtoff = tm.tm_gmtoff; tm_zone = tm.tm_zone; } @@ -216,6 +217,7 @@ int wday (void) const { return tm_wday; } int yday (void) const { return tm_yday; } int isdst (void) const { return tm_isdst; } + long gmtoff (void) const { return tm_gmtoff; } std::string zone (void) const { return tm_zone; } octave_base_tm& usec (int v); @@ -228,6 +230,7 @@ octave_base_tm& wday (int v); octave_base_tm& yday (int v); octave_base_tm& isdst (int v); + octave_base_tm& gmtoff (long v); octave_base_tm& zone (const std::string& s); std::string strftime (const std::string& fmt) const; @@ -268,6 +271,9 @@ int tm_isdst; // Time zone. + long tm_gmtoff; + + // Time zone. std::string tm_zone; void init (void *p);
--- a/liboctave/pathsearch.cc +++ b/liboctave/pathsearch.cc @@ -31,7 +31,7 @@ #include "lo-utils.h" #include "oct-env.h" #include "pathsearch.h" -#include "str-vec.h" +#include "singleton-cleanup.h" #include "str-vec.h" #include "kpse.cc" @@ -47,7 +47,12 @@ bool retval = true; if (! instance) - instance = new static_members (); + { + instance = new static_members (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) {
--- a/liboctave/pathsearch.h +++ b/liboctave/pathsearch.h @@ -153,6 +153,8 @@ static static_members *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + static bool instance_ok (void); // No copying!
--- a/liboctave/randgamma.h +++ b/liboctave/randgamma.h @@ -29,8 +29,8 @@ extern "C" { #endif -extern double oct_randg (double a); -extern void oct_fill_randg (double a, octave_idx_type n, double *p); +extern OCTAVE_API double oct_randg (double a); +extern OCTAVE_API void oct_fill_randg (double a, octave_idx_type n, double *p); #ifdef __cplusplus }
--- a/liboctave/randmtzig.h +++ b/liboctave/randmtzig.h @@ -71,21 +71,21 @@ #endif /* === Mersenne Twister === */ -extern void oct_init_by_int (uint32_t s); -extern void oct_init_by_array (uint32_t init_key[], int key_length); -extern void oct_init_by_entropy (void); -extern void oct_set_state (uint32_t save[]); -extern void oct_get_state (uint32_t save[]); +extern OCTAVE_API void oct_init_by_int (uint32_t s); +extern OCTAVE_API void oct_init_by_array (uint32_t init_key[], int key_length); +extern OCTAVE_API void oct_init_by_entropy (void); +extern OCTAVE_API void oct_set_state (uint32_t save[]); +extern OCTAVE_API void oct_get_state (uint32_t save[]); /* === Array generators === */ -extern double oct_randu (void); -extern double oct_randn (void); -extern double oct_rande (void); +extern OCTAVE_API double oct_randu (void); +extern OCTAVE_API double oct_randn (void); +extern OCTAVE_API double oct_rande (void); /* === Array generators === */ -extern void oct_fill_randu (octave_idx_type n, double *p); -extern void oct_fill_randn (octave_idx_type n, double *p); -extern void oct_fill_rande (octave_idx_type n, double *p); +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); #ifdef __cplusplus }
--- a/liboctave/randpoisson.h +++ b/liboctave/randpoisson.h @@ -29,8 +29,8 @@ extern "C" { #endif -extern double oct_randp (double L); -extern void oct_fill_randp (double L, octave_idx_type n, double *p); +extern OCTAVE_API double oct_randp (double L); +extern OCTAVE_API void oct_fill_randp (double L, octave_idx_type n, double *p); #ifdef __cplusplus }
rename from liboctave/regex-match.cc rename to liboctave/regexp.cc --- a/liboctave/regex-match.cc +++ b/liboctave/regexp.cc @@ -1,6 +1,8 @@ /* -Copyright (C) 2008-2011 David Bateman +Copyright (C) 2011 John W. Eaton +Copyright (C) 2005-2011 David Bateman +Copyright (C) 2002-2005 Paul Kienzle This file is part of Octave. @@ -24,126 +26,554 @@ #include <config.h> #endif +#include <list> +#include <sstream> +#include <string> #include <vector> -#include <iostream> -#include <string> -#include "regex-match.h" -#include "str-vec.h" -#include "oct-locbuf.h" +#if defined (HAVE_PCRE_H) +#include <pcre.h> +#elif defined (HAVE_PCRE_PCRE_H) +#include <pcre/pcre.h> +#endif -regex_match& -regex_match::operator = (const regex_match& gm) -{ - if (this != &gm) - { -#if HAVE_REGEX - for (int i = 0; i < pat.length (); i++) - regfree (compiled +i); - delete [] compiled; -#endif - pat = gm.pat; - case_insen = gm.case_insen; - init (); - } - return *this; -} +#include "Matrix.h" +#include "base-list.h" +#include "lo-error.h" +#include "oct-locbuf.h" +#include "quit.h" +#include "regexp.h" +#include "str-vec.h" -regex_match::~regex_match (void) -{ -#if HAVE_REGEX - for (int i = 0; i < pat.length (); i++) - regfree (compiled +i); - delete [] compiled; -#endif -} +// Define the maximum number of retries for a pattern that possibly +// results in an infinite recursion. +#define PCRE_MATCHLIMIT_MAX 10 +// FIXME -- should this be configurable? +#define MAXLOOKBEHIND 10 + +static bool lookbehind_warned = false; + +// FIXME -- don't bother collecting and composing return values the user +// doesn't want. void -regex_match::set_pattern (const std::string& p) +regexp::free (void) { -#if HAVE_REGEX - for (int i = 0; i < pat.length (); i++) - regfree (compiled +i); - delete [] compiled; -#endif - pat = p; - init (); -} - -void -regex_match::set_pattern (const string_vector& p) -{ -#if HAVE_REGEX - for (int i = 0; i < pat.length (); i++) - regfree (compiled +i); - delete [] compiled; -#endif - pat = p; - init (); + if (data) + pcre_free (static_cast<pcre *> (data)); } void -regex_match::init (void) +regexp::compile_internal (void) { -#ifdef HAVE_REGEX - int npat = pat.length (); - int err = 0; - int i; + // If we had a previously compiled pattern, release it. + free (); + + size_t max_length = MAXLOOKBEHIND; + + size_t pos = 0; + size_t new_pos; + int inames = 0; + std::ostringstream buf; + + while ((new_pos = pattern.find ("(?", pos)) != std::string::npos) + { + if (pattern.at (new_pos + 2) == '<' + && !(pattern.at (new_pos + 3) == '=' + || pattern.at (new_pos + 3) == '!')) + { + // The syntax of named tokens in pcre is "(?P<name>...)" while + // we need a syntax "(?<name>...)", so fix that here. Also an + // expression like + // "(?<first>\w+)\s+(?<last>\w+)|(?<last>\w+),\s+(?<first>\w+)" + // should be perfectly legal, while pcre does not allow the same + // named token name on both sides of the alternative. Also fix + // that here by replacing name tokens by dummy names, and dealing + // with the dummy names later. + + size_t tmp_pos = pattern.find_first_of ('>', new_pos); + + if (tmp_pos == std::string::npos) + { + (*current_liboctave_error_handler) + ("regexp: syntax error in pattern"); + return; + } + + std::string tmp_name = + pattern.substr (new_pos+3, tmp_pos-new_pos-3); + + bool found = false; + + for (int i = 0; i < nnames; i++) + { + if (named_pats(i) == tmp_name) + { + named_idx.resize (dim_vector (inames+1, 1)); + named_idx(inames) = i; + found = true; + break; + } + } + + if (! found) + { + named_idx.resize (dim_vector (inames+1, 1)); + named_idx(inames) = nnames; + named_pats.append (tmp_name); + nnames++; + } + + if (new_pos - pos > 0) + buf << pattern.substr (pos, new_pos-pos); + if (inames < 10) + buf << "(?P<n00" << inames++; + else if (inames < 100) + buf << "(?P<n0" << inames++; + else + buf << "(?P<n" << inames++; - compiled = new regex_t [npat]; + pos = tmp_pos; + } + else if (pattern.at (new_pos + 2) == '<') + { + // Find lookbehind operators of arbitrary length (ie like + // "(?<=[a-z]*)") and replace with a maximum length operator + // as PCRE can not yet handle arbitrary length lookahead + // operators. Use the string length as the maximum length to + // avoid issues. + + int brackets = 1; + size_t tmp_pos1 = new_pos + 2; + size_t tmp_pos2 = tmp_pos1; + + while (tmp_pos1 <= pattern.length () && brackets > 0) + { + char ch = pattern.at (tmp_pos1); + + if (ch == '(') + brackets++; + else if (ch == ')') + { + if (brackets > 1) + tmp_pos2 = tmp_pos1; + + brackets--; + } + + tmp_pos1++; + } + + if (brackets != 0) + { + buf << pattern.substr (pos, new_pos - pos) << "(?"; + pos = new_pos + 2; + } + else + { + size_t tmp_pos3 = pattern.find_first_of ("*+", tmp_pos2); - for (i = 0; i < npat; i++) - { - err = regcomp (compiled + i, pat(i).c_str (), - (REG_NOSUB | REG_EXTENDED | - (case_insen ? REG_ICASE : 0))); - if (err) - break; + if (tmp_pos3 != std::string::npos && tmp_pos3 < tmp_pos1) + { + if (!lookbehind_warned) + { + lookbehind_warned = true; + (*current_liboctave_warning_handler) + ("%s: arbitrary length lookbehind patterns are only supported up to length %d", + who.c_str (), MAXLOOKBEHIND); + } + + buf << pattern.substr (pos, new_pos - pos) << "("; + + size_t i; + + if (pattern.at (tmp_pos3) == '*') + i = 0; + else + i = 1; + + for (; i < max_length + 1; i++) + { + buf << pattern.substr (new_pos, tmp_pos3 - new_pos) + << "{" << i << "}"; + buf << pattern.substr (tmp_pos3 + 1, + tmp_pos1 - tmp_pos3 - 1); + if (i != max_length) + buf << "|"; + } + buf << ")"; + } + else + buf << pattern.substr (pos, tmp_pos1 - pos); + + pos = tmp_pos1; + } + } + else + { + buf << pattern.substr (pos, new_pos - pos) << "(?"; + pos = new_pos + 2; + } + } - if (err) + buf << pattern.substr (pos); + + const char *err; + int erroffset; + std::string buf_str = buf.str (); + + int pcre_options + = ((options.case_insensitive () ? PCRE_CASELESS : 0) + | (options.dotexceptnewline () ? 0 : PCRE_DOTALL) + | (options.lineanchors () ? PCRE_MULTILINE : 0) + | (options.freespacing () ? PCRE_EXTENDED : 0)); + + data = pcre_compile (buf_str.c_str (), pcre_options, &err, &erroffset, 0); + + if (! data) + (*current_liboctave_error_handler) + ("%s: %s at position %d of expression", who.c_str (), + err, erroffset); +} + +regexp::match_data +regexp::match (const std::string& buffer) +{ + regexp::match_data retval; + + std::list<regexp::match_element> lst; + + int subpatterns; + int namecount; + int nameentrysize; + char *nametable; + size_t idx = 0; + + pcre *re = static_cast <pcre *> (data); + + pcre_fullinfo (re, 0, PCRE_INFO_CAPTURECOUNT, &subpatterns); + pcre_fullinfo (re, 0, PCRE_INFO_NAMECOUNT, &namecount); + pcre_fullinfo (re, 0, PCRE_INFO_NAMEENTRYSIZE, &nameentrysize); + pcre_fullinfo (re, 0, PCRE_INFO_NAMETABLE, &nametable); + + OCTAVE_LOCAL_BUFFER (int, ovector, (subpatterns+1)*3); + OCTAVE_LOCAL_BUFFER (int, nidx, namecount); + + for (int i = 0; i < namecount; i++) { - int len = regerror (err, compiled + i, 0, 0); - OCTAVE_LOCAL_BUFFER (char, errmsg, len); - regerror(err, compiled + i, errmsg, len); - (*current_liboctave_error_handler) ("%s in pattern (%s)", errmsg, - pat(i).c_str()); + // Index of subpattern in first two bytes MSB first of name. + // Extract index. + nidx[i] = (static_cast<int> (nametable[i*nameentrysize])) << 8 + | static_cast<int> (nametable[i*nameentrysize+1]); + } + + while (true) + { + OCTAVE_QUIT; + + int matches = pcre_exec (re, 0, buffer.c_str (), + buffer.length (), idx, + (idx ? PCRE_NOTBOL : 0), + ovector, (subpatterns+1)*3); + + if (matches == PCRE_ERROR_MATCHLIMIT) + { + // Try harder; start with default value for MATCH_LIMIT + // and increase it. + (*current_liboctave_warning_handler) + ("your pattern caused PCRE to hit its MATCH_LIMIT; trying harder now, but this will be slow"); + + pcre_extra pe; + + pcre_config (PCRE_CONFIG_MATCH_LIMIT, + static_cast <void *> (&pe.match_limit)); + + pe.flags = PCRE_EXTRA_MATCH_LIMIT; + + int i = 0; + while (matches == PCRE_ERROR_MATCHLIMIT + && i++ < PCRE_MATCHLIMIT_MAX) + { + OCTAVE_QUIT; + + pe.match_limit *= 10; + matches = pcre_exec (re, &pe, buffer.c_str (), + buffer.length (), idx, + (idx ? PCRE_NOTBOL : 0), + ovector, (subpatterns+1)*3); + } + } - for (int j = 0; j < i + 1; j++) - regfree (compiled + j); + if (matches < 0 && matches != PCRE_ERROR_NOMATCH) + { + (*current_liboctave_error_handler) + ("%s: internal error calling pcre_exec; error code from pcre_exec is %i", + who.c_str (), matches); + return retval; + } + else if (matches == PCRE_ERROR_NOMATCH) + break; + else if (ovector[1] <= ovector[0]) + { + // Zero sized match. Skip to next char. + idx = ovector[0] + 1; + if (idx < buffer.length ()) + continue; + else + break; + } + else + { + int pos_match = 0; + Matrix token_extents (matches-1, 2); + + for (int i = 1; i < matches; i++) + { + if (ovector[2*i] >= 0 && ovector[2*i+1] > 0 + && (i == 1 || ovector[2*i] != ovector[2*i-2] + || ovector[2*i-1] != ovector[2*i+1]) + && ovector[2*i] >= 0 && ovector[2*i+1] > 0) + { + token_extents(pos_match,0) = double (ovector[2*i]+1); + token_extents(pos_match++,1) = double (ovector[2*i+1]); + } + } + + token_extents.resize (pos_match, 2); + + double start = double (ovector[0]+1); + double end = double (ovector[1]); + + const char **listptr; + int status = pcre_get_substring_list (buffer.c_str (), ovector, + matches, &listptr); + + if (status == PCRE_ERROR_NOMEMORY) + { + (*current_liboctave_error_handler) + ("%s: cannot allocate memory in pcre_get_substring_list", + who.c_str ()); + return retval; + } + + string_vector tokens (pos_match); + string_vector named_tokens (nnames); + int pos_offset = 0; + pos_match = 0; + + for (int i = 1; i < matches; i++) + { + if (ovector[2*i] >= 0 && ovector[2*i+1] > 0) + { + if (i == 1 || ovector[2*i] != ovector[2*i-2] + || ovector[2*i-1] != ovector[2*i+1]) + { + if (namecount > 0) + named_tokens(named_idx(i-pos_offset-1)) = + std::string (*(listptr+nidx[i-pos_offset-1])); + + tokens(pos_match++) = std::string (*(listptr+i)); + } + else + pos_offset++; + } + } + + std::string match_string = std::string (*listptr); + + pcre_free_substring_list (listptr); + + regexp::match_element new_elem (named_tokens, tokens, match_string, + token_extents, start, end); + lst.push_back (new_elem); + idx = ovector[1]; + + if (options.once () || idx >= buffer.length ()) + break; + } } -#else - (*current_liboctave_error_handler) - ("regex not available in this version of Octave"); -#endif + + retval = regexp::match_data (lst, named_pats); + + return retval; } bool -regex_match::match (const std::string& s) +regexp::is_match (const std::string& buffer) { -#if HAVE_REGEX - int npat = pat.length (); - - const char *str = s.c_str (); + regexp::match_data rx_lst = match (buffer); - for (int i = 0; i < npat; i++) - if (regexec (compiled + i, str, 0, 0, 0) == 0) - return true; -#endif + regexp::match_data::const_iterator p = rx_lst.begin (); - return false; + std::string match_string = p->match_string (); + + return ! match_string.empty (); } Array<bool> -regex_match::match (const string_vector& s) +regexp::is_match (const string_vector& buffer) { - int n = s.length (); + octave_idx_type len = buffer.length (); - Array<bool> retval (dim_vector (n, 1)); + Array<bool> retval (dim_vector (len, 1)); - for (int i = 0; i < n; i++) - retval(i) = match (s[i]); + for (octave_idx_type i = 0; i < buffer.length (); i++) + retval(i) = is_match (buffer(i)); return retval; } + +std::string +regexp::replace (const std::string& buffer, const std::string& replacement) +{ + std::string retval; + + // Identify replacement tokens; build a vector of group numbers in + // the replacement string so that we can quickly calculate the size + // of the replacement. + + int tokens = 0; + for (size_t i=1; i < replacement.size (); i++) + { + if (replacement[i-1]=='$' && isdigit (replacement[i])) + { + tokens++; + i++; + } + } + std::vector<int> token (tokens); + + int kk = 0; + for (size_t i = 1; i < replacement.size (); i++) + { + if (replacement[i-1]=='$' && isdigit (replacement[i])) + { + token[kk++] = replacement[i]-'0'; + i++; + } + } + + regexp::match_data rx_lst = match (buffer); + + size_t sz = rx_lst.size (); + + if (sz == 0) + { + retval = buffer; + return retval; + } + + std::string rep; + + if (tokens > 0) + { + // Determine replacement length + const size_t replen = replacement.size () - 2*tokens; + int delta = 0; + regexp::match_data::const_iterator p = rx_lst.begin (); + for (size_t i = 0; i < sz; i++) + { + OCTAVE_QUIT; + + double start = p->start (); + double end = p->end (); + + const Matrix pairs (p->token_extents ()); + size_t pairlen = 0; + for (int j = 0; j < tokens; j++) + { + if (token[j] == 0) + pairlen += static_cast<size_t> (end - start) + 1; + else if (token[j] <= pairs.rows ()) + pairlen += static_cast<size_t> (pairs(token[j]-1,1) + - pairs(token[j]-1,0)) + 1; + } + delta += (static_cast<int> (replen + pairlen) + - static_cast<int> (end - start + 1)); + p++; + } + + // Build replacement string + rep.reserve (buffer.size () + delta); + size_t from = 0; + p = rx_lst.begin (); + for (size_t i = 0; i < sz; i++) + { + OCTAVE_QUIT; + + double start = p->start (); + double end = p->end (); + + const Matrix pairs (p->token_extents ()); + rep.append (&buffer[from], static_cast<size_t> (start - 1) - from); + from = static_cast<size_t> (end - 1) + 1; + + for (size_t j = 1; j < replacement.size (); j++) + { + if (replacement[j-1]=='$' && isdigit (replacement[j])) + { + int k = replacement[j]-'0'; + if (k == 0) + { + // replace with entire match + rep.append (&buffer[static_cast<size_t> (end - 1)], + static_cast<size_t> (end - start) + 1); + } + else if (k <= pairs.rows ()) + { + // replace with group capture + rep.append (&buffer[static_cast<size_t> (pairs(k-1,0)-1)], + static_cast<size_t> (pairs(k-1,1) + - pairs(k-1,0)) + 1); + } + else + { + // replace with nothing + } + j++; + } + else + rep.append (1, replacement[j-1]); + + if (j+1 == replacement.size ()) + rep.append (1, replacement[j]); + } + p++; + } + rep.append (&buffer[from], buffer.size () - from); + } + else + { + // Determine replacement length + const size_t replen = replacement.size (); + int delta = 0; + regexp::match_data::const_iterator p = rx_lst.begin (); + for (size_t i = 0; i < sz; i++) + { + OCTAVE_QUIT; + delta += static_cast<int> (replen) + - static_cast<int> (p->end () - p->start () + 1); + p++; + } + + // Build replacement string + rep.reserve (buffer.size () + delta); + size_t from = 0; + p = rx_lst.begin (); + for (size_t i = 0; i < sz; i++) + { + OCTAVE_QUIT; + rep.append (&buffer[from], + static_cast<size_t> (p->start () - 1) - from); + from = static_cast<size_t> (p->end () - 1) + 1; + rep.append (replacement); + p++; + } + rep.append (&buffer[from], buffer.size () - from); + } + + retval = rep; + return retval; +}
rename from liboctave/regex-match.h rename to liboctave/regexp.h --- a/liboctave/regex-match.h +++ b/liboctave/regexp.h @@ -1,6 +1,7 @@ /* -Copyright (C) 2008-2011 David Bateman +Copyright (C) 2011 John W. Eaton +Copyright (C) 2005-2011 David Bateman This file is part of Octave. @@ -20,80 +21,261 @@ */ -#if !defined (octave_regex_match_h) -#define octave_regex_match_h 1 +#if !defined (octave_regexp_match_h) +#define octave_regexp_match_h 1 +#include <list> +#include <sstream> #include <string> -#if defined (HAVE_REGEX) -#if defined (__MINGW32__) -#define __restrict -#endif -#include <sys/types.h> -#include <regex.h> -#endif - #include "Array.h" +#include "Matrix.h" +#include "base-list.h" #include "str-vec.h" -class -OCTAVE_API -regex_match +class regexp { public: - regex_match (const std::string& p, bool insen = false) - : pat (p), case_insen (insen) -#if HAVE_REGEX - , compiled (0) -#endif + class opts; + class match_data; + + regexp (const std::string& pat = "", + const regexp::opts& opt = regexp::opts (), + const std::string& w = "regexp") + : pattern (pat), options (opt), data (0), named_pats (), + nnames (0), named_idx (), who (w) + { + compile_internal (); + } + + regexp (const regexp& rx) + : pattern (rx.pattern), data (rx.data), named_pats (rx.named_pats), + nnames (rx.nnames), named_idx (rx.named_idx) + { } + + regexp& operator = (const regexp& rx) + { + if (this != &rx) + { + pattern = rx.pattern; + data = rx.data; + named_pats = rx.named_pats; + nnames = rx.nnames; + named_idx = rx.named_idx; + } + + return *this; + } + + ~regexp (void) { free (); } + + void compile (const std::string& pat, + const regexp::opts& opt = regexp::opts ()) + { + pattern = pat; + options = opt; + compile_internal (); + } + + match_data match (const std::string& buffer); + + bool is_match (const std::string& buffer); + + Array<bool> is_match (const string_vector& buffer); + + std::string replace (const std::string& buffer, + const std::string& replacement); + + struct opts + { + public: + + opts (void) + : x_case_insensitive (false), x_dotexceptnewline (false), + x_freespacing (false), x_lineanchors (false), x_once (false) { } + + opts (const opts& o) + : x_case_insensitive (o.x_case_insensitive), + x_dotexceptnewline (o.x_dotexceptnewline), + x_freespacing (o.x_freespacing), + x_lineanchors (o.x_lineanchors), + x_once (o.x_once) + { } + + opts& operator = (const opts& o) { - init (); - } + if (this != &o) + { + x_case_insensitive = o.x_case_insensitive; + x_dotexceptnewline = o.x_dotexceptnewline; + x_freespacing = o.x_freespacing; + x_lineanchors = o.x_lineanchors; + x_once = o.x_once; + } - regex_match (const string_vector& p = string_vector (), bool insen = false) - : pat (p), case_insen (insen) -#if HAVE_REGEX - , compiled (0) -#endif - { - init (); + return *this; } - regex_match (const regex_match& gm) - : pat (gm.pat), case_insen (gm.case_insen) -#if HAVE_REGEX - , compiled (0) -#endif + ~opts (void) { } + + void case_insensitive (bool val) { x_case_insensitive = val; } + void dotexceptnewline (bool val) { x_dotexceptnewline = val; } + void freespacing (bool val) { x_freespacing = val; } + void lineanchors (bool val) { x_lineanchors = val; } + void once (bool val) { x_once = val; } + + bool case_insensitive (void) const { return x_case_insensitive; } + bool dotexceptnewline (void) const { return x_dotexceptnewline; } + bool freespacing (void) const { return x_freespacing; } + bool lineanchors (void) const { return x_lineanchors; } + bool once (void) const { return x_once; } + + private: + + bool x_case_insensitive; + bool x_dotexceptnewline; + bool x_freespacing; + bool x_lineanchors; + bool x_once; + }; + + class match_element + { + public: + + match_element (const string_vector& nt, const string_vector& t, + const std::string& ms, const Matrix& te, + double s, double e) + : x_match_string (ms), x_named_tokens (nt), x_tokens (t), + x_token_extents (te), x_start (s), x_end (e) + { } + + match_element (const match_element &a) + : x_match_string (a.x_match_string), + x_named_tokens (a.x_named_tokens), x_tokens (a.x_tokens), + x_token_extents (a.x_token_extents), + x_start (a.x_start), x_end (a.x_end) + { } + + std::string match_string (void) const { return x_match_string; } + string_vector named_tokens (void) const { return x_named_tokens; } + string_vector tokens (void) const { return x_tokens; } + Matrix token_extents (void) const { return x_token_extents; } + double start (void) const { return x_start; } + double end (void) const { return x_end; } + + private: + + std::string x_match_string; + string_vector x_named_tokens; + string_vector x_tokens; + Matrix x_token_extents; + double x_start; + double x_end; + }; + + class match_data : public octave_base_list<match_element> + { + public: + + match_data (void) + : octave_base_list<match_element> (), named_pats () + { } + + match_data (const std::list<match_element>& l, const string_vector& np) + : octave_base_list<match_element> (l), named_pats (np) + { } + + match_data (const match_data& rx_lst) + : octave_base_list<match_element> (rx_lst), + named_pats (rx_lst.named_pats) + { } + + match_data& operator = (const match_data& rx_lst) { - init (); + if (this != &rx_lst) + { + octave_base_list<match_element>::operator = (rx_lst); + named_pats = rx_lst.named_pats; + } + + return *this; } - regex_match& operator = (const regex_match& gm); + ~match_data (void) { } - ~regex_match (void); - - void set_pattern (const std::string& p); + string_vector named_patterns (void) { return named_pats; } - void set_pattern (const string_vector& p); + private: - bool match (const std::string&); - - Array<bool> match (const string_vector&); + string_vector named_pats; + }; private: - void init (void); + // The pattern we've been asked to match. + std::string pattern; - // Regex pattern(s). - string_vector pat; + opts options; + + // Internal data describing the regular expression. + void *data; - // Should match be case insensitive - bool case_insen; + std::string m; + string_vector named_pats; + int nnames; + Array<int> named_idx; + std::string who; -#if HAVE_REGEX - regex_t *compiled; -#endif + void free (void); + + void compile_internal (void); }; +inline regexp::match_data +regexp_match (const std::string& pat, + const std::string& buffer, + const regexp::opts& opt = regexp::opts (), + const std::string& who = "regexp") +{ + regexp rx (pat, opt, who); + + return rx.match (buffer); +} + +inline bool +is_regexp_match (const std::string& pat, + const std::string& buffer, + const regexp::opts& opt = regexp::opts (), + const std::string& who = "regexp") +{ + regexp rx (pat, opt, who); + + return rx.is_match (buffer); +} + +inline Array<bool> +is_regexp_match (const std::string& pat, + const string_vector& buffer, + const regexp::opts& opt = regexp::opts (), + const std::string& who = "regexp") +{ + regexp rx (pat, opt, who); + + return rx.is_match (buffer); +} + +inline std::string +regexp_replace (const std::string& pat, + const std::string& buffer, + const std::string& replacement, + const regexp::opts& opt = regexp::opts (), + const std::string& who = "regexp") +{ + regexp rx (pat, opt, who); + + return rx.replace (buffer, replacement); +} + #endif
new file mode 100644 --- /dev/null +++ b/liboctave/singleton-cleanup.cc @@ -0,0 +1,60 @@ +/* + +Copyright (C) 2011 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/>. + +*/ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <lo-error.h> +#include <singleton-cleanup.h> + +singleton_cleanup_list *singleton_cleanup_list::instance = 0; + +singleton_cleanup_list::~singleton_cleanup_list (void) +{ + for (std::set<fptr>::iterator p = fcn_list.begin (); + p != fcn_list.end (); p++) + { + fptr fcn = *p; + + fcn (); + } +} + +bool +singleton_cleanup_list::instance_ok (void) +{ + bool retval = true; + + if (! instance) + instance = new singleton_cleanup_list (); + + if (! instance) + { + current_liboctave_error_handler + ("unable to create singleton_cleanup_list object!"); + + retval = false; + } + + return retval; +}
new file mode 100644 --- /dev/null +++ b/liboctave/singleton-cleanup.h @@ -0,0 +1,50 @@ +#if !defined (octave_singleton_cleanup_h) +#define octave_singleton_cleanup_h 1 + +#include <set> + +class +OCTAVE_API +singleton_cleanup_list +{ +protected: + + singleton_cleanup_list (void) : fcn_list () { } + +public: + + typedef void (*fptr) (void); + + ~singleton_cleanup_list (void); + + static void add (fptr f) + { + if (instance_ok ()) + instance->do_add (f); + } + + static void cleanup (void) { delete instance; instance = 0; } + +private: + + static singleton_cleanup_list *instance; + + static bool instance_ok (void); + + static void cleanup_instance (void) { delete instance; instance = 0; } + + std::set<fptr> fcn_list; + + void do_add (fptr f) + { + fcn_list.insert (f); + } + + // No copying! + + singleton_cleanup_list (const singleton_cleanup_list&); + + singleton_cleanup_list& operator = (const singleton_cleanup_list&); +}; + +#endif
--- a/liboctave/sparse-base-chol.h +++ b/liboctave/sparse-base-chol.h @@ -178,7 +178,7 @@ virtual ~sparse_base_chol (void) { - if (--rep->count <= 0) + if (--rep->count == 0) delete rep; } @@ -186,7 +186,7 @@ { if (this != &a) { - if (--rep->count <= 0) + if (--rep->count == 0) delete rep; rep = a.rep;
--- a/liboctave/sparse-util.cc +++ b/liboctave/sparse-util.cc @@ -52,7 +52,7 @@ va_list args; va_start (args, fmt); int ret = gnulib::vfprintf (stderr, fmt, args); - fflush (stderr); + gnulib::fflush (stderr); va_end (args); return ret; }
--- a/liboctave/str-vec.cc +++ b/liboctave/str-vec.cc @@ -163,6 +163,26 @@ return *this; } +std::string +string_vector::join (const std::string& sep) const +{ + std::string retval; + + octave_idx_type len = length (); + + if (len > 0) + { + octave_idx_type i; + + for (i = 0; i < len - 1; i++) + retval += elem(i) + sep; + + retval += elem(i); + } + + return retval; +} + char ** string_vector::c_str_vec (void) const {
--- a/liboctave/str-vec.h +++ b/liboctave/str-vec.h @@ -105,6 +105,8 @@ string_vector& append (const string_vector& sv); + std::string join (const std::string& sep = std::string ()) const; + char **c_str_vec (void) const; static void delete_c_str_vec (const char * const*);
--- a/liboctave/uint16NDArray.cc +++ b/liboctave/uint16NDArray.cc @@ -54,3 +54,6 @@ BSXFUN_STDOP_DEFS_MXLOOP (uint16NDArray) BSXFUN_STDREL_DEFS_MXLOOP (uint16NDArray) + +BSXFUN_OP_DEF_MXLOOP (pow, uint16NDArray, mx_inline_pow) +BSXFUN_POW_MIXED_MXLOOP (uint16NDArray)
--- a/liboctave/uint16NDArray.h +++ b/liboctave/uint16NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (uint16NDArray, octave_uint16, OCTAVE_API) BSXFUN_STDOP_DECLS (uint16NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(uint16NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (uint16NDArray, OCTAVE_API) #endif
--- a/liboctave/uint32NDArray.cc +++ b/liboctave/uint32NDArray.cc @@ -54,3 +54,6 @@ BSXFUN_STDOP_DEFS_MXLOOP (uint32NDArray) BSXFUN_STDREL_DEFS_MXLOOP (uint32NDArray) + +BSXFUN_OP_DEF_MXLOOP (pow, uint32NDArray, mx_inline_pow) +BSXFUN_POW_MIXED_MXLOOP (uint32NDArray)
--- a/liboctave/uint32NDArray.h +++ b/liboctave/uint32NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (uint32NDArray, octave_uint32, OCTAVE_API) BSXFUN_STDOP_DECLS (uint32NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(uint32NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (uint32NDArray, OCTAVE_API) #endif
--- a/liboctave/uint64NDArray.cc +++ b/liboctave/uint64NDArray.cc @@ -54,3 +54,7 @@ BSXFUN_STDOP_DEFS_MXLOOP (uint64NDArray) BSXFUN_STDREL_DEFS_MXLOOP (uint64NDArray) + +BSXFUN_OP_DEF_MXLOOP (pow, uint64NDArray, mx_inline_pow) +BSXFUN_POW_MIXED_MXLOOP (uint64NDArray) +
--- a/liboctave/uint64NDArray.h +++ b/liboctave/uint64NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (uint64NDArray, octave_uint64, OCTAVE_API) BSXFUN_STDOP_DECLS (uint64NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(uint64NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (uint64NDArray, OCTAVE_API) #endif
--- a/liboctave/uint8NDArray.cc +++ b/liboctave/uint8NDArray.cc @@ -54,3 +54,7 @@ BSXFUN_STDOP_DEFS_MXLOOP (uint8NDArray) BSXFUN_STDREL_DEFS_MXLOOP (uint8NDArray) + +BSXFUN_POW_MIXED_MXLOOP (uint8NDArray) +BSXFUN_OP_DEF_MXLOOP (pow, uint8NDArray, mx_inline_pow) +
--- a/liboctave/uint8NDArray.h +++ b/liboctave/uint8NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (uint8NDArray, octave_uint8, OCTAVE_API) BSXFUN_STDOP_DECLS (uint8NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(uint8NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (uint8NDArray, OCTAVE_API) #endif
rename from acinclude.m4 rename to m4/acinclude.m4 --- a/acinclude.m4 +++ b/m4/acinclude.m4 @@ -370,7 +370,8 @@ assert (in[0] == out[0] && in[1] == out[1]); ]])], [octave_cv_fortran_integer_size=yes], - [octave_cv_fortran_integer_size=no]) + [octave_cv_fortran_integer_size=no], + [octave_cv_fortran_integer_size=yes]) AC_LANG_POP(C)dnl LIBS="$octave_fintsize_save_LIBS" rm -f conftest.$ac_objext fintsize.$ac_objext @@ -565,7 +566,7 @@ AC_DEFUN([OCTAVE_PROG_GHOSTSCRIPT], [ case "$canonical_host_type" in *-*-mingw* | *-*-msdosmsvc) - gs_names="gswin32c gs" + gs_names="gswin32c gs mgs" ;; *) gs_names="gs" @@ -818,7 +819,7 @@ }]])], octave_cv_ieee754_data_format=yes, octave_cv_ieee754_data_format=no, - octave_cv_ieee754_data_format=no)]) + octave_cv_ieee754_data_format=yes)]) if test "$cross_compiling" = yes; then AC_MSG_RESULT([$octave_cv_ieee754_data_format assumed for cross compilation]) else @@ -881,7 +882,7 @@ ]])], octave_cv_umfpack_seperate_split=yes, octave_cv_umfpack_seperate_split=no, - octave_cv_umfpack_seperate_split=no)]) + octave_cv_umfpack_seperate_split=yes)]) if test "$cross_compiling" = yes; then AC_MSG_RESULT([$octave_cv_umfpack_seperate_split assumed for cross compilation]) else @@ -935,7 +936,28 @@ [AC_CACHE_CHECK([for qh_version in $QHULL_LIBS], octave_cv_lib_qhull_version, [ AC_LINK_IFELSE([AC_LANG_PROGRAM([[ -#include <qhull/qhull_a.h> +#include <stdio.h> +#if defined (HAVE_QHULL_LIBQHULL_H) || defined (HAVE_QHULL_QHULL_H) +# if defined (HAVE_QHULL_LIBQHULL_H) +# include <qhull/libqhull.h> +# else +# include <qhull/qhull.h> +# endif +# include <qhull/qset.h> +# include <qhull/geom.h> +# include <qhull/poly.h> +# include <qhull/io.h> +#elif defined (HAVE_LIBQHULL_H) || defined (HAVE_QHULL_H) +# if defined (HAVE_LIBQHULL_H) +# include <libqhull.h> +# else +# include <qhull.h> +# endif +# include <qset.h> +# include <geom.h> +# include <poly.h> +# include <io.h> +#endif ]], [[ const char *tmp = qh_version; ]])], [octave_cv_lib_qhull_version=yes], [octave_cv_lib_qhull_version=no])]) @@ -952,7 +974,27 @@ octave_cv_lib_qhull_ok, [ AC_RUN_IFELSE([AC_LANG_PROGRAM([[ #include <stdio.h> -#include <qhull/qhull.h> +#if defined (HAVE_QHULL_LIBQHULL_H) || defined (HAVE_QHULL_QHULL_H) +# if defined (HAVE_QHULL_LIBQHULL_H) +# include <qhull/libqhull.h> +# else +# include <qhull/qhull.h> +# endif +# include <qhull/qset.h> +# include <qhull/geom.h> +# include <qhull/poly.h> +# include <qhull/io.h> +#elif defined (HAVE_LIBQHULL_H) || defined (HAVE_QHULL_H) +# if defined (HAVE_LIBQHULL_H) +# include <libqhull.h> +# else +# include <qhull.h> +# endif +# include <qset.h> +# include <geom.h> +# include <poly.h> +# include <io.h> +#endif #ifdef NEED_QHULL_VERSION char *qh_version = "version"; #endif @@ -962,7 +1004,10 @@ coordT points[8] = { -0.5, -0.5, -0.5, 0.5, 0.5, -0.5, 0.5, 0.5 }; boolT ismalloc = 0; return qh_new_qhull (dim, n, points, ismalloc, "qhull ", 0, stderr); -]])], [octave_cv_lib_qhull_ok=yes], [octave_cv_lib_qhull_ok=no])]) +]])], + [octave_cv_lib_qhull_ok=yes], + [octave_cv_lib_qhull_ok=no], + [octave_cv_lib_qhull_ok=yes])]) if test "$octave_cv_lib_qhull_ok" = "yes"; then $1 else @@ -1337,9 +1382,10 @@ dnl 4. Bit operations on signed integers work like on unsigned integers, dnl except for the shifts. Shifts are arithmetic. dnl -AC_DEFUN([OCTAVE_FAST_INT_OPS],[ -AC_MSG_CHECKING([whether fast integer arithmetics is usable]) -AC_LANG_PUSH(C++) +AC_DEFUN([OCTAVE_FAST_INT_OPS], +[AC_CACHE_CHECK([whether fast integer arithmetics is usable], +octave_cv_fast_int_ops, +[AC_LANG_PUSH(C++) AC_RUN_IFELSE([AC_LANG_PROGRAM([[ #include <limits> template<class UT, class ST> @@ -1383,10 +1429,15 @@ DO_TEST(long long) #endif ]])], -[AC_MSG_RESULT([yes]) - AC_DEFINE(HAVE_FAST_INT_OPS,1,[Define if signed integers use two's complement])], -[AC_MSG_RESULT([no])]) + [octave_cv_fast_int_ops=yes], + [octave_cv_fast_int_ops=no], + [octave_cv_fast_int_ops=yes]) AC_LANG_POP(C++)]) +if test $octave_cv_fast_int_ops = yes; then + AC_DEFINE(HAVE_FAST_INT_OPS, 1, + [Define if signed integers use two's complement]) +fi +]) dnl dnl Check to see if the compiler and the linker can handle the flags dnl "-framework $1" for the given prologue $2 and the given body $3 of
deleted file mode 100755 --- a/missing +++ /dev/null @@ -1,367 +0,0 @@ -#! /bin/sh -# Common stub for a few missing GNU programs while installing. - -scriptversion=2006-05-10.23 - -# Copyright (C) 1996, 1997, 1999, 2000, 2002, 2003, 2004, 2005, 2006 -# Free Software Foundation, Inc. -# Originally by Fran,cois Pinard <pinard@iro.umontreal.ca>, 1996. - -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. - -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301, USA. - -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -if test $# -eq 0; then - echo 1>&2 "Try \`$0 --help' for more information" - exit 1 -fi - -run=: -sed_output='s/.* --output[ =]\([^ ]*\).*/\1/p' -sed_minuso='s/.* -o \([^ ]*\).*/\1/p' - -# In the cases where this matters, `missing' is being run in the -# srcdir already. -if test -f configure.ac; then - configure_ac=configure.ac -else - configure_ac=configure.in -fi - -msg="missing on your system" - -case $1 in ---run) - # Try to run requested program, and just exit if it succeeds. - run= - shift - "$@" && exit 0 - # Exit code 63 means version mismatch. This often happens - # when the user try to use an ancient version of a tool on - # a file that requires a minimum version. In this case we - # we should proceed has if the program had been absent, or - # if --run hadn't been passed. - if test $? = 63; then - run=: - msg="probably too old" - fi - ;; - - -h|--h|--he|--hel|--help) - echo "\ -$0 [OPTION]... PROGRAM [ARGUMENT]... - -Handle \`PROGRAM [ARGUMENT]...' for when PROGRAM is missing, or return an -error status if there is no known handling for PROGRAM. - -Options: - -h, --help display this help and exit - -v, --version output version information and exit - --run try to run the given command, and emulate it if it fails - -Supported PROGRAM values: - aclocal touch file \`aclocal.m4' - autoconf touch file \`configure' - autoheader touch file \`config.h.in' - autom4te touch the output file, or create a stub one - automake touch all \`Makefile.in' files - bison create \`y.tab.[ch]', if possible, from existing .[ch] - flex create \`lex.yy.c', if possible, from existing .c - help2man touch the output file - lex create \`lex.yy.c', if possible, from existing .c - makeinfo touch the output file - tar try tar, gnutar, gtar, then tar without non-portable flags - yacc create \`y.tab.[ch]', if possible, from existing .[ch] - -Send bug reports to <bug-automake@gnu.org>." - exit $? - ;; - - -v|--v|--ve|--ver|--vers|--versi|--versio|--version) - echo "missing $scriptversion (GNU Automake)" - exit $? - ;; - - -*) - echo 1>&2 "$0: Unknown \`$1' option" - echo 1>&2 "Try \`$0 --help' for more information" - exit 1 - ;; - -esac - -# Now exit if we have it, but it failed. Also exit now if we -# don't have it and --version was passed (most likely to detect -# the program). -case $1 in - lex|yacc) - # Not GNU programs, they don't have --version. - ;; - - tar) - if test -n "$run"; then - echo 1>&2 "ERROR: \`tar' requires --run" - exit 1 - elif test "x$2" = "x--version" || test "x$2" = "x--help"; then - exit 1 - fi - ;; - - *) - if test -z "$run" && ($1 --version) > /dev/null 2>&1; then - # We have it, but it failed. - exit 1 - elif test "x$2" = "x--version" || test "x$2" = "x--help"; then - # Could not run --version or --help. This is probably someone - # running `$TOOL --version' or `$TOOL --help' to check whether - # $TOOL exists and not knowing $TOOL uses missing. - exit 1 - fi - ;; -esac - -# If it does not exist, or fails to run (possibly an outdated version), -# try to emulate it. -case $1 in - aclocal*) - echo 1>&2 "\ -WARNING: \`$1' is $msg. You should only need it if - you modified \`acinclude.m4' or \`${configure_ac}'. You might want - to install the \`Automake' and \`Perl' packages. Grab them from - any GNU archive site." - touch aclocal.m4 - ;; - - autoconf) - echo 1>&2 "\ -WARNING: \`$1' is $msg. You should only need it if - you modified \`${configure_ac}'. You might want to install the - \`Autoconf' and \`GNU m4' packages. Grab them from any GNU - archive site." - touch configure - ;; - - autoheader) - echo 1>&2 "\ -WARNING: \`$1' is $msg. You should only need it if - you modified \`acconfig.h' or \`${configure_ac}'. You might want - to install the \`Autoconf' and \`GNU m4' packages. Grab them - from any GNU archive site." - files=`sed -n 's/^[ ]*A[CM]_CONFIG_HEADER(\([^)]*\)).*/\1/p' ${configure_ac}` - test -z "$files" && files="config.h" - touch_files= - for f in $files; do - case $f in - *:*) touch_files="$touch_files "`echo "$f" | - sed -e 's/^[^:]*://' -e 's/:.*//'`;; - *) touch_files="$touch_files $f.in";; - esac - done - touch $touch_files - ;; - - automake*) - echo 1>&2 "\ -WARNING: \`$1' is $msg. You should only need it if - you modified \`Makefile.am', \`acinclude.m4' or \`${configure_ac}'. - You might want to install the \`Automake' and \`Perl' packages. - Grab them from any GNU archive site." - find . -type f -name Makefile.am -print | - sed 's/\.am$/.in/' | - while read f; do touch "$f"; done - ;; - - autom4te) - echo 1>&2 "\ -WARNING: \`$1' is needed, but is $msg. - You might have modified some files without having the - proper tools for further handling them. - You can get \`$1' as part of \`Autoconf' from any GNU - archive site." - - file=`echo "$*" | sed -n "$sed_output"` - test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` - if test -f "$file"; then - touch $file - else - test -z "$file" || exec >$file - echo "#! /bin/sh" - echo "# Created by GNU Automake missing as a replacement of" - echo "# $ $@" - echo "exit 0" - chmod +x $file - exit 1 - fi - ;; - - bison|yacc) - echo 1>&2 "\ -WARNING: \`$1' $msg. You should only need it if - you modified a \`.y' file. You may need the \`Bison' package - in order for those modifications to take effect. You can get - \`Bison' from any GNU archive site." - rm -f y.tab.c y.tab.h - if test $# -ne 1; then - eval LASTARG="\${$#}" - case $LASTARG in - *.y) - SRCFILE=`echo "$LASTARG" | sed 's/y$/c/'` - if test -f "$SRCFILE"; then - cp "$SRCFILE" y.tab.c - fi - SRCFILE=`echo "$LASTARG" | sed 's/y$/h/'` - if test -f "$SRCFILE"; then - cp "$SRCFILE" y.tab.h - fi - ;; - esac - fi - if test ! -f y.tab.h; then - echo >y.tab.h - fi - if test ! -f y.tab.c; then - echo 'main() { return 0; }' >y.tab.c - fi - ;; - - lex|flex) - echo 1>&2 "\ -WARNING: \`$1' is $msg. You should only need it if - you modified a \`.l' file. You may need the \`Flex' package - in order for those modifications to take effect. You can get - \`Flex' from any GNU archive site." - rm -f lex.yy.c - if test $# -ne 1; then - eval LASTARG="\${$#}" - case $LASTARG in - *.l) - SRCFILE=`echo "$LASTARG" | sed 's/l$/c/'` - if test -f "$SRCFILE"; then - cp "$SRCFILE" lex.yy.c - fi - ;; - esac - fi - if test ! -f lex.yy.c; then - echo 'main() { return 0; }' >lex.yy.c - fi - ;; - - help2man) - echo 1>&2 "\ -WARNING: \`$1' is $msg. You should only need it if - you modified a dependency of a manual page. You may need the - \`Help2man' package in order for those modifications to take - effect. You can get \`Help2man' from any GNU archive site." - - file=`echo "$*" | sed -n "$sed_output"` - test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` - if test -f "$file"; then - touch $file - else - test -z "$file" || exec >$file - echo ".ab help2man is required to generate this page" - exit 1 - fi - ;; - - makeinfo) - echo 1>&2 "\ -WARNING: \`$1' is $msg. You should only need it if - you modified a \`.texi' or \`.texinfo' file, or any other file - indirectly affecting the aspect of the manual. The spurious - call might also be the consequence of using a buggy \`make' (AIX, - DU, IRIX). You might want to install the \`Texinfo' package or - the \`GNU make' package. Grab either from any GNU archive site." - # The file to touch is that specified with -o ... - file=`echo "$*" | sed -n "$sed_output"` - test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` - if test -z "$file"; then - # ... or it is the one specified with @setfilename ... - infile=`echo "$*" | sed 's/.* \([^ ]*\) *$/\1/'` - file=`sed -n ' - /^@setfilename/{ - s/.* \([^ ]*\) *$/\1/ - p - q - }' $infile` - # ... or it is derived from the source name (dir/f.texi becomes f.info) - test -z "$file" && file=`echo "$infile" | sed 's,.*/,,;s,.[^.]*$,,'`.info - fi - # If the file does not exist, the user really needs makeinfo; - # let's fail without touching anything. - test -f $file || exit 1 - touch $file - ;; - - tar) - shift - - # We have already tried tar in the generic part. - # Look for gnutar/gtar before invocation to avoid ugly error - # messages. - if (gnutar --version > /dev/null 2>&1); then - gnutar "$@" && exit 0 - fi - if (gtar --version > /dev/null 2>&1); then - gtar "$@" && exit 0 - fi - firstarg="$1" - if shift; then - case $firstarg in - *o*) - firstarg=`echo "$firstarg" | sed s/o//` - tar "$firstarg" "$@" && exit 0 - ;; - esac - case $firstarg in - *h*) - firstarg=`echo "$firstarg" | sed s/h//` - tar "$firstarg" "$@" && exit 0 - ;; - esac - fi - - echo 1>&2 "\ -WARNING: I can't seem to be able to run \`tar' with the given arguments. - You may want to install GNU tar or Free paxutils, or check the - command line arguments." - exit 1 - ;; - - *) - echo 1>&2 "\ -WARNING: \`$1' is needed, and is $msg. - You might have modified some files without having the - proper tools for further handling them. Check the \`README' file, - it often tells you about the needed prerequisites for installing - this package. You may also peek at any GNU archive site, in case - some other package would contain this missing \`$1' program." - exit 1 - ;; -esac - -exit 0 - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-end: "$" -# End:
deleted file mode 100755 --- a/octave-sh +++ /dev/null @@ -1,19 +0,0 @@ -#!/bin/sh -# -# Wrapper for octave for binary installations that can't install -# octave in /usr/local/bin. -# -# The real binary should be installed in as octave.bin, and this file -# should be installed in the same directory as octave. - -if test -n "$LD_LIBRARY_PATH"; then - LD_LIBRARY_PATH="@LD_LIBRARY_PATH@:$LD_LIBRARY_PATH" -else - LD_LIBRARY_PATH="@LD_LIBRARY_PATH@" -fi -export LD_LIBRARY_PATH - -OCTAVE_HOME=@OCTAVE_HOME@ -export OCTAVE_HOME - -exec $OCTAVE_HOME/bin/octave.bin $*
old mode 100755 new mode 100644 --- a/run-octave.in +++ b/run-octave.in @@ -30,22 +30,19 @@ top_srcdir='%abs_top_srcdir%' builddir='%builddir%' -d1="$top_srcdir/test" -d2="$top_srcdir/scripts" -d3="$builddir/scripts" -d4="$builddir/src" +d1="$top_srcdir/scripts" +d2="$builddir/scripts" +d3="$builddir/src" d1_list=`$FIND "$d1" -type d -a ! \( \( -name private -o -name '@*' \) -a -prune \) -exec echo '{}' ';' | $SED 's/$/:/'` d2_list=`$FIND "$d2" -type d -a ! \( \( -name private -o -name '@*' \) -a -prune \) -exec echo '{}' ';' | $SED 's/$/:/'` d3_list=`$FIND "$d3" -type d -a ! \( \( -name private -o -name '@*' \) -a -prune \) -exec echo '{}' ';' | $SED 's/$/:/'` -d4_list=`$FIND "$d4" -type d -a ! \( \( -name private -o -name '@*' \) -a -prune \) -exec echo '{}' ';' | $SED 's/$/:/'` d1_path=`echo "$d1_list" | $AWK '{ t = (s $0); s = t; } END { sub (/:$/, "", s); print s; }'` d2_path=`echo "$d2_list" | $AWK '{ t = (s $0); s = t; } END { sub (/:$/, "", s); print s; }'` d3_path=`echo "$d3_list" | $AWK '{ t = (s $0); s = t; } END { sub (/:$/, "", s); print s; }'` -d4_path=`echo "$d4_list" | $AWK '{ t = (s $0); s = t; } END { sub (/:$/, "", s); print s; }'` -LOADPATH="$d1_path:$d2_path:$d3_path:$d4_path" +LOADPATH="$d1_path:$d2_path:$d3_path" IMAGEPATH="$top_srcdir/scripts/image" DOCFILE="$builddir/doc/interpreter/doc-cache" INFOFILE="$top_srcdir/doc/interpreter/octave.info"
--- a/scripts/@ftp/mget.m +++ b/scripts/@ftp/mget.m @@ -20,7 +20,7 @@ ## @deftypefn {Function File} {} mget (@var{f}, @var{file}) ## @deftypefnx {Function File} {} mget (@var{f}, @var{dir}) ## @deftypefnx {Function File} {} mget (@dots{}, @var{target}) -## Downloads a remote file @var{file} or directory @var{dir} to the local +## Download a remote file @var{file} or directory @var{dir} to the local ## directory on the FTP connection @var{f}. @var{f} is an FTP object ## returned by the @code{ftp} function. ##
--- a/scripts/Makefile.am +++ b/scripts/Makefile.am @@ -3,22 +3,22 @@ # Copyright (C) 1993-2011 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/>. -include $(top_srcdir)/common.mk +include $(top_srcdir)/build-aux/common.mk AUTOMAKE_OPTIONS = subdir-objects @@ -53,6 +53,7 @@ include pkg/module.mk include plot/module.mk include polynomial/module.mk +include prefs/module.mk include set/module.mk include signal/module.mk include sparse/module.mk @@ -141,6 +142,10 @@ $(srcdir)/mk-pkg-add $(srcdir) $(polynomial_FCN_FILES) -- $(polynomial_GEN_FCN_FILES) > $@-t mv $@-t $@ +prefs/PKG_ADD: $(prefs_FCN_FILES) $(prefs_GEN_FCN_FILES) prefs/$(octave_dirstamp) mk-pkg-add + $(srcdir)/mk-pkg-add $(srcdir) $(prefs_FCN_FILES) -- $(prefs_GEN_FCN_FILES) > $@-t + mv $@-t $@ + set/PKG_ADD: $(set_FCN_FILES) $(set_GEN_FCN_FILES) set/$(octave_dirstamp) mk-pkg-add $(srcdir)/mk-pkg-add $(srcdir) $(set_FCN_FILES) -- $(set_GEN_FCN_FILES) > $@-t mv $@-t $@ @@ -209,6 +214,7 @@ $(pkg_GEN_FCN_FILES): pkg/$(octave_dirstamp) $(plot_GEN_FCN_FILES): plot/$(octave_dirstamp) $(polynomial_GEN_FCN_FILES): polynomial/$(octave_dirstamp) +$(prefs_GEN_FCN_FILES): prefs/$(octave_dirstamp) $(set_GEN_FCN_FILES): set/$(octave_dirstamp) $(signal_GEN_FCN_FILES): signal/$(octave_dirstamp) $(sparse_GEN_FCN_FILES): sparse/$(octave_dirstamp) @@ -271,6 +277,9 @@ polynomial/$(octave_dirstamp): $(MKDIR_P) polynomial : > polynomial/$(octave_dirstamp) +prefs/$(octave_dirstamp): + $(MKDIR_P) prefs + : > prefs/$(octave_dirstamp) set/$(octave_dirstamp): $(MKDIR_P) set : > set/$(octave_dirstamp) @@ -324,7 +333,7 @@ fi @echo "creating .DOCSTRINGS from .m script files" @$(srcdir)/mkdoc "$(srcdir)" $(FCN_FILES) -- $(GEN_FCN_FILES) > $@ - $(top_srcdir)/move-if-change $@ DOCSTRINGS + $(top_srcdir)/build-aux/move-if-change $@ DOCSTRINGS touch $@ $(GEN_FCN_FILES) : %.m : %.in Makefile
--- a/scripts/audio/loadaudio.m +++ b/scripts/audio/loadaudio.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} loadaudio (@var{name}, @var{ext}, @var{bps}) -## Loads audio data from the file @file{@var{name}.@var{ext}} into the +## Load audio data from the file @file{@var{name}.@var{ext}} into the ## vector @var{x}. ## ## The extension @var{ext} determines how the data in the audio file is
--- a/scripts/audio/playaudio.m +++ b/scripts/audio/playaudio.m @@ -19,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} playaudio (@var{name}, @var{ext}) ## @deftypefnx {Function File} {} playaudio (@var{x}) -## Plays the audio file @file{@var{name}.@var{ext}} or the audio data +## Play the audio file @file{@var{name}.@var{ext}} or the audio data ## stored in the vector @var{x}. ## @seealso{lin2mu, mu2lin, loadaudio, saveaudio, setaudio, record} ## @end deftypefn @@ -30,46 +30,59 @@ function playaudio (name, ext) - if (nargin == 1 && isvector (name) && ! ischar (name)) + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 1 && isnumeric (name)) ## play a vector - [nr, nc] = size (name); - if (nc != 1) - if (nr == 1) - name = name'; - nr = nc; - else - error ("playaudio: X must be a vector"); - endif + if (! isvector (name)) + error ("playaudio: X must be a vector"); endif - X = name + 127; + X = name(:) + 127; unwind_protect file = tmpnam (); - num = fopen (file, "wb"); - c = fwrite (num, X, "uchar"); - fclose (num); - system (sprintf ("cat \"%s\" > /dev/dsp", file)); + fid = fopen (file, "wb"); + fwrite (fid, X, "uchar"); + fclose (fid); + [status, out] = system (sprintf ('cat "%s" > /dev/dsp', file)); + if (status != 0) + system (sprintf ("paplay --raw \"%s\"", file)) + endif unwind_protect_cleanup unlink (file); end_unwind_protect elseif (nargin >= 1 && ischar (name)) ## play a file if (nargin == 1) - name = [name, ".lin"]; + name = [name ".lin"]; elseif (nargin == 2) - name = [name, ".", ext]; - else - print_usage (); + name = [name "." ext]; endif - if (strcmp (ext, "lin") || strcmp (ext, "raw")) - system (sprintf ("cat \"%s\" > /dev/dsp", name)); - elseif (strcmp (ext, "mu") || strcmp (ext, "au") - || strcmp (ext, "snd") || strcmp (ext, "ul")) - system (sprintf ("cat \"%s\" > /dev/audio", name)); + if (any (strcmp (ext, {"lin", "raw"}))) + [status, out] = system (sprintf ('cat "%s" > /dev/dsp', name)); + if (status != 0) + system (sprintf ('paplay --raw "%s"', name)) + endif + elseif (any (strcmp (ext, {"mu", "au" "snd", "ul"}))) + [status, out] = system (sprintf ('cat "%s" > /dev/audio', name)); + if (status != 0) + system (sprintf ('paplay "%s"', name)) + endif else - error ("playaudio: unsupported extension"); + error ("playaudio: unsupported extension '%s'", ext); endif else print_usage (); endif endfunction + + +%% Test input validation +%!error playaudio () +%!error playaudio (1,2,3) +%!error <X must be a vector> playaudio (magic (3)) +%!error <unsupported extension> playaudio ("file", "abc") +%!error playaudio ({"abc"}) +
--- a/scripts/audio/record.m +++ b/scripts/audio/record.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} record (@var{sec}, @var{sampling_rate}) -## Records @var{sec} seconds of audio input into the vector @var{x}. The +## Record @var{sec} seconds of audio input into the vector @var{x}. The ## default value for @var{sampling_rate} is 8000 samples per second, or ## 8kHz. The program waits until the user types @key{RET} and then ## immediately starts to record.
--- a/scripts/audio/saveaudio.m +++ b/scripts/audio/saveaudio.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} saveaudio (@var{name}, @var{x}, @var{ext}, @var{bps}) -## Saves a vector @var{x} of audio data to the file +## Save a vector @var{x} of audio data to the file ## @file{@var{name}.@var{ext}}. The optional parameters @var{ext} and ## @var{bps} determine the encoding and the number of bits per sample used ## in the audio file (see @code{loadaudio}); defaults are @file{lin} and
--- a/scripts/audio/wavread.m +++ b/scripts/audio/wavread.m @@ -22,9 +22,9 @@ ## in vector @var{y}. If the file contains multichannel data, then ## @var{y} is a matrix with the channels represented as columns. ## -## @deftypefnx {Function File} {[@var{y}, @var{Fs}, @var{bits}] =} wavread (@var{filename}) +## @deftypefnx {Function File} {[@var{y}, @var{Fs}, @var{bps}] =} wavread (@var{filename}) ## Additionally return the sample rate (@var{fs}) in Hz and the number of bits -## per sample (@var{bits}). +## per sample (@var{bps}). ## ## @deftypefnx {Function File} {[@dots{}] =} wavread (@var{filename}, @var{n}) ## Read only the first @var{n} samples from each channel. @@ -55,135 +55,139 @@ error ("wavread: FILENAME must be a character string"); endif - # Open file for binary reading. - [fid, msg] = fopen (filename, "rb"); - if (fid < 0) - error ("wavread: %s", msg); - endif + fid = -1; + + unwind_protect - ## Get file size. - fseek (fid, 0, "eof"); - file_size = ftell (fid); - fseek (fid, 0, "bof"); + [fid, msg] = fopen (filename, "rb"); + + if (fid < 0) + error ("wavread: %s", msg); + endif - ## Find RIFF chunk. - riff_size = find_chunk (fid, "RIFF", file_size); - riff_pos = ftell (fid); - if (riff_size == -1) - fclose (fid); - error ("wavread: file contains no RIFF chunk"); - endif + ## Get file size. + fseek (fid, 0, "eof"); + file_size = ftell (fid); + fseek (fid, 0, "bof"); - riff_type = char (fread (fid, 4))'; - if(! strcmp (riff_type, "WAVE")) - fclose (fid); - error ("wavread: file contains no WAVE signature"); - endif - riff_pos = riff_pos + 4; - riff_size = riff_size - 4; + ## Find RIFF chunk. + riff_size = find_chunk (fid, "RIFF", file_size); + riff_pos = ftell (fid); + if (riff_size == -1) + error ("wavread: file contains no RIFF chunk"); + endif + + riff_type = char (fread (fid, 4))'; + if (! strcmp (riff_type, "WAVE")) + error ("wavread: file contains no WAVE signature"); + endif + riff_pos = riff_pos + 4; + riff_size = riff_size - 4; - ## Find format chunk inside the RIFF chunk. - fseek (fid, riff_pos, "bof"); - fmt_size = find_chunk (fid, "fmt ", riff_size); - fmt_pos = ftell(fid); - if (fmt_size == -1) - fclose (fid); - error ("wavread: file contains no format chunk"); - endif + ## Find format chunk inside the RIFF chunk. + fseek (fid, riff_pos, "bof"); + fmt_size = find_chunk (fid, "fmt ", riff_size); + fmt_pos = ftell(fid); + if (fmt_size == -1) + error ("wavread: file contains no format chunk"); + endif + + ## Find data chunk inside the RIFF chunk. + ## We don't assume that it comes after the format chunk. + fseek (fid, riff_pos, "bof"); + data_size = find_chunk (fid, "data", riff_size); + data_pos = ftell (fid); + if (data_size == -1) + error ("wavread: file contains no data chunk"); + endif - ## Find data chunk inside the RIFF chunk. - ## We don't assume that it comes after the format chunk. - fseek (fid, riff_pos, "bof"); - data_size = find_chunk (fid, "data", riff_size); - data_pos = ftell (fid); - if (data_size == -1) - fclose (fid); - error ("wavread: file contains no data chunk"); - endif + ### Read format chunk. + fseek (fid, fmt_pos, "bof"); - ### Read format chunk. - fseek (fid, fmt_pos, "bof"); + ## Sample format code. + format_tag = fread (fid, 1, "uint16", 0, BYTEORDER); + if (format_tag != FORMAT_PCM && format_tag != FORMAT_IEEE_FLOAT) + error ("wavread: sample format %#x is not supported", format_tag); + endif - ## Sample format code. - format_tag = fread (fid, 1, "uint16", 0, BYTEORDER); - if (format_tag != FORMAT_PCM && format_tag != FORMAT_IEEE_FLOAT) - fclose (fid); - error ("wavread: sample format %#x is not supported", format_tag); - endif + ## Number of interleaved channels. + channels = fread (fid, 1, "uint16", 0, BYTEORDER); - ## Number of interleaved channels. - channels = fread (fid, 1, "uint16", 0, BYTEORDER); + ## Sample rate. + samples_per_sec = fread (fid, 1, "uint32", 0, BYTEORDER); - ## Sample rate. - samples_per_sec = fread (fid, 1, "uint32", 0, BYTEORDER); + ## Bits per sample. + fseek (fid, 6, "cof"); + bits_per_sample = fread (fid, 1, "uint16", 0, BYTEORDER); - ## Bits per sample. - fseek (fid, 6, "cof"); - bits_per_sample = fread (fid, 1, "uint16", 0, BYTEORDER); + ### Read data chunk. + fseek (fid, data_pos, "bof"); - ### Read data chunk. - fseek (fid, data_pos, "bof"); + ## Determine sample data type. + if (format_tag == FORMAT_PCM) + switch (bits_per_sample) + case 8 + format = "uint8"; + case 16 + format = "int16"; + case 24 + format = "uint8"; + case 32 + format = "int32"; + otherwise + error ("wavread: %d bits sample resolution is not supported with PCM", + bits_per_sample); + endswitch + else + switch (bits_per_sample) + case 32 + format = "float32"; + case 64 + format = "float64"; + otherwise + error ("wavread: %d bits sample resolution is not supported with IEEE float", + bits_per_sample); + endswitch + endif - ## Determine sample data type. - if (format_tag == FORMAT_PCM) - switch (bits_per_sample) - case 8 - format = "uint8"; - case 16 - format = "int16"; - case 24 - format = "uint8"; - case 32 - format = "int32"; - otherwise - fclose (fid); - error ("wavread: %d bits sample resolution is not supported with PCM", - bits_per_sample); - endswitch - else - switch (bits_per_sample) - case 32 - format = "float32"; - case 64 - format = "float64"; - otherwise - fclose (fid); - error ("wavread: %d bits sample resolution is not supported with IEEE float", - bits_per_sample); - endswitch - endif + ## Parse arguments. + if (nargin == 1) + length = idivide (8 * data_size, bits_per_sample); + else + nparams = numel (param); + if (nparams == 1) + ## Number of samples is given. + length = param * channels; + elseif (nparams == 2) + ## Sample range is given. + if (fseek (fid, (param(1)-1) * channels * (bits_per_sample/8), "cof") < 0) + warning ("wavread: seeking failed"); + endif + length = (param(2)-param(1)+1) * channels; + elseif (nparams == 4 && char (param) == "size") + ## Size of the file is requested. + tmp = idivide (8 * data_size, channels * bits_per_sample); + y = [tmp, channels]; + return; + else + error ("wavread: invalid PARAM argument"); + endif + endif - ## Parse arguments. - if (nargin == 1) - length = 8 * data_size / bits_per_sample; - else - nparams = size (param, 2); - if (nparams == 1) - ## Number of samples is given. - length = param * channels; - elseif (nparams == 2) - ## Sample range is given. - if (fseek (fid, (param(1)-1) * channels * (bits_per_sample/8), "cof") < 0) - warning ("wavread: seeking failed"); - endif - length = (param(2)-param(1)+1) * channels; - elseif (nparams == 4 && char (param) == "size") - ## Size of the file is requested. + ## Read samples and close file. + if (bits_per_sample == 24) + length *= 3; + endif + + [yi, n] = fread (fid, length, format, 0, BYTEORDER); + + unwind_protect_cleanup + + if (fid >= 0) fclose (fid); - y = [data_size/channels/(bits_per_sample/8), channels]; - return; - else - fclose (fid); - error ("wavread: invalid argument 2"); endif - endif - ## Read samples and close file. - if (bits_per_sample == 24) - length *= 3; - endif - [yi, n] = fread (fid, length, format, 0, BYTEORDER); - fclose (fid); + end_unwind_protect ## Check data. if (mod (numel (yi), channels) != 0) @@ -201,13 +205,13 @@ ## Normalize samples. switch (bits_per_sample) case 8 - yi = (yi - 128)/127; + yi = (yi - 128)/128; case 16 - yi /= 32767; + yi /= 32768; case 24 - yi /= 8388607; + yi /= 8388608; case 32 - yi /= 2147483647; + yi /= 2147483648; endswitch endif @@ -239,3 +243,7 @@ chunk_size = -1; endif endfunction + +## Mark file as being tested. Tests for wavread/wavwrite pair are in +## wavwrite.m +%!assert(1)
--- a/scripts/audio/wavwrite.m +++ b/scripts/audio/wavwrite.m @@ -18,10 +18,10 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} wavwrite (@var{y}, @var{filename}) -## @deftypefnx {Function File} {} wavwrite (@var{y}, @var{fs}, @var{filename}) -## @deftypefnx {Function File} {} wavwrite (@var{y}, @var{fs}, @var{bits}, @var{filename}) +## @deftypefnx {Function File} {} wavwrite (@var{y}, @var{Fs}, @var{filename}) +## @deftypefnx {Function File} {} wavwrite (@var{y}, @var{Fs}, @var{bps}, @var{filename}) ## Write @var{y} to the canonical RIFF/WAVE sound file @var{filename} -## with sample rate @var{fs} and bits per sample @var{bits}. The +## with sample rate @var{Fs} and bits per sample @var{bps}. The ## default sample rate is 8000 Hz with 16-bits per sample. Each column ## of the data represents a separate channel. ## @seealso{wavread} @@ -34,13 +34,6 @@ BYTEORDER = "ieee-le"; - ## For backward compatibility with previous versions of Octave, also - ## accept the inputs - ## - ## wavwrite (filename, y) - ## wavwrite (filename, y, fs) - ## wavwrite (filename, y, fs, bits) - if (nargin < 2 || nargin > 4) print_usage (); endif @@ -49,22 +42,11 @@ samples_per_sec = 8000; bits_per_sample = 16; - if (ischar (y)) - filename = y; - y = varargin{1}; - if (nargin > 2) - samples_per_sec = varargin{2}; - if (nargin > 3) - bits_per_sample = varargin{3}; - endif - endif - else - filename = varargin{end}; - if (nargin > 2) - samples_per_sec = varargin{1}; - if (nargin > 3) - bits_per_sample = varargin{2}; - endif + filename = varargin{end}; + if (nargin > 2) + samples_per_sec = varargin{1}; + if (nargin > 3) + bits_per_sample = varargin{2}; endif endif @@ -72,7 +54,7 @@ if (columns (y) < 1) error ("wavwrite: Y must have at least one column"); endif - if (columns (y) > 2^15-1) + if (columns (y) > 0x7FFF) error ("wavwrite: Y has more than 32767 columns (too many for a WAV-file)"); endif @@ -89,17 +71,16 @@ endswitch ## calculate filesize - [n, channels] = size(y); + [n, channels] = size (y); ## size of data chunk ck_size = n*channels*(bits_per_sample/8); - ## open file for writing binary - if (! ischar (filename)) error ("wavwrite: expecting FILENAME to be a character string"); endif + ## open file for writing binary [fid, msg] = fopen (filename, "wb"); if (fid < 0) error ("wavwrite: %s", msg); @@ -126,8 +107,8 @@ c += fwrite (fid, samples_per_sec, "uint32", 0, BYTEORDER); ## bytes per second - bps = samples_per_sec*channels*bits_per_sample/8; - c += fwrite (fid, bps, "uint32", 0, BYTEORDER); + byteps = samples_per_sec*channels*bits_per_sample/8; + c += fwrite (fid, byteps, "uint32", 0, BYTEORDER); ## block align c += fwrite (fid, channels*bits_per_sample/8, "uint16", 0, BYTEORDER); @@ -147,11 +128,11 @@ ## scale samples switch (bits_per_sample) case 8 - yi = round (yi*127 + 128); + yi = round (yi*128 + 128); case 16 - yi = round (yi*32767); + yi = round (yi*32768); case 32 - yi = round (yi*2147483647); + yi = round (yi*2147483648); endswitch ## write to file @@ -161,29 +142,42 @@ endfunction + +%!shared fname +%! fname = tmpnam (); + %!test -%! A = [1:10; 1:10]/10; -%! wavwrite("a.wav", A); -%! [B, samples_per_sec, bits_per_sample] = wavread("a.wav"); -%! assert(A,B, 10^(-4)); -%! assert(samples_per_sec, 8000); -%! assert(bits_per_sample, 16); -%! delete ("a.wav"); +%! A = [-1:0.1:1; -1:0.1:1]; +%! wavwrite (A, fname); +%! [B, samples_per_sec, bits_per_sample] = wavread (fname); +%! assert (A,B, 1/2^15); +%! assert (samples_per_sec, 8000); +%! assert (bits_per_sample, 16); +%! unlink (fname); % %!test -%! A=[1:10; 1:10] / 10; -%! wavwrite("a.wav", A, 4000); -%! [B, samples_per_sec, bits_per_sample] = wavread("a.wav"); -%! assert(A,B, 10^(-4)); -%! assert(samples_per_sec, 4000); -%! assert(bits_per_sample, 16); -%! delete ("a.wav"); +%! A = [-1:0.1:1; -1:0.1:1]; +%! wavwrite (A, 4000, fname); +%! [B, samples_per_sec, bits_per_sample] = wavread (fname); +%! assert (A,B, 1/2^15); +%! assert (samples_per_sec, 4000); +%! assert (bits_per_sample, 16); +%! unlink (fname); % %!test -%! A=[1:10; 1:10] / 10; -%! wavwrite("a.wav", A, 4000, 8); -%! [B, samples_per_sec, bits_per_sample] = wavread("a.wav"); -%! assert(A,B, 10^(-2)); -%! assert(samples_per_sec, 4000); -%! assert(bits_per_sample, 8); -%! delete ("a.wav"); +%! A = [-1:0.1:1; -1:0.1:1]; +%! wavwrite (A, 4000, 8, fname); +%! [B, samples_per_sec, bits_per_sample] = wavread (fname); +%! assert (A,B, 1/128); +%! assert (samples_per_sec, 4000); +%! assert (bits_per_sample, 8); +%! unlink (fname); +% +%!test +%! A = [-2:2]; +%! wavwrite (A, fname); +%! B = wavread (fname); +%! B *= 32768; +%! assert (B, [-32768 -32768 0 32767 32767]); +%! unlink (fname); +
new file mode 100644 --- /dev/null +++ b/scripts/deprecated/__error_text__.m @@ -0,0 +1,36 @@ +## Copyright (C) 2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} __error_text__ (@var{msg}, @var{msgid}) +## This function has been deprecated. Use @code{lasterr} instead. +## @seealso{lasterr} +## @end deftypefn + +function [msg, msgid] = __error_text__ (varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "__error_text__ is obsolete and will be removed from a future version of Octave, please use lasterr instead"); + endif + + [msg, msgid] = lasterr (varargin{:}); + +endfunction
rename from scripts/statistics/base/cor.m rename to scripts/deprecated/cor.m --- a/scripts/statistics/base/cor.m +++ b/scripts/deprecated/cor.m @@ -25,7 +25,14 @@ ## @seealso{corrcoef} ## @end deftypefn -function retval = cor (x, y = []) +function retval = cor (x, y = x) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "cor is obsolete and will be removed from a future version of Octave; please use corr instead"); + endif if (nargin < 1 || nargin > 2) print_usage (); @@ -35,3 +42,13 @@ endfunction + +%!test +%! x = rand (10, 2); +%! assert (cor (x), corrcoef (x), 5*eps); +%! assert (cor (x(:,1), x(:,2)) == corrcoef (x(:,1), x(:,2))); + +%% Test input validation +%!error corrcoef (); +%!error corrcoef (1, 2, 3); +
rename from scripts/statistics/base/corrcoef.m rename to scripts/deprecated/corrcoef.m --- a/scripts/statistics/base/corrcoef.m +++ b/scripts/deprecated/corrcoef.m @@ -48,20 +48,26 @@ function retval = corrcoef (x, y = []) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "corrcoef is not equivalent to Matlab and will be removed from a future version of Octave; for similar functionality see corr"); + endif + if (nargin < 1 || nargin > 2) print_usage (); endif - if (! (isnumeric (x) && isnumeric (y))) - error ("corrcoef: X and Y must be numeric matrices or vectors"); - endif + ## Input validation is done by cov.m. Don't repeat tests here - if (ndims (x) != 2 || ndims (y) != 2) - error ("corrcoef: X and Y must be 2-D matrices or vectors"); - endif - + ## Special case, scalar is always 100% correlated with itself if (isscalar (x)) - retval = 1; + if (isa (x, 'single')) + retval = single (1); + else + retval = 1; + endif return; endif @@ -79,20 +85,35 @@ endfunction + %!test %! x = rand (10); %! cc1 = corrcoef (x); %! cc2 = corrcoef (x, x); -%! assert((size (cc1) == [10, 10] && size (cc2) == [10, 10] -%! && abs (cc1 - cc2) < sqrt (eps))); +%! assert (size (cc1) == [10, 10] && size (cc2) == [10, 10]); +%! assert (cc1, cc2, sqrt (eps)); + +%!test +%! x = [1:3]'; +%! y = [3:-1:1]'; +%! assert (corrcoef (x,y), -1, 5*eps) +%! assert (corrcoef (x,flipud (y)), 1, 5*eps) +%! assert (corrcoef ([x, y]), [1 -1; -1 1], 5*eps) -%!assert(corrcoef (5), 1); +%!test +%! x = single ([1:3]'); +%! y = single ([3:-1:1]'); +%! assert (corrcoef (x,y), single (-1), 5*eps) +%! assert (corrcoef (x,flipud (y)), single (1), 5*eps) +%! assert (corrcoef ([x, y]), single ([1 -1; -1 1]), 5*eps) + +%!assert (corrcoef (5), 1); +%!assert (corrcoef (single(5)), single(1)); %% Test input validation %!error corrcoef (); %!error corrcoef (1, 2, 3); -%!error corrcoef ([true, true]); -%!error corrcoef ([1, 2], [true, true]); +%!error corrcoef ([1; 2], ["A", "B"]); %!error corrcoef (ones (2,2,2)); %!error corrcoef (ones (2,2), ones (2,2,2));
new file mode 100644 --- /dev/null +++ b/scripts/deprecated/cquad.m @@ -0,0 +1,39 @@ +## Copyright (C) 2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{int}, @var{err}, @var{nr_points}] =} cquad (@var{f}, @var{a}, @var{b}, @var{tol}) +## @deftypefnx {Function File} {[@var{int}, @var{err}, @var{nr_points}] =} cquad (@var{f}, @var{a}, @var{b}, @var{tol}, @var{sing}) +## This function is an alias for compatibility with older versions of +## Octave. New programs should use @code{quadcc} instead. +## @seealso{quadcc} +## @end deftypefn + +## Deprecated in version 3.4 + +function retval = cquad (varargin) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "cquad has been renamed to quadcc and this alias will be removed from a future version of Octave; please use quadcc instead"); + endif + + retval = quadcc (varargin{:}); + +endfunction
rename from scripts/statistics/base/cut.m rename to scripts/deprecated/cut.m --- a/scripts/statistics/base/cut.m +++ b/scripts/deprecated/cut.m @@ -37,6 +37,13 @@ function group = cut (x, breaks) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "cut is obsolete and will be removed from a future version of Octave; please use histc instead"); + endif + if (nargin != 2) print_usage (); endif
new file mode 100644 --- /dev/null +++ b/scripts/deprecated/error_text.m @@ -0,0 +1,36 @@ +## Copyright (C) 2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} error_text (@var{msg}, @var{msgid}) +## This function has been deprecated. Use @code{lasterr} instead. +## @seealso{lasterr} +## @end deftypefn + +function [msg, msgid] = error_text (varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "error_text is obsolete and will be removed from a future version of Octave, please use lasterr instead"); + endif + + [msg, msgid] = lasterr (varargin{:}); + +endfunction
--- a/scripts/deprecated/glpkmex.m +++ b/scripts/deprecated/glpkmex.m @@ -32,7 +32,7 @@ warning ("Octave:deprecated-function", "glpkmex is obsolete and will be removed from a future version of Octave; please use glpk instead"); endif - + ## If there is no input output the version and syntax if (nargin < 4 || nargin > 11) print_usage ();
--- a/scripts/deprecated/module.mk +++ b/scripts/deprecated/module.mk @@ -1,12 +1,18 @@ FCN_FILE_DIRS += deprecated deprecated_FCN_FILES = \ + deprecated/__error_text__.m \ deprecated/autocor.m \ deprecated/autocov.m \ deprecated/betai.m \ deprecated/cellidx.m \ deprecated/clg.m \ + deprecated/cor.m \ + deprecated/corrcoef.m \ + deprecated/cquad.m \ + deprecated/cut.m \ deprecated/dispatch.m \ + deprecated/error_text.m \ deprecated/fstat.m \ deprecated/gammai.m \ deprecated/glpkmex.m \ @@ -15,11 +21,17 @@ deprecated/is_global.m \ deprecated/isstr.m \ deprecated/krylovb.m \ + deprecated/perror.m \ + deprecated/polyderiv.m \ deprecated/replot.m \ deprecated/saveimage.m \ deprecated/setstr.m \ + deprecated/shell_cmd.m \ deprecated/sphcat.m \ deprecated/spvcat.m \ + deprecated/strerror.m \ + deprecated/studentize.m \ + deprecated/sylvester_matrix.m \ deprecated/values.m \ deprecated/weibcdf.m \ deprecated/weibinv.m \
rename from scripts/general/perror.m rename to scripts/deprecated/perror.m --- a/scripts/general/perror.m +++ b/scripts/deprecated/perror.m @@ -29,6 +29,13 @@ function perror (funcname, num) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "perror is obsolete and will be removed from a future version of Octave."); + endif + if (nargin != 2) print_usage (); else
rename from scripts/polynomial/polyderiv.m rename to scripts/deprecated/polyderiv.m --- a/scripts/polynomial/polyderiv.m +++ b/scripts/deprecated/polyderiv.m @@ -36,6 +36,13 @@ function [q, d] = polyderiv (p, a) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "polyderiv is obsolete and will be removed from a future version of Octave; please use polyder instead"); + endif + if (nargin == 1 || nargin == 2) if (! isvector (p)) error ("polyderiv: argument must be a vector");
--- a/scripts/deprecated/saveimage.m +++ b/scripts/deprecated/saveimage.m @@ -30,8 +30,7 @@ ## Portable pixmap format. ## ## @item "ps" -## PostScript format. Note that images saved in PostScript format cannot -## be read back into Octave with loadimage. +## PostScript format. ## @end table ## ## If the fourth argument is supplied, the specified colormap will also be @@ -42,7 +41,7 @@ ## image is a gray scale image (the entries within each row of the colormap ## are equal) the gray scale ppm and PostScript image formats are used, ## otherwise the full color formats are used. -## @seealso{loadimage, save, load, colormap} +## @seealso{imread, save, load, colormap} ## @end deftypefn ## The conversion to PostScript is based on pbmtolps.c, which was
new file mode 100644 --- /dev/null +++ b/scripts/deprecated/shell_cmd.m @@ -0,0 +1,68 @@ +## Copyright (C) 2011 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/>. + +## "-*- texinfo -*- +## @deftypefn {Built-in Function} {} shell_cmd (@var{string}) +## @deftypefnx {Built-in Function} {} shell_cmd (@var{string}, @var{return_output}) +## @deftypefnx {Built-in Function} {} shell_cmd (@var{string}, @var{return_output}, @var{type}) +## @deftypefnx {Built-in Function} {[@var{status}, @var{output}] =} shell_cmd (@dots{}) +## @deftypefnx {Built-in Function} {[@var{status}, @var{output}] =} shell_cmd (@var{string}, @var{return_output}, @var{type}) +## Execute a shell command specified by @var{string}. +## If the optional argument @var{type} is "async", the process +## is started in the background and the process id of the child process +## is returned immediately. Otherwise, the process is started and +## Octave waits until it exits. If the @var{type} argument is omitted, it +## defaults to a value of "sync". +## +## If the optional argument @var{return_output} is true and the subprocess +## is started synchronously, or if @var{shell_cmd} is called with one input +## argument and one or more output arguments, then the output from the command +## is returned. Otherwise, if the subprocess is executed synchronously, its +## output is sent to the standard output. +## +## The @code{shell_cmd} function can return two values. The first is the +## exit status of the command and the second is any output from the +## command that was written to the standard output stream. For example, +## +## @example +## [status, output] = shell_cmd ("echo foo; exit 2"); +## @end example +## +## @noindent +## will set the variable @code{output} to the string @samp{foo}, and the +## variable @code{status} to the integer @samp{2}. +## +## For commands run asynchronously, @var{status} is the process id of the +## command shell that is started to run the command. +## @seealso{system, unix, dos} +## @end deftypefn + +## Deprecated in version 3.6 + +function [status, output] = shell_cmd (varargin) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "shell_cmd is obsolete and will be removed from a future version of Octave; please use system instead"); + endif + + [status, output] = system (varargin{:}); + +endfunction +
rename from scripts/general/strerror.m rename to scripts/deprecated/strerror.m --- a/scripts/general/strerror.m +++ b/scripts/deprecated/strerror.m @@ -28,6 +28,13 @@ function msg = strerror (name, num) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "strerror is obsolete and will be removed from a future version of Octave."); + endif + if (nargin != 2) print_usage (); endif
rename from scripts/statistics/base/studentize.m rename to scripts/deprecated/studentize.m --- a/scripts/statistics/base/studentize.m +++ b/scripts/deprecated/studentize.m @@ -32,6 +32,12 @@ ## Description: Subtract mean and divide by standard deviation function t = studentize (x, dim) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "studentize is obsolete and will be removed from a future version of Octave; please use zscore instead"); + endif if (nargin != 1 && nargin != 2) print_usage ();
rename from scripts/special-matrix/sylvester_matrix.m rename to scripts/deprecated/sylvester_matrix.m --- a/scripts/special-matrix/sylvester_matrix.m +++ b/scripts/deprecated/sylvester_matrix.m @@ -23,15 +23,23 @@ ## $n = 2^k$. ## @end tex ## @ifnottex -## n = 2^k. +## n = 2^@var{k}. ## @end ifnottex -## @seealso{hankel, vander, hilb, invhilb, toeplitz} +## +## @seealso{toeplitz, hankel} ## @end deftypefn ## Author: jwe function retval = sylvester_matrix (k) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "sylvester_matrix is obsolete and will be removed from a future version of Octave; please use hadamard(2^k) instead"); + endif + if (nargin != 1) print_usage (); endif
--- a/scripts/elfun/cosd.m +++ b/scripts/elfun/cosd.m @@ -32,7 +32,7 @@ I = x / 180; y = cos (I .* pi); I = I + 0.5; - y(I == round (I) & finite (I)) = 0; + y(I == fix (I) & finite (I)) = 0; endfunction %!error(cosd())
--- a/scripts/elfun/module.mk +++ b/scripts/elfun/module.mk @@ -20,7 +20,6 @@ elfun/csc.m \ elfun/cscd.m \ elfun/csch.m \ - elfun/lcm.m \ elfun/sec.m \ elfun/secd.m \ elfun/sech.m \
--- a/scripts/elfun/sind.m +++ b/scripts/elfun/sind.m @@ -31,7 +31,7 @@ endif I = x / 180; y = sin (I .* pi); - y(I == round (I) & finite (I)) = 0; + y(I == fix (I) & finite (I)) = 0; endfunction %!error(sind())
--- a/scripts/elfun/tand.m +++ b/scripts/elfun/tand.m @@ -33,8 +33,8 @@ I0 = x / 180; I90 = (x-90) / 180; y = tan (I0 .* pi); - y(I0 == round (I0) & finite (I0)) = 0; - y(I90 == round (I90) & finite (I90)) = Inf; + y(I0 == fix (I0) & finite (I0)) = 0; + y(I90 == fix (I90) & finite (I90)) = Inf; endfunction; %!error(tand())
--- a/scripts/general/accumarray.m +++ b/scripts/general/accumarray.m @@ -19,50 +19,110 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} accumarray (@var{subs}, @var{vals}, @var{sz}, @var{func}, @var{fillval}, @var{issparse}) -## @deftypefnx {Function File} {} accumarray (@var{csubs}, @var{vals}, @dots{}) +## @deftypefnx {Function File} {} accumarray (@var{subs}, @var{vals}, @dots{}) ## ## Create an array by accumulating the elements of a vector into the ## positions defined by their subscripts. The subscripts are defined by -## the rows of the matrix @var{subs} and the values by @var{vals}. Each row -## of @var{subs} corresponds to one of the values in @var{vals}. +## the rows of the matrix @var{subs} and the values by @var{vals}. Each +## row of @var{subs} corresponds to one of the values in @var{vals}. If +## @var{vals} is a scalar, it will be used for each of the row of +## @var{subs}. If @var{subs} is a cell array of vectors, all vectors +## must be of the same length, and the subscripts in the @var{k}th +## vector must correspond to the @var{k}th dimension of the result. ## -## The size of the matrix will be determined by the subscripts themselves. -## However, if @var{sz} is defined it determines the matrix size. The length -## of @var{sz} must correspond to the number of columns in @var{subs}. +## The size of the matrix will be determined by the subscripts +## themselves. However, if @var{sz} is defined it determines the matrix +## size. The length of @var{sz} must correspond to the number of columns +## in @var{subs}. An exception is if @var{subs} has only one column, in +## which case @var{sz} may be the dimensions of a vector and the +## subscripts of @var{subs} are taken as the indices into it. +## +## The default action of @code{accumarray} is to sum the elements with +## the same subscripts. This behavior can be modified by defining the +## @var{func} function. This should be a function or function handle +## that accepts a column vector and returns a scalar. The result of the +## function should not depend on the order of the subscripts. ## -## The default action of @code{accumarray} is to sum the elements with the -## same subscripts. This behavior can be modified by defining the @var{func} -## function. This should be a function or function handle that accepts a -## column vector and returns a scalar. The result of the function should not -## depend on the order of the subscripts. +## The elements of the returned array that have no subscripts associated +## with them are set to zero. Defining @var{fillval} to some other value +## allows these values to be defined. This behavior changes, however, +## for certain values of @var{func}. If @var{func} is @code{min} +## (respectively, @code{max}) then the result will be filled with the +## minimum (respectively, maximum) integer if @var{vals} is of integral +## type, logical false (respectively, logical true) if @var{vals} is of +## logical type, zero if @var{fillval} is zero and all values are +## non-positive (respectively, non-negative), and NaN otherwise. ## -## The elements of the returned array that have no subscripts associated with -## them are set to zero. Defining @var{fillval} to some other value allows -## these values to be defined. +## By default @code{accumarray} returns a full matrix. If +## @var{issparse} is logically true, then a sparse matrix is returned +## instead. ## -## By default @code{accumarray} returns a full matrix. If @var{issparse} is -## logically true, then a sparse matrix is returned instead. -## -## An example of the use of @code{accumarray} is: +## The following @code{accumarray} example constructs a frequency table +## that in the first column counts how many occurrences each number in +## the second column has, taken from the vector @var{x}. Note the usage +## of @code{unique} for assigning to all repeated elements of @var{x} +## the same index (@pxref{doc-unique}). ## ## @example ## @group -## accumarray ([1,1,1;2,1,2;2,3,2;2,1,2;2,3,2], 101:105) +## @var{x} = [91, 92, 90, 92, 90, 89, 91, 89, 90, 100, 100, 100]; +## [@var{u}, ~, @var{j}] = unique (@var{x}); +## [accumarray(@var{j}', 1), @var{u}'] +## @result{} 2 89 +## 3 90 +## 2 91 +## 2 92 +## 3 100 +## @end group +## @end example +## +## Another example, where the result is a multi-dimensional 3-D array and +## the default value (zero) appears in the output: +## +## @example +## @group +## accumarray ([1, 1, 1; +## 2, 1, 2; +## 2, 3, 2; +## 2, 1, 2; +## 2, 3, 2], 101:105) ## @result{} ans(:,:,1) = [101, 0, 0; 0, 0, 0] ## ans(:,:,2) = [0, 0, 0; 206, 0, 208] ## @end group ## @end example ## -## The complexity in the non-sparse case is generally O(M+N), where N is the -## number of -## subscripts and M is the maximum subscript (linearized in multi-dimensional -## case). -## If @var{func} is one of @code{@@sum} (default), @code{@@max}, @code{@@min} -## or @code{@@(x) @{x@}}, an optimized code path is used. -## Note that for general reduction function the interpreter overhead can play a -## major part and it may be more efficient to do multiple accumarray calls and -## compute the results in a vectorized manner. -## @seealso{accumdim} +## The sparse option can be used as an alternative to the @code{sparse} +## constructor (@pxref{doc-sparse}). Thus +## +## @example +## sparse (@var{i}, @var{j}, @var{sv}) +## @end example +## +## @noindent +## can be written with @code{accumarray} as +## +## @example +## accumarray ([@var{i}, @var{j}], @var{sv}', [], [], 0, true) +## @end example +## +## @noindent +## For repeated indices, @code{sparse} adds the corresponding value. To +## take the minimum instead, use @code{min} as an accumulator function: +## +## @example +## accumarray ([@var{i}, @var{j}], @var{sv}', [], @@min, 0, true) +## @end example +## +## The complexity of accumarray in general for the non-sparse case is +## generally O(M+N), where N is the number of subscripts and M is the +## maximum subscript (linearized in multi-dimensional case). If +## @var{func} is one of @code{@@sum} (default), @code{@@max}, +## @code{@@min} or @code{@@(x) @{x@}}, an optimized code path is used. +## Note that for general reduction function the interpreter overhead can +## play a major part and it may be more efficient to do multiple +## accumarray calls and compute the results in a vectorized manner. +## +## @seealso{accumdim, unique, sparse} ## @end deftypefn function A = accumarray (subs, vals, sz = [], func = [], fillval = [], issparse = []) @@ -71,14 +131,27 @@ print_usage (); endif + lenvals = length (vals); + if (iscell (subs)) subs = cellfun (@vec, subs, "uniformoutput", false); ndims = numel (subs); if (ndims == 1) subs = subs{1}; endif + + lensubs = cellfun (@length, subs); + + if (any (lensubs != lensubs(1)) || + (lenvals > 1 && lenvals != lensubs(1))) + error ("accumarray: dimension mismatch"); + endif + else ndims = columns (subs); + if (lenvals > 1 && lenvals != rows (subs)) + error ("accumarray: dimension mismatch") + endif endif if (isempty (fillval)) @@ -91,7 +164,8 @@ if (issparse) - ## Sparse case. Avoid linearizing the subscripts, because it could overflow. + ## Sparse case. Avoid linearizing the subscripts, because it could + ## overflow. if (fillval != 0) error ("accumarray: FILLVAL must be zero in the sparse case"); @@ -117,8 +191,8 @@ if (! (isempty (func) || func == @sum)) - ## Reduce values. This is not needed if we're about to sum them, because - ## "sparse" can do that. + ## Reduce values. This is not needed if we're about to sum them, + ## because "sparse" can do that. ## Sort indices. [subs, idx] = sortrows (subs); @@ -138,7 +212,14 @@ if (isempty (sz)) A = sparse (subs(:,1), subs(:,2), vals, mode); elseif (length (sz) == 2) - A = sparse (subs(:,1), subs(:,2), vals, sz(1), sz(2), mode); + + ## Row vector case + if (sz(1) == 1) + [i, j] = deal (subs(:,2), subs(:,1)); + else + [i, j] = deal (subs(:,1), subs(:,2)); + endif + A = sparse (i, j, vals, sz(1), sz(2), mode); else error ("accumarray: dimensions mismatch"); endif @@ -149,7 +230,7 @@ if (ndims > 1) if (isempty (sz)) if (iscell (subs)) - sz = cellfun (@max, subs); + sz = cellfun ("max", subs); else sz = max (subs, [], 1); endif @@ -195,7 +276,8 @@ elseif (islogical (vals)) zero = false; elseif (fillval == 0 && all (vals(:) >= 0)) - ## This is a common case - fillval is zero, all numbers nonegative. + ## This is a common case - fillval is zero, all numbers + ## nonegative. zero = 0; else zero = NaN; # Neutral value. @@ -220,6 +302,10 @@ zero = intmax (class (vals)); elseif (islogical (vals)) zero = true; + elseif (fillval == 0 && all (vals(:) <= 0)) + ## This is a common case - fillval is zero, all numbers + ## non-positive. + zero = 0; else zero = NaN; # Neutral value. endif @@ -252,14 +338,21 @@ jdx = find (subs(1:n-1) != subs(2:n)); jdx = [jdx; n]; vals = mat2cell (vals(idx), diff ([0; jdx])); - ## Optimize the case when function is @(x) {x}, i.e. we just want to - ## collect the values to cells. + ## Optimize the case when function is @(x) {x}, i.e. we just want + ## to collect the values to cells. persistent simple_cell_str = func2str (@(x) {x}); if (! strcmp (func2str (func), simple_cell_str)) vals = cellfun (func, vals); endif subs = subs(jdx); + if (isempty (sz)) + sz = max (subs); + if (length (sz) == 1) + sz(2) = 1; + endif + endif + ## Construct matrix of fillvals. if (iscell (vals)) A = cell (sz); @@ -282,9 +375,14 @@ %!assert (accumarray ([1,1,1;2,1,2;2,3,2;2,1,2;2,3,2],101:105,[],@(x)sin(sum(x))),sin(cat(3, [101,0,0;0,0,0],[0,0,0;206,0,208]))) %!assert (accumarray ({[1 3 3 2 3 1 2 2 3 3 1 2],[3 4 2 1 4 3 4 2 2 4 3 4],[1 1 2 2 1 1 2 1 1 1 2 2]},101:112),cat(3,[0,0,207,0;0,108,0,0;0,109,0,317],[0,0,111,0;104,0,0,219;0,103,0,0])) %!assert (accumarray ([1,1;2,1;2,3;2,1;2,3],101:105,[2,4],@max,NaN),[101,NaN,NaN,NaN;104,NaN,105,NaN]) +%!assert (accumarray ([1 1; 2 1; 2 3; 2 1; 2 3],101:105, [], @prod), [101, 0, 0; 10608, 0, 10815]) %!assert (accumarray ([1 1; 2 1; 2 3; 2 1; 2 3],101:105,[2 4],@prod,0,true),sparse([1,2,2],[1,1,3],[101,10608,10815],2,4)) %!assert (accumarray ([1 1; 2 1; 2 3; 2 1; 2 3],1,[2,4]), [1,0,0,0;2,0,2,0]) %!assert (accumarray ([1 1; 2 1; 2 3; 2 1; 2 3],101:105,[2,4],@(x)length(x)>1),[false,false,false,false;true,false,true,false]) +%!assert (accumarray ([1; 2], [3; 4], [2, 1], @min, [], 0), [3; 4]) +%!assert (accumarray ([1; 2], [3; 4], [2, 1], @min, [], 1), sparse ([3; 4])) +%!assert (accumarray ([1; 2], [3; 4], [1, 2], @min, [], 0), [3, 4]) +%!assert (accumarray ([1; 2], [3; 4], [1, 2], @min, [], 1), sparse ([3, 4])) %!test %! A = accumarray ([1 1; 2 1; 2 3; 2 1; 2 3],101:105,[2,4],@(x){x}); %! assert (A{2},[102;104])
--- a/scripts/general/accumdim.m +++ b/scripts/general/accumdim.m @@ -22,29 +22,34 @@ ## positions defined by their subscripts along a specified dimension. ## The subscripts are defined by the index vector @var{subs}. ## The dimension is specified by @var{dim}. If not given, it defaults -## to the first non-singleton dimension. +## to the first non-singleton dimension. The length of @var{subs} must +## be equal to @code{size (@var{vals}, @var{dim})}. ## -## The extent of the result matrix in the working dimension will be determined -## by the subscripts themselves. -## However, if @var{n} is defined it determines this extent. +## The extent of the result matrix in the working dimension will be +## determined by the subscripts themselves. However, if @var{n} is +## defined it determines this extent. ## ## The default action of @code{accumdim} is to sum the subarrays with the -## same subscripts. This behavior can be modified by defining the @var{func} -## function. This should be a function or function handle that accepts an -## array and a dimension, and reduces the array along this dimension. -## As a special exception, the built-in @code{min} and @code{max} functions -## can be used directly, and @code{accumdim} accounts for the middle empty -## argument that is used in their calling. +## same subscripts. This behavior can be modified by defining the +## @var{func} function. This should be a function or function handle +## that accepts an array and a dimension, and reduces the array along +## this dimension. As a special exception, the built-in @code{min} and +## @code{max} functions can be used directly, and @code{accumdim} +## accounts for the middle empty argument that is used in their calling. ## -## The slices of the returned array that have no subscripts associated with -## them are set to zero. Defining @var{fillval} to some other value allows -## these values to be defined. +## The slices of the returned array that have no subscripts associated +## with them are set to zero. Defining @var{fillval} to some other +## value allows these values to be defined. ## ## An example of the use of @code{accumdim} is: ## ## @example ## @group -## accumdim ([1, 2, 1, 2, 1], [7,-10,4;-5,-12,8;-12,2,8;-10,9,-3;-5,-3,-13]) +## accumdim ([1, 2, 1, 2, 1], [ 7, -10, 4; +## -5, -12, 8; +## -12, 2, 8; +## -10, 9, -3; +## -5, -3, -13]) ## @result{} ans = [-10,-11,-1;-15,-3,5] ## @end group ## @end example @@ -68,7 +73,7 @@ error ("accumdim: indices must be positive integers"); else m = max (subs); - if (n == 0) + if (n == 0 || isempty (n)) n = m; elseif (n < m) error ("accumdim: N index out of range"); @@ -86,6 +91,10 @@ endif sz(dim) = n; + if (length (subs) != size (vals, dim)) + error ("accumdim: dimension mismatch") + endif + if (isempty (func) || func == @sum) ## Fast summation case. A = __accumdim_sum__ (subs, vals, dim, n);
deleted file mode 100644 --- a/scripts/general/arrayfun.m +++ /dev/null @@ -1,347 +0,0 @@ -## Copyright (C) 2006-2011 Bill Denney -## Copyright (C) 2009 Jaroslav Hajek -## -## 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/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} arrayfun (@var{func}, @var{A}) -## @deftypefnx {Function File} {@var{x} =} arrayfun (@var{func}, @var{A}) -## @deftypefnx {Function File} {@var{x} =} arrayfun (@var{func}, @var{A}, @var{b}, @dots{}) -## @deftypefnx {Function File} {[@var{x}, @var{y}, @dots{}] =} arrayfun (@var{func}, @var{A}, @dots{}) -## @deftypefnx {Function File} {} arrayfun (@dots{}, "UniformOutput", @var{val}) -## @deftypefnx {Function File} {} arrayfun (@dots{}, "ErrorHandler", @var{errfunc}) -## -## Execute a function on each element of an array. This is useful for -## functions that do not accept array arguments. If the function does -## accept array arguments it is better to call the function directly. -## -## The first input argument @var{func} can be a string, a function -## handle, an inline function or an anonymous function. The input -## argument @var{A} can be a logic array, a numeric array, a string -## array, a structure array or a cell array. By a call of the function -## @command{arrayfun} all elements of @var{A} are passed on to the named -## function @var{func} individually. -## -## The named function can also take more than two input arguments, with -## the input arguments given as third input argument @var{b}, fourth -## input argument @var{c}, @dots{} If given more than one array input -## argument then all input arguments must have the same sizes, for -## example: -## -## @example -## @group -## arrayfun (@@atan2, [1, 0], [0, 1]) -## @result{} ans = [1.5708 0.0000] -## @end group -## @end example -## -## If the parameter @var{val} after a further string input argument -## "UniformOutput" is set @code{true} (the default), then the named -## function @var{func} must return a single element which then will be -## concatenated into the return value and is of type matrix. Otherwise, -## if that parameter is set to @code{false}, then the outputs are -## concatenated in a cell array. For example: -## -## @example -## @group -## arrayfun (@@(x,y) x:y, "abc", "def", "UniformOutput", false) -## @result{} ans = -## @{ -## [1,1] = abcd -## [1,2] = bcde -## [1,3] = cdef -## @} -## @end group -## @end example -## -## If more than one output arguments are given then the named function -## must return the number of return values that also are expected, for -## example: -## -## @example -## @group -## [A, B, C] = arrayfun (@@find, [10; 0], "UniformOutput", false) -## @result{} -## A = -## @{ -## [1,1] = 1 -## [2,1] = [](0x0) -## @} -## B = -## @{ -## [1,1] = 1 -## [2,1] = [](0x0) -## @} -## C = -## @{ -## [1,1] = 10 -## [2,1] = [](0x0) -## @} -## @end group -## @end example -## -## If the parameter @var{errfunc} after a further string input argument -## "ErrorHandler" is another string, a function handle, an inline -## function or an anonymous function, then @var{errfunc} defines a -## function to call in the case that @var{func} generates an error. -## The definition of the function must be of the form -## -## @example -## function [@dots{}] = errfunc (@var{s}, @dots{}) -## @end example -## -## @noindent -## where there is an additional input argument to @var{errfunc} -## relative to @var{func}, given by @var{s}. This is a structure with -## the elements "identifier", "message" and "index", giving -## respectively the error identifier, the error message and the index of -## the array elements that caused the error. The size of the output -## argument of @var{errfunc} must have the same size as the output -## argument of @var{func}, otherwise a real error is thrown. For -## example: -## -## @example -## @group -## function y = ferr (s, x), y = "MyString"; endfunction -## arrayfun (@@str2num, [1234], \ -## "UniformOutput", false, "ErrorHandler", @@ferr) -## @result{} ans = -## @{ -## [1,1] = MyString -## @} -## @end group -## @end example -## -## @seealso{spfun, cellfun, structfun} -## @end deftypefn - -## Author: Bill Denney <denney@seas.upenn.edu> -## Rewritten: Jaroslav Hajek <highegg@gmail.com> - -function varargout = arrayfun (func, varargin) - - if (nargin < 2) - print_usage (); - endif - - nargs = length (varargin); - - recognized_opts = {"UniformOutput", "ErrorHandler"}; - - while (nargs >= 2) - maybeopt = varargin{nargs-1}; - if (ischar (maybeopt) && any (strcmpi (maybeopt, recognized_opts))) - nargs -= 2; - else - break; - endif - endwhile - - args = varargin(1:nargs); - opts = varargin(nargs+1:end); - - args = cellfun (@num2cell, args, "UniformOutput", false, - "ErrorHandler", @arg_class_error); - - [varargout{1:max(1, nargout)}] = cellfun (func, args{:}, opts{:}); - -endfunction - -function arg_class_error (S, X) - error ("arrayfun: invalid argument of class %s", class (X)); -endfunction - -%% Test function to check the "Errorhandler" option -%!function [z] = arrayfunerror (S, varargin) -%! z = S; -%! endfunction -%% First input argument can be a string, an inline function, a -%% function_handle or an anonymous function -%!test -%! arrayfun (@isequal, [false, true], [true, true]); %% No output argument -%!error -%! arrayfun (@isequal); %% One or less input arguments -%!test -%! A = arrayfun ("isequal", [false, true], [true, true]); -%! assert (A, [false, true]); -%!test -%! A = arrayfun (inline ("(x == y)", "x", "y"), [false, true], [true, true]); -%! assert (A, [false, true]); -%!test -%! A = arrayfun (@isequal, [false, true], [true, true]); -%! assert (A, [false, true]); -%!test -%! A = arrayfun (@(x,y) isequal(x,y), [false, true], [true, true]); -%! assert (A, [false, true]); - -%% Number of input and output arguments may be greater than one -%#!test -%! A = arrayfun (@(x) islogical (x), false); -%! assert (A, true); -%!test -%! A = arrayfun (@(x,y,z) x + y + z, [1, 1, 1], [2, 2, 2], [3, 4, 5]); -%! assert (A, [6, 7, 8], 1e-16); -%!test %% Two input arguments of different types -%! A = arrayfun (@(x,y) islogical (x) && ischar (y), false, "a"); -%! assert (A, true); -%!test %% Pass another variable to the anonymous function -%! y = true; A = arrayfun (@(x) islogical (x && y), false); -%! assert (A, true); -%!test %% Three ouptut arguments of different type -%! [A, B, C] = arrayfun (@find, [10, 11; 0, 12], "UniformOutput", false); -%! assert (isequal (A, {true, true; [], true})); -%! assert (isequal (B, {true, true; [], true})); -%! assert (isequal (C, {10, 11; [], 12})); - -%% Input arguments can be of type logical -%!test -%! A = arrayfun (@(x,y) x == y, [false, true], [true, true]); -%! assert (A, [false, true]); -%!test -%! A = arrayfun (@(x,y) x == y, [false; true], [true; true], "UniformOutput", true); -%! assert (A, [false; true]); -%!test -%! A = arrayfun (@(x) x, [false, true, false, true], "UniformOutput", false); -%! assert (A, {false, true, false, true}); -%!test %% Three ouptut arguments of same type -%! [A, B, C] = arrayfun (@find, [true, false; false, true], "UniformOutput", false); -%! assert (isequal (A, {true, []; [], true})); -%! assert (isequal (B, {true, []; [], true})); -%! assert (isequal (C, {true, []; [], true})); -%!test -%! A = arrayfun (@(x,y) array2str (x,y), true, true, "ErrorHandler", @arrayfunerror); -%! assert (isfield (A, "identifier"), true); -%! assert (isfield (A, "message"), true); -%! assert (isfield (A, "index"), true); -%! assert (isempty (A.message), false); -%! assert (A.index, 1); -%!test %% Overwriting setting of "UniformOutput" true -%! A = arrayfun (@(x,y) array2str (x,y), true, true, \ -%! "UniformOutput", true, "ErrorHandler", @arrayfunerror); -%! assert (isfield (A, "identifier"), true); -%! assert (isfield (A, "message"), true); -%! assert (isfield (A, "index"), true); -%! assert (isempty (A.message), false); -%! assert (A.index, 1); - -%% Input arguments can be of type numeric -%!test -%! A = arrayfun (@(x,y) x>y, [1.1, 4.2], [3.1, 2+3*i]); -%! assert (A, [false, true]); -%!test -%! A = arrayfun (@(x,y) x>y, [1.1, 4.2; 2, 4], [3.1, 2; 2, 4+2*i], "UniformOutput", true); -%! assert (A, [false, true; false, false]); -%!test -%! A = arrayfun (@(x,y) x:y, [1.1, 4], [3.1, 6], "UniformOutput", false); -%! assert (isequal (A{1}, [1.1, 2.1, 3.1])); -%! assert (isequal (A{2}, [4, 5, 6])); -%!test %% Three ouptut arguments of different type -%! [A, B, C] = arrayfun (@find, [10, 11; 0, 12], "UniformOutput", false); -%! assert (isequal (A, {true, true; [], true})); -%! assert (isequal (B, {true, true; [], true})); -%! assert (isequal (C, {10, 11; [], 12})); -%!test -%! A = arrayfun (@(x,y) array2str(x,y), {1.1, 4}, {3.1, 6}, "ErrorHandler", @arrayfunerror); -%! B = isfield (A(1), "message") && isfield (A(1), "index"); -%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); -%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); -%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); -%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); -%! assert ([A(1).index, A(2).index], [1, 2]); -%!test %% Overwriting setting of "UniformOutput" true -%! A = arrayfun (@(x,y) array2str(x,y), {1.1, 4}, {3.1, 6}, \ -%! "UniformOutput", true, "ErrorHandler", @arrayfunerror); -%! B = isfield (A(1), "message") && isfield (A(1), "index"); -%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); -%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); -%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); -%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); -%! assert ([A(1).index, A(2).index], [1, 2]); - -%% Input arguments can be of type character or strings -%!test -%! A = arrayfun (@(x,y) x>y, ["ad", "c", "ghi"], ["cc", "d", "fgh"]); -%! assert (A, [false, true, false, true, true, true]); -%!test -%! A = arrayfun (@(x,y) x>y, ["a"; "f"], ["c"; "d"], "UniformOutput", true); -%! assert (A, [false; true]); -%!test -%! A = arrayfun (@(x,y) x:y, ["a", "d"], ["c", "f"], "UniformOutput", false); -%! assert (A, {"abc", "def"}); -%! %#!test -%! A = arrayfun (@(x,y) cell2str(x,y), ["a", "d"], ["c", "f"], "ErrorHandler", @arrayfunerror); -%! B = isfield (A(1), "identifier") && isfield (A(1), "message") && isfield (A(1), "index"); -%! assert (B, true); - -%% Input arguments can be of type structure -%!test -%! a = struct ("a", 1.1, "b", 4.2); b = struct ("a", 3.1, "b", 2); -%! A = arrayfun (@(x,y) (x.a < y.a) && (x.b > y.b), a, b); -%! assert (A, true); -%!test -%! a = struct ("a", 1.1, "b", 4.2); b = struct ("a", 3.1, "b", 2); -%! A = arrayfun (@(x,y) (x.a < y.a) && (x.b > y.b), a, b, "UniformOutput", true); -%! assert (A, true); -%!test -%! a = struct ("a", 1.1, "b", 4.2); b = struct ("a", 3.1, "b", 2); -%! A = arrayfun (@(x,y) x.a:y.a, a, b, "UniformOutput", false); -%! assert (isequal (A, {[1.1, 2.1, 3.1]})); -%!test -%! A = arrayfun (@(x) mat2str(x), "a", "ErrorHandler", @arrayfunerror); -%! assert (isfield (A, "identifier"), true); -%! assert (isfield (A, "message"), true); -%! assert (isfield (A, "index"), true); -%! assert (isempty (A.message), false); -%! assert (A.index, 1); -%!test %% Overwriting setting of "UniformOutput" true -%! A = arrayfun (@(x) mat2str(x), "a", "UniformOutput", true, \ -%! "ErrorHandler", @arrayfunerror); -%! assert (isfield (A, "identifier"), true); -%! assert (isfield (A, "message"), true); -%! assert (isfield (A, "index"), true); -%! assert (isempty (A.message), false); -%! assert (A.index, 1); - -%% Input arguments can be of type cell array -%!test -%! A = arrayfun (@(x,y) x{1} < y{1}, {1.1, 4.2}, {3.1, 2}); -%! assert (A, [true, false]); -%!test -%! A = arrayfun (@(x,y) x{1} < y{1}, {1.1; 4.2}, {3.1; 2}, "UniformOutput", true); -%! assert (A, [true; false]); -%!test -%! A = arrayfun (@(x,y) x{1} < y{1}, {1.1, 4.2}, {3.1, 2}, "UniformOutput", false); -%! assert (A, {true, false}); -%!test -%! A = arrayfun (@(x,y) num2str(x,y), {1.1, 4.2}, {3.1, 2}, "ErrorHandler", @arrayfunerror); -%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); -%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); -%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); -%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); -%! assert ([A(1).index, A(2).index], [1, 2]); -%!test -%! A = arrayfun (@(x,y) num2str(x,y), {1.1, 4.2}, {3.1, 2}, \ -%! "UniformOutput", true, "ErrorHandler", @arrayfunerror); -%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); -%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); -%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); -%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); -%! assert ([A(1).index, A(2).index], [1, 2]); - -## Local Variables: *** -## mode: octave *** -## End: ***
--- a/scripts/general/bitget.m +++ b/scripts/general/bitget.m @@ -79,3 +79,31 @@ C = bitand (A, bitshift (_conv (1), uint8 (n) - uint8 (1))) != _conv (0); endfunction + +%!error bitget (1); +%!error bitget (1, 2, 3); + +%!test +%! assert (bitget ([4, 14], [3, 3]), logical ([1, 1])); +%! pfx = {"", "u"}; +%! for i = 1:2 +%! for prec = [8, 16, 32, 64] +%! fcn = str2func (sprintf ("%sint%d", pfx{i}, prec)); +%! assert (bitget (fcn ([4, 14]), [3, 3]), logical ([1, 1])); +%! endfor +%! endfor + +%!error bitget (0, 0); +%!error bitget (0, 55); + +%!error bitget (int8 (0), 9); +%!error bitget (uint8 (0), 9); + +%!error bitget (int16 (0), 17); +%!error bitget (uint16 (0), 17); + +%!error bitget (int32 (0), 33); +%!error bitget (uint32 (0), 33); + +%!error bitget (int64 (0), 65); +%!error bitget (uint64 (0), 65);
--- a/scripts/general/bitset.m +++ b/scripts/general/bitset.m @@ -92,3 +92,31 @@ endif endfunction + +%!error bitset (1); +%!error bitset (1, 2, 3, 4); + +%!test +%! assert (bitset ([0, 10], [3, 3]), [4, 14]); +%! pfx = {"", "u"}; +%! for i = 1:2 +%! for prec = [8, 16, 32, 64] +%! fcn = str2func (sprintf ("%sint%d", pfx{i}, prec)); +%! assert (bitset (fcn ([0, 10]), [3, 3]), fcn ([4, 14])); +%! endfor +%! endfor + +%!error bitset (0, 0); +%!error bitset (0, 55); + +%!error bitset (int8 (0), 9); +%!error bitset (uint8 (0), 9); + +%!error bitset (int16 (0), 17); +%!error bitset (uint16 (0), 17); + +%!error bitset (int32 (0), 33); +%!error bitset (uint32 (0), 33); + +%!error bitset (int64 (0), 65); +%!error bitset (uint64 (0), 65);
--- a/scripts/general/blkdiag.m +++ b/scripts/general/blkdiag.m @@ -18,10 +18,11 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} blkdiag (@var{A}, @var{B}, @var{C}, @dots{}) -## Build a block diagonal matrix from @var{A}, @var{B}, @var{C}, @dots{}. +## Build a block diagonal matrix from @var{A}, @var{B}, @var{C}, @dots{} ## All the arguments must be numeric and are two-dimensional matrices or -## scalars. -## @seealso{diag, horzcat, vertcat} +## scalars. If any argument is of type sparse, the output will also be +## sparse. +## @seealso{diag, horzcat, vertcat, sparse} ## @end deftypefn ## Author: Daniel Calvelo @@ -33,7 +34,7 @@ print_usage (); endif - if (! all (cellfun (@isnumeric, varargin))) + if (! all (cellfun ("isnumeric", varargin))) error ("blkdiag: all arguments must be numeric"); endif @@ -46,7 +47,12 @@ ## calling size directly. tmp = cell2mat (cellfun (@size, varargin', "uniformoutput", false)); csz = cumsum ([0 0; tmp], 1); - retval = zeros (csz(end,:)); + + if (any (cellfun ("issparse", varargin))) + retval = sparse (csz(end,1), csz(end,2)); + else + retval = zeros (csz(end,:)); + endif for p = 1:nargin vp = varargin{p}; @@ -57,15 +63,18 @@ endfunction -# regular tests +## regular tests %!assert(blkdiag(1,ones(2),1),[1,0,0,0;0,1,1,0;0,1,1,0;0,0,0,1]) %!assert(blkdiag([1,2],[3,4],[5,6]),[1,2,0,0,0,0;0,0,3,4,0,0;0,0,0,0,5,6]) %!assert(blkdiag([1,2],[3;4],[5,6]),[1,2,0,0,0;0,0,3,0,0;0,0,4,0,0;0,0,0,5,6]) %!assert(blkdiag([1,2;3,4],[5,6,7]),[1,2,0,0,0;3,4,0,0,0;0,0,5,6,7]) -# tests involving empty matrices +## tests involving empty matrices %!assert(blkdiag([],[],[]),[]) %!assert(blkdiag([],[1,2;3,4],[],5,[]),[1,2,0;3,4,0;0,0,5]) %!assert(blkdiag(zeros(1,0,1),[1,2,3],1,0,5,zeros(0,1,1)),[0,0,0,0,0,0,0;1,2,3,0,0,0,0;0,0,0,1,0,0,0;0,0,0,0,0,0,0;0,0,0,0,0,5,0]); +## tests involving sparse matrices +%!assert (blkdiag (sparse([1,2;3,4]),[5,6;7,8]), sparse([1,2,0,0;3,4,0,0;0,0,5,6;0,0,7,8])) +%!assert (blkdiag (sparse([1,2;3,4]),[5,6]), sparse([1,2,0,0;3,4,0,0;0,0,5,6])) # sanity checks %!test %! A = rand (round (rand (1, 2) * 10));
--- a/scripts/general/cell2mat.m +++ b/scripts/general/cell2mat.m @@ -43,11 +43,11 @@ else ## We only want numeric, logical, and char matrices. - valid = cellfun (@isnumeric, c); - valid |= cellfun (@islogical, c); - valid |= cellfun (@ischar, c); - validc = cellfun (@iscell, c); - valids = cellfun (@isstruct, c); + valid = cellfun ("isnumeric", c); + valid |= cellfun ("islogical", c); + valid |= cellfun ("isclass", c, "char"); + validc = cellfun ("isclass", c, "cell"); + valids = cellfun ("isclass", c, "struct"); if (! all (valid(:)) && ! all (validc(:)) && ! all (valids(:))) error ("cell2mat: wrong type elements or mixed cells, structs and matrices"); @@ -71,7 +71,7 @@ endif xdim = [1:idim-1, idim+1:nd]; cc = num2cell (c, xdim); - c = cellfun (@cat, {idim}, cc{:}, "uniformoutput", false); + c = cellfun ("cat", {idim}, cc{:}, "uniformoutput", false); endfor m = c{1}; endif
--- a/scripts/general/celldisp.m +++ b/scripts/general/celldisp.m @@ -80,4 +80,8 @@ %!demo %! c = {1, 2, {31, 32}}; -%! celldisp(c, "b") \ No newline at end of file +%! celldisp(c, "b") + +%!error celldisp (); +%!error celldisp ({}, "name", 1); +%!error celldisp (1);
--- a/scripts/general/circshift.m +++ b/scripts/general/circshift.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{y} =} circshift (@var{x}, @var{n}) -## Circularly shifts the values of the array @var{x}. @var{n} must be +## Circularly shift the values of the array @var{x}. @var{n} must be ## a vector of integers no longer than the number of dimensions in ## @var{x}. The values of @var{n} can be either positive or negative, ## which determines the direction in which the values or @var{x} are @@ -47,53 +47,58 @@ function y = circshift (x, n) - if (nargin == 2) - if (isempty (x)) - y = x; - else - nd = ndims (x); - sz = size (x); - - if (! isvector (n) && length (n) > nd) - error ("circshift: N must be a vector, no longer than the number of dimension in X"); - endif - - if (any (n != floor (n))) - error ("circshift: all values of N must be integers"); - endif - - idx = cell (); - for i = 1:length (n); - nn = n(i); - if (nn < 0) - while (sz(i) <= -nn) - nn = nn + sz(i); - endwhile - idx{i} = [(1-nn):sz(i), 1:-nn]; - else - while (sz(i) <= nn) - nn = nn - sz(i); - endwhile - idx{i} = [(sz(i)-nn+1):sz(i), 1:(sz(i)-nn)]; - endif - endfor - for i = (length(n) + 1) : nd - idx{i} = 1:sz(i); - endfor - y = x(idx{:}); - endif - else + if (nargin != 2) print_usage (); endif + + if (isempty (x)) + y = x; + return; + endif + + nd = ndims (x); + sz = size (x); + + if (! isvector (n) || length (n) > nd) + error ("circshift: N must be a vector, no longer than the number of dimension in X"); + elseif (any (n != fix (n))) + error ("circshift: all values of N must be integers"); + endif + + idx = repmat ({':'}, 1, nd); + for i = 1:length (n); + b = n(i); + d = sz(i); + if (b > 0) + b = rem (b, d); + idx{i} = [d-b+1:d, 1:d-b]; + elseif (b < 0) + b = rem (abs (b), d); + idx{i} = [b+1:d, 1:b]; + endif + endfor + + y = x(idx{:}); + endfunction + %!shared x %! x = [1, 2, 3; 4, 5, 6; 7, 8, 9]; %!assert (circshift (x, 1), [7, 8, 9; 1, 2, 3; 4, 5, 6]) %!assert (circshift (x, -2), [7, 8, 9; 1, 2, 3; 4, 5, 6]) -%!assert (circshift (x, [0, 1]), [3, 1, 2; 6, 4, 5; 9, 7, 8]); -%!assert (circshift ([],1), []) +%!assert (circshift (x, [0, 1]), [3, 1, 2; 6, 4, 5; 9, 7, 8]) +%!assert (circshift ([], 1), []) + +%!assert (circshift (eye (3), 1), circshift (eye (3), 1)) +%!assert (circshift (eye (3), 1), [0,0,1;1,0,0;0,1,0]) -%!assert (full (circshift (eye (3), 1)), circshift (full (eye (3)), 1)) -%!assert (full (circshift (eye (3), 1)), [0,0,1;1,0,0;0,1,0]) +%% Test input validation +%!error circshift () +%!error circshift (1) +%!error circshift (1,2,3) +%!error circshift (1, ones(2,2)) +%!error circshift (1, [1 2 3]) +%!error circshift (1, 1.5) +
--- a/scripts/general/colon.m +++ b/scripts/general/colon.m @@ -34,5 +34,11 @@ ## @end deftypefn function r = colon (varargin) - error ("colon: not defined for class \"%s\"", class(varargin{1})); + if (nargin != 0) + error ("colon: not defined for class \"%s\"", class(varargin{1})); + endif endfunction + +%!error colon (1) + +## FIXME -- what does colon () mean since it doesn't set a return value?
--- a/scripts/general/common_size.m +++ b/scripts/general/common_size.m @@ -52,7 +52,7 @@ endif ## Find scalar args. - nscal = cellfun (@numel, varargin) != 1; + nscal = cellfun ("numel", varargin) != 1; i = find (nscal, 1); @@ -60,7 +60,7 @@ errorcode = 0; varargout = varargin; else - match = cellfun (@size_equal, varargin, varargin(i)); + match = cellfun ("size_equal", varargin, varargin(i)); if (any (nscal &! match)) errorcode = 1; varargout = varargin; @@ -78,3 +78,13 @@ endif endif endfunction + +%!error common_size (); + +%!test +%! m = [1,2;3,4]; +%! [err, a, b, c] = common_size (m, 3, 5); +%! assert (err, 0); +%! assert (a, m); +%! assert (b, [3,3;3,3]); +%! assert (c, [5,5;5,5]);
--- a/scripts/general/cumtrapz.m +++ b/scripts/general/cumtrapz.m @@ -17,18 +17,26 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{z} =} cumtrapz (@var{y}) -## @deftypefnx {Function File} {@var{z} =} cumtrapz (@var{x}, @var{y}) -## @deftypefnx {Function File} {@var{z} =} cumtrapz (@dots{}, @var{dim}) +## @deftypefn {Function File} {@var{q} =} cumtrapz (@var{y}) +## @deftypefnx {Function File} {@var{q} =} cumtrapz (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{q} =} cumtrapz (@dots{}, @var{dim}) ## -## Cumulative numerical integration using trapezoidal method. -## @code{cumtrapz (@var{y})} computes the cumulative integral of the -## @var{y} along the first non-singleton dimension. If the argument -## @var{x} is omitted an equally spaced vector is assumed. @code{cumtrapz -## (@var{x}, @var{y})} evaluates the cumulative integral with respect -## to @var{x}. +## Cumulative numerical integration of points @var{y} using the trapezoidal +## method. +## @w{@code{cumtrapz (@var{y})}} computes the cumulative integral of @var{y} +## along the first non-singleton dimension. Where @code{trapz} reports +## only the overall integral sum, @code{cumtrapz} reports the current partial +## sum value at each point of @var{y}. When the argument @var{x} is omitted +## an equally spaced @var{x} vector with unit spacing (1) is assumed. +## @code{cumtrapz (@var{x}, @var{y})} evaluates the integral with respect to +## the spacing in @var{x} and the values in @var{y}. This is useful if the +## points in @var{y} have been sampled unevenly. If the optional @var{dim} +## argument is given, operate along this dimension. ## -## @seealso{trapz,cumsum} +## If @var{x} is not specified then unit spacing will be used. To scale +## the integral to the correct value you must multiply by the actual spacing +## value (deltaX). +## @seealso{trapz, cumsum} ## @end deftypefn ## Author: Kai Habel <kai.habel@gmx.de> @@ -42,53 +50,61 @@ print_usage (); endif - nd = ndims (x); - sz = size (x); + have_xy = have_dim = false; - have_x = false; - have_dim = false; if (nargin == 3) - have_x = true; + have_xy = true; have_dim = true; elseif (nargin == 2) if (! size_equal (x, y) && isscalar (y)) dim = y; have_dim = true; else - have_x = true; + have_xy = true; endif endif + if (have_xy) + nd = ndims (y); + sz = size (y); + else + nd = ndims (x); + sz = size (x); + endif + if (! have_dim) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else - dim = floor (dim); - if (! (isscalar (dim) && 1 <= dim && dim <= nd)) - error ("cumtrapz: invalid dimension DIM"); + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("trapz: DIM must be an integer and a valid dimension"); endif endif n = sz(dim); - idx1 = cell (); - for i = 1:nd - idx1{i} = 1:sz(i); - endfor - idx2 = idx1; + idx1 = idx2 = repmat ({':'}, [nd, 1]); idx1{dim} = 2 : n; idx2{dim} = 1 : (n - 1); - if (! have_x) + if (! have_xy) z = 0.5 * cumsum (x(idx1{:}) + x(idx2{:}), dim); else - if (! size_equal (x, y)) - error ("cumtrapz: X and Y must have the same shape"); + if (isvector (x) && !isvector (y)) + if (length (x) != sz(dim)) + error ("cumtrapz: length of X and length of Y along DIM must match"); + endif + ## Reshape vector to point along dimension DIM + shape = ones (nd, 1); + shape(dim) = sz(dim); + x = reshape (x, shape); + z = 0.5 * cumsum (bsxfun (@times, diff (x), y(idx1{:}) + y(idx2{:})), dim); + else + if (! size_equal (x, y)) + error ("cumtrapz: X and Y must have same shape"); + endif + z = 0.5 * cumsum (diff (x, 1, dim) .* (y(idx1{:}) + y(idx2{:})), dim); endif - z = 0.5 * cumsum ((x(idx1{:}) - x(idx2{:})) .* - (y(idx1{:}) + y(idx2{:})), dim); endif sz(dim) = 1; @@ -96,13 +112,23 @@ endfunction + %!shared x1,x2,y %! x1 = [0,0,0;2,2,2]; %! x2 = [0,2,4;0,2,4]; %! y = [1,2,3;4,5,6]; -%!assert (cumtrapz(y),[0,0,0;2.5,3.5,4.5]) -%!assert (cumtrapz(x1,y),[0,0,0;5,7,9]) -%!assert (cumtrapz(y,1),[0,0,0;2.5,3.5,4.5]) -%!assert (cumtrapz(x1,y,1),[0,0,0;5,7,9]) -%!assert (cumtrapz(y,2),[0,1.5,4;0,4.5,10]) -%!assert (cumtrapz(x2,y,2),[0,3,8;0,9,20]) +%!assert (cumtrapz(y), [0,0,0;2.5,3.5,4.5]) +%!assert (cumtrapz(x1,y), [0,0,0;5,7,9]) +%!assert (cumtrapz(y,1), [0,0,0;2.5,3.5,4.5]) +%!assert (cumtrapz(x1,y,1), [0,0,0;5,7,9]) +%!assert (cumtrapz(y,2), [0,1.5,4;0,4.5,10]) +%!assert (cumtrapz(x2,y,2), [0,3,8;0,9,20]) +%% Test ND-array implementation +%!shared x1,x2,y +%! x1 = 1:3; +%! x2 = reshape ([0,2,4;0,2,4], [1 2 3]); +%! y = reshape ([1,2,3;4,5,6], [1 2 3]); +%!assert (cumtrapz(y,3), reshape([0,1.5,4;0,4.5,10],[1 2 3])) +%!assert (cumtrapz(x1,y,3), reshape([0,1.5,4;0,4.5,10],[1 2 3])) +%!assert (cumtrapz(x2,y,3), reshape([0,3,8;0,9,20],[1 2 3])) +
--- a/scripts/general/curl.m +++ b/scripts/general/curl.m @@ -44,7 +44,7 @@ ## for two-dimensional input. For three-dimensional input the scalar ## rotation is calculated at each grid point in direction of the vector field ## at that point. -## @seealso{divergence, gradient, del2, cross, dot} +## @seealso{divergence, gradient, del2, cross} ## @end deftypefn ## Author: Kai Habel <kai.habel@gmx.de>
--- a/scripts/general/dblquad.m +++ b/scripts/general/dblquad.m @@ -17,30 +17,43 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} dblquad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{tol}, @var{quadf}, @dots{}) -## Numerically evaluate a double integral. The function over with to -## integrate is defined by @code{@var{f}}, and the interval for the -## integration is defined by @code{[@var{xa}, @var{xb}, @var{ya}, -## @var{yb}]}. The function @var{f} must accept a vector @var{x} and a -## scalar @var{y}, and return a vector of the same length as @var{x}. +## @deftypefn {Function File} {} dblquad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}) +## @deftypefnx {Function File} {} dblquad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{tol}) +## @deftypefnx {Function File} {} dblquad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{tol}, @var{quadf}) +## @deftypefnx {Function File} {} dblquad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{tol}, @var{quadf}, @dots{}) +## Numerically evaluate the double integral of @var{f}. +## @var{f} is a function handle, inline function, or string +## containing the name of the function to evaluate. The function @var{f} must +## have the form @math{z = f(x,y)} where @var{x} is a vector and @var{y} is a +## scalar. It should return a vector of the same length and orientation as +## @var{x}. ## -## If defined, @var{tol} defines the absolute tolerance to which to -## which to integrate each sub-integral. +## @var{xa}, @var{ya} and @var{xb}, @var{yb} are the lower and upper limits of +## integration for x and y respectively. The underlying integrator determines +## whether infinite bounds are accepted. +## +## The optional argument @var{tol} defines the absolute tolerance used to +## integrate each sub-integral. The default value is @math{1e^{-6}}. +## +## The optional argument @var{quadf} specifies which underlying integrator +## function to use. Any choice but @code{quad} is available and the default +## is @code{quadcc}. ## ## Additional arguments, are passed directly to @var{f}. To use the default -## value for @var{tol} one may pass an empty matrix. -## @seealso{triplequad,quad,quadv,quadl,quadgk,quadcc,trapz} +## value for @var{tol} or @var{quadf} one may pass ':' or an empty matrix ([]). +## @seealso{triplequad, quad, quadv, quadl, quadgk, quadcc, trapz} ## @end deftypefn -function q = dblquad(f, xa, xb, ya, yb, tol, quadf, varargin) +function q = dblquad (f, xa, xb, ya, yb, tol = 1e-6, quadf = @quadcc, varargin) + if (nargin < 5) print_usage (); endif - if (nargin < 6 || isempty (tol)) + if (isempty (tol)) tol = 1e-6; endif - if (nargin < 7 || isempty (quadf)) - quadf = @quadgk; + if (isempty (quadf)) + quadf = @quadcc; endif inner = @__dblquad_inner__; @@ -60,9 +73,10 @@ endfor endfunction -%% Nasty integrand to show quadgk off +%% Nasty integrand to show quadcc off %!assert (dblquad (@(x,y) 1 ./ (x+y), 0, 1, 0, 1), 2*log(2), 1e-6) -%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, [], @quadgk), pi * erf(1).^2, 1e-6) -%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, [], @quadl), pi * erf(1).^2, 1e-6) -%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, [], @quadv), pi * erf(1).^2, 1e-6) +%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, 1e-6, @quadgk), pi * erf(1).^2, 1e-6) +%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, 1e-6, @quadl), pi * erf(1).^2, 1e-6) +%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, 1e-6, @quadv), pi * erf(1).^2, 1e-6) +
--- a/scripts/general/display.m +++ b/scripts/general/display.m @@ -33,9 +33,18 @@ ## @end deftypefn function idx = display (a) - if (nargin == 1) - error ("display: not defined for class \"%s\"", class(a)); - else + + if (nargin != 1) print_usage (); endif + + ## Only reason we got here is that there was no overloaded display() + ## function for object a. This may mean it is a built-in. + str = disp (a); + if (isempty (strfind (str, "<class "))) + disp (str); + else + error ('display: not defined for class "%s"', class (a)); + endif + endfunction
--- a/scripts/general/divergence.m +++ b/scripts/general/divergence.m @@ -42,7 +42,7 @@ ## The coordinates of the vector field can be given by the arguments @var{x}, ## @var{y}, @var{z} or @var{x}, @var{y} respectively. ## -## @seealso{curl, gradient, del2, cross, dot} +## @seealso{curl, gradient, del2, dot} ## @end deftypefn ## Author: Kai Habel <kai.habel@gmx.de>
--- a/scripts/general/flipdim.m +++ b/scripts/general/flipdim.m @@ -43,9 +43,10 @@ endif nd = ndims (x); + sz = size (x); if (nargin == 1) ## Find the first non-singleton dimension. - [~, dim] = min (size (x) != 1); + (dim = find (sz > 1, 1)) || (dim = 1); elseif (! (isscalar (dim) && isindex (dim))) error ("flipdim: DIM must be a positive integer"); endif @@ -55,3 +56,12 @@ y = x(idx{:}); endfunction + +%!error flipdim (); +%!error flipdim (1, 2, 3); + +%!assert (flipdim ([1,2;3,4]), flipdim ([1,2 ; 3,4], 1)); +%!assert (flipdim ([1,2;3,4], 2), [2,1;4,3]); +%!assert (flipdim ([1,2;3,4], 3), [1,2;3,4]); + +## FIXME -- we need tests for multidimensional arrays.
--- a/scripts/general/fliplr.m +++ b/scripts/general/fliplr.m @@ -18,7 +18,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} fliplr (@var{x}) -## Return a copy of @var{x} with the order of the columns reversed. For +## Return a copy of @var{x} with the order of the columns reversed. In +## other words, @var{x} is flipped left-to-right about a vertical axis. For ## example: ## ## @example @@ -29,7 +30,7 @@ ## @end group ## @end example ## -## Note that @code{fliplr} only work with 2-D arrays. To flip N-d arrays +## Note that @code{fliplr} only works with 2-D arrays. To flip N-D arrays ## use @code{flipdim} instead. ## @seealso{flipud, flipdim, rot90, rotdim} ## @end deftypefn
--- a/scripts/general/flipud.m +++ b/scripts/general/flipud.m @@ -18,7 +18,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} flipud (@var{x}) -## Return a copy of @var{x} with the order of the rows reversed. For +## Return a copy of @var{x} with the order of the rows reversed. In +## other words, @var{x} is flipped upside-down about a horizontal axis. For ## example: ## ## @example @@ -29,8 +30,7 @@ ## @end group ## @end example ## -## Due to the difficulty of defining which axis about which to flip the -## matrix @code{flipud} only work with 2-d arrays. To flip N-d arrays +## Note that @code{flipud} only works with 2-D arrays. To flip N-D arrays ## use @code{flipdim} instead. ## @seealso{fliplr, flipdim, rot90, rotdim} ## @end deftypefn
--- a/scripts/general/gradient.m +++ b/scripts/general/gradient.m @@ -88,7 +88,7 @@ if (isvector (m)) ## make a row vector. transposed = (size (m, 2) == 1); - m = m(:)'; + m = m(:).'; endif nd = ndims (m); @@ -259,6 +259,34 @@ %! assert (all(dU(:)==2)); %!test +%! [Y,X,Z,U] = ndgrid (2:2:8,1:5,4:4:12,3:5:30); +%! [dX,dY,dZ,dU] = gradient (X+j*X); +%! assert (all(dX(:)==1+1j)); +%! assert (all(dY(:)==0)); +%! assert (all(dZ(:)==0)); +%! assert (all(dU(:)==0)); +%! [dX,dY,dZ,dU] = gradient (Y-j*Y); +%! assert (all(dX(:)==0)); +%! assert (all(dY(:)==2-j*2)); +%! assert (all(dZ(:)==0)); +%! assert (all(dU(:)==0)); +%! [dX,dY,dZ,dU] = gradient (Z+j*1); +%! assert (all(dX(:)==0)); +%! assert (all(dY(:)==0)); +%! assert (all(dZ(:)==4)); +%! assert (all(dU(:)==0)); +%! [dX,dY,dZ,dU] = gradient (U-j*1); +%! assert (all(dX(:)==0)); +%! assert (all(dY(:)==0)); +%! assert (all(dZ(:)==0)); +%! assert (all(dU(:)==5)); +%! assert (size_equal(dX, dY, dZ, dU, X, Y, Z, U)); +%! [dX,dY,dZ,dU] = gradient (U, 5.0); +%! assert (all(dU(:)==1)); +%! [dX,dY,dZ,dU] = gradient (U, 1.0, 2.0, 3.0, 2.5); +%! assert (all(dU(:)==2)); + +%!test %! x = 0:10; %! f = @cos; %! df_dx = @(x) -sin (x);
--- a/scripts/general/int2str.m +++ b/scripts/general/int2str.m @@ -49,31 +49,33 @@ function retval = int2str (n) - if (nargin == 1) - n = round (real(n)); - sz = size(n); - nd = ndims (n); - nc = columns (n); - if (nc > 1) - idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor - idx(2) = 1; - ifmt = get_fmt (n(idx{:}), 0); - idx(2) = 2:sz(2); - rfmt = get_fmt (n(idx{:}), 2); - fmt = cstrcat (ifmt, repmat (rfmt, 1, nc-1), "\n"); - else - fmt = cstrcat (get_fmt (n, 0), "\n"); - endif - tmp = sprintf (fmt, permute (n, [2, 1, 3 : nd])); - tmp(end) = ""; - retval = char (strsplit (tmp, "\n")); - else + if (nargin != 1) print_usage (); endif + if (isempty (n)) + retval = ''; + return; + endif + + n = round (real(n)); + sz = size(n); + nd = ndims (n); + nc = columns (n); + if (nc > 1) + idx = repmat ({':'}, nd, 1); + idx(2) = 1; + ifmt = get_fmt (n(idx{:}), 0); + idx(2) = 2:sz(2); + rfmt = get_fmt (n(idx{:}), 2); + fmt = cstrcat (ifmt, repmat (rfmt, 1, nc-1), "\n"); + else + fmt = cstrcat (get_fmt (n, 0), "\n"); + endif + tmp = sprintf (fmt, permute (n, [2, 1, 3 : nd])); + tmp(end) = ""; + retval = char (strsplit (tmp, "\n")); + endfunction function fmt = get_fmt (x, sep) @@ -112,8 +114,10 @@ endfunction -%!assert(strcmp (int2str (-123), "-123") && strcmp (int2str (1.2), "1")); +%!assert (strcmp (int2str (-123), "-123") && strcmp (int2str (1.2), "1")); %!assert (all (int2str ([1, 2, 3; 4, 5, 6]) == ["1 2 3";"4 5 6"])); +%!assert (int2str([]), ""); + %!error int2str (); %!error int2str (1, 2);
--- a/scripts/general/interp1.m +++ b/scripts/general/interp1.m @@ -43,7 +43,7 @@ ## Piecewise cubic Hermite interpolating polynomial ## ## @item 'cubic' -## Cubic interpolation from four nearest neighbors +## Cubic interpolation (same as @code{pchip}) ## ## @item 'spline' ## Cubic spline interpolation---smooth first and second derivatives @@ -112,7 +112,7 @@ method = "linear"; extrap = NA; xi = []; - pp = false; + ispp = false; firstnumeric = true; if (nargin > 2) @@ -123,7 +123,7 @@ if (strcmp ("extrap", arg)) extrap = "extrap"; elseif (strcmp ("pp", arg)) - pp = true; + ispp = true; else method = arg; endif @@ -138,7 +138,7 @@ endfor endif - if (isempty (xi) && firstnumeric && ! pp) + if (isempty (xi) && firstnumeric && ! ispp) xi = y; y = x; x = 1:numel(y); @@ -150,9 +150,8 @@ szx = size (xi); if (isvector (y)) y = y(:); - elseif (isvector (xi)) - szx = length (xi); endif + szy = size (y); y = y(:,:); [ny, nc] = size (y); @@ -191,147 +190,85 @@ switch (method) case "nearest" - if (pp) - yi = mkpp ([x(1); (x(1:nx-1)+x(2:nx))/2; x(nx)], y, szy(2:end)); + pp = mkpp ([x(1); (x(1:nx-1)+x(2:nx))/2; x(nx)], shiftdim (y, 1), szy(2:end)); + pp.orient = "first"; + + if (ispp) + yi = pp; else - idx = lookup (0.5*(x(1:nx-1)+x(2:nx)), xi) + 1; - yi = y(idx,:); + yi = ppval (pp, reshape (xi, szx)); endif case "*nearest" - if (pp) - yi = mkpp ([x(1); x(1)+[0.5:(nx-1)]'*dx; x(nx)], y, szy(2:end)); + pp = mkpp ([x(1), x(1)+[0.5:(nx-1)]*dx, x(nx)], shiftdim (y, 1), szy(2:end)); + pp.orient = "first"; + if (ispp) + yi = pp; else - idx = max (1, min (ny, floor((xi-x(1))/dx+1.5))); - yi = y(idx,:); + yi = ppval(pp, reshape (xi, szx)); endif case "linear" dy = diff (y); dx = diff (x); - if (pp) - coefs = [dy./dx, y(1:nx-1)]; - xx = x; - if (have_jumps) - ## Omit zero-size intervals. - coefs(jumps) = []; - xx(jumps) = []; - endif - yi = mkpp (xx, coefs, szy(2:end)); + dx = repmat (dx, [1 size(dy)(2:end)]); + coefs = [(dy./dx).'(:), y(1:nx-1, :).'(:)]; + xx = x; + + if (have_jumps) + ## Omit zero-size intervals. + coefs(jumps, :) = []; + xx(jumps) = []; + endif + + pp = mkpp (xx, coefs, szy(2:end)); + pp.orient = "first"; + + if (ispp) + yi = pp; else - ## find the interval containing the test point - idx = lookup (x, xi, "lr"); - ## use the endpoints of the interval to define a line - s = (xi - x(idx))./dx(idx); - yi = bsxfun (@times, s, dy(idx,:)) + y(idx,:); - if (have_jumps) - ## Fix the corner cases of discontinuities at boundaries. - ## Internal discontinuities already handled correctly. - if (jumps (1)) - mask = xi < x(1); - yi(mask,:) = y(1*ones (1, sum (mask)),:); - endif - if (jumps(nx-1)) - mask = xi >= x(nx); - yi(mask,:) = y(nx*ones (1, sum (mask)),:); - endif - endif + yi = ppval(pp, reshape (xi, szx)); endif + case "*linear" dy = diff (y); - if (pp) - yi = mkpp (x(1) + [0:ny-1]*dx, [dy./dx, y(1:end-1)], szy(2:end)); + coefs = [(dy/dx).'(:), y(1:nx-1, :).'(:)]; + pp = mkpp (x, coefs, szy(2:end)); + pp.orient = "first"; + + if (ispp) + yi = pp; else - ## find the interval containing the test point - t = (xi - x(1))/dx + 1; - idx = max (1, min (ny - 1, floor (t))); + yi = ppval(pp, reshape (xi, szx)); + endif - ## use the endpoints of the interval to define a line - s = t - idx; - yi = bsxfun (@times, s, dy(idx,:)) + y(idx,:); - endif - case {"pchip", "*pchip"} + case {"pchip", "*pchip", "cubic", "*cubic"} if (nx == 2 || starmethod) x = linspace (x(1), x(nx), ny); endif - ## Note that pchip's arguments are transposed relative to interp1 - if (pp) - yi = pchip (x.', y.'); - yi.d = szy(2:end); - else - yi = pchip (x.', y.', xi.').'; - endif - case {"cubic", "*cubic"} - if (nx < 4 || ny < 4) - error ("interp1: table too short"); - endif - - ## FIXME Is there a better way to treat pp return and *cubic - if (starmethod && ! pp) - ## From: Miloje Makivic - ## http://www.npac.syr.edu/projects/nasa/MILOJE/final/node36.html - t = (xi - x(1))/dx + 1; - idx = max (min (floor (t), ny-2), 2); - t = t - idx; - t2 = t.*t; - tp = 1 - 0.5*t; - a = (1 - t2).*tp; - b = (t2 + t).*tp; - c = (t2 - t).*tp/3; - d = (t2 - 1).*t/6; - J = ones (1, nc); - - yi = a(:,J) .* y(idx,:) + b(:,J) .* y(idx+1,:) ... - + c(:,J) .* y(idx-1,:) + d(:,J) .* y(idx+2,:); + if (ispp) + y = shiftdim (reshape (y, szy), 1); + yi = pchip (x, y); else - if (starmethod) - x = linspace (x(1), x(nx), ny).'; - nx = ny; - endif - - idx = lookup (x(2:nx-1), xi, "lr"); - - ## Construct cubic equations for each interval using divided - ## differences (computation of c and d don't use divided differences - ## but instead solve 2 equations for 2 unknowns). Perhaps - ## reformulating this as a lagrange polynomial would be more efficient. - i = 1:nx-3; - J = ones (1, nc); - dx = diff (x); - dx2 = x(i+1).^2 - x(i).^2; - dx3 = x(i+1).^3 - x(i).^3; - a = diff (y, 3)./dx(i,J).^3/6; - b = (diff (y(1:nx-1,:), 2)./dx(i,J).^2 - 6*a.*x(i+1,J))/2; - c = (diff (y(1:nx-2,:), 1) - a.*dx3(:,J) - b.*dx2(:,J))./dx(i,J); - d = y(i,:) - ((a.*x(i,J) + b).*x(i,J) + c).*x(i,J); - - if (pp) - xs = [x(1);x(3:nx-2)]; - yi = mkpp ([x(1);x(3:nx-2);x(nx)], - [a(:), (b(:) + 3.*xs(:,J).*a(:)), ... - (c(:) + 2.*xs(:,J).*b(:) + 3.*xs(:,J)(:).^2.*a(:)), ... - (d(:) + xs(:,J).*c(:) + xs(:,J).^2.*b(:) + ... - xs(:,J).^3.*a(:))], szy(2:end)); - else - yi = ((a(idx,:).*xi(:,J) + b(idx,:)).*xi(:,J) ... - + c(idx,:)).*xi(:,J) + d(idx,:); - endif + y = shiftdim (y, 1); + yi = pchip (x, y, reshape (xi, szx)); endif case {"spline", "*spline"} if (nx == 2 || starmethod) x = linspace(x(1), x(nx), ny); endif - ## Note that spline's arguments are transposed relative to interp1 - if (pp) - yi = spline (x.', y.'); - yi.d = szy(2:end); + + if (ispp) + y = shiftdim (reshape (y, szy), 1); + yi = spline (x, y); else - yi = spline (x.', y.', xi.').'; + y = shiftdim (y, 1); + yi = spline (x, y, reshape (xi, szx)); endif otherwise error ("interp1: invalid method '%s'", method); endswitch - if (! pp) + if (! ispp) if (! ischar (extrap)) ## determine which values are out of range and set them to extrap, ## unless extrap == "extrap". @@ -339,10 +276,24 @@ maxx = max (x(1), x(nx)); outliers = xi < minx | ! (xi <= maxx); # this catches even NaNs - yi(outliers, :) = extrap; + if (size_equal (outliers, yi)) + yi(outliers) = extrap; + yi = reshape (yi, szx); + elseif (!isvector (yi)) + if (strcmp (method, "pchip") || strcmp (method, "*pchip") + ||strcmp (method, "cubic") || strcmp (method, "*cubic") + ||strcmp (method, "spline") || strcmp (method, "*spline")) + yi(:, outliers) = extrap; + yi = shiftdim(yi, 1); + else + yi(outliers, :) = extrap; + endif + else + yi(outliers.') = extrap; + endif endif - - yi = reshape (yi, [szx, szy(2:end)]); + else + yi.orient = "first"; endif endfunction @@ -394,6 +345,7 @@ %! %-------------------------------------------------------- %! % confirm that interpolated function matches the original +##FIXME: add test for n-d arguments here ## For each type of interpolated test, confirm that the interpolated ## value at the knots match the values at the knots. Points away @@ -595,7 +547,6 @@ %!assert (interp1(1:2,1:2,1.4,"nearest"),1); %!error interp1(1,1,1, "linear"); %!assert (interp1(1:2,1:2,1.4,"linear"),1.4); -%!error interp1(1:3,1:3,1, "cubic"); %!assert (interp1(1:4,1:4,1.4,"cubic"),1.4); %!assert (interp1(1:2,1:2,1.1, "spline"), 1.1); %!assert (interp1(1:3,1:3,1.4,"spline"),1.4); @@ -604,7 +555,6 @@ %!assert (interp1(1:2:4,1:2:4,1.4,"*nearest"),1); %!error interp1(1,1,1, "*linear"); %!assert (interp1(1:2:4,1:2:4,[0,1,1.4,3,4],"*linear"),[NA,1,1.4,3,NA]); -%!error interp1(1:3,1:3,1, "*cubic"); %!assert (interp1(1:2:8,1:2:8,1.4,"*cubic"),1.4); %!assert (interp1(1:2,1:2,1.3, "*spline"), 1.3); %!assert (interp1(1:2:6,1:2:6,1.4,"*spline"),1.4); @@ -612,5 +562,5 @@ %!assert (interp1([3,2,1],[3,2,2],2.5),2.5) %!assert (interp1 ([1,2,2,3,4],[0,1,4,2,1],[-1,1.5,2,2.5,3.5], "linear", "extrap"), [-2,0.5,4,3,1.5]) -%!assert (interp1 ([4,4,3,2,0],[0,1,4,2,1],[1.5,4,4.5], "linear"), [0,1,NA]) +%!assert (interp1 ([4,4,3,2,0],[0,1,4,2,1],[1.5,4,4.5], "linear"), [1.75,1,NA]) %!assert (interp1 (0:4, 2.5), 1.5)
--- a/scripts/general/interp2.m +++ b/scripts/general/interp2.m @@ -101,9 +101,11 @@ switch (nargin) case 1 Z = varargin{1}; + n = 1; case 2 if (ischar (varargin{2})) [Z, method] = deal (varargin{:}); + n = 1; else [Z, n] = deal (varargin{:}); endif @@ -159,6 +161,7 @@ error ("interp2: X, Y must be numeric matrices"); endif if (! isempty (n)) + ## Calculate the interleaved input vectors. p = 2^n; XI = (p:p*zc)/p; YI = (p:p*zr)'/p; @@ -337,17 +340,16 @@ endif ## Check dimensions of XI and YI - if (isvector (XI) && isvector (YI)) + if (isvector (XI) && isvector (YI) && ! size_equal (XI, YI)) XI = XI(:).'; YI = YI(:); + [XI, YI] = meshgrid (XI, YI); elseif (! size_equal (XI, YI)) error ("interp2: XI and YI must be matrices of equal size"); endif - ## FIXME bicubic/__splinen__ don't handle arbitrary XI, YI. if (strcmp (method, "cubic")) - ## Please remove the dummy zero when bicubic is fixed. - if (0 && isgriddata (XI) && isgriddata (YI')) + if (isgriddata (XI) && isgriddata (YI')) ZI = bicubic (X, Y, Z, XI (1, :), YI (:, 1), extrapval); elseif (isgriddata (X) && isgriddata (Y')) ## Allocate output @@ -589,3 +591,20 @@ %! X = meshgrid (1:4); %! assert (interp2 (X, 2.5, 2.5, 'nearest'), 3); +%!shared z, zout, tol +%! z = [1 3 5; 3 5 7; 5 7 9]; +%! zout = [1 2 3 4 5; 2 3 4 5 6; 3 4 5 6 7; 4 5 6 7 8; 5 6 7 8 9]; +%! tol = 2 * eps; +%!assert (interp2 (z), zout, tol); +%!assert (interp2 (z, "linear"), zout, tol); +%!assert (interp2 (z, "pchip"), zout, tol); +%!assert (interp2 (z, "cubic"), zout, 10 * tol); +%!assert (interp2 (z, "spline"), zout, tol); +%!assert (interp2 (z, [2 3 1], [2 2 2]', "linear"), repmat ([5, 7, 3], [3, 1]), tol) +%!assert (interp2 (z, [2 3 1], [2 2 2]', "pchip"), repmat ([5, 7, 3], [3, 1]), tol) +%!assert (interp2 (z, [2 3 1], [2 2 2]', "cubic"), repmat ([5, 7, 3], [3, 1]), 10 * tol) +%!assert (interp2 (z, [2 3 1], [2 2 2]', "spline"), repmat ([5, 7, 3], [3, 1]), tol) +%!assert (interp2 (z, [2 3 1], [2 2 2], "linear"), [5 7 3], tol); +%!assert (interp2 (z, [2 3 1], [2 2 2], "pchip"), [5 7 3], tol); +%!assert (interp2 (z, [2 3 1], [2 2 2], "cubic"), [5 7 3], 10 * tol); +%!assert (interp2 (z, [2 3 1], [2 2 2], "spline"), [5 7 3], tol);
--- a/scripts/general/interp3.m +++ b/scripts/general/interp3.m @@ -69,14 +69,14 @@ extrapval = NA; nargs = nargin; - if (nargin < 1) + if (nargin < 1 || ! isnumeric (varargin{1})) print_usage (); endif if (ischar (varargin{end})) method = varargin{end}; nargs = nargs - 1; - elseif (ischar (varargin{end-1})) + elseif (nargs > 1 && ischar (varargin{end - 1})) if (! isnumeric (varargin{end}) || ! isscalar (varargin{end})) error ("interp3: extrapal is expected to be a numeric scalar"); endif @@ -91,7 +91,7 @@ if (ndims (v) != 3) error ("interp3: expect 3-dimensional array of values"); endif - x = varargin (2:4); + x = varargin (2:end); if (any (! cellfun (@isvector, x))) for i = 2 : 3 if (! size_equal (x{1}, x{i})) @@ -146,3 +146,21 @@ %! [xxi, yyi, zzi] = ndgrid (xi, yi, zi); %! vi2 = interpn(x, y, z, v, xxi, yyi, zzi); %! assert (vi, vi2); + +%!shared z, zout, tol +%! z = zeros (3, 3, 3); +%! zout = zeros (5, 5, 5); +%! z(:,:,1) = [1 3 5; 3 5 7; 5 7 9]; +%! z(:,:,2) = z(:,:,1) + 2; +%! z(:,:,3) = z(:,:,2) + 2; +%! for n = 1:5 +%! zout(:,:,n) = [1 2 3 4 5; +%! 2 3 4 5 6; +%! 3 4 5 6 7; +%! 4 5 6 7 8; +%! 5 6 7 8 9] + (n-1); +%! end +%! tol = 10 * eps; +%!assert (interp3 (z), zout, tol) +%!assert (interp3 (z, "linear"), zout, tol) +%!assert (interp3 (z, "spline"), zout, tol)
--- a/scripts/general/interpft.m +++ b/scripts/general/interpft.m @@ -27,7 +27,7 @@ ## along the dimension @var{dim}. ## ## @code{interpft} assumes that the interpolated function is periodic, -## and so assumptions are made about the end points of the interpolation. +## and so assumptions are made about the endpoints of the interpolation. ## ## @seealso{interp1} ## @end deftypefn @@ -46,40 +46,35 @@ print_usage (); endif + if (! (isscalar (n) && n == fix (n))) + error ("interpft: N must be a scalar integer"); + endif + if (nargin == 2) - if (isvector (x) && size (x, 1) == 1) + if (isrow (x)) dim = 2; else dim = 1; endif endif - if (! isscalar (n)) - error ("interpft: N must be an integer scalar"); - endif - nd = ndims (x); if (dim < 1 || dim > nd) - error ("interpft: integrating over invalid dimension"); + error ("interpft: invalid dimension DIM"); endif perm = [dim:nd, 1:(dim-1)]; x = permute (x, perm); - m = size (x, 1); + m = rows (x); - inc = 1; - while (inc*n < m) - inc++; - endwhile + inc = max (1, fix (m/n)); y = fft (x) / m; k = floor (m / 2); sz = size (x); sz(1) = n * inc - m; - idx = cell (nd, 1); - for i = 2:nd - idx{i} = 1:sz(i); - endfor + + idx = repmat ({':'}, nd, 1); idx{1} = 1:k; z = cat (1, y(idx{:}), zeros (sz)); idx{1} = k+1:m; @@ -92,8 +87,10 @@ endif z = ipermute (z, perm); + endfunction + %!demo %! t = 0 : 0.3 : pi; dt = t(2)-t(1); %! n = length (t); k = 100; @@ -110,5 +107,10 @@ %!assert (interpft(y', n), y', 20*eps); %!assert (interpft([y,y],n), [y,y], 20*eps); -%!error (interpft(y,n,0)) -%!error (interpft(y,[n,n])) +%% Test input validation +%!error interpft () +%!error interpft (1) +%!error interpft (1,2,3) +%!error (interpft(1,[n,n])) +%!error (interpft(1,2,0)) +%!error (interpft(1,2,3))
--- a/scripts/general/interpn.m +++ b/scripts/general/interpn.m @@ -70,14 +70,14 @@ extrapval = NA; nargs = nargin; - if (nargin < 1) + if (nargin < 1 || ! isnumeric (varargin{1})) print_usage (); endif if (ischar (varargin{end})) method = varargin{end}; nargs = nargs - 1; - elseif (ischar (varargin{end - 1})) + elseif (nargs > 1 && ischar (varargin{end - 1})) if (! isnumeric (varargin{end}) || ! isscalar (varargin{end})) error ("interpn: extrapal is expected to be a numeric scalar"); endif @@ -90,9 +90,12 @@ v = varargin{1}; m = 1; if (nargs == 2) - m = varargin{2}; - if (! isnumeric (m) || ! isscalar (m) || floor (m) != m) - error ("interpn: M is expected to be a integer scalar"); + if (ischar (varargin{2})) + method = varargin{2}; + elseif (isnumeric (m) && isscalar (m) && fix (m) == m) + m = varargin{2}; + else + print_usage (); endif endif sz = size (v); @@ -103,6 +106,8 @@ x{i} = 1 : sz(i); y{i} = 1 : (1 / (2 ^ m)) : sz(i); endfor + y{1} = y{1}.'; + [y{:}] = ndgrid (y{:}); elseif (! isvector (varargin{1}) && nargs == (ndims (varargin{1}) + 1)) v = varargin{1}; sz = size (v); @@ -124,7 +129,7 @@ error ("interpn: wrong number or incorrectly formatted input arguments"); endif - if (any (! cellfun (@isvector, x))) + if (any (! cellfun ("isvector", x))) for i = 2 : nd if (! size_equal (x{1}, x{i}) || ! size_equal (x{i}, v)) error ("interpn: dimensional mismatch"); @@ -140,8 +145,8 @@ method = tolower (method); - all_vectors = all (cellfun (@isvector, y)); - different_lengths = numel (unique (cellfun (@numel, y))) > 1; + all_vectors = all (cellfun ("isvector", y)); + different_lengths = numel (unique (cellfun ("numel", y))) > 1; if (all_vectors && different_lengths) [foobar(1:numel(y)).y] = ndgrid (y{:}); y = {foobar.y}; @@ -169,7 +174,7 @@ vi(idx) = extrapval; vi = reshape (vi, yshape); elseif (strcmp (method, "spline")) - if (any (! cellfun (@isvector, y))) + if (any (! cellfun ("isvector", y))) for i = 2 : nd if (! size_equal (y{1}, y{i})) error ("interpn: dimensional mismatch"); @@ -290,3 +295,20 @@ %! X = meshgrid (1:4); %! assert (interpn (X, 2.5, 2.5, 'nearest'), 3); +%!shared z, zout, tol +%! z = zeros (3, 3, 3); +%! zout = zeros (5, 5, 5); +%! z(:,:,1) = [1 3 5; 3 5 7; 5 7 9]; +%! z(:,:,2) = z(:,:,1) + 2; +%! z(:,:,3) = z(:,:,2) + 2; +%! for n = 1:5 +%! zout(:,:,n) = [1 2 3 4 5; +%! 2 3 4 5 6; +%! 3 4 5 6 7; +%! 4 5 6 7 8; +%! 5 6 7 8 9] + (n-1); +%! end +%! tol = 10 * eps; +%!assert (interpn (z), zout, tol) +%!assert (interpn (z, "linear"), zout, tol) +%!assert (interpn (z, "spline"), zout, tol)
--- a/scripts/general/isa.m +++ b/scripts/general/isa.m @@ -75,3 +75,22 @@ %!assert (isa (uint16 (13), "numeric"), true) %!assert (isa (uint32 (13), "numeric"), true) %!assert (isa (uint64 (13), "numeric"), true) + +%!assert (isa (double (13), "double")); +%!assert (isa (single (13), "single")); +%!assert (isa (int8 (13), "int8")); +%!assert (isa (int16 (13), "int16")); +%!assert (isa (int32 (13), "int32")); +%!assert (isa (int64 (13), "int64")); +%!assert (isa (uint8 (13), "uint8")); +%!assert (isa (uint16 (13), "uint16")); +%!assert (isa (uint32 (13), "uint32")); +%!assert (isa (uint64 (13), "uint64")); +%!assert (isa ("string", "char")); +%!assert (isa (true, "logical")); +%!assert (isa (false, "logical")); +%!assert (isa ({1, 2}, "cell")); +%!test +%! a.b = 1; +%! assert (isa (a, "struct")); +
--- a/scripts/general/iscolumn.m +++ b/scripts/general/iscolumn.m @@ -26,8 +26,6 @@ function retval = iscolumn (x) - retval = false; - if (nargin != 1) print_usage (); endif @@ -37,26 +35,22 @@ endfunction -%!assert(iscolumn ([1, 2, 3]), false); -%!assert(iscolumn ([1; 2; 3])); -%!assert(iscolumn (1)); -%!assert(iscolumn ([]), false); -%!assert(iscolumn ([1, 2; 3, 4]), false); -%!test -%! warning ("off", "Octave:str-to-num"); -%! assert((iscolumn ("t"))); -%!test -%! warning ("off", "Octave:str-to-num"); -%! assert(!(iscolumn ("test"))); +%!assert (iscolumn ([1, 2, 3]), false) +%!assert (iscolumn ([1; 2; 3])) +%!assert (iscolumn (1)) +%!assert (iscolumn ([]), false) +%!assert (iscolumn ([1, 2; 3, 4]), false) -%!assert(!(iscolumn (["test"; "ing"]))); +%!assert (iscolumn ("t")) +%!assert (iscolumn ("test"), false) +%!assert (iscolumn (["test"; "ing"]), false) %!test %! s.a = 1; -%! assert((iscolumn (s))); +%! assert (iscolumn (s)); %% Test input validation -%!error iscolumn (); -%!error iscolumn ([1, 2], 2); +%!error iscolumn () +%!error iscolumn ([1, 2], 2)
--- a/scripts/general/isdir.m +++ b/scripts/general/isdir.m @@ -23,10 +23,17 @@ ## @end deftypefn function retval = isdir (f) - if (nargin == 1) - ## Exist returns an integer but isdir should return a logical. - retval = (exist (f, "dir") == 7); - else + if (nargin != 1) print_usage ("isdir"); endif + + ## Exist returns an integer but isdir should return a logical. + retval = (exist (f, "dir") == 7); + endfunction + +%!error isdir (); +%!error isdir (1, 2); + +%!assert (isdir (pwd ())); +%!assert (! isdir ("this is highly unlikely to be a directory name"));
--- a/scripts/general/isequal.m +++ b/scripts/general/isequal.m @@ -24,12 +24,12 @@ function retval = isequal (x1, varargin) - if (nargin > 1) - retval = __isequal__ (false, x1, varargin{:}); - else + if (nargin < 2) print_usage (); endif + retval = __isequal__ (false, x1, varargin{:}); + endfunction ## test size and shape
--- a/scripts/general/isequalwithequalnans.m +++ b/scripts/general/isequalwithequalnans.m @@ -25,12 +25,12 @@ function retval = isequalwithequalnans (x1, varargin) - if (nargin > 1) - retval = __isequal__ (true, x1, varargin{:}); - else + if (nargin < 2) print_usage (); endif + retval = __isequal__ (true, x1, varargin{:}); + endfunction ## test for equality
--- a/scripts/general/isrow.m +++ b/scripts/general/isrow.m @@ -26,8 +26,6 @@ function retval = isrow (x) - retval = false; - if (nargin != 1) print_usage (); endif @@ -37,26 +35,22 @@ endfunction -%!assert(isrow ([1, 2, 3])); -%!assert(isrow ([1; 2; 3]), false); -%!assert(isrow (1)); -%!assert(isrow ([]), false); -%!assert(isrow ([1, 2; 3, 4]), false); -%!test -%! warning ("off", "Octave:str-to-num"); -%! assert((isrow ("t"))); -%!test -%! warning ("off", "Octave:str-to-num"); -%! assert((isrow ("test"))); +%!assert (isrow ([1, 2, 3])) +%!assert (isrow ([1; 2; 3]), false) +%!assert (isrow (1)) +%!assert (isrow ([]), false) +%!assert (isrow ([1, 2; 3, 4]), false) -%!assert(!(isrow (["test"; "ing"]))); +%!assert (isrow ("t")) +%!assert (isrow ("test")) +%!assert (isrow (["test"; "ing"]), false) %!test %! s.a = 1; -%! assert((isrow (s))); +%! assert (isrow (s)); %% Test input validation -%!error isrow (); -%!error isrow ([1, 2], 2); +%!error isrow () +%!error isrow ([1, 2], 2)
--- a/scripts/general/isscalar.m +++ b/scripts/general/isscalar.m @@ -26,31 +26,29 @@ function retval = isscalar (x) - if (nargin == 1) - retval = numel (x) == 1; - else + if (nargin != 1) print_usage (); endif + retval = numel (x) == 1; + endfunction -%!assert(isscalar (1)); -%!assert(!(isscalar ([1, 2]))); -%!assert(!(isscalar ([]))); -%!assert(!(isscalar ([1, 2; 3, 4]))); -%!test -%! warning ("off", "Octave:str-to-num"); -%! assert((isscalar ("t"))); +%!assert (isscalar (1)) +%!assert (isscalar ([1, 2]), false) +%!assert (isscalar ([]), false) +%!assert (isscalar ([1, 2; 3, 4]), false) -%!assert(!(isscalar ("test"))); -%!assert(!(isscalar (["test"; "ing"]))); +%!assert (isscalar ("t")) +%!assert (isscalar ("test"), false) +%!assert (isscalar (["test"; "ing"]), false) %!test %! s.a = 1; -%! assert((isscalar (s))); +%! assert (isscalar (s)); %% Test input validation -%!error isscalar (); -%!error isscalar (1, 2); +%!error isscalar () +%!error isscalar (1, 2)
--- a/scripts/general/issquare.m +++ b/scripts/general/issquare.m @@ -28,42 +28,35 @@ function retval = issquare (x) - if (nargin == 1) - if (ndims (x) == 2) - [r, c] = size (x); - retval = r == c; - else - retval = false; - endif + if (nargin != 1) + print_usage (); + endif + + if (ndims (x) == 2) + [r, c] = size (x); + retval = r == c; else - print_usage (); + retval = false; endif endfunction +%!assert(issquare ([])); %!assert(issquare (1)); - %!assert(!(issquare ([1, 2]))); - -%!assert(issquare ([])); - %!assert(issquare ([1, 2; 3, 4])); - -%!test -%! assert(issquare ("t")); - +%!assert(!(issquare ([1, 2; 3, 4; 5, 6]))); +%!assert(!(issquare (ones (3,3,3)))); +%!assert(issquare ("t")); %!assert(!(issquare ("test"))); - -%!test -%! assert(issquare (["test"; "ing"; "1"; "2"])); - +%!assert(issquare (["test"; "ing"; "1"; "2"])); %!test %! s.a = 1; %! assert(issquare (s)); - -%!assert(!(issquare ([1, 2; 3, 4; 5, 6]))); +%!assert(issquare ({1, 2; 3, 4})); +%!assert(sparse (([1, 2; 3, 4]))); +%% Test input validation %!error issquare (); - %!error issquare ([1, 2; 3, 4], 2);
--- a/scripts/general/isvector.m +++ b/scripts/general/isvector.m @@ -28,37 +28,30 @@ function retval = isvector (x) - retval = 0; - - if (nargin == 1) - sz = size (x); - retval = (ndims (x) == 2 && (sz(1) == 1 || sz(2) == 1)); - else + if (nargin != 1) print_usage (); endif + sz = size (x); + retval = (ndims (x) == 2 && (sz(1) == 1 || sz(2) == 1)); + endfunction -%!assert(isvector (1)); -%!assert(isvector ([1; 2; 3])); -%!assert(!(isvector ([]))); -%!assert(!(isvector ([1, 2; 3, 4]))); -%!test -%! warning ("off", "Octave:str-to-num"); -%! assert((isvector ("t"))); +%!assert (isvector (1)) +%!assert (isvector ([1; 2; 3])) +%!assert (isvector ([]), false) +%!assert (isvector ([1, 2; 3, 4]), false) -%!test -%! warning ("off", "Octave:str-to-num"); -%! assert((isvector ("test"))); - -%!assert(!(isvector (["test"; "ing"]))); +%!assert (isvector ("t")) +%!assert (isvector ("test")) +%!assert (isvector (["test"; "ing"]), false) %!test %! s.a = 1; -%! assert((isvector (s))); +%! assert (isvector (s)); %% Test input validation -%!error isvector (); -%!error isvector ([1, 2], 2); +%!error isvector () +%!error isvector ([1, 2], 2)
--- a/scripts/general/logspace.m +++ b/scripts/general/logspace.m @@ -17,18 +17,19 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} logspace (@var{base}, @var{limit}) -## @deftypefnx {Function File} {} logspace (@var{base}, @var{limit}, @var{n}) -## Similar to @code{linspace} except that the values are logarithmically -## spaced from +## @deftypefn {Function File} {} logspace (@var{a}, @var{b}) +## @deftypefnx {Function File} {} logspace (@var{b}, @var{b}, @var{n}) +## @deftypefnx {Function File} {} logspace (@var{a}, pi, @var{n}) +## Return a row vector with @var{n} elements logarithmically spaced from ## @tex -## $10^{base}$ to $10^{limit}$. +## $10^{a}$ to $10^{b}$. ## @end tex ## @ifnottex -## 10^base to 10^limit. +## 10^@var{a} to 10^@var{b}. ## @end ifnottex +## If @var{n} is unspecified it defaults to 50. ## -## If @var{limit} is equal to +## If @var{b} is equal to ## @tex ## $\pi$, ## @end tex @@ -37,67 +38,62 @@ ## @end ifnottex ## the points are between ## @tex -## $10^{base}$ and $\pi$, +## $10^{a}$ and $\pi$, ## @end tex ## @ifnottex -## 10^base and pi, +## 10^@var{a} and pi, ## @end ifnottex ## @emph{not} ## @tex -## $10^{base}$ and $10^{\pi}$, +## $10^{a}$ and $10^{\pi}$, ## @end tex ## @ifnottex -## 10^base and 10^pi, +## 10^@var{a} and 10^pi, ## @end ifnottex -## in order to be compatible with the corresponding @sc{matlab} -## function. -## If @var{n} is unspecified it defaults to 50. +## in order to be compatible with the corresponding @sc{matlab} function. ## -## Also for compatibility with @sc{matlab}, return the second argument if -## fewer than two values are requested. +## Also for compatibility with @sc{matlab}, return the second argument @var{b} +## if fewer than two values are requested. ## @seealso{linspace} ## @end deftypefn ## Author: jwe -function retval = logspace (base, limit, n) +function retval = logspace (base, limit, n = 50) - if (nargin == 2) - npoints = 50; - elseif (nargin == 3) - if (length (n) == 1) - npoints = fix (n); - else - error ("logspace: arguments must be scalars"); - endif - else + if (nargin != 2 && nargin != 3) print_usage (); endif - if (length (base) == 1 && length (limit) == 1) - if (limit == pi) - limit = log10 (pi); - endif - retval = 10 .^ (linspace (base, limit, npoints)); - else - error ("logspace: arguments must be scalars"); + if (! (isscalar (base) && isscalar (limit) && isscalar (n))) + error ("logspace: arguments BASE, LIMIT, and N must be scalars"); endif + npoints = fix (n); + + if (limit == pi) + limit = log10 (pi); + endif + + retval = 10 .^ (linspace (base, limit, npoints)); + endfunction + %!test %! x1 = logspace (1, 2); -%! x2 = logspace (1, 2, 10); +%! x2 = logspace (1, 2, 10.1); %! x3 = logspace (1, -2, 10); %! x4 = logspace (1, pi, 10); -%! assert((size (x1) == [1, 50] && x1(1) == 10 && x1(50) == 100 -%! && size (x2) == [1, 10] && x2(1) == 10 && x2(10) == 100 -%! && size (x3) == [1, 10] && x3(1) == 10 && x3(10) == 0.01 -%! && size (x4) == [1, 10] && x4(1) == 10 && abs (x4(10) - pi) < sqrt (eps))); +%! assert (size (x1) == [1, 50] && x1(1) == 10 && x1(50) == 100); +%! assert (size (x2) == [1, 10] && x2(1) == 10 && x2(10) == 100); +%! assert (size (x3) == [1, 10] && x3(1) == 10 && x3(10) == 0.01); +%! assert (size (x4) == [1, 10] && x4(1) == 10 && abs (x4(10) - pi) < sqrt (eps)); +%% Test input validation +%!error logspace (); +%!error logspace (1, 2, 3, 4); %!error logspace ([1, 2; 3, 4], 5, 6); - -%!error logspace (); +%!error logspace (1, [1, 2; 3, 4], 6); +%!error logspace (1, 2, [1, 2; 3, 4]); -%!error logspace (1, 2, 3, 4); -
--- a/scripts/general/module.mk +++ b/scripts/general/module.mk @@ -7,7 +7,6 @@ general_FCN_FILES = \ general/accumarray.m \ general/accumdim.m \ - general/arrayfun.m \ general/bicubic.m \ general/bitcmp.m \ general/bitget.m \ @@ -54,14 +53,18 @@ general/loadobj.m \ general/logspace.m \ general/nargchk.m \ + general/narginchk.m \ general/nargoutchk.m \ + general/nthargout.m \ general/nextpow2.m \ general/num2str.m \ - general/perror.m \ general/pol2cart.m \ general/polyarea.m \ general/postpad.m \ general/prepad.m \ + general/profexplore.m \ + general/profile.m \ + general/profshow.m \ general/quadgk.m \ general/quadl.m \ general/quadv.m \ @@ -70,13 +73,11 @@ general/repmat.m \ general/rot90.m \ general/rotdim.m \ - general/runlength.m \ general/saveobj.m \ general/shift.m \ general/shiftdim.m \ general/sortrows.m \ general/sph2cart.m \ - general/strerror.m \ general/structfun.m \ general/subsindex.m \ general/triplequad.m \
--- a/scripts/general/nargchk.m +++ b/scripts/general/nargchk.m @@ -25,21 +25,19 @@ ## ## This is useful for checking to see that the number of input arguments ## supplied to a function is within an acceptable range. -## @seealso{nargoutchk, error, nargin, nargout} +## @seealso{nargoutchk, narginchk, error, nargin, nargout} ## @end deftypefn ## Author: Bill Denney <bill@denney.ws> -function msg = nargchk (minargs, maxargs, nargs, outtype) +function msg = nargchk (minargs, maxargs, nargs, outtype = "string") if (nargin < 3 || nargin > 4) print_usage (); elseif (minargs > maxargs) error ("nargchk: MINARGS must be <= MAXARGS"); - elseif (nargin == 3) - outtype = "string"; elseif (! any (strcmpi (outtype, {"string", "struct"}))) - error ("nargchk: output type must be either string or struct"); + error ('nargchk: output type must be either "string" or "struct"'); elseif (! (isscalar (minargs) && isscalar (maxargs) && isscalar (nargs))) error ("nargchk: MINARGS, MAXARGS, and NARGS must be scalars"); endif @@ -56,13 +54,16 @@ if (strcmpi (outtype, "string")) msg = msg.message; elseif (isempty (msg.message)) - msg = struct ([]); + ## Compatability: Matlab returns a 0x1 empty struct when nargchk passes + msg = resize (msg, 0, 1); endif endfunction + ## Tests -%!shared stmin, stmax +%!shared stnul, stmin, stmax +%! stnul = resize (struct ("message", "", "identifier", ""), 0, 1); %! stmin = struct ("message", "not enough input arguments", %! "identifier", "Octave:nargchk:not-enough-inputs"); %! stmax = struct ("message", "too many input arguments", @@ -73,7 +74,7 @@ %!assert (nargchk (0, 1, 2), "too many input arguments") %!assert (nargchk (0, 1, 2, "string"), "too many input arguments") ## Struct outputs -%!assert (nargchk (0, 1, 0, "struct"), struct([])) -%!assert (nargchk (0, 1, 1, "struct"), struct([])) +%!assert (isequal (nargchk (0, 1, 0, "struct"), stnul)) +%!assert (isequal (nargchk (0, 1, 1, "struct"), stnul)) %!assert (nargchk (1, 1, 0, "struct"), stmin) %!assert (nargchk (0, 1, 2, "struct"), stmax)
new file mode 100644 --- /dev/null +++ b/scripts/general/narginchk.m @@ -0,0 +1,69 @@ +## Copyright (C) 2011 Carnë Draug +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} narginchk (@var{minargs}, @var{maxargs}) +## Check for correct number of arguments or generate an error message if +## the number of arguments in the calling function is outside the range +## @var{minargs} and @var{maxargs}. Otherwise, do nothing. +## +## Both @var{minargs} and @var{maxargs} need to be scalar numeric +## values. Zero, Inf and negative values are all allowed, and +## @var{minargs} and @var{maxargs} may be equal. +## +## Note that this function evaluates @code{nargin} on the caller. +## +## @seealso{nargchk, nargoutchk, error, nargout, nargin} +## @end deftypefn + +## Author: Carnë Draug <carandraug+dev@gmail.com> + +function narginchk (minargs, maxargs) + + if (nargin != 2) + print_usage; + elseif (!isnumeric (minargs) || !isscalar (minargs)) + error ("minargs must be a numeric scalar"); + elseif (!isnumeric (maxargs) || !isscalar (maxargs)) + error ("maxargs must be a numeric scalar"); + elseif (minargs > maxargs) + error ("minargs cannot be larger than maxargs") + endif + + args = evalin ("caller", "nargin;"); + + if (args < minargs) + error ("not enough input arguments"); + elseif (args > maxargs) + error ("too many input arguments"); + endif + +endfunction + +%!function f (nargs, varargin) +%! narginchk (nargs(1), nargs(2)); +%!endfunction + +%!error <too many input arguments> f([0,0]) +%!error <not enough input arguments> f([3, 3], 1) + +%!test +%! f([1,1]) + +%!test +%! f([1,5], 2, 3, 4, 5)
--- a/scripts/general/nargoutchk.m +++ b/scripts/general/nargoutchk.m @@ -1,4 +1,5 @@ ## Copyright (C) 2008-2011 Bill Denney +## Copyright (C) 2011 Carnë Draug ## ## This file is part of Octave. ## @@ -17,57 +18,95 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{msgstr} =} nargoutchk (@var{minargs}, @var{maxargs}, @var{nargs}) +## @deftypefn {Function File} {} nargoutchk (@var{minargs}, @var{maxargs}) +## @deftypefnx {Function File} {@var{msgstr} =} nargoutchk (@var{minargs}, @var{maxargs}, @var{nargs}) ## @deftypefnx {Function File} {@var{msgstr} =} nargoutchk (@var{minargs}, @var{maxargs}, @var{nargs}, "string") ## @deftypefnx {Function File} {@var{msgstruct} =} nargoutchk (@var{minargs}, @var{maxargs}, @var{nargs}, "struct") -## Return an appropriate error message string (or structure) if the -## number of outputs requested is invalid. +## Check for correct number of output arguments. +## +## On the first form, returns an error unless the number of arguments in its +## caller is between the values of @var{minargs} and @var{maxargs}. It does +## nothing otherwise. Note that this function evaluates the value of +## @code{nargout} on the caller so its value must have not been tampered with. +## +## Both @var{minargs} and @var{maxargs} need to be a numeric scalar. Zero, Inf +## and negative are all valid, and they can have the same value. +## +## For backward compatibility reasons, the other forms return an appropriate +## error message string (or structure) if the number of outputs requested is +## invalid. ## ## This is useful for checking to see that the number of output ## arguments supplied to a function is within an acceptable range. -## @seealso{nargchk, error, nargout, nargin} +## @seealso{nargchk, narginchk, error, nargout, nargin} ## @end deftypefn ## Author: Bill Denney <bill@denney.ws> +## Author: Carnë Draug <carandraug+dev@gmail.com> function msg = nargoutchk (minargs, maxargs, nargs, outtype) - if (nargin < 3 || nargin > 4) - print_usage (); - elseif (minargs > maxargs) - error ("nargoutchk: MINARGS must be <= MAXARGS"); - elseif (nargin == 3) - outtype = "string"; - elseif (! any (strcmpi (outtype, {"string" "struct"}))) - error ("nargoutchk: output type must be either string or struct"); - elseif (! (isscalar (minargs) && isscalar (maxargs) && isscalar (nargs))) - error ("nargoutchk: MINARGS, MAXARGS, and NARGS must be scalars"); - endif + ## before matlab's 2011b, nargoutchk would return an error message (just the + ## message in a string). With 2011b, it no longer returns anything, it simply + ## gives an error if the args number is incorrect. + ## To try to keep compatibility with both versions, check nargout and nargin + ## to guess if the caller is expecting a value (old syntax) or none (new syntax) + + if (nargout == 1 && (nargin == 3 || nargin == 4)) + + if (minargs > maxargs) + error ("nargoutchk: MINARGS must be <= MAXARGS"); + elseif (nargin == 3) + outtype = "string"; + elseif (! any (strcmpi (outtype, {"string" "struct"}))) + error ("nargoutchk: output type must be either string or struct"); + elseif (! (isscalar (minargs) && isscalar (maxargs) && isscalar (nargs))) + error ("nargoutchk: MINARGS, MAXARGS, and NARGS must be scalars"); + endif + + msg = struct ("message", "", "identifier", ""); + if (nargs < minargs) + msg.message = "not enough output arguments"; + msg.identifier = "Octave:nargoutchk:not-enough-outputs"; + elseif (nargs > maxargs) + msg.message = "too many output arguments"; + msg.identifier = "Octave:nargoutchk:too-many-outputs"; + endif - msg = struct ("message", "", "identifier", ""); - if (nargs < minargs) - msg.message = "not enough output arguments"; - msg.identifier = "Octave:nargoutchk:not-enough-outputs"; - elseif (nargs > maxargs) - msg.message = "too many output arguments"; - msg.identifier = "Octave:nargoutchk:too-many-outputs"; - endif + if (strcmpi (outtype, "string")) + msg = msg.message; + elseif (isempty (msg.message)) + ## Compatability: Matlab returns a 0x1 empty struct when nargchk passes + msg = resize (msg, 0, 1); + endif + + elseif (nargout == 0 && nargin == 2) - if (strcmpi (outtype, "string")) - msg = msg.message; + if (!isnumeric (minargs) || !isscalar (minargs)) + error ("minargs must be a numeric scalar"); + elseif (!isnumeric (maxargs) || !isscalar (maxargs)) + error ("maxargs must be a numeric scalar"); + elseif (minargs > maxargs) + error ("minargs cannot be larger than maxargs") + endif + + args = evalin ("caller", "nargout;"); + + if (args < minargs) + error ("Not enough output arguments."); + elseif (args > maxargs) + error ("Too many output arguments."); + endif + else - if (isempty (msg.message)) - msg = struct ([]); - endif - ## FIXME: remove the error below if error is modified to accept - ## struct inputs - error ("nargoutchk: error does not yet support struct inputs"); + print_usage; endif endfunction ## Tests -%!shared stmin, stmax +%!shared stnul, stmin, stmax +%! stnul = resize (struct ("message", "", "identifier", ""), 0, 1); %! stmin = struct ("message", "not enough output arguments", %! "identifier", "Octave:nargoutchk:not-enough-outputs"); %! stmax = struct ("message", "too many output arguments", @@ -78,7 +117,8 @@ %!assert (nargoutchk (0, 1, 2), "too many output arguments") %!assert (nargoutchk (0, 1, 2, "string"), "too many output arguments") ## Struct outputs -#%!assert (nargoutchk (0, 1, 0, "struct"), struct([])) -#%!assert (nargoutchk (0, 1, 1, "struct"), struct([])) -#%!assert (nargoutchk (1, 1, 0, "struct"), stmin) -#%!assert (nargoutchk (0, 1, 2, "struct"), stmax) +%!assert (isequal (nargoutchk (0, 1, 0, "struct"), stnul)) +%!assert (isequal (nargoutchk (0, 1, 1, "struct"), stnul)) +%!assert (nargoutchk (1, 1, 0, "struct"), stmin) +%!assert (nargoutchk (0, 1, 2, "struct"), stmax) +
--- a/scripts/general/nextpow2.m +++ b/scripts/general/nextpow2.m @@ -55,3 +55,14 @@ endif endfunction + +%!error nexpow2 (); +%!error nexpow2 (1, 2); + +%!assert (nextpow2 (16), 4); +%!assert (nextpow2 (17), 5); +%!assert (nextpow2 (31), 5); +%!assert (nextpow2 (-16), 4); +%!assert (nextpow2 (-17), 5); +%!assert (nextpow2 (-31), 5); +%!assert (nextpow2 (1:17), 5);
new file mode 100644 --- /dev/null +++ b/scripts/general/nthargout.m @@ -0,0 +1,113 @@ +## Copyright (C) 2011 Jordi Gutiérrez Hermoso +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} nthargout (@var{n}, @var{func}, @dots{}) +## @deftypefnx {Function File} {} nthargout (@var{n}, @var{ntot}, @var{func}, @dots{}) +## Return the @var{n}th output argument of function given by the +## function handle or string @var{func}. Any arguments after @var{func} +## are passed to @var{func}. The total number of arguments to call +## @var{func} with can be passed in @var{ntot}; by default @var{ntot} +## is @var{n}. The input @var{n} can also be a vector of indices of the +## output, in which case the output will be a cell array of the +## requested output arguments. +## +## The intended use @code{nthargout} is to avoid intermediate variables. +## For example, when finding the indices of the maximum entry of a +## matrix, the following two compositions of nthargout +## +## @example +## @group +## @var{m} = magic (5); +## cell2mat (nthargout ([1, 2], @@ind2sub, size(@var{m}), +## nthargout (2, @@max, @var{m}(:)))) +## @result{} 5 3 +## @end group +## @end example +## +## @noindent +## are completely equivalent to the following lines: +## +## @example +## @group +## @var{m} = magic(5); +## [~, idx] = max (@var{M}(:)); +## [i, j] = ind2sub (size (@var{m}), idx); +## [i, j] +## @result{} 5 3 +## @end group +## @end example +## +## It can also be helpful to have all output arguments in a single cell +## in the following manner: +## +## @example +## @var{USV} = nthargout ([1:3], @@svd, hilb (5)); +## @end example +## +## @seealso{nargin, nargout, varargin, varargout, isargout} +## @end deftypefn + +## Author: Jordi Gutiérrez Hermoso + +function out = nthargout (n, varargin) + if (nargin < 2) + print_usage (); + endif + + if (isa (varargin{1}, "function_handle") || ischar (varargin{1})) + ntot = max (n(:)); + func = varargin{1}; + args = varargin(2:end); + elseif (isnumeric (varargin{1}) + && (isa (varargin{2}, "function_handle") || ischar (varargin{2}))) + ntot = varargin{1}; + func = varargin{2}; + args = varargin(3:end); + else + print_usage (); + endif + + if (any (n != fix (n)) || ntot != fix (ntot) || any (n <= 0) || ntot <= 0) + error ("nthargout: N and NTOT must consist of positive integers") + endif + + outargs = cell (1, ntot); + + try + [outargs{:}] = feval (func, args{:}); + if (numel (n) > 1) + out = outargs(n); + else + out = outargs{n}; + endif + catch + err = lasterr (); + if (strfind ("some elements undefined in return list", err)) + error ("nthargout: Too many output arguments: %d", ntot); + else + error (err); + endif + end_try_catch + +endfunction + +%!shared m +%! m = magic (5); +%!assert (nthargout ([1, 2], @ind2sub, size(m), nthargout (2, @max, m(:))), {5,3}) +%!assert (nthargout (3, @find, m(m>20)), [23, 24, 25, 21, 22]')
--- a/scripts/general/num2str.m +++ b/scripts/general/num2str.m @@ -75,7 +75,7 @@ if (ischar (arg)) fmt = cstrcat (arg, "%-+", arg(2:end), "i"); else - if (isnumeric (x) && round (x) == x && abs (x) < (10 .^ arg)) + if (isnumeric (x) && x == fix (x) && abs (x) < (10 .^ arg)) fmt = sprintf ("%%%dd%%-+%ddi ", arg, arg); else fmt = sprintf ("%%%d.%dg%%-+%d.%dgi", arg+7, arg, arg+7, arg); @@ -83,7 +83,7 @@ endif else ## Setup a suitable format string - if (isnumeric (x) && round (x) == x && abs (x) < 1e10) + if (isnumeric (x) && x == fix (x) && abs (x) < 1e10) if (max (abs (real (x(:)))) == 0) dgt1 = 2; else @@ -111,10 +111,7 @@ nd = ndims (x); perm = fix ([1:0.5:nc+0.5]); perm(2:2:2*nc) = perm(2:2:2*nc) + nc; - idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor + idx = repmat ({':'}, nd, 1); idx{2} = perm; x = horzcat (real (x), imag (x)); x = x(idx{:}); @@ -147,14 +144,14 @@ if (ischar (arg)) fmt = arg; else - if (isnumeric (x) && round (x) == x && abs (x) < (10 .^ arg)) + if (isnumeric (x) && x == fix (x) && abs (x) < (10 .^ arg)) fmt = sprintf ("%%%dd ", arg); else fmt = sprintf ("%%%d.%dg", arg+7, arg); endif endif else - if (isnumeric (x) && round (x) == x && abs (x) < 1e10) + if (isnumeric (x) && x == fix (x) && abs (x) < 1e10) if (max (abs (x(:))) == 0) dgt = 2; else
--- a/scripts/general/polyarea.m +++ b/scripts/general/polyarea.m @@ -20,7 +20,7 @@ ## @deftypefn {Function File} {} polyarea (@var{x}, @var{y}) ## @deftypefnx {Function File} {} polyarea (@var{x}, @var{y}, @var{dim}) ## -## Determines area of a polygon by triangle method. The variables +## Determine area of a polygon by triangle method. The variables ## @var{x} and @var{y} define the vertex pairs, and must therefore have ## the same shape. They can be either vectors or arrays. If they are ## arrays then the columns of @var{x} and @var{y} are treated separately
--- a/scripts/general/postpad.m +++ b/scripts/general/postpad.m @@ -20,9 +20,8 @@ ## @deftypefn {Function File} {} postpad (@var{x}, @var{l}) ## @deftypefnx {Function File} {} postpad (@var{x}, @var{l}, @var{c}) ## @deftypefnx {Function File} {} postpad (@var{x}, @var{l}, @var{c}, @var{dim}) -## Append the scalar value @var{c} to the vector @var{x} -## until it is of length @var{l}. If the third argument is not -## supplied, a value of 0 is used. +## Append the scalar value @var{c} to the vector @var{x} until it is of length +## @var{l}. If @var{c} is not given, a value of 0 is used. ## ## If @code{length (@var{x}) > @var{l}}, elements from the end of ## @var{x} are removed until a vector of length @var{l} is obtained. @@ -54,11 +53,8 @@ nd = ndims (x); sz = size (x); if (nargin < 4) - ## Find the first non-singleton dimension - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -77,10 +73,7 @@ d = sz (dim); if (d >= l) - idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor + idx = repmat ({':'}, nd, 1); idx{dim} = 1:l; y = x(idx{:}); else @@ -89,3 +82,16 @@ endif endfunction + +%!error postpad (); +%!error postpad (1); +%!error postpad (1,2,3,4,5); +%!error postpad ([1,2], 2, 2,3); + +%!assert (postpad ([1,2], 4), [1,2,0,0]); +%!assert (postpad ([1;2], 4), [1;2;0;0]); + +%!assert (postpad ([1,2], 4, 2), [1,2,2,2]); +%!assert (postpad ([1;2], 4, 2), [1;2;2;2]); + +%!assert (postpad ([1,2], 2, 2, 1), [1,2;2,2]);
--- a/scripts/general/prepad.m +++ b/scripts/general/prepad.m @@ -20,9 +20,8 @@ ## @deftypefn {Function File} {} prepad (@var{x}, @var{l}) ## @deftypefnx {Function File} {} prepad (@var{x}, @var{l}, @var{c}) ## @deftypefnx {Function File} {} prepad (@var{x}, @var{l}, @var{c}, @var{dim}) -## Prepend the scalar value @var{c} to the vector @var{x} -## until it is of length @var{l}. If the third argument is not -## supplied, a value of 0 is used. +## Prepend the scalar value @var{c} to the vector @var{x} until it is of length +## @var{l}. If @var{c} is not given, a value of 0 is used. ## ## If @code{length (@var{x}) > @var{l}}, elements from the beginning of ## @var{x} are removed until a vector of length @var{l} is obtained. @@ -54,11 +53,8 @@ nd = ndims (x); sz = size (x); if (nargin < 4) - ## Find the first non-singleton dimension - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -77,10 +73,7 @@ d = sz (dim); if (d >= l) - idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor + idx = repmat ({':'}, nd, 1); idx{dim} = d-l+1:d; y = x(idx{:}); else @@ -89,3 +82,18 @@ endif endfunction + +%!error prepad (); +%!error prepad (1); +%!error prepad (1,2,3,4,5); +%!error prepad ([1,2], 2, 2,3); + +%!assert (prepad ([1,2], 4), [0,0,1,2]); +%!assert (prepad ([1;2], 4), [0;0;1;2]); + +%!assert (prepad ([1,2], 4, 2), [2,2,1,2]); +%!assert (prepad ([1;2], 4, 2), [2;2;1;2]); + +%!assert (prepad ([1,2], 2, 2, 1), [2,2;1,2]); + +## FIXME -- we need tests for multidimensional arrays.
--- a/scripts/general/private/__isequal__.m +++ b/scripts/general/private/__isequal__.m @@ -59,16 +59,16 @@ ## All arguments must either be of the same class or they must be ## numeric values. t = (all (strcmp (class(x), - cellfun (@class, varargin, "uniformoutput", false))) + cellfun ("class", varargin, "uniformoutput", false))) || ((isnumeric (x) || islogical (x)) - && all (cellfun (@isnumeric, varargin) - | cellfun (@islogical, varargin)))); + && all (cellfun ("isnumeric", varargin) + | cellfun ("islogical", varargin)))); if (t) ## Test that everything has the same number of dimensions. s_x = size (x); s_v = cellfun (@size, varargin, "uniformoutput", false); - t = all (length (s_x) == cellfun (@length, s_v)); + t = all (length (s_x) == cellfun ("length", s_v)); endif if (t) @@ -96,8 +96,8 @@ ## Test the number of fields. fn_x = fieldnames (x); l_fn_x = length (fn_x); - fn_v = cellfun (@fieldnames, varargin, "uniformoutput", false); - t = all (l_fn_x == cellfun (@length, fn_v)); + fn_v = cellfun ("fieldnames", varargin, "uniformoutput", false); + t = all (l_fn_x == cellfun ("length", fn_v)); ## Test that all the names are equal. idx = 0; @@ -146,7 +146,7 @@ elseif (isa (x, "function_handle")) ## The == operator is overloaded for handles. - t = all (cellfun (@eq, {x}, varargin)); + t = all (cellfun ("eq", {x}, varargin)); else ## Check the numeric types.
new file mode 100644 --- /dev/null +++ b/scripts/general/profexplore.m @@ -0,0 +1,132 @@ +## Copyright (C) 2011 Daniel Kraft +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} profexplore (@var{data}) +## Interactively explore hierarchical profiler output. +## +## Assuming @var{data} is the structure with profile data returned by +## @code{profile ('info')}, this command opens an interactive prompt +## that can be used to explore the call-tree. Type @kbd{help} to get a list +## of possible commands. +## @seealso{profile, profshow} +## @end deftypefn + +## Built-in profiler. +## Author: Daniel Kraft <d@domob.eu> + +function profexplore (data) + + if (nargin ~= 1) + print_usage (); + endif + + ## The actual work is done by a recursive worker function, since that + ## is an easy way to traverse the tree datastructure. Here, we just check + ## the arguments (already done) and give over to it. + + __profexplore_worker (data.FunctionTable, data.Hierarchical, "Top\n", " "); + +endfunction + +## This is the worker function. tree is the current subtree we want to +## display / explore. parents is a string containing the already 'rendered' +## data for the parents which is displayed on top of the list of current +## children. prefix is the prefix to add to each line rendered; this +## is just a string of spaces to get indentation right. +## +## Returning 0 indicates that the user requested to totally exit the +## explorer, thus also all higher levels should exit immediately. An integer +## greater zero indicates to exit that many levels since the user wants to go +## up (but not necessarily quit). + +function rv = __profexplore_worker (fcn_table, tree, parents, prefix) + + ## Sort children by total time. + times = -[ tree.TotalTime ]; + [~, p] = sort (times); + tree = tree(p); + + while (true) + + printf ("\n%s", parents); + strings = cell (length (tree), 1); + for i = 1 : length (tree) + strings{i} = sprintf ("%s: %d calls, %.3f total, %.3f self", ... + fcn_table(tree(i).Index).FunctionName, ... + tree(i).NumCalls, ... + tree(i).TotalTime, tree(i).SelfTime); + printf ("%s%d) %s\n", prefix, i, strings{i}); + endfor + printf ("\n"); + + cmd = input ("profexplore> ", "s"); + option = fix (str2double (cmd)); + + if (strcmp (cmd, "exit")) + rv = 0; + return; + elseif (strcmp (cmd, "help")) + printf ("\nCommands for profile explorer:\n\n"); + printf ("exit Return to Octave prompt.\n"); + printf ("help Display this help message.\n"); + printf ("up [N] Go up N levels, where N is an integer. Default is 1.\n"); + printf ("N Go down a level into option N.\n"); + elseif (~isnan (option)) + if (option < 1 || option > length (tree)) + printf ("The chosen option is out of range!\n"); + else + newParents = sprintf ("%s%s%s\n", parents, prefix, strings{option}); + newPrefix = sprintf ("%s ", prefix); + + rv = __profexplore_worker (fcn_table, tree(option).Children, ... + newParents, newPrefix); + + if (rv == 0) + return; + elseif (rv > 1) + rv = rv - 1; + return; + else + assert (rv == 1); + ## It was requested to return to this level, so just stay. + endif + endif + elseif (length (cmd) >= 2 && strcmp (substr (cmd, 1, 2), "up")) + if (length (cmd) == 2) + rv = 1; + return; + endif + + if (length (cmd) > 3 && cmd(3) == ' ') + opt = fix (str2double (substr (cmd, 3))); + if (~isnan (opt) && opt > 0) + rv = opt; + return; + endif + endif + + printf ("Invalid 'up' command. Type 'help' for further"); + printf (" information.\n"); + else + printf ("Unrecognized input. Type 'help' to get a list of possible"); + printf (" commands.\n"); + endif + + endwhile +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/general/profile.m @@ -0,0 +1,151 @@ +## Copyright (C) 2011 Daniel Kraft +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Command} {} profile on +## @deftypefnx {Command} {} profile off +## @deftypefnx {Command} {} profile resume +## @deftypefnx {Command} {} profile clear +## @deftypefnx {Function File} {@var{S} =} profile ('status') +## @deftypefnx {Function File} {@var{T} =} profile ('info') +## Control the built-in profiler. +## +## @table @code +## @item profile on +## Start the profiler, clearing all previously collected data if there +## is any. +## +## @item profile off +## Stop profiling. The collected data can later be retrieved and examined +## with calls like @code{S = profile ('info')}. +## +## @item profile clear +## Clear all collected profiler data. +## +## @item profile resume +## Restart profiling without cleaning up the old data and instead +## all newly collected statistics are added to the already existing ones. +## +## @item @var{S} = profile ('status') +## Return a structure filled with certain information about the current status +## of the profiler. At the moment, the only field is @code{ProfilerStatus} +## which is either 'on' or 'off'. +## +## @item @var{T} = profile ('info') +## Return the collected profiling statistics in the structure @var{T}. +## The flat profile is returned in the field @code{FunctionTable} which is an +## array of structures, each entry corresponding to a function which was called +## and for which profiling statistics are present. Furthermore, the field +## @code{Hierarchical} contains the hierarchical call-tree. Each node +## has an index into the @code{FunctionTable} identifying the function it +## corresponds to as well as data fields for number of calls and time spent +## at this level in the call-tree. +## @seealso{profshow, profexplore} +## @end table +## @end deftypefn + +## Built-in profiler. +## Author: Daniel Kraft <d@domob.eu> + +function retval = profile (option) + + if (nargin != 1) + print_usage (); + endif + + switch (option) + case 'on' + __profiler_reset__ (); + __profiler_enable__ (true); + + case 'off' + __profiler_enable__ (false); + + case 'clear' + __profiler_reset__ (); + + case 'resume' + __profiler_enable__ (true); + + case 'status' + enabled = __profiler_enable__ (); + if (enabled) + enabled = 'on'; + else + enabled = 'off'; + endif + retval = struct ('ProfilerStatus', enabled); + + case 'info' + [flat, tree] = __profiler_data__ (); + retval = struct ('FunctionTable', flat, 'Hierarchical', tree); + + otherwise + warning ("profile: Unrecognized option '%s'", option); + print_usage (); + + endswitch + +endfunction + + +%!demo +%! profile ('on'); +%! A = rand (100); +%! B = expm (A); +%! profile ('off'); +%! profile ('resume'); +%! C = sqrtm (A); +%! profile ('off'); +%! T = profile ('info'); +%! profshow (T); + +%!error profile (); +%!error profile ('on', 2); + +%!test +%! on_struct.ProfilerStatus = "on"; +%! off_struct.ProfilerStatus = "off"; +%! profile ('on'); +%! result = logm (rand (200) + 10 * eye (200)); +%! assert (profile ('status'), on_struct); +%! profile ('off'); +%! assert (profile ('status'), off_struct); +%! profile ('resume'); +%! result = logm (rand (200) + 10 * eye (200)); +%! profile ('off'); +%! assert (profile ('status'), off_struct); +%! info = profile ('info'); +%! assert (isstruct (info)); +%! assert (size (info), [1, 1]); +%! assert (fieldnames (info), {'FunctionTable'; 'Hierarchical'}); +%! ftbl = info.FunctionTable; +%! assert (fieldnames (ftbl), {'FunctionName'; 'TotalTime'; 'NumCalls'; 'IsRecursive'; 'Parents'; 'Children'}); +%! hier = info.Hierarchical; +%! assert (fieldnames (hier), {'Index'; 'SelfTime'; 'TotalTime'; 'NumCalls'; 'Children'}); +%! profile ('clear'); +%! info = profile ('info'); +%! assert (isstruct (info)); +%! assert (size (info), [1, 1]); +%! assert (fieldnames (info), {'FunctionTable'; 'Hierarchical'}); +%! ftbl = info.FunctionTable; +%! assert (size (ftbl), [0, 1]); +%! assert (fieldnames (ftbl), {'FunctionName'; 'TotalTime'; 'NumCalls'; 'IsRecursive'; 'Parents'; 'Children'}); +%! hier = info.Hierarchical; +%! assert (size (hier), [0, 1]); +%! assert (fieldnames (hier), {'Index'; 'SelfTime'; 'NumCalls'; 'Children'});
new file mode 100644 --- /dev/null +++ b/scripts/general/profshow.m @@ -0,0 +1,100 @@ +## Copyright (C) 2011 Daniel Kraft +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} profshow (@var{data}) +## @deftypefnx {Function File} {} profshow (@var{data}, @var{n}) +## Show flat profiler results. +## +## This command prints out profiler data as a flat profile. @var{data} is the +## structure returned by @code{profile ('info')}. If @var{n} is given, it +## specifies the number of functions to show in the profile; functions are +## sorted in descending order by total time spent in them. If there are more +## than @var{n} included in the profile, those will not be shown. @var{n} +## defaults to 20. +## +## The attribute column shows @samp{R} for recursive functions and nothing +## otherwise. +## @seealso{profexplore, profile} +## @end deftypefn + +## Built-in profiler. +## Author: Daniel Kraft <d@domob.eu> + +function profshow (data, n = 20) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + n = fix (n); + if (! isscalar (n) || ! isreal (n) || ! (n > 0)) + error ("profile: N must be a positive integer"); + endif + + m = length (data.FunctionTable); + n = min (n, m); + + ## We want to sort by times in descending order. For this, extract the + ## times to an array, then sort this, and use the resulting index permutation + ## to print out our table. + times = -[ data.FunctionTable.TotalTime ]; + + [~, p] = sort (times); + + ## For printing the table, find out the maximum length of a function name + ## so that we can proportion the table accordingly. Based on this, + ## we can build the format used for printing table rows. + nameLen = length ("Function"); + for i = 1 : n + nameLen = max (nameLen, length (data.FunctionTable(p(i)).FunctionName)); + endfor + headerFormat = sprintf ("%%4s %%%ds %%4s %%12s %%12s\n", nameLen); + rowFormat = sprintf ("%%4d %%%ds %%4s %%12.3f %%12d\n", nameLen); + + printf (headerFormat, "#", "Function", "Attr", "Time (s)", "Calls"); + printf ("%s\n", repmat ("-", 1, nameLen + 2 * 5 + 2 * 13)); + for i = 1 : n + row = data.FunctionTable(p(i)); + attr = ""; + if (row.IsRecursive) + attr = "R"; + endif + printf (rowFormat, p(i), row.FunctionName, attr, ... + row.TotalTime, row.NumCalls); + endfor + +endfunction + +%!demo +%! profile ("on"); +%! A = rand (100); +%! B = expm (A); +%! profile ("off"); +%! T = profile ("info"); +%! profshow (T, 10); + +%!demo +%! profile ("on"); +%! expm (rand (500) + eye (500)); +%! profile ("off"); +%! profshow (profile ("info"), 5); + +%!error profshow (); +%!error profshow (1, 2, 3); +%!error profshow (struct (), 1.2);
--- a/scripts/general/quadgk.m +++ b/scripts/general/quadgk.m @@ -17,25 +17,29 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} quadgk (@var{f}, @var{a}, @var{b}, @var{abstol}, @var{trace}) -## @deftypefnx {Function File} {} quadgk (@var{f}, @var{a}, @var{b}, @var{prop}, @var{val}, @dots{}) +## @deftypefn {Function File} {@var{q} =} quadgk (@var{f}, @var{a}, @var{b}) +## @deftypefnx {Function File} {@var{q} =} quadgk (@var{f}, @var{a}, @var{b}, @var{abstol}) +## @deftypefnx {Function File} {@var{q} =} quadgk (@var{f}, @var{a}, @var{b}, @var{abstol}, @var{trace}) +## @deftypefnx {Function File} {@var{q} =} quadgk (@var{f}, @var{a}, @var{b}, @var{prop}, @var{val}, @dots{}) ## @deftypefnx {Function File} {[@var{q}, @var{err}] =} quadgk (@dots{}) -## Numerically evaluate integral using adaptive Gauss-Konrod quadrature. +## +## Numerically evaluate the integral of @var{f} from @var{a} to @var{b} +## using adaptive Gauss-Konrod quadrature. +## @var{f} is a function handle, inline function, or string +## containing the name of the function to evaluate. ## The formulation is based on a proposal by L.F. Shampine, ## @cite{"Vectorized adaptive quadrature in @sc{matlab}", Journal of ## Computational and Applied Mathematics, pp131-140, Vol 211, Issue 2, ## Feb 2008} where all function evaluations at an iteration are -## calculated with a single call to @var{f}. Therefore the function -## @var{f} must be of the form @code{@var{f} (@var{x})} and accept -## vector values of @var{x} and return a vector of the same length -## representing the function evaluations at the given values of @var{x}. -## The function @var{f} can be defined in terms of a function handle, -## inline function or string. +## calculated with a single call to @var{f}. Therefore, the function +## @var{f} must be vectorized and must accept a vector of input values @var{x} +## and return an output vector representing the function evaluations at the +## given values of @var{x}. ## -## The bounds of the quadrature @code{[@var{a}, @var{b}]} can be finite -## or infinite and contain weak end singularities. Variable -## transformation will be used to treat infinite intervals and weaken -## the singularities. For example: +## @var{a} and @var{b} are the lower and upper limits of integration. Either +## or both limits may be infinite or contain weak end singularities. +## Variable transformation will be used to treat any infinite intervals and +## weaken the singularities. For example: ## ## @example ## quadgk(@@(x) 1 ./ (sqrt (x) .* (x + 1)), 0, Inf) @@ -46,53 +50,57 @@ ## element-by-element operator @code{./} and all user functions to ## @code{quadgk} should do the same. ## -## The absolute tolerance can be passed as a fourth argument in a manner -## compatible with @code{quadv}. Equally the user can request that -## information on the convergence can be printed is the fifth argument -## is logically true. +## The optional argument @var{tol} defines the absolute tolerance used to stop +## the integration procedure. The default value is @math{1e^{-10}}. ## -## Alternatively, certain properties of @code{quadgk} can be passed as -## pairs @code{@var{prop}, @var{val}}. Valid properties are +## The algorithm used by @code{quadgk} involves subdividing the +## integration interval and evaluating each subinterval. +## If @var{trace} is true then after computing each of these partial +## integrals display: (1) the number of subintervals at this step, +## (2) the current estimate of the error @var{err}, (3) the current estimate +## for the integral @var{q}. +## +## Alternatively, properties of @code{quadgk} can be passed to the function as +## pairs @code{"@var{prop}", @var{val}}. Valid properties are ## ## @table @code ## @item AbsTol -## Defines the absolute error tolerance for the quadrature. The default +## Define the absolute error tolerance for the quadrature. The default ## absolute tolerance is 1e-10. ## ## @item RelTol -## Defines the relative error tolerance for the quadrature. The default +## Define the relative error tolerance for the quadrature. The default ## relative tolerance is 1e-5. ## ## @item MaxIntervalCount ## @code{quadgk} initially subdivides the interval on which to perform -## the quadrature into 10 intervals. Sub-intervals that have an -## unacceptable error are sub-divided and re-evaluated. If the number of -## sub-intervals exceeds at any point 650 sub-intervals then a poor +## the quadrature into 10 intervals. Subintervals that have an +## unacceptable error are subdivided and re-evaluated. If the number of +## subintervals exceeds 650 subintervals at any point then a poor ## convergence is signaled and the current estimate of the integral is ## returned. The property 'MaxIntervalCount' can be used to alter the -## number of sub-intervals that can exist before exiting. +## number of subintervals that can exist before exiting. ## ## @item WayPoints -## If there exists discontinuities in the first derivative of the -## function to integrate, then these can be flagged with the -## @code{"WayPoints"} property. This forces the ends of a sub-interval -## to fall on the breakpoints of the function and can result in +## Discontinuities in the first derivative of the function to integrate can be +## flagged with the @code{"WayPoints"} property. This forces the ends of +## a subinterval to fall on the breakpoints of the function and can result in ## significantly improved estimation of the error in the integral, faster -## computation or both. For example, +## computation, or both. For example, ## ## @example -## quadgk (@@(x) abs (1 - x .^ 2), 0, 2, 'Waypoints', 1) +## quadgk (@@(x) abs (1 - x.^2), 0, 2, 'Waypoints', 1) ## @end example ## ## @noindent ## signals the breakpoint in the integrand at @code{@var{x} = 1}. ## ## @item Trace -## If logically true, then @code{quadgk} prints information on the +## If logically true @code{quadgk} prints information on the ## convergence of the quadrature at each iteration. -##@end table +## @end table ## -## If any of @var{a}, @var{b} or @var{waypoints} is complex, then the +## If any of @var{a}, @var{b}, or @var{waypoints} is complex then the ## quadrature is treated as a contour integral along a piecewise ## continuous path defined by the above. In this case the integral is ## assumed to have no edge singularities. For example, @@ -108,11 +116,12 @@ ## integrates @code{log (z)} along the square defined by @code{[1+1i, ## 1-1i, -1-1i, -1+1i]} ## -## If two output arguments are requested, then @var{err} returns the -## approximate bounds on the error in the integral @code{abs (@var{q} - -## @var{i})}, where @var{i} is the exact value of the integral. +## The result of the integration is returned in @var{q}. +## @var{err} is an approximate bound on the error in the integral +## @code{abs (@var{q} - @var{I})}, where @var{I} is the exact value of the +## integral. ## -## @seealso{quad,quadv,quadl,quadcc,trapz,dblquad,triplequad} +## @seealso{quad, quadv, quadl, quadcc, trapz, dblquad, triplequad} ## @end deftypefn function [q, err] = quadgk (f, a, b, varargin) @@ -223,9 +232,9 @@ if (!isempty (waypoints)) tmp = sqrt (b - waypoints); trans = @(x) - x ./ (x + 1); - subs = [0; trans(tmp); 1]; + subs = [-1; trans(tmp); 0]; else - subs = linspace (0, 1, 11)'; + subs = linspace (-1, 0, 11)'; endif h = 1; h0 = b - a; @@ -281,7 +290,7 @@ 3 .* (b - a) ./ 4 .* (1 - t.^2); endif - ## Split interval into at least 10 sub-interval with a 15 point + ## Split interval into at least 10 subinterval with a 15 point ## Gauss-Kronrod rule giving a minimum of 150 function evaluations while (length (subs) < 11) subs = [subs' ; subs(1:end-1)' + diff(subs') ./ 2, NaN](:)(1 : end - 1); @@ -294,7 +303,7 @@ ## Singularity will cause divide by zero warnings warning ("off", "Octave:divide-by-zero"); - ## Initial evaluation of the integrand on the sub-intervals + ## Initial evaluation of the integrand on the subintervals [q_subs, q_errs] = __quadgk_eval__ (f, subs); q0 = sum (q_subs); err0 = sum (q_errs); @@ -307,8 +316,8 @@ first = true; while (true) - ## Check for sub-intervals that are too small. Test must be - ## performed in untransformed sub-intervals. What is a good + ## Check for subintervals that are too small. Test must be + ## performed in untransformed subintervals. What is a good ## value for this test. Shampine suggests 100*eps if (any (abs (diff (trans (subs), [], 2) / h0) < 100 * myeps)) q = q0; @@ -333,7 +342,7 @@ break; endif - ## Accept the sub-intervals that meet the convergence criteria + ## Accept the subintervals that meet the convergence criteria idx = find (abs (q_errs) < tol .* abs(diff (subs, [], 2)) ./ h); if (first) q = sum (q_subs (idx)); @@ -347,7 +356,7 @@ endif subs(idx,:) = []; - ## If no remaining sub-intervals exit + ## If no remaining subintervals exit if (rows (subs) == 0) break; endif @@ -356,12 +365,12 @@ disp([rows(subs), err, q0]); endif - ## Split remaining sub-intervals in two + ## Split remaining subintervals in two mid = (subs(:,2) + subs(:,1)) ./ 2; subs = [subs(:,1), mid; mid, subs(:,2)]; - ## If the maximum sub-interval count is met accept remaining - ## sub-interval and exit + ## If the maximum subinterval count is met accept remaining + ## subinterval and exit if (rows (subs) > maxint) warning ("quadgk: maximum interval count (%d) met", maxint); q += sum (q_subs); @@ -369,7 +378,7 @@ break; endif - ## Evaluation of the integrand on the remaining sub-intervals + ## Evaluation of the integrand on the remaining subintervals [q_subs, q_errs] = __quadgk_eval__ (f, subs); endwhile @@ -449,3 +458,4 @@ %!assert (quadgk (@(z) log (z), 1+1i, 1+1i, 'WayPoints', [1-1i, -1,-1i, -1+1i]), -pi * 1i, 1e-6) %!assert (quadgk (@(x) exp(-x .^ 2), -Inf, Inf), sqrt(pi), 1e-6) +%!assert (quadgk (@(x) exp(-x .^ 2), -Inf, 0), sqrt(pi)/2, 1e-6)
--- a/scripts/general/quadl.m +++ b/scripts/general/quadl.m @@ -22,26 +22,33 @@ ## @deftypefnx {Function File} {@var{q} =} quadl (@var{f}, @var{a}, @var{b}, @var{tol}, @var{trace}) ## @deftypefnx {Function File} {@var{q} =} quadl (@var{f}, @var{a}, @var{b}, @var{tol}, @var{trace}, @var{p1}, @var{p2}, @dots{}) ## -## Numerically evaluate integral using adaptive Lobatto rule. -## @code{quadl (@var{f}, @var{a}, @var{b})} approximates the integral of -## @code{@var{f}(@var{x})} to machine precision. @var{f} is either a -## function handle, inline function or string containing the name of -## the function to evaluate. The function @var{f} must return a vector -## of output values if given a vector of input values. +## Numerically evaluate the integral of @var{f} from @var{a} to @var{b} +## using an adaptive Lobatto rule. +## @var{f} is a function handle, inline function, or string +## containing the name of the function to evaluate. +## The function @var{f} must be vectorized and return a vector of output values +## if given a vector of input values. +## +## @var{a} and @var{b} are the lower and upper limits of integration. Both +## limits must be finite. ## -## If defined, @var{tol} defines the relative tolerance to which to -## which to integrate @code{@var{f}(@var{x})}. While if @var{trace} is -## defined, displays the left end point of the current interval, the -## interval length, and the partial integral. +## The optional argument @var{tol} defines the relative tolerance with which +## to perform the integration. The default value is @code{eps}. ## -## Additional arguments @var{p1}, etc., are passed directly to @var{f}. -## To use default values for @var{tol} and @var{trace}, one may pass -## empty matrices. +## The algorithm used by @code{quadl} involves recursively subdividing the +## integration interval. +## If @var{trace} is defined then for each subinterval display: (1) the left +## end of the subinterval, (2) the length of the subinterval, (3) the +## approximation of the integral over the subinterval. +## +## Additional arguments @var{p1}, etc., are passed directly to the function +## @var{f}. To use default values for @var{tol} and @var{trace}, one may pass +## empty matrices ([]). ## ## Reference: W. Gander and W. Gautschi, @cite{Adaptive Quadrature - ## Revisited}, BIT Vol. 40, No. 1, March 2000, pp. 84--101. ## @url{http://www.inf.ethz.ch/personal/gander/} -## @seealso{quad,quadv,quadgk,quadcc,trapz,dblquad,triplequad} +## @seealso{quad, quadv, quadgk, quadcc, trapz, dblquad, triplequad} ## @end deftypefn ## Author: Walter Gautschi @@ -55,14 +62,12 @@ ## * replace global variable terminate2 with local function need_warning ## * add paper ref to docs -function Q = quadl (f, a, b, tol, trace, varargin) - need_warning (1); - if (nargin < 4) - tol = []; +function q = quadl (f, a, b, tol = [], trace = false, varargin) + + if (nargin < 3) + print_usage (); endif - if (nargin < 5) - trace = []; - endif + if (isa (a, "single") || isa (b, "single")) myeps = eps ("single"); else @@ -72,16 +77,23 @@ tol = myeps; endif if (isempty (trace)) - trace = 0; + trace = false; endif if (tol < myeps) tol = myeps; endif + ## Track whether recursion has occurred + global __quadl_recurse_done__; + __quadl_recurse_done__ = false; + ## Track whether warning about machine precision has been issued + global __quadl_need_warning__; + __quadl_need_warning__ = true; + m = (a+b)/2; h = (b-a)/2; - alpha = sqrt(2/3); - beta = 1/sqrt(5); + alpha = sqrt (2/3); + beta = 1/sqrt (5); x1 = .942882415695480; x2 = .641853342345781; @@ -97,12 +109,12 @@ i2 = (h/6)*(y(1) + y(13) + 5*(y(5)+y(9))); - i1 = (h/1470)*(77*(y(1)+y(13)) + i1 = (h/1470)*( 77*(y(1)+y(13)) + 432*(y(3)+y(11)) + 625*(y(5)+y(9)) + 672*y(7)); - is = h*(.0158271919734802*(y(1)+y(13)) + is = h*( .0158271919734802*(y(1)+y(13)) +.0942738402188500*(y(2)+y(12)) + .155071987336585*(y(3)+y(11)) + .188821573960182*(y(4)+y(10)) @@ -110,80 +122,96 @@ + .224926465333340*(y(6)+y(8)) + .242611071901408*y(7)); - s = sign(is); - + s = sign (is); if (s == 0) s = 1; endif - erri1 = abs(i1-is); - erri2 = abs(i2-is); - R = 1; + erri1 = abs (i1-is); + erri2 = abs (i2-is); if (erri2 != 0) R = erri1/erri2; + else + R = 1; endif if (R > 0 && R < 1) tol = tol/R; endif - is = s*abs(is)*tol/myeps; + is = s * abs(is) * tol/myeps; if (is == 0) is = b-a; endif - Q = adaptlobstp (f, a, b, fa, fb, is, trace, varargin{:}); + + q = adaptlobstp (f, a, b, fa, fb, is, trace, varargin{:}); + endfunction ## ADAPTLOBSTP Recursive function used by QUADL. ## ## Q = ADAPTLOBSTP('F', A, B, FA, FB, IS, TRACE) tries to ## approximate the integral of F(X) from A to B to -## an appropriate relative error. The argument 'F' is +## an appropriate relative error. The argument 'F' is ## a string containing the name of f. The remaining ## arguments are generated by ADAPTLOB or by recursion. ## ## Walter Gautschi, 08/03/98 -function Q = adaptlobstp (f, a, b, fa, fb, is, trace, varargin) +function q = adaptlobstp (f, a, b, fa, fb, is, trace, varargin) + global __quadl_recurse_done__; + global __quadl_need_warning__; + h = (b-a)/2; m = (a+b)/2; - alpha = sqrt(2/3); - beta = 1/sqrt(5); + alpha = sqrt (2/3); + beta = 1 / sqrt(5); mll = m-alpha*h; - ml = m-beta*h; - mr = m+beta*h; + ml = m-beta*h; + mr = m+beta*h; mrr = m+alpha*h; x = [mll, ml, m, mr, mrr]; - y = feval(f, x, varargin{:}); + y = feval (f, x, varargin{:}); fmll = y(1); - fml = y(2); - fm = y(3); - fmr = y(4); + fml = y(2); + fm = y(3); + fmr = y(4); fmrr = y(5); i2 = (h/6)*(fa + fb + 5*(fml+fmr)); i1 = (h/1470)*(77*(fa+fb) + 432*(fmll+fmrr) + 625*(fml+fmr) + 672*fm); - if (is+(i1-i2) == is || mll <= a || b <= mrr) - if ((m <= a || b <= m) && need_warning ()) + if ((is+(i1-i2) == is || mll <= a || b <= mrr) && __quadl_recurse_done__) + if ((m <= a || b <= m) && __quadl_need_warning__) warning ("quadl: interval contains no more machine number"); warning ("quadl: required tolerance may not be met"); - need_warning (0); + __quadl_need_warning__ = false; endif - Q = i1; + q = i1; if (trace) - disp ([a, b-a, Q]); + disp ([a, b-a, q]); endif else - Q = (adaptlobstp (f, a, mll, fa, fmll, is, trace, varargin{:}) - + adaptlobstp (f, mll, ml, fmll, fml, is, trace, varargin{:}) - + adaptlobstp (f, ml, m, fml, fm, is, trace, varargin{:}) - + adaptlobstp (f, m, mr, fm, fmr, is, trace, varargin{:}) - + adaptlobstp (f, mr, mrr, fmr, fmrr, is, trace, varargin{:}) - + adaptlobstp (f, mrr, b, fmrr, fb, is, trace, varargin{:})); + __quadl_recurse_done__ = true; + q = ( adaptlobstp (f, a , mll, fa , fmll, is, trace, varargin{:}) + + adaptlobstp (f, mll, ml , fmll, fml , is, trace, varargin{:}) + + adaptlobstp (f, ml , m , fml , fm , is, trace, varargin{:}) + + adaptlobstp (f, m , mr , fm , fmr , is, trace, varargin{:}) + + adaptlobstp (f, mr , mrr, fmr , fmrr, is, trace, varargin{:}) + + adaptlobstp (f, mrr, b , fmrr, fb , is, trace, varargin{:})); endif endfunction -function r = need_warning (v) - persistent w = []; - if (nargin == 0) - r = w; - else - w = v; - endif -endfunction + +## basic functionality +%!assert (quadl (@(x) sin (x), 0, pi, [], []), 2, -3e-16) + +## the values here are very high so it may be unavoidable that this fails +%!assert (quadl (@(x) sin (3*x).*cosh (x).*sinh (x),10,15), +%! 2.588424538641647e+10, -1.1e-14) + +## extra parameters +%!assert (quadl (@(x,a,b) sin (a + b*x), 0, 1, [], [], 2, 3), +%! cos(2)/3 - cos(5)/3, -3e-16) + +## test different tolerances. +%!assert (quadl (@(x) sin (2 + 3*x).^2, 0, 10, 0.3, []), +%! (60 + sin(4) - sin(64))/12, -0.3) +%!assert (quadl (@(x) sin (2 + 3*x).^2, 0, 10, 0.1, []), +%! (60 + sin(4) - sin(64))/12, -0.1) +
--- a/scripts/general/quadv.m +++ b/scripts/general/quadv.m @@ -1,4 +1,5 @@ ## Copyright (C) 2008-2011 David Bateman +## Copyright (C) 2011 Alexander Klein ## ## This file is part of Octave. ## @@ -21,32 +22,45 @@ ## @deftypefnx {Function File} {@var{q} =} quadv (@var{f}, @var{a}, @var{b}, @var{tol}) ## @deftypefnx {Function File} {@var{q} =} quadv (@var{f}, @var{a}, @var{b}, @var{tol}, @var{trace}) ## @deftypefnx {Function File} {@var{q} =} quadv (@var{f}, @var{a}, @var{b}, @var{tol}, @var{trace}, @var{p1}, @var{p2}, @dots{}) -## @deftypefnx {Function File} {[@var{q}, @var{fcnt}] =} quadv (@dots{}) +## @deftypefnx {Function File} {[@var{q}, @var{nfun}] =} quadv (@dots{}) ## ## Numerically evaluate the integral of @var{f} from @var{a} to @var{b} -## using adaptive Simpson's rule. -## @var{f} is either a function handle, inline function or string +## using an adaptive Simpson's rule. +## @var{f} is a function handle, inline function, or string ## containing the name of the function to evaluate. -## The function defined by @var{f} may be a scalar, vector or array-valued. +## @code{quadv} is a vectorized version of @code{quad} and the function +## defined by @var{f} must accept a scalar or vector as input and return a +## scalar, vector, or array as output. ## -## If a value for @var{tol} is given, it defines the tolerance used to stop -## the adaptation procedure, otherwise the default value of 1e-6 is used. +## @var{a} and @var{b} are the lower and upper limits of integration. Both +## limits must be finite. +## +## The optional argument @var{tol} defines the tolerance used to stop +## the adaptation procedure. The default value is @math{1e^{-6}}. ## -## The algorithm used by @code{quadv}, involves recursively subdividing the -## integration interval and applying Simpson's rule on each sub-interval. -## If @var{trace} is @var{true}, after computing each of these partial -## integrals, display the total number of function evaluations, the left end -## of the sub-interval, the length of the sub-interval and the approximation -## of the integral over the sub-interval. +## The algorithm used by @code{quadv} involves recursively subdividing the +## integration interval and applying Simpson's rule on each subinterval. +## If @var{trace} is true then after computing each of these partial +## integrals display: (1) the total number of function evaluations, +## (2) the left end of the subinterval, (3) the length of the subinterval, +## (4) the approximation of the integral over the subinterval. ## -## Additional arguments @var{p1}, etc., are passed directly to @var{f}. -## To use default values for @var{tol} and @var{trace}, one may pass -## empty matrices. +## Additional arguments @var{p1}, etc., are passed directly to the function +## @var{f}. To use default values for @var{tol} and @var{trace}, one may pass +## empty matrices ([]). ## -##@seealso{quad, quadl, quadgk, quadcc, trapz, dblquad, triplequad} +## The result of the integration is returned in @var{q}. @var{nfun} indicates +## the number of function evaluations that were made. +## +## Note: @code{quadv} is written in Octave's scripting language and can be +## used recursively in @code{dblquad} and @code{triplequad}, unlike the +## similar @code{quad} function. +## @seealso{quad, quadl, quadgk, quadcc, trapz, dblquad, triplequad} ## @end deftypefn -function [q, fcnt] = quadv (f, a, b, tol, trace, varargin) +function [q, nfun] = quadv (f, a, b, tol, trace, varargin) + ## TODO: Make norm for convergence testing configurable + if (nargin < 3) print_usage (); endif @@ -73,42 +87,42 @@ fa = feval (f, a, varargin{:}); fc = feval (f, c, varargin{:}); fb = feval (f, b, varargin{:}); - fcnt = 3; + nfun = 3; ## If have edge singularities, move edge point by eps*(b-a) as ## discussed in Shampine paper used to implement quadgk - if (isinf (fa)) + if (any (isinf (fa(:)))) fa = feval (f, a + myeps * (b-a), varargin{:}); endif - if (isinf (fb)) + if (any (isinf (fb(:)))) fb = feval (f, b - myeps * (b-a), varargin{:}); endif h = (b - a); q = (b - a) / 6 * (fa + 4 * fc + fb); - [q, fcnt, hmin] = simpsonstp (f, a, b, c, fa, fb, fc, q, fcnt, abs (h), + [q, nfun, hmin] = simpsonstp (f, a, b, c, fa, fb, fc, q, nfun, abs (h), tol, trace, varargin{:}); - if (fcnt > 10000) + if (nfun > 10000) warning ("maximum iteration count reached"); - elseif (isnan (q) || isinf (q)) + elseif (any (isnan (q)(:) | isinf (q)(:))) warning ("infinite or NaN function evaluations were returned"); elseif (hmin < (b - a) * myeps) warning ("minimum step size reached -- possibly singular integral"); endif endfunction -function [q, fcnt, hmin] = simpsonstp (f, a, b, c, fa, fb, fc, q0, - fcnt, hmin, tol, trace, varargin) - if (fcnt > 10000) +function [q, nfun, hmin] = simpsonstp (f, a, b, c, fa, fb, fc, q0, + nfun, hmin, tol, trace, varargin) + if (nfun > 10000) q = q0; else d = (a + c) / 2; e = (c + b) / 2; fd = feval (f, d, varargin{:}); fe = feval (f, e, varargin{:}); - fcnt += 2; + nfun += 2; q1 = (c - a) / 6 * (fa + 4 * fd + fc); q2 = (b - c) / 6 * (fc + 4 * fe + fb); q = q1 + q2; @@ -118,14 +132,16 @@ endif if (trace) - disp ([fcnt, a, b-a, q]); + disp ([nfun, a, b-a, q]); endif ## Force at least one adpative step. - if (fcnt == 5 || abs (q - q0) > tol) - [q1, fcnt, hmin] = simpsonstp (f, a, c, d, fa, fc, fd, q1, fcnt, hmin, + ## Not vectorizing q-q0 in the norm provides a more rigid criterion for + ## matrix-valued functions. + if (nfun == 5 || norm (q - q0, Inf) > tol) + [q1, nfun, hmin] = simpsonstp (f, a, c, d, fa, fc, fd, q1, nfun, hmin, tol, trace, varargin{:}); - [q2, fcnt, hmin] = simpsonstp (f, c, b, e, fc, fb, fe, q2, fcnt, hmin, + [q2, nfun, hmin] = simpsonstp (f, c, b, e, fc, fb, fe, q2, nfun, hmin, tol, trace, varargin{:}); q = q1 + q2; endif @@ -141,3 +157,5 @@ %% Handles vector-valued functions %!assert (quadv (@(x) [(sin (x)), (sin (2 * x))], 0, pi), [2, 0], 1e-5) +%% Handles matrix-valued functions +%!assert (quadv (@(x) [ x, x, x; x, 1./sqrt(x), x; x, x, x ], 0, 1 ), [0.5, 0.5, 0.5; 0.5, 2, 0.5; 0.5, 0.5, 0.5], 1e-5)
--- a/scripts/general/randi.m +++ b/scripts/general/randi.m @@ -20,7 +20,7 @@ ## @deftypefn {Function File} {} randi (@var{imax}) ## @deftypefnx {Function File} {} randi (@var{imax}, @var{n}) ## @deftypefnx {Function File} {} randi (@var{imax}, @var{m}, @var{n}, @dots{}) -## @deftypefnx {Function File} {} randi ([@var{imin}, @var{imax}], @dots{}) +## @deftypefnx {Function File} {} randi ([@var{imin} @var{imax}], @dots{}) ## @deftypefnx {Function File} {} randi (@dots{}, "@var{class}") ## Return random integers in the range 1:@var{imax}. ## @@ -47,7 +47,7 @@ ## uses class "double" to represent numbers. This limits the maximum ## integer (@var{imax}) and range (@var{imax} - @var{imin}) to the value ## returned by the @code{bitmax} function. For IEEE floating point numbers -## this value is @w{@code{2^53 - 1}}. +## this value is @w{@math{2^{53} - 1}}. ## ## @seealso{rand} ## @end deftypefn
--- a/scripts/general/rat.m +++ b/scripts/general/rat.m @@ -150,3 +150,11 @@ endif endfunction + +%!error rat (); +%!error rat (1, 2, 3); + +%!test +%! [n, d] = rat ([0.5, 0.3, 1/3]); +%! assert (n, [1, 3, 1]); +%! assert (d, [2, 10, 3]);
--- a/scripts/general/repmat.m +++ b/scripts/general/repmat.m @@ -18,7 +18,9 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} repmat (@var{A}, @var{m}, @var{n}) +## @deftypefn {Function File} {} repmat (@var{A}, @var{m}) +## @deftypefnx {Function File} {} repmat (@var{A}, @var{m}, @var{n}) +## @deftypefnx {Function File} {} repmat (@var{A}, @var{m}, @var{n}, @var{p}, @dots{}) ## @deftypefnx {Function File} {} repmat (@var{A}, [@var{m} @var{n}]) ## @deftypefnx {Function File} {} repmat (@var{A}, [@var{m} @var{n} @var{p} @dots{}]) ## Form a block matrix of size @var{m} by @var{n}, with a copy of matrix
--- a/scripts/general/rot90.m +++ b/scripts/general/rot90.m @@ -17,7 +17,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} rot90 (@var{A}, @var{k}) +## @deftypefn {Function File} {} rot90 (@var{A}) +## @deftypefnx {Function File} {} rot90 (@var{A}, @var{k}) ## Return a copy of @var{A} with the elements rotated counterclockwise in ## 90-degree increments. The second argument is optional, and specifies ## how many 90-degree rotations are to be applied (the default value is 1). @@ -44,66 +45,58 @@ ## @end group ## @end example ## -## Due to the difficulty of defining an axis about which to rotate the -## matrix @code{rot90} only work with 2-D arrays. To rotate N-d arrays +## Note that @code{rot90} only works with 2-D arrays. To rotate N-D arrays ## use @code{rotdim} instead. ## @seealso{rotdim, flipud, fliplr, flipdim} ## @end deftypefn ## Author: jwe -function B = rot90 (A, k) - - if (nargin == 1 || nargin == 2) - if (nargin < 2) - k = 1; - endif - - if (ndims (A) > 2) - error ("rot90: Only works with 2-D arrays"); - endif - - if (imag (k) != 0 || fix (k) != k) - error ("rot90: K must be an integer"); - endif - - k = rem (k, 4); +function B = rot90 (A, k = 1) - if (k < 0) - k = k + 4; - endif - - if (k == 0) - B = A; - elseif (k == 1) - B = flipud (A.'); - elseif (k == 2) - B = flipud (fliplr (A)); - elseif (k == 3) - B = (flipud (A)).'; - else - error ("rot90: internal error!"); - endif - else + if (nargin < 1 || nargin > 2) print_usage (); endif + if (ndims (A) > 2) + error ("rot90: A must be a 2-D array"); + elseif (! (isscalar (k) && isreal (k) && k == fix (k))) + error ("rot90: K must be a single real integer"); + endif + + k = mod (k, 4); + + if (k == 0) + B = A; + elseif (k == 1) + B = flipud (A.'); + elseif (k == 2) + B = flipud (fliplr (A)); + elseif (k == 3) + B = (flipud (A)).'; + else + error ("rot90: internal error!"); + endif + endfunction + %!test %! x1 = [1, 2; 3, 4]; %! x2 = [2, 4; 1, 3]; %! x3 = [4, 3; 2, 1]; %! x4 = [3, 1; 4, 2]; %! -%! assert(rot90 (x1) == x2); -%! assert(rot90 (x1, 2) == x3); -%! assert(rot90 (x1, 3) == x4); -%! assert(rot90 (x1, 4) == x1); -%! assert(rot90 (x1, 5) == x2); -%! assert(rot90 (x1, -1) == x4); +%! assert(rot90 (x1), x2); +%! assert(rot90 (x1, 2), x3); +%! assert(rot90 (x1, 3), x4); +%! assert(rot90 (x1, 4), x1); +%! assert(rot90 (x1, 5), x2); +%! assert(rot90 (x1, -1), x4); %% Test input validation %!error rot90 (); %!error rot90 (1, 2, 3); - +%!error rot90 (1, ones(2)); +%!error rot90 (1, 1.5); +%!error rot90 (1, 1+i);
--- a/scripts/general/rotdim.m +++ b/scripts/general/rotdim.m @@ -17,14 +17,17 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} rotdim (@var{x}, @var{n}, @var{plane}) +## @deftypefn {Function File} {} rotdim (@var{x}) +## @deftypefnx {Function File} {} rotdim (@var{x}, @var{n}) +## @deftypefnx {Function File} {} rotdim (@var{x}, @var{n}, @var{plane}) ## Return a copy of @var{x} with the elements rotated counterclockwise in -## 90-degree increments. The second argument is optional, and specifies -## how many 90-degree rotations are to be applied (the default value is 1). +## 90-degree increments. +## The second argument @var{n} is optional, and specifies how many 90-degree +## rotations are to be applied (the default value is 1). ## The third argument is also optional and defines the plane of the -## rotation. As such @var{plane} is a two element vector containing two -## different valid dimensions of the matrix. If @var{plane} is not given -## Then the first two non-singleton dimensions are used. +## rotation. If present, @var{plane} is a two element vector containing two +## different valid dimensions of the matrix. When @var{plane} is not given +## the first two non-singleton dimensions are used. ## ## Negative values of @var{n} rotate the matrix in a clockwise direction. ## For example, @@ -68,26 +71,30 @@ nd = ndims (x); sz = size (x); if (nargin < 3) - ## Find the first two non-singleton dimension. - plane = []; - dim = 0; - while (dim < nd) - dim = dim + 1; - if (sz (dim) != 1) - plane = [plane, dim]; - if (length (plane) == 2) - break; + if (nd > 2) + ## Find the first two non-singleton dimension. + plane = []; + dim = 0; + while (dim < nd) + dim = dim + 1; + if (sz (dim) != 1) + plane = [plane, dim]; + if (length (plane) == 2) + break; + endif endif + endwhile + if (length (plane) < 1) + plane = [1, 2]; + elseif (length (plane) < 2) + plane = [1, plane]; endif - endwhile - if (length (plane) < 1) + else plane = [1, 2]; - elseif (length (plane) < 2) - plane = [1, plane]; endif else if (! (isvector (plane) && length (plane) == 2 - && all (plane == round (plane)) && all (plane > 0) + && all (plane == fix (plane)) && all (plane > 0) && all (plane < (nd + 1)) && plane(1) != plane(2))) error ("rotdim: PLANE must be a 2 element integer vector defining a valid PLANE"); endif @@ -116,3 +123,36 @@ endif endfunction + +%!error rotdim (); +%!error rotdim (1, 2, 3, 4); + +%!shared r, rr +%! r = [1,2,3]; rr = [3,2,1]; +%!assert (rotdim (r, 0), r); +%!assert (rotdim (r, 1), rr'); +%!assert (rotdim (r, 2), rr); +%!assert (rotdim (r, 3), r'); +%!assert (rotdim (r, 3), rotdim (r, -1)); +%!assert (rotdim (r, 1), rotdim (r)); + +%!shared c, cr +%! c = [1;2;3]; cr = [3;2;1]; +%!assert (rotdim (c, 0), c); +%!assert (rotdim (c, 1), c'); +%!assert (rotdim (c, 2), cr); +%!assert (rotdim (c, 3), cr'); +%!assert (rotdim (c, 3), rotdim (c, -1)); +%!assert (rotdim (c, 1), rotdim (c)); + +%!shared m +%! m = [1,2;3,4]; +%!assert (rotdim (m, 0), m); +%!assert (rotdim (m, 1), [2,4;1,3]); +%!assert (rotdim (m, 2), [4,3;2,1]); +%!assert (rotdim (m, 3), [3,1;4,2]); +%!assert (rotdim (m, 3), rotdim (m, -1)); +%!assert (rotdim (m, 1), rotdim (m)); + +## FIXME -- we need tests for multidimensional arrays and different +## values of PLANE.
--- a/scripts/general/shift.m +++ b/scripts/general/shift.m @@ -37,7 +37,9 @@ print_usage (); endif - if (! (isscalar (b) && b == round (b))) + if (numel (x) < 1) + error ("shift: X must not be empty"); + elseif (! (isscalar (b) && b == fix (b))) error ("shift: B must be an integer"); endif @@ -45,39 +47,31 @@ sz = size (x); if (nargin == 3) - if (!(isscalar (dim) && dim == round (dim)) + if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) error ("shift: DIM must be an integer and a valid dimension"); endif else ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); endif - if (numel (x) < 1) - error ("shift: X must not be empty"); - endif - - d = sz (dim); + d = sz(dim); - idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor - if (b >= 0) + idx = repmat ({':'}, nd, 1); + if (b > 0) b = rem (b, d); idx{dim} = [d-b+1:d, 1:d-b]; elseif (b < 0) b = rem (abs (b), d); idx{dim} = [b+1:d, 1:b]; endif + y = x(idx{:}); endfunction + %!test %! a = [1, 2, 3]; %! b = [4, 5, 6]; @@ -86,13 +80,20 @@ %! r = [a, b, c]; %! m = [a; b; c]; %! -%! assert((shift (r, 3) == [c, a, b] -%! && shift (r, -6) == [c, a, b] -%! && shift (r, -3) == [b, c, a] -%! && shift (m, 1) == [c; a; b] -%! && shift (m, -2) == [c; a; b])); +%! assert(shift (r, 0), r); +%! assert(shift (r, 3), [c, a, b]); +%! assert(shift (r, -6), [c, a, b]); +%! assert(shift (r, -3), [b, c, a]); +%! assert(shift (m, 1), [c; a; b]); +%! assert(shift (m, -2), [c; a; b]); -%!error shift (); +%% Test input validation +%!error shift () +%!error shift (1, 2, 3, 4) +%!error shift ([], 1) +%!error shift (ones(2), ones(2)) +%!error shift (ones(2), 1.5) +%!error shift (1, 1, 1.5) +%!error shift (1, 1, 0) +%!error shift (1, 1, 3) -%!error shift (1, 2, 3, 4); -
--- a/scripts/general/shiftdim.m +++ b/scripts/general/shiftdim.m @@ -19,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{y} =} shiftdim (@var{x}, @var{n}) ## @deftypefnx {Function File} {[@var{y}, @var{ns}] =} shiftdim (@var{x}) -## Shifts the dimension of @var{x} by @var{n}, where @var{n} must be +## Shift the dimensions of @var{x} by @var{n}, where @var{n} must be ## an integer scalar. When @var{n} is positive, the dimensions of ## @var{x} are shifted to the left, with the leading dimensions ## circulated to the end. If @var{n} is negative, then the dimensions @@ -57,14 +57,9 @@ orig_dims = size (x); if (nargin == 1) - ## Find the first singleton dimension. - n = 0; - while (n < nd && orig_dims(n+1) == 1) - n++; - endwhile - endif - - if (! isscalar (n) || floor (n) != n) + ## Find the first non-singleton dimension. + (n = find (orig_dims != 1, 1) - 1) || (n = nd); + elseif (! (isscalar (n) && n == fix (n))) error ("shiftdim: N must be a scalar integer"); endif @@ -78,7 +73,7 @@ elseif (n > 0) ## We need permute here instead of reshape to shift values in a ## compatible way. - y = permute (x, [n+1:ndims(x) 1:n]); + y = permute (x, [n+1:nd 1:n]); else y = x; endif @@ -86,3 +81,20 @@ ns = n; endfunction + + +%!test +%! x = rand (1, 1, 4, 2); +%! [y, ns] = shiftdim (x); +%! assert (size (y), [4 2]); +%! assert (ns, 2); +%! assert (shiftdim (y, -2), x); +%! assert (size (shiftdim (x, 2)), [4 2]); +%!assert (size (shiftdim (rand (0, 1, 2))), [0 1 2]); + +%% Test input validation +%!error(shiftdim ()); +%!error(shiftdim (1,2,3)); +%!error(shiftdim (1, ones (2))); +%!error(shiftdim (1, 1.5)); +
--- a/scripts/general/sortrows.m +++ b/scripts/general/sortrows.m @@ -18,12 +18,14 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} sortrows (@var{A}, @var{c}) +## @deftypefn {Function File} {[@var{s}, @var{i}] =} sortrows (@var{A}) +## @deftypefnx {Function File} {[@var{s}, @var{i}] =} sortrows (@var{A}, @var{c}) ## Sort the rows of the matrix @var{A} according to the order of the ## columns specified in @var{c}. If @var{c} is omitted, a ## lexicographical sort is used. By default ascending order is used ## however if elements of @var{c} are negative then the corresponding ## column is sorted in descending order. +## @seealso{sort} ## @end deftypefn ## Author: Daniel Calvelo, Paul Kienzle @@ -31,26 +33,38 @@ function [s, i] = sortrows (A, c) + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 2) + if (! (isnumeric (c) && isvector (c))) + error ("sortrows: C must be a numeric vector"); + elseif (any (c == 0) || any (abs (c) > columns (A))) + error ("sortrows: all elements of C must be in the range [1, columns (A)]"); + endif + endif + default_mode = "ascend"; - other_mode = "descend"; + reverse_mode = "descend"; if (issparse (A)) - ## FIXME -- eliminate this case once __sort_rows_idx__ is fixed to - ## handle sparse matrices. + ## FIXME: Eliminate this case once __sort_rows_idx__ is fixed to + ## handle sparse matrices. if (nargin == 1) - i = sort_rows_idx_generic (default_mode, other_mode, A); + i = sort_rows_idx_generic (default_mode, reverse_mode, A); else - i = sort_rows_idx_generic (default_mode, other_mode, A, c); + i = sort_rows_idx_generic (default_mode, reverse_mode, A, c); endif elseif (nargin == 1) i = __sort_rows_idx__ (A, default_mode); elseif (all (c > 0)) i = __sort_rows_idx__ (A(:,c), default_mode); elseif (all (c < 0)) - i = __sort_rows_idx__ (A(:,-c), other_mode); + i = __sort_rows_idx__ (A(:,-c), reverse_mode); else ## Otherwise, fall back to the old algorithm. - i = sort_rows_idx_generic (default_mode, other_mode, A, c); + i = sort_rows_idx_generic (default_mode, reverse_mode, A, c); endif ## Only bother to compute s if needed. @@ -60,20 +74,20 @@ endfunction -function i = sort_rows_idx_generic (default_mode, other_mode, m, c) +function i = sort_rows_idx_generic (default_mode, reverse_mode, m, c) if (nargin == 3) - indices = [1:size(m,2)]'; - mode(1:size(m,2)) = {default_mode}; + indices = [1:columns(m)]'; + mode(1:columns(m)) = {default_mode}; else - for ii = 1:length (c); - if (c(ii) < 0) - mode{ii} = other_mode; + for j = 1:length (c); + if (c(j) < 0) + mode{j} = reverse_mode; else - mode{ii} = default_mode; + mode{j} = default_mode; endif endfor - indices = abs(c(:)); + indices = abs (c(:)); endif ## Since sort is 'stable' the order of identical elements will be @@ -82,9 +96,9 @@ ## index j. indices = flipud (indices); mode = flipud (mode'); - i = [1:size(m,1)]'; - for ii = 1:length (indices); - [trash, idx] = sort (m(i, indices(ii)), mode{ii}); + i = [1:rows(m)]'; + for j = 1:length (indices); + [~, idx] = sort (m(i, indices(j)), mode{j}); i = i(idx); endfor @@ -101,3 +115,23 @@ %! assert (issparse (sx)); %! assert (x, full (sx)); %! assert (idx, sidx); + +%!test +%! m = [1, 0, 0, 4]; +%! c = 1; +%! [x, idx] = sortrows (m, c); +%! [sx, sidx] = sortrows (sparse (m), c); +%! assert (x, m); +%! assert (idx, 1); +%! assert (issparse (sx)); +%! assert (x, full (sx)); +%! assert (idx, sidx); + +%% Test input validation +%!error sortrows () +%!error sortrows (1, 2, 3) +%!error sortrows (1, "ascend") +%!error sortrows (1, ones (2,2)) +%!error sortrows (1, 0) +%!error sortrows (1, 2) +
--- a/scripts/general/structfun.m +++ b/scripts/general/structfun.m @@ -106,7 +106,7 @@ [varargout{:}] = cellfun (func, struct2cell (S), varargin{:}); if (! uniform_output) - varargout = cellfun (@cell2struct, varargout, {fieldnames(S)}, {1}, uo_str, false); + varargout = cellfun ("cell2struct", varargout, {fieldnames(S)}, {1}, uo_str, false); endif endfunction @@ -120,9 +120,10 @@ %! "UniformOutput", false); %! assert (o, l); -%!function [a, b] = twoouts (x) +%!function [a, b] = __twoouts (x) %! a = x + x; %! b = x * x; +%!endfunction %!test %! s = struct ("a", {1, 2, 3}, "b", {4, 5, 6}); @@ -132,7 +133,7 @@ %! d(1:2, 1, 1) = [1; 16]; %! d(1:2, 1, 2) = [4; 25]; %! d(1:2, 1, 3) = [9; 36]; -%! [aa, bb] = structfun(@twoouts, s); +%! [aa, bb] = structfun(@__twoouts, s); %! assert(aa, c); %! assert(bb, d); @@ -140,6 +141,6 @@ %! s = struct ("a", {1, 2, 3}, "b", {4, 5, 6}); %! c = struct ("a", {2, 4, 6}, "b", {8, 10, 12}); %! d = struct ("a", {1, 4, 9}, "b", {16, 25, 36}); -%! [aa, bb] = structfun(@twoouts, s, "UniformOutput", false); +%! [aa, bb] = structfun(@__twoouts, s, "UniformOutput", false); %! assert(aa, c); %! assert(bb, d);
--- a/scripts/general/trapz.m +++ b/scripts/general/trapz.m @@ -17,15 +17,38 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{z} =} trapz (@var{y}) -## @deftypefnx {Function File} {@var{z} =} trapz (@var{x}, @var{y}) -## @deftypefnx {Function File} {@var{z} =} trapz (@dots{}, @var{dim}) +## @deftypefn {Function File} {@var{q} =} trapz (@var{y}) +## @deftypefnx {Function File} {@var{q} =} trapz (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{q} =} trapz (@dots{}, @var{dim}) +## +## Numerically evaluate the integral of points @var{y} using the trapezoidal +## method. +## @w{@code{trapz (@var{y})}} computes the integral of @var{y} along the first +## non-singleton dimension. When the argument @var{x} is omitted an +## equally spaced @var{x} vector with unit spacing (1) is assumed. +## @code{trapz (@var{x}, @var{y})} evaluates the integral with respect +## to the spacing in @var{x} and the values in @var{y}. This is useful if +## the points in @var{y} have been sampled unevenly. +## If the optional @var{dim} argument is given, operate along this dimension. ## -## Numerical integration using trapezoidal method. @code{trapz -## (@var{y})} computes the integral of the @var{y} along the first -## non-singleton dimension. If the argument @var{x} is omitted a -## equally spaced vector is assumed. @code{trapz (@var{x}, @var{y})} -## evaluates the integral with respect to @var{x}. +## If @var{x} is not specified then unit spacing will be used. To scale +## the integral to the correct value you must multiply by the actual spacing +## value (deltaX). As an example, the integral of @math{x^3} over the range +## [0, 1] is @math{x^4/4} or 0.25. The following code uses @code{trapz} to +## calculate the integral in three different ways. +## +## @example +## @group +## x = 0:0.1:1; +## y = x.^3; +## q = trapz (y) +## @result{} q = 2.525 # No scaling +## q * 0.1 +## @result{} q = 0.2525 # Approximation to integral by scaling +## trapz (x, y) +## @result{} q = 0.2525 # Same result by specifying @var{x} +## @end group +## @end example ## ## @seealso{cumtrapz} ## @end deftypefn @@ -41,60 +64,75 @@ print_usage (); endif - nd = ndims (x); - sz = size (x); + have_xy = have_dim = false; - have_x = false; - have_dim = false; if (nargin == 3) - have_x = true; + have_xy = true; have_dim = true; - endif - if (nargin == 2) + elseif (nargin == 2) if (! size_equal (x, y) && isscalar (y)) dim = y; have_dim = true; else - have_x = true; + have_xy = true; endif endif + if (have_xy) + nd = ndims (y); + sz = size (y); + else + nd = ndims (x); + sz = size (x); + endif + if (! have_dim) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else - dim = floor (dim); - if (dim < 1 || dim > nd) - error ("trapz: invalid dimension DIM along which to sort"); + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("trapz: DIM must be an integer and a valid dimension"); endif endif n = sz(dim); - idx1 = cell (); - for i = 1:nd - idx1{i} = 1:sz(i); - endfor - idx2 = idx1; + idx1 = idx2 = repmat ({':'}, [nd, 1]); idx1{dim} = 2 : n; idx2{dim} = 1 : (n - 1); - if (! have_x) + if (! have_xy) z = 0.5 * sum (x(idx1{:}) + x(idx2{:}), dim); else - if (! size_equal (x, y)) - error ("trapz: X and Y must have same shape"); + if (isvector (x) && !isvector (y)) + if (length (x) != sz(dim)) + error ("trapz: length of X and length of Y along DIM must match"); + endif + ## Reshape vector to point along dimension DIM + shape = ones (nd, 1); + shape(dim) = sz(dim); + x = reshape (x, shape); + z = 0.5 * sum (bsxfun (@times, diff (x), y(idx1{:}) + y(idx2{:})), dim); + else + if (! size_equal (x, y)) + error ("trapz: X and Y must have same shape"); + endif + z = 0.5 * sum (diff (x, 1, dim) .* (y(idx1{:}) + y(idx2{:})), dim); endif - z = 0.5 * sum ((x(idx1{:}) - x(idx2{:})) .* - (y(idx1{:}) + y(idx2{:})), dim); endif endfunction + %!assert (trapz(1:5), 12) %!assert (trapz(0:0.5:2,1:5), 6) -%!assert (trapz([1:5;1:5],2),[12;12]) -%!assert (trapz([1:5;1:5].',1),[12,12]) -%!assert (trapz([0:0.5:2;0:0.5:2],[1:5;1:5],2),[6;6]) -%!assert (trapz([0:0.5:2;0:0.5:2].',[1:5;1:5].',1),[6,6]) +%!assert (trapz([1:5;1:5].',1), [12,12]) +%!assert (trapz([1:5;1:5],2), [12;12]) +%!assert (trapz(repmat(reshape(1:5,1,1,5),2,2), 3), [12 12; 12 12]) +%!assert (trapz([0:0.5:2;0:0.5:2].',[1:5;1:5].',1), [6, 6]) +%!assert (trapz([0:0.5:2;0:0.5:2],[1:5;1:5],2), [6; 6]) +%!assert (trapz(repmat(reshape([0:0.5:2],1,1,5),2,2), ... +%! repmat(reshape(1:5,1,1,5),2,2), 3), [6 6; 6 6]) +%!assert (trapz(0:0.5:2,[(1:5)',(1:5)']), [6, 6]) +%!assert (trapz(0:0.5:2,[(1:5);(1:5)],2), [6; 6]) +%!assert (trapz(0:0.5:2,repmat(reshape(1:5,1,1,5),2,2),3), [6 6; 6 6]) +
--- a/scripts/general/triplequad.m +++ b/scripts/general/triplequad.m @@ -17,31 +17,45 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} triplequad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{za}, @var{zb}, @var{tol}, @var{quadf}, @dots{}) -## Numerically evaluate a triple integral. The function over which to -## integrate is defined by @code{@var{f}}, and the interval for the -## integration is defined by @code{[@var{xa}, @var{xb}, @var{ya}, -## @var{yb}, @var{za}, @var{zb}]}. The function @var{f} must accept a -## vector @var{x} and a scalar @var{y}, and return a vector of the same -## length as @var{x}. +## @deftypefn {Function File} {} triplequad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{za}, @var{zb}) +## @deftypefnx {Function File} {} triplequad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{za}, @var{zb}, @var{tol}) +## @deftypefnx {Function File} {} triplequad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{za}, @var{zb}, @var{tol}, @var{quadf}) +## @deftypefnx {Function File} {} triplequad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{za}, @var{zb}, @var{tol}, @var{quadf}, @dots{}) +## Numerically evaluate the triple integral of @var{f}. +## @var{f} is a function handle, inline function, or string +## containing the name of the function to evaluate. The function @var{f} must +## have the form @math{w = f(x,y,z)} where either @var{x} or @var{y} is a +## vector and the remaining inputs are scalars. It should return a vector of +## the same length and orientation as @var{x} or @var{y}. ## -## If defined, @var{tol} defines the absolute tolerance to which to -## which to integrate each sub-integral. +## @var{xa}, @var{ya}, @var{za} and @var{xb}, @var{yb}, @var{zb} are the lower +## and upper limits of integration for x, y, and z respectively. The +## underlying integrator determines whether infinite bounds are accepted. +## +## The optional argument @var{tol} defines the absolute tolerance used to +## integrate each sub-integral. The default value is @math{1e^{-6}}. +## +## The optional argument @var{quadf} specifies which underlying integrator +## function to use. Any choice but @code{quad} is available and the default +## is @code{quadcc}. ## ## Additional arguments, are passed directly to @var{f}. To use the default -## value for @var{tol} one may pass an empty matrix. -## @seealso{dblquad,quad,quadv,quadl,quadgk,quadcc,trapz} +## value for @var{tol} or @var{quadf} one may pass ':' or an empty matrix ([]). +## @seealso{dblquad, quad, quadv, quadl, quadgk, quadcc, trapz} ## @end deftypefn -function Q = triplequad(f, xa, xb, ya, yb, za, zb, tol, quadf, varargin) +function q = triplequad (f, xa, xb, ya, yb, za, zb, tol = 1e-6, quadf = @quadcc, varargin) + if (nargin < 7) print_usage (); endif - if (nargin < 8 || isempty (tol)) + + ## Allow use of empty matrix ([]) to indicate default + if (isempty (tol)) tol = 1e-6; endif - if (nargin < 9 || isempty (quadf)) - quadf = @quadgk; + if (isempty (quadf)) + quadf = @quadcc; endif inner = @__triplequad_inner__; @@ -50,17 +64,22 @@ varargin = {}; endif - Q = dblquad(@(y, z) inner (y, z, f, xa, xb, tol, quadf, varargin{:}),ya, yb, za, zb, tol); + q = dblquad (@(y, z) inner (y, z, f, xa, xb, tol, quadf, varargin{:}), ya, yb, za, zb, tol); + endfunction -function Q = __triplequad_inner__ (y, z, f, xa, xb, tol, quadf, varargin) - Q = zeros (size(y)); +function q = __triplequad_inner__ (y, z, f, xa, xb, tol, quadf, varargin) + q = zeros (size(y)); for i = 1 : length (y) - Q(i) = feval (quadf, @(x) f (x, y(i), z, varargin{:}), xa, xb, tol); + q(i) = feval (quadf, @(x) f (x, y(i), z, varargin{:}), xa, xb, tol); endfor endfunction -%% These tests are too expensive to run normally. Disable them -% !#assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadgk), pi ^ (3/2) * erf(1).^3, 1e-6) -% !#assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadl), pi ^ (3/2) * erf(1).^3, 1e-6) -% !#assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadv), pi ^ (3/2) * erf(1).^3, 1e-6) + +%!assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadcc), pi ^ (3/2) * erf(1).^3, 1e-6) + +%% These tests are too expensive to run normally (~30 sec each). Disable them +#%!assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadgk), pi ^ (3/2) * erf(1).^3, 1e-6) +#%!#assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadl), pi ^ (3/2) * erf(1).^3, 1e-6) +#%!#assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadv), pi ^ (3/2) * erf(1).^3, 1e-6) +
--- a/scripts/geometry/convhull.m +++ b/scripts/geometry/convhull.m @@ -18,35 +18,44 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{H} =} convhull (@var{x}, @var{y}) -## @deftypefnx {Function File} {@var{H} =} convhull (@var{x}, @var{y}, @var{opt}) -## Returns the index vector to the points of the enclosing convex hull. The -## data points are defined by the x and y vectors. +## @deftypefnx {Function File} {@var{H} =} convhull (@var{x}, @var{y}, @var{options}) +## Compute the convex hull of the set of points defined by the +## vectors @var{x} and @var{y}. The hull @var{H} is an index vector into +## the set of points and specifies which points form the enclosing hull. ## -## A third optional argument, which must be a string, contains extra options -## passed to the underlying qhull command. See the documentation for the -## Qhull library for details. +## An optional third argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## The default option is @code{@{"Qt"@}}. ## -## @seealso{delaunay, convhulln} +## If @var{options} is not present or @code{[]} then the default arguments are +## used. Otherwise, @var{options} replaces the default argument list. +## To append user options to the defaults it is necessary to repeat the +## default arguments in @var{options}. Use a null string to pass no arguments. +## +## @seealso{convhulln, delaunay, voronoi} ## @end deftypefn ## Author: Kai Habel <kai.habel@gmx.de> -function H = convhull (x, y, opt) +function H = convhull (x, y, options) if (nargin != 2 && nargin != 3) print_usage (); endif - if (isvector (x) && isvector (y) && length (x) == length (y)) - if (nargin == 2) - i = convhulln ([x(:), y(:)]); - elseif (ischar (opt) || iscell (opt)) - i = convhulln ([x(:), y(:)], opt); - else - error ("convhull: third argument must be a string or cell array of strings"); - endif + if (! (isvector (x) && isvector (y) && length (x) == length (y)) + && ! size_equal (x, y)) + error ("convhull: X and Y must be the same size"); + elseif (nargin == 3 && ! (ischar (options) || iscellstr (options))) + error ("convhull: OPTIONS must be a string or cell array of strings"); + endif + + if (nargin == 2) + i = convhulln ([x(:), y(:)]); else - error ("convhull: first two input arguments must be vectors of same size"); + i = convhulln ([x(:), y(:)], options); endif n = rows (i); @@ -71,16 +80,21 @@ endfor H(n + 1) = H(1); + endfunction -%!testif HAVE_QHULL -%! x = -3:0.5:3; -%! y = abs (sin (x)); -%! assert (convhull (x, y, {"s","Qci","Tcv","Pp"}), [1;7;13;12;11;10;4;3;2;1]) %!demo %! x = -3:0.05:3; %! y = abs (sin (x)); %! k = convhull (x, y); -%! plot (x(k),y(k),'r-',x,y,'b+'); +%! plot (x(k),y(k),"r-;convex hull;", x,y,"b+;points;"); %! axis ([-3.05, 3.05, -0.05, 1.05]); + +%!testif HAVE_QHULL +%! x = -3:0.5:3; +%! y = abs (sin (x)); +%! assert (convhull (x, y), [1;7;13;12;11;10;4;3;2;1]) + +%% FIXME: Need input validation tests +
--- a/scripts/geometry/delaunay.m +++ b/scripts/geometry/delaunay.m @@ -17,74 +17,103 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{tri} =} delaunay (@var{x}, @var{y}) -## @deftypefnx {Function File} {@var{tri} =} delaunay (@var{x}, @var{y}, @var{opt}) -## The return matrix of size [n, 3] contains a set triangles which are -## described by the indices to the data point x and y vector. -## The triangulation satisfies the Delaunay circum-circle criterion. -## No other data point is in the circum-circle of the defining triangle. +## @deftypefn {Function File} {} delaunay (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{tri} =} delaunay (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{tri} =} delaunay (@var{x}, @var{y}, @var{options}) +## Compute the Delaunay triangulation for a 2-D set of points. +## The return value @var{tri} is a set of triangles which satisfies the +## Delaunay circum-circle criterion, i.e., only a single data point from +## [@var{x}, @var{y}] is within the circum-circle of the defining triangle. +## +## The set of triangles @var{tri} is a matrix of size [n, 3]. Each +## row defines a triangle and the three columns are the three vertices +## of the triangle. The value of @code{@var{tri}(i,j)} is an index into +## @var{x} and @var{y} for the location of the j-th vertex of the i-th +## triangle. ## -## A third optional argument, which must be a string, contains extra options -## passed to the underlying qhull command. See the documentation for the -## Qhull library for details. +## An optional third argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## The default options are @code{@{"Qt", "Qbb", "Qc", "Qz"@}}. +## +## If @var{options} is not present or @code{[]} then the default arguments are +## used. Otherwise, @var{options} replaces the default argument list. +## To append user options to the defaults it is necessary to repeat the +## default arguments in @var{options}. Use a null string to pass no arguments. +## +## If no output argument is specified the resulting Delaunay triangulation +## is plotted along with the original set of points. ## ## @example ## @group ## x = rand (1, 10); -## y = rand (size (x)); +## y = rand (1, 10); ## T = delaunay (x, y); -## X = [x(T(:,1)); x(T(:,2)); x(T(:,3)); x(T(:,1))]; -## Y = [y(T(:,1)); y(T(:,2)); y(T(:,3)); y(T(:,1))]; +## VX = [ x(T(:,1)); x(T(:,2)); x(T(:,3)); x(T(:,1)) ]; +## VY = [ y(T(:,1)); y(T(:,2)); y(T(:,3)); y(T(:,1)) ]; ## axis ([0,1,0,1]); -## plot (X, Y, "b", x, y, "r*"); +## plot (VX, VY, "b", x, y, "r*"); ## @end group ## @end example -## @seealso{voronoi, delaunay3, delaunayn} +## @seealso{delaunay3, delaunayn, convhull, voronoi} ## @end deftypefn ## Author: Kai Habel <kai.habel@gmx.de> -function ret = delaunay (x, y, opt) +function tri = delaunay (x, y, options) if (nargin != 2 && nargin != 3) print_usage (); endif - if ((isvector (x) && isvector (y) && length (x) == length (y)) - || size_equal (x, y)) - if (nargin == 2) - tri = delaunayn ([x(:), y(:)]); - elseif (ischar (opt) || iscellstr (opt)) - tri = delaunayn ([x(:), y(:)], opt); - else - error ("delaunay: third argument must be a string"); - endif + if (! (isvector (x) && isvector (y) && length (x) == length (y)) + && ! size_equal (x, y)) + error ("delaunay: X and Y must be the same size"); + elseif (nargin == 3 && ! (ischar (options) || iscellstr (options))) + error ("delaunay: OPTIONS must be a string or cell array of strings"); + endif + + if (nargin == 2) + T = delaunayn ([x(:), y(:)]); else - error ("delaunay: first two input arguments must be matrices of same size"); + T = delaunayn ([x(:), y(:)], options); endif if (nargout == 0) x = x(:).'; y = y(:).'; - X = [x(tri(:,1)); x(tri(:,2)); x(tri(:,3)); x(tri(:,1))]; - Y = [y(tri(:,1)); y(tri(:,2)); y(tri(:,3)); y(tri(:,1))]; - plot(X, Y, 'b', x, y, 'r*'); + VX = [ x(T(:,1)); x(T(:,2)); x(T(:,3)); x(T(:,1)) ]; + VY = [ y(T(:,1)); y(T(:,2)); y(T(:,3)); y(T(:,1)) ]; + plot (VX, VY, "b", x, y, "r*"); else - ret = tri; + tri = T; endif + endfunction + +%!demo +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 1); +%! x = rand (1,10); +%! y = rand (1,10); +%! T = delaunay (x,y); +%! VX = [ x(T(:,1)); x(T(:,2)); x(T(:,3)); x(T(:,1)) ]; +%! VY = [ y(T(:,1)); y(T(:,2)); y(T(:,3)); y(T(:,1)) ]; +%! axis ([0,1,0,1]); +%! plot (VX,VY,"b", x,y,"r*"); + +%!testif HAVE_QHULL +%! x = [-1, 0, 1, 0]; +%! y = [0, 1, 0, -1]; +%! assert (sortrows (sort (delaunay (x, y), 2)), [1,2,4;2,3,4]); + %!testif HAVE_QHULL %! x = [-1, 0, 1, 0, 0]; %! y = [0, 1, 0, -1, 0]; -%! assert (sortrows (sort (delaunay (x, y), 2)), [1,2,5;1,4,5;2,3,5;3,4,5]) +%! assert (sortrows (sort (delaunay (x, y), 2)), [1,2,5;1,4,5;2,3,5;3,4,5]); -%!demo -%! rand ('state', 1); -%! x = rand(1,10); -%! y = rand(size(x)); -%! T = delaunay(x,y); -%! X = [ x(T(:,1)); x(T(:,2)); x(T(:,3)); x(T(:,1)) ]; -%! Y = [ y(T(:,1)); y(T(:,2)); y(T(:,3)); y(T(:,1)) ]; -%! axis([0,1,0,1]); -%! plot(X,Y,'b',x,y,'r*'); +%% FIXME: Need input validation tests +
--- a/scripts/geometry/delaunay3.m +++ b/scripts/geometry/delaunay3.m @@ -17,42 +17,61 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{T} =} delaunay3 (@var{x}, @var{y}, @var{z}) -## @deftypefnx {Function File} {@var{T} =} delaunay3 (@var{x}, @var{y}, @var{z}, @var{opt}) -## A matrix of size [n, 4] is returned. Each row contains a -## set of tetrahedron which are -## described by the indices to the data point vectors (x,y,z). +## @deftypefn {Function File} {@var{tetr} =} delaunay3 (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {@var{tetr} =} delaunay3 (@var{x}, @var{y}, @var{z}, @var{options}) +## Compute the Delaunay triangulation for a 3-D set of points. +## The return value @var{tetr} is a set of tetrahedrons which satisfies the +## Delaunay circum-circle criterion, i.e., only a single data point from +## [@var{x}, @var{y}, @var{z}] is within the circum-circle of the defining +## tetrahedron. ## -## A fourth optional argument, which must be a string or cell array of strings, -## contains extra options passed to the underlying qhull command. See the -## documentation for the Qhull library for details. -## @seealso{delaunay,delaunayn} +## The set of tetrahedrons @var{tetr} is a matrix of size [n, 4]. Each +## row defines a tetrahedron and the four columns are the four vertices +## of the tetrahedron. The value of @code{@var{tetr}(i,j)} is an index into +## @var{x}, @var{y}, @var{z} for the location of the j-th vertex of the i-th +## tetrahedron. +## +## An optional fourth argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## The default options are @code{@{"Qt", "Qbb", "Qc", "Qz"@}}. +## +## If @var{options} is not present or @code{[]} then the default arguments are +## used. Otherwise, @var{options} replaces the default argument list. +## To append user options to the defaults it is necessary to repeat the +## default arguments in @var{options}. Use a null string to pass no arguments. +## +## @seealso{delaunay, delaunayn, convhull, voronoi} ## @end deftypefn ## Author: Kai Habel <kai.habel@gmx.de> -function tetr = delaunay3 (x, y, z, opt) +function tetr = delaunay3 (x, y, z, options) - if (nargin != 3 && nargin != 4) + if (nargin < 3 || nargin > 4) print_usage (); endif - if (isvector (x) && isvector (y) &&isvector (z) - && length (x) == length (y) && length(x) == length (z)) - if (nargin == 3) - tetr = delaunayn ([x(:), y(:), z(:)]); - elseif (ischar (opt) || iscell (opt)) - tetr = delaunayn ([x(:), y(:), z(:)], opt); - else - error ("delaunay3: fourth argument must be a string or cell array of strings"); - endif + if (! (isvector (x) && isvector (y) && isvector (z) + && length (x) == length (y) && length(x) == length (z))) + error ("delaunay: X, Y, and Z must be the same size"); + elseif (nargin == 4 && ! (ischar (options) || iscellstr (options))) + error ("delaunay3: OPTIONS must be a string or cell array of strings"); + endif + + if (nargin == 3) + tetr = delaunayn ([x(:), y(:), z(:)]); else - error ("delaunay3: first three input arguments must be vectors of same size"); + tetr = delaunayn ([x(:), y(:), z(:)], options); endif endfunction + %!testif HAVE_QHULL %! x = [-1, -1, 1, 0, -1]; y = [-1, 1, 1, 0, -1]; z = [0, 0, 0, 1, 1]; %! assert (sortrows (sort (delaunay3 (x, y, z), 2)), [1,2,3,4;1,2,4,5]) +%% FIXME: Need input validation tests +
--- a/scripts/geometry/delaunayn.m +++ b/scripts/geometry/delaunayn.m @@ -17,66 +17,77 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{t} =} delaunayn (@var{p}) -## @deftypefnx {Function File} {@var{t} =} delaunayn (@var{p}, @var{opt}) -## Form the Delaunay triangulation for a set of points. -## The Delaunay triangulation is a tessellation of the convex hull of the -## points such that no n-sphere defined by the n-triangles contains +## @deftypefn {Function File} {@var{T} =} delaunayn (@var{pts}) +## @deftypefnx {Function File} {@var{T} =} delaunayn (@var{pts}, @var{options}) +## Compute the Delaunay triangulation for an N-dimensional set of points. +## The Delaunay triangulation is a tessellation of the convex hull of a set +## of points such that no N-sphere defined by the N-triangles contains ## any other points from the set. -## The input matrix @var{p} of size @code{[n, dim]} contains @math{n} -## points in a space of dimension dim. The return matrix @var{t} has the -## size @code{[m, dim+1]}. It contains for each row a set of indices to -## the points, which describes a simplex of dimension dim. For example, -## a 2-D simplex is a triangle and 3-D simplex is a tetrahedron. +## +## The input matrix @var{pts} of size [n, dim] contains n points in a space of +## dimension dim. The return matrix @var{T} has size [m, dim+1]. Each row +## of @var{T} contains a set of indices back into the original set of points +## @var{pts} which describes a simplex of dimension dim. For example, a 2-D +## simplex is a triangle and 3-D simplex is a tetrahedron. ## -## Extra options for the underlying Qhull command can be specified by the -## second argument. This argument is a cell array of strings. The default -## options depend on the dimension of the input: +## An optional second argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## The default options depend on the dimension of the input: ## ## @itemize -## @item 2D and 3D: @var{opt} = @code{@{"Qt", "Qbb", "Qc"@}} +## @item 2-D and 3-D: @var{options} = @code{@{"Qt", "Qbb", "Qc", "Qz"@}} ## -## @item 4D and higher: @var{opt} = @code{@{"Qt", "Qbb", "Qc", "Qz"@}} +## @item 4-D and higher: @var{options} = @code{@{"Qt", "Qbb", "Qc", "Qx"@}} ## @end itemize ## -## If @var{opt} is [], then the default arguments are used. If @var{opt} -## is @code{@{"@w{}"@}}, then none of the default arguments are used by Qhull. -## See the Qhull documentation for the available options. +## If @var{options} is not present or @code{[]} then the default arguments are +## used. Otherwise, @var{options} replaces the default argument list. +## To append user options to the defaults it is necessary to repeat the +## default arguments in @var{options}. Use a null string to pass no arguments. ## -## All options can also be specified as single string, for example -## @code{"Qt Qbb Qc Qz"}. -## +## @seealso{delaunay, delaunay3, convhulln, voronoin} ## @end deftypefn -function t = delaunayn (p, varargin) +function T = delaunayn (pts, varargin) + if (nargin < 1) print_usage (); endif - t = __delaunayn__ (p, varargin{:}); + T = __delaunayn__ (pts, varargin{:}); - if (isa (p, "single")) + if (isa (pts, "single")) myeps = eps ("single"); else myeps = eps; endif - ## Try to remove the zero volume simplices. The volume of the i-th simplex is - ## given by abs(det(p(t(i,1:end-1),:)-p(t(i,2:end),:)))/prod(1:n) - ## (reference http://en.wikipedia.org/wiki/Simplex). Any simplex with a - ## relative volume less than some arbitrary criteria is rejected. The + ## Try to remove the zero volume simplices. The volume of the i-th simplex is + ## given by abs(det(pts(T(i,1:end-1),:)-pts(T(i,2:end),:)))/prod(1:n) + ## (reference http://en.wikipedia.org/wiki/Simplex). Any simplex with a + ## relative volume less than some arbitrary criteria is rejected. The ## criteria we use is the volume of the simplex corresponding to an ## orthogonal simplex is equal edge length all equal to the edge length of - ## the original simplex. If the relative volume is 1e3*eps then the simplex - ## is rejected. Note division of the two volumes means that the factor + ## the original simplex. If the relative volume is 1e3*eps then the simplex + ## is rejected. Note division of the two volumes means that the factor ## prod(1:n) is dropped. idx = []; - [nt, n] = size (t); + [nt, n] = size (T); + ## FIXME: Vectorize this for loop or convert to delaunayn to .oct function for i = 1:nt - X = p(t(i,1:end-1),:) - p(t(i,2:end),:); - if (abs (det (X)) / sqrt (sum (X .^ 2, 2)) < 1e3 * myeps) - idx = [idx, i]; + X = pts(T(i,1:end-1),:) - pts(T(i,2:end),:); + if (abs (det (X)) / sqrt (sum (X .^ 2, 2)) < 1e3 * myeps) + idx(end+1) = i; endif endfor - t(idx,:) = []; + T(idx,:) = []; + endfunction + + +%% FIXME: Need tests for delaunayn + +%% FIXME: Need input validation tests +
--- a/scripts/geometry/dsearch.m +++ b/scripts/geometry/dsearch.m @@ -19,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{idx} =} dsearch (@var{x}, @var{y}, @var{tri}, @var{xi}, @var{yi}) ## @deftypefnx {Function File} {@var{idx} =} dsearch (@var{x}, @var{y}, @var{tri}, @var{xi}, @var{yi}, @var{s}) -## Returns the index @var{idx} or the closest point in @code{@var{x}, @var{y}} +## Return the index @var{idx} or the closest point in @code{@var{x}, @var{y}} ## to the elements @code{[@var{xi}(:), @var{yi}(:)]}. The variable @var{s} is ## accepted for compatibility but is ignored. ## @seealso{dsearchn, tsearch}
--- a/scripts/geometry/dsearchn.m +++ b/scripts/geometry/dsearchn.m @@ -21,7 +21,7 @@ ## @deftypefnx {Function File} {@var{idx} =} dsearchn (@var{x}, @var{tri}, @var{xi}, @var{outval}) ## @deftypefnx {Function File} {@var{idx} =} dsearchn (@var{x}, @var{xi}) ## @deftypefnx {Function File} {[@var{idx}, @var{d}] =} dsearchn (@dots{}) -## Returns the index @var{idx} or the closest point in @var{x} to the elements +## Return the index @var{idx} or the closest point in @var{x} to the elements ## @var{xi}. If @var{outval} is supplied, then the values of @var{xi} that are ## not contained within one of the simplices @var{tri} are set to ## @var{outval}. Generally, @var{tri} is returned from @code{delaunayn
--- a/scripts/geometry/griddata3.m +++ b/scripts/geometry/griddata3.m @@ -53,28 +53,32 @@ vi = griddatan ([x(:), y(:), z(:)], v(:), [xi(:), yi(:), zi(:)], varargin{:}); vi = reshape (vi, size (xi)); + endfunction + %!testif HAVE_QHULL -%! rand('state', 0); -%! x = 2 * rand(1000, 1) - 1; -%! y = 2 * rand(1000, 1) - 1; -%! z = 2 * rand(1000, 1) - 1; +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 0); +%! x = 2 * rand (1000, 1) - 1; +%! y = 2 * rand (1000, 1) - 1; +%! z = 2 * rand (1000, 1) - 1; %! v = x.^2 + y.^2 + z.^2; %! [xi, yi, zi] = meshgrid (-0.8:0.2:0.8); -%! ##vi = reshape (griddatan([x(:), y(:), z(:)], v, [xi(:), yi(:), zi(:)], 'linear'), size (xi)); %! vi = griddata3 (x, y, z, v, xi, yi, zi, 'linear'); %! vv = vi - xi.^2 - yi.^2 - zi.^2; -%! assert (max(abs(vv(:))), 0, 0.1) +%! assert (max (abs (vv(:))), 0, 0.1); %!testif HAVE_QHULL -%! rand('state', 0); -%! x = 2 * rand(1000, 1) - 1; -%! y = 2 * rand(1000, 1) - 1; -%! z = 2 * rand(1000, 1) - 1; +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 0); +%! x = 2 * rand (1000, 1) - 1; +%! y = 2 * rand (1000, 1) - 1; +%! z = 2 * rand (1000, 1) - 1; %! v = x.^2 + y.^2 + z.^2; %! [xi, yi, zi] = meshgrid (-0.8:0.2:0.8); -%! ##vi = reshape (griddatan([x(:), y(:), z(:)], v, [xi(:), yi(:), zi(:)], 'linear'), size (xi)); %! vi = griddata3 (x, y, z, v, xi, yi, zi, 'nearest'); %! vv = vi - xi.^2 - yi.^2 - zi.^2; -%! assert (max(abs(vv(:))), 0, 0.1) +%! assert (max (abs (vv(:))), 0, 0.1)
--- a/scripts/geometry/inpolygon.m +++ b/scripts/geometry/inpolygon.m @@ -130,3 +130,14 @@ %! disp("Green points are inside polygon, magenta are outside,"); %! disp("and blue are on boundary."); +%!error inpolygon (); +%!error inpolygon (1, 2); +%!error inpolygon (1, 2, 3); + +%!error inpolygon (1, [1,2], [3, 4], [5, 6]); +%!error inpolygon ([1,2], [3, 4], [5, 6], 1); + +%!test +%! [in, on] = inpolygon ([1, 0], [1, 0], [-1, -1, 1, 1], [-1, 1, 1, -1]); +%! assert (in, [false, true]); +%! assert (on, [true, false]);
--- a/scripts/geometry/module.mk +++ b/scripts/geometry/module.mk @@ -12,9 +12,6 @@ geometry/griddatan.m \ geometry/inpolygon.m \ geometry/rectint.m \ - geometry/trimesh.m \ - geometry/triplot.m \ - geometry/trisurf.m \ geometry/tsearchn.m \ geometry/voronoi.m \ geometry/voronoin.m
--- a/scripts/geometry/tsearchn.m +++ b/scripts/geometry/tsearchn.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {[@var{idx}, @var{p}] =} tsearchn (@var{x}, @var{t}, @var{xi}) -## Searches for the enclosing Delaunay convex hull. For @code{@var{t} = +## Search for the enclosing Delaunay convex hull. For @code{@var{t} = ## delaunayn (@var{x})}, finds the index in @var{t} containing the ## points @var{xi}. For points outside the convex hull, @var{idx} is NaN. ## If requested @code{tsearchn} also returns the Barycentric coordinates @var{p}
--- a/scripts/geometry/voronoi.m +++ b/scripts/geometry/voronoi.m @@ -18,18 +18,27 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} voronoi (@var{x}, @var{y}) -## @deftypefnx {Function File} {} voronoi (@var{x}, @var{y}, "plotstyle") -## @deftypefnx {Function File} {} voronoi (@var{x}, @var{y}, "plotstyle", @var{options}) +## @deftypefnx {Function File} {} voronoi (@var{x}, @var{y}, @var{options}) +## @deftypefnx {Function File} {} voronoi (@dots{}, "linespec") +## @deftypefnx {Function File} {} voronoi (@var{hax}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} voronoi (@dots{}) ## @deftypefnx {Function File} {[@var{vx}, @var{vy}] =} voronoi (@dots{}) -## plots Voronoi diagram of points @code{(@var{x}, @var{y})}. +## Plot the Voronoi diagram of points @code{(@var{x}, @var{y})}. ## The Voronoi facets with points at infinity are not drawn. -## [@var{vx}, @var{vy}] = voronoi(@dots{}) returns the vertices instead of -## plotting the -## diagram. plot (@var{vx}, @var{vy}) shows the Voronoi diagram. +## +## If "linespec" is given it is used to set the color and line style of the +## plot. If an axis graphics handle @var{hax} is supplied then the Voronoi +## diagram is drawn on the specified axis rather than in a new figure. ## -## A fourth optional argument, which must be a string, contains extra options -## passed to the underlying qhull command. See the documentation for the -## Qhull library for details. +## The @var{options} argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## +## If a single output argument is requested then the Voronoi diagram will be +## plotted and a graphics handle @var{h} to the plot is returned. +## [@var{vx}, @var{vy}] = voronoi(@dots{}) returns the Voronoi vertices +## instead of plotting the diagram. ## ## @example ## @group @@ -57,7 +66,7 @@ ## Added optional fourth argument to pass options to the underlying ## qhull command -function [vvx, vvy] = voronoi (varargin) +function [vx, vy] = voronoi (varargin) if (nargin < 1) print_usage (); @@ -66,14 +75,12 @@ narg = 1; if (isscalar (varargin{1}) && ishandle (varargin{1})) handl = varargin{1}; - narg++; if (! strcmp (get (handl, "type"), "axes")) error ("voronoi: expecting first argument to be an axes object"); endif - else - if (nargout < 2) - handl = gca (); - endif + narg++; + elseif (nargout < 2) + handl = gca (); endif if (nargin < 1 + narg || nargin > 3 + narg) @@ -87,24 +94,22 @@ if (narg <= nargin) if (iscell (varargin{narg})) opts = varargin(narg++); - elseif (ismatrix (varargin{narg})) - ## Accept but ignore the triangulation + elseif (isnumeric (varargin{narg})) + ## Accept, but ignore, the triangulation narg++; endif endif linespec = {"b"}; - if (narg <= nargin) - if (ischar (varargin{narg})) - linespec = varargin(narg); - endif + if (narg <= nargin && ischar (varargin{narg})) + linespec = varargin(narg); endif lx = length (x); ly = length (y); if (lx != ly) - error ("voronoi: arguments must be vectors of same length"); + error ("voronoi: X and Y must be vectors of the same length"); endif ## Add box to approximate rays to infinity. For Voronoi diagrams the @@ -124,14 +129,16 @@ ybox = [xmin - scale * xdelta; xmax + scale * xdelta; ... xmax + scale * xdelta; xmin - scale * xdelta]; - [p, c, infi] = __voronoi__ ([[x(:) ; xbox(:)], [y(:); ybox(:)]], opts{:}); + [p, c, infi] = __voronoi__ ("voronoi", + [[x(:) ; xbox(:)], [y(:); ybox(:)]], + opts{:}); - idx = find (!infi); + idx = find (! infi); ll = length (idx); c = c(idx).'; - k = sum (cellfun ('length', c)); - edges = cell2mat(cellfun (@(x) [x ; [x(end), x(1:end-1)]], c, - "uniformoutput", false)); + k = sum (cellfun ("length", c)); + edges = cell2mat (cellfun (@(x) [x ; [x(end), x(1:end-1)]], c, + "uniformoutput", false)); ## Identify the unique edges of the Voronoi diagram edges = sortrows (sort (edges).').'; @@ -147,22 +154,34 @@ edges (:, edgeoutside) = []; ## Get points of the diagram - vx = reshape (p (edges, 1), size(edges)); - vy = reshape (p (edges, 2), size(edges)); + Vvx = reshape (p(edges, 1), size (edges)); + Vvy = reshape (p(edges, 2), size (edges)); if (nargout < 2) lim = [xmin, xmax, ymin, ymax]; - h = plot (handl, vx, vy, linespec{:}, x, y, '+'); + h = plot (handl, Vvx, Vvy, linespec{:}, x, y, '+'); axis (lim + 0.1 * [[-1, 1] * (lim (2) - lim (1)), ... [-1, 1] * (lim (4) - lim (3))]); if (nargout == 1) - vxx = h; + vx = h; endif - elseif (nargout == 2) - vvx = vx; - vvy = vy; else - error ("voronoi: only two or zero output arguments supported"); + vx = Vvx; + vy = Vvy; endif endfunction + + +%!demo +%! voronoi (rand(10,1), rand(10,1)); + +%!testif HAVE_QHULL +%! phi = linspace (-pi, 3/4*pi, 8); +%! [x,y] = pol2cart (phi, 1); +%! [vx,vy] = voronoi (x,y); +%! assert(vx(2,:), zeros (1, columns (vx)), eps); +%! assert(vy(2,:), zeros (1, columns (vy)), eps); + +%% FIXME: Need input validation tests +
--- a/scripts/geometry/voronoin.m +++ b/scripts/geometry/voronoin.m @@ -20,14 +20,15 @@ ## @deftypefn {Function File} {[@var{C}, @var{F}] =} voronoin (@var{pts}) ## @deftypefnx {Function File} {[@var{C}, @var{F}] =} voronoin (@var{pts}, @var{options}) ## Compute N-dimensional Voronoi facets. The input matrix @var{pts} -## of size [n, dim] contains n points of dimension dim. +## of size [n, dim] contains n points in a space of dimension dim. ## @var{C} contains the points of the Voronoi facets. The list @var{F} -## contains for each facet the indices of the Voronoi points. +## contains, for each facet, the indices of the Voronoi points. ## -## A second optional argument, which must be a string, contains extra options -## passed to the underlying qhull command. See the documentation for the -## Qhull library for details. -## @seealso{voronoin, delaunay, convhull} +## An optional second argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## @seealso{voronoi, convhulln, delaunayn} ## @end deftypefn ## Author: Kai Habel <kai.habel@gmx.de> @@ -43,17 +44,24 @@ print_usage (); endif - [np, dims] = size (pts); - if (np > dims) - if (nargin == 1) - [C, F, infi] = __voronoi__ (pts); - elseif (ischar (options)) - [C, F, infi] = __voronoi__ (pts, options); - else - error ("voronoin: second argument must be a string"); - endif + [np, dim] = size (pts); - else + if (np <= dim) error ("voronoin: number of points must be greater than their dimension"); endif + + caller = "voronoin"; + + if (nargin == 1) + [C, F] = __voronoi__ (caller, pts); + else + [C, F] = __voronoi__ (caller, pts, options); + endif + endfunction + + +%% FIXME: Need functional tests + +%% FIXME: Need input validation tests +
--- a/scripts/gethelp.cc +++ b/scripts/gethelp.cc @@ -31,7 +31,7 @@ // Perhaps someday we will want to do more here, so leave this as a // separate function. - return (s.substr (0, 9) == "Copyright"); + return (s.substr (0, 9) == "Copyright" || s.substr (0, 6) == "Author"); } // Eat whitespace and comments from FFILE, returning the text of the
--- a/scripts/help/__makeinfo__.m +++ b/scripts/help/__makeinfo__.m @@ -57,87 +57,52 @@ ## The optional output argument @var{status} contains the exit status of the ## @code{makeinfo} program as returned by @code{system}. -function [retval, status] = __makeinfo__ (text, output_type = "plain text", see_also = []) +function [retval, status] = __makeinfo__ (text, output_type = "plain text", fsee_also) ## Check input - if (nargin == 0) + if (nargin < 1 || nargin > 3) print_usage (); endif - if (!ischar (text)) + if (! ischar (text)) error ("__makeinfo__: first input argument must be a string"); endif - if (!ischar (output_type)) + if (! ischar (output_type)) error ("__makeinfo__: second input argument must be a string"); endif - ## Define the function which expands @seealso macro - if (isempty (see_also)) + if (nargin < 3) if (strcmpi (output_type, "plain text")) - see_also = @simple_see_also; + fsee_also = @(T) strcat ... + ("\nSee also:", sprintf (" %s,", T{:})(1:end-1), "\n"); else - see_also = @simple_see_also_with_refs; + fsee_also = @(T) strcat ... + ("\nSee also:", sprintf (" @ref{%s},", T{:})(1:end-1), "\n"); endif endif - if (!isa (see_also, "function_handle")) - error ("__makeinfo__: third input argument must be the empty matrix, or a function handle"); + if (! isa (fsee_also, "function_handle")) + error ("__makeinfo__: third input argument must be a function handle"); endif + ## It seems like makeinfo sometimes gets angry if the first character ## on a line is a space, so we remove these. text = strrep (text, "\n ", "\n"); ## Handle @seealso macro - SEE_ALSO = "@seealso"; - starts = strfind (text, SEE_ALSO); - for start = fliplr (starts) - if (start == 1 || (text (start-1) != "@")) - bracket_start = find (text (start:end) == "{", 1); - stop = find (text (start:end) == "}", 1); - if (!isempty (stop) && !isempty (bracket_start)) - stop += start - 1; - bracket_start += start - 1; - else - bracket_start = start + length (SEE_ALSO); - stop = find (text (start:end) == "\n", 1); - if (isempty (stop)) - stop = length (text); - else - stop += start - 1; - endif - endif - see_also_args = text (bracket_start+1:(stop-1)); - see_also_args = strtrim (strsplit (see_also_args, ",")); - expanded = see_also (see_also_args); - text = strcat (text (1:start-1), expanded, text (stop+1:end)); - endif + see_also_pat = '@seealso *\{(.*)\}'; + args = regexp (text, see_also_pat, 'tokens'); + for ii = 1:numel (args) + expanded = fsee_also (strtrim (strsplit (args{ii}{:}, ',', true))); + text = regexprep (text, see_also_pat, expanded, 'once'); endfor ## Handle @nospell macro - NOSPELL = "@nospell"; - starts = strfind (text, NOSPELL); - for start = fliplr (starts) - if (start == 1 || (text (start-1) != "@")) - bracket_start = find (text (start:end) == "{", 1); - stop = find (text (start:end) == "}", 1); - if (!isempty (stop) && !isempty (bracket_start)) - stop += start - 1; - bracket_start += start - 1; - else - bracket_start = start + length (NOSPELL); - stop = find (text (start:end) == "\n", 1); - if (isempty (stop)) - stop = length (text); - else - stop += start - 1; - endif - endif - text(stop) = []; - text(start:bracket_start) = []; - endif - endfor + text = regexprep (text, '@nospell *\{([^}]*)\}', "$1"); + ## Handle @xcode macro + text = regexprep (text, '@xcode *\{([^}]*)\}', "$1"); if (strcmpi (output_type, "texinfo")) status = 0; @@ -151,7 +116,7 @@ unwind_protect ## Write Texinfo to tmp file template = "octave-help-XXXXXX"; - [fid, name, msg] = mkstemp (fullfile (P_tmpdir, template), true); + [fid, name] = mkstemp (fullfile (P_tmpdir, template), true); if (fid < 0) error ("__makeinfo__: could not create temporary file"); endif @@ -161,11 +126,11 @@ ## Take action depending on output type switch (lower (output_type)) case "plain text" - cmd = sprintf ("%s --no-headers --no-warn --force --no-validate %s", - makeinfo_program (), name); + cmd = sprintf ("%s --no-headers --no-warn --force --no-validate %s", + makeinfo_program (), name); case "html" - cmd = sprintf ("%s --no-headers --html --no-warn --no-validate --force %s", - makeinfo_program (), name); + cmd = sprintf ("%s --no-headers --html --no-warn --no-validate --force %s", + makeinfo_program (), name); otherwise error ("__makeinfo__: unsupported output type: '%s'", output_type); endswitch @@ -180,12 +145,6 @@ end_unwind_protect endfunction -function expanded = simple_see_also (args) - expanded = strcat ("\nSee also:", sprintf (" %s,", args {:})); - expanded = strcat (expanded (1:end-1), "\n\n"); -endfunction +## No test needed for internal helper function. +%!assert (1) -function expanded = simple_see_also_with_refs (args) - expanded = strcat ("\nSee also:", sprintf (" @ref{%s},", args {:})); - expanded = strcat (expanded (1:end-1), "\n\n"); -endfunction
--- a/scripts/help/gen_doc_cache.m +++ b/scripts/help/gen_doc_cache.m @@ -32,6 +32,7 @@ ## @end deftypefn function gen_doc_cache (out_file = "doc-cache", directory = []) + ## Check input if (!ischar (out_file)) print_usage (); @@ -143,3 +144,8 @@ cache = create_cache (list); endfunction + +%% No true tests desirable for this function. +%% Test input validation +%!error gen_doc_cache (1) +
--- a/scripts/help/get_first_help_sentence.m +++ b/scripts/help/get_first_help_sentence.m @@ -17,15 +17,14 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{retval}, @var{status}] =} get_first_help_sentence (@var{name}, @var{max_len}) -## Return the first sentence of a function help text. +## @deftypefn {Function File} {[@var{text}, @var{status}] =} get_first_help_sentence (@var{name}) +## @deftypefnx {Function File} {[@var{text}, @var{status}] =} get_first_help_sentence (@var{name}, @var{max_len}) +## Return the first sentence of a function's help text. ## -## The function reads the first sentence of the help text of the function -## @var{name}. The first sentence is defined as the text after the function +## The first sentence is defined as the text after the function ## declaration until either the first period (".") or the first appearance of -## two consecutive end-lines ("\n\n"). The text is truncated to a maximum -## length -## of @var{max_len}, which defaults to 80. +## two consecutive newlines ("\n\n"). The text is truncated to a maximum +## length of @var{max_len}, which defaults to 80. ## ## The optional output argument @var{status} returns the status reported by ## @code{makeinfo}. If only one output argument is requested, and @var{status} @@ -36,23 +35,23 @@ ## @example ## @group ## get_first_help_sentence ("get_first_help_sentence") -## @print{} ans = Return the first sentence of a function help text. +## @print{} ans = Return the first sentence of a function's help text. ## @end group ## @end example ## @end deftypefn -function [retval, status] = get_first_help_sentence (name, max_len = 80) +function [text, status] = get_first_help_sentence (name, max_len = 80) ## Check input - if (nargin == 0) - error ("get_first_help_sentence: not enough input arguments"); + if (nargin < 1 || nargin > 2) + print_usage (); endif if (!ischar (name)) - error ("get_first_help_sentence: first input must be a string"); + error ("get_first_help_sentence: NAME must be a string"); endif - if (!isnumeric (max_len) || max_len <= 0 || max_len != round (max_len)) - error ("get_first_help_sentence: second input must be positive integer"); + if (!isnumeric (max_len) || max_len <= 0 || max_len != fix (max_len)) + error ("get_first_help_sentence: MAX_LEN must be positive integer"); endif ## First, we get the raw help text @@ -61,11 +60,11 @@ ## Then, we take action depending on the format switch (lower (format)) case "plain text" - [retval, status] = first_sentence_plain_text (help_text, max_len); + [text, status] = first_sentence_plain_text (help_text, max_len); case "texinfo" - [retval, status] = first_sentence_texinfo (help_text, max_len); + [text, status] = first_sentence_texinfo (help_text, max_len); case "html" - [retval, status] = first_sentence_html (help_text, max_len); + [text, status] = first_sentence_html (help_text, max_len); case "not documented" error ("get_first_help_sentence: `%s' is not documented\n", name); case "not found" @@ -80,18 +79,18 @@ endfunction ## This function extracts the first sentence from a plain text help text -function [retval, status] = first_sentence_plain_text (help_text, max_len) +function [text, status] = first_sentence_plain_text (help_text, max_len) ## Extract first line by searching for a period or a double line-end. - period_idx = find (help_text == ".", 1); + period_idx = find (help_text == '.', 1); line_end_idx = strfind (help_text, "\n\n"); - retval = help_text (1:min ([period_idx(:); line_end_idx(:); max_len; length(help_text)])); + text = help_text (1:min ([period_idx(:); line_end_idx(:); max_len; length(help_text)])); status = 0; endfunction ## This function extracts the first sentence from a Texinfo help text. ## The function works by removing @def* from the texinfo text. After this, we ## render the text to plain text using makeinfo, and then extract the first line. -function [retval, status] = first_sentence_texinfo (help_text, max_len) +function [text, status] = first_sentence_texinfo (help_text, max_len) ## Lines ending with "@\n" are continuation lines, so they should be concatenated ## with the following line. help_text = strrep (help_text, "@\n", " "); @@ -141,16 +140,26 @@ [help_text, status] = __makeinfo__ (help_text, "plain text"); ## Extract first line with plain text method. - retval = first_sentence_plain_text (help_text, max_len); + text = first_sentence_plain_text (help_text, max_len); endfunction ## This function extracts the first sentence from a html help text. ## The function simply removes the tags and treats the text as plain text. -function [retval, status] = first_sentence_html (help_text, max_len) +function [text, status] = first_sentence_html (help_text, max_len) ## Strip tags [help_text, status] = strip_html_tags (help_text); ## Extract first line with plain text method. - retval = first_sentence_plain_text (help_text, max_len); + text = first_sentence_plain_text (help_text, max_len); endfunction +%!assert (strcmp (get_first_help_sentence('get_first_help_sentence'), "Return the first sentence of a function's help text.")); + +%% Test input validation +%!error get_first_help_sentence () +%!error get_first_help_sentence (1, 2, 3) +%!error get_first_help_sentence (1) +%!error get_first_help_sentence ('ls', 'a') +%!error get_first_help_sentence ('ls', 0) +%!error get_first_help_sentence ('ls', 80.1) +
--- a/scripts/help/help.m +++ b/scripts/help/help.m @@ -179,3 +179,7 @@ endif endfunction + + +%!assert (! isempty (findstr (help ("ls"), "List directory contents"))) +%!error <invalid input> help (42)
--- a/scripts/help/lookfor.m +++ b/scripts/help/lookfor.m @@ -42,17 +42,18 @@ ## @end deftypefn function [out_fun, out_help_text] = lookfor (str, arg2) + if (strcmpi (str, "-all")) ## The difference between using '-all' and not, is which part of the caches - ## we search. The cache is organised such that its first column contains - ## the function name, its second column contains the full help text, and its - ## third column contains the first sentence of the help text. + ## we search. The cache is organized such that the first column contains + ## the function name, the second column contains the full help text, and + ## the third column contains the first sentence of the help text. str = arg2; - search_type = 2; # when using caches, search its second column + search_type = 2; # when using caches, search the second column else - search_type = 3; # when using caches, search its third column + search_type = 3; # when using caches, search the third column endif - str = lower (str); + str = lower (str); # Compare is case insensitive ## Search functions, operators, and keywords that come with Octave cache_file = doc_cache_file (); @@ -81,16 +82,16 @@ if (exist (cache_file, "file")) ## We have a cache in the directory, then read it and search it! [funs, hts] = search_cache (str, cache_file, search_type); - fun (end+1:end+length (funs)) = funs; - help_text (end+1:end+length (hts)) = hts; + fun(end+1:end+length (funs)) = funs; + help_text(end+1:end+length (hts)) = hts; else ## We don't have a cache. Search files funs_in_f = __list_functions__ (elt); for m = 1:length (funs_in_f) - fn = funs_in_f {m}; + fn = funs_in_f{m}; ## Skip files that start with __ - if (length (fn) > 2 && strcmp (fn (1:2), "__")) + if (length (fn) > 2 && strcmp (fn(1:2), "__")) continue; endif @@ -99,7 +100,7 @@ warn_state = warning (); unwind_protect warning ("off"); - first_sentence = get_first_help_sentence (fn); + first_sentence = get_first_help_sentence (fn, 1024); status = 0; unwind_protect_cleanup warning (warn_state); @@ -139,28 +140,29 @@ endif ## Search the help text, if we can - if (status == 0 && !isempty (strfind (text, str))) - fun (end+1) = fn; - help_text (end+1) = first_sentence; + if (status == 0 && ! isempty (strfind (lower (text), str))) + fun(end+1) = fn; + help_text(end+1) = first_sentence; endif endfor endif endfor if (nargout == 0) - ## Print the results (FIXME: improve this to make it look better. + ## Print the results (FIXME: it would be nice to break at word boundaries) indent = 20; - term_width = terminal_size() (2); + term_width = (terminal_size ())(2); desc_width = term_width - indent - 2; - indent_space = repmat (" ", 1, indent); + indent_space = blanks (indent); for k = 1:length (fun) - f = fun {k}; - f (end+1:indent) = " "; - printf (f); - desc = strtrim (strrep (help_text {k}, "\n", " ")); + f = fun{k}; + f(end+1:indent-1) = " "; + puts ([f " "]); + lf = length (f); + desc = strtrim (strrep (help_text{k}, "\n", " ")); ldesc = length (desc); - printf ("%s\n", desc (1:min (desc_width, ldesc))); - for start = desc_width+1:desc_width:ldesc + printf ("%s\n", desc(1:min (ldesc, desc_width - (lf - indent)))); + for start = (desc_width - (lf - indent) + 1):desc_width:ldesc stop = min (start + desc_width, ldesc); printf ("%s%s\n", indent_space, strtrim (desc (start:stop))); endfor @@ -171,17 +173,19 @@ out_fun = fun; out_help_text = help_text; endif + endfunction function [funs, help_texts] = search_cache (str, cache_file, search_type) load (cache_file); if (! isempty (cache)) - t1 = strfind (cache (1, :), str); - t2 = strfind (cache (search_type, :), str); + t1 = strfind (lower (cache (1, :)), str); + t2 = strfind (lower (cache (search_type, :)), str); cache_idx = find (! (cellfun ("isempty", t1) & cellfun ("isempty", t2))); - funs = cache (1, cache_idx); - help_texts = cache (3, cache_idx); + funs = cache(1, cache_idx); + help_texts = cache(3, cache_idx); else funs = help_texts = {}; endif endfunction +
--- a/scripts/help/module.mk +++ b/scripts/help/module.mk @@ -1,11 +1,11 @@ FCN_FILE_DIRS += help help_PRIVATE_FCN_FILES = \ - help/private/__additional_help_message__.m + help/private/__additional_help_message__.m \ + help/private/__strip_html_tags__.m help_FCN_FILES = \ help/__makeinfo__.m \ - help/__strip_html_tags__.m \ help/doc.m \ help/gen_doc_cache.m \ help/get_first_help_sentence.m \ @@ -13,6 +13,7 @@ help/lookfor.m \ help/print_usage.m \ help/type.m \ + help/unimplemented.m \ help/which.m \ $(help_PRIVATE_FCN_FILES)
--- a/scripts/help/print_usage.m +++ b/scripts/help/print_usage.m @@ -136,3 +136,7 @@ retval = get_usage_plain_text (help_text, max_len); endfunction + +## Stop reporting function as missing tests. No good tests possible. +%!assert (1) +
--- a/scripts/help/type.m +++ b/scripts/help/type.m @@ -111,4 +111,14 @@ endfor endfunction +%!test +%! var = 1; +%! typestr = type ("var"); +%! typestr = typestr{1}(1:17); +%! assert (typestr, "var is a variable"); +%!assert (type ('dot'){1}, "dot is a dynamically-linked function") +%!assert (type ('cat'){1}, "cat is a built-in function") +%!assert (type ('+'){1}, "+ is an operator") +%!assert (type ('end'){1}, "end is a keyword") +%!error (type ('NO_NAME'))
rename from scripts/miscellaneous/unimplemented.m rename to scripts/help/unimplemented.m --- a/scripts/miscellaneous/unimplemented.m +++ b/scripts/help/unimplemented.m @@ -29,12 +29,17 @@ ## Some smarter cases, add more as needed. switch (fcn) + case "importdata" + txt = ["importdata is not implemented. Similar functionality is ",... + "available through @code{load}, @code{dlmread}, @code{csvread}, ",... + "or @code{textscan}."]; + case "quad2d" txt = ["quad2d is not implemented. Consider using dblquad."]; case "gsvd" - txt = ["gsvd is not currently part of Octave. See the linear-algebra",... - "package at @url{http://octave.sf.net/linear-algebra/}."]; + txt = ["gsvd is not currently part of core Octave. See the ", + "linear-algebra package at @url{http://octave.sf.net/linear-algebra/}."]; case "linprog" txt = ["Octave does not currently provide linprog. ",... @@ -76,7 +81,6 @@ "RandStream", "TriRep", "TriScatteredInterp", - "addpref", "align", "alim", "alpha", @@ -95,7 +99,6 @@ "bar3h", "bench", "betaincinv", - "bicg", "bicgstabl", "brush", "builddocsearchdb", @@ -188,7 +191,6 @@ "gco", "getframe", "getpixelposition", - "getpref", "gmres", "grabcode", "graymon", @@ -233,7 +235,6 @@ "isinterface", "isjava", "isocaps", - "ispref", "isstudent", "javaArray", "javaMethod", @@ -329,23 +330,17 @@ "quad2d", "questdlg", "rbbox", - "rectangle", - "recycle", "reducepatch", "reducevolume", "resample", - "reset", "rgbplot", - "rmpref", "root", "rotate", "rotate3d", - "rsf2csf", "selectmoveresize", "sendmail", "serial", "setpixelposition", - "setpref", "showplottool", "shrinkfaces", "smooth3", @@ -400,14 +395,12 @@ "unicode2native", "unloadlibrary", "unmesh", - "usejava", "userpath", "validateattributes", "verLessThan", "viewmtx", "visdiff", "volumebounds", - "waitbar", "waitfor", "warndlg", "waterfall", @@ -429,3 +422,14 @@ "zoom", }; endfunction + + +%!test +%! str = unimplemented ("no_name_function"); +%! assert (isempty (str)); +%! str = unimplemented ("quad2d"); +%! assert (str(1:51), "quad2d is not implemented. Consider using dblquad."); +%! str = unimplemented ("MException"); +%! assert (str(1:58), "the `MException' function is not yet implemented in Octave"); + +
--- a/scripts/help/which.m +++ b/scripts/help/which.m @@ -53,3 +53,13 @@ endif endfunction + + +%!test +%! str = which ("ls"); +%! assert (str(end-17:end), strcat ("miscellaneous", filesep(), "ls.m")); +%!test +%! str = which ("dot"); +%! assert (str(end-6:end), "dot.oct"); + +%!assert (which ("NO_NAME"), "");
--- a/scripts/image/brighten.m +++ b/scripts/image/brighten.m @@ -20,7 +20,7 @@ ## @deftypefn {Function File} {@var{map_out} =} brighten (@var{map}, @var{beta}) ## @deftypefnx {Function File} {@var{map_out} =} brighten (@var{h}, @var{beta}) ## @deftypefnx {Function File} {@var{map_out} =} brighten (@var{beta}) -## Darkens or brightens the given colormap. If the @var{map} argument +## Darken or brighten the given colormap. If the @var{map} argument ## is omitted, the function is applied to the current colormap. The first ## argument can also be a valid graphics handle @var{h}, in which case ## @code{brighten} is applied to the colormap associated with this handle.
--- a/scripts/image/image.m +++ b/scripts/image/image.m @@ -19,9 +19,10 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} image (@var{img}) ## @deftypefnx {Function File} {} image (@var{x}, @var{y}, @var{img}) -## Display a matrix as a color image. The elements of @var{x} are indices +## @deftypefnx {Function File} {@var{h} =} image (@dots{}) +## Display a matrix as a color image. The elements of @var{img} are indices ## into the current colormap, and the colormap will be scaled so that the -## extremes of @var{x} are mapped to the extremes of the colormap. +## extremes of @var{img} are mapped to the extremes of the colormap. ## ## The axis values corresponding to the matrix elements are specified in ## @var{x} and @var{y}. If you're not using gnuplot 4.2 or later, these @@ -35,6 +36,8 @@ ## an image and an ordinary plot need to be overlaid. The recommended ## solution is to display the image and then plot the reversed ydata ## using, for example, @code{flipud (ydata,1)}. +## +## The optional return value @var{h} is a graphics handle to the image. ## @seealso{imshow, imagesc, colormap} ## @end deftypefn @@ -95,7 +98,7 @@ ## Adapted-By: jwe function h = __img__ (x, y, img, varargin) - + newplot (); if (isempty (img)) @@ -113,6 +116,15 @@ xdata = [x(1), x(end)]; ydata = [y(1), y(end)]; + dx = diff (x); + dy = diff (y); + dx = std (dx) / mean (abs (dx)); + dy = std (dy) / mean (abs (dy)); + tol = 100*eps; + if (any (dx > tol) || any (dy > tol)) + warning ("Image does not map to non-linearly spaced coordinates") + endif + ca = gca (); tmp = __go_image__ (ca, "cdata", img, "xdata", xdata, "ydata", ydata, @@ -164,6 +176,7 @@ endfunction %!demo +%! clf %! img = 1 ./ hilb (11); %! x = -5:5; %! y = x; @@ -186,4 +199,40 @@ %! set (h, "cdatamapping", "scaled") %! title ('image (-x, -y, img)') +%!demo +%! clf +%! g = 0.1:0.1:10; +%! h = g'*g; +%! imagesc (g, g, sin (h)); +%! hold on +%! imagesc (g, g+12, cos (h/2)); +%! axis ([0 10 0 22]) +%! hold off +%! title ("two consecutive images") +%!demo +%! clf +%! g = 0.1:0.1:10; +%! h = g'*g; +%! imagesc (g, g, sin (h)); +%! hold all +%! plot (g, 11.0 * ones (size (g))) +%! imagesc (g, g+12, cos (h/2)); +%! axis ([0 10 0 22]) +%! hold off +%! title ("image, line, image") + +%!demo +%! clf +%! g = 0.1:0.1:10; +%! h = g'*g; +%! plot (g, 10.5 * ones (size (g))) +%! hold all +%! imagesc (g, g, sin (h)); +%! plot (g, 11.0 * ones (size (g))) +%! imagesc (g, g+12, cos (h/2)); +%! plot (g, 11.5 * ones (size (g))) +%! axis ([0 10 0 22]) +%! hold off +%! title ("line, image, line, image, line") +
--- a/scripts/image/imagesc.m +++ b/scripts/image/imagesc.m @@ -32,6 +32,7 @@ ## values for the respective axes, or as values for each row and column ## of the matrix @var{A}. ## +## The optional return value @var{h} is a graphics handle to the image. ## @seealso{image, imshow, caxis} ## @end deftypefn
--- a/scripts/image/imshow.m +++ b/scripts/image/imshow.m @@ -23,6 +23,7 @@ ## @deftypefnx {Function File} {} imshow (@var{rgb}, @dots{}) ## @deftypefnx {Function File} {} imshow (@var{filename}) ## @deftypefnx {Function File} {} imshow (@dots{}, @var{string_param1}, @var{value1}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} imshow (@dots{}) ## Display the image @var{im}, where @var{im} can be a 2-dimensional ## (gray-scale image) or a 3-dimensional (RGB image) matrix. ## @@ -44,6 +45,8 @@ ## @item "displayrange" ## @var{value1} is the display range as described above. ## @end table +## +## The optional return value @var{h} is a graphics handle to the image. ## @seealso{image, imagesc, colormap, gray2ind, rgb2ind} ## @end deftypefn @@ -115,6 +118,12 @@ endif endwhile + ## Check for complex images. + if (iscomplex (im)) + warning ("imshow: only showing real part of complex image"); + im = real (im); + endif + ## Set default display range if display_range not set yet. if (isempty (display_range)) display_range = [min(im(:)), max(im(:))]; @@ -130,12 +139,6 @@ endswitch endif - ## Check for complex images. - if (iscomplex (im)) - warning ("imshow: only showing real part of complex image"); - im = real (im); - endif - nans = isnan (im(:)); if (any (nans)) warning ("Octave:imshow-NaN",
--- a/scripts/image/ind2rgb.m +++ b/scripts/image/ind2rgb.m @@ -40,7 +40,7 @@ endif ## Check if X is an indexed image. - if (ndims (x) != 2 || any (x(:) != round (x(:))) || min (x(:)) < 1) + if (ndims (x) != 2 || any (x(:) != fix (x(:))) || min (x(:)) < 1) error ("ind2rgb: X must be an indexed image"); endif
--- a/scripts/io/beep.m +++ b/scripts/io/beep.m @@ -26,10 +26,13 @@ function beep () - if (nargin == 0) - puts ("\a"); - else + if (nargin != 0) print_usage (); endif + puts ("\a"); + endfunction + + +%!error (beep (1))
--- a/scripts/io/csvread.m +++ b/scripts/io/csvread.m @@ -33,3 +33,9 @@ function x = csvread (filename, varargin) x = dlmread (filename, ",", varargin{:}); endfunction + + +%% Tests for csvread() are in csvwrite() +%% Mark file as being tested +%!assert (1) +
--- a/scripts/io/csvwrite.m +++ b/scripts/io/csvwrite.m @@ -34,3 +34,21 @@ function csvwrite (filename, x, varargin) dlmwrite (filename, x, ",", varargin{:}); endfunction + + +%!shared fname +%! fname = tmpnam (); + +%!test +%! csvwrite (fname, magic (3)); +%! assert (csvread (fname), magic (3)); +%! unlink (fname); + +%!test +%! csvwrite (fname, magic (3), "precision", "%2.1f", "newline", "unix"); +%! fid = fopen (fname, "rt"); +%! txt = char (fread (fid,Inf,'char')'); +%! fclose (fid); +%! assert (txt, "8.0,1.0,6.0\n3.0,5.0,7.0\n4.0,9.0,2.0\n"); +%! unlink (fname); +
--- a/scripts/io/dlmwrite.m +++ b/scripts/io/dlmwrite.m @@ -21,6 +21,7 @@ ## @deftypefnx {Function File} {} dlmwrite (@var{file}, @var{M}, @var{delim}, @var{r}, @var{c}) ## @deftypefnx {Function File} {} dlmwrite (@var{file}, @var{M}, @var{key}, @var{val} @dots{}) ## @deftypefnx {Function File} {} dlmwrite (@var{file}, @var{M}, "-append", @dots{}) +## @deftypefnx {Function File} {} dlmwrite (@var{fid}, @dots{}) ## Write the matrix @var{M} to the named file using delimiters. ## ## @var{file} should be a file name or writable file ID given by @code{fopen}. @@ -34,7 +35,7 @@ ## The value of @var{c} specifies the number of delimiters to prepend to ## each line of data. ## -## If the argument @code{"-append"} is given, append to the end of the +## If the argument @code{"-append"} is given, append to the end of ## @var{file}. ## ## In addition, the following keyword value pairs may appear at the end @@ -86,14 +87,13 @@ function dlmwrite (file, M, varargin) - if (nargin < 2 || ! ischar (file)) + if (nargin < 2) print_usage (); endif ## set defaults delim = ","; - r = 0; - c = 0; + r = c = 0; newline = "\n"; if (ischar (M)) precision = "%c"; @@ -102,16 +102,14 @@ endif opentype = "wt"; - ## process the input arguements + ## process the input arguments i = 0; while (i < length (varargin)) - i = i + 1; + i++; if (strcmpi (varargin{i}, "delimiter")) - i = i + 1; - delim = varargin{i}; + delim = varargin{++i}; elseif (strcmpi (varargin{i}, "newline")) - i = i + 1; - newline = varargin{i}; + newline = varargin{++i}; if (strcmpi (newline, "unix")) newline = "\n"; elseif (strcmpi (newline, "pc")) @@ -120,27 +118,24 @@ newline = "\r"; endif elseif (strcmpi (varargin{i}, "roffset")) - i = i + 1; - r = varargin{i}; + r = varargin{++i}; elseif (strcmpi (varargin{i}, "coffset")) - i = i + 1; - c = varargin{i}; + c = varargin{++i}; elseif (strcmpi (varargin{i}, "precision")) - i = i + 1; - precision = varargin{i}; + precision = varargin{++i}; if (! strcmpi (class (precision), "char")) precision = sprintf ("%%.%gg", precision); endif elseif (strcmpi (varargin{i}, "-append")) opentype = "at"; elseif (strcmpi (varargin{i}, "append")) - i = i + 1; + i++; if (strcmpi (varargin{i}, "on")) opentype = "at"; elseif (strcmpi (varargin{i}, "off")) opentype = "wt"; else - error ("dlmwrite: append must be \"on\" or \"off\""); + error ('dlmwrite: append must be "on" or "off"'); endif else if (i == 1) @@ -158,21 +153,20 @@ if (ischar (file)) [fid, msg] = fopen (file, opentype); elseif (isscalar (file) && isnumeric (file)) - fid = file; - msg = "invalid file number"; + [fid, msg] = deal (file, "invalid file number"); else error ("dlmwrite: FILE must be a filename string or numeric FID"); endif if (fid < 0) - error (msg); + error (["dlmwrite: " msg]); else if (r > 0) fprintf (fid, "%s", repmat ([repmat(delim, 1, c + columns(M)-1), newline], 1, r)); endif if (iscomplex (M)) - cprecision = regexprep (precision, '^%([-\d.])','%+$1'); + cprecision = regexprep (precision, '^%([-\d.])', '%+$1'); template = [precision, cprecision, "i", ... repmat([delim, precision, cprecision, "i"], 1, ... columns(M) - 1), newline ]; @@ -196,19 +190,22 @@ fclose (fid); endif endif + endfunction + %!test -%! f = tmpnam(); -%! dlmwrite(f,[1,2;3,4],'precision','%5.2f','newline','unix','roffset',1,'coffset',1); -%! fid = fopen(f,"rt"); -%! f1 = char(fread(fid,Inf,'char')'); -%! fclose(fid); -%! dlmwrite(f,[5,6],'precision','%5.2f','newline','unix','coffset',1,'delimiter',',','-append'); -%! fid = fopen(f,"rt"); -%! f2 = char(fread(fid,Inf,'char')'); -%! fclose(fid); -%! unlink(f); +%! f = tmpnam (); +%! dlmwrite (f,[1,2;3,4],'precision','%5.2f','newline','unix','roffset',1,'coffset',1); +%! fid = fopen (f,"rt"); +%! f1 = char (fread (fid,Inf,'char')'); +%! fclose (fid); +%! dlmwrite (f,[5,6],'precision','%5.2f','newline','unix','coffset',1,'delimiter',',','-append'); +%! fid = fopen (f,"rt"); +%! f2 = char (fread (fid,Inf,'char')'); +%! fclose (fid); +%! unlink (f); %! -%! assert(f1,",,\n, 1.00, 2.00\n, 3.00, 4.00\n"); -%! assert(f2,",,\n, 1.00, 2.00\n, 3.00, 4.00\n, 5.00, 6.00\n"); +%! assert (f1,",,\n, 1.00, 2.00\n, 3.00, 4.00\n"); +%! assert (f2,",,\n, 1.00, 2.00\n, 3.00, 4.00\n, 5.00, 6.00\n"); +
--- a/scripts/io/fileread.m +++ b/scripts/io/fileread.m @@ -18,8 +18,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{str} =} fileread (@var{filename}) -## Read the contents of a file and return it as a string. -## @seealso{fread, textread} +## Read the contents of @var{filename} and return it as a string. +## @seealso{fread, textread, sscanf} ## @end deftypefn function str = fileread (filename) @@ -29,7 +29,7 @@ endif if (! ischar (filename)) - error ("fileread: argument must be a string"); + error ("fileread: FILENAME argument must be a string"); endif fid = fopen (filename, "r"); @@ -45,3 +45,19 @@ endfunction + +%!test +%! cstr = {"Hello World", "The answer is 42", "Goodbye World"}; +%! fname = tmpnam (); +%! fid = fopen (fname, "w"); +%! fprintf (fid, "%s\n", cstr{:}) +%! fclose (fid); +%! str = fileread (fname); +%! assert (str', [cstr{1} "\n" cstr{2} "\n" cstr{3} "\n"]); +%! unlink (fname); + +%% Test input validation +%!error fileread () +%!error fileread (1, 2) +%!error <FILENAME argument must be a string> fileread (1) +
--- a/scripts/io/strread.m +++ b/scripts/io/strread.m @@ -1,4 +1,5 @@ ## Copyright (C) 2009-2011 Eric Chassande-Mottin, CNRS (France) +## Copyright (C) 2011 Philip Nienhuis ## ## This file is part of Octave. ## @@ -19,15 +20,16 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {[@var{a}, @dots{}] =} strread (@var{str}) ## @deftypefnx {Function File} {[@var{a}, @dots{}] =} strread (@var{str}, @var{format}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} strread (@var{str}, @var{format}, @var{format_repeat}) ## @deftypefnx {Function File} {[@var{a}, @dots{}] =} strread (@var{str}, @var{format}, @var{prop1}, @var{value1}, @dots{}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} strread (@var{str}, @var{format}, @var{format_repeat}, @var{prop1}, @var{value1}, @dots{}) ## Read data from a string. ## ## The string @var{str} is split into words that are repeatedly matched to the ## specifiers in @var{format}. The first word is matched to the first -## specifier, -## the second to the second specifier and so forth. If there are more words -## than -## specifiers, the process is repeated until all words have been processed. +## specifier, the second to the second specifier and so forth. If there are +## more words than specifiers, the process is repeated until all words have +## been processed. ## ## The string @var{format} describes how the words in @var{str} should be ## parsed. @@ -36,19 +38,31 @@ ## @item %s ## The word is parsed as a string. ## -## @item %d ## @itemx %f -## The word is parsed as a number. +## @itemx %n +## The word is parsed as a number and converted to double. +## +## @item %d +## @itemx %u +## The word is parsed as a number and converted to int32. ## -## @item %* +## @item %*', '%*f', '%*s ## The word is skipped. +## +## For %s and %d, %f, %n, %u and the associated %*s @dots{} specifiers an +## optional width can be specified as %Ns, etc. where N is an integer > 1. +## For %f, format specifiers like %N.Mf are allowed. +## +## @item literals +## In addition the format may contain literal character strings; these will be +## skipped during reading. ## @end table ## ## Parsed word corresponding to the first specifier are returned in the first ## output argument and likewise for the rest of the specifiers. ## ## By default, @var{format} is @t{"%f"}, meaning that numbers are read from -## @var{str}. +## @var{str}. This will do if @var{str} contains only numeric fields. ## ## For example, the string ## @@ -68,6 +82,18 @@ ## [@var{a}, @var{b}, @var{c}] = strread (@var{str}, "%s %s %f"); ## @end example ## +## Optional numeric argument @var{format_repeat} can be used for +## limiting the number of items read: +## @table @asis +## @item -1 +## (default) read all of the string until the end. +## +## @item N +## Read N times @var{nargout} items. 0 (zero) is an acceptable +## value for @var{format_repeat}. +## +## @end table +## ## The behavior of @code{strread} can be changed via property-value ## pairs. The following properties are recognized: ## @@ -77,94 +103,215 @@ ## @var{value} is the comment style and can be any of the following. ## @itemize ## @item "shell" -## Everything from @code{#} characters to the nearest end-line is skipped. +## Everything from @code{#} characters to the nearest end-of-line is skipped. ## ## @item "c" ## Everything between @code{/*} and @code{*/} is skipped. ## ## @item "c++" -## Everything from @code{//} characters to the nearest end-line is skipped. +## Everything from @code{//} characters to the nearest end-of-line is skipped. ## ## @item "matlab" -## Everything from @code{%} characters to the nearest end-line is skipped. +## Everything from @code{%} characters to the nearest end-of-line is skipped. +## +## @item user-supplied. Two options: +## (1) One string, or 1x1 cell string: Skip everything to the right of it; +## (2) 2x1 cell string array: Everything between the left and right strings +## is skipped. ## @end itemize ## ## @item "delimiter" -## Any character in @var{value} will be used to split @var{str} into words. +## Any character in @var{value} will be used to split @var{str} into words +## (default value = any whitespace). +## +## @item "emptyvalue": +## Value to return for empty numeric values in non-whitespace delimited data. +## The default is NaN@. When the data type does not support NaN +## (int32 for example), then default is zero. +## +## @item "multipledelimsasone" +## Treat a series of consecutive delimiters, without whitespace in between, +## as a single delimiter. Consecutive delimiter series need not be vertically +## "aligned". ## -## @item "emptyvalue" -## Parts of the output where no word is available is filled with @var{value}. +## @item "treatasempty" +## Treat single occurrences (surrounded by delimiters or whitespace) of the +## string(s) in @var{value} as missing values. +## +## @item "returnonerror" +## If @var{value} true (1, default), ignore read errors and return normally. +## If false (0), return an error. +## +## @item "whitespace" +## Any character in @var{value} will be interpreted as whitespace and +## trimmed; the string defining whitespace must be enclosed in double +## quotes for proper processing of special characters like \t. +## The default value for whitespace = " \b\r\n\t" (note the space). +## Unless whitespace is set to '' (empty) AND at least one "%s" format +## conversion specifier is supplied, a space is always part of whitespace. +## ## @end table ## -## @seealso{textread, load, dlmread, fscanf} +## @seealso{textscan, textread, load, dlmread, fscanf} ## @end deftypefn function varargout = strread (str, format = "%f", varargin) + ## Check input if (nargin < 1) print_usage (); endif - if (!ischar (str) || !ischar (format)) + if (isempty (format)) + format = "%f"; + endif + + if (! ischar (str) || ! ischar (format)) error ("strread: STR and FORMAT arguments must be strings"); endif - ## Parse options + ## Parse format string to compare number of conversion fields and nargout + nfields = length (strfind (format, "%")) - length (strfind (format, "%*")); + ## If str only has numeric fields, a (default) format ("%f") will do. + ## Otherwise: + if ((max (nargout, 1) != nfields) && ! strcmp (format, "%f")) + error ("strread: the number of output variables must match that specified by FORMAT"); + endif + + ## Check for format string repeat count + format_repeat_count = -1; + if (nargin > 2 && isnumeric (varargin{1})) + if (varargin{1} >= 0) + format_repeat_count = varargin{1}; + endif + if (nargin > 3) + varargin = varargin(2:end); + else + varargin = {}; + endif + endif + + ## Parse options. First initialize defaults comment_flag = false; - numeric_fill_value = 0; - white_spaces = " \n\r\t\b"; delimiter_str = ""; + empty_str = ""; + eol_char = ""; + err_action = 0; + mult_dlms_s1 = false; + numeric_fill_value = NaN; + white_spaces = " \b\r\n\t"; for n = 1:2:length (varargin) - switch (lower (varargin {n})) + switch (lower (varargin{n})) + case "bufsize" + ## We could synthesize this, but that just seems weird... + warning ('strread: property "bufsize" is not implemented'); case "commentstyle" comment_flag = true; - switch (lower (varargin {n+1})) + switch (lower (varargin{n+1})) case "c" - comment_specif = {"/*", "*/"}; + [comment_start, comment_end] = deal ("/*", "*/"); case "c++" - comment_specif = {"//", "\n"}; + [comment_start, comment_end] = deal ("//", "eol_char"); case "shell" - comment_specif = {"#", "\n"}; + [comment_start, comment_end] = deal ("#" , "eol_char"); case "matlab" - comment_specif = {"%", "\n"}; + [comment_start, comment_end] = deal ("%" , "eol_char"); otherwise - warning ("strread: unknown comment style '%s'", val); + if (ischar (varargin{n+1}) || + (numel (varargin{n+1}) == 1 && iscellstr (varargin{n+1}))) + [comment_start, comment_end] = deal (char (varargin{n+1}), "eol_char"); + elseif (iscellstr (varargin{n+1}) && numel (varargin{n+1}) == 2) + [comment_start, comment_end] = deal (varargin{n+1}{:}); + else + ## FIXME - a user may have numeric values specified: {'//', 7} + ## this will lead to an error in the warning message + error ("strread: unknown or unrecognized comment style '%s'", + varargin{n+1}); + endif endswitch case "delimiter" - delimiter_str = varargin {n+1}; + delimiter_str = varargin{n+1}; + if (strcmp (typeinfo (delimiter_str), "sq_string")) + delimiter_str = do_string_escapes (delimiter_str); + endif case "emptyvalue" - numeric_fill_value = varargin {n+1}; - case "bufsize" - ## XXX: We could synthesize this, but that just seems weird... - warning ("strread: property \"bufsize\" is not implemented"); + numeric_fill_value = varargin{n+1}; + case "expchars" + warning ('strread: property "expchars" is not implemented'); case "whitespace" - white_spaces = varargin {n+1}; - case "expchars" - warning ("strread: property \"expchars\" is not implemented"); + white_spaces = varargin{n+1}; + if (strcmp (typeinfo (white_spaces), "sq_string")) + white_spaces = do_string_escapes (white_spaces); + endif + ## The following parameters are specific to textscan and textread + case "endofline" + eol_char = varargin{n+1}; + if (strcmp (typeinfo (eol_char), "sq_string")) + eol_char = do_string_escapes (eol_char); + endif + case "returnonerror" + err_action = varargin{n+1}; + case "multipledelimsasone" + mult_dlms_s1 = varargin{n+1}; + case "treatasempty" + if (iscellstr (varargin{n+1})) + empty_str = varargin{n+1}; + elseif (ischar (varargin{n+1})) + empty_str = varargin(n+1); + else + error ('strread: "treatasempty" value must be string or cellstr'); + endif otherwise - warning ("strread: unknown property \"%s\"", varargin {n}); + warning ('strread: unknown property "%s"', varargin{n}); endswitch endfor - if (isempty (delimiter_str)) - delimiter_str = white_spaces; + + ## First parse of FORMAT + if (strcmpi (strtrim (format), "%f")) + ## Default format specified. Expand it (to desired nargout) + fmt_words = cell (nargout, 1); + fmt_words (1:nargout) = format; + else + ## Determine the number of words per line as a first guess. Forms + ## like %f<literal>) (w/o delimiter in between) are fixed further on + format = strrep (format, "%", " %"); + fmt_words = regexp (format, '[^ ]+', 'match'); + ## Format conversion specifiers following literals w/o space/delim + ## in between are separate now. Separate those w trailing literals + idy2 = find (! cellfun ("isempty", strfind (fmt_words, "%"))); + a = strfind (fmt_words(idy2), "%"); + b = regexp (fmt_words(idy2), '[nfdus]', 'end'); + for jj = 1:numel (a) + ii = numel (a) - jj + 1; + if (! (length (fmt_words{idy2(ii)}) == b{ii}(1))) + ## Fix format_words + fmt_words(idy2(ii)+1 : end+1) = fmt_words(idy2(ii) : end); + fmt_words{idy2(ii)} = fmt_words{idy2(ii)}(a{ii} : b{ii}(1)); + fmt_words{idy2(ii)+1} = fmt_words{idy2(ii)+1}(b{ii}+1:end); + endif + endfor + endif + num_words_per_line = numel (fmt_words); + + ## Special handling for CRLF EOL character in str + if (! isempty (eol_char) && strcmp (eol_char, "\r\n")) + ## Strip CR from CRLF sequences + str = strrep (str, "\r\n", "\n"); + ## CR serves no further purpose in function + eol_char = "\n"; endif - ## Parse format string - idx = strfind (format, "%")'; - specif = format ([idx, idx+1]); - nspecif = length (idx); - idx_star = strfind (format, "%*"); - nfields = length (idx) - length (idx_star); - - if (max (nargout, 1) != nfields) - error ("strread: the number of output variables must match that specified byFORMAT"); - endif - - ## Remove comments + ## Remove comments in str if (comment_flag) - cstart = strfind (str, comment_specif{1}); - cstop = strfind (str, comment_specif{2}); - if (length (cstart) > 0) + ## Expand 'eol_char' here, after option processing which may have set value + comment_end = regexprep (comment_end, 'eol_char', eol_char); + cstart = strfind (str, comment_start); + cstop = strfind (str, comment_end); + ## Treat end of string as additional comment stop + if (isempty (cstop) || cstop(end) != length (str)) + cstop(end+1) = length (str); + endif + if (! isempty (cstart)) ## Ignore nested openers. [idx, cidx] = unique (lookup (cstop, cstart), "first"); if (idx(end) == length (cstop)) @@ -172,7 +319,7 @@ endif cstart = cstart(cidx); endif - if (length (cstop) > 0) + if (! isempty (cstop)) ## Ignore nested closers. [idx, cidx] = unique (lookup (cstart, cstop), "first"); if (idx(1) == 0) @@ -181,101 +328,435 @@ cstop = cstop(cidx); endif len = length (str); - c2len = length (comment_specif{2}); + c2len = length (comment_end); str = cellslices (str, [1, cstop + c2len], [cstart - 1, len]); str = [str{:}]; endif - ## Determine the number of words per line - format = strrep (format, "%", " %"); - [~, ~, ~, fmt_words] = regexp (format, '[^ ]+'); + if (! isempty (white_spaces)) + ## For numeric fields, whitespace is always a delimiter, but not for text fields + if (isempty (strfind (format, "%s"))) + ## Add whitespace to delimiter set + delimiter_str = unique ([white_spaces delimiter_str]); + else + ## Remove any delimiter chars from white_spaces list + white_spaces = setdiff (white_spaces, delimiter_str); + endif + endif + if (isempty (delimiter_str)) + delimiter_str = " "; + endif + if (! isempty (eol_char)) + ## Add eol_char to delimiter collection + delimiter_str = unique ([delimiter_str eol_char]); + ## .. and remove it from whitespace collection + white_spaces = strrep (white_spaces, eol_char, ''); + endif - num_words_per_line = numel (fmt_words); - for m = 1:numel(fmt_words) - ## Convert formats such as "%Ns" to "%s" (see the FIXME below) - if (length (fmt_words{m}) > 2) - if (strcmp (fmt_words{m}(1:2), "%*")) - fmt_words{m} = "%*"; - elseif (fmt_words{m}(1) == "%") - fmt_words{m} = fmt_words{m}([1, end]); - endif + pad_out = 0; + ## Trim whitespace if needed + if (! isempty (white_spaces)) + ## Check if trailing "\n" might signal padding output arrays to equal size + ## before it is trimmed away below + if ((str(end) == 10) && (nargout > 1)) + pad_out = 1; + endif + ## Condense all repeated whitespace into one single space + ## FIXME: this will also fold repeated whitespace in a char field + rxp_wsp = sprintf ("[%s]+", white_spaces); + str = regexprep (str, rxp_wsp, ' '); + ## Remove possible leading space at string + if (str(1) == 32) + str = str(2:end); endif - endfor + ## Check for single delimiter followed/preceded by whitespace + ## FIXME: Double strrep on str is enormously expensive of CPU time. + ## Can this be eliminated + if (! isempty (delimiter_str)) + dlmstr = setdiff (delimiter_str, " "); + rxp_dlmwsp = sprintf ("( [%s]|[%s] )", dlmstr, dlmstr); + str = regexprep (str, rxp_dlmwsp, delimiter_str(1)); + endif + ## FIXME: Double strrep on str is enormously expensive of CPU time. + ## Can this be eliminated + ## Wipe leading and trailing whitespace on each line (it may be delimiter too) + if (! isempty (eol_char)) + str = strrep (str, [eol_char " "], eol_char); + str = strrep (str, [" " eol_char], eol_char); + endif + endif ## Split 'str' into words - words = split_by (str, delimiter_str); + words = split_by (str, delimiter_str, mult_dlms_s1, eol_char); + if (! isempty (white_spaces)) + ## Trim leading and trailing white_spaces + ## FIXME: Is this correct? strtrim clears what matches isspace(), not + ## necessarily what is in white_spaces. + words = strtrim (words); + endif num_words = numel (words); + ## First guess at number of lines in file (ignoring leading/trailing literals) num_lines = ceil (num_words / num_words_per_line); - ## For each specifier + ## Replace TreatAsEmpty char sequences by empty strings + if (! isempty (empty_str)) + for ii = 1:numel (empty_str) + idz = strmatch (empty_str{ii}, words, "exact"); + words(idz) = {""}; + endfor + endif + + ## fmt_words has been split properly now, but words{} has only been split on + ## delimiter positions. + ## As numeric fields can also be separated by whitespace, more splits may be + ## needed. + ## We also don't know the number of lines (as EndOfLine may have been set to + ## "" (empty) by the caller). + ## + ## We also may have to cope with 3 cases as far as literals go: + ## A: Trailing literals (%f<literal>) w/o delimiter in between. + ## B: Leading literals (<literal>%f) w/o delimiter in between. + ## C. Skipping leftover parts of specified skip fields (%*N ) + ## Some words columns may have to be split further to fix these. + + ## Find indices and pointers to possible literals in fmt_words + idf = cellfun ("isempty", strfind (fmt_words, "%")); + ## Find indices and pointers to conversion specifiers with fixed width + idg = ! cellfun ("isempty", regexp (fmt_words, '%\*?\d')); + idy = find (idf | idg); + ## Find indices to numeric conversion specifiers + idn = ! cellfun ("isempty", regexp (fmt_words, "%[dnfu]")); + + ## If needed, split up columns in three steps: + if (! isempty (idy)) + ## Try-catch because complexity of strings to read can be infinite + try + + ## 1. Assess "period" in the split-up words array ( < num_words_per_line). + ## Could be done using EndOfLine but that prohibits EndOfLine = "" option. + ## Alternative below goes by simply parsing a first grab of words + ## and counting words until the fmt_words array is exhausted: + iwrd = 1; iwrdp = 0; iwrdl = length (words{iwrd}); + for ii = 1:numel (fmt_words) + + if (idf(ii)) + ## Literal expected + if (isempty (strfind (fmt_words{ii}, words(iwrd)))) + ## Not found in current word; supposed to be in next word + ++iwrd; iwrdp = 0; + if (ii < numel (fmt_words)) + iwrdl = length (words{iwrd}); + endif + else + ## Found it in current word. Subtract literal length + iwrdp += length (fmt_words{ii}); + if (iwrdp > iwrdl) + ## Parse error. Literal extends beyond delimiter (word boundary) + warning ("strread: literal '%s' (fmt spec # %d) does not match data", ... + fmt_words{ii}, ii); + ## Word assumed to be completely "used up". Next word + ++iwrd; iwrdp = 0; + if (ii < numel (fmt_words)) + iwrdl = length (words{iwrd}); + endif + elseif (iwrdp == iwrdl) + ## Word completely "used up". Next word + ++iwrd; iwrdp = 0; + if (ii < numel (fmt_words)) + iwrdl = length (words{iwrd}); + endif + endif + endif + + elseif (idg(ii)) + ## Fixed width specifier (%N or %*N): read just a part of word + iwrdp += floor ... + (str2double (fmt_words{ii}(regexp(fmt_words{ii}, '\d') : end-1))); + if (iwrdp > iwrdl) + ## Match error. Field extends beyond word boundary. + warning ... + ("strread: field width '%s' (fmt spec # %d) extends beyond actual word limit", ... + fmt_words{ii}, ii); + ## Assume word to be completely "used up". Next word + ++iwrd; iwrdp = 0; iwrdl = length (words{iwrd}); + elseif (iwrdp == iwrdl) + ## Word completely "used up". Next word + ++iwrd; iwrdp = 0; iwrdl = length (words{iwrd}); + endif + + else + ## A simple format conv. specifier. Either (1) uses rest of word, or + ## (2) is squeezed between current iwrdp and next literal, or (3) uses + ## next word. (3) is already taken care of. So just check (1) & (2) + if (ii < numel (fmt_words) && idf(ii+1)) + ## Next fmt_word is a literal... + if (! index (words{iwrd}(iwrdp+1:end), fmt_words{ii+1})) + ## ...but not found in current word => field uses rest of word + ++iwrd; iwrdp = 0; iwrdl = length (words{iwrd}); + else + ## ..or it IS found. Add inferred width of current conversion field + iwrdp += index (words{iwrd}(iwrdp+1:end), fmt_words{ii+1}) - 1; + endif + elseif (iwrdp < iwrdl) + ## No bordering literal to the right => field occupies (rest of) word + ++iwrd; iwrdp = 0; + if (ii < numel (fmt_words)) + iwrdl = length (words{iwrd}); + endif + endif + + endif + endfor + ## Done + words_period = max (iwrd - 1, 1); + num_lines = ceil (num_words / words_period); + + ## 2. Pad words array so that it can be reshaped + tmp_lines = ceil (num_words / words_period); + num_words_padded = tmp_lines * words_period - num_words; + if (num_words_padded) + words = [words'; cell(num_words_padded, 1)]; + endif + words = reshape (words, words_period, tmp_lines); + + ## 3. Do the column splitting on rectangular words array + icol = 1; ii = 1; # icol = current column, ii = current fmt_word + while (ii <= num_words_per_line) + + ## Check if fmt_words(ii) contains a literal or fixed-width + if ((idf(ii) || idg(ii)) && (rows(words) < num_words_per_line)) + if (idf(ii)) + s = strfind (words(icol, 1), fmt_words{ii}); + if (isempty (s{:})) + error ("strread: Literal '%s' not found in column %d", fmt_words{ii}, icol); + endif + s = s{:}(1); + e = s(1) + length (fmt_words{ii}) - 1; + endif + if (! strcmp (fmt_words{ii}, words{icol, 1})) + ## Column doesn't exactly match literal => split needed. Insert a column + words(icol+1:end+1, :) = words(icol:end, :); + ## Watch out for empty cells + jptr = find (! cellfun ("isempty", words(icol, :))); + + ## Distinguish leading or trailing literals + if (! idg(ii) && ! isempty (s) && s(1) == 1) + ## Leading literal. Assign literal to icol, paste rest in icol + 1 + ## Apply only to those cells that do have something beyond literal + jptr = find (cellfun("length", words(icol+1, jptr), ... + "UniformOutput", false) > e(1)); + words(icol+1, :) = {""}; + words(icol+1, jptr) = cellfun ... + (@(x) substr(x, e(1)+1, length(x)-e(1)), words(icol, jptr), ... + "UniformOutput", false); + words(icol, jptr) = fmt_words{ii}; + + else + if (! idg(ii) && ! isempty (strfind (fmt_words{ii-1}, "%s"))) + ## Trailing literal. If preceding format == '%s' this is an error + warning ("Ambiguous '%s' specifier next to literal in column %d", icol); + elseif (idg(ii)) + ## Current field = fixed width. Strip into icol, rest in icol+1 + wdth = floor (str2double (fmt_words{ii}(regexp(fmt_words{ii}, ... + '\d') : end-1))); + words(icol+1, jptr) = cellfun (@(x) x(wdth+1:end), + words(icol,jptr), "UniformOutput", false); + words(icol, jptr) = strtrunc (words(icol, jptr), wdth); + else + ## FIXME: this assumes char(254)/char(255) won't occur in input! + clear wrds; + wrds(1:2:2*numel (words(icol, jptr))) = ... + strrep (words(icol, jptr), fmt_words{ii}, ... + [char(255) char(254)]); + wrds(2:2:2*numel (words(icol, jptr))-1) = char(255); + wrds = strsplit ([wrds{:}], char(255)); + words(icol, jptr) = ... + wrds(find (cellfun ("isempty", strfind (wrds, char(254))))); + wrds(find (cellfun ("isempty", strfind (wrds, char(254))))) ... + = char(255); + words(icol+1, jptr) = strsplit (strrep ([wrds{2:end}], ... + char(254), fmt_words{ii}), char(255)); + ## Former trailing literal may now be leading for next specifier + --ii; + endif + endif + endif + + else + ## Conv. specifier. Peek if next fmt_word needs split from current column + if (ii < num_words_per_line) + if (idf(ii+1) && (! isempty (strfind (words{icol, 1}, fmt_words{ii+1})))) + --icol; + elseif (idg(ii+1)) + --icol; + endif + endif + endif + ## Next fmt_word, next column + ++ii; ++icol; + endwhile + + ## Done. Reshape words back into 1 long vector and strip padded empty words + words = reshape (words, 1, numel (words))(1 : end-num_words_padded); + + catch + warning ("strread: unable to parse text or file with given format string"); + return; + + end_try_catch + endif + + ## For each specifier, process corresponding column k = 1; for m = 1:num_words_per_line - data = words (m:num_words_per_line:end); - ## Map to format - ## FIXME - add support for formats like "%4s" or "<%s>", "%[a-zA-Z]" - ## Someone with regexp experience is needed. - switch fmt_words{m} - case "%s" - data (end+1:num_lines) = {""}; - varargout {k} = data'; - k++; - case {"%d", "%f"} - n = cellfun (@isempty, data); - data = str2double (data); - data(n) = numeric_fill_value; - data (end+1:num_lines) = numeric_fill_value; - varargout {k} = data.'; - k++; - case {"%*", "%*s"} - ## skip the word - otherwise - ## Ensure descriptive content is consistent - if (numel (unique (data)) > 1 - || ! strcmpi (unique (data), fmt_words{m})) - error ("strread: FORMAT does not match data"); - endif - endswitch + try + if (format_repeat_count < 0) + data = words(m:num_words_per_line:end); + elseif (format_repeat_count == 0) + data = {}; + else + lastline = ... + min (num_words_per_line * format_repeat_count + m - 1, numel (words)); + data = words(m:num_words_per_line:lastline); + endif + + ## Map to format + ## FIXME - add support for formats like "<%s>", "%[a-zA-Z]" + ## Someone with regexp experience is needed. + switch fmt_words{m}(1:min (2, length (fmt_words{m}))) + case "%s" + if (pad_out) + data(end+1:num_lines) = {""}; + endif + varargout{k} = data'; + k++; + case {"%d", "%u", "%f", "%n"} + n = cellfun ("isempty", data); + ### FIXME - erroneously formatted data lead to NaN, not an error + data = str2double (data); + if (! isempty (regexp (fmt_words{m}, "%[du]"))) + ## Cast to integer + ## FIXME: NaNs will be transformed into zeros + data = int32 (data); + endif + data(n) = numeric_fill_value; + if (pad_out) + data(end+1:num_lines) = numeric_fill_value; + endif + varargout{k} = data.'; + k++; + case {"%0", "%1", "%2", "%3", "%4", "%5", "%6", "%7", "%8", "%9"} + nfmt = strsplit (fmt_words{m}(2:end-1), '.'); + swidth = str2double (nfmt{1}); + switch fmt_words{m}(end) + case {"d", "u", "f", "n%"} + n = cellfun ("isempty", data); + ### FIXME - erroneously formatted data lead to NaN, not an error + ### => ReturnOnError can't be implemented for numeric data + data = str2double (strtrunc (data, swidth)); + data(n) = numeric_fill_value; + if (pad_out) + data(end+1:num_lines) = numeric_fill_value; + endif + if (numel (nfmt) > 1) + sprec = str2double (nfmt{2}); + data = 10^-sprec * round (10^sprec * data); + elseif (! isempty (regexp (fmt_words{m}, "[du]"))) + ## Cast to integer + ## FIXME: NaNs will be transformed into zeros + data = int32 (data); + endif + varargout{k} = data.'; + k++; + case "s" + if (pad_out) + data(end+1:num_lines) = {""} + endif + varargout{k} = strtrunc (data, swidth)'; + k++; + otherwise + endswitch + case {"%*", "%*s"} + ## skip the word + otherwise + ## Ensure descriptive content is consistent. + ## Test made a bit lax to accomodate for incomplete last lines + n = find (! cellfun ("isempty", data)); + if (numel (unique (data(n))) > 1 + || ! strcmpi (unique (data), fmt_words{m})) + error ("strread: FORMAT does not match data"); + endif + endswitch + catch + ## As strread processes columnwise, ML-compatible error processing + ## (row after row) is not feasible. In addition Octave sets unrecognizable + ## numbers to NaN w/o error. But maybe Octave is better in this respect. + if (err_action) + ## Just try the next column where ML bails out + else + rethrow (lasterror); + endif + end_try_catch endfor + endfunction -function out = split_by (text, sep) - sep = union (sep, "\n"); - pat = sprintf ('[^%s]+', sep); - [~, ~, ~, out] = regexp (text, pat); - out(cellfun (@isempty, out)) = {""}; - out = strtrim (out); +function out = split_by (text, sep, mult_dlms_s1, eol_char) + + ## Check & if needed, process MultipleDelimsAsOne parameter + if (mult_dlms_s1) + mult_dlms_s1 = true; + ## FIXME: Should re-implement strsplit() function here in order + ## to avoid strrep on megabytes of data. + ## If \n is in sep collection we need to enclose it in text + ## to avoid it being included in consecutive delim series + enchr = ' '; + ## However watch out if eol_char is also in delimiters + if (index (sep, eol_char)); enchr = char(255); endif + text = strrep (text, eol_char, [enchr eol_char enchr]); + else + mult_dlms_s1 = false; + endif + + ## Split text string along delimiters + out = strsplit (text, sep, mult_dlms_s1); + if (index (sep, eol_char)); out = strrep (out, char(255), ''); endif + ## In case of trailing delimiter, strip stray last empty word + if (!isempty (out) && any (sep == text(end))) + out(end) = []; + endif + + ## Empty cells converted to empty cellstrings. + out(cellfun ("isempty", out)) = {""}; + endfunction + %!test %! [a, b] = strread ("1 2", "%f%f"); -%! assert (a == 1 && b == 2); - -%!test -%! str = "# comment\n# comment\n1 2 3"; -%! [a, b] = strread (str, '%d %s', 'commentstyle', 'shell'); -%! assert (a, [1; 3]); -%! assert (b, {"2"; ""}); +%! assert (a, 1); +%! assert (b, 2); %!test %! str = ''; %! a = rand (10, 1); -%! b = char (round (65 + 20 * rand (10, 1))); +%! b = char (randi ([65, 85], 10, 1)); %! for k = 1:10 -%! str = sprintf ('%s %.6f %s\n', str, a (k), b (k)); +%! str = sprintf ('%s %.6f %s\n', str, a(k), b(k)); %! endfor %! [aa, bb] = strread (str, '%f %s'); -%! assert (a, aa, 1e-5); +%! assert (a, aa, 1e-6); %! assert (cellstr (b), bb); %!test %! str = ''; %! a = rand (10, 1); -%! b = char (round (65 + 20 * rand (10, 1))); +%! b = char (randi ([65, 85], 10, 1)); %! for k = 1:10 -%! str = sprintf ('%s %.6f %s\n', str, a (k), b (k)); +%! str = sprintf ('%s %.6f %s\n', str, a(k), b(k)); %! endfor %! aa = strread (str, '%f %*s'); -%! assert (a, aa, 1e-5); +%! assert (a, aa, 1e-6); %!test %! str = sprintf ('/* this is\nacomment*/ 1 2 3'); @@ -283,6 +764,12 @@ %! assert (a, [1; 2; 3]); %!test +%! str = "# comment\n# comment\n1 2 3"; +%! [a, b] = strread (str, '%n %s', 'commentstyle', 'shell', 'endofline', "\n"); +%! assert (a, [1; 3]); +%! assert (b, {"2"}); + +%!test %! str = sprintf ("Tom 100 miles/hr\nDick 90 miles/hr\nHarry 80 miles/hr"); %! fmt = "%s %f miles/hr"; %! c = cell (1, 2); @@ -294,3 +781,110 @@ %! a = strread ("a b c, d e, , f", "%s", "delimiter", ","); %! assert (a, {"a b c"; "d e"; ""; "f"}); +%!test +%! # Bug #33536 +%! [a, b, c] = strread ("1,,2", "%s%s%s", "delimiter", ","); +%! assert (a{1}, '1'); +%! assert (b{1}, ''); +%! assert (c{1}, '2'); + +%!test +%! # Bug #33536 +%! a = strread ("[SomeText]", "[%s", "delimiter", "]"); +%! assert (a{1}, "SomeText"); + +%!test +%! dat = "Data file.\r\n= = = = =\r\nCOMPANY : <Company name>\r\n"; +%! a = strread (dat, "%s", 'delimiter', "\n", 'whitespace', '', 'endofline', "\r\n"); +%! assert (a{2}, "= = = = ="); +%! assert (double (a{3}(end-5:end)), [32 110 97 109 101 62]); + +%!test +%! [a, b, c, d] = strread ("1,2,3,,5,6", "%d%f%d%f", 'delimiter', ','); +%! assert (c, int32 (3)); +%! assert (d, NaN); + +%!test +%! [a, b, c, d] = strread ("1,2,3,,5,6\n", "%d%d%f%d", 'delimiter', ','); +%! assert (c, [3; NaN]); +%! assert (d, int32 ([0; 0])); + +%!test +%! # Default format (= %f) +%1 [a, b, c] = strread ("0.12 0.234 0.3567"); +%1 assert (a, 0.12); +%1 assert (b, 0.234); +%1 assert (c, 0.3567); + +%!test +%! [a, b] = strread('0.41 8.24 3.57 6.24 9.27', "%f%f", 2, 'delimiter', ' '); +%1 assert (a, [0.41; 3.57]); + +%!test +%! # TreatAsEmpty +%! [a, b, c, d] = strread ("1,2,3,NN,5,6\n", "%d%d%d%f", 'delimiter', ',', 'TreatAsEmpty', 'NN'); +%! assert (c, int32 ([3; 0])); +%! assert (d, [NaN; NaN]); + +%!test +%! # No delimiters at all besides EOL. Plain reading numbers & strings +%! str = "Text1Text2Text\nText398Text4Text\nText57Text"; +%! [a, b] = strread (str, "Text%dText%1sText"); +%! assert (a, int32 ([1; 398; 57])); +%! assert (b(1:2), {'2'; '4'}); +%! assert (isempty (b{3}), true); + +%% MultipleDelimsAsOne +%!test +%! str = "11, 12, 13,, 15\n21,, 23, 24, 25\n,, 33, 34, 35"; +%! [a b c d] = strread (str, "%f %f %f %f", 'delimiter', ',', 'multipledelimsasone', 1, 'endofline', "\n"); +%! assert (a', [11, 21, NaN]); +%! assert (b', [12, 23, 33]); +%! assert (c', [13, 24, 34]); +%! assert (d', [15, 25, 35]); + +%% delimiter as sq_string and dq_string +%!test +%! assert (strread ("1\n2\n3", "%d", "delimiter", "\n"), +%! strread ("1\n2\n3", "%d", "delimiter", '\n')) + +%% whitespace as sq_string and dq_string +%!test +%! assert (strread ("1\b2\r3\b4\t5", "%d", "whitespace", "\b\r\n\t"), +%! strread ("1\b2\r3\b4\t5", "%d", "whitespace", '\b\r\n\t')) + +%!test +%! str = "0.31 0.86 0.94\n 0.60 0.72 0.87"; +%! fmt = "%f %f %f"; +%! args = {"delimiter", " ", "endofline", "\n", "whitespace", " "}; +%! [a, b, c] = strread (str, fmt, args {:}); +%! assert (a, [0.31; 0.60], 0.01) +%! assert (b, [0.86; 0.72], 0.01) +%! assert (c, [0.94; 0.87], 0.01) + +%!test +%! str = "0.31,0.86,0.94\n0.60,0.72,0.87"; +%! fmt = "%f %f %f"; +%! args = {"delimiter", ",", "endofline", "\n", "whitespace", " "}; +%! [a, b, c] = strread (str, fmt, args {:}); +%! assert (a, [0.31; 0.60], 0.01) +%! assert (b, [0.86; 0.72], 0.01) +%! assert (c, [0.94; 0.87], 0.01) + +%!test +%! str = "0.31 0.86 0.94\n 0.60 0.72 0.87"; +%! fmt = "%f %f %f"; +%! args = {"delimiter", ",", "endofline", "\n", "whitespace", " "}; +%! [a, b, c] = strread (str, fmt, args {:}); +%! assert (a, [0.31; 0.60], 0.01) +%! assert (b, [0.86; 0.72], 0.01) +%! assert (c, [0.94; 0.87], 0.01) + +%!test +%! str = "0.31, 0.86, 0.94\n 0.60, 0.72, 0.87"; +%! fmt = "%f %f %f"; +%! args = {"delimiter", ",", "endofline", "\n", "whitespace", " "}; +%! [a, b, c] = strread (str, fmt, args {:}); +%! assert (a, [0.31; 0.60], 0.01) +%! assert (b, [0.86; 0.72], 0.01) +%! assert (c, [0.94; 0.87], 0.01)
--- a/scripts/io/textread.m +++ b/scripts/io/textread.m @@ -19,30 +19,43 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}) ## @deftypefnx {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}, @var{format}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}, @var{format}, @var{n}) ## @deftypefnx {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}, @var{format}, @var{prop1}, @var{value1}, @dots{}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}, @var{format}, @var{n}, @var{prop1}, @var{value1}, @dots{}) ## Read data from a text file. ## ## The file @var{filename} is read and parsed according to @var{format}. The ## function behaves like @code{strread} except it works by parsing a file -## instead -## of a string. See the documentation of @code{strread} for details. +## instead of a string. See the documentation of @code{strread} for details. +## ## In addition to the options supported by @code{strread}, this function -## supports one more: +## supports two more: +## ## @itemize ## @item "headerlines": +## The first @var{value} number of lines of @var{filename} are skipped. +## +## @item "endofline": +## Specify a single character or "\r\n". If no value is given, it will be +## inferred from the file. If set to "" (empty string) EOLs are ignored as +## delimiters. ## @end itemize -## The first @var{value} number of lines of @var{str} are skipped. -## @seealso{strread, load, dlmread, fscanf} +## +## The optional input @var{n} specifes the number of times to use +## @var{format} when parsing, i.e., the format repeat count. +## +## @seealso{strread, load, dlmread, fscanf, textscan} ## @end deftypefn function varargout = textread (filename, format = "%f", varargin) + ## Check input if (nargin < 1) print_usage (); endif - if (!ischar (filename) || !ischar (format)) - error ("textread: first and second input arguments must be strings"); + if (! ischar (filename) || ! ischar (format)) + error ("textread: FILENAME and FORMAT arguments must be strings"); endif ## Read file @@ -51,17 +64,85 @@ error ("textread: could not open '%s' for reading", filename); endif - ## Maybe skip header lines + ## Skip header lines if requested headerlines = find (strcmpi (varargin, "headerlines"), 1); - if (! isempty (headerlines)) - fskipl (fid, headerlines); + ## Beware of zero valued headerline, fskipl would skip to EOF + if (! isempty (headerlines) && (varargin{headerlines + 1} > 0)) + fskipl (fid, varargin{headerlines + 1}); varargin(headerlines:headerlines+1) = []; endif - str = fread (fid, "char=>char").'; + if (nargin > 2 && isnumeric (varargin{1})) + nlines = varargin{1}; + else + nlines = Inf; + endif + + if (isfinite (nlines) && (nlines >= 0)) + str = tmp_str = ""; + n = 0; + ## FIXME: Can this be done without slow loop? + while (ischar (tmp_str) && n++ <= nlines) + str = strcat (str, tmp_str); + tmp_str = fgets (fid); + endwhile + else + str = fread (fid, "char=>char").'; + endif fclose (fid); + if (isempty (str)) + warning ("textread: empty file"); + return; + endif + + endofline = find (strcmpi (varargin, "endofline"), 1); + if (! isempty (endofline)) + ## 'endofline' option set by user. + if (! ischar (varargin{endofline + 1})); + error ("textread: character value required for EndOfLine"); + endif + else + ## Determine EOL from file. Search for EOL candidates in first 3000 chars + eol_srch_len = min (length (str), 3000); + ## First try DOS (CRLF) + if (! isempty (findstr ("\r\n", str(1 : eol_srch_len)))) + eol_char = "\r\n"; + ## Perhaps old Macintosh? (CR) + elseif (! isempty (findstr ("\r", str(1 : eol_srch_len)))) + eol_char = "\r"; + ## Otherwise, use plain UNIX (LF) + else + eol_char = "\n"; + endif + ## Set up default endofline param value + varargin(end+1:end+2) = {'endofline', eol_char}; + endif + + ## Set up default whitespace param value if needed + if (isempty (find (strcmpi ('whitespace', varargin)))) + varargin(end+1:end+2) = {'whitespace', " \b\t"}; + endif + ## Call strread to make it do the real work [varargout{1:max (nargout, 1)}] = strread (str, format, varargin {:}); endfunction + + +%!test +%! f = tmpnam(); +%! d = rand (5, 3); +%! dlmwrite (f, d, 'precision', '%5.2f'); +%! [a, b, c] = textread (f, "%f %f %f", "delimiter", ",", "headerlines", 3); +%! unlink(f); +%! assert (a, d(4:5, 1), 1e-2); +%! assert (b, d(4:5, 2), 1e-2); +%! assert (c, d(4:5, 3), 1e-2); + +%% Test input validation +%!error textread () +%!error textread (1) +%!error <arguments must be strings> textread (1, '%f') +%!error <arguments must be strings> textread ("fname", 1) +
--- a/scripts/io/textscan.m +++ b/scripts/io/textscan.m @@ -18,30 +18,44 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{C} =} textscan (@var{fid}, @var{format}) -## @deftypefnx {Function File} {@var{C} =} textscan (@var{fid}, @var{format}, @ -## @var{n}) -## @deftypefnx {Function File} {@var{C} =} textscan (@var{fid}, @var{format}, @ -## @var{param}, @var{value}, @dots{}) -## @deftypefnx {Function File} {@var{C} =} textscan (@var{fid}, @var{format}, @ -## @var{n}, @var{param}, @var{value}, @dots{}) +## @deftypefnx {Function File} {@var{C} =} textscan (@var{fid}, @var{format}, @var{n}) +## @deftypefnx {Function File} {@var{C} =} textscan (@var{fid}, @var{format}, @var{param}, @var{value}, @dots{}) +## @deftypefnx {Function File} {@var{C} =} textscan (@var{fid}, @var{format}, @var{n}, @var{param}, @var{value}, @dots{}) ## @deftypefnx {Function File} {@var{C} =} textscan (@var{str}, @dots{}) -## @deftypefnx {Function File} {[@var{C}, @var{position}] =} textscan (@dots{}) -## Read data from a text file. +## @deftypefnx {Function File} {[@var{C}, @var{position}] =} textscan (@var{fid}, @dots{}) +## Read data from a text file or string. ## ## The file associated with @var{fid} is read and parsed according to ## @var{format}. The function behaves like @code{strread} except it works by ## parsing a file instead of a string. See the documentation of -## @code{strread} for details. In addition to the options supported by -## @code{strread}, this function supports one more: +## @code{strread} for details. +## +## In addition to the options supported by +## @code{strread}, this function supports a few more: +## ## @itemize +## @item "collectoutput": +## A value of 1 or true instructs textscan to concatenate consecutive columns +## of the same class in the output cell array. A value of 0 or false (default) +## leaves output in distinct columns. +## +## @item "endofline": +## Specify "\r", "\n" or "\r\n" (for CR, LF, or CRLF). If no value is given, +## it will be inferred from the file. If set to "" (empty string) EOLs are +## ignored as delimiters and added to whitespace. +## ## @item "headerlines": +## The first @var{value} number of lines of @var{fid} are skipped. +## +## @item "returnonerror": +## If set to numerical 1 or true (default), return normally when read errors +## have been encountered. If set to 0 or false, return an error and no data. ## @end itemize -## The first @var{value} number of lines of @var{str} are skipped. ## -## The optional input, @var{n}, specifes the number of lines to be read from -## the file, associated with @var{fid}. +## The optional input @var{n} specifes the number of times to use +## @var{format} when parsing, i.e., the format repeat count. ## -## The output, @var{C}, is a cell array whose length is given by the number +## The output @var{C} is a cell array whose length is given by the number ## of format specifiers. ## ## The second output, @var{position}, provides the position, in characters, @@ -50,86 +64,208 @@ ## @seealso{dlmread, fscanf, load, strread, textread} ## @end deftypefn -function [C, p] = textscan (fid, format, varargin) +function [C, position] = textscan (fid, format = "%f", varargin) ## Check input if (nargin < 1) print_usage (); - elseif (nargin == 1 || isempty (format)) + endif + + if (isempty (format)) format = "%f"; endif - if (nargin > 2 && isnumeric (varargin{1})) - nlines = varargin{1}; - args = varargin(2:end); + if (! (isa (fid, "double") && fid > 0) && ! ischar (fid)) + error ("textscan: first argument must be a file id or character string"); + endif + + if (! ischar (format)) + error ("textscan: FORMAT must be a string"); + endif + + args = varargin; + if (nargin > 2 && isnumeric (args{1})) + nlines = args{1}; else nlines = Inf; - args = varargin; endif if (! any (strcmpi (args, "emptyvalue"))) ## Matlab returns NaNs for missing values - args{end+1} = "emptyvalue"; - args{end+1} = NaN; + args(end+1:end+2) = {'emptyvalue', NaN}; + endif + + ## Check default parameter values that differ for strread & textread + + ipos = find (strcmpi (args, "whitespace")); + if (isempty (ipos)) + ## Matlab default whitespace = " \b\t" + args(end+1:end+2) = {'whitespace', " \b\t"}; + whitespace = " \b\t"; + else + ## Check if there's at least one string format specifier + fmt = strrep (format, "%", " %"); + fmt = regexp (fmt, '[^ ]+', 'match'); + fmt = strtrim (fmt(strmatch ("%", fmt))) + has_str_fmt = all (cellfun ("isempty", strfind (strtrim (fmt(strmatch ("%", fmt))), 's'))); + ## If there is a format, AND whitespace value = empty, + ## don't add a space (char(32)) to whitespace + if (! (isempty (args{ipos+1}) && has_str_fmt)) + args{ipos+1} = unique ([" ", whitespace]); + endif + endif + + if (! any (strcmpi (args, "delimiter"))) + ## Matlab says default delimiter = whitespace. + ## strread() will pick this up further + args(end+1:end+2) = {'delimiter', ""}; + endif + + collop = false; + ipos = find (strcmpi (args, "collectoutput")); + if (! isempty (ipos)) + ## Search & concatenate consecutive columns of same class requested + if (isscalar (args{ipos+1}) + && (islogical (args{ipos+1}) || isnumeric (args{ipos+1}))) + collop = args{ipos+1}; + else + warning ("textscan: illegal value for CollectOutput parameter - ignored"); + endif + ## Remove argument before call to strread() below + args(ipos:ipos+1) = []; + endif + + if (any (strcmpi (args, "returnonerror"))) + ## Because of the way strread() reads data (columnwise) this parameter + ## can't be neatly implemented. strread() will pick it up anyway + warning ('textscan: ReturnOnError is not fully implemented'); + else + ## Set default value (=true) + args(end+1:end+2) = {"returnonerror", 1}; + endif + + if (ischar (fid)) + ## Read from a text string + if (nargout == 2) + error ("textscan: cannot provide position information for character input"); + endif + str = fid; + else + ## Skip header lines if requested + headerlines = find (strcmpi (args, "headerlines"), 1); + ## Beware of zero valued headerline, fskipl would skip to EOF + if (! isempty (headerlines) && (args{headerlines + 1} > 0)) + fskipl (fid, varargin{headerlines + 1}); + args(headerlines:headerlines+1) = []; + endif + if (isfinite (nlines) && (nlines >= 0)) + str = tmp_str = ""; + n = 0; + ## FIXME: Can this be done without slow loop? + while (ischar (tmp_str) && n++ < nlines) + tmp_str = fgets (fid); + if (ischar (tmp_str)) + str = strcat (str, tmp_str); + endif + endwhile + else + str = fread (fid, "char=>char").'; + endif endif - if (isa (fid, "double") && fid > 0 || ischar (fid)) - if (ischar (format)) - if (ischar (fid)) - if (nargout == 2) - error ("textscan: cannot provide position information for character input"); - endif - str = fid; - else - ## Maybe skip header lines - headerlines = find (strcmpi (args, "headerlines"), 1); - if (! isempty (headerlines)) - fskipl (fid, headerlines); - args(headerlines:headerlines+1) = []; - endif - if (isfinite (nlines)) - str = ""; - for n = 1:nlines - str = strcat (str, fgets (fid)); - endfor - else - str = fread (fid, "char=>char").'; - endif + ## Check for empty result + if (isempty (str)) + warning ("textscan: no data read"); + C = []; + return; + endif + + ## Check value of 'endofline'. String or file doesn't seem to matter + endofline = find (strcmpi (args, "endofline"), 1); + if (! isempty (endofline)) + if (ischar (args{endofline + 1})) + eol_char = args{endofline + 1}; + if (isempty (strmatch (eol_char, {"", "\n", "\r", "\r\n"}, 'exact'))) + error ("textscan: illegal EndOfLine character value specified"); endif - - ## Determine the number of data fields - num_fields = numel (strfind (format, "%")) - ... - numel (idx_star = strfind (format, "%*")); - - ## Call strread to make it do the real work - C = cell (1, num_fields); - [C{:}] = strread (str, format, args{:}); - - if (ischar (fid) && isfinite (nlines)) - C = cellfun (@(x) x(1:nlines), C, "uniformoutput", false); - endif - - if (nargout == 2) - p = ftell (fid); - endif - else - error ("textscan: FORMAT must be a valid specification"); + error ("textscan: character value required for EndOfLine"); endif else - error ("textscan: first argument must be a file id or character string"); + ## Determine EOL from file. Search for EOL candidates in first 3000 chars + eol_srch_len = min (length (str), 3000); + ## First try DOS (CRLF) + if (! isempty (findstr ("\r\n", str(1 : eol_srch_len)))) + eol_char = "\r\n"; + ## Perhaps old Macintosh? (CR) + elseif (! isempty (findstr ("\r", str(1 : eol_srch_len)))) + eol_char = "\r"; + ## Otherwise, use plain UNIX (LF) + else + eol_char = "\n"; + endif + ## Set up the default endofline param value + args(end+1:end+2) = {'endofline', eol_char}; + endif + + ## Determine the number of data fields + num_fields = numel (strfind (format, "%")) - numel (strfind (format, "%*")); + + ## Strip trailing EOL to avoid returning stray missing values (f. strread) + if (strcmp (str(end-length (eol_char) + 1 : end), eol_char)); + str(end-length (eol_char) + 1 : end) = ""; + endif + + ## Call strread to make it do the real work + C = cell (1, num_fields); + [C{:}] = strread (str, format, args{:}); + + ## If requested, collect output columns of same class + if (collop) + C = colloutp (C); endif + if (nargout == 2) + position = ftell (fid); + endif + +endfunction + + +## Collect consecutive columns of same class into one cell column +function C = colloutp (C) + + ## Start at rightmost column and work backwards to avoid ptr mixup + ii = numel (C); + while ii > 1 + clss1 = class (C{ii}); + jj = ii; + while (jj > 1 && strcmp (clss1, class (C{jj - 1}))) + ## Column to the left is still same class; check next column to the left + --jj; + endwhile + if (jj < ii) + ## Concatenate columns into current column + C{jj} = [C{jj : ii}]; + ## Wipe concatenated columns to the right, resume search to the left + C(jj+1 : ii) = []; + ii = jj - 1; + else + ## No similar class in column to the left, search from there + --ii; + endif + endwhile + endfunction %!test %! str = "1, 2, 3, 4\n 5, , , 8\n 9, 10, 11, 12"; %! fmtstr = "%f %d %f %s"; %! c = textscan (str, fmtstr, 2, "delimiter", ",", "emptyvalue", -Inf); -%! assert (isequal (c{1}, [1;5])) +%! assert (isequal (c{1}, [1;5])); %! assert (length (c{1}), 2); -%! assert (iscellstr (c{4})) -%! assert (isequal (c{3}, [3; -Inf])) +%! assert (iscellstr (c{4})); +%! assert (isequal (c{3}, [3; -Inf])); %!test %! b = [10:10:100]; @@ -137,7 +273,60 @@ %! str = sprintf ("%g miles/hr = %g kilometers/hr\n", b); %! fmt = "%f miles/hr = %f kilometers/hr"; %! c = textscan (str, fmt); -%! assert (b(1,:)', c{1}) -%! assert (b(2,:)', c{2}) +%! assert (b(1,:)', c{1}, 1e-5); +%! assert (b(2,:)', c{2}, 1e-5); + +#%!test +#%! str = "13, 72, NA, str1, 25\r\n// Middle line\r\n36, na, 05, str3, 6"; +#%! a = textscan(str, '%d %n %f %s %n', 'delimiter', ',','treatAsEmpty', {'NA', 'na'},'commentStyle', '//'); +#%! assert (a{1}, int32([13; 36])); +#%! assert (a{2}, [72; NaN]); +#%! assert (a{3}, [NaN; 5]); +#%! assert (a{4}, {"str1"; "str3"}); +#%! assert (a{5}, [25; 6]); + +%!test +%! str = "Km:10 = hhhBjjj miles16hour\r\n"; +%! str = [str "Km:15 = hhhJjjj miles241hour\r\n"]; +%! str = [str "Km:2 = hhhRjjj miles3hour\r\n"]; +%! str = [str "Km:25 = hhhZ\r\n"]; +%! fmt = "Km:%d = hhh%1sjjj miles%dhour"; +%! a = textscan (str, fmt, 'delimiter', ' '); +%! assert (a{1}', int32([10 15 2 25])); +%! assert (a{2}', {'B' 'J' 'R' 'Z'}); +%! assert (a{3}', int32([16 241 3 0])); + +%% Test with default endofline parameter +%!test +%! c = textscan ("L1\nL2", "%s"); +%! assert (c{:}, {"L1"; "L2"}); +%% Test with endofline parameter set to '' (empty) - newline should be in word +%!test +%! c = textscan ("L1\nL2", "%s", 'endofline', ''); +%! assert (int8(c{:}{:}), int8([ 76, 49, 10, 76, 50 ])); +%!test +%! # No delimiters at all besides EOL. Skip fields, even empty fields +%! str = "Text1Text2Text\nTextText4Text\nText57Text"; +%! c = textscan (str, "Text%*dText%dText"); +%! assert (c{1}, int32 ([2; 4; 0])); + +%!test +%% CollectOutput test +%! b = [10:10:100]; +%! b = [b; 8*b/5; 8*b*1000/5]; +%! str = sprintf ("%g miles/hr = %g (%g) kilometers (meters)/hr\n", b); +%! fmt = "%f miles%s %s %f (%f) kilometers %*s"; +%! c = textscan (str, fmt, 'collectoutput', 1); +%! assert (size(c{3}), [10, 2]); +%! assert (size(c{2}), [10, 2]); + +%% Test input validation +%!error textscan () +%!error textscan (single (4)) +%!error textscan ({4}) +%!error <must be a string> textscan ("Hello World", 2) +%!error <cannot provide position information> [C, pos] = textscan ("Hello World") +%!error <character value required> textscan ("Hello World", '%s', 'EndOfLine', 3) +
--- a/scripts/linear-algebra/commutation_matrix.m +++ b/scripts/linear-algebra/commutation_matrix.m @@ -76,12 +76,12 @@ if (nargin < 1 || nargin > 2) print_usage (); else - if (! (isscalar (m) && m == round (m) && m > 0)) + if (! (isscalar (m) && m == fix (m) && m > 0)) error ("commutation_matrix: M must be a positive integer"); endif if (nargin == 1) n = m; - elseif (! (isscalar (n) && n == round (n) && n > 0)) + elseif (! (isscalar (n) && n == fix (n) && n > 0)) error ("commutation_matrix: N must be a positive integer"); endif endif @@ -95,3 +95,25 @@ endfor endfunction + +%!test +%! c = commutation_matrix(1,1); +%! assert(c,1); + +%!test +%! A = rand(3,5); +%! vc = vec(A); +%! vr = vec(A'); +%! c = commutation_matrix(3,5); +%! assert(c*vc,vr); + +%!test +%! A = rand(4,6); +%! vc = vec(A); +%! vr = vec(A'); +%! c = commutation_matrix(4,6); +%! assert(c*vc,vr); + +%!error commutation_matrix(0,0); +%!error commutation_matrix(1,0); +%!error commutation_matrix(0,1);
--- a/scripts/linear-algebra/cond.m +++ b/scripts/linear-algebra/cond.m @@ -19,9 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} cond (@var{A}) ## @deftypefnx {Function File} {} cond (@var{A}, @var{p}) -## Compute the @var{p}-norm condition number of a matrix. @code{cond -## (@var{A})} is -## defined as +## Compute the @var{p}-norm condition number of a matrix. +## +## @code{cond (@var{A})} is ## defined as ## @tex ## $ {\parallel A \parallel_p * \parallel A^{-1} \parallel_p .} $ ## @end tex
--- a/scripts/linear-algebra/cross.m +++ b/scripts/linear-algebra/cross.m @@ -33,7 +33,7 @@ ## along the first dimension with 3 elements. The optional argument ## @var{dim} forces the cross product to be calculated along ## the specified dimension. -## @seealso{dot} +## @seealso{dot, curl, divergence} ## @end deftypefn ## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> @@ -90,3 +90,26 @@ endif endfunction + +%!test +%! x = [1 0 0]; +%! y = [0 1 0]; +%! r = [0 0 1]; +%! assert(cross(x, y), r, 2e-8); + +%!test +%! x = [1 2 3]; +%! y = [4 5 6]; +%! r = [(2*6-3*5) (3*4-1*6) (1*5-2*4)]; +%! assert(cross(x, y), r, 2e-8); + +%!test +%! x = [1 0 0; 0 1 0; 0 0 1]; +%! y = [0 1 0; 0 0 1; 1 0 0]; +%! r = [0 0 1; 1 0 0; 0 1 0]; +%! assert(cross(x, y, 2), r, 2e-8); +%! assert(cross(x, y, 1), -r, 2e-8); + +%!error cross(0,0); +%!error cross(); +
--- a/scripts/linear-algebra/duplication_matrix.m +++ b/scripts/linear-algebra/duplication_matrix.m @@ -68,7 +68,7 @@ print_usage (); endif - if (! (isscalar (n) && n == round (n) && n > 0)) + if (! (isscalar (n) && n > 0 && n == fix (n))) error ("duplication_matrix: N must be a positive integer"); endif @@ -86,3 +86,35 @@ endfor endfunction + +%!test +%! N = 2; +%! A = rand(N); +%! B = A * A'; +%! C = A + A'; +%! D = duplication_matrix (N); +%! assert (D * vech (B), vec (B), 1e-6); +%! assert (D * vech (C), vec (C), 1e-6); + +%!test +%! N = 3; +%! A = rand(N); +%! B = A * A'; +%! C = A + A'; +%! D = duplication_matrix (N); +%! assert (D * vech (B), vec (B), 1e-6); +%! assert (D * vech (C), vec (C), 1e-6); + +%!test +%! N = 4; +%! A = rand(N); +%! B = A * A'; +%! C = A + A'; +%! D = duplication_matrix (N); +%! assert (D * vech (B), vec (B), 1e-6); +%! assert (D * vech (C), vec (C), 1e-6); + +%!error duplication_matrix (); +%!error duplication_matrix (0.5); +%!error duplication_matrix (-1); +%!error duplication_matrix (ones(1,4));
--- a/scripts/linear-algebra/expm.m +++ b/scripts/linear-algebra/expm.m @@ -68,6 +68,7 @@ ## @code{Dq(A)} ## @end ifnottex ## is ill-conditioned. +## @seealso{logm, sqrtm} ## @end deftypefn function r = expm (A)
--- a/scripts/linear-algebra/housh.m +++ b/scripts/linear-algebra/housh.m @@ -23,8 +23,8 @@ ## ## @example ## @group -## (I - beta*housv*housv')x = norm(x)*e(j) if x(1) < 0, -## (I - beta*housv*housv')x = -norm(x)*e(j) if x(1) >= 0 +## (I - beta*housv*housv')x = norm(x)*e(j) if x(j) < 0, +## (I - beta*housv*housv')x = -norm(x)*e(j) if x(j) >= 0 ## @end group ## @end example ## @@ -91,3 +91,43 @@ endif endfunction + +%!test +%! x = [1 2 3]'; +%! j = 3; +%! [hv, b, z] = housh(x, j, 0); +%! r = (eye(3) - b*hv*hv') * x; +%! d = - norm(x) * [0 0 1]'; +%! assert(r, d, 2e-8); +%! assert(z, 0, 2e-8); + +%!test +%! x = [7 -3 1]'; +%! j = 2; +%! [hv, b, z] = housh(x, j, 0); +%! r = (eye(3) - b*hv*hv') * x; +%! d = norm(x) * [0 1 0]'; +%! assert(r, d, 2e-8); +%! assert(z, 0, 2e-8); + +%!test +%! x = [1 0 0]'; +%! j = 1; +%! [hv, b, z] = housh(x, j, 10); +%! r = (eye(3) - b*hv*hv') * x; +%! d = norm(x) * [1 0 0]'; +%! assert(r, d, 2e-8); +%! assert(z, 1, 2e-8); + +%!test +%! x = [5 0 4 1]'; +%! j = 2; +%! [hv, b, z] = housh(x, j, 0); +%! r = (eye(4) - b*hv*hv') * x; +%! d = - norm(x) * [0 1 0 0]'; +%! assert(r, d, 2e-8); +%! assert(z, 0, 2e-8); + +%!error housh([0]); +%!error housh(); +
--- a/scripts/linear-algebra/isdefinite.m +++ b/scripts/linear-algebra/isdefinite.m @@ -37,16 +37,16 @@ print_usage (); endif - if (! ishermitian (x)) - error ("isdefinite: X must be a hermitian matrix"); - endif - if (! isfloat (x)) x = double (x); endif if (nargin == 1) - tol = 100 * eps(class (x)) * norm (x, "fro"); + tol = 100 * eps (class (x)) * norm (x, "fro"); + endif + + if (! ishermitian (x, tol)) + error ("isdefinite: X must be a Hermitian matrix"); endif e = tol * eye (rows (x)); @@ -63,3 +63,25 @@ endif endfunction + + +%!test +%! A = [-1 0; 0 -1]; +%! assert (isdefinite (A), -1) + +%!test +%! A = [1 0; 0 1]; +%! assert (isdefinite (A), 1) + +%!test +%! A = [2 -1 0; -1 2 -1; 0 -1 2]; +%! assert (isdefinite (A), 1) + +%!test +%! A = [1 0; 0 0]; +%! assert (isdefinite (A), 0) + +%!error isdefinite () +%!error isdefinite (1,2,3) +%!error <X must be a Hermitian matrix> isdefinite ([1 2; 3 4]) +
--- a/scripts/linear-algebra/krylov.m +++ b/scripts/linear-algebra/krylov.m @@ -28,8 +28,8 @@ ## Using Householder reflections to guard against loss of orthogonality. ## ## If @var{V} is a vector, then @var{h} contains the Hessenberg matrix -## such that @code{a*u == u*h+rk*ek'}, in which @code{rk = -## a*u(:,k)-u*h(:,k)}, and @code{ek'} is the vector +## such that @nospell{@xcode{a*u == u*h+rk*ek'}}, in which @code{rk = +## a*u(:,k)-u*h(:,k)}, and @nospell{@xcode{ek'}} is the vector ## @code{[0, 0, @dots{}, 1]} of length @code{k}. Otherwise, @var{h} is ## meaningless. ##
--- a/scripts/linear-algebra/logm.m +++ b/scripts/linear-algebra/logm.m @@ -32,7 +32,7 @@ ## The optional argument @var{opt_iters} is the maximum number of square roots ## to compute and defaults to 100. The optional output @var{iters} is the ## number of square roots actually computed. -## +## @seealso{expm, sqrtm} ## @end deftypefn ## Reference: N. J. Higham, Functions of Matrices: Theory and Computation @@ -63,11 +63,14 @@ [u, s] = rsf2csf (u, s); endif - if (any (diag (s) < 0)) + eigv = diag (s); + if (any (eigv < 0)) warning ("Octave:logm:non-principal", "logm: principal matrix logarithm is not defined for matrices with negative eigenvalues; computing non-principal logarithm"); endif + real_eig = all (eigv >= 0); + k = 0; ## Algorithm 11.9 in "Function of matrices", by N. Higham theta = [0, 0, 1.61e-2, 5.38e-2, 1.13e-1, 1.86e-1, 2.6429608311114350e-1]; @@ -100,6 +103,11 @@ s = 2^k * u * s * u'; + ## Remove small complex values (O(eps)) which may have entered calculation + if (real_eig) + s = real (s); + endif + if (nargout == 2) iters = k; endif
--- a/scripts/linear-algebra/null.m +++ b/scripts/linear-algebra/null.m @@ -17,7 +17,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} null (@var{A}, @var{tol}) +## @deftypefn {Function File} {} null (@var{A}) +## @deftypefnx {Function File} {} null (@var{A}, @var{tol}) ## Return an orthonormal basis of the null space of @var{A}. ## ## The dimension of the null space is taken as the number of singular @@ -76,3 +77,35 @@ endif endfunction + +%!test +%! A = 0; +%! assert(null(A), 1); + +%!test +%! A = 1; +%! assert(null(A), zeros(1,0)) + +%!test +%! A = [1 0; 0 1]; +%! assert(null(A), zeros(2,0)); + +%!test +%! A = [1 0; 1 0]; +%! assert(null(A), [0 1]') + +%!test +%! A = [1 1; 0 0]; +%! assert(null(A), [-1/sqrt(2) 1/sqrt(2)]', eps) + +%!test +%! tol = 1e-4; +%! A = [1 0; 0 tol-eps]; +%! assert(null(A,tol), [0 1]') + +%!test +%! tol = 1e-4; +%! A = [1 0; 0 tol+eps]; +%! assert(null(A,tol), zeros(2,0)); + +%!error null()
--- a/scripts/linear-algebra/onenormest.m +++ b/scripts/linear-algebra/onenormest.m @@ -277,6 +277,9 @@ ## Only likely to be within a factor of 10. %!test +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ('state', 42); % Initialize to guarantee reproducible results %! N = 100; %! A = rand (N); %! [nm1, v1, w1] = onenormest (A);
--- a/scripts/linear-algebra/orth.m +++ b/scripts/linear-algebra/orth.m @@ -17,7 +17,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} orth (@var{A}, @var{tol}) +## @deftypefn {Function File} {} orth (@var{A}) +## @deftypefnx {Function File} {} orth (@var{A}, @var{tol}) ## Return an orthonormal basis of the range space of @var{A}. ## ## The dimension of the range space is taken as the number of singular @@ -38,6 +39,11 @@ if (nargin == 1 || nargin == 2) + if (isempty (A)) + retval = []; + return; + endif + [U, S, V] = svd (A); [rows, cols] = size (A); @@ -73,3 +79,12 @@ endif endfunction + +%!test +%! for ii=1:20 +%! A = rand (10, 10); +%! V = orth (A); +%! if (det (A) != 0) +%! assert (V'*V, eye (10), 100*eps) +%! endif +%! endfor
--- a/scripts/linear-algebra/planerot.m +++ b/scripts/linear-algebra/planerot.m @@ -34,3 +34,14 @@ G = givens (x(1), x(2)); y = G * x(:); endfunction + +%!test +%! x = [3 4]; +%! [g y] = planerot(x); +%! assert(g - [x(1) x(2); -x(2) x(1)] / sqrt(x(1)^2 + x(2)^2), zeros(2), 2e-8); +%! assert(y(2), 0, 2e-8); + +%!error planerot([0]); +%!error planerot([0 0 0]); +%!error planerot(); +
--- a/scripts/linear-algebra/qzhess.m +++ b/scripts/linear-algebra/qzhess.m @@ -90,3 +90,52 @@ endfor endfunction + +%!test +%! a = [1 2 1 3; +%! 2 5 3 2; +%! 5 5 1 0; +%! 4 0 3 2]; +%! b = [0 4 2 1; +%! 2 3 1 1; +%! 1 0 2 1; +%! 2 5 3 2]; +%! mask = [0 0 0 0; +%! 0 0 0 0; +%! 1 0 0 0; +%! 1 1 0 0]; +%! [aa, bb, q, z] = qzhess(a, b); +%! assert(inv(q) - q', zeros(4), 2e-8); +%! assert(inv(z) - z', zeros(4), 2e-8); +%! assert(q * a * z, aa, 2e-8); +%! assert(aa .* mask, zeros(4), 2e-8); +%! assert(q * b * z, bb, 2e-8); +%! assert(bb .* mask, zeros(4), 2e-8); + +%!test +%! a = [1 2 3 4 5; +%! 3 2 3 1 0; +%! 4 3 2 1 1; +%! 0 1 0 1 0; +%! 3 2 1 0 5]; +%! b = [5 0 4 0 1; +%! 1 1 1 2 5; +%! 0 3 2 1 0; +%! 4 3 0 3 5; +%! 2 1 2 1 3]; +%! mask = [0 0 0 0 0; +%! 0 0 0 0 0; +%! 1 0 0 0 0; +%! 1 1 0 0 0; +%! 1 1 1 0 0]; +%! [aa, bb, q, z] = qzhess(a, b); +%! assert(inv(q) - q', zeros(5), 2e-8); +%! assert(inv(z) - z', zeros(5), 2e-8); +%! assert(q * a * z, aa, 2e-8); +%! assert(aa .* mask, zeros(5), 2e-8); +%! assert(q * b * z, bb, 2e-8); +%! assert(bb .* mask, zeros(5), 2e-8); + +%!error qzhess([0]); +%!error qzhess(); +
--- a/scripts/linear-algebra/rank.m +++ b/scripts/linear-algebra/rank.m @@ -17,7 +17,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} rank (@var{A}, @var{tol}) +## @deftypefn {Function File} {} rank (@var{A}) +## @deftypefnx {Function File} {} rank (@var{A}, @var{tol}) ## Compute the rank of @var{A}, using the singular value decomposition. ## The rank is taken to be the number of singular values of @var{A} that ## are greater than the specified tolerance @var{tol}. If the second @@ -57,3 +58,54 @@ retval = sum (sigma > tolerance); endfunction + +%!test +%! A = [1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 1 2 3.1 4 5 6 7; +%! 2 3 4 5 6 7 8; +%! 3 4 5 6 7 8 9; +%! 4 5 6 7 8 9 10; +%! 5 6 7 8 9 10 11]; +%! assert(rank(A),4); + +%!test +%! A = [1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 1 2 3.0000001 4 5 6 7; +%! 4 5 6 7 8 9 12.00001; +%! 3 4 5 6 7 8 9; +%! 4 5 6 7 8 9 10; +%! 5 6 7 8 9 10 11]; +%! assert(rank(A),4); + +%!test +%! A = [1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12.00001; +%! 3 4 5 6 7 8 9; +%! 4 5 6 7 8 9 10; +%! 5 6 7 8 9 10 11]; +%! assert(rank(A),3); + +%!test +%! A = [1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 3 4 5 6 7 8 9; +%! 4 5 6 7 8 9 10; +%! 5 6 7 8 9 10 11]; +%! assert(rank(A),3); + +%!test +%! A = eye(100); +%! assert(rank(A),100); + +%!test +%! A = [1, 2, 3; 1, 2.001, 3; 1, 2, 3.0000001]; +%! assert(rank(A),3) +%! assert(rank(A,0.0009),1) +%! assert(rank(A,0.0006),2) +%! assert(rank(A,0.00000002),3) \ No newline at end of file
--- a/scripts/linear-algebra/rref.m +++ b/scripts/linear-algebra/rref.m @@ -17,9 +17,10 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{r}, @var{k}] =} rref (@var{A}, @var{tol}) -## -## Returns the reduced row echelon form of @var{A}. @var{tol} defaults +## @deftypefn {Function File} {} rref (@var{A}) +## @deftypefnx {Function File} {} rref (@var{A}, @var{tol}) +## @deftypefnx {Function File} {[@var{r}, @var{k}] =} rref (@dots{}) +## Return the reduced row echelon form of @var{A}. @var{tol} defaults ## to @code{eps * max (size (@var{A})) * norm (@var{A}, inf)}. ## ## Called with two return arguments, @var{k} returns the vector of @@ -85,3 +86,43 @@ k = find (used); endfunction + +%!test +%! a = [1]; +%! [r k] = rref(a); +%! assert(r, [1], 2e-8); +%! assert(k, [1], 2e-8); + +%!test +%! a = [1 3; 4 5]; +%! [r k] = rref(a); +%! assert(rank(a), rank(r), 2e-8); +%! assert(r, eye(2), 2e-8); +%! assert(k == [1, 2] || k == [2, 1]); + + +%!test +%! a = [1 3; 4 5; 7 9]; +%! [r k] = rref(a); +%! assert(rank(a), rank(r), 2e-8); +%! assert(r, eye(3)(:,1:2), 2e-8); +%! assert(k, [1 2], 2e-8); + +%!test +%! a = [1 2 3; 2 4 6; 7 2 0]; +%! [r k] = rref(a); +%! assert(rank(a), rank(r), 2e-8); +%! assert(r, [1 0 (3-7/2); 0 1 (7/4); 0 0 0], 2e-8); +%! assert(k, [1 2], 2e-8); + +%!test +%! a = [1 2 1; 2 4 2.01; 2 4 2.1]; +%! tol = 0.02; +%! [r k] = rref(a, tol); +%! assert(rank(a, tol), rank(r, tol), 2e-8); +%! tol = 0.2; +%! [r k] = rref(a, tol); +%! assert(rank(a, tol), rank(r, tol), 2e-8); + +%!error rref(); +
--- a/scripts/linear-algebra/vech.m +++ b/scripts/linear-algebra/vech.m @@ -21,7 +21,10 @@ ## @deftypefn {Function File} {} vech (@var{x}) ## Return the vector obtained by eliminating all supradiagonal elements of ## the square matrix @var{x} and stacking the result one column above the -## other. +## other. This has uses in matrix calculus where the underlying matrix +## is symmetric and it would be pointless to keep values above the main +## diagonal. +## @seealso{vec} ## @end deftypefn ## See Magnus and Neudecker (1988), Matrix differential calculus with
--- a/scripts/miscellaneous/ans.m +++ b/scripts/miscellaneous/ans.m @@ -28,3 +28,7 @@ ## @noindent ## is evaluated, the value returned by @code{ans} is 25. ## @end defvr + +## Mark file as being tested. No real test needed for a documentation .m file +%!assert (1) +
--- a/scripts/miscellaneous/bincoeff.m +++ b/scripts/miscellaneous/bincoeff.m @@ -68,46 +68,53 @@ error ("bincoeff: N and K must be of common size or scalars"); endif - sz = size (n); - b = zeros (sz); + if (iscomplex (n) || iscomplex (k)) + error ("bincoeff: N and K must not be complex"); + endif - ind = (! (k >= 0) | (k != real (round (k))) | isnan (n)); - b(ind) = NaN; + b = zeros (size (n)); - ind = (k == 0); - b(ind) = 1; + ok = (k >= 0) & (k == fix (k)) & (! isnan (n)); + b(! ok) = NaN; - ind = ((k > 0) & ((n == real (round (n))) & (n < 0))); - b(ind) = (-1) .^ k(ind) .* exp (gammaln (abs (n(ind)) + k(ind)) - - gammaln (k(ind) + 1) - - gammaln (abs (n(ind)))); + n_int = (n == fix (n)); + idx = n_int & (n < 0) & ok; + b(idx) = (-1) .^ k(idx) .* exp (gammaln (abs (n(idx)) + k(idx)) + - gammaln (k(idx) + 1) + - gammaln (abs (n(idx)))); - ind = ((k > 0) & (n >= k)); - b(ind) = exp (gammaln (n(ind) + 1) - - gammaln (k(ind) + 1) - - gammaln (n(ind) - k(ind) + 1)); + idx = (n >= k) & ok; + b(idx) = exp (gammaln (n(idx) + 1) + - gammaln (k(idx) + 1) + - gammaln (n(idx) - k(idx) + 1)); - ind = ((k > 0) & ((n != real (round (n))) & (n < k))); - b(ind) = (1/pi) * exp (gammaln (n(ind) + 1) - - gammaln (k(ind) + 1) - + gammaln (k(ind) - n(ind)) - + log (sin (pi * (n(ind) - k(ind) + 1)))); + idx = (! n_int) & (n < k) & ok; + b(idx) = (1/pi) * exp (gammaln (n(idx) + 1) + - gammaln (k(idx) + 1) + + gammaln (k(idx) - n(idx)) + + log (sin (pi * (n(idx) - k(idx) + 1)))); ## Clean up rounding errors. - ind = (n == round (n)); - b(ind) = round (b(ind)); + b(n_int) = round (b(n_int)); - ind = (n != round (n)); - b(ind) = real (b(ind)); + idx = ! n_int; + b(idx) = real (b(idx)); endfunction -%!assert(bincoeff(4,2), 6) -%!assert(bincoeff(2,4), 0) -%!assert(bincoeff(0.4,2), -.12, 8*eps) + +%!assert(bincoeff (4, 2), 6) +%!assert(bincoeff (2, 4), 0) +%!assert(bincoeff (-4, 2), 10) +%!assert(bincoeff (5, 2), 10) +%!assert(bincoeff (50, 6), 15890700) +%!assert(bincoeff (0.4, 2), -.12, 8*eps) -%!assert(bincoeff (5, 2) == 10 && bincoeff (50, 6) == 15890700); +%!assert(bincoeff ([4 NaN 4], [-1, 2, 2.5]), NaN (1, 3)) +%% Test input validation %!error bincoeff (); +%!error bincoeff (1, 2, 3); +%!error bincoeff (ones(3),ones(2)) +%!error bincoeff (ones(2),ones(3)) -%!error bincoeff (1, 2, 3);
--- a/scripts/miscellaneous/bug_report.m +++ b/scripts/miscellaneous/bug_report.m @@ -43,3 +43,6 @@ puts ("\n"); endfunction + +## Mark file as being tested. No real test needed for this function. +%!assert (1)
--- a/scripts/miscellaneous/bzip2.m +++ b/scripts/miscellaneous/bzip2.m @@ -23,7 +23,7 @@ ## Compress the list of files specified in @var{files}. ## Each file is compressed separately and a new file with a '.bz2' extension ## is created. The original files are not modified. Existing compressed files -## are silently overwritten. If @var{outdir} is defined the compressed +## are silently overwritten. If @var{outdir} is defined the compressed ## files are placed in this directory. ## @seealso{bunzip2, gzip, zip, tar} ## @end deftypefn
--- a/scripts/miscellaneous/comma.m +++ b/scripts/miscellaneous/comma.m @@ -21,3 +21,7 @@ ## Array index, function argument, or command separator. ## @seealso{semicolon} ## @end deftypefn + +## Mark file as being tested. No real test needed for a documentation .m file +%!assert (1) +
--- a/scripts/miscellaneous/compare_versions.m +++ b/scripts/miscellaneous/compare_versions.m @@ -66,7 +66,7 @@ ## Note that version "1.1-test2" will compare as greater than ## "1.1-test10". Also, since the numeric part is compared first, "a" ## compares less than "1a" because the second string starts with a -## numeric part even though @code{double("a")} is greater than +## numeric part even though @code{double("a")} is greater than ## @code{double("1").} ## @end deftypefn
--- a/scripts/miscellaneous/computer.m +++ b/scripts/miscellaneous/computer.m @@ -17,7 +17,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{c}, @var{maxsize}, @var{endian}] =} computer () +## @deftypefn {Function File} {[@var{c}, @var{maxsize}, @var{endian}] =} computer () +## @deftypefnx {Function File} {@var{arch} =} computer ("arch") ## Print or return a string of the form @var{cpu}-@var{vendor}-@var{os} ## that identifies the kind of computer Octave is running on. If invoked ## with an output argument, the value is returned instead of printed. For @@ -39,42 +40,52 @@ ## If three output arguments are requested, also return the byte order ## of the current system as a character (@code{"B"} for big-endian or ## @code{"L"} for little-endian). +## +## If the argument @code{"arch"} is specified, return a string +## indicating the architecture of the computer on which Octave is +## running. ## @end deftypefn -function [c, maxsize, endian] = computer () - - if (nargin != 0) - warning ("computer: ignoring extra arguments"); - endif +function [c, maxsize, endian] = computer (a) - msg = octave_config_info ("canonical_host_type"); + if (nargin == 1 && ischar (a) && strcmpi (a, "arch")) + tmp = strsplit (octave_config_info ("canonical_host_type"), "-"); + if (numel (tmp) == 4) + c = sprintf ("%s-%s-%s", tmp{4}, tmp{3}, tmp{1}); + else + c = sprintf ("%s-%s", tmp{3}, tmp{1}); + endif + elseif (nargin == 0) + msg = octave_config_info ("canonical_host_type"); - if (strcmp (msg, "unknown")) - msg = "Hi Dave, I'm a HAL-9000"; - endif + if (strcmp (msg, "unknown")) + msg = "Hi Dave, I'm a HAL-9000"; + endif - if (nargout == 0) - printf ("%s\n", msg); - else - c = msg; - if (strcmp (octave_config_info ("USE_64_BIT_IDX_T"), "true")) - maxsize = 2^63-1; + if (nargout == 0) + printf ("%s\n", msg); else - maxsize = 2^31-1; + c = msg; + if (strcmp (octave_config_info ("USE_64_BIT_IDX_T"), "true")) + maxsize = 2^63-1; + else + maxsize = 2^31-1; + endif + if (octave_config_info ("words_big_endian")) + endian = "B"; + elseif (octave_config_info ("words_little_endian")) + endian = "L"; + else + endian = "?"; + endif endif - if (octave_config_info ("words_big_endian")) - endian = "B"; - elseif (octave_config_info ("words_little_endian")) - endian = "L"; - else - endian = "?"; - endif + else + print_usage (); endif endfunction %!assert((ischar (computer ()) %! && computer () == octave_config_info ("canonical_host_type"))); - -%!warning a =computer(2); - +%!assert(ischar (computer ("arch"))); +%!error computer (2);
--- a/scripts/miscellaneous/debug.m +++ b/scripts/miscellaneous/debug.m @@ -18,13 +18,12 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} debug () -## Summary of the debugging commands. The debugging commands that are -## available in Octave are +## Summary of debugging commands. For more information on each command +## and available options use @code{help CMD}. +## +## The debugging commands available in Octave are ## ## @table @code -## @item keyboard -## Force entry into debug mode. -## ## @item dbstop ## Add a breakpoint. ## @@ -34,48 +33,59 @@ ## @item dbstatus ## List all breakpoints. ## +## @item dbwhere +## Report the current file and line number where execution is stopped. +## +## @item dbtype +## List the function where execution is currently stopped, enumerating +## the line numbers. +## +## @item dbstep +## @itemx dbnext +## Execute (step) one or more lines, follow execution into (step into) a +## function call, or execute until the end of a function (step out), and +## re-enter debug mode. +## ## @item dbcont -## Continue execution from the debug prompt. +## Continue normal code execution from the debug prompt. +## +## @item dbquit +## Quit debugging mode immediately and return to the main prompt. ## ## @item dbstack ## Print a backtrace of the execution stack. ## -## @item dbstep -## Execute one or more lines and re-enter debug mode -## -## @item dbtype -## List the function where execution is currently stopped, enumerating -## the lines. -## ## @item dbup -## The workspace up the execution stack. +## Move up the execution stack. ## ## @item dbdown -## The workspace down the execution stack. +## Move down the execution stack. ## -## @item dbquit -## Quit debugging mode and return to the main prompt. +## @item keyboard +## Force entry into debug mode from an m-file. ## ## @item debug_on_error -## Flag whether to enter debug mode in case Octave encounters an error. +## Configure whether Octave enters debug mode when it encounters an error. ## ## @item debug_on_warning -## Flag whether to enter debug mode in case Octave encounters a warning. +## Configure whether Octave enters debug mode when it encounters a warning. ## ## @item debug_on_interrupt -## Flag whether to enter debug mode in case Octave encounters an interupt. +## Configure whether Octave enters debug mode when it encounters an interrupt. ## +## @item isdebugmode +## Return true if in debug mode. ## @end table ## ## @noindent -## when Octave encounters a breakpoint or other reason to enter debug +## When Octave encounters a breakpoint, or other reason to enter debug ## mode, the prompt changes to @code{"debug>"}. The workspace of the function ## where the breakpoint was encountered becomes available and any Octave -## command that works within that workspace may be executed. +## command that is valid in that workspace context may be executed. ## -## @seealso{dbstop, dbclear, dbstatus, dbcont, dbstack, dbstep, dbtype, -## dbup, dbdown, dbquit, debug_on_error, debug_on_warning, -## debug_on_interrupt} +## @seealso{dbstop, dbclear, dbstatus, dbwhere, dbtype, dbcont, dbquit, +## dbstack, dbup, dbdown, keyboard, debug_on_error, debug_on_warning, +## debug_on_interrupt, isdebugmode} ## @end deftypefn function debug ()
--- a/scripts/miscellaneous/delete.m +++ b/scripts/miscellaneous/delete.m @@ -23,34 +23,41 @@ ## ## Deleting graphics objects is the proper way to remove ## features from a plot without clearing the entire figure. -## @seealso{clf, cla} +## @seealso{clf, cla, unlink} ## @end deftypefn ## Author: jwe function delete (arg) - if (nargin == 1) - if (ischar (arg)) - files = glob (arg).'; - if (isempty (files)) - warning ("delete: no such file: %s", arg); - endif - for i = 1:length (files) - file = files{i}; - [err, msg] = unlink (file); - if (err) - warning ("delete: %s: %s", file, msg); - endif - endfor - elseif (all (ishandle (arg(:)))) - ## Delete a graphics object. - __go_delete__ (arg); - else - error ("delete: first argument must be a filename or graphics handle"); - endif - else + if (nargin != 1) print_usage (); endif + if (ischar (arg)) + files = glob (arg); + if (isempty (files)) + warning ("delete: no such file: %s", arg); + endif + for i = 1:length (files) + file = files{i}; + [err, msg] = unlink (file); + if (err) + warning ("delete: %s: %s", file, msg); + endif + endfor + elseif (all (ishandle (arg(:)))) + ## Delete a graphics object. + __go_delete__ (arg); + else + error ("delete: first argument must be a filename or graphics handle"); + endif + endfunction + + +%% Test input validation +%!error delete () +%!error delete (1, 2) +%!error <first argument must be a filename> delete (struct ()) +
--- a/scripts/miscellaneous/dos.m +++ b/scripts/miscellaneous/dos.m @@ -17,14 +17,16 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{status}, @var{text}] =} dos (@var{command}) -## @deftypefnx {Function File} {[@var{status}, @var{text}] =} dos (@var{command}, "-echo") +## @deftypefn {Function File} {} dos ("@var{command}") +## @deftypefnx {Function File} {@var{status} =} dos ("@var{command}") +## @deftypefnx {Function File} {[@var{status}, @var{text}] =} dos ("@var{command"}) +## @deftypefnx {Function File} {[@dots{}] =} dos ("@var{command}", "-echo") ## Execute a system command if running under a Windows-like operating ## system, otherwise do nothing. Return the exit status of the program -## in @var{status} and any output sent to the standard output in -## @var{text}. If the optional second argument @code{"-echo"} is given, -## then also send the output from the command to the standard output. -## @seealso{unix, isunix, ispc, system} +## in @var{status} and any output from the command in @var{text}. +## When called with no output argument, or the "-echo" argument is +## given, then @var{text} is also sent to standard output. +## @seealso{unix, system, isunix, ispc} ## @end deftypefn ## Author: octave-forge ??? @@ -42,3 +44,28 @@ endif endfunction + + +%!test +%! cmd = ls_command (); +%! old_wstate = warning ("query"); +%! warning ("off", "Octave:undefined-return-values"); +%! unwind_protect +%! [status, output] = dos (cmd); +%! unwind_protect_cleanup +%! warning (old_wstate); +%! end_unwind_protect +%! +%! if (ispc () && ! isunix ()) +%! [status, output] = dos (cmd); +%! assert (status, 0); +%! assert (ischar (output)); +%! assert (! isempty (output)); +%! else +%! assert (status, []); +%! assert (output, []); +%! endif + +%!error dos () +%!error dos (1, 2, 3) +
--- a/scripts/miscellaneous/dump_prefs.m +++ b/scripts/miscellaneous/dump_prefs.m @@ -17,10 +17,11 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} dump_prefs (@var{file}) -## Have Octave dump all the current user preference variables to -## @var{file} in a format that can be parsed by Octave later. If -## @var{file} is omitted, the listing is printed to stdout. +## @deftypefn {Function File} {} dump_prefs () +## @deftypefnx {Function File} {} dump_prefs (@var{fid}) +## Dump all of the current user preference variables in a format that can be +## parsed by Octave later. @var{fid} is a file descriptor as returned by +## @code{fopen}. If @var{file} is omitted, the listing is printed to stdout. ## @end deftypefn ## Author: jwe
--- a/scripts/miscellaneous/edit.m +++ b/scripts/miscellaneous/edit.m @@ -54,7 +54,7 @@ ## filename. If @file{name.ext} is not modifiable, it will be copied to ## @env{HOME} before editing. ## -## @strong{WARNING!} You may need to clear name before the new definition +## @strong{Warning:} You may need to clear name before the new definition ## is available. If you are editing a .cc file, you will need ## to mkoctfile @file{name.cc} before the definition will be available. ## @end itemize @@ -76,7 +76,7 @@ ## In place of the function name. For example, ## @table @samp ## @item [EDITOR, " %s"] -## Use the editor which Octave uses for @code{bug_report}. +## Use the editor which Octave uses for @code{edit_history}. ## ## @item "xedit %s &" ## pop up simple X11 editor in a separate window
new file mode 100644 --- /dev/null +++ b/scripts/miscellaneous/fact.m @@ -0,0 +1,269 @@ +## Copyright (C) 2007-2011 Jordi Gutiérrez Hermoso +## Copyright (C) 2007 Stallmanfacts.com +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Command} {} fact +## @deftypefnx {Function File} {T =} fact() +## Display an amazing and random fact about the world's greatest hacker. +## @end deftypefn + + +function f = fact() + persistent wisdom = \ + { + "Richard Stallman takes notes in binary."; + "Richard Stallman doesn't need sudo. I will make him a sandwich anyway."; + "Richard Stallman is my shephurd, and I am his GNU."; + "Richard Stallman doesn't wget, Richard Stallman wdemands!"; + "Richard Stallman can touch MC Hammer"; + "Richard Stallman doesn't read web pages. They write to him."; + "Richard Stallman gets 9 bits to the byte."; + "Richard Stallman doesn't really believe in open software, because it's not free enough."; + "Richard Stallman can leave neutral or negative feedback on eBay."; + "Richard Stallman is the only man alive who can pronounce GNU the way it is meant to be pronounced."; + "Richard Stallman does not own a mobile phone because he can fashion a crude convex dish and shout into it at the exact resonant frequency of the ozone, causing a voice to seemingly come from the sky above his intended recipient."; + "Richard Stallman is so handsome that when he was young he was responsible for all other geeks not being able to get girls. This is why he has to cover his face with a thick layer of hair."; + "Some people check their computers for viruses. Viruses check their computers for Richard Stallman."; + "Richard Stallman memorises all his documents. In binary. He just types everything in whenever he needs a document."; + "When Richard Stallman makes a sudo command, he loses permissions."; + "Richard Stallman's beard is made of parentheses."; + "Richard Stallman's DNA is in binary."; + "Richard Stallman's nervous system is completely wireless."; + "Richard Stallman's brain accepts UNIX commands."; + "If Richard Stallman has 1GB of RAM, and if you have 1GB of RAM, Richard Stallman has more RAM than you."; + "Richard Stallman eats ethernet cables. That's why they invented wireless."; + "Richard Stallman has a katana. 'Nuff said."; + "Richard Stallman wrote a program that divides by zero."; + "Ricahrd Stallman doesn't use zip drives, he just squeezes the hard drive."; + "Richard Stallman's compiler is afraid to report errors."; + "Richard Stallman wrote the compiler God used. The Big Bang was the Universe's first segfault."; + "Richard Stallman successfully compiled a kernel of popcorn."; + "Richard Stallman doesn't write programs, they write themselves out of reverence."; + "Richard Stallman can make infinite loops end."; + "Richard Stallman's anti-virus programs cures HIV."; + "Richard Stallman's computer doesn't have a clock; it defines what time it is."; + "Richard Stallman wrote a program to compute the last digit of pi."; + "Richard Stallman doesn't use web browsers. He sends a link to a demon that uses wget to fetch the page and sends it back to him."; + "Richard Stallman can solve the halting problem... in polynomial time."; + "For Richard Stallman, polynomial time is O(1)."; + "Richard Stallman didn't \"write\" Emacs or created it in his own image. Richard Stallman made Emacs an instance of himself."; + "Richard Stallman can coerce meaningful data from /dev/null."; + "Some people wear Linus Torvalds pyjamas to bed, Linus Torvalds wears Richard Stallman pyjamas."; + "There is no software development process, only a bunch of programs Richard Stallman allows to exist. "; + "Richard Stallman spends his leisure time programming with Guile on GNU Hurd. "; + "Richard Stallman's left and right hands are named \"(\" and \")\" "; + "Richard Stallman first words were actually syscalls. "; + "Richard Stallman didn't create the singularity. He is the singularity. GNU/Linux is only the event horizon. "; + "When Richard Stallman pipes to more, he gets less "; + "Richard Stallman never showers: he runs 'make clean'. "; + "Richard Stallman needs neither mouse nor keyboard to operate his computer. He just stares it down until it does what he wants. "; + "Richard Stallman didn't write the GPL. He is the GPL. "; + "Richad Stallman's pinky finger is really a USB memory stick. "; + "Richard Stallman called his operating system GNU because he created it before computers existed, when actual gnus were used for calcuations. "; + "In Soviet Russia, Richard Stallman is still Richard Stallman! "; + "Richard Stallman's flute only plays free music. "; + "When Richard Stallman uses floats, there are no rounding errors."; + "Richard Stallman wrote a program so powerful, it knows the question to 42."; + "Richard Stallman released his own DNA under GNU FDL."; + "Richard Stallman knows the entire wikipedia by heart, markup included."; + "Richard Stallman wrote the HAL9000 OS."; + "Richard Stallman's laser pointer is a lightsaber."; + "Richard Stallman never steps down; he shifts the universe up ."; + "Richard Stallman doesn't maintain code; he stares at it until it fixes itself out of reverence."; + "Richard Stallman doesn't use an editor; he sets the fundamental constants of the universe so that a magnetic platter with his code on it evolves itself."; + "Richard Stallman doesn’t code; he dares the computer to not do his bidding."; + "Global warming is caused by Richard Stallman’s rage toward non-free software."; + "Rather than being birthed like a normal child, Richard Stallman instead instantiated himself polymorphically. Shortly thereafter he grew a beard."; + "Richard Stallman discovered extra-terrestrial life but killed them because they used non-free software."; + "Richard Stallman doesn't evaluate expressions, expressions evaluate to Richard Stallman."; + "Richard Stallman can see Russia from his house."; + "Richard Stallman proved P=NP, twice!"; + "Richard Stallman knows of an unfixed bug in TeX."; + "Richard Stallman can write a context-free grammar for C."; + "Richard Stallman can determine whether an arbitrary program will terminate."; + "Richard Stallman's computer has only two buttons. One is for guests."; + "Richard Stallman does not actually write programs. He comes up with a length and digit index in pi."; + "Richard Stallman's distributed version control system is a flamewar on Usenet."; + "Richard Stallman wrote the first version of Emacs on a typewriter."; + "Richard Stallman has no known weaknesses, except for a phobia against soap."; + "Richard Stallman is not affected by Godwin's Law."; + "Richard Stallman can write an anti-virus program that cures HIV. Too bad he never writes anti-virus programs."; + "Richard Stallman' facial hair is \"free as in beard\""; + "Richard Stallman is licensed under GPL, so you can clone him and redistribute copies so you can help your neighbor. For example a version that take a bath more often."; + "Richard Stallman doesn't code; he just travels around the world."; + "Richard Stallman was coded by himself in lisp with Emacs."; + "Richard Stallman doesn't eat McDonald's because the machine that kills the cows uses proprietary software."; + "There is no chin behind Richard Stallman's legendary beard, there is only another Emacs."; + "In an average living room there are 1,242 objects Richard Stallman could use to write an OS, including the room itself."; + "Vendor lock-in is when vendors lock themselves inside of a building out of fear of Richard Stallman's wrath."; + "When Richard Stallman executes ps -e, you show up."; + "When Richard Stallman gets angry he doesn't swear; he recurses."; + "On Richard Stallman's computer the bootloader is contained in his .emacs."; + "Richard Satallman can make any operating system free, free from drivers."; + "Richard Stallman programmed Chuck Norris."; + "Behind Richard Stallman's beard there is another fist, to code faster."; + "Richard Stallman won a Suduku that started with only one number in each line"; + "Richard Stallman's brain compiles and runs C code."; + "Richard Stallman wrote the first version of Emacs using Emacs."; + "Richard Stallman never gonna give you up, never gonna let you down, never gonna run around and desert you, never gonna make you cry, never gonna say goodbye, never gonna tell a lie and hurt you."; + "Richard Stallman, upon reading these facts, didn't laugh at all. Instead, he complained that he is being linked to that dirty \"open source\" software. He also asked it to be changed to \"free software\", in order to raise awareness for software freedom in our society."; + "Richard Stallman has no problem using Emacs. He wrote it with his 4 hands."; + "Richard Stallman will revert the big rip by adding parenthesis to the dark matter."; + "When you make a Google search and it doesn't find the answer, Google gently consults Richard Stallman."; + "Richard Stallman's uptime is over 53 years. And counting up."; + "Richard Stallman's portable music player plays ogg and WMA."; + "Richard Stallman will never die, but may some day go to /dev/null."; + "Richard Stallman once got swine flu, but it got cleansed by hereditay GPL and thus got assimilated."; + "Richard Stallman don't cut his hair because there are no GNU/Scissors"; + "Richard Stallman is the one who trims Chuck Norris beard. And he does it freely, of course."; + "Richard Stallman does not take bath, for the hydroelectric company uses proprietary software."; + "Agent Smith loves Richard Stallman's scent."; + "Richard Stallman is the One."; + "\"They can take our lives, but they can never take our freedom.\" Willian Wallace after a litle talk with Richard Stallman."; + "Richard Stallman can connect to any brain using an Emacs ssh client."; + "Richard Stallman ported Emacs to Intel 4004 chip."; + "Richard Stallman did not write GNU Emacs, he simply read the source code from /dev/null."; + "Richard Stallman once used GDB to reverse-engineer Windows 7 into a free operating system - able to run on GNU Emacs!"; + "Richard Stallman does not contribute to open source projects; open source projects contribute to Richard Stallman, and then call themselves free software projects."; + "Richard Stallman programmed himself before he could even exist"; + "Richard Stallman can fill up /dev/null."; + "Richard Stallman is so zealous about privacy he has /dev/null as his home."; + "When Richard Stallman runs /bin/false, it returns \"true\"."; + "Richard Stallman doesn't like money, because banks don't run on free software."; + "Richard Stallman user GNU tar to compress air."; + "Richard Stallman was installed in the world, it runs on a free program .."; + "When Richard Stallman reports a bug, the bug prefers to squash itself instead of facing Richard Stallman's wrath."; + "There is no Windows in Richard Stallman's house... only Doors..."; + "Richard Stallman doesn't like neither PCs-Intel nor Burger King... He prefers e-Macs..."; + "Richard Stallman can use grep to find Jimmy Hoffa."; + "Richard Stallman made it possible to not absolutely abhor HPUX."; + "When Richard Stallman pours his alphabets cereal into a bowl, only G's, N's, and U's come out."; + "Richard Stallman is pronounced \"GNU slash Stallman\""; + "Richard Stallman doesn't mind if you read his mail as long as you don't delete it before he reads it."; + "Richard Stallman is just a guy who has strong principles and decided to follow them."; + "Richard Stallman knows that you don't have class because it is a keyword that he defined."; + "Richard Stallman doesn't need a qwerty/dvorak keyboard only two buttons \"1\" and \"0\" and his erect penis."; + "On the first day Richard Stallman said M-x create-light."; + "Richard Stallman once went out of scope for a while. The garbage collector never dared to touch him."; + "Richard Stallman does not compile; he closes his eyes, and see energy lines created between bit blocks by the compiler optimizations..."; + "intx80 first calls Richard Stallman before calling sys_call"; + "Tron is actually a biographical story about Richard Stallman. The director decided to tone it down or audiences wouldn't find it believable."; + "Richard Stallman always wears a red shirt to make sure that whatever attacks his away-team has to go through him first."; + "kill -9 invokes Richard Stallman's rage against a process."; + "If Richard were to stumble upon stallmanfacts.com, he would find it a gnuisance."; + "Richard Stallman can telnet into Mordor."; + "sudo chown Richard:Stallman /all/your/base"; + "Richard Stallman's nervous system is completely wireless."; + "Richard Stallman does not sleep. He yields."; + "Some people say M-x psychoanalyse-pinhead is a merely a program. Others say M-x psychoanalyse-pinhead *is* Richard Stallman. All I know is, Richard Stallman is The Stig."; + "If you execute Emacs backward it either undoes the industrial revolution or induces the rapture. But only Richard Stallman knows which."; + "If Richard Stallman's beard were ever trimmed, the clippings would re-marshal into an exact copy of Richard Stallman."; + "Richard Stallman never sleeps because he altered his own source to gain background garbage collection."; + "Richard Stallman's doctor can retrieve a blood sample via CVS."; + "Richard Stallman can touch this"; + "Because Richard Stallman's DNA is licensed under the FDL, his doctor can't draw his blood without violating HIPAA."; + "Richard Stallman can remove his own appendix, using only gdb."; + "Richard Stallman's DNA includes debugging symbols. But he doesn't need them."; + "Richard Stallman met Chuck Norris once. Chuck tried a roundhouse, but Richard bashed him in the skull."; + "Richard Stallman doesn't need to buy a bigger hard drive. He can compress data infinitely. "; + "When Richard Stallman cannot take your call, his beard answers the phone for you."; + "The R in RMS stands for RMS."; + "Richard Stallman can parse HTML with regular expressions."; + "Richard Stallman's traceroute goes all the way through an infinite number of anonymous proxies back to the traffic's source."; + "Richard Stallman's beard is in fact not a just a beard, but a microprinted hard copy of Emacs source code. New patches must be checked against new hair growth before being approved."; + "In the beginning-of-buffer there was Richard Stallman."; + "The NOOP was created to give Richard Stallman some time to comb his beard."; + "Whenever Richard Stallman looks at a Windows computer, it segfaults. Whenever Richard Stallman doesn't look at a Windows computer, it segfaults."; + "Richard Stallman can walk on Windows!"; + "After being unable to satisfy my wife for years, Richard Stallman was able to single-handedly unlock her orgasm within seconds and managed to write a texinfo manual minutes later for other users."; + "Richard Stallman's tabbed browser is a set to wget/telnet fg/bg processes."; + "There is no chin under Richard Stallman' beard. There's only another beard. Recursively."; + "Stallman can chown anything! stallman@stallman~$ chown stallman:stallman Earth (for example)"; + "Richard Stallman freed his beard so he can always check what's in it."; + "In the beginning was the Word, and the Word was with RMS, and the Word was GNU."; + "RMS means \"RMS means Stallman\""; + "Richard Stallman is the babelfish of his own speeches."; + "Richard Stallman wrote his own library and lives in it."; + "Richard Stallman found Waldo using grep in /dev/null"; + "Richard Stallman doesn't sleep; he is compiling"; + "Richard Stallman will get Coca Cola to release their recipe under the GPL."; + "Richard Stallman doesn't change clothes. He makes case mods."; + "Richard Stallman compiled the first version of gcc with an hexadecimal editor."; + "Richard Stallman will be the last guest on Linux Outlaws"; + "Richard Stallman calculates the universe's entropy by exploiting forced stack overflows."; + "Richard Stallman's consciousness will one day become the singularity, which will create Deep Thought, and answer the meaning of life, the universe and everything."; + "C is actually written in RMS."; + "Richard Stallman can write software that does not have a buffer overflow when counting money lost by Jerome Kerviel."; + "There were no double rainbows before Richard Stallman."; + "Chuck Norris had to shorten his beard in the presence of Stallman because two beards that awsome, so close would segfault the universe (again)."; + "RMS is Titanic."; + "Richard Stallman is the answer to the Turing Test."; + "Richard Stallman's beard makes ads for Gillette and Braun appear."; + "for i = 1 to Stallman will never stop."; + "\"RMS\" stands for \"RMS Makes Software\""; + "Whenever someone writes a \"Hello, world\" program, Richard Stallman says \"Hello\" back."; + "Richard Stallman wasn't born. He was compiled from source."; + "Richard Stallman has a URL tatooed on the left side of his chest where you can download his genetic code."; + "The GNU command line idiom that Richard Stallman never needs: \"date | more\""; + "Richard Stallman's toe cheese is aged to perfection."; + "Richard Stallman doesn't always run an OS kernel, but when he does he prefers GNU/Hurd. He is... the most interesting hacker in the world. Stay free, my friends."; + "When Richard Stallman gets hungry, he just picks debris from his foot and eats it."; + "Richard Stallman can GPL your code just by looking at it funny."; + "Richard Mathew Stallman loves birds. Birds make auricular love to Richard Mathew Stallman."; + "Richard Stallman is so free that the primitive recursive function for computing his liberty causes a stack overflow."; + "GNU Hurd is taking more than twenty years to develop because Richard Stallman is using a programming language comprised entirely of different lengths of time."; + "Richard Stallman's beard contains Richard Stallman, whose beard contains Richard Stallman...."; + "Richard Stallman had a Google Plus account in 2010."; + "sudo chown rms:gnu ~/base -R"; + "Richard Stallman pipes the Emacs binaries to /dev/dsp before he goes to sleep."; + "When Richard Stallman counted his fingers as a kid, he always started with 0."; + "When Richard Stallman's computer gets a virus, he simply applies a GPL license to it which converts the whole botnet to Linux. I mean, GNU/Linux."; + "Richard Stallman's beard trimmings can cure cancer. Too bad he never shaves."; + "Richard Stallman's doesn't kill a process, he just dares it to stay running."; + "Richard Stallman exists because he compiled himself into being. "; + "Richard Stallman's first words were in binary. When they couldn't understand him, he wrote a parser."; + "Richard Stallman doesn't need any codecs, he just opens a multimedia file with Emacs, and reads the bytes of the file as plain text. He then performs all the necessary decoding in his mind. But he refuses to decode files encrypted with DRM, although his mind is able to."; + }; + + w = wisdom{randi([1, numel(wisdom)])}; + if nargout > 0 + f = w; + else + w = wordwrap (w); + printf ("%s", w); + endif +endfunction + +function out = wordwrap (w) + cols = terminal_size ()(2); + wc = strsplit (w, " "); + out = "\n"; + i = 1; + numwords = numel (wc); + while i <= numwords; + line = wc{i}; + while (i < numwords && length (newline = cstrcat (line, " ", wc{i+1})) < cols) + line = newline; + i++; + endwhile + out = cstrcat (out, line, "\n"); + i++; + endwhile + out = cstrcat(out, "\n"); +endfunction \ No newline at end of file
--- a/scripts/miscellaneous/fileattrib.m +++ b/scripts/miscellaneous/fileattrib.m @@ -17,7 +17,7 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{status}, @var{msg}, @var{msgid}] =} fileattrib (@var{file}) +## @deftypefn {Function File} {[@var{status}, @var{result}, @var{msgid}] =} fileattrib (@var{file}) ## Return information about @var{file}. ## ## If successful, @var{status} is 1, with @var{result} containing a
--- a/scripts/miscellaneous/fullfile.m +++ b/scripts/miscellaneous/fullfile.m @@ -26,7 +26,7 @@ if (nargin > 0) ## Discard all empty arguments - varargin(cellfun (@isempty, varargin)) = []; + varargin(cellfun ("isempty", varargin)) = []; nargs = numel (varargin); if (nargs > 1) filename = varargin{1};
--- a/scripts/miscellaneous/getappdata.m +++ b/scripts/miscellaneous/getappdata.m @@ -16,8 +16,11 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{value} =} getappdata (@var{h}, @var{name}) -## Returns the @var{value} for named application data for the object(s) with +## Return the @var{value} for named application data for the object(s) with ## handle(s) @var{h}. +## @deftypefnx {Function File} {@var{appdata} =} getappdata (@var{h}) +## Return a structure, @var{appdata}, whose fields correspond to the appdata +## properties. ## @end deftypefn ## Author: Ben Abbott <bpabbott@mac.com> @@ -25,19 +28,32 @@ function val = getappdata (h, name) - if (! (all (ishandle (h)) && ischar (name))) + if (all (ishandle (h)) && nargin == 2 && ischar (name)) + ## FIXME - Is there a better way to handle non-existent appdata + ## and missing fields? + val = cell (numel (h), 1); + appdata = struct(); + for nh = 1:numel(h) + try + appdata = get (h(nh), "__appdata__"); + end_try_catch + if (! isfield (appdata, name)) + appdata.(name) = []; + endif + val(nh) = {appdata.(name)}; + endfor + if (nh == 1) + val = val{1}; + endif + elseif (ishandle (h) && numel (h) == 1 && nargin == 1) + try + val = get (h, "__appdata__"); + catch + val = struct (); + end_try_catch + else error ("getappdata: invalid input"); endif - appdata(numel(h)) = struct(); - for nh = 1:numel(h) - appdata(nh) = get (h(nh), "__appdata__"); - end - if (nh > 1) - val = {appdata.(name)}; - else - val = appdata.(name); - endif - endfunction
--- a/scripts/miscellaneous/getfield.m +++ b/scripts/miscellaneous/getfield.m @@ -50,8 +50,8 @@ print_usage (); endif subs = varargin; - flds = cellfun (@ischar, subs); - idxs = cellfun (@iscell, subs); + flds = cellfun ("isclass", subs, "char"); + idxs = cellfun ("isclass", subs, "cell"); if (all (flds | idxs)) typs = merge (flds, {"."}, {"()"}); obj = subsref (s, struct ("type", typs, "subs", subs));
--- a/scripts/miscellaneous/gzip.m +++ b/scripts/miscellaneous/gzip.m @@ -31,7 +31,7 @@ if (nargin != 1 && nargin != 2) || (nargout > 1) print_usage (); endif - + if (nargout == 0) __xzip__ ("gzip", "gz", "gzip -r %s", varargin{:}); else
--- a/scripts/miscellaneous/info.m +++ b/scripts/miscellaneous/info.m @@ -43,3 +43,6 @@ http://www.octave.org/bugs.html\n"); endfunction + +## Mark file as being tested. No real test needed for this function. +%! assert (1)
--- a/scripts/miscellaneous/ismac.m +++ b/scripts/miscellaneous/ismac.m @@ -32,3 +32,5 @@ endfunction +%!error ismac (1); +%!assert (islogical (ismac ()));
--- a/scripts/miscellaneous/ispc.m +++ b/scripts/miscellaneous/ispc.m @@ -31,3 +31,6 @@ endif endfunction + +%!error ispc (1); +%!assert (islogical (ispc ()));
--- a/scripts/miscellaneous/isunix.m +++ b/scripts/miscellaneous/isunix.m @@ -31,3 +31,6 @@ endif endfunction + +%!error isunix (1); +%!assert (islogical (isunix ()));
--- a/scripts/miscellaneous/license.m +++ b/scripts/miscellaneous/license.m @@ -75,21 +75,15 @@ nr_licenses = rows (__octave_licenses__); if (nout > 1 || nin > 3) - error ("type `help license' for usage info"); + print_usage (); endif - if (nin == 0) + if (nin == 0) - found = false; - for p = 1:nr_licenses - if (strcmp (__octave_licenses__{p,1}, "Octave")) - found = true; - break; - endif - endfor + found = find (strcmp (__octave_licenses__(:,1), "Octave"), 1); - if (found) - result = __octave_licenses__{p,2}; + if (! isempty (found)) + result = __octave_licenses__{found,2}; else result = "unknown"; endif @@ -105,17 +99,15 @@ if (nout == 0) if (! strcmp (varargin{1}, "inuse")) - usage ("license (\"inuse\")"); + usage ('license ("inuse")'); endif - for p = 1:nr_licenses - printf ("%s\n", __octave_licenses__{p,1}); - endfor + printf ("%s\n", __octave_licenses__{:,1}); else if (! strcmp (varargin{1}, "inuse")) - usage ("retval = license (\"inuse\")"); + usage ('retval = license ("inuse")'); endif pw = getpwuid (getuid ()); @@ -125,11 +117,7 @@ username = "octave_user"; endif - retval(1:nr_licenses) = struct ("feature", "", "user", ""); - for p = 1:nr_licenses - retval(p).feature = __octave_licenses__{p,1}; - retval(p).user = username; - endfor + retval = struct ("feature", __octave_licenses__(:,1), "user", username); endif @@ -139,52 +127,61 @@ if (strcmp (varargin{1}, "test")) - found = false; - for p = 1:nr_licenses - if (strcmpi (feature, __octave_licenses__{p,1})) - found = true; - break; - endif - endfor + found = find (strcmpi (__octave_licenses__(:,1), feature), 1); if (nin == 2) - retval = found && __octave_licenses__{p,3}; + retval = ! isempty (found) && __octave_licenses__{found,3}; else - if (found) + if (! isempty (found)) if (strcmp (varargin{3}, "enable")) - __octave_licenses__{p,3} = true; + __octave_licenses__{found,3} = true; elseif (strcmp (varargin{3}, "disable")) - __octave_licenses__{p,3} = false; + __octave_licenses__{found,3} = false; else - error ("TOGGLE must be either `enable' of `disable'"); + error ("license: TOGGLE must be either `enable' or `disable'"); endif else - error ("FEATURE `%s' not found", feature); + error ("license: FEATURE `%s' not found", feature); endif endif elseif (strcmp (varargin{1}, "checkout")) if (nin != 2) - usage ("retval = license (\"checkout\", feature)"); + usage ('retval = license ("checkout", feature)'); endif - found = false; - for p = 1:nr_licenses - if (strcmpi (feature, __octave_licenses__{p,1})) - found = true; - break; - endif - endfor + found = find (strcmpi (__octave_licenses__(:,1), feature), 1); - retval = found && __octave_licenses__{p,3}; + retval = ! isempty (found) && __octave_licenses__{found,3}; else - - error ("type `help license' for usage info"); - + print_usage (); endif endif endfunction + + +%!assert (license(), "GNU General Public License") +%!assert ((license ("inuse")).feature, "Octave") + +%!test +%! lstate = license ("test", "Octave"); +%! license ("test", "Octave", "disable"); +%! assert (license ("test", "Octave"), false); +%! license ("test", "Octave", "enable"); +%! assert (license ("test", "Octave"), true); +%! if (lstate == false) +%! license ("test", "Octave", "disable"); +%! endif + +%!assert (license ("checkout", "Octave"), true) + +%% Test input validation +%!error license ("not_inuse") +%!error <TOGGLE must be either> license ("test", "Octave", "not_enable") +%!error <FEATURE `INVALID' not found> license ("test", "INVALID", "enable") +%!error license ("not_test", "Octave", "enable") +
--- a/scripts/miscellaneous/list_primes.m +++ b/scripts/miscellaneous/list_primes.m @@ -83,3 +83,9 @@ endwhile endfunction + +%!test +%! assert (list_primes(), [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41,\ +%! 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97]); +%! assert (list_primes(5), [2, 3, 5, 7, 11]); +
--- a/scripts/miscellaneous/ls.m +++ b/scripts/miscellaneous/ls.m @@ -46,38 +46,49 @@ ls_command (); endif - if (iscellstr (varargin)) - - args = tilde_expand (varargin); + if (! iscellstr (varargin)) + error ("ls: all arguments must be character strings"); + endif - cmd = sprintf ("%s ", __ls_command__, args{:}); - - if (page_screen_output () || nargout > 0) - - [status, output] = system (cmd); + if (nargin > 0) + args = tilde_expand (varargin); + if (ispc () && ! isunix ()) + ## shell (cmd.exe) on MinGW uses '^' as escape character + args = regexprep (args, '([^\w.*? -])', '^$1'); + else + args = regexprep (args, '([^\w.*? -])', '\$1'); + endif + args = sprintf ("%s ", args{:}); + else + args = ""; + endif - if (status == 0) - if (nargout == 0) - puts (output); - else - retval = strvcat (regexp (output, '\S+', 'match'){:}); - endif - else - error ("ls: command exited abnormally with status %d", status); - endif + cmd = sprintf ("%s %s", __ls_command__, args); + + if (page_screen_output () || nargout > 0) + [status, output] = system (cmd); + if (status != 0) + error ("ls: command exited abnormally with status %d\n", status); + elseif (nargout == 0) + puts (output); else - ## Just let the output flow if the pager is off. That way the - ## output from things like "ls -R /" will show up immediately and - ## we won't have to buffer all the output. - system (cmd); + retval = strvcat (regexp (output, '\S+', 'match'){:}); endif - else - error ("ls: expecting all arguments to be character strings"); + ## Just let the output flow if the pager is off. That way the + ## output from things like "ls -R /" will show up immediately and + ## we won't have to buffer all the output. + system (cmd); endif endfunction + +%!test +%! list = ls (); +%! assert (ischar (list)); +%! assert (! isempty (list)); + %!error ls (1);
--- a/scripts/miscellaneous/ls_command.m +++ b/scripts/miscellaneous/ls_command.m @@ -17,10 +17,9 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{old_cmd} =} ls_command (@var{cmd}) -## Set or return the shell command used by Octave's @code{ls} command. -## The value of @var{cmd} must be a character string. -## With no arguments, simply return the previous value. +## @deftypefn {Function File} {@var{val} =} ls_command () +## @deftypefnx {Function File} {@var{old_val} =} ls_command (@var{new_val}) +## Query or set the shell command used by Octave's @code{ls} command. ## @seealso{ls} ## @end deftypefn @@ -31,10 +30,10 @@ global __ls_command__; if (isempty (__ls_command__)) - ## FIXME -- ispc and isunix both return true for Cygwin. Should they? + ## MinGW uses different ls_command if (ispc () && ! isunix () && isempty (file_in_path (getenv ("PATH"), "ls"))) - __ls_command__ = "cmd /C dir /D"; + __ls_command__ = "dir /D"; else __ls_command__ = "ls -C"; endif @@ -55,3 +54,14 @@ endif endfunction + + +%!test +%! cmd = ls_command (); +%! assert (ischar (cmd)); +%! if (ispc () && ! isunix ()) +%! assert (cmd(1:3), "dir"); +%! else +%! assert (cmd(1:2), "ls"); +%! endif +
--- a/scripts/miscellaneous/menu.m +++ b/scripts/miscellaneous/menu.m @@ -42,38 +42,29 @@ ## Don't send the menu through the pager since doing that can cause ## major confusion. - save_page_screen_output = page_screen_output (); - - unwind_protect - - page_screen_output (0); + page_screen_output (0, "local"); - if (! isempty (title)) - disp (title); - printf ("\n"); - endif + if (! isempty (title)) + disp (title); + printf ("\n"); + endif - nopt = nargin - 1; + nopt = nargin - 1; - while (1) - for i = 1:nopt - printf (" [%2d] ", i); - disp (varargin{i}); - endfor - printf ("\n"); - s = input ("pick a number, any number: ", "s"); - num = sscanf (s, "%d"); - if (! isscalar (num) || num < 1 || num > nopt) - printf ("\nerror: input invalid or out of range\n\n"); - else - break; - endif - endwhile - - unwind_protect_cleanup - - page_screen_output (save_page_screen_output); - - end_unwind_protect + while (1) + for i = 1:nopt + printf (" [%2d] ", i); + disp (varargin{i}); + endfor + printf ("\n"); + s = input ("pick a number, any number: ", "s"); + num = sscanf (s, "%d"); + if (! isscalar (num) || num < 1 || num > nopt) + printf ("\nerror: input invalid or out of range\n\n"); + else + break; + endif + endwhile endfunction +
--- a/scripts/miscellaneous/mexext.m +++ b/scripts/miscellaneous/mexext.m @@ -19,8 +19,11 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} mexext () ## Return the filename extension used for MEX files. +## @seealso{mex} ## @end deftypefn function retval = mexext () retval = "mex"; endfunction + +%!assert (mexext (), "mex")
--- a/scripts/miscellaneous/mkoctfile.m +++ b/scripts/miscellaneous/mkoctfile.m @@ -18,6 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Command} {} mkoctfile [-options] file @dots{} +## @deftypefnx {Function File} {[@var{output}, @var{status} =} mkoctfile (@dots{}) ## ## The @code{mkoctfile} function compiles source code written in C, ## C++, or Fortran. Depending on the options used with @code{mkoctfile}, the @@ -25,7 +26,9 @@ ## application. ## ## @code{mkoctfile} can be called from the shell prompt or from the Octave -## prompt. +## prompt. Calling it from the Octave prompt simply delegates the +## call to the shell prompt. The output is stored in the @var{output} +## variable and the exit status in the @var{status} variable. ## ## @code{mkoctfile} accepts the following options, all of which are optional ## except for the file name of the code you wish to compile: @@ -75,26 +78,30 @@ ## Print the configuration variable VAR@. Recognized variables are: ## ## @example -## ALL_CFLAGS FFTW_LIBS +## ALL_CFLAGS FFTW3F_LIBS ## ALL_CXXFLAGS FLIBS ## ALL_FFLAGS FPICFLAG ## ALL_LDFLAGS INCFLAGS -## BLAS_LIBS LDFLAGS -## CC LD_CXX -## CFLAGS LD_STATIC_FLAG -## CPICFLAG LFLAGS -## CPPFLAGS LIBCRUFT -## CXX LIBOCTAVE -## CXXFLAGS LIBOCTINTERP -## CXXPICFLAG LIBREADLINE +## BLAS_LIBS LAPACK_LIBS +## CC LDFLAGS +## CFLAGS LD_CXX +## CPICFLAG LD_STATIC_FLAG +## CPPFLAGS LFLAGS +## CXX LIBCRUFT +## CXXFLAGS LIBOCTAVE +## CXXPICFLAG LIBOCTINTERP ## DEPEND_EXTRA_SED_PATTERN LIBS ## DEPEND_FLAGS OCTAVE_LIBS -## DL_LD RDYNAMIC_FLAG -## DL_LDFLAGS RLD_FLAG -## F2C SED -## F2CFLAGS XTRA_CFLAGS -## F77 XTRA_CXXFLAGS -## FFLAGS +## DL_LD OCTAVE_LINK_DEPS +## DL_LDFLAGS OCT_LINK_DEPS +## EXEEXT RDYNAMIC_FLAG +## F77 READLINE_LIBS +## F77_INTEGER_8_FLAG SED +## FFLAGS XTRA_CFLAGS +## FFTW3_LDFLAGS XTRA_CXXFLAGS +## FFTW3_LIBS +## FFTW3F_LDFLAGS +## ## @end example ## ## @item --link-stand-alone @@ -133,7 +140,7 @@ ## @end table ## @end deftypefn -function mkoctfile (varargin) +function [output, status] = mkoctfile (varargin) bindir = octave_config_info ("bindir"); @@ -144,9 +151,15 @@ cmd = cstrcat (cmd, " \"", varargin{i}, "\""); endfor - status = system (cmd); + [sys, out] = system (cmd); - if (status == 127) + if (nargout > 0) + [output, status] = deal (out, sys); + else + printf ("%s", out); + endif + + if (sys == 127) warning ("unable to find mkoctfile in expected location: `%s'", shell_script);
--- a/scripts/miscellaneous/module.mk +++ b/scripts/miscellaneous/module.mk @@ -20,6 +20,7 @@ miscellaneous/dos.m \ miscellaneous/dump_prefs.m \ miscellaneous/edit.m \ + miscellaneous/fact.m \ miscellaneous/fileattrib.m \ miscellaneous/fileparts.m \ miscellaneous/fullfile.m \ @@ -50,6 +51,8 @@ miscellaneous/paren.m \ miscellaneous/parseparams.m \ miscellaneous/perl.m \ + miscellaneous/python.m \ + miscellaneous/recycle.m \ miscellaneous/rmappdata.m \ miscellaneous/run.m \ miscellaneous/semicolon.m \ @@ -61,11 +64,11 @@ miscellaneous/tar.m \ miscellaneous/tempdir.m \ miscellaneous/tempname.m \ - miscellaneous/unimplemented.m \ miscellaneous/unix.m \ miscellaneous/unpack.m \ miscellaneous/untar.m \ miscellaneous/unzip.m \ + miscellaneous/usejava.m \ miscellaneous/ver.m \ miscellaneous/version.m \ miscellaneous/warning_ids.m \
--- a/scripts/miscellaneous/namelengthmax.m +++ b/scripts/miscellaneous/namelengthmax.m @@ -18,15 +18,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} namelengthmax () -## Returns the @sc{matlab} compatible maximum variable name length. Octave is -## capable of storing strings up to -## @tex -## $2^{31} - 1$ -## @end tex -## @ifnottex -## @code{2 ^ 31 - 1} -## @end ifnottex -## in length. However for @sc{matlab} compatibility all variable, function +## Return the @sc{matlab} compatible maximum variable name length. Octave is +## capable of storing strings up to @math{2^{31} - 1} in length. +## However for @sc{matlab} compatibility all variable, function, ## and structure field names should be shorter than the length supplied by ## @code{namelengthmax}. In particular variables stored to a @sc{matlab} file ## format will have their names truncated to this length. @@ -35,3 +29,6 @@ function n = namelengthmax () n = 63; endfunction + + +%!assert (namelengthmax, 63)
--- a/scripts/miscellaneous/news.m +++ b/scripts/miscellaneous/news.m @@ -17,14 +17,32 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} news () -## Display the current NEWS file for Octave. +## @deftypefn {Function File} {} news (@var{package}) +## Display the current NEWS file for Octave or installed package. +## +## If @var{package} is the name of an installed package, display the current +## NEWS file for that package. ## @end deftypefn -function news () +function news (package = "octave") + + if (ischar (package) && strcmpi (package, "octave")) + octetcdir = octave_config_info ("octetcdir"); + newsfile = fullfile (octetcdir, "NEWS"); - octetcdir = octave_config_info ("octetcdir"); - newsfile = fullfile (octetcdir, "NEWS"); + elseif (nargin == 1 && ischar (package)) + installed = pkg ("list"); + names = cellfun (@(x) x.name, installed, "UniformOutput", false); + ## we are nice and let the user use any case on the package name + pos = strcmpi (names, package); + if (!any (pos)) + error ("Package '%s' is not installed.", package); + endif + newsfile = fullfile (installed{pos}.dir, "packinfo", "NEWS"); + + else + print_usage; + endif if (exist (newsfile, "file")) f = fopen (newsfile, "r"); @@ -32,7 +50,14 @@ puts (line); endwhile else - error ("news: unable to locate NEWS file"); + if (strcmpi (package, "octave")) + error ("news: unable to locate NEWS file"); + else + error ("news: unable to locate NEWS file of %s package", package); + endif endif endfunction + +## Remove from test statistics. No real tests possible +%!assert (1)
--- a/scripts/miscellaneous/pack.m +++ b/scripts/miscellaneous/pack.m @@ -18,8 +18,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} pack () -## This function is provided for compatibility with @sc{matlab}, but it -## doesn't actually do anything. +## Consolidate workspace memory in @sc{matlab}. This function is provided for +## compatibility, but does nothing in Octave. ## @end deftypefn ## Author: jwe
--- a/scripts/miscellaneous/paren.m +++ b/scripts/miscellaneous/paren.m @@ -21,3 +21,7 @@ ## @deftypefnx {Operator} {} ) ## Array index or function argument delimeter. ## @end deftypefn + +## Mark file as being tested. No real test needed for a documentation .m file +%!assert (1) +
--- a/scripts/miscellaneous/parseparams.m +++ b/scripts/miscellaneous/parseparams.m @@ -48,7 +48,7 @@ ## with their default values given as name-value pairs. ## If @var{params} do not form name-value pairs, or if an option occurs ## that does not match any of the available options, an error occurs. -## When called from a m-file function, the error is prefixed with the +## When called from an m-file function, the error is prefixed with the ## name of the caller function. ## The matching of options is case-insensitive. ##
--- a/scripts/miscellaneous/private/__xzip__.m +++ b/scripts/miscellaneous/private/__xzip__.m @@ -36,7 +36,7 @@ if (nargin != 4 && nargin != 5) print_usage (); endif - + if (! ischar (extension) || length (extension) == 0) error ("__xzip__: EXTENSION must be a string with finite length"); endif @@ -80,14 +80,16 @@ commandname, status); endif - if (nargout > 0) - if (nargin == 5) + if (nargin == 5) + if (nargout > 0) entries = cellfun( @(x) fullfile (outdir, sprintf ("%s.%s", x, extension)), f, "uniformoutput", false); - else - movefile (cellfun(@(x) sprintf ("%s.%s", x, extension), f, - "uniformoutput", false), cwd); + endif + else + movefile (cellfun(@(x) sprintf ("%s.%s", x, extension), f, + "uniformoutput", false), cwd); + if (nargout > 0) ## FIXME this does not work when you try to compress directories entries = cellfun(@(x) sprintf ("%s.%s", x, extension), files, "uniformoutput", false); @@ -97,23 +99,18 @@ unwind_protect_cleanup cd (cwd); if (nargin == 4) - crr = confirm_recursive_rmdir (); - unwind_protect - confirm_recursive_rmdir (false); - rmdir (outdir, "s"); - unwind_protect_cleanup - confirm_recursive_rmdir (crr); - end_unwind_protect + confirm_recursive_rmdir (false, "local"); + rmdir (outdir, "s"); endif end_unwind_protect endfunction function [d, f] = myfileparts (files) - [d, f, ext] = cellfun (@(x) fileparts (x), files, "uniformoutput", false); + [d, f, ext] = cellfun ("fileparts", files, "uniformoutput", false); f = cellfun (@(x, y) sprintf ("%s%s", x, y), f, ext, "uniformoutput", false); - idx = cellfun (@isdir, files); + idx = cellfun ("isdir", files); d(idx) = ""; f(idx) = files(idx); endfunction
new file mode 100644 --- /dev/null +++ b/scripts/miscellaneous/python.m @@ -0,0 +1,47 @@ +## Copyright (C) 2008-2011 Julian Schnidder +## Copyright (C) 2011 Carnë Draug +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{output}, @var{status}] =} python (@var{scriptfile}) +## @deftypefnx {Function File} {[@var{output}, @var{status}] =} python (@var{scriptfile}, @var{argument1}, @var{argument2}, @dots{}) +## Invoke python script @var{scriptfile} with possibly a list of +## command line arguments. +## Returns output in @var{output} and status +## in @var{status}. +## @seealso{system} +## @end deftypefn + +## Author: Carnë Draug <carandraug+dev@gmail.com> + +function [output, status] = python (scriptfile = "-c ''", varargin) + + ## VARARGIN is intialized to {}(1x0) if no additional arguments are + ## supplied, so there is no need to check for it, or provide an + ## initial value in the argument list of the function definition. + + if (ischar (scriptfile) + && ((nargin != 1 && iscellstr (varargin)) + || (nargin == 1 && ! isempty (scriptfile)))) + [status, output] = system (cstrcat ("python ", scriptfile, + sprintf (" %s", varargin{:}))); + else + error ("python: invalid arguments"); + endif + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/miscellaneous/recycle.m @@ -0,0 +1,66 @@ +## Copyright (C) 2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{current_state}} recycle () +## @deftypefnx {Function File} {@var{old_state}} recycle (@var{new_state}) +## Query or set the preference for recycling deleted files. +## +## Recycling files instead of permanently deleting them is currently not +## implemented in Octave. To help avoid accidental data loss it +## is an error to attempt enable file recycling. +## @seealso{delete} +## @end deftypefn + +## Author: jwe + +function retval = recycle (state) + + persistent current_state = "off"; + + if (nargin > 1) + print_usage (); + endif + + if (nargin == 0 || nargout > 0) + retval = current_state; + endif + + if (nargin == 1) + if (ischar (state)) + if (strcmpi (state, "on")) + error ("recycle: recycling files is not implemented"); + elseif (strcmpi (state, "off")) + current_state = "off"; + else + error ("recycle: invalid value of STATE = `%s'", state); + endif + else + error ("recycle: expecting STATE to be a character string"); + endif + endif + +endfunction + +%!error recycle ("on"); +%!error recycle ("on", "and I mean it"); +%!error recycle (1); + +%!test +%! recycle ("off"); +%! assert (recycle ("off"), "off");
--- a/scripts/miscellaneous/rmappdata.m +++ b/scripts/miscellaneous/rmappdata.m @@ -16,7 +16,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} rmappdata (@var{h}, @var{name}) -## Deletes the named application data for the object(s) with +## Delete the named application data for the object(s) with ## handle(s) @var{h}. ## @end deftypefn
--- a/scripts/miscellaneous/semicolon.m +++ b/scripts/miscellaneous/semicolon.m @@ -21,3 +21,7 @@ ## Array row or command separator. ## @seealso{comma} ## @end deftypefn + +## Mark file as being tested. No real test needed for a documentation .m file +%!assert (1) +
--- a/scripts/miscellaneous/setappdata.m +++ b/scripts/miscellaneous/setappdata.m @@ -16,7 +16,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} setappdata (@var{h}, @var{name}, @var{value}) -## Sets the named application data to @var{value} for the object(s) with +## Set the named application data to @var{value} for the object(s) with ## handle(s) @var{h}. If the application data with the specified name does ## not exist, it is created. ## @end deftypefn @@ -33,7 +33,7 @@ for nh = 1:numel(h) if (! isfield (get (h(nh)), "__appdata__")) addproperty ("__appdata__", h(nh), "any", struct ()); - end + endif appdata = get (h(nh), "__appdata__"); for narg = 1:2:numel(varargin) if (iscellstr (varargin{narg}))
--- a/scripts/miscellaneous/setfield.m +++ b/scripts/miscellaneous/setfield.m @@ -50,8 +50,8 @@ endif subs = varargin(1:end-1); rhs = varargin{end}; - flds = cellfun (@ischar, subs); - idxs = cellfun (@iscell, subs); + flds = cellfun ("isclass", subs, "char"); + idxs = cellfun ("isclass", subs, "cell"); if (all (flds | idxs)) typs = merge (flds, {"."}, {"()"}); obj = subsasgn (obj, struct ("type", typs, "subs", subs), rhs);
--- a/scripts/miscellaneous/swapbytes.m +++ b/scripts/miscellaneous/swapbytes.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} swapbytes (@var{x}) -## Swaps the byte order on values, converting from little endian to big +## Swap the byte order on values, converting from little endian to big ## endian and vice versa. For example: ## ## @example @@ -32,6 +32,7 @@ ## @end deftypefn function y = swapbytes (x) + if (nargin != 1) print_usage (); endif @@ -53,4 +54,11 @@ y = reshape (typecast (reshape (typecast (x(:), "uint8"), nb, numel (x)) ([nb : -1 : 1], :) (:), clx), size(x)); endif + endfunction + + +%!assert (double (swapbytes (uint16 (1:4))), [256 512 768 1024]) +%!error (swapbytes ()) +%!error (swapbytes (1, 2)) +
--- a/scripts/miscellaneous/symvar.m +++ b/scripts/miscellaneous/symvar.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} symvar (@var{s}) -## Identifies the argument names in the function defined by a string. +## Identify the argument names in the function defined by a string. ## Common constant names such as @code{pi}, @code{NaN}, @code{Inf}, ## @code{eps}, @code{i} or @code{j} are ignored. The arguments that are ## found are returned in a cell array of strings. If no variables are @@ -28,3 +28,6 @@ function args = symvar (s) args = argnames (inline (s)); endfunction + +## This function is tested by the tests for argnames(). +%!assert (1)
--- a/scripts/miscellaneous/tar.m +++ b/scripts/miscellaneous/tar.m @@ -42,7 +42,7 @@ files = cellstr (files); endif - if (ischar (tarfile) && iscellstr (files) && ischar (root)) + if (! (ischar (tarfile) && iscellstr (files) && ischar (root))) error ("tar: all arguments must be character strings"); endif
--- a/scripts/miscellaneous/tempdir.m +++ b/scripts/miscellaneous/tempdir.m @@ -37,3 +37,19 @@ endif endfunction + + +%!assert (ischar (tempdir ())) + +%!test +%! old_wstate = warning ("query"); +%! warning ("off"); +%! old_tmpdir = getenv ("TMPDIR"); +%! unwind_protect +%! setenv ("TMPDIR", "__MY_TMP_DIR__"); +%! assert (tempdir (), ["__MY_TMP_DIR__" filesep()]); +%! unwind_protect_cleanup +%! setenv ("TMPDIR", old_tmpdir); +%! warning (old_wstate); +%! end_unwind_protect +
--- a/scripts/miscellaneous/tempname.m +++ b/scripts/miscellaneous/tempname.m @@ -29,3 +29,7 @@ filename = tmpnam (varargin{:}); endfunction + + +%% No tests needed for alias. +%!assert (1)
--- a/scripts/miscellaneous/unix.m +++ b/scripts/miscellaneous/unix.m @@ -17,14 +17,16 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{status}, @var{text}] =} unix (@var{command}) -## @deftypefnx {Function File} {[@var{status}, @var{text}] =} unix (@var{command}, "-echo") +## @deftypefn {Function File} {} unix ("@var{command}") +## @deftypefnx {Function File} {@var{status} =} unix ("@var{command}") +## @deftypefnx {Function File} {[@var{status}, @var{text}] =} unix ("@var{command}") +## @deftypefnx {Function File} {[@dots{}] =} unix ("@var{command}", "-echo") ## Execute a system command if running under a Unix-like operating ## system, otherwise do nothing. Return the exit status of the program -## in @var{status} and any output sent to the standard output in -## @var{text}. If the optional second argument @code{"-echo"} is given, -## then also send the output from the command to the standard output. -## @seealso{isunix, ispc, system} +## in @var{status} and any output from the command in @var{text}. +## When called with no output argument, or the "-echo" argument is +## given, then @var{text} is also sent to standard output. +## @seealso{dos, system, isunix, ispc} ## @end deftypefn ## Author: octave-forge ??? @@ -42,3 +44,27 @@ endif endfunction + + +%!test +%! cmd = ls_command (); +%! old_wstate = warning ("query"); +%! warning ("off", "Octave:undefined-return-values"); +%! unwind_protect +%! [status, output] = unix (cmd); +%! unwind_protect_cleanup +%! warning (old_wstate); +%! end_unwind_protect +%! +%! if (isunix ()) +%! assert (status, 0); +%! assert (ischar (output)); +%! assert (! isempty (output)); +%! else +%! assert (status, []); +%! assert (output, []); +%! endif + +%!error unix () +%!error unix (1, 2, 3) +
--- a/scripts/miscellaneous/unpack.m +++ b/scripts/miscellaneous/unpack.m @@ -21,12 +21,12 @@ ## @deftypefnx {Function File} {@var{files} =} unpack (@var{file}, @var{dir}) ## @deftypefnx {Function File} {@var{files} =} unpack (@var{file}, @var{dir}, @var{filetype}) ## Unpack the archive @var{file} based on its extension to the directory -## @var{dir}. If @var{file} is a list of strings, then each file is +## @var{dir}. If @var{file} is a list of strings, then each file is ## unpacked individually. If @var{dir} is not specified, it defaults to ## the current directory. If a directory is in the file list, then the ## @var{filetype} must also be specified. ## -## The optional return value is a list of @var{files} unpacked. +## The optional return value is a list of @var{files} unpacked. ## @seealso{bzip2, gzip, zip, tar} ## @end deftypefn @@ -38,12 +38,12 @@ print_usage (); endif - if (! ischar (file) && ! iscellstr (file)) + if (! ischar (file) && ! iscellstr (file)) error ("unpack: invalid input file class, %s", class(file)); endif ## character arrays of more than one string must be treated as cell strings - if (ischar (file) && ! isvector (file)) + if (ischar (file) && ! isvector (file)) file = cellstr (file); endif @@ -222,7 +222,7 @@ ## Parse the output from zip and unzip. ## Skip first line which is Archive header - output(1) = []; + output(1) = []; for i = 1:length (output) files{i} = output{i}(14:length(output{i})); endfor
new file mode 100644 --- /dev/null +++ b/scripts/miscellaneous/usejava.m @@ -0,0 +1,67 @@ +## Copyright (C) 2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} usejava (@var{feature}) +## Return true if the specific Sun Java element @var{feature} is available. +## +## Possible features are: +## +## @table @asis +## @item "awt" +## Abstract Window Toolkit for GUIs. +## +## @item "desktop" +## Interactive desktop is running. +## +## @item "jvm" +## Java Virtual Machine. +## +## @item "swing" +## Swing components for lightweight GUIs. +## @end table +## +## This function is provided for compatibility with @sc{matlab} scripts which +## may alter their behavior based on the availability of Java. Octave does +## not implement an interface to Java and this function always returns +## @code{false}. +## @end deftypefn + +function retval = usejava (feature) + + if (nargin != 1 || ! ischar (feature)) + print_usage (); + endif + + if (! any (strcmp (feature, {"awt", "desktop", "jvm", "swing"}))) + error ("usejava: unrecognized feature '%s'", feature); + endif + + retval = false; + +endfunction + + +%!assert (usejava ("awt"), false) + +%% Test input validation +%!error usejava () +%!error usejava (1, 2) +%!error usejava (1) +%!error <unrecognized feature> usejava ("abc") +
--- a/scripts/miscellaneous/ver.m +++ b/scripts/miscellaneous/ver.m @@ -40,9 +40,9 @@ ## Date respecting the version/revision. ## @end table ## -## @deftypefnx {Function File} {v =} ver (@code{"Octave"}) +## @deftypefnx {Function File} {v =} ver ("Octave") ## Return version information for Octave only. -## +## ## @deftypefnx {Function File} {v =} ver (@var{package}) ## Return version information for @var{package}. ##
--- a/scripts/miscellaneous/version.m +++ b/scripts/miscellaneous/version.m @@ -20,7 +20,7 @@ ## @deftypefn {Function File} {} version () ## Return the version number of Octave, as a string. ## -## This is an alias for the function @code{OCTAVE_VERSION} provided for +## This is an alias for the function @w{@env{OCTAVE_VERSION}} provided for ## compatibility ## @seealso{OCTAVE_VERSION}. ## @end deftypefn
--- a/scripts/miscellaneous/warning_ids.m +++ b/scripts/miscellaneous/warning_ids.m @@ -17,18 +17,22 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- +## @cindex warning ids ## @table @code +## @item Octave:abbreviated-property-match +## By default, the @code{Octave:abbreviated-property-match} warning is enabled. +## ## @item Octave:array-to-scalar ## If the @code{Octave:array-to-scalar} warning is enabled, Octave will ## warn when an implicit conversion from an array to a scalar value is -## attempted. By default, the @code{Octave:array-to-scalar} warning is -## disabled. +## attempted. +## By default, the @code{Octave:array-to-scalar} warning is disabled. ## ## @item Octave:array-to-vector ## If the @code{Octave:array-to-vector} warning is enabled, Octave will ## warn when an implicit conversion from an array to a vector value is -## attempted. By default, the @code{Octave:array-to-vector} warning is -## disabled. +## attempted. +## By default, the @code{Octave:array-to-vector} warning is disabled. ## ## @item Octave:assign-as-truth-value ## If the @code{Octave:assign-as-truth-value} warning is @@ -106,40 +110,33 @@ ## enabled, Octave will warn about possible changes in the meaning of ## some code due to changes in associativity for some operators. ## Associativity changes have typically been made for @sc{matlab} -## compatibility. By default, the @code{Octave:associativity-change} -## warning is enabled. +## compatibility. +## By default, the @code{Octave:associativity-change} warning is enabled. ## ## @item Octave:autoload-relative-file-name ## If the @code{Octave:autoload-relative-file-name} is enabled, ## Octave will warn when parsing autoload() function calls with relative -## paths to function files. This usually happens when using autoload() +## paths to function files. This usually happens when using autoload() ## calls in PKG_ADD files, when the PKG_ADD file is not in the same ## directory as the .oct file referred to by the autoload() command. -## By default, the @code{Octave:autoload-relative-file-name} -## warning is enabled. +## By default, the @code{Octave:autoload-relative-file-name} warning is enabled. +## +## @item Octave:broadcast +## Warn when performing broadcasting operations. By default, this is +## enabled. See @ref{Broadcasting} in the chapter Vectorization and Faster +## Code Execution of the manual. +## +## @item Octave:built-in-variable-assignment +## By default, the @code{Octave:built-in-variable-assignment} warning is +## enabled. ## ## @item Octave:divide-by-zero ## If the @code{Octave:divide-by-zero} warning is enabled, a -## warning is issued when Octave encounters a division by zero. By -## default, the @code{Octave:divide-by-zero} warning is enabled. -## -## @item Octave:empty-list-elements -## If the @code{Octave:empty-list-elements} warning is enabled, a -## warning is issued when an empty matrix is found in a matrix list. -## For example: +## warning is issued when Octave encounters a division by zero. +## By default, the @code{Octave:divide-by-zero} warning is enabled. ## -## @example -## a = [1, [], 3, [], 5] -## @end example -## -## @noindent -## By default, the @code{Octave:empty-list-elements} warning is enabled. -## -## @item Octave:fortran-indexing -## If the @code{Octave:fortran-indexing} warning is enabled, a warning is -## printed for expressions which select elements of a two-dimensional matrix -## using a single index. By default, the @code{Octave:fortran-indexing} -## warning is disabled. +## @item Octave:fopen-file-in-path +## By default, the @code{Octave:fopen-file-in-path} warning is enabled. ## ## @item Octave:function-name-clash ## If the @code{Octave:function-name-clash} warning is enabled, a @@ -151,23 +148,44 @@ ## @item Octave:future-time-stamp ## If the @code{Octave:future-time-stamp} warning is enabled, Octave ## will print a warning if it finds a function file with a time stamp -## that is in the future. By default, the -## @code{Octave:future-time-stamp} warning is enabled. +## that is in the future. +## By default, the @code{Octave:future-time-stamp} warning is enabled. +## +## @item Octave:glyph-render +## By default, the @code{Octave:glyph-render} warning is enabled. ## ## @item Octave:imag-to-real ## If the @code{Octave:imag-to-real} warning is enabled, a warning is ## printed for implicit conversions of complex numbers to real numbers. ## By default, the @code{Octave:imag-to-real} warning is disabled. ## +## @item Octave:load-file-in-path +## By default, the @code{Octave:load-file-in-path} warning is enabled. +## +## @item Octave:logical-conversion +## By default, the @code{Octave:logical-conversion} warning is enabled. +## ## @item Octave:matlab-incompatible ## Print warnings for Octave language features that may cause ## compatibility problems with @sc{matlab}. +## By default, the @code{Octave:matlab-incompatible} warning is disabled. +## +## @item Octave:md5sum-file-in-path +## By default, the @code{Octave:md5sum-file-in-path} warning is enabled. +## +## @item Octave:missing-glyph +## By default, the @code{Octave:missing-glyph} warning is enabled. ## ## @item Octave:missing-semicolon ## If the @code{Octave:missing-semicolon} warning is enabled, Octave ## will warn when statements in function definitions don't end in -## semicolons. By default the @code{Octave:missing-semicolon} warning -## is disabled. +## semicolons. +## By default the @code{Octave:missing-semicolon} warning is disabled. +## +## @item Octave:mixed-string-concat +## If the @code{Octave:mixed-string-concat} warning is enabled, print a +## warning when concatenating a mixture of double and single quoted strings. +## By default, the @code{Octave:mixed-string-concat} warning is disabled. ## ## @item Octave:neg-dim-as-zero ## If the @code{Octave:neg-dim-as-zero} warning is enabled, print a warning @@ -180,6 +198,12 @@ ## @noindent ## By default, the @code{Octave:neg-dim-as-zero} warning is disabled. ## +## @item Octave:nested-functions-coerced +## By default, the @code{Octave:nested-functions-coerced} warning is enabled. +## +## @item Octave:noninteger-range-as-index +## By default, the @code{Octave:noninteger-range-as-index} warning is enabled. +## ## @item Octave:num-to-str ## If the @code{Octave:num-to-str} warning is enable, a warning is ## printed for implicit conversions of numbers to their ASCII character @@ -201,8 +225,8 @@ ## If the @code{Octave:possible-matlab-short-circuit-operator} warning ## is enabled, Octave will warn about using the not short circuiting ## operators @code{&} and @code{|} inside @code{if} or @code{while} -## conditions. They normally never short circuit, but @sc{Matlab} always -## short circuits if any logical operators are used in a condition. You +## conditions. They normally never short circuit, but @sc{matlab} always +## short circuits if any logical operators are used in a condition. You ## can turn on the option ## ## @example @@ -213,39 +237,55 @@ ## ## @noindent ## if you would like to enable this short-circuit evaluation in -## Octave. Note that the @code{&&} and @code{||} operators always short -## circuit in both Octave and @sc{Matlab}, so it's only necessary to -## enable @sc{Matlab}-style short-circuiting it's too arduous to modify -## existing code that relies on this behaviour. +## Octave. Note that the @code{&&} and @code{||} operators always short +## circuit in both Octave and @sc{matlab}, so it's only necessary to +## enable @sc{matlab}-style short-circuiting it's too arduous to modify +## existing code that relies on this behavior. +## By default, the @code{Octave:possible-matlab-short-circuit-operator} warning +## is enabled. ## ## @item Octave:precedence-change ## If the @code{Octave:precedence-change} warning is enabled, Octave ## will warn about possible changes in the meaning of some code due to ## changes in precedence for some operators. Precedence changes have -## typically been made for @sc{matlab} compatibility. By default, the -## @code{Octave:precedence-change} warning is enabled. +## typically been made for @sc{matlab} compatibility. +## By default, the @code{Octave:precedence-change} warning is enabled. +## +## @item Octave:recursive-path-search +## By default, the @code{Octave:recursive-path-search} warning is enabled. ## ## @item Octave:reload-forces-clear ## If several functions have been loaded from the same file, Octave must ## clear all the functions before any one of them can be reloaded. If ## the @code{Octave:reload-forces-clear} warning is enabled, Octave will ## warn you when this happens, and print a list of the additional -## functions that it is forced to clear. By default, the -## @code{Octave:reload-forces-clear} warning is enabled. +## functions that it is forced to clear. +## By default, the @code{Octave:reload-forces-clear} warning is enabled. ## ## @item Octave:resize-on-range-error ## If the @code{Octave:resize-on-range-error} warning is enabled, print a ## warning when a matrix is resized by an indexed assignment with -## indices outside the current bounds. By default, the -## @code{Octave:resize-on-range-error} warning is disabled. +## indices outside the current bounds. +## By default, the ## @code{Octave:resize-on-range-error} warning is disabled. ## ## @item Octave:separator-insert ## Print warning if commas or semicolons might be inserted ## automatically in literal matrices. +## By default, the @code{Octave:separator-insert} warning is disabled. +## +## @item Octave:shadowed-function +## By default, the @code{Octave:shadowed-function} warning is enabled. ## ## @item Octave:single-quote-string ## Print warning if a single quote character is used to introduce a ## string constant. +## By default, the @code{Octave:single-quote-string} warning is disabled. +## +## @item Octave:singular-matrix-div +## By default, the @code{Octave:singular-matrix-div} warning is enabled. +## +## @item Octave:sqrtm:SingularMatrix +## By default, the @code{Octave:sqrtm:SingularMatrix} warning is enabled. ## ## @item Octave:str-to-num ## If the @code{Octave:str-to-num} warning is enabled, a warning is printed @@ -263,24 +303,22 @@ ## elicits a warning if the @code{Octave:str-to-num} warning is enabled. ## By default, the @code{Octave:str-to-num} warning is disabled. ## -## @item Octave:string-concat -## If the @code{Octave:string-concat} warning is enabled, print a -## warning when concatenating a mixture of double and single quoted strings. -## By default, the @code{Octave:string-concat} warning is disabled. -## ## @item Octave:undefined-return-values ## If the @code{Octave:undefined-return-values} warning is disabled, ## print a warning if a function does not define all the values in -## the return list which are expected. By default, the -## @code{Octave:undefined-return-values} warning is enabled. +## the return list which are expected. +## By default, the @code{Octave:undefined-return-values} warning is enabled. ## ## @item Octave:variable-switch-label ## If the @code{Octave:variable-switch-label} warning is enabled, Octave ## will print a warning if a switch label is not a constant or constant -## expression. By default, the @code{Octave:variable-switch-label} -## warning is disabled. +## expression. +## By default, the @code{Octave:variable-switch-label} warning is disabled. ## @end table function warning_ids () help ("warning_ids"); endfunction + +## Remove from test statistics. No real tests possible +%!assert (1)
--- a/scripts/miscellaneous/what.m +++ b/scripts/miscellaneous/what.m @@ -20,10 +20,9 @@ ## @deftypefn {Command} {} what ## @deftypefnx {Command} {} what @var{dir} ## @deftypefnx {Function File} {w =} what (@var{dir}) -## List the Octave specific files in a directory. If the variable @var{dir} -## is given then check that directory rather than the current directory. If -## a return argument is requested, the files found are returned in the -## structure @var{w}. +## List the Octave specific files in directory @var{dir}. If @var{dir} is +## not specified then the current directory is used. If a return argument is +## requested, the files found are returned in the structure @var{w}. ## @seealso{which} ## @end deftypefn @@ -91,7 +90,7 @@ if (length (f) > 0) printf ("%s %s:\n\n", msg, p); - maxlen = max (cellfun (@length, f)); + maxlen = max (cellfun ("length", f)); ncols = max (1, floor (terminal_size()(2) / (maxlen + 3))); fmt = ""; for i = 1: ncols
--- a/scripts/miscellaneous/xor.m +++ b/scripts/miscellaneous/xor.m @@ -17,11 +17,24 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Mapping Function} {} xor (@var{x}, @var{y}) +## @deftypefn {Mapping Function} {@var{z} =} xor (@var{x}, @var{y}) ## Return the `exclusive or' of the entries of @var{x} and @var{y}. ## For boolean expressions @var{x} and @var{y}, -## @code{xor (@var{x}, @var{y})} is true if and only if @var{x} or @var{y} -## is true, but not if both @var{x} and @var{y} are true. +## @code{xor (@var{x}, @var{y})} is true if and only if one of @var{x} or +## @var{y} is true. Otherwise, for @var{x} and @var{y} both true or both +## false, @code{xor} returns false. +## +## The truth table for the xor operation is +## +## @multitable @columnfractions 0.44 .03 .05 .03 0.44 +## @item @tab @var{x} @tab @var{y} @tab @var{z} @tab +## @item @tab 0 @tab 0 @tab 0 @tab +## @item @tab 1 @tab 0 @tab 1 @tab +## @item @tab 0 @tab 1 @tab 1 @tab +## @item @tab 1 @tab 1 @tab 0 @tab +## @end multitable +## +## @seealso{and, or, not} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -35,7 +48,11 @@ ## Typecast to logicals is necessary for other numeric types. z = logical (x) != logical (y); else - error ("xor: X and Y must be of common size or scalars"); + try + z = bsxfun (@xor, x, y); + catch + error ("xor: X and Y must be of compatible size or scalars"); + end_try_catch endif else print_usage ();
--- a/scripts/optimization/__all_opts__.m +++ b/scripts/optimization/__all_opts__.m @@ -67,3 +67,7 @@ endfunction + +## No test needed for internal helper function. +%!assert (1) +
--- a/scripts/optimization/fminbnd.m +++ b/scripts/optimization/fminbnd.m @@ -49,7 +49,8 @@ ## This is patterned after opt/fmin.f from Netlib, which in turn is taken from ## Richard Brent: Algorithms For Minimization Without Derivatives, Prentice-Hall (1973) -## PKG_ADD: __all_opts__ ("fminbnd"); +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("fminbnd"); function [x, fval, info, output] = fminbnd (fun, xmin, xmax, options = struct ())
--- a/scripts/optimization/fminunc.m +++ b/scripts/optimization/fminunc.m @@ -21,7 +21,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} fminunc (@var{fcn}, @var{x0}) ## @deftypefnx {Function File} {} fminunc (@var{fcn}, @var{x0}, @var{options}) -## @deftypefnx {Function File} {[@var{x}, @var{fvec}, @var{info}, @var{output}, @var{grad}, @var{hess}]} = fminunc (@var{fcn}, @dots{}) +## @deftypefnx {Function File} {[@var{x}, @var{fvec}, @var{info}, @var{output}, @var{grad}, @var{hess}] =} fminunc (@var{fcn}, @dots{}) ## Solve an unconstrained optimization problem defined by the function ## @var{fcn}. ## @var{fcn} should accepts a vector (array) defining the unknown variables, @@ -59,7 +59,7 @@ ## Last relative step size was less that TolX. ## ## @item 3 -## Last relative decrease in func value was less than TolF. +## Last relative decrease in function value was less than TolF. ## ## @item 0 ## Iteration limit exceeded. @@ -77,7 +77,8 @@ ## @seealso{fminbnd, optimset} ## @end deftypefn -## PKG_ADD: __all_opts__ ("fminunc"); +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("fminunc"); function [x, fval, info, output, grad, hess] = fminunc (fcn, x0, options = struct ()) @@ -358,17 +359,18 @@ endif endfunction -%!function f = rosenb (x) +%!function f = __rosenb (x) %! n = length (x); %! f = sumsq (1 - x(1:n-1)) + 100 * sumsq (x(2:n) - x(1:n-1).^2); +%!endfunction %!test -%! [x, fval, info, out] = fminunc (@rosenb, [5, -5]); +%! [x, fval, info, out] = fminunc (@__rosenb, [5, -5]); %! tol = 2e-5; %! assert (info > 0); %! assert (x, ones (1, 2), tol); %! assert (fval, 0, tol); %!test -%! [x, fval, info, out] = fminunc (@rosenb, zeros (1, 4)); +%! [x, fval, info, out] = fminunc (@__rosenb, zeros (1, 4)); %! tol = 2e-5; %! assert (info > 0); %! assert (x, ones (1, 4), tol);
--- a/scripts/optimization/fsolve.m +++ b/scripts/optimization/fsolve.m @@ -127,7 +127,8 @@ ## @end example ## @end deftypefn -## PKG_ADD: __all_opts__ ("fsolve"); +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("fsolve"); function [x, fvec, info, output, fjac] = fsolve (fcn, x0, options = struct ()) @@ -459,7 +460,7 @@ endif endfunction -%!function retval = f (p) +%!function retval = __f (p) %! x = p(1); %! y = p(2); %! z = p(3); @@ -467,17 +468,18 @@ %! retval(1) = sin(x) + y**2 + log(z) - 7; %! retval(2) = 3*x + 2**y -z**3 + 1; %! retval(3) = x + y + z - 5; +%!endfunction %!test %! x_opt = [ 0.599054; %! 2.395931; %! 2.005014 ]; %! tol = 1.0e-5; -%! [x, fval, info] = fsolve (@f, [ 0.5; 2.0; 2.5 ]); +%! [x, fval, info] = fsolve (@__f, [ 0.5; 2.0; 2.5 ]); %! assert (info > 0); %! assert (norm (x - x_opt, Inf) < tol); %! assert (norm (fval) < tol); -%!function retval = f (p) +%!function retval = __f (p) %! x = p(1); %! y = p(2); %! z = p(3); @@ -487,15 +489,16 @@ %! retval(2) = 6*x - 4*y + exp (3*z + w) - 11; %! retval(3) = x^4 - 4*y^2 + 6*z - 8*w - 20; %! retval(4) = x^2 + 2*y^3 + z - w - 4; +%!endfunction %!test %! x_opt = [ -0.767297326653401, 0.590671081117440, 1.47190018629642, -1.52719341133957 ]; %! tol = 1.0e-5; -%! [x, fval, info] = fsolve (@f, [-1, 1, 2, -1]); +%! [x, fval, info] = fsolve (@__f, [-1, 1, 2, -1]); %! assert (info > 0); %! assert (norm (x - x_opt, Inf) < tol); %! assert (norm (fval) < tol); -%!function retval = f (p) +%!function retval = __f (p) %! x = p(1); %! y = p(2); %! z = p(3); @@ -504,17 +507,18 @@ %! retval(2) = 3*x + 2**y -z**3 + 1; %! retval(3) = x + y + z - 5; %! retval(4) = x*x + y - z*log(z) - 1.36; +%!endfunction %!test %! x_opt = [ 0.599054; %! 2.395931; %! 2.005014 ]; %! tol = 1.0e-5; -%! [x, fval, info] = fsolve (@f, [ 0.5; 2.0; 2.5 ]); +%! [x, fval, info] = fsolve (@__f, [ 0.5; 2.0; 2.5 ]); %! assert (info > 0); %! assert (norm (x - x_opt, Inf) < tol); %! assert (norm (fval) < tol); -%!function retval = f (p) +%!function retval = __f (p) %! x = p(1); %! y = p(2); %! z = p(3); @@ -522,13 +526,14 @@ %! retval(1) = sin(x) + y**2 + log(z) - 7; %! retval(2) = 3*x + 2**y -z**3 + 1; %! retval(3) = x + y + z - 5; +%!endfunction %!test %! x_opt = [ 0.599054; %! 2.395931; %! 2.005014 ]; %! tol = 1.0e-5; %! opt = optimset ("Updating", "qrp"); -%! [x, fval, info] = fsolve (@f, [ 0.5; 2.0; 2.5 ], opt); +%! [x, fval, info] = fsolve (@__f, [ 0.5; 2.0; 2.5 ], opt); %! assert (info > 0); %! assert (norm (x - x_opt, Inf) < tol); %! assert (norm (fval) < tol); @@ -552,6 +557,7 @@ %! y(1) = (1+i)*x(1)^2 - (1-i)*x(2) - 2; %! y(2) = sqrt (x(1)*x(2)) - (1-2i)*x(3) + (3-4i); %! y(3) = x(1) * x(2) - x(3)^2 + (3+2i); +%!endfunction %!test %! x_opt = [-1+i, 1-i, 2+i];
--- a/scripts/optimization/fzero.m +++ b/scripts/optimization/fzero.m @@ -24,10 +24,12 @@ ## @deftypefnx {Function File} {[@var{x}, @var{fval}, @var{info}, @var{output}] =} fzero (@dots{}) ## Find a zero of a univariate function. ## -## @var{fun} should be a function handle or name. @var{x0} should be a -## two-element vector specifying two points which bracket a zero. In -## other words, there must be a change in sign of the function between -## @var{x0}(1) and @var{x0}(2). More mathematically, the following must hold +## @var{fun} is a function handle, inline function, or string +## containing the name of the function to evaluate. +## @var{x0} should be a two-element vector specifying two points which +## bracket a zero. In other words, there must be a change in sign of the +## function between @var{x0}(1) and @var{x0}(2). More mathematically, the +## following must hold ## ## @example ## sign (@var{fun}(@var{x0}(1))) * sign (@var{fun}(@var{x0}(2))) <= 0 @@ -91,7 +93,8 @@ ## the need for external functions and error handling. The algorithm has ## also been slightly modified. -## PKG_ADD: __all_opts__ ("fzero"); +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("fzero"); function [x, fval, info, output] = fzero (fun, x0, options = struct ())
--- a/scripts/optimization/glpk.m +++ b/scripts/optimization/glpk.m @@ -342,14 +342,19 @@ ## @table @asis ## @item 180 (@w{@code{LPX_OPT}}) ## Solution is optimal. +## ## @item 181 (@w{@code{LPX_FEAS}}) ## Solution is feasible. +## ## @item 182 (@w{@code{LPX_INFEAS}}) ## Solution is infeasible. +## ## @item 183 (@w{@code{LPX_NOFEAS}}) ## Problem has no feasible solution. +## ## @item 184 (@w{@code{LPX_UNBND}}) ## Problem has no unbounded solution. +## ## @item 185 (@w{@code{LPX_UNDEF}}) ## Solution status is undefined. ## @end table @@ -357,6 +362,7 @@ ## @table @asis ## @item 150 (@w{@code{LPX_T_UNDEF}}) ## The interior point method is undefined. +## ## @item 151 (@w{@code{LPX_T_OPT}}) ## The interior point method is optimal. ## @end table @@ -364,10 +370,13 @@ ## @table @asis ## @item 170 (@w{@code{LPX_I_UNDEF}}) ## The status is undefined. +## ## @item 171 (@w{@code{LPX_I_OPT}}) ## The solution is integer optimal. +## ## @item 172 (@w{@code{LPX_I_FEAS}}) ## Solution integer feasible but its optimality has not been proven +## ## @item 173 (@w{@code{LPX_I_NOFEAS}}) ## No integer feasible solution. ## @end table @@ -378,24 +387,34 @@ ## @table @asis ## @item 204 (@w{@code{LPX_E_FAULT}}) ## Unable to start the search. +## ## @item 205 (@w{@code{LPX_E_OBJLL}}) ## Objective function lower limit reached. +## ## @item 206 (@w{@code{LPX_E_OBJUL}}) ## Objective function upper limit reached. +## ## @item 207 (@w{@code{LPX_E_ITLIM}}) ## Iterations limit exhausted. +## ## @item 208 (@w{@code{LPX_E_TMLIM}}) ## Time limit exhausted. +## ## @item 209 (@w{@code{LPX_E_NOFEAS}}) ## No feasible solution. +## ## @item 210 (@w{@code{LPX_E_INSTAB}}) ## Numerical instability. +## ## @item 211 (@w{@code{LPX_E_SING}}) ## Problems with basis matrix. +## ## @item 212 (@w{@code{LPX_E_NOCONV}}) ## No convergence (interior). +## ## @item 213 (@w{@code{LPX_E_NOPFS}}) ## No primal feasible solution (LP presolver). +## ## @item 214 (@w{@code{LPX_E_NODFS}}) ## No dual feasible solution (LP presolver). ## @end table
--- a/scripts/optimization/lsqnonneg.m +++ b/scripts/optimization/lsqnonneg.m @@ -63,7 +63,8 @@ ## @seealso{optimset, pqpnonneg} ## @end deftypefn -## PKG_ADD: __all_opts__ ("lsqnonneg"); +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("lsqnonneg"); ## This is implemented from Lawson and Hanson's 1973 algorithm on page ## 161 of Solving Least Squares Problems.
--- a/scripts/optimization/optimset.m +++ b/scripts/optimization/optimset.m @@ -23,6 +23,57 @@ ## @deftypefnx {Function File} {} optimset (@var{old}, @var{par}, @var{val}, @dots{}) ## @deftypefnx {Function File} {} optimset (@var{old}, @var{new}) ## Create options struct for optimization functions. +## +## Valid parameters are: +## @itemize @bullet +## @item AutoScaling +## +## @item ComplexEqn +## +## @item FinDiffType +## +## @item FunValCheck +## When enabled, display an error if the objective function returns a complex +## value or NaN@. Must be set to "on" or "off" [default]. +## +## @item GradObj +## When set to "on", the function to be minimized must return a second argument +## which is the gradient, or first derivative, of the function at the point +## @var{x}. If set to "off" [default], the gradient is computed via finite +## differences. +## +## @item Jacobian +## When set to "on", the function to be minimized must return a second argument +## which is the Jacobian, or first derivative, of the function at the point +## @var{x}. If set to "off" [default], the Jacobian is computed via finite +## differences. +## +## @item MaxFunEvals +## Maximum number of function evaluations before optimization stops. +## Must be a positive integer. +## +## @item MaxIter +## Maximum number of algorithm iterations before optimization stops. +## Must be a positive integer. +## +## @item OutputFcn +## A user-defined function executed once per algorithm iteration. +## +## @item TolFun +## Termination criterion for the function output. If the difference in the +## calculated objective function between one algorithm iteration and the next +## is less than @code{TolFun} the optimization stops. Must be a positive +## scalar. +## +## @item TolX +## Termination criterion for the function input. If the difference in @var{x}, +## the current search point, between one algorithm iteration and the next is +## less than @code{TolX} the optimization stops. Must be a positive scalar. +## +## @item TypicalX +## +## @item Updating +## @end itemize ## @end deftypefn function retval = optimset (varargin) @@ -39,9 +90,8 @@ printf (" %s\n", opts{:}); puts ("\n"); else - ## Return empty structure. - ## We're incompatible with Matlab at this point. - retval = struct (); + ## Return struct with all options initialized to [] + retval = cell2struct (repmat ({[]}, size (opts)), opts, 2); endif elseif (nargs == 1 && ischar (varargin{1})) ## Return defaults for named function. @@ -90,5 +140,9 @@ endfunction + %!assert (optimget (optimset ('tolx', 1e-2), 'tOLx'), 1e-2) %!assert (isfield (optimset ('tolFun', 1e-3), 'TolFun')) + +%!error (optimset ("%NOT_A_REAL_FUNCTION_NAME%")) +
--- a/scripts/optimization/pqpnonneg.m +++ b/scripts/optimization/pqpnonneg.m @@ -58,7 +58,8 @@ ## @seealso{optimset, lsqnonneg, qp} ## @end deftypefn -## PKG_ADD: __all_opts__ ("pqpnonneg"); +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("pqpnonneg"); ## This is analogical to the lsqnonneg implementation, which is ## implemented from Lawson and Hanson's 1973 algorithm on page
--- a/scripts/optimization/qp.m +++ b/scripts/optimization/qp.m @@ -108,7 +108,8 @@ ## @end table ## @end deftypefn -## PKG_ADD: __all_opts__ ("qp"); +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("qp"); function [x, obj, INFO, lambda] = qp (x0, H, varargin)
--- a/scripts/optimization/sqp.m +++ b/scripts/optimization/sqp.m @@ -22,7 +22,7 @@ ## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}, @var{h}) ## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}, @var{h}, @var{lb}, @var{ub}) ## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}, @var{h}, @var{lb}, @var{ub}, @var{maxiter}) -## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}, @var{h}, @var{lb}, @var{ub}, @var{maxiter}, @var{tolerance}) +## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}, @var{h}, @var{lb}, @var{ub}, @var{maxiter}, @var{tol}) ## Solve the nonlinear program ## @tex ## $$ @@ -62,14 +62,8 @@ ## The first argument is the initial guess for the vector @var{x0}. ## ## The second argument is a function handle pointing to the objective -## function. The objective function must be of the form -## -## @example -## @var{y} = phi (@var{x}) -## @end example -## -## @noindent -## in which @var{x} is a vector and @var{y} is a scalar. +## function @var{phi}. The objective function must accept one vector +## argument and return a scalar. ## ## The second argument may also be a 2- or 3-element cell array of ## function handles. The first element should point to the objective @@ -80,40 +74,18 @@ ## differences. If the Hessian function is not supplied, a BFGS update ## formula is used to approximate the Hessian. ## -## When supplied, the gradient function must be of the form -## -## @example -## @var{g} = gradient (@var{x}) -## @end example -## -## @noindent -## in which @var{x} is a vector and @var{g} is a vector. -## -## When supplied, the Hessian function must be of the form -## -## @example -## @var{h} = hessian (@var{x}) -## @end example +## When supplied, the gradient function @code{@var{phi}@{2@}} must accept +## one vector argument and return a vector. When supplied, the Hessian +## function @code{@var{phi}@{3@}} must accept one vector argument and +## return a matrix. ## -## @noindent -## in which @var{x} is a vector and @var{h} is a matrix. -## -## The third and fourth arguments are function handles pointing to -## functions that compute the equality constraints and the inequality -## constraints, respectively. -## -## If the problem does not have equality (or inequality) constraints, -## then use an empty matrix ([]) for @var{cef} (or @var{cif}). -## -## When supplied, the equality and inequality constraint functions must be -## of the form -## -## @example -## @var{r} = f (@var{x}) -## @end example -## -## @noindent -## in which @var{x} is a vector and @var{r} is a vector. +## The third and fourth arguments @var{g} and @var{h} are function +## handles pointing to functions that compute the equality constraints +## and the inequality constraints, respectively. If the problem does +## not have equality (or inequality) constraints, then use an empty +## matrix ([]) for @var{g} (or @var{h}). When supplied, these equality +## and inequality constraint functions must accept one vector argument +## and return a vector. ## ## The third and fourth arguments may also be 2-element cell arrays of ## function handles. The first element should point to the constraint @@ -137,19 +109,20 @@ ## @end example ## ## @end ifnottex -## The fifth and sixth arguments contain lower and upper bounds -## on @var{x}. These must be consistent with the equality and inequality -## constraints @var{g} and @var{h}. If the arguments are vectors then -## @var{x}(i) is bound by @var{lb}(i) and @var{ub}(i). A bound can also -## be a scalar in which case all elements of @var{x} will share the same -## bound. If only one bound (lb, ub) is specified then the other will -## default to (-@var{realmax}, +@var{realmax}). +## The fifth and sixth arguments, @var{lb} and @var{ub}, contain lower +## and upper bounds on @var{x}. These must be consistent with the +## equality and inequality constraints @var{g} and @var{h}. If the +## arguments are vectors then @var{x}(i) is bound by @var{lb}(i) and +## @var{ub}(i). A bound can also be a scalar in which case all elements +## of @var{x} will share the same bound. If only one bound (lb, ub) is +## specified then the other will default to (-@var{realmax}, +## +@var{realmax}). ## -## The seventh argument specifies the maximum number of iterations. -## The default value is 100. +## The seventh argument @var{maxiter} specifies the maximum number of +## iterations. The default value is 100. ## -## The eighth argument specifies the tolerance for the stopping criteria. -## The default value is @code{sqrt(eps)}. +## The eighth argument @var{tol} specifies the tolerance for the +## stopping criteria. The default value is @code{sqrt(eps)}. ## ## The value returned in @var{info} may be one of the following: ## @@ -163,7 +136,7 @@ ## @ifnottex ## delta @var{x}, ## @end ifnottex -## is less than @code{tol * norm (x)}. +## is less than @code{@var{tol} * norm (x)}. ## ## @item 102 ## The BFGS update failed. @@ -443,7 +416,19 @@ info = INFO.info; - ## Check QP solution and attempt to recover if it has failed. + ## FIXME -- check QP solution and attempt to recover if it has + ## failed. For now, just warn about possible problems. + + id = "Octave:SQP-QP-subproblem"; + switch (info) + case 2 + warning (id, "sqp: QP subproblem is non-convex and unbounded"); + case 3 + warning (id, "sqp: QP subproblem failed to converge in %d iterations", + INFO.solveiter); + case 6 + warning (id, "sqp: QP subproblem is infeasible"); + endswitch ## Choose mu such that p is a descent direction for the chosen ## merit function phi. @@ -751,19 +736,21 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Test Code -%!function r = g (x) +%!function r = __g (x) %! r = [sumsq(x)-10; %! x(2)*x(3)-5*x(4)*x(5); %! x(1)^3+x(2)^3+1 ]; +%!endfunction %! -%!function obj = phi (x) +%!function obj = __phi (x) %! obj = exp(prod(x)) - 0.5*(x(1)^3+x(2)^3+1)^2; +%!endfunction %! %!test %! %! x0 = [-1.8; 1.7; 1.9; -0.8; -0.8]; %! -%! [x, obj, info, iter, nf, lambda] = sqp (x0, @phi, @g, []); +%! [x, obj, info, iter, nf, lambda] = sqp (x0, @__phi, @__g, []); %! %! x_opt = [-1.717143501952599; %! 1.595709610928535;
--- a/scripts/path/matlabroot.m +++ b/scripts/path/matlabroot.m @@ -20,7 +20,7 @@ ## @deftypefn {Function File} {} matlabroot () ## Return the name of the top-level Octave installation directory. ## -## This is an alias for the function @code{OCTAVE_HOME} provided +## This is an alias for the function @w{@code{OCTAVE_HOME}} provided ## for compatibility. ## @seealso{OCTAVE_HOME} ## @end deftypefn @@ -31,5 +31,5 @@ endfunction +%!assert (matlabroot(), OCTAVE_HOME()) -
--- a/scripts/pkg/module.mk +++ b/scripts/pkg/module.mk @@ -1,8 +1,11 @@ FCN_FILE_DIRS += pkg +pkg_PRIVATE_FCN_FILES = \ + pkg/private/get_forge_pkg.m + pkg_FCN_FILES = \ pkg/pkg.m \ - pkg/get_forge_pkg.m + $(pkg_PRIVATE_FCN_FILES) FCN_FILES += $(pkg_FCN_FILES)
--- a/scripts/pkg/pkg.m +++ b/scripts/pkg/pkg.m @@ -20,8 +20,10 @@ ## -*- texinfo -*- ## @deftypefn {Command} {} pkg @var{command} @var{pkg_name} ## @deftypefnx {Command} {} pkg @var{command} @var{option} @var{pkg_name} -## This command interacts with the package manager. Different actions will -## be taken depending on the value of @var{command}. +## Manage packages (groups of add-on functions) for Octave. Different actions +## are available depending on the value of @var{command}. +## +## Available commands: ## ## @table @samp ## @@ -40,30 +42,44 @@ ## ## @table @code ## @item -nodeps -## The package manager will disable the dependency checking. That way it -## is possible to install a package even if it depends on another package -## that's not installed on the system. @strong{Use this option with care.} +## The package manager will disable dependency checking. With this option it +## is possible to install a package even when it depends on another package +## which is not installed on the system. @strong{Use this option with care.} ## ## @item -noauto ## The package manager will not automatically load the installed package -## when starting Octave, even if the package requests that it is. +## when starting Octave. This overrides any setting within the package. ## ## @item -auto ## The package manager will automatically load the installed package when -## starting Octave, even if the package requests that it isn't. +## starting Octave. This overrides any setting within the package. ## ## @item -local -## A local installation is forced, even if the user has system privileges. +## A local installation (package available only to current user) is forced, +## even if the user has system privileges. ## ## @item -global -## A global installation is forced, even if the user doesn't normally have -## system privileges +## A global installation (package available to all users) is forced, even if +## the user doesn't normally have system privileges. +## +## @item -forge +## Install a package directly from the Octave-Forge repository. This +## requires an internet connection and the cURL library. ## ## @item -verbose -## The package manager will print the output of all of the commands that are -## performed. +## The package manager will print the output of all commands as +## they are performed. ## @end table ## +## @item update +## Check installed Octave-Forge packages against repository and update any +## outdated items. This requires an internet connection and the cURL library. +## Usage: +## +## @example +## pkg update +## @end example +## ## @item uninstall ## Uninstall named packages. For example, ## @@ -86,44 +102,53 @@ ## ## @noindent ## adds the @code{image} package to the path. It is possible to load all -## installed packages at once with the command +## installed packages at once with the keyword @samp{all}. Usage: ## ## @example ## pkg load all ## @end example ## ## @item unload -## Removes named packages from the path. After unloading a package it is -## no longer possible to use the functions provided by the package. -## This command behaves like the @code{load} command. +## Remove named packages from the path. After unloading a package it is +## no longer possible to use the functions provided by the package. It is +## possible to unload all installed packages at once with the keyword +## @samp{all}. Usage: +## +## @example +## pkg unload all +## @end example ## ## @item list -## Show a list of the currently installed packages. By requesting one or two -## output argument it is possible to get a list of the currently installed -## packages. For example, +## Show the list of currently installed packages. For example, ## ## @example -## installed_packages = pkg list; +## installed_packages = pkg ("list") ## @end example ## ## @noindent ## returns a cell array containing a structure for each installed package. -## The command +## +## If two output arguments are requested @code{pkg} splits the list of +## installed packages into those which were installed by the current user, +## and those which were installed by the system administrator. ## ## @example -## [@var{user_packages}, @var{system_packages}] = pkg list +## [user_packages, system_packages] = pkg ("list") ## @end example ## -## @noindent -## splits the list of installed packages into those who are installed by -## the current user, and those installed by the system administrator. +## The option '-forge' lists packages available at the Octave-Forge repository. +## This requires an internet connection and the cURL library. For example: +## +## @example +## oct_forge_pkgs = pkg ("list", "-forge") +## @end example ## ## @item describe ## Show a short description of the named installed packages, with the option -## '-verbose' also list functions provided by the package, e.g.: +## '-verbose' also list functions provided by the package. For example, ## ## @example -## pkg describe -verbose all +## pkg describe -verbose all ## @end example ## ## @noindent @@ -133,7 +158,7 @@ ## output rather than printed on screen: ## ## @example -## desc = pkg ("describe", "secs1d", "image") +## desc = pkg ("describe", "secs1d", "image") ## @end example ## ## @noindent @@ -141,7 +166,7 @@ ## error, unless a second output is requested: ## ## @example -## [ desc, flag] = pkg ("describe", "secs1d", "image") +## [desc, flag] = pkg ("describe", "secs1d", "image") ## @end example ## ## @noindent @@ -163,20 +188,20 @@ ## output argument. For example: ## ## @example -## p = pkg prefix +## pfx = pkg ("prefix") ## @end example ## ## The location in which to install the architecture dependent files can be -## independent specified with an addition argument. For example: +## independently specified with an addition argument. For example: ## ## @example ## pkg prefix ~/my_octave_packages ~/my_arch_dep_pkgs ## @end example ## ## @item local_list -## Set the file in which to look for information on the locally +## Set the file in which to look for information on locally ## installed packages. Locally installed packages are those that are -## typically available only to the current user. For example: +## available only to the current user. For example: ## ## @example ## pkg local_list ~/.octave_packages @@ -189,9 +214,9 @@ ## @end example ## ## @item global_list -## Set the file in which to look for, for information on the globally +## Set the file in which to look for information on globally ## installed packages. Globally installed packages are those that are -## typically available to all users. For example: +## available to all users. For example: ## ## @example ## pkg global_list /usr/share/octave/octave_packages @@ -203,21 +228,8 @@ ## pkg global_list ## @end example ## -## @item rebuild -## Rebuilds the package database from the installed directories. This can -## be used in cases where for some reason the package database is corrupted. -## It can also take the @option{-auto} and @option{-noauto} options to allow the -## autoloading state of a package to be changed. For example, -## -## @example -## pkg rebuild -noauto image -## @end example -## -## @noindent -## will remove the autoloading status of the image package. -## ## @item build -## Builds a binary form of a package or packages. The binary file produced +## Build a binary form of a package or packages. The binary file produced ## will itself be an Octave package that can be installed normally with ## @code{pkg}. The form of the command to build a binary package is ## @@ -229,7 +241,21 @@ ## where @code{builddir} is the name of a directory where the temporary ## installation will be produced and the binary packages will be found. ## The options @option{-verbose} and @option{-nodeps} are respected, while -## the other options are ignored. +## all other options are ignored. +## +## @item rebuild +## Rebuild the package database from the installed directories. This can +## be used in cases where the package database has been corrupted. +## It can also take the @option{-auto} and @option{-noauto} options to allow the +## autoloading state of a package to be changed. For example, +## +## @example +## pkg rebuild -noauto image +## @end example +## +## @noindent +## will remove the autoloading status of the image package. +## ## @end table ## @end deftypefn @@ -248,7 +274,7 @@ if (prefix == -1) if (global_install) prefix = fullfile (OCTAVE_HOME (), "share", "octave", "packages"); - archprefix = fullfile (octave_config_info ("libexecdir"), + archprefix = fullfile (octave_config_info ("libdir"), "octave", "packages"); else prefix = fullfile ("~", "octave"); @@ -260,7 +286,8 @@ available_actions = {"list", "install", "uninstall", "load", ... "unload", "prefix", "local_list", ... - "global_list", "rebuild", "build","describe"}; + "global_list", "rebuild", "build", ... + "describe", "update"}; ## Handle input if (length (varargin) == 0 || ! iscellstr (varargin)) print_usage (); @@ -281,6 +308,8 @@ auto = 1; case "-verbose" verbose = true; + ## Send verbose output to pager immediately. Change setting locally. + page_output_immediately (true, "local"); case "-forge" octave_forge = true; case "-local" @@ -293,7 +322,7 @@ global_install = true; if (! user_prefix) prefix = fullfile (OCTAVE_HOME (), "share", "octave", "packages"); - archprefix = fullfile (octave_config_info ("libexecdir"), + archprefix = fullfile (octave_config_info ("libdir"), "octave", "packages"); endif case available_actions @@ -342,8 +371,8 @@ unwind_protect if (octave_forge) - [urls, local_files] = cellfun (@get_forge_download, files, "uniformoutput", false); - [files, succ] = cellfun (@urlwrite, urls, local_files, "uniformoutput", false); + [urls, local_files] = cellfun ("get_forge_download", files, "uniformoutput", false); + [files, succ] = cellfun ("urlwrite", urls, local_files, "uniformoutput", false); succ = [succ{:}]; if (! all (succ)) i = find (! succ, 1); @@ -355,7 +384,7 @@ global_list, global_install); unwind_protect_cleanup - cellfun (@unlink, local_files); + cellfun ("unlink", local_files); end_unwind_protect case "uninstall" @@ -485,6 +514,21 @@ error ("you can request at most two outputs when calling 'pkg describe'"); endswitch + case "update" + if (nargout == 0) + installed_pkgs_lst = installed_packages (local_list, global_list); + for i = 1:length (installed_pkgs_lst) + installed_pkg_name = installed_pkgs_lst{i}.name; + installed_pkg_version = installed_pkgs_lst{i}.version; + forge_pkg_version = get_forge_pkg (installed_pkg_name); + if (compare_versions (forge_pkg_version, installed_pkg_version, ">")) + feval (@pkg, "install", "-forge", installed_pkg_name); + endif + endfor + else + error ("no output arguments available"); + endif + otherwise error ("you must specify a valid action for 'pkg'. See 'help pkg' for details"); endswitch @@ -902,6 +946,15 @@ load_packages_and_dependencies (idx, handle_deps, installed_pkgs_lst, global_install); endif + + ## If there's a NEWS file, mention it + ## we are checking if desc exists too because it's possible to ge to this point + ## without creating it such as giving an invalid filename for the package + if (exist ("desc", "var") && exist (fullfile (desc.dir, "packinfo", "NEWS"), "file")) + printf ("For information about changes from previous versions of the %s package, run 'news (\"%s\")'.\n", + desc.name, desc.name); + endif + endfunction function uninstall (pkgnames, handle_deps, verbose, local_list, @@ -1313,7 +1366,7 @@ flags = cstrcat (flags, " RANLIB=\"", octave_config_info ("RANLIB"), "\""); endif [status, output] = shell (cstrcat ("cd '", src, "'; ", scenv, - "./configure --prefix=\"", + "./configure --prefix=\"", desc.dir, "\"", flags)); if (status != 0) rm_rf (desc.dir); @@ -1376,7 +1429,7 @@ if (isempty (filenames)) idx = []; else - idx = cellfun (@is_architecture_dependent, filenames); + idx = cellfun ("is_architecture_dependent", filenames); endif archdependent = filenames (idx); archindependent = filenames (!idx); @@ -1582,42 +1635,17 @@ error ("couldn't create packinfo directory: %s", msg); endif - ## Copy DESCRIPTION. - [status, output] = copyfile (fullfile (packdir, "DESCRIPTION"), packinfo); - if (status != 1) - rm_rf (desc.dir); - rm_rf (octfiledir); - error ("couldn't copy DESCRIPTION: %s", output); - endif + packinfo_copy_file ("DESCRIPTION", "required", packdir, packinfo, desc, octfiledir); + packinfo_copy_file ("COPYING", "required", packdir, packinfo, desc, octfiledir); - ## Copy COPYING. - [status, output] = copyfile (fullfile (packdir, "COPYING"), packinfo); - if (status != 1) - rm_rf (desc.dir); - rm_rf (octfiledir); - error ("couldn't copy COPYING: %s", output); - endif - - ## If the file ChangeLog exists, copy it. - changelog_file = fullfile (packdir, "ChangeLog"); - if (exist (changelog_file, "file")) - [status, output] = copyfile (changelog_file, packinfo); - if (status != 1) - rm_rf (desc.dir); - rm_rf (octfiledir); - error ("couldn't copy ChangeLog file: %s", output); - endif - endif + packinfo_copy_file ("NEWS", "optional", packdir, packinfo, desc, octfiledir); + packinfo_copy_file ("ONEWS", "optional", packdir, packinfo, desc, octfiledir); + packinfo_copy_file ("ChangeLog", "optional", packdir, packinfo, desc, octfiledir); ## Is there an INDEX file to copy or should we generate one? index_file = fullfile (packdir, "INDEX"); if (exist(index_file, "file")) - [status, output] = copyfile (index_file, packinfo); - if (status != 1) - rm_rf (desc.dir); - rm_rf (octfiledir); - error ("couldn't copy INDEX file: %s", output); - endif + packinfo_copy_file ("INDEX", "required", packdir, packinfo, desc, octfiledir); else try write_index (desc, fullfile (packdir, "inst"), @@ -1630,15 +1658,7 @@ endif ## Is there an 'on_uninstall.m' to install? - fon_uninstall = fullfile (packdir, "on_uninstall.m"); - if (exist (fon_uninstall, "file")) - [status, output] = copyfile (fon_uninstall, packinfo); - if (status != 1) - rm_rf (desc.dir); - rm_rf (octfiledir); - error ("couldn't copy on_uninstall.m: %s", output); - endif - endif + packinfo_copy_file ("on_uninstall.m", "optional", packdir, packinfo, desc, octfiledir); ## Is there a doc/ directory that needs to be installed? docdir = fullfile (packdir, "doc"); @@ -1654,6 +1674,20 @@ endif endfunction +function packinfo_copy_file (filename, requirement, packdir, packinfo, desc, octfiledir) + filepath = fullfile (packdir, filename); + if (!exist (filepath, "file") && strcmpi (requirement, "optional")) + ## do nothing, it's still OK + else + [status, output] = copyfile (filepath, packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("Couldn't copy %s file: %s", filename, output); + endif + endif +endfunction + function finish_installation (desc, packdir, global_install) ## Is there a post-install to call? if (exist (fullfile (packdir, "post_install.m"), "file")) @@ -2165,13 +2199,8 @@ function [status_out, msg_out] = rm_rf (dir) if (exist (dir)) - crr = confirm_recursive_rmdir (); - unwind_protect - confirm_recursive_rmdir (false); - [status, msg] = rmdir (dir, "s"); - unwind_protect_cleanup - confirm_recursive_rmdir (crr); - end_unwind_protect + crr = confirm_recursive_rmdir (false, "local"); + [status, msg] = rmdir (dir, "s"); else status = 1; msg = ""; @@ -2212,14 +2241,14 @@ endfunction function arch = getarch () - persistent _arch = cstrcat (octave_config_info("canonical_host_type"), ... - "-", octave_config_info("api_version")); + persistent _arch = cstrcat (octave_config_info ("canonical_host_type"), + "-", octave_config_info ("api_version")); arch = _arch; endfunction function archprefix = getarchprefix (desc, global_install) if ((nargin == 2 && global_install) || (nargin < 2 && issuperuser ())) - archprefix = fullfile (octave_config_info ("libexecdir"), "octave", + archprefix = fullfile (octave_config_info ("libdir"), "octave", "packages", cstrcat(desc.name, "-", desc.version)); else archprefix = desc.dir;
rename from scripts/pkg/get_forge_pkg.m rename to scripts/pkg/private/get_forge_pkg.m --- a/scripts/pkg/get_forge_pkg.m +++ b/scripts/pkg/private/get_forge_pkg.m @@ -18,10 +18,10 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {[@var{ver}, @var{url}] =} get_forge_pkg (@var{name}) -## Tries to discover the current version of an OctaveForge package from the web, +## Try to discover the current version of an OctaveForge package from the web, ## using a working internet connection and the urlread function. -## If two output arguments are requested, returns also an address to download -## the file. +## If two output arguments are requested, also return an address from which +## to download the file. ## @end deftypefn function [ver, url] = get_forge_pkg (name)
--- a/scripts/plot/__gnuplot_drawnow__.m +++ b/scripts/plot/__gnuplot_drawnow__.m @@ -149,7 +149,7 @@ ## Generate gnuplot title string for plot windows. if (output_to_screen (term) && ~strcmp (term, "dumb")) fig.numbertitle = get (h, "numbertitle"); - fig.name = get (h, "name"); + fig.name = strrep (get (h, "name"), "\"", "\\\""); if (strcmpi (get (h, "numbertitle"), "on")) title_str = sprintf ("Figure %d", h); else @@ -386,3 +386,7 @@ endif endif endfunction + + +## No test needed for internal helper function. +%!assert (1)
deleted file mode 100644 --- a/scripts/plot/__go_close_all__.m +++ /dev/null @@ -1,28 +0,0 @@ -## Copyright (C) 2007-2011 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/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} __go_close_all__ () -## Undocumented internal function. -## @end deftypefn - -## Author: jwe - -function __go_close_all__ () - close ("all", "hidden"); -endfunction
--- a/scripts/plot/__plt_get_axis_arg__.m +++ b/scripts/plot/__plt_get_axis_arg__.m @@ -33,7 +33,7 @@ nogca = false; endif - ## Figure handles are integers, but object handles are non integer, + ## Figure handles are integers, but object handles are non-integer, ## therefore ignore integer scalars. if (nargin > 1 && length (varargin) > 0 && isnumeric (varargin{1}) && numel (varargin{1}) == 1 && ishandle (varargin{1}(1)) @@ -76,3 +76,7 @@ narg = length (varargin); endfunction + + +## No test needed for internal helper function. +%!assert (1)
--- a/scripts/plot/allchild.m +++ b/scripts/plot/allchild.m @@ -35,16 +35,23 @@ shh = get (0, "showhiddenhandles"); unwind_protect set (0, "showhiddenhandles", "on"); - if (isscalar (handles)) - h = get (handles, "children"); - else - h = cell (size (handles)); - for i = 1:numel (handles) - h{i} = get (handles, "children"); - endfor - endif + h = get (handles, "children"); unwind_protect_cleanup set (0, "showhiddenhandles", shh); end_unwind_protect endfunction + + +%!testif HAVE_FLTK +%! toolkit = graphics_toolkit (); +%! graphics_toolkit ("fltk"); +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! assert(get (allchild (hf),"type"),{"axes"; "uimenu"; "uimenu"; "uimenu"}); +%! unwind_protect_cleanup +%! close (hf); +%! graphics_toolkit (toolkit); +%! end_unwind_protect +
--- a/scripts/plot/ancestor.m +++ b/scripts/plot/ancestor.m @@ -74,3 +74,13 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! assert (ancestor (l, "axes"), gca); +%! assert (ancestor (l, "figure"), hf); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/area.m +++ b/scripts/plot/area.m @@ -33,9 +33,11 @@ ## @code{1 : rows (@var{y})}. A value @var{lvl} can be defined that determines ## where the base level of the shading under the curve should be defined. ## -## Additional arguments to the @code{area} function are passed to the -## @code{patch}. The optional return value @var{h} provides a handle to -## area series object representing the patches of the areas. +## Additional arguments to the @code{area} function are passed to +## @code{patch}. +## +## The optional return value @var{h} is a graphics handle to the hggroup +## object representing the area patch objects. ## @seealso{plot, patch} ## @end deftypefn
--- a/scripts/plot/axes.m +++ b/scripts/plot/axes.m @@ -28,8 +28,7 @@ function h = axes (varargin) if (nargin == 0 || nargin > 1) - ## make default axes object, and make it the current axes for the - ## current figure. + ## Create an axes object. idx = find (strcmpi (varargin(1:2:end), "parent"), 1, "first"); if (! isempty (idx) && length (varargin) >= 2*idx) cf = varargin{2*idx}; @@ -38,16 +37,19 @@ cf = gcf (); endif tmp = __go_axes__ (cf, varargin{:}); - set (ancestor (cf, "figure"), "currentaxes", tmp); + if (__is_handle_visible__ (tmp)) + set (ancestor (cf, "figure"), "currentaxes", tmp); + endif else - ## arg is axes handle, make it the current axes for the current - ## figure. + ## arg is axes handle. tmp = varargin{1}; if (length(tmp) == 1 && ishandle (tmp) && strcmp (get (tmp, "type"), "axes")) - parent = ancestor (tmp, "figure"); - set (0, "currentfigure", parent); - set (parent, "currentaxes", tmp); + if (__is_handle_visible__ (tmp)) + parent = ancestor (tmp, "figure"); + set (0, "currentfigure", parent); + set (parent, "currentaxes", tmp); + endif else error ("axes: expecting argument to be a scalar axes handle"); endif
--- a/scripts/plot/axis.m +++ b/scripts/plot/axis.m @@ -18,9 +18,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} axis () -## @deftypefnx {Function File} {} axis ([@var{x}_lo, @var{x}_hi]) -## @deftypefnx {Function File} {} axis ([@var{x}_lo, @var{x}_hi, @var{y}_lo, @var{y}_hi]) -## @deftypefnx {Function File} {} axis ([@var{x}_lo, @var{x}_hi, @var{y}_lo, @var{y}_hi, @var{z}_lo, @var{z}_hi]) +## @deftypefnx {Function File} {} axis ([@var{x}_lo @var{x}_hi]) +## @deftypefnx {Function File} {} axis ([@var{x}_lo @var{x}_hi @var{y}_lo @var{y}_hi]) +## @deftypefnx {Function File} {} axis ([@var{x}_lo @var{x}_hi @var{y}_lo @var{y}_hi @var{z}_lo @var{z}_hi]) ## @deftypefnx {Function File} {} axis (@var{option}) ## @deftypefnx {Function File} {} axis (@dots{}, @var{option}) ## @deftypefnx {Function File} {} axis (@var{h}, @dots{}) @@ -277,8 +277,8 @@ endif for i = 1:2:len - if (ax(i) == ax(i+1)) - error ("axis: limits(%d) cannot equal limits(%d)", i, i+1); + if (ax(i) >= ax(i+1)) + error ("axis: limits(%d) must be less than limits(%d)", i, i+1); endif endfor @@ -309,9 +309,9 @@ ## Get the limits for axis ("tight"). ## AX should be one of "x", "y", or "z". kids = findobj (ca, "-property", strcat (ax, "data")); - ## Since contours set the cdata for the patches to the hggroup zdata property, exclude - ## hgroups when determining the tight limits. - hg_kids = findobj (ca, "-property", strcat (ax, "data"), "type", "hggroup"); + ## The data properties for hggroups mirror their children. + ## Exclude the redundant hgroup values. + hg_kids = findobj (kids, "type", "hggroup"); kids = setdiff (kids, hg_kids); if (isempty (kids)) ## Return the current limits. @@ -319,20 +319,23 @@ else data = get (kids, strcat (ax, "data")); scale = get (ca, strcat (ax, "scale")); - if (strcmp (scale, "log")) - data(data<=0) = NaN; + if (! iscell (data)) + data = {data}; end - if (iscell (data)) - data = data (find (! cellfun (@isempty, data))); - if (! isempty (data)) - lims_min = min (cellfun (@min, cellfun (@min, data, 'uniformoutput', false)(:))); - lims_max = max (cellfun (@max, cellfun (@max, data, 'uniformoutput', false)(:))); - lims = [lims_min, lims_max]; - else - lims = [0, 1]; - endif + if (strcmp (scale, "log")) + tmp = data; + data = cellfun (@(x) x(x>0), tmp, "uniformoutput", false); + n = cellfun (@isempty, data); + data(n) = cellfun (@(x) x(x<0), tmp(n), "uniformoutput", false); + endif + data = cellfun (@(x) x(isfinite(x)), data, "uniformoutput", false); + data = data(! cellfun ("isempty", data)); + if (! isempty (data)) + lims_min = min (cellfun (@(x) min (x(:)), data(:))); + lims_max = max (cellfun (@(x) max (x(:)), data(:))); + lims = [lims_min, lims_max]; else - lims = [min(data(:)), max(data(:))]; + lims = [0, 1]; endif endif @@ -350,6 +353,7 @@ endfunction %!demo +%! clf %! t=0:0.01:2*pi; x=sin(t); %! %! subplot(221); @@ -372,6 +376,7 @@ %! axis("normal"); %!demo +%! clf %! t=0:0.01:2*pi; x=sin(t); %! %! subplot(121); @@ -385,6 +390,7 @@ %! axis("xy"); %!demo +%! clf %! t=0:0.01:2*pi; x=sin(t); %! %! subplot(331); @@ -433,6 +439,7 @@ %! axis("on"); %!demo +%! clf %! t=0:0.01:2*pi; x=sin(t); %! %! subplot(321); @@ -493,3 +500,81 @@ %! legend ({"x >= 1", "x <= 1"}, "location", "north") %! title ("ylim = [1, 10]") +%!demo +%! clf +%! loglog (1:20, "-s") +%! axis tight + +%!demo +%! clf +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "zero") +%! set (gca, "yaxislocation", "zero") +%! box off + +%!demo +%! clf +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "zero") +%! set (gca, "yaxislocation", "left") +%! box off + +%!demo +%! clf +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "zero") +%! set (gca, "yaxislocation", "right") +%! box off + +%!demo +%! clf +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "bottom") +%! set (gca, "yaxislocation", "zero") +%! box off + +%!demo +%! clf +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "top") +%! set (gca, "yaxislocation", "zero") +%! box off + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot (11:20, [21:24, NaN, -Inf, 27:30]); +%! hold all; +%! plot (11:20, 25.5 + rand (10)); +%! axis tight; +%! assert (axis (), [11 20 21 30]); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! loglog (a, -a) +%! axis tight; +%! assert (axis (), [1e-5, 10, -10, -1e-5]) +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/bar.m +++ b/scripts/plot/bar.m @@ -36,7 +36,7 @@ ## argument, which can take the values @code{"grouped"} (the default), ## or @code{"stacked"}. ## -## The optional return value @var{h} provides a handle to the "bar series" +## The optional return value @var{h} is a handle to the created "bar series" ## object with one handle per column of the variable @var{y}. This ## series allows common elements of the group of bar series objects to ## be changed in a single bar series and the same properties are changed @@ -93,3 +93,7 @@ varargout = cell (nargout, 1); [varargout{:}] = __bar__ (true, "bar", varargin{:}); endfunction + + +%% FIXME: Need demo or test for function +
--- a/scripts/plot/barh.m +++ b/scripts/plot/barh.m @@ -36,13 +36,13 @@ ## argument, which can take the values @code{"grouped"} (the default), ## or @code{"stacked"}. ## -## The optional return value @var{h} provides a handle to the bar series -## object. See @code{bar} for a description of the use of the bar series. -## ## The optional input handle @var{h} allows an axis handle to be passed. ## Properties of the patch graphics object can be changed using ## @var{prop}, @var{val} pairs. ## +## The optional return value @var{h} is a graphics handle to the created +## bar series object. See @code{bar} for a description of the use of the +## bar series. ## @seealso{bar, plot} ## @end deftypefn @@ -52,3 +52,7 @@ varargout = cell (nargout, 1); [varargout{:}] = __bar__ (false, "barh", varargin{:}); endfunction + + +%% FIXME: Need demo or test for function +
--- a/scripts/plot/cla.m +++ b/scripts/plot/cla.m @@ -90,9 +90,8 @@ endfunction %!test -%! hf = figure (1, "visible", "off"); +%! hf = figure ("visible", "off"); %! unwind_protect -%! clf %! plot (1:10) %! cla () %! kids = get (gca, "children");
--- a/scripts/plot/clabel.m +++ b/scripts/plot/clabel.m @@ -24,7 +24,7 @@ ## @deftypefnx {Function File} {} clabel (@var{c}, @var{h}) ## @deftypefnx {Function File} {} clabel (@dots{}, @var{prop}, @var{val}, @dots{}) ## @deftypefnx {Function File} {@var{h} =} clabel (@dots{}) -## Adds labels to the contours of a contour plot. The contour plot is specified +## Add labels to the contours of a contour plot. The contour plot is specified ## by the contour matrix @var{c} and optionally the contourgroup object @var{h} ## that are returned by @code{contour}, @code{contourf} and @code{contour3}. ## The contour labels are rotated and placed in the contour itself. @@ -39,9 +39,10 @@ ## on a contour (in points) to be specified. The default is 144 points, or 2 ## inches. ## -## The returned value @var{h} is the set of text object that represent the -## contour labels. The "userdata" property of the text objects contains the -## numerical value of the contour label. +## The optional return value @var{h} is a vector of graphics handles to +## the text objects representing each label. +## The "userdata" property of the text objects contains the numerical value of +## the contour label. ## ## An example of the use of @code{clabel} is ## @@ -128,12 +129,14 @@ endif endfunction -%!demo -%! clf -%! [c, h] = contour (peaks(), -4 : 6); -%! clabel (c, h, -4 : 2 : 6, 'fontsize', 12); %!demo %! clf -%! [c, h] = contourf (peaks(), -7 : 6); -%! clabel (c, h, -6 : 2 : 6, 'fontsize', 12); +%! [c, h] = contour (peaks(), -4:6); +%! clabel (c, h, -4:2:6, "fontsize", 12); + +%!demo +%! clf +%! [c, h] = contourf (peaks(), -7:6); +%! clabel (c, h, -6:2:6, "fontsize", 12); +
--- a/scripts/plot/clf.m +++ b/scripts/plot/clf.m @@ -21,17 +21,21 @@ ## @deftypefnx {Function File} {} clf ("reset") ## @deftypefnx {Function File} {} clf (@var{hfig}) ## @deftypefnx {Function File} {} clf (@var{hfig}, "reset") +## @deftypefnx {Function File} {@var{h} =} clf (@dots{}) ## Clear the current figure window. @code{clf} operates by deleting child ## graphics objects with visible handles (@code{handlevisibility} = on). ## If @var{hfig} is specified operate on it instead of the current figure. ## If the optional argument @code{"reset"} is specified, all objects including ## those with hidden handles are deleted. +## +## The optional return value @var{h} is the graphics handle of the figure +## window that was cleared. ## @seealso{cla, close, delete} ## @end deftypefn ## Author: jwe -function clf (varargin) +function retval = clf (varargin) if (nargin > 2) print_usage (); @@ -74,4 +78,28 @@ ## Delete the children. delete (hc); + if (nargout > 0) + retval = hfig; + endif + endfunction + + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! assert (!isempty (get (gcf, "children"))); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! clf; +%! assert (isempty (get (gcf, "children"))); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/close.m +++ b/scripts/plot/close.m @@ -79,3 +79,15 @@ endwhile endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! close (hf); +%! objs = findobj ("type", "figure"); +%! assert (isempty (intersect (objs, hf))); +%! unwind_protect_cleanup +%! if (isfigure (hf)) +%! close (hf); +%! endif +%! end_unwind_protect
--- a/scripts/plot/colorbar.m +++ b/scripts/plot/colorbar.m @@ -19,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} colorbar (@var{s}) ## @deftypefnx {Function File} {} colorbar ("peer", @var{h}, @dots{}) -## Adds a colorbar to the current axes. Valid values for @var{s} are +## Add a colorbar to the current axes. Valid values for @var{s} are ## ## @table @asis ## @item "EastOutside"
new file mode 100644 --- /dev/null +++ b/scripts/plot/colstyle.m @@ -0,0 +1,89 @@ +## Copyright (C) 2011 David Bateman +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{style}, @var{color}, @var{marker}, @var{msg}] =} colstyle (@var{linespec}) +## Parse @var{linespec} and return the line style, color, and markers given. +## In the case of an error, the string @var{msg} will return the text of the +## error. +## @end deftypefn + +function [l, c, m, msg] = colstyle (style) + + if (nargin != 1) + print_usage (); + endif + + if (! ischar (style)) + error ("colstyle: STYLE must be a string"); + endif + + try + opt = __pltopt__ ("colstyle", style); + l = opt.linestyle; + c = opt.color; + m = opt.marker; + msg = []; + switch (c) + case [0 0 0] + c = "k"; + case [1 0 0] + c = "r"; + case [0 1 0] + c = "g"; + case [0 0 1] + c = "b"; + case [1 1 0] + c = "y"; + case [1 0 1] + c = "m"; + case [0 1 1] + c = "c"; + case [0 1 1] + c = "w"; + endswitch + catch + l = c = m = []; + msg = lasterr (); + end_try_catch + +endfunction + +%!test +%! [l, c, m, msg] = colstyle ("r:x"); +%! assert (isempty (msg)); +%! assert (l, ":"); +%! assert (c, "r"); +%! assert (m, "x"); + +%!test +%! [l, c, m, msg] = colstyle ("."); +%! assert (isempty (msg)); +%! assert (l, "none"); +%! assert (c, []); +%! assert (m, "."); + +%!test +%! [l, c, m, msg] = colstyle ("~"); +%! assert (msg, "colstyle: unrecognized format character: `~'"); + +%% Test input validation +%!error colstyle () +%!error colstyle (1, 2) +%!error colstyle (1.5) +
--- a/scripts/plot/compass.m +++ b/scripts/plot/compass.m @@ -31,17 +31,17 @@ ## The style to use for the plot can be defined with a line style @var{style} ## in a similar manner to the line styles used with the @code{plot} command. ## -## The optional return value @var{h} provides a list of handles to the -## the parts of the vector field (body, arrow and marker). +## The optional return value @var{h} is a vector of graphics handles to the +## line objects representing the drawn vectors. ## ## @example ## @group -## a = toeplitz([1;randn(9,1)],[1,randn(1,9)]); +## a = toeplitz ([1;randn(9,1)], [1,randn(1,9)]); ## compass (eig (a)) ## @end group ## @end example ## -## @seealso{plot, polar, quiver, feather} +## @seealso{polar, quiver, feather, plot} ## @end deftypefn function retval = compass (varargin) @@ -112,6 +112,7 @@ %!demo +%! clf %! randn_9x1_data = [-2.555884; 0.394974; -0.191871; -1.147024; 1.355425; -0.437335; -0.014370; -0.941312; 1.240300]; %! randn_1x9_data = [1.42934, -1.10821, -1.70404, 0.63357, -0.68337, -1.19771, -0.96502, -1.12810, 0.22457]; %! a = toeplitz ([1;randn_9x1_data], [1,randn_1x9_data]);
--- a/scripts/plot/contour.m +++ b/scripts/plot/contour.m @@ -71,11 +71,22 @@ endfunction %!demo +%! clf () %! [x, y, z] = peaks (); %! contour (x, y, z); %!demo +%! clf () %! [theta, r] = meshgrid (linspace (0, 2*pi, 64), linspace(0,1,64)); %! [X, Y] = pol2cart (theta, r); %! Z = sin(2*theta).*(1-r); %! contour(X, Y, abs(Z), 10) + +%!demo +%! clf () +%! x = linspace (-2, 2); +%! [x, y] = meshgrid (x); +%! z = sqrt (x.^2 + y.^2) ./ (x.^2 + y.^2+1); +%! contourf (x, y, z, [0.4, 0.4]) +%! title ("The hole should be filled with the background color") +
--- a/scripts/plot/contour3.m +++ b/scripts/plot/contour3.m @@ -75,6 +75,7 @@ endfunction %!demo +%! clf %! contour3 (peaks (19)); %! hold on %! surface (peaks (19), "facecolor", "none", "edgecolor", "black")
--- a/scripts/plot/contourf.m +++ b/scripts/plot/contourf.m @@ -81,10 +81,12 @@ endfunction %!demo +%! clf %! [x, y, z] = peaks (50); %! contourf (x, y, z, -7:9) %!demo +%! clf %! [theta, r] = meshgrid (linspace (0, 2*pi, 64), linspace(0,1,64)); %! [X, Y] = pol2cart (theta, r); %! Z = sin(2*theta).*(1-r);
--- a/scripts/plot/cylinder.m +++ b/scripts/plot/cylinder.m @@ -22,7 +22,7 @@ ## @deftypefnx {Function File} {} cylinder (@var{r}, @var{n}) ## @deftypefnx {Function File} {[@var{x}, @var{y}, @var{z}] =} cylinder (@dots{}) ## @deftypefnx {Function File} {} cylinder (@var{ax}, @dots{}) -## Generates three matrices in @code{meshgrid} format, such that +## Generate three matrices in @code{meshgrid} format, such that ## @code{surf (@var{x}, @var{y}, @var{z})} generates a unit cylinder. ## The matrices are of size @code{@var{n}+1}-by-@code{@var{n}+1}. ## @var{r} is a vector containing the radius along the z-axis. @@ -86,6 +86,7 @@ endfunction %!demo +%! clf %! [x, y, z] = cylinder (10:-1:0,50); %! surf (x, y, z); %! title ("a cone")
--- a/scripts/plot/daspect.m +++ b/scripts/plot/daspect.m @@ -21,14 +21,18 @@ ## Set the data aspect ratio of the current axes. The aspect ratio is ## a normalized 3-element vector representing the span of the x, y, and ## z-axes limits. +## ## @deftypefnx {Function File} {@var{data_aspect_ratio} =} daspect ( ) ## Return the data aspect ratio of the current axes. +## ## @deftypefnx {Function File} {} daspect (@var{mode}) ## Set the data aspect ratio mode of the current axes. +## ## @deftypefnx {Function File} {@var{data_aspect_ratio_mode} =} daspect ("mode") ## Return the data aspect ratio mode of the current axes. +## ## @deftypefnx {Function File} {} daspect (@var{hax}, @dots{}) -## Uses the axes, with handle @var{hax}, instead of the current axes. +## Use the axes, with handle @var{hax}, instead of the current axes. ## ## @seealso{axis, pbaspect, xlim, ylim, zlim} ## @end deftypefn
--- a/scripts/plot/ellipsoid.m +++ b/scripts/plot/ellipsoid.m @@ -70,4 +70,5 @@ endfunction %!demo +%! clf %! ellipsoid (0, 0, 1, 2, 3, 4, 20);
--- a/scripts/plot/errorbar.m +++ b/scripts/plot/errorbar.m @@ -138,16 +138,19 @@ %!demo +%! clf %! rand_1x11_data1 = [0.82712, 0.50325, 0.35613, 0.77089, 0.20474, 0.69160, 0.30858, 0.88225, 0.35187, 0.14168, 0.54270]; %! rand_1x11_data2 = [0.506375, 0.330106, 0.017982, 0.859270, 0.140641, 0.327839, 0.275886, 0.162453, 0.807592, 0.318509, 0.921112]; %! errorbar (0:10, rand_1x11_data1, 0.25*rand_1x11_data2); %!demo +%! clf %! rand_1x11_data3 = [0.423650, 0.142331, 0.213195, 0.129301, 0.975891, 0.012872, 0.635327, 0.338829, 0.764997, 0.401798, 0.551850]; %! rand_1x11_data4 = [0.682566, 0.456342, 0.132390, 0.341292, 0.108633, 0.601553, 0.040455, 0.146665, 0.309187, 0.586291, 0.540149]; %! errorbar(0:10, rand_1x11_data3, rand_1x11_data4, ">"); %!demo +%! clf %! x = 0:0.5:2*pi; %! err = x/100; %! y1 = sin (x); @@ -155,6 +158,7 @@ %! hg = errorbar (x, y1, err, "~", x, y2, err, ">"); %!demo +%! clf %! x = 0:0.5:2*pi; %! err = x/100; %! y1 = sin (x); @@ -162,6 +166,7 @@ %! hg = errorbar (x, y1, err, err, "#r", x, y2, err, err, "#~"); %!demo +%! clf %! x = 0:0.5:2*pi; %! err = x/100; %! y1 = sin (x);
--- a/scripts/plot/ezcontour.m +++ b/scripts/plot/ezcontour.m @@ -23,7 +23,7 @@ ## @deftypefnx {Function File} {} ezcontour (@var{h}, @dots{}) ## @deftypefnx {Function File} {@var{h} =} ezcontour (@dots{}) ## -## Plots the contour lines of a function. @var{f} is a string, inline function +## Plot the contour lines of a function. @var{f} is a string, inline function ## or function handle with two arguments defining the function. By default the ## plot is over the domain @code{-2*pi < @var{x} < 2*pi} and @code{-2*pi < ## @var{y} < 2*pi} with 60 points in each dimension. @@ -35,8 +35,7 @@ ## ## @var{n} is a scalar defining the number of points to use in each dimension. ## -## The optional return value @var{h} provides a list of handles to the -## the parts of the vector field (body, arrow and marker). +## The optional return value @var{h} is a graphics handle to the created plot. ## ## @example ## @group @@ -61,6 +60,9 @@ endif endfunction + %!demo +%! clf %! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); %! ezcontour (f, [-3, 3]); +
--- a/scripts/plot/ezcontourf.m +++ b/scripts/plot/ezcontourf.m @@ -23,7 +23,7 @@ ## @deftypefnx {Function File} {} ezcontourf (@var{h}, @dots{}) ## @deftypefnx {Function File} {@var{h} =} ezcontourf (@dots{}) ## -## Plots the filled contour lines of a function. @var{f} is a string, inline +## Plot the filled contour lines of a function. @var{f} is a string, inline ## function or function handle with two arguments defining the function. By ## default the plot is over the domain @code{-2*pi < @var{x} < 2*pi} and ## @code{-2*pi < @var{y} < 2*pi} with 60 points in each dimension. @@ -35,8 +35,7 @@ ## ## @var{n} is a scalar defining the number of points to use in each dimension. ## -## The optional return value @var{h} provides a list of handles to the -## the parts of the vector field (body, arrow and marker). +## The optional return value @var{h} is a graphics handle to the created plot. ## ## @example ## @group @@ -61,6 +60,8 @@ endif endfunction + %!demo +%! clf %! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); %! ezcontourf (f, [-3, 3]);
--- a/scripts/plot/ezmesh.m +++ b/scripts/plot/ezmesh.m @@ -25,7 +25,7 @@ ## @deftypefnx {Function File} {} ezmesh (@var{h}, @dots{}) ## @deftypefnx {Function File} {@var{h} =} ezmesh (@dots{}) ## -## Plots the mesh defined by a function. @var{f} is a string, inline +## Plot the mesh defined by a function. @var{f} is a string, inline ## function or function handle with two arguments defining the function. By ## default the plot is over the domain @code{-2*pi < @var{x} < 2*pi} and ## @code{-2*pi < @var{y} < 2*pi} with 60 points in each dimension. @@ -44,8 +44,8 @@ ## If the argument 'circ' is given, then the function is plotted over a disk ## centered on the middle of the domain @var{dom}. ## -## The optional return value @var{h} provides a list of handles to the -## the parts of the vector field (body, arrow and marker). +## The optional return value @var{h} is a graphics handle to the created +## surface object. ## ## @example ## @group @@ -65,7 +65,7 @@ ## @end group ## @end example ## -## @seealso{ezplot, ezsurf, ezsurfc, ezmeshc} +## @seealso{ezplot, ezmeshc, ezsurf, ezsurfc} ## @end deftypefn function retval = ezmesh (varargin) @@ -81,12 +81,16 @@ endif endfunction + %!demo +%! clf %! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); %! ezmesh (f, [-3, 3]); %!demo +%! clf %! fx = @(s,t) cos (s) .* cos(t); %! fy = @(s,t) sin (s) .* cos(t); %! fz = @(s,t) sin (t); %! ezmesh (fx, fy, fz, [-pi,pi,-pi/2,pi/2], 20); +
--- a/scripts/plot/ezmeshc.m +++ b/scripts/plot/ezmeshc.m @@ -25,7 +25,7 @@ ## @deftypefnx {Function File} {} ezmeshc (@var{h}, @dots{}) ## @deftypefnx {Function File} {@var{h} =} ezmeshc (@dots{}) ## -## Plots the mesh and contour lines defined by a function. @var{f} is a string, +## Plot the mesh and contour lines defined by a function. @var{f} is a string, ## inline function or function handle with two arguments defining the function. ## By default the plot is over the domain @code{-2*pi < @var{x} < 2*pi} and ## @code{-2*pi < @var{y} < 2*pi} with 60 points in each dimension. @@ -44,8 +44,9 @@ ## If the argument 'circ' is given, then the function is plotted over a disk ## centered on the middle of the domain @var{dom}. ## -## The optional return value @var{h} provides a list of handles to the -## the parts of the vector field (body, arrow and marker). +## The optional return value @var{h} is a 2-element vector with a graphics +## handle for the created mesh plot and a second handle for the created contour +## plot. ## ## @example ## @group @@ -70,6 +71,9 @@ endif endfunction + %!demo +%! clf %! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); %! ezmeshc (f, [-3, 3]); +
--- a/scripts/plot/ezplot.m +++ b/scripts/plot/ezplot.m @@ -24,7 +24,7 @@ ## @deftypefnx {Function File} {} ezplot (@var{h}, @dots{}) ## @deftypefnx {Function File} {@var{h} =} ezplot (@dots{}) ## -## Plots in two-dimensions the curve defined by @var{f}. The function +## Plot the curve defined by @var{f} in two dimensions. The function ## @var{f} may be a string, inline function or function handle and can ## have either one or two variables. If @var{f} has one variable, then ## the function is plotted over the domain @code{-2*pi < @var{x} < 2*pi} @@ -61,8 +61,7 @@ ## @var{n} is a scalar defining the number of points to use in plotting ## the function. ## -## The optional return value @var{h} provides a list of handles to the -## the line objects plotted. +## The optional return value @var{h} is a graphics handle to the created plot. ## ## @seealso{plot, ezplot3} ## @end deftypefn @@ -80,11 +79,16 @@ endif endfunction + %!demo +%! clf %! ezplot (@cos, @sin) %!demo +%! clf %! ezplot ("1/x") %!demo -%! ezplot (inline("x^2 - y^2 = 1")) +%! clf +%! ezplot (inline ("x^2 - y^2 = 1")) +
--- a/scripts/plot/ezplot3.m +++ b/scripts/plot/ezplot3.m @@ -23,7 +23,7 @@ ## @deftypefnx {Function File} {} ezplot3 (@var{h}, @dots{}) ## @deftypefnx {Function File} {@var{h} =} ezplot3 (@dots{}) ## -## Plots in three-dimensions the curve defined parametrically. +## Plot a parametrically defined curve in three dimensions. ## @var{fx}, @var{fy}, and @var{fz} are strings, inline functions ## or function handles with one arguments defining the function. By ## default the plot is over the domain @code{-2*pi < @var{x} < 2*pi} @@ -32,8 +32,7 @@ ## If @var{dom} is a two element vector, it represents the minimum and maximum ## value of @var{t}. @var{n} is a scalar defining the number of points to use. ## -## The optional return value @var{h} provides a list of handles to the -## the parts of the vector field (body, arrow and marker). +## The optional return value @var{h} is a graphics handle to the created plot. ## ## @example ## @group @@ -60,8 +59,11 @@ endif endfunction + %!demo +%! clf %! fx = @(t) cos (t); %! fy = @(t) sin (t); %! fz = @(t) t; %! ezplot3 (fx, fy, fz, [0, 10*pi], 100); +
--- a/scripts/plot/ezpolar.m +++ b/scripts/plot/ezpolar.m @@ -23,7 +23,7 @@ ## @deftypefnx {Function File} {} ezpolar (@var{h}, @dots{}) ## @deftypefnx {Function File} {@var{h} =} ezpolar (@dots{}) ## -## Plots in polar plot defined by a function. The function @var{f} is either +## Plot a function in polar coordinates. The function @var{f} is either ## a string, inline function or function handle with one arguments defining ## the function. By default the plot is over the domain @code{0 < @var{x} < ## 2*pi} with 60 points. @@ -32,8 +32,7 @@ ## value of both @var{t}. @var{n} is a scalar defining the number of points to ## use. ## -## The optional return value @var{h} provides a list of handles to the -## the parts of the vector field (body, arrow and marker). +## The optional return value @var{h} is a graphics handle to the created plot. ## ## @example ## ezpolar (@@(t) 1 + sin (t)); @@ -55,5 +54,8 @@ endif endfunction + %!demo +%! clf %! ezpolar (@(t) 1 + sin (t)); +
--- a/scripts/plot/ezsurf.m +++ b/scripts/plot/ezsurf.m @@ -25,7 +25,7 @@ ## @deftypefnx {Function File} {} ezsurf (@var{h}, @dots{}) ## @deftypefnx {Function File} {@var{h} =} ezsurf (@dots{}) ## -## Plots the surface defined by a function. @var{f} is a string, inline +## Plot the surface defined by a function. @var{f} is a string, inline ## function or function handle with two arguments defining the function. By ## default the plot is over the domain @code{-2*pi < @var{x} < 2*pi} and ## @code{-2*pi < @var{y} < 2*pi} with 60 points in each dimension. @@ -44,8 +44,8 @@ ## If the argument 'circ' is given, then the function is plotted over a disk ## centered on the middle of the domain @var{dom}. ## -## The optional return value @var{h} provides a list of handles to the -## the parts of the vector field (body, arrow and marker). +## The optional return value @var{h} is a graphics handle to the created +## surface object. ## ## @example ## @group @@ -81,12 +81,16 @@ endif endfunction + %!demo +%! clf %! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); %! ezsurf (f, [-3, 3]); %!demo +%! clf %! fx = @(s,t) cos (s) .* cos(t); %! fy = @(s,t) sin (s) .* cos(t); %! fz = @(s,t) sin (t); %! ezsurf (fx, fy, fz, [-pi,pi,-pi/2,pi/2], 20); +
--- a/scripts/plot/ezsurfc.m +++ b/scripts/plot/ezsurfc.m @@ -25,7 +25,7 @@ ## @deftypefnx {Function File} {} ezsurfc (@var{h}, @dots{}) ## @deftypefnx {Function File} {@var{h} =} ezsurfc (@dots{}) ## -## Plots the surface and contour lines defined by a function. @var{f} is a +## Plot the surface and contour lines defined by a function. @var{f} is a ## string, inline function or function handle with two arguments defining the ## function. By default the plot is over the domain @code{-2*pi < @var{x} < ## 2*pi} and @code{-2*pi < @var{y} < 2*pi} with 60 points in each dimension. @@ -44,8 +44,9 @@ ## If the argument 'circ' is given, then the function is plotted over a disk ## centered on the middle of the domain @var{dom}. ## -## The optional return value @var{h} provides a list of handles to the -## the parts of the vector field (body, arrow and marker). +## The optional return value @var{h} is a 2-element vector with a graphics +## for the created surface plot and a second handle for the created contour +## plot. ## ## @example ## @group @@ -70,6 +71,9 @@ endif endfunction + %!demo +%! clf %! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); %! ezsurfc (f, [-3, 3]); +
--- a/scripts/plot/feather.m +++ b/scripts/plot/feather.m @@ -31,8 +31,8 @@ ## The style to use for the plot can be defined with a line style @var{style} ## in a similar manner to the line styles used with the @code{plot} command. ## -## The optional return value @var{h} provides a list of handles to the -## the parts of the vector field (body, arrow and marker). +## The optional return value @var{h} is a vector of graphics handles to the +## line objects representing the drawn vectors. ## ## @example ## @group @@ -109,6 +109,9 @@ endfunction + %!demo +%! clf %! phi = [0 : 15 : 360] * pi / 180; %! feather (sin (phi), cos (phi)) +
--- a/scripts/plot/figure.m +++ b/scripts/plot/figure.m @@ -41,7 +41,7 @@ f = tmp; varargin(1) = []; nargs--; - elseif (isnumeric (tmp) && tmp > 0 && round (tmp) == tmp) + elseif (isnumeric (tmp) && tmp > 0 && tmp == fix (tmp)) f = tmp; init_new_figure = true; varargin(1) = []; @@ -73,10 +73,21 @@ endif cf = get (0, "currentfigure"); - __add_default_menu__ (cf); + if (strcmp (get (cf, "__graphics_toolkit__"), "fltk")) + __add_default_menu__ (cf); + endif if (nargout > 0) h = f; endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (gcf, hf); +%! assert (isfigure (hf)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/fill.m +++ b/scripts/plot/fill.m @@ -22,7 +22,11 @@ ## @deftypefnx {Function File} {} fill (@dots{}, @var{prop}, @var{val}) ## @deftypefnx {Function File} {} fill (@var{h}, @dots{}) ## @deftypefnx {Function File} {@var{h} =} fill (@dots{}) -## Create one or more filled patch objects, returning a patch object for each. +## Create one or more filled patch objects. +## +## The optional return value @var{h} is an array of graphics handles to +## the created patch objects. +## @seealso{patch} ## @end deftypefn function retval = fill (varargin) @@ -114,12 +118,14 @@ endwhile endfunction + %!demo %! clf -%! t1 = (1/16:1/8:1)'*2*pi; -%! t2 = ((1/16:1/8:1)' + 1/32)*2*pi; -%! x1 = sin(t1) - 0.8; -%! y1 = cos(t1); -%! x2 = sin(t2) + 0.8; -%! y2 = cos(t2); -%! h = fill(x1,y1,'r',x2,y2,'g'); +%! t1 = (1/16:1/8:1)*2*pi; +%! t2 = ((1/16:1/8:1) + 1/32)*2*pi; +%! x1 = sin (t1) - 0.8; +%! y1 = cos (t1); +%! x2 = sin (t2) + 0.8; +%! y2 = cos (t2); +%! h = fill (x1,y1,'r', x2,y2,'g'); +
--- a/scripts/plot/findall.m +++ b/scripts/plot/findall.m @@ -21,7 +21,7 @@ ## @deftypefnx {Function File} {@var{h} =} findall (@var{prop_name}, @var{prop_value}) ## @deftypefnx {Function File} {@var{h} =} findall (@var{h}, @dots{}) ## @deftypefnx {Function File} {@var{h} =} findall (@var{h}, "-depth", @var{d}, @dots{}) -## Find object with specified property values including hidden handles. +## Find graphics object with specified property values including hidden handles. ## ## This function performs the same function as @code{findobj}, but it ## includes hidden objects in its search. For full documentation, see @@ -42,3 +42,19 @@ end_unwind_protect endfunction + + +%!testif HAVE_FLTK +%! toolkit = graphics_toolkit (); +%! graphics_toolkit ("fltk"); +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = findall (hf); +%! all_handles(1:13,1) = {"uimenu"}; +%! all_handles(14) = {"figure"}; +%! assert (get (h, "type"), all_handles); +%! unwind_protect_cleanup +%! close (hf); +%! graphics_toolkit (toolkit); +%! end_unwind_protect +
--- a/scripts/plot/findobj.m +++ b/scripts/plot/findobj.m @@ -24,7 +24,7 @@ ## @deftypefnx {Function File} {@var{h} =} findobj ('flat', @dots{}) ## @deftypefnx {Function File} {@var{h} =} findobj (@var{h}, @dots{}) ## @deftypefnx {Function File} {@var{h} =} findobj (@var{h}, '-depth', @var{d}, @dots{}) -## Find object with specified property values. The simplest form is +## Find graphics object with specified property values. The simplest form is ## ## @example ## findobj (@var{prop_name}, @var{prop_Value}) @@ -242,3 +242,18 @@ h = h (keepers != 0); h = reshape (h, [numel(h), 1]); endfunction + + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! obj = findobj (hf, "type", "line"); +%! assert (l, obj); +%! assert (gca, findobj (hf, "type", "axes")); +%! assert (hf, findobj (hf, "type", "figure")); +%! assert (isempty (findobj (hf, "type", "xyzxyz"))); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/fplot.m +++ b/scripts/plot/fplot.m @@ -21,8 +21,9 @@ ## @deftypefnx {Function File} {} fplot (@var{fn}, @var{limits}, @var{tol}) ## @deftypefnx {Function File} {} fplot (@var{fn}, @var{limits}, @var{n}) ## @deftypefnx {Function File} {} fplot (@dots{}, @var{fmt}) -## Plot a function @var{fn}, within the defined limits. @var{fn} -## an be either a string, a function handle or an inline function. +## Plot a function @var{fn} within defined limits. +## @var{fn} is a function handle, inline function, or string +## containing the name of the function to evaluate. ## The limits of the plot are given by @var{limits} of the form ## @code{[@var{xlo}, @var{xhi}]} or @code{[@var{xlo}, @var{xhi}, ## @var{ylo}, @var{yhi}]}. @var{tol} is the default tolerance to use for the @@ -127,7 +128,9 @@ endfunction %!demo +%! clf %! fplot ("cos", [0, 2*pi]) %!demo +%! clf %! fplot ("[cos(x), sin(x)]", [0, 2*pi])
--- a/scripts/plot/gca.m +++ b/scripts/plot/gca.m @@ -49,3 +49,12 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! ax = axes; +%! unwind_protect +%! assert (gca, ax); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/gcbf.m +++ b/scripts/plot/gcbf.m @@ -31,3 +31,6 @@ [dummy, fig] = gcbo (); endfunction + +%!test +%! assert (isempty (gcbf ));
--- a/scripts/plot/gcbo.m +++ b/scripts/plot/gcbo.m @@ -41,3 +41,6 @@ endif endfunction + +%!test +%! assert (isempty (gcbo ));
--- a/scripts/plot/gcf.m +++ b/scripts/plot/gcf.m @@ -53,3 +53,11 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (gcf, hf); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/ginput.m +++ b/scripts/plot/ginput.m @@ -21,7 +21,7 @@ ## Return which mouse buttons were pressed and keys were hit on the current ## figure. If @var{n} is defined, then wait for @var{n} mouse clicks ## before returning. If @var{n} is not defined, then @code{ginput} will -## loop until the return key is pressed. +## loop until the return key @key{RET} is pressed. ## @end deftypefn function varargout = ginput (n) @@ -42,3 +42,7 @@ endif endfunction + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1);
--- a/scripts/plot/graphics_toolkit.m +++ b/scripts/plot/graphics_toolkit.m @@ -17,9 +17,10 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} graphics_toolkit (@var{name}) +## @deftypefn {Function File} {@var{name} =} graphics_toolkit () +## @deftypefnx {Function File} {@var{old_name} =} graphics_toolkit (@var{name}) ## @deftypefnx {Function File} {} graphics_toolkit (@var{hlist}, @var{name}) -## Change the default graphics toolkit to @var{name}. If the +## Query or set the default graphics toolkit to @var{name}. If the ## toolkit is not already loaded, it is first initialized by calling the ## function @code{__init_@var{name}__}. ## @@ -28,44 +29,67 @@ ## @seealso{available_graphics_toolkits} ## @end deftypefn -function graphics_toolkit (varargin) +function retval = graphics_toolkit (name, hlist = []) - name = ""; - hlist = []; + if (nargin > 2) + print_usage (); + endif - if (nargin == 1) - if (ischar (varargin{1})) - name = varargin{1}; - else + if (nargout > 0 || nargin == 0) + retval = get (0, "defaultfigure__graphics_toolkit__"); + endif + + if (nargin == 0) + return; + elseif (nargin == 1) + if (! ischar (name)) error ("graphics_toolkit: invalid graphics toolkit NAME"); endif elseif (nargin == 2) - if (isnumeric (varargin{1}) && ischar (varargin{2})) - hlist = varargin{1}; - name = varargin{2}; - elseif (ischar (varargin{2})) - error ("graphics_toolkit: invalid handle list"); - else + ## Swap input arguments + [hlist, name] = deal (name, hlist); + if (! all (isfigure (hlist))) + error ("graphics_toolkit: invalid figure handle list HLIST"); + elseif (! ischar (name)) error ("graphics_toolkit: invalid graphics toolkit NAME"); endif - else - print_usage (); endif - if (! any (strcmp (available_graphics_toolkits (), name))) + if (! any (strcmp (loaded_graphics_toolkits (), name))) feval (["__init_", name, "__"]); - if (! any (strcmp (available_graphics_toolkits (), name))) - error ("graphics_toolkit: %s toolkit was not correctly registered", - name); + if (! any (strcmp (loaded_graphics_toolkits (), name))) + error ("graphics_toolkit: %s toolkit was not correctly loaded", name); endif endif if (isempty (hlist)) set (0, "defaultfigure__graphics_toolkit__", name); else - for h = hlist(:)' - set (h, "__graphics_toolkit__", name); - endfor + set (hlist, "__graphics_toolkit__", name); endif endfunction + + +%!testif HAVE_FLTK +%! unwind_protect +%! hf = figure ("visible", "off"); +%! toolkit = graphics_toolkit (); +%! assert (get (0, "defaultfigure__graphics_toolkit__"), toolkit); +%! graphics_toolkit (hf, "fltk"); +%! assert (get (hf, "__graphics_toolkit__"), "fltk"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!testif HAVE_FLTK +%! old_toolkit = graphics_toolkit (); +%! switch old_toolkit +%! case {"gnuplot"} +%! new_toolkit = "fltk"; +%! otherwise +%! new_toolkit = "gnuplot"; +%! endswitch +%! assert (graphics_toolkit (new_toolkit), old_toolkit) +%! assert (graphics_toolkit (old_toolkit), new_toolkit) +
--- a/scripts/plot/gtext.m +++ b/scripts/plot/gtext.m @@ -29,25 +29,21 @@ function gtext (s, varargin) - if (nargin > 0) - if (iscellstr (s)) - if (isempty (s)) - s = ""; - else - s = sprintf ("%s\n", s{:}); - endif - endif - if (ischar (s)) - if (! isempty (s)) - [x, y] = ginput (1); - text (x, y, s, varargin{:}); - endif - else - error ("gtext: expecting a string or cell array of strings"); - endif - else + if (nargin < 1) print_usage (); endif + if (! (ischar (s) || iscellstr (s))) + error ("gtext: S must be a string or cell array of strings"); + endif + + if (! isempty (s)) + [x, y] = ginput (1); + text (x, y, s, varargin{:}); + endif + endfunction +## Remove from test statistics. No real tests possible. +%!test +%! assert (1);
new file mode 100644 --- /dev/null +++ b/scripts/plot/guidata.m @@ -0,0 +1,52 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{data} =} guidata (@var{handle}) +## @deftypefnx {Function File} {} guidata (@var{handle}, @var{data}) +## @end deftypefn + +## Author: goffioul + +function varargout = guidata (varargin) + + if (nargin == 1 || nargin == 2) + h = varargin{1}; + if (ishandle (h)) + h = ancestor (h, "figure"); + if (! isempty (h)) + if (nargin == 1) + varargout{1} = get (h, "__guidata__"); + else + data = varargin{2}; + set (h, "__guidata__", data); + if (nargout == 1) + varargout{1} = data; + endif + endif + else + error ("no ancestor figure found"); + endif + else + error ("invalid object handle"); + endif + else + print_usage (); + endif + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/guihandles.m @@ -0,0 +1,70 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{hdata} =} guihandles (@var{handle}) +## @deftypefnx {Function File} {@var{hdata} =} guihandles +## @end deftypefn + +## Author: goffioul + +function hdata = guihandles (varargin) + + hdata = []; + + if (nargin == 0 || nargin == 1) + if (nargin == 1) + h = varargin{1}; + if (ishandle (h)) + h = ancestor (h, "figure"); + if (isempty (h)) + error ("no ancestor figure found"); + endif + else + error ("invalid object handle"); + endif + else + h = gcf (); + endif + hdata = __make_guihandles_struct__ (h, hdata); + else + print_usage (); + endif + +endfunction + +function hdata = __make_guihandles_struct__ (h, hdata) + + tag = get (h, "tag"); + if (! isempty (tag)) + if (isfield (hdata, tag)) + hdata.(tag) = [hdata.(tag), h]; + else + try + hdata.(tag) = h; + catch + end_try_catch + endif + endif + + kids = allchild (h); + for i = 1 : length (kids) + hdata = __make_guihandles_struct__ (kids(i), hdata); + endfor + +endfunction
--- a/scripts/plot/hggroup.m +++ b/scripts/plot/hggroup.m @@ -41,3 +41,13 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = hggroup; +%! assert (findobj (hf, "type", "hggroup"), h); +%! assert (get (h, "type"), "hggroup"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/hold.m +++ b/scripts/plot/hold.m @@ -139,3 +139,35 @@ %! colorbar ("SouthOutside"); %! title ("Test script for some plot functions"); +##hold on +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! p = plot ([0 1]); +%! assert (!ishold); +%! hold on; +%! assert (ishold); +%! p1 = fill ([0 1 1], [0 0 1],"black"); +%! p2 = fill ([0 1 0], [0 1 1], "red"); +%! assert (length (get (hf, "children")), 1); +%! assert (length (get (gca, "children")), 3); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +##hold off +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! p = plot ([0 1]); +%! assert (!ishold); +%! hold on; +%! assert (ishold); +%! p1 = fill ([0 1 1], [0 0 1],"black"); +%! hold off +%! p2 = fill ([0 1 0], [0 1 1], "red"); +%! assert (length (get (hf, "children")), 1); +%! assert (length (get (gca, "children")), 1); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/isfigure.m +++ b/scripts/plot/isfigure.m @@ -34,3 +34,12 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (isfigure (hf)); +%! assert (!isfigure (-hf)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/ishghandle.m +++ b/scripts/plot/ishghandle.m @@ -26,3 +26,34 @@ ## no simulink equivalent. retval = ishandle (h); endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (ishghandle (hf)); +%! assert (!ishghandle (-hf)); +%! l = line; +%! ax = gca(); +%! assert (ishghandle (ax)); +%! assert (!ishghandle (-ax)); +%! assert (ishghandle (l)); +%! assert (!ishghandle (-l)); +%! p = patch; +%! assert (ishghandle (p)); +%! assert (!ishghandle (-p)); +%! s = surface; +%! assert (ishghandle (s)); +%! assert (!ishghandle (-s)); +%! t = text; +%! assert (ishghandle (t)); +%! assert (!ishghandle (-t)); +%! i = image; +%! assert (ishghandle (i)); +%! assert (!ishghandle (-i)); +%! hg = hggroup; +%! assert (ishghandle (hg)); +%! assert (!ishghandle (-hg)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/ishold.m +++ b/scripts/plot/ishold.m @@ -17,25 +17,25 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Command} {} ishold +## @deftypefn {Command} {} ishold +## @deftypefnx {Function File} {} ishold (@var{h}) ## Return true if the next plot will be added to the current plot, or ## false if the plot device will be cleared before drawing the next plot. +## +## Optionally, operate on the graphics handle @var{h} rather than the current +## plot. ## @seealso{hold} ## @end deftypefn function retval = ishold (h) if (nargin == 0) - ax = gca (); fig = gcf (); + ax = get (fig, "currentaxes"); elseif (nargin == 1) if (ishandle (h)) if (isfigure (h)) ax = get (h, "currentaxes"); - if (isempty (ax)) - ax = __go_axes__ (h); - set (h, "currentaxes", ax); - endif fig = h; elseif (strcmpi (get (h, "type"), "axes")) ax = h; @@ -51,6 +51,29 @@ endif retval = (strcmpi (get (fig, "nextplot"), "add") - && strcmpi (get (ax, "nextplot"), "add")); + && ! isempty (ax) && strcmpi (get (ax, "nextplot"), "add")); endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (!ishold); +%! assert (isempty (get (hf, "currentaxes"))); +%! assert (get (hf, "NextPlot"), "add"); +%! l = plot ([0 1]); +%! assert (!ishold); +%! assert (!ishold (gca)); +%! assert (get (gca, "NextPlot"), "replace"); +%! assert (get (hf, "NextPlot"), "add"); +%! hold; +%! assert (ishold); +%! assert (ishold (gca)); +%! assert (get (gca, "NextPlot"), "add"); +%! assert (get (hf, "NextPlot"), "add"); +%! p = fill ([0 1 1], [0 0 1],"black"); +%! assert (length (get (hf, "children")), 1); +%! assert (length (get (gca, "children")), 2); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/isocolors.m +++ b/scripts/plot/isocolors.m @@ -22,10 +22,10 @@ ## @deftypefnx {Function File} {[@var{cd}] =} isocolors (@var{x}, @var{y}, @var{z}, @var{r}, @var{g}, @var{b}, @var{v}) ## @deftypefnx {Function File} {[@var{cd}] =} isocolors (@var{r}, @var{g}, @var{b}, @var{v}) ## @deftypefnx {Function File} {[@var{cd}] =} isocolors (@dots{}, @var{p}) -## @deftypefnx {Function File} isocolors (@dots{}) +## @deftypefnx {Function File} {} isocolors (@dots{}) ## ## If called with one output argument and the first input argument -## @var{c} is a three--dimensional array that contains color values and +## @var{c} is a three-dimensional array that contains color values and ## the second input argument @var{v} keeps the vertices of a geometry ## then return a matrix @var{cd} with color data information for the ## geometry at computed points @@ -92,7 +92,7 @@ ## isofinish (p); ## @end example ## -## @seealso{isosurface, isonormals, isocaps} +## @seealso{isosurface, isonormals} ## ## @end deftypefn
--- a/scripts/plot/isonormals.m +++ b/scripts/plot/isonormals.m @@ -22,10 +22,10 @@ ## @deftypefnx {Function File} {[@var{n}] =} isonormals (@var{x}, @var{y}, @var{z}, @var{val}, @var{v}) ## @deftypefnx {Function File} {[@var{n}] =} isonormals (@var{x}, @var{y}, @var{z}, @var{val}, @var{p}) ## @deftypefnx {Function File} {[@var{n}] =} isonormals (@dots{}, "negate") -## @deftypefnx {Function File} isonormals (@dots{}, @var{p}) +## @deftypefnx {Function File} {} isonormals (@dots{}, @var{p}) ## ## If called with one output argument and the first input argument -## @var{val} is a three--dimensional array that contains the data for an +## @var{val} is a three-dimensional array that contains the data for an ## isosurface geometry and the second input argument @var{v} keeps the ## vertices of an isosurface then return the normals @var{n} in form of ## a matrix with the same size than @var{v} at computed points @@ -45,51 +45,52 @@ ## given by the patch handle @var{p}. ## ## For example: +## @c Set example in small font to prevent overfull line ## -## @example +## @smallexample ## function [] = isofinish (p) -## set (gca, "PlotBoxAspectRatioMode","manual","PlotBoxAspectRatio",[1 1 1]); -## set (p, "VertexNormals", -get(p,"VertexNormals")); ## Revert normals +## set (gca, "PlotBoxAspectRatioMode", "manual", ... +## "PlotBoxAspectRatio",[1 1 1]); +## set (p, "VertexNormals", -get(p,"VertexNormals")); # Revert normals ## set (p, "FaceColor", "interp"); ## ## set (p, "FaceLighting", "phong"); -## ## light ("Position", [1 1 5]); ## Available with JHandles +## ## light ("Position", [1 1 5]); # Available with JHandles ## endfunction ## -## N = 15; ## Increase number of vertices in each direction -## iso = .4; ## Change isovalue to .1 to display a sphere +## N = 15; # Increase number of vertices in each direction +## iso = .4; # Change isovalue to .1 to display a sphere ## lin = linspace (0, 2, N); ## [x, y, z] = meshgrid (lin, lin, lin); ## c = abs ((x-.5).^2 + (y-.5).^2 + (z-.5).^2); -## figure (); ## Open another figure window +## figure (); # Open another figure window ## ## subplot (2, 2, 1); view (-38, 20); ## [f, v, cdat] = isosurface (x, y, z, c, iso, y); ## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", cdat, \ -## "FaceColor", "interp", "EdgeColor", "none"); +## "FaceColor", "interp", "EdgeColor", "none"); ## isofinish (p); ## Call user function isofinish ## ## subplot (2, 2, 2); view (-38, 20); ## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", cdat, \ -## "FaceColor", "interp", "EdgeColor", "none"); -## isonormals (x, y, z, c, p); ## Directly modify patch +## "FaceColor", "interp", "EdgeColor", "none"); +## isonormals (x, y, z, c, p); # Directly modify patch ## isofinish (p); ## ## subplot (2, 2, 3); view (-38, 20); ## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", cdat, \ -## "FaceColor", "interp", "EdgeColor", "none"); -## n = isonormals (x, y, z, c, v); ## Compute normals of isosurface -## set (p, "VertexNormals", n); ## Manually set vertex normals +## "FaceColor", "interp", "EdgeColor", "none"); +## n = isonormals (x, y, z, c, v); # Compute normals of isosurface +## set (p, "VertexNormals", n); # Manually set vertex normals ## isofinish (p); ## ## subplot (2, 2, 4); view (-38, 20); ## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", cdat, \ -## "FaceColor", "interp", "EdgeColor", "none"); -## isonormals (x, y, z, c, v, "negate"); ## Use reverse directly +## "FaceColor", "interp", "EdgeColor", "none"); +## isonormals (x, y, z, c, v, "negate"); # Use reverse directly ## isofinish (p); -## @end example +## @end smallexample ## -## @seealso {isosurface, isocolors, isocaps, marching_cube} -## +## @seealso{isosurface, isocolors} ## @end deftypefn ## Author: Martin Helm <martin@mhelm.de>
--- a/scripts/plot/isosurface.m +++ b/scripts/plot/isosurface.m @@ -26,7 +26,7 @@ ## @deftypefnx {Function File} {} isosurface (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}, @var{col}, @var{opt}) ## ## If called with one output argument and the first input argument -## @var{val} is a three--dimensional array that contains the data of an +## @var{val} is a three-dimensional array that contains the data of an ## isosurface geometry and the second input argument @var{iso} keeps the ## isovalue as a scalar value then return a structure array @var{fv} ## that contains the fields @var{Faces} and @var{Vertices} at computed @@ -70,25 +70,28 @@ ## will directly draw a random isosurface geometry in a graphics window. ## Another example for an isosurface geometry with different additional ## coloring +## @c Set example in small font to prevent overfull line ## -## @example -## N = 15; ## Increase number of vertices in each direction -## iso = .4; ## Change isovalue to .1 to display a sphere +## @smallexample +## N = 15; # Increase number of vertices in each direction +## iso = .4; # Change isovalue to .1 to display a sphere ## lin = linspace (0, 2, N); ## [x, y, z] = meshgrid (lin, lin, lin); ## c = abs ((x-.5).^2 + (y-.5).^2 + (z-.5).^2); -## figure (); ## Open another figure window +## figure (); # Open another figure window ## ## subplot (2, 2, 1); view (-38, 20); ## [f, v] = isosurface (x, y, z, c, iso); ## p = patch ("Faces", f, "Vertices", v, "EdgeColor", "none"); -## set (gca, "PlotBoxAspectRatioMode","manual", "PlotBoxAspectRatio", [1 1 1]); +## set (gca, "PlotBoxAspectRatioMode","manual", ... +## "PlotBoxAspectRatio", [1 1 1]); ## # set (p, "FaceColor", "green", "FaceLighting", "phong"); -## # light ("Position", [1 1 5]); ## Available with the JHandles package +## # light ("Position", [1 1 5]); # Available with the JHandles package ## ## subplot (2, 2, 2); view (-38, 20); ## p = patch ("Faces", f, "Vertices", v, "EdgeColor", "blue"); -## set (gca, "PlotBoxAspectRatioMode","manual", "PlotBoxAspectRatio", [1 1 1]); +## set (gca, "PlotBoxAspectRatioMode","manual", ... +## "PlotBoxAspectRatio", [1 1 1]); ## # set (p, "FaceColor", "none", "FaceLighting", "phong"); ## # light ("Position", [1 1 5]); ## @@ -96,20 +99,21 @@ ## [f, v, c] = isosurface (x, y, z, c, iso, y); ## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", c, \ ## "FaceColor", "interp", "EdgeColor", "none"); -## set (gca, "PlotBoxAspectRatioMode","manual", "PlotBoxAspectRatio", [1 1 1]); +## set (gca, "PlotBoxAspectRatioMode","manual", ... +## "PlotBoxAspectRatio", [1 1 1]); ## # set (p, "FaceLighting", "phong"); ## # light ("Position", [1 1 5]); ## ## subplot (2, 2, 4); view (-38, 20); ## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", c, \ ## "FaceColor", "interp", "EdgeColor", "blue"); -## set (gca, "PlotBoxAspectRatioMode","manual", "PlotBoxAspectRatio", [1 1 1]); +## set (gca, "PlotBoxAspectRatioMode","manual", ... +## "PlotBoxAspectRatio", [1 1 1]); ## # set (p, "FaceLighting", "phong"); ## # light ("Position", [1 1 5]); -## @end example +## @end smallexample ## -## @seealso{isocolors, isonormals, isocaps} -## +## @seealso{isonormals, isocolors} ## @end deftypefn ## Author: Martin Helm <martin@mhelm.de>
--- a/scripts/plot/isprop.m +++ b/scripts/plot/isprop.m @@ -30,21 +30,26 @@ print_usage (); endif - if (! ishandle (h)) + if (! all (ishandle (h))) error ("isprop: first input argument must be a handle"); elseif (! ischar (prop)) error ("isprop: second input argument must be string"); endif - res = true; - try - v = get (h, prop); - catch - res = false; - end_try_catch + res = false (size (h)); + for n = 1:numel(res) + res(n) = true; + try + v = get (h(n), prop); + catch + res(n) = false; + end_try_catch + endfor endfunction %!assert (isprop (0, "foobar"), false) %!assert (isprop (0, "screenpixelsperinch"), true) +%!assert (isprop (zeros (2, 3), "visible"), true (2, 3)) +
--- a/scripts/plot/legend.m +++ b/scripts/plot/legend.m @@ -40,6 +40,9 @@ ## ## @multitable @columnfractions 0.06 0.14 0.80 ## +## @headitem @tab @var{pos} @tab +## location of the legend +## ## @item @tab north @tab ## center top ## @@ -119,13 +122,20 @@ ca = gca (); endif - if (strcmp (get (ca, "tag"), "plotyy")) - plty = get(ca, "userdata"); - if (isscalar (plty)) + if (ishandle (ca) && isprop (ca, "__plotyy_axes__")) + plty = get (ca, "__plotyy_axes__"); + if (isscalar (plty) && ishandle (plty)) ca = [ca, plty]; - else + elseif (iscell (plty)) ca = [ca, plty{:}]; + elseif (all (ishandle (plty))) + ca = [ca, plty(:).']; + else + error ("legend.m: This should not happen. File a bug report.") endif + ## Remove duplicates while preserving order + [~, n] = unique (ca); + ca = ca (sort (n)); endif if (nargin > 0 && all (ishandle (varargin{1}))) @@ -151,7 +161,7 @@ if (nargs > 0) pos = varargin{nargs}; - if (isnumeric (pos) && isscalar (pos) && round (pos) == pos) + if (isnumeric (pos) && isscalar (pos) && pos == fix (pos)) if (pos >= -1 && pos <= 4) position = [{"northeastoutside", "best", "northeast", "northwest", "southwest", "southeast"}] {pos + 2}; @@ -288,7 +298,7 @@ if (! isempty (hlegend)) set (hlegend, "box", "off", "visible", "off"); endif - elseif (nargs == 0 && !(strcmp (position, "default") && + elseif (nargs == 0 && !(strcmp (position, "default") && strcmp (orientation, "default"))) if (! isempty (hlegend)) hax = getfield (get (hlegend, "userdata"), "handle"); @@ -298,14 +308,14 @@ h = legend (hax, hplots, text_strings, "orientation", orientation); elseif (strcmp (orientation, "default")) if (outside) - h = legend (hax, hplots, text_strings, "location", + h = legend (hax, hplots, text_strings, "location", strcat (position, "outside")); else h = legend (hax, hplots, text_strings, "location", position); endif else if (outside) - h = legend (hax, hplots, text_strings, "location", + h = legend (hax, hplots, text_strings, "location", strcat (position, "outside"), "orientation", orientation); else h = legend (hax, hplots, text_strings, "location", position, @@ -368,13 +378,15 @@ break; endif elseif (! warned) - warned = true; - warning ("legend: ignoring extra labels"); + break; endif else error ("legend: expecting argument to be a character string"); endif endfor + if (i < nargs && ! warned) + warning ("legend: ignoring extra labels"); + endif else k = nkids; while (k > 0) @@ -396,7 +408,7 @@ if (isfield (hgobj, "displayname") && ! isempty (hgobj.displayname)) hplots = [hplots, hgkids(j)]; - text_strings = {text_strings{:}, hbobj.displayname}; + text_strings = {text_strings{:}, hgobj.displayname}; break; endif endfor @@ -806,22 +818,14 @@ endfunction function updatelegendtext (h, d) + hax = get (h, "userdata").handle; kids = get (h, "children"); - k = numel (kids); - in = get (h, "interpreter"); - tc = get (h, "textcolor"); - while (k > 0) - typ = get (kids(k), "type"); - while (k > 0 && ! strcmp (typ, "text")) - typ = get (kids(--k), "type"); - endwhile - if (k > 0) - set (kids (k), "interpreter", in, "color", tc); - if (--k == 0) - break; - endif - endif - endwhile + text_kids = findobj (kids, "-property", "interpreter", "type", "text"); + interpreter = get (h, "interpreter"); + textcolor = get (h, "textcolor"); + set (kids, "interpreter", interpreter, "color", textcolor); + hobj = cell2mat (get (kids, "userdata")); + set (hobj, "interpreter", interpreter); endfunction function hideshowlegend (h, d, ca, pos1, pos2) @@ -1076,7 +1080,7 @@ %! clf %! rand_2x3_data1 = [0.341447, 0.171220, 0.284370; 0.039773, 0.731725, 0.779382]; %! bar (rand_2x3_data1); -%! ylim ([0 1.2]); +%! ylim ([0 1.0]); %! legend ({"1st Bar", "2nd Bar", "3rd Bar"}); %!demo @@ -1085,6 +1089,7 @@ %! bar (rand_2x3_data2); %! ylim ([0 1.2]); %! legend ("1st Bar", "2nd Bar", "3rd Bar"); +%! legend right %!demo %! clf @@ -1123,21 +1128,34 @@ %!demo %! clf -%! x = 0:4; +%! x = 1:5; %! subplot (2, 2, 1) %! plot (x, rand (numel (x))); -%! legend (cellstr (num2str ((1:10)')), "location", "northwestoutside") +%! legend (cellstr (num2str (x')), "location", "northwestoutside") %! legend boxon %! subplot (2, 2, 2) %! plot (x, rand (numel (x))); -%! legend (cellstr (num2str ((1:10)')), "location", "northeastoutside") +%! legend (cellstr (num2str (x')), "location", "northeastoutside") %! legend boxon %! subplot (2, 2, 3); %! plot (x, rand (numel (x))); -%! legend (cellstr (num2str ((1:10)')), "location", "southwestoutside") +%! legend (cellstr (num2str (x')), "location", "southwestoutside") %! legend boxon %! subplot (2, 2, 4) %! plot (x, rand (numel (x))); -%! legend (cellstr (num2str ((1:10)')), "location", "southeastoutside") +%! legend (cellstr (num2str (x')), "location", "southeastoutside") %! legend boxon +%!demo +%! clf +%! plot (rand (2)) +%! title ("Warn of extra labels") +%! legend ("Hello", "World", "interpreter", "foobar") + +%!demo +%! clf +%! plot (rand (2)) +%! title ("Turn off TeX interpreter") +%! h = legend ("Hello_World", "foo^bar"); +%! set (h, "interpreter", "none") +
--- a/scripts/plot/line.m +++ b/scripts/plot/line.m @@ -42,3 +42,18 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = line; +%! assert (findobj (hf, "type", "line"), h); +%! assert (get (h, "xdata"), [0 1], eps); +%! assert (get (h, "ydata"), [0 1], eps); +%! assert (get (h, "type"), "line"); +%! assert (get (h, "color"), get (0, "defaultlinecolor")); +%! assert (get (h, "linestyle"), get (0, "defaultlinelinestyle")); +%! assert (get (h, "linewidth"), get (0, "defaultlinelinewidth"), eps); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/linkprop.m +++ b/scripts/plot/linkprop.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{hlink} =} linkprop (@var{h}, @var{prop}) -## Links graphics object properties, such that a change in one is +## Link graphics object properties, such that a change in one is ## propagated to the others. The properties to link are given as a ## string of cell string array by @var{prop} and the objects containing ## these properties by the handle array @var{h}.
--- a/scripts/plot/loglog.m +++ b/scripts/plot/loglog.m @@ -26,6 +26,8 @@ ## Produce a two-dimensional plot using log scales for both axes. See ## the documentation of @code{plot} for a description of the arguments ## that @code{loglog} will accept. +## +## The optional return value @var{h} is a graphics handle to the created plot. ## @seealso{plot, semilogx, semilogy} ## @end deftypefn @@ -60,3 +62,48 @@ endfunction +%!demo +%! clf (); +%! t = 1:0.01:10; +%! x = sort ((t .* (1 + rand (size (t)))) .^ 2); +%! y = ((t .* (1 + rand (size (t)))) .^ 2); +%! loglog (x, y); + +%!demo +%! clf (); +%! a = logspace (-5, 1, 10); +%! b =-logspace (-5, 1, 10); +%! +%! subplot (1, 2, 1) +%! loglog (a, b) +%! xlabel ('loglog (a, b)') +%! +%! subplot (1, 2, 2) +%! loglog (a, abs (b)) +%! set (gca, 'ydir', 'reverse') +%! xlabel ('loglog (a, abs (b))') + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b = logspace (-5, 1, 10); +%! loglog (a, b) +%! assert (get (gca, "yscale"), "log"); +%! assert (get (gca, "xscale"), "log"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b =-logspace (-5, 1, 10); +%! loglog (a, b) +%! axis tight +%! assert (all (get (gca, "ytick") < 0)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/loglogerr.m +++ b/scripts/plot/loglogerr.m @@ -61,6 +61,7 @@ endfunction %!demo +%! clf %! x = exp (log(0.01):0.2:log(10)); %! y = wblpdf (x, 3, 2); %! eyu = 2*rand (size (y)) .* y;
--- a/scripts/plot/mesh.m +++ b/scripts/plot/mesh.m @@ -32,6 +32,9 @@ ## The color of the mesh is derived from the @code{colormap} ## and the value of @var{z}. Optionally the color of the mesh can be ## specified independent of @var{z}, by adding a fourth matrix, @var{c}. +## +## The optional return value @var{h} is a graphics handle to the created +## surface object. ## @seealso{colormap, contour, meshgrid, surf} ## @end deftypefn @@ -58,3 +61,7 @@ endif endfunction + + +%% FIXME: Need demo or test for function +
--- a/scripts/plot/meshgrid.m +++ b/scripts/plot/meshgrid.m @@ -70,3 +70,34 @@ endif endfunction + +%!test +%! x = 1:2; +%! y = 1:3; +%! z = 1:4; +%! [XX, YY, ZZ] = meshgrid (x, y, z); +%! assert (size_equal (XX, YY, ZZ)); +%! assert (ndims (XX), 3); +%! assert (size (XX), [3, 2, 4]); +%! assert (XX(1) * YY(1) * ZZ(1), x(1) * y(1) * z(1)); +%! assert (XX(end) * YY(end) * ZZ(end), x(end) * y(end) * z(end)); + +%!test +%! x = 1:2; +%! y = 1:3; +%! [XX, YY] = meshgrid (x, y); +%! assert (size_equal (XX, YY)); +%! assert (ndims (XX), 2); +%! assert (size (XX), [3, 2]); +%! assert (XX(1) * YY(1), x(1) * y(1)); +%! assert (XX(end) * YY(end), x(end) * y(end)); + +%!test +%! x = 1:3; +%! [XX1, YY1] = meshgrid (x, x); +%! [XX2, YY2] = meshgrid (x); +%! assert (size_equal (XX1, XX2, YY1, YY2)); +%! assert (ndims (XX1), 2); +%! assert (size (XX1), [3, 3]); +%! assert (XX1, XX2); +%! assert (YY1, YY2); \ No newline at end of file
--- a/scripts/plot/module.mk +++ b/scripts/plot/module.mk @@ -19,39 +19,44 @@ plot/private/__errcomm__.m \ plot/private/__errplot__.m \ plot/private/__ezplot__.m \ + plot/private/__file_filter__.m \ plot/private/__fltk_file_filter__.m \ - plot/private/__ghostscript__.m \ + plot/private/__fltk_ginput__.m \ + plot/private/__fltk_print__.m \ plot/private/__getlegenddata__.m \ + plot/private/__ghostscript__.m \ + plot/private/__gnuplot_get_var__.m \ + plot/private/__gnuplot_ginput__.m \ + plot/private/__gnuplot_has_feature__.m \ plot/private/__gnuplot_has_terminal__.m\ + plot/private/__gnuplot_open_stream__.m \ + plot/private/__gnuplot_print__.m \ + plot/private/__gnuplot_version__.m \ + plot/private/__go_draw_axes__.m \ + plot/private/__go_draw_figure__.m \ plot/private/__interp_cube__.m \ + plot/private/__is_function__.m \ plot/private/__line__.m \ + plot/private/__marching_cube__.m \ + plot/private/__next_line_color__.m \ + plot/private/__next_line_style__.m \ plot/private/__patch__.m \ plot/private/__pie__.m \ plot/private/__plt__.m \ plot/private/__pltopt__.m \ + plot/private/__print_parse_opts__.m \ plot/private/__quiver__.m \ plot/private/__scatter__.m \ plot/private/__stem__.m \ - plot/private/__tight_eps_bbox__.m + plot/private/__tight_eps_bbox__.m \ + plot/private/__uigetdir_fltk__.m \ + plot/private/__uigetfile_fltk__.m \ + plot/private/__uiputfile_fltk__.m \ + plot/private/__uiobject_split_args__.m plot_FCN_FILES = \ - plot/__fltk_ginput__.m \ - plot/__fltk_print__.m \ plot/__gnuplot_drawnow__.m \ - plot/__gnuplot_get_var__.m \ - plot/__gnuplot_ginput__.m \ - plot/__gnuplot_has_feature__.m \ - plot/__gnuplot_open_stream__.m \ - plot/__gnuplot_print__.m \ - plot/__gnuplot_version__.m \ - plot/__go_close_all__.m \ - plot/__go_draw_axes__.m \ - plot/__go_draw_figure__.m \ - plot/__marching_cube__.m \ - plot/__next_line_color__.m \ - plot/__next_line_style__.m \ plot/__plt_get_axis_arg__.m \ - plot/__print_parse_opts__.m \ plot/allchild.m \ plot/ancestor.m \ plot/area.m \ @@ -67,6 +72,7 @@ plot/close.m \ plot/closereq.m \ plot/colorbar.m \ + plot/colstyle.m \ plot/comet.m \ plot/comet3.m \ plot/compass.m \ @@ -102,6 +108,8 @@ plot/graphics_toolkit.m \ plot/grid.m \ plot/gtext.m \ + plot/guidata.m \ + plot/guihandles.m \ plot/hggroup.m \ plot/hidden.m \ plot/hist.m \ @@ -140,6 +148,7 @@ plot/print.m \ plot/quiver.m \ plot/quiver3.m \ + plot/rectangle.m \ plot/refresh.m \ plot/refreshdata.m \ plot/ribbon.m \ @@ -169,11 +178,23 @@ plot/surfnorm.m \ plot/text.m \ plot/title.m \ + plot/trimesh.m \ + plot/triplot.m \ + plot/trisurf.m \ + plot/uicontextmenu.m \ + plot/uicontrol.m \ plot/uigetdir.m \ plot/uigetfile.m \ plot/uimenu.m \ + plot/uipanel.m \ + plot/uipushtool.m \ plot/uiputfile.m \ + plot/uiresume.m \ + plot/uitoggletool.m \ + plot/uitoolbar.m \ + plot/uiwait.m \ plot/view.m \ + plot/waitbar.m \ plot/waitforbuttonpress.m \ plot/whitebg.m \ plot/xlabel.m \
--- a/scripts/plot/ndgrid.m +++ b/scripts/plot/ndgrid.m @@ -69,3 +69,29 @@ endfor endfunction + +%!test +%! x = 1:2; +%! y = 1:3; +%! z = 1:4; +%! [XX, YY, ZZ] = ndgrid (x, y, z); +%! assert (size_equal (XX, YY, ZZ)); +%! assert (ndims (XX), 3); +%! assert (size (XX), [2, 3, 4]); +%! assert (XX(1) * YY(1) * ZZ(1), x(1) * y(1) * z(1)); +%! assert (XX(end) * YY(end) * ZZ(end), x(end) * y(end) * z(end)); + +%!test +%! x = 1:2; +%! y = 1:3; +%! [XX1, YY1] = meshgrid (x, y); +%! [XX2, YY2] = ndgrid (x, y); +%! assert (size_equal (XX1, YY1)); +%! assert (size_equal (XX2, YY2)); +%! assert (ndims (XX1), 2); +%! assert (size (XX1), [3, 2]); +%! assert (size (XX2), [2, 3]); +%! assert (XX2(1) * YY2(1), x(1) * y(1)); +%! assert (XX2(end) * YY2(end), x(end) * y(end)); +%! assert (XX1, XX2.'); +%! assert (YY1, YY2.');
--- a/scripts/plot/newplot.m +++ b/scripts/plot/newplot.m @@ -64,3 +64,13 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! p = plot ([0, 1]); +%! newplot; +%! assert (isempty (get (gca, "children"))); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/pareto.m +++ b/scripts/plot/pareto.m @@ -41,6 +41,10 @@ ## @var{y} can be a string array, a cell array of strings or a numerical ## vector. ## +## The optional return value @var{h} is a 2-element vector with a graphics +## handle for the created bar plot and a second handle for the created line +## plot. +## ## An example of the use of @code{pareto} is ## ## @example @@ -48,7 +52,7 @@ ## Cheese = @{"Cheddar", "Swiss", "Camembert", ... ## "Munster", "Stilton", "Blue"@}; ## Sold = [105, 30, 70, 10, 15, 20]; -## pareto(Sold, Cheese); +## pareto (Sold, Cheese); ## @end group ## @end example ## @end deftypefn @@ -66,11 +70,11 @@ if (ischar (y)) y = cellstr (y); else - y = cellfun (@num2str, num2cell (y), "uniformoutput", false); + y = cellfun ("num2str", num2cell (y), "uniformoutput", false); endif endif else - y = cellfun (@int2str, num2cell (1 : numel(x)), + y = cellfun ("int2str", num2cell (1 : numel(x)), "uniformoutput", false); endif @@ -99,12 +103,13 @@ endfunction + %!demo %! clf -%! colormap (jet (64)) +%! colormap (jet (64)); %! Cheese = {"Cheddar", "Swiss", "Camembert", "Munster", "Stilton", "Blue"}; %! Sold = [105, 30, 70, 10, 15, 20]; -%! pareto(Sold, Cheese); +%! pareto (Sold, Cheese); %!demo %! clf @@ -114,3 +119,4 @@ %! SoldUnits = [54723 41114 16939 1576091 168000 687197 120222 168195, ... %! 1084118 55576]'; %! pareto (Value.*SoldUnits, Codes); +
--- a/scripts/plot/patch.m +++ b/scripts/plot/patch.m @@ -35,6 +35,10 @@ ## If passed a structure @var{fv} contain the fields "vertices", "faces" ## and optionally "facevertexcdata", create the patch based on these ## properties. +## +## The optional return value @var{h} is a graphics handle to the created patch +## object. +## @seealso{fill} ## @end deftypefn ## Author: jwe @@ -43,17 +47,11 @@ [h, varargin] = __plt_get_axis_arg__ ("patch", varargin{:}); - oldh = gca (); + [tmp, failed] = __patch__ (h, varargin{:}); - unwind_protect - axes (h); - [tmp, failed] = __patch__ (h, varargin{:}); - if (failed) - print_usage (); - endif - unwind_protect_cleanup - axes (oldh); - end_unwind_protect + if (failed) + print_usage (); + endif if (nargout > 0) retval = tmp; @@ -66,10 +64,10 @@ %! clf %! t1 = (1/16:1/8:1)'*2*pi; %! t2 = ((1/16:1/8:1)' + 1/32)*2*pi; -%! x1 = sin(t1) - 0.8; -%! y1 = cos(t1); -%! x2 = sin(t2) + 0.8; -%! y2 = cos(t2); +%! x1 = sin (t1) - 0.8; +%! y1 = cos (t1); +%! x2 = sin (t2) + 0.8; +%! y2 = cos (t2); %! patch([x1,x2],[y1,y2],'r'); %!demo @@ -77,10 +75,10 @@ %! clf %! t1 = (1/16:1/8:1)'*2*pi; %! t2 = ((1/16:1/16:1)' + 1/32)*2*pi; -%! x1 = sin(t1) - 0.8; -%! y1 = cos(t1); -%! x2 = sin(t2) + 0.8; -%! y2 = cos(t2); +%! x1 = sin (t1) - 0.8; +%! y1 = cos (t1); +%! x2 = sin (t2) + 0.8; +%! y2 = cos (t2); %! patch([[x1;NaN(8,1)],x2],[[y1;NaN(8,1)],y2],'r'); %!demo @@ -88,10 +86,10 @@ %! clf %! t1 = (1/16:1/8:1)'*2*pi; %! t2 = ((1/16:1/16:1)' + 1/32)*2*pi; -%! x1 = sin(t1) - 0.8; -%! y1 = cos(t1); -%! x2 = sin(t2) + 0.8; -%! y2 = cos(t2); +%! x1 = sin (t1) - 0.8; +%! y1 = cos (t1); +%! x2 = sin (t2) + 0.8; +%! y2 = cos (t2); %! vert = [x1, y1; x2, y2]; %! fac = [1:8,NaN(1,8);9:24]; %! patch('Faces',fac,'Vertices',vert,'FaceColor','r'); @@ -101,10 +99,10 @@ %! clf %! t1 = (1/16:1/8:1)'*2*pi; %! t2 = ((1/16:1/16:1)' + 1/32)*2*pi; -%! x1 = sin(t1) - 0.8; -%! y1 = cos(t1); -%! x2 = sin(t2) + 0.8; -%! y2 = cos(t2); +%! x1 = sin (t1) - 0.8; +%! y1 = cos (t1); +%! x2 = sin (t2) + 0.8; +%! y2 = cos (t2); %! vert = [x1, y1; x2, y2]; %! fac = [1:8,NaN(1,8);9:24]; %! patch('Faces',fac,'Vertices',vert,'FaceVertexCData', [0, 1, 0; 0, 0, 1]); @@ -114,10 +112,10 @@ %! clf %! t1 = (1/16:1/8:1)'*2*pi; %! t2 = ((1/16:1/8:1)' + 1/32)*2*pi; -%! x1 = sin(t1) - 0.8; -%! y1 = cos(t1); -%! x2 = sin(t2) + 0.8; -%! y2 = cos(t2); +%! x1 = sin (t1) - 0.8; +%! y1 = cos (t1); +%! x2 = sin (t2) + 0.8; +%! y2 = cos (t2); %! h = patch([x1,x2],[y1,y2],cat (3,[0,0],[1,0],[0,1])); %! pause (1); %! set (h, 'FaceColor', 'r'); @@ -133,6 +131,105 @@ %! 2, 3, 5; %! 3, 4, 5; %! 4, 1, 5]; -%! patch('Vertices', vertices, 'Faces', faces, ... -%! 'FaceVertexCData', jet(4), 'FaceColor', 'flat') -%! view (-37.5, 30) +%! patch ('Vertices', vertices, 'Faces', faces, ... +%! 'FaceVertexCData', jet(4), 'FaceColor', 'flat'); +%! view (-37.5, 30); + +%!demo +%! clf +%! vertices = [0, 0, 0; +%! 1, 0, 0; +%! 1, 1, 0; +%! 0, 1, 0; +%! 0.5, 0.5, 1]; +%! faces = [1, 2, 5; +%! 2, 3, 5; +%! 3, 4, 5; +%! 4, 1, 5]; +%! patch ('Vertices', vertices, 'Faces', faces, ... +%! 'FaceVertexCData', jet(5), 'FaceColor', 'interp'); +%! view (-37.5, 30); + +%!demo +%! clf +%! colormap (jet); +%! x = [0 1 1 0]; +%! y = [0 0 1 1]; +%! subplot (2, 1, 1); +%! title ("Blue, Light-Green, and Red Horizontal Bars"); +%! patch (x, y + 0, 1); +%! patch (x, y + 1, 2); +%! patch (x, y + 2, 3); +%! subplot (2, 1, 2); +%! title ("Blue, Light-Green, and Red Vertical Bars"); +%! patch (x + 0, y, 1 * ones (size (x))); +%! patch (x + 1, y, 2 * ones (size (x))); +%! patch (x + 2, y, 3 * ones (size (x))); + +%!demo +%! clf +%! colormap (jet); +%! x = [0 1 1 0]; +%! y = [0 0 1 1]; +%! subplot (2, 1, 1); +%! title ("Blue horizontal bars: Dark to Light"); +%! patch (x, y + 0, 1, "cdatamapping", "direct"); +%! patch (x, y + 1, 9, "cdatamapping", "direct"); +%! patch (x, y + 2, 17, "cdatamapping", "direct"); +%! subplot (2, 1, 2); +%! title ("Blue vertical bars: Dark to Light") +%! patch (x + 0, y, 1 * ones (size (x)), "cdatamapping", "direct"); +%! patch (x + 1, y, 9 * ones (size (x)), "cdatamapping", "direct"); +%! patch (x + 2, y, 17 * ones (size (x)), "cdatamapping", "direct"); + +%!demo +%! clf; +%! colormap (jet); +%! x = [ 0 0; 1 1; 1 0 ]; +%! y = [ 0 0; 0 1; 1 1 ]; +%! p = patch (x, y, "facecolor", "b"); +%! title ("Two blue triangles"); +%! set (p, "cdatamapping", "direct", "facecolor", "flat", "cdata", [1 32]); +%! title ("Direct mapping of colors: Light-Green UL and Blue LR triangles"); + +%!demo +%! clf; +%! colormap (jet); +%! x = [ 0 0; 1 1; 1 0 ]; +%! y = [ 0 0; 0 1; 1 1 ]; +%! p = patch (x, y, [1 32]); +%! title ("Autoscaling of colors: Red UL and Blue LR triangles"); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = patch; +%! assert (findobj (hf, "type", "patch"), h); +%! assert (get (h, "xdata"), [0; 1; 0], eps); +%! assert (get (h, "ydata"), [1; 1; 0], eps); +%! assert (isempty (get (h, "zdata"))); +%! assert (isempty (get (h, "cdata"))); +%! assert (get (h, "faces"), [1, 2, 3], eps); +%! assert (get (h, "vertices"), [0 1; 1 1; 0 0], eps); +%! assert (get (h, "type"), "patch"); +%! assert (get (h, "facecolor"), [0 0 0]); +%! assert (get (h, "linestyle"), get (0, "defaultpatchlinestyle")); +%! assert (get (h, "linewidth"), get (0, "defaultpatchlinewidth"), eps); +%! assert (get (h, "marker"), get (0, "defaultpatchmarker")); +%! assert (get (h, "markersize"), get (0, "defaultpatchmarkersize")); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! c = 0.9; +%! unwind_protect +%! h = patch ([0 1 0], [0 1 1], c); +%! assert (get (gca, "clim"), [c - 1, c + 1]); +%! h = patch ([0 1 0], [0 1 1], 2 * c); +%! assert (get (gca, "clim"), [c, 2 * c]); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/pbaspect.m +++ b/scripts/plot/pbaspect.m @@ -21,14 +21,18 @@ ## Set the plot box aspect ratio of the current axes. The aspect ratio ## is a normalized 3-element vector representing the rendered lengths of ## the x, y, and z-axes. +## ## @deftypefnx {Function File} {@var{plot_box_aspect_ratio} =} pbaspect ( ) ## Return the plot box aspect ratio of the current axes. +## ## @deftypefnx {Function File} {} pbaspect (@var{mode}) ## Set the plot box aspect ratio mode of the current axes. +## ## @deftypefnx {Function File} {@var{plot_box_aspect_ratio_mode} =} pbaspect ("mode") ## Return the plot box aspect ratio mode of the current axes. +## ## @deftypefnx {Function File} {} pbaspect (@var{hax}, @dots{}) -## Uses the axes, with handle @var{hax}, instead of the current axes. +## Use the axes, with handle @var{hax}, instead of the current axes. ## ## @seealso{axis, daspect, xlim, ylim, zlim} ## @end deftypefn
--- a/scripts/plot/pcolor.m +++ b/scripts/plot/pcolor.m @@ -80,3 +80,15 @@ endif endfunction + +%!demo +%! clf +%! [~,~,Z]=peaks; +%! pcolor(Z); + +%!demo +%! clf +%! [X,Y,Z]=sombrero; +%! [Fx,Fy] = gradient(Z); +%! pcolor(X,Y,Fx+Fy); +%! shading interp;
--- a/scripts/plot/pie.m +++ b/scripts/plot/pie.m @@ -22,7 +22,7 @@ ## @deftypefnx {Function File} {} pie (@dots{}, @var{labels}) ## @deftypefnx {Function File} {} pie (@var{h}, @dots{}); ## @deftypefnx {Function File} {@var{h} =} pie (@dots{}); -## Produce a pie chart. +## Produce a 2-D pie chart. ## ## Called with a single vector argument, produces a pie chart of the ## elements in @var{x}, with the size of the slice determined by percentage @@ -34,7 +34,8 @@ ## If given @var{labels} is a cell array of strings of the same length as ## @var{x}, giving the labels of each of the slices of the pie chart. ## -## The optional return value @var{h} provides a handle to the patch object. +## The optional return value @var{h} is a list of handles to the patch +## and text objects generating the plot. ## ## @seealso{pie3, bar, stem} ## @end deftypefn @@ -65,17 +66,22 @@ endfunction -%!demo -%! pie ([3, 2, 1], [0, 0, 1]); -%! colormap([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); %!demo +%! clf +%! pie ([3, 2, 1], [0, 0, 1]); +%! colormap ([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); + +%!demo +%! clf %! pie ([3, 2, 1], [0, 0, 1], {"Cheddar", "Swiss", "Camembert"}); -%! colormap([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); +%! colormap ([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); %! axis ([-2,2,-2,2]); %!demo +%! clf %! pie ([0.17, 0.34, 0.41], {"Cheddar", "Swiss", "Camembert"}); -%! colormap([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); +%! colormap ([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); %! axis ([-2,2,-2,2]); -%! title ("missing slice"); \ No newline at end of file +%! title ("missing slice"); +
--- a/scripts/plot/pie3.m +++ b/scripts/plot/pie3.m @@ -35,8 +35,8 @@ ## If given @var{labels} is a cell array of strings of the same length as ## @var{x}, giving the labels of each of the slices of the pie chart. ## -## The optional return value @var{h} provides a handle list to patch, surface -## and text objects generating this plot. +## The optional return value @var{h} is a list of graphics handles to the patch, +## surface, and text objects generating the plot. ## ## @seealso{pie, bar, stem} ## @end deftypefn @@ -67,17 +67,22 @@ endfunction -%!demo -%! pie3 ([5:-1:1], [0, 0, 1, 0, 0]); -%! colormap([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); %!demo +%! clf +%! pie3 ([5:-1:1], [0, 0, 1, 0, 0]); +%! colormap ([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); + +%!demo +%! clf %! pie3 ([3, 2, 1], [0, 0, 1], {"Cheddar", "Swiss", "Camembert"}); -%! colormap([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); +%! colormap ([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); %! axis ([-2,2,-2,2]); %!demo +%! clf %! pie3 ([0.17, 0.34, 0.41], {"Cheddar", "Swiss", "Camembert"}); -%! colormap([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); +%! colormap ([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); %! axis ([-2,2,-2,2]); %! title ("missing slice"); +
--- a/scripts/plot/plot.m +++ b/scripts/plot/plot.m @@ -173,6 +173,8 @@ ## If the first argument is an axis handle, then plot into these axes, ## rather than the current axis handle returned by @code{gca}. ## +## The optional return value @var{h} is a graphics handle to the created plot. +## ## @seealso{semilogx, semilogy, loglog, polar, mesh, contour, bar, ## stairs, errorbar, xlabel, ylabel, title, print} ## @end deftypefn @@ -201,3 +203,7 @@ endif endfunction + + +%% FIXME: Need demo or test for function +
--- a/scripts/plot/plot3.m +++ b/scripts/plot/plot3.m @@ -333,6 +333,7 @@ endfunction %!demo +%! clf %! z = [0:0.05:5]; %! plot3 (cos(2*pi*z), sin(2*pi*z), z, ";helix;"); %! plot3 (z, exp(2i*pi*z), ";complex sinusoid;");
--- a/scripts/plot/plotmatrix.m +++ b/scripts/plot/plotmatrix.m @@ -96,6 +96,7 @@ endfunction %!demo +%! clf %! plotmatrix (randn (100, 3), 'g+') function plotmatrixdelete (h, d, ax)
--- a/scripts/plot/plotyy.m +++ b/scripts/plot/plotyy.m @@ -22,7 +22,7 @@ ## @deftypefnx {Function File} {} plotyy (@dots{}, @var{fun1}, @var{fun2}) ## @deftypefnx {Function File} {} plotyy (@var{h}, @dots{}) ## @deftypefnx {Function File} {[@var{ax}, @var{h1}, @var{h2}] =} plotyy (@dots{}) -## Plots two sets of data with independent y-axes. The arguments @var{x1} and +## Plot two sets of data with independent y-axes. The arguments @var{x1} and ## @var{y1} define the arguments for the first plot and @var{x1} and @var{y2} ## for the second. ## @@ -70,6 +70,7 @@ else error ("plotyy: expecting first argument to be axes handle"); endif + oldh = gca (); else f = get (0, "currentfigure"); if (isempty (f)) @@ -78,7 +79,7 @@ ca = get (f, "currentaxes"); if (isempty (ca)) ax = []; - elseif (strcmp (get (ca, "tag"), "plotyy")); + elseif (ishandle (ca) && isprop (ca, "__plotyy_axes__")) ax = get (ca, "__plotyy_axes__"); else ax = ca; @@ -93,17 +94,18 @@ elseif (isempty (ax)) ax(1) = axes (); ax(2) = axes (); + ca = ax(2); endif if (nargin < 2) varargin = {}; endif + oldh = ca; endif if (nargin < 4) print_usage (); endif - oldh = gca (); unwind_protect [ax, h1, h2] = __plotyy__ (ax, varargin{:}); unwind_protect_cleanup @@ -113,8 +115,6 @@ endif end_unwind_protect - set (ax, "activepositionproperty", "position"); - if (nargout > 0) Ax = ax; H1 = h1; @@ -162,10 +162,24 @@ colors = get (ax(1), "colororder"); set (ax(2), "colororder", [colors(2:end,:); colors(1,:)]); + if (strcmp (get (ax(1), "autopos_tag"), "subplot")) + set (ax(2), "autopos_tag", "subplot"); + else + set (ax, "activepositionproperty", "position"); + endif + h2 = feval (fun2, x2, y2); set (ax(2), "yaxislocation", "right"); set (ax(2), "ycolor", getcolor (h2(1))); - set (ax(2), "position", get (ax(1), "position")); + + + if (strcmp (get(ax(1), "activepositionproperty"), "position")) + set (ax(2), "position", get (ax(1), "position")); + else + set (ax(2), "outerposition", get (ax(1), "outerposition")); + set (ax(2), "looseinset", get (ax(1), "looseinset")); + endif + set (ax(2), "xlim", xlim); set (ax(2), "color", "none"); set (ax(2), "box", "off"); @@ -184,6 +198,10 @@ addlistener (ax(1), "position", {@update_position, ax(2)}); addlistener (ax(2), "position", {@update_position, ax(1)}); + addlistener (ax(1), "outerposition", {@update_position, ax(2)}); + addlistener (ax(2), "outerposition", {@update_position, ax(1)}); + addlistener (ax(1), "looseinset", {@update_position, ax(2)}); + addlistener (ax(2), "looseinset", {@update_position, ax(1)}); addlistener (ax(1), "view", {@update_position, ax(2)}); addlistener (ax(2), "view", {@update_position, ax(1)}); addlistener (ax(1), "plotboxaspectratio", {@update_position, ax(2)}); @@ -191,25 +209,21 @@ addlistener (ax(1), "plotboxaspectratiomode", {@update_position, ax(2)}); addlistener (ax(2), "plotboxaspectratiomode", {@update_position, ax(1)}); - ## Tag the plotyy axes, so we can use that information - ## not to mirror the y axis tick marks - set (ax, "tag", "plotyy"); - - ## Cross-reference one axis to the other in the userdata - set (ax(1), "userdata", ax(2)); - set (ax(2), "userdata", ax(1)); - ## Store the axes handles for the sister axes. - try + if (ishandle (ax(1)) && ! isprop (ax(1), "__plotyy_axes__")) addproperty ("__plotyy_axes__", ax(1), "data", ax); - catch + elseif (ishandle (ax(1))) set (ax(1), "__plotyy_axes__", ax); - end_try_catch - try + else + error ("plotyy.m: This shouldn't happen. File a bug report.") + endif + if (ishandle (ax(2)) && ! isprop (ax(2), "__plotyy_axes__")) addproperty ("__plotyy_axes__", ax(2), "data", ax); - catch + elseif (ishandle (ax(2))) set (ax(2), "__plotyy_axes__", ax); - end_try_catch + else + error ("plotyy.m: This shouldn't happen. File a bug report.") + endif endfunction %!demo @@ -241,6 +255,15 @@ %! plotyy (x, 10*sin(2*pi*x), x, cos(2*pi*x)) %! axis square +%!demo +%! clf +%! x = linspace (-1, 1, 201); +%! subplot (1, 1, 1); +%! hax = plotyy (x, sin(pi*x), x, cos(pi*x)); +%! ylabel ("Blue and on the Left") +%! ylabel (hax(2), "Green and on the Right") +%! xlabel ("xlabel") + function deleteplotyy (h, d, ax2, t2) if (ishandle (ax2) && strcmp (get (ax2, "type"), "axes") && (isempty (gcbf()) || strcmp (get (gcbf(), "beingdeleted"),"off")) @@ -257,17 +280,27 @@ if (! recursion) unwind_protect recursion = true; - position = get (h, "position"); view = get (h, "view"); - plotboxaspectratio = get (h, "plotboxaspectratio"); - plotboxaspectratiomode = get (h, "plotboxaspectratiomode"); - oldposition = get (ax2, "position"); oldview = get (ax2, "view"); + plotboxaspectratio = get (h, "plotboxaspectratio"); oldplotboxaspectratio = get (ax2, "plotboxaspectratio"); + plotboxaspectratiomode = get (h, "plotboxaspectratiomode"); oldplotboxaspectratiomode = get (ax2, "plotboxaspectratiomode"); - if (! (isequal (position, oldposition) && isequal (view, oldview))) - set (ax2, "position", position, "view", view); + + if (strcmp (get(h, "activepositionproperty"), "position")) + position = get (h, "position"); + oldposition = get (ax2, "position"); + if (! (isequal (position, oldposition) && isequal (view, oldview))) + set (ax2, "position", position, "view", view); + endif + else + outerposition = get (h, "outerposition"); + oldouterposition = get (ax2, "outerposition"); + if (! (isequal (outerposition, oldouterposition) && isequal (view, oldview))) + set (ax2, "outerposition", outerposition, "view", view); + endif endif + if (! (isequal (plotboxaspectratio, oldplotboxaspectratio) && isequal (plotboxaspectratiomode, oldplotboxaspectratiomode))) set (ax2, "plotboxaspectratio", plotboxaspectratio);
--- a/scripts/plot/polar.m +++ b/scripts/plot/polar.m @@ -21,10 +21,13 @@ ## @deftypefnx {Function File} {} polar (@var{theta}, @var{rho}, @var{fmt}) ## @deftypefnx {Function File} {} polar (@var{h}, @dots{}) ## @deftypefnx {Function File} {@var{h} =} polar (@dots{}) -## Make a two-dimensional plot given the polar coordinates @var{theta} and +## Create a two-dimensional plot from polar coordinates @var{theta} and ## @var{rho}. ## -## The optional third argument specifies the line type. +## The optional argument @var{fmt} specifies the line format. +## +## The optional return value @var{h} is a graphics handle to the created plot. +## ## @seealso{plot} ## @end deftypefn @@ -211,3 +214,17 @@ endif endfunction + + +%!demo +%! clf +%! theta = linspace (0, 2*pi, 1000); +%! rho = sin (7*theta); +%! polar (theta, rho); + +%!demo +%! clf +%! theta = linspace (0, 10*pi, 1000); +%! rho = sin (5/4*theta); +%! polar (theta, rho); +
--- a/scripts/plot/print.m +++ b/scripts/plot/print.m @@ -611,7 +611,7 @@ "print.m: error closing file '%s'", latexfile); endif ## TODO - should this be fixed in GL2PS? - latex = strrep (latex, "\\includegraphics{}", + latex = strrep (latex, "\\includegraphics{}", sprintf ("\\includegraphics{%s}", graphicsfile)); else error ("print:erroropeningfile",
old mode 100755 new mode 100644 --- a/scripts/plot/private/__add_default_menu__.m +++ b/scripts/plot/private/__add_default_menu__.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} __add_default_menu__ (@var{fig}) -## Adds default menu to figure. All uimenu handles have +## Add default menu to figure. All uimenu handles have ## set their property "handlevisibility" to "off". ## @end deftypefn
--- a/scripts/plot/private/__axes_limits__.m +++ b/scripts/plot/private/__axes_limits__.m @@ -44,7 +44,11 @@ if (!isnumeric (arg) && any (size(arg(:)) != [2, 1])) error ("%s: argument must be a 2 element vector", fcn); else - set (h, fcn, arg(:)); + if (arg(1) >= arg(2)) + error ("%s: axis limits must be increasing", fcn); + else + set (h, fcn, arg(:)); + endif endif endif endif
--- a/scripts/plot/private/__axis_label__.m +++ b/scripts/plot/private/__axis_label__.m @@ -17,32 +17,26 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} __axis_label__ (@var{caller}, @var{txt}, @dots{}) +## @deftypefn {Function File} {} __axis_label__ (@var{caller}, @var{h}, @var{txt}, @dots{}) ## Undocumented internal function. ## @end deftypefn ## Author: jwe -function retval = __axis_label__ (caller, txt, varargin) +function retval = __axis_label__ (ah, caller, txt, varargin) - if (ischar (txt)) - ca = gca (); - - h = get (gca (), caller); + h = get (ah, caller); - set (h, "fontangle", get (ca, "fontangle"), - "fontname", get (ca, "fontname"), - "fontsize", get (ca, "fontsize"), - "fontunits", get (ca, "fontunits"), - "fontweight", get (ca, "fontweight"), - "string", txt, - varargin{:}); + set (h, "fontangle", get (ah, "fontangle"), + "fontname", get (ah, "fontname"), + "fontsize", get (ah, "fontsize"), + "fontunits", get (ah, "fontunits"), + "fontweight", get (ah, "fontweight"), + "string", txt, + varargin{:}); - if (nargout > 0) - retval = h; - endif - else - error ("%s: expecting first argument to be character string", caller); + if (nargout > 0) + retval = h; endif endfunction
--- a/scripts/plot/private/__bar__.m +++ b/scripts/plot/private/__bar__.m @@ -82,7 +82,7 @@ [linespec, valid] = __pltopt__ (func, varargin{idx}, false); if (valid) have_line_spec = true; - newargs = [{linespec.color}, newargs]; + newargs = [{"facecolor", linespec.color}, newargs] idx++; continue; endif
--- a/scripts/plot/private/__contour__.m +++ b/scripts/plot/private/__contour__.m @@ -319,10 +319,18 @@ else ## Special case unclosed contours endif + if (isnan(cont_lev(idx))) + fc = get (ca, "color"); + if (strcmp (fc, "none")) + fc = get (ancestor (ca, "figure"), "color"); + endif + else + fc = "flat"; + endif h = [h; __go_patch__(ca, "xdata", ctmp(1, :)(:), "ydata", ctmp(2, :)(:), "vertices", ctmp.', "faces", 1:(cont_len(idx)-1), "facevertexcdata", cont_lev(idx), - "facecolor", "flat", "cdata", cont_lev(idx), + "facecolor", fc, "cdata", cont_lev(idx), "edgecolor", lc, "linestyle", ls, "linewidth", lw, "parent", hg)]; endfor @@ -530,7 +538,7 @@ ## it be an absolute or relative tolerance, or switch from one to the ## other depending on the value of lev? if (isscalar (lev)) - lvl_eps = abs (lev) * sqrt (eps); + lvl_eps = abs (lev) * sqrt (eps) + sqrt (eps); else tmp = min (abs (diff (lev))); if (tmp < 10*eps)
--- a/scripts/plot/private/__errplot__.m +++ b/scripts/plot/private/__errplot__.m @@ -31,7 +31,7 @@ print_usage (); endif - [fmt, key] = __pltopt__ ("__errplot__", fstr); + [fmt, valid] = __pltopt__ ("__errplot__", fstr); [len, nplots] = size (varargin{1}); h = []; @@ -74,7 +74,7 @@ switch (numel(varargin)) case 2 ydata = varargin{1}(:,i); - xdata = 1:numel(ydata); + xdata = 1:numel (ydata); if (strcmp (ifmt, "xerr") || strcmp (ifmt, "box")) xldata = varargin{2}(:,i); xudata = ldata; @@ -86,12 +86,12 @@ xldata = []; xudata = []; else - error ("errorbar: 2 column errorplot is only valid or xerr or yerr"); + error ("errorbar: 2 column errorplot is only valid for xerr or yerr"); endif case 3 if (strcmp (ifmt, "boxxy") || strcmp (ifmt, "xyerr")) ydata = varargin{1}(:,i); - xdata = 1:numel(ydata); + xdata = 1:numel (ydata); xldata = varargin{2}(:,i); xudata = xldata; ldata = varargin{3}(:,i); @@ -146,7 +146,7 @@ error ("errorbar: error plot with 6 columns only valid for boxxy and xyerr"); endif otherwise - error ("errorbar: error plot requires 2, 3, 4 or 6 arguments"); + error ("errorbar: error plot requires 2, 3, 4, or 6 arguments"); endswitch addproperty ("xdata", hg, "data", xdata(:)); @@ -193,6 +193,34 @@ endfor + ## Process legend key + if (! isempty (fmt.key)) + hlegend = []; + fkids = get (gcf(), "children"); + for i = 1 : numel (fkids) + if (ishandle (fkids(i)) && strcmp (get (fkids(i), "type"), "axes") + && (strcmp (get (fkids(i), "tag"), "legend"))) + udata = get (fkids(i), "userdata"); + if (! isempty (intersect (udata.handle, gca ()))) + hlegend = fkids (i); + break; + endif + endif + endfor + + if (isempty (hlegend)) + hlgnd = []; + tlgnd = {}; + else + [hlgnd, tlgnd] = __getlegenddata__ (hlegend); + endif + + hlgnd(end+1) = hg; + tlgnd(end+1) = fmt.key; + + legend (gca(), hlgnd, tlgnd); + end + endfunction function [xdata, ydata] = errorbar_data (xdata, ydata, ldata, udata, @@ -259,8 +287,10 @@ else error ("errorbar: valid error bar types are xerr, yerr, boxxy, and xyerr"); endif + xdata = xdata.'(:); ydata = ydata.'(:); + endfunction function update_props (hg, dummy, hl)
new file mode 100644 --- /dev/null +++ b/scripts/plot/private/__file_filter__.m @@ -0,0 +1,93 @@ +## Copyright (C) 2010-2011 Kai Habel +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} __file_filter__ (@var{file_filter}) +## Undocumented internal function. +## @end deftypefn + +## Author: Kai Habel + +function [retval, defname, defdir] = __file_filter__ (file_filter, name) + + revtal = {}; + defname = ""; + defdir = ""; + + if (iscell (file_filter)) + [r, c] = size (file_filter); + if (c != 1 && c != 2) + error ("%s: invalid filter specification", name); + endif + if (c == 1) + retval = cell (r, 2); + for i = 1:r + retval{i, 1} = file_filter{i}; + retval{i, 2} = __default_filtername__ (file_filter{i}); + endfor + else + retval = file_filter; + for i = 1:r + if (isempty (retval{i, 2})) + retval{i, 2} = __default_filtername__ (retval{i, 1}); + endif + endfor + endif + elseif (ischar (file_filter)) + [defdir, fname, fext] = fileparts (file_filter); + if (! strcmp (fname, "*")) + defname = strcat (fname, fext); + endif + if (length (fext) > 0) + fext = strcat ("*", fext); + retval = {fext, __default_filtername__(fext)}; + endif + endif + + retval(end+1,:) = {"*", __default_filtername__("*")}; + +endfunction + +function name = __default_filtername__ (filterext) + + name = ""; + + switch (filterext) + case "*" + name = "All Files"; + case "*.m" + name = "Octave Source Files"; + case "*.c" + name = "C Source Files"; + case {"*.cc" "*.c++" "*.cpp"} + name = "C++ Source Files"; + case "*.oct" + name = "Octave Compiled Files"; + endswitch + + if (isempty (name)) + extlist = strsplit(filterext, ";"); + extlist = strrep (extlist, "*.", ""); + extlist = toupper (extlist); + extlist(end+1, :) = repmat ({","}, 1, length (extlist)); + extlist = strcat (extlist{:}); + extlist = extlist(1:end-1); + name = strcat (extlist, "-Files"); + endif + +endfunction
old mode 100755 new mode 100644 --- a/scripts/plot/private/__fltk_file_filter__.m +++ b/scripts/plot/private/__fltk_file_filter__.m @@ -1,4 +1,4 @@ -## Copyright (C) 2010-2011 Kai Habel +## Copyright (C) 2011 Michael Goffioul ## ## This file is part of Octave. ## @@ -17,56 +17,48 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} __fltk_file_filter__ (@var{file_filter}) +## @deftypefn {Function File} {@var{filterspec} =} __fltk_file_filter__ (@var{filter}) ## Undocumented internal function. ## @end deftypefn -## Author: Kai Habel +## Author: Michael Goffioul function retval = __fltk_file_filter__ (file_filter) - # converts octave's file filter format into fltk's. - retval = ""; - if (iscell (file_filter)) - [r, c] = size (file_filter); - if ((c == 0) || (c > 2)) - error ("expecting 1 or to 2 columns for file filter cell"); - endif - fltk_str = ""; - for idx = 1 : r - curr_ext = file_filter{idx, 1}; - curr_ext = strsplit (curr_ext, ";"); + retval = ""; + [r, c] = size (file_filter); + if ((c == 0) || (c > 2)) + error ("expecting 1 or to 2 columns for file filter cell"); + endif + fltk_str = ""; + for idx = 1 : r - if (length (curr_ext) > 1) - curr_ext = regexprep (curr_ext, '\*\.', ','); - curr_ext = strcat (curr_ext{:})(2 : end); - curr_ext = strcat ("*.{", curr_ext, "}"); - else - curr_ext = curr_ext{:}; - endif - - curr_desc = strcat (curr_ext(3:end), "-Files"); + curr_ext = file_filter{idx, 1}; + curr_ext = strsplit (curr_ext, ";"); - if (c == 2) - curr_desc = file_filter{idx, 2}; - curr_desc = regexprep (curr_desc, '\(', '<'); - curr_desc = regexprep (curr_desc, '\)', '>'); - endif + if (length (curr_ext) > 1) + curr_ext = regexprep (curr_ext, '\*\.', ','); + curr_ext = strcat (curr_ext{:})(2 : end); + curr_ext = strcat ("*.{", curr_ext, "}"); + else + curr_ext = curr_ext{:}; + endif - if (length (fltk_str) > 0) - fltk_str = strcat (fltk_str, "\t", curr_desc, " (", curr_ext, ")"); - else - fltk_str = strcat (curr_desc, " (", curr_ext, ")"); - endif + curr_desc = strcat (curr_ext(3:end), "-Files"); - endfor - retval = fltk_str; - elseif (ischar (file_filter)) - if (!isdir (file_filter)) - [fdir, fname, fext] = fileparts (file_filter); - if (length (fext) > 0) - retval = strcat ("*", fext, "\t*"); - endif + if (c == 2) + curr_desc = file_filter{idx, 2}; + curr_desc = regexprep (curr_desc, '\(', '<'); + curr_desc = regexprep (curr_desc, '\)', '>'); endif - endif + + if (length (fltk_str) > 0) + fltk_str = strcat (fltk_str, "\t", curr_desc, " (", curr_ext, ")"); + else + fltk_str = strcat (curr_desc, " (", curr_ext, ")"); + endif + + endfor + retval = fltk_str; + endfunction
--- a/scripts/plot/private/__getlegenddata__.m +++ b/scripts/plot/private/__getlegenddata__.m @@ -26,38 +26,33 @@ text_strings = {}; ca = getfield (get (hlegend, "userdata"), "handle"); kids = []; - for i = 1 : numel (ca) - kids = [kids; get(ca (i), "children")]; + for i = 1:numel (ca) + kids = [kids; get(ca(i), "children")]; endfor - k = numel (kids); - while (k > 0) - typ = get (kids(k), "type"); - while (k > 0 - && ! (strcmp (typ, "line") || strcmp (typ, "surface") - || strcmp (typ, "patch") || strcmp (typ, "hggroup"))) - typ = get (kids(--k), "type"); - endwhile - if (k > 0) - if (strcmp (get (kids(k), "type"), "hggroup")) - hgkids = get (kids(k), "children"); + + for i = numel (kids):-1:1 + typ = get (kids(i), "type"); + if (strcmp (typ, "line") || strcmp (typ, "surface") + || strcmp (typ, "patch") || strcmp (typ, "hggroup")) + + if (strcmp (typ, "hggroup")) + hgkids = get (kids(i), "children"); for j = 1 : length (hgkids) hgobj = get (hgkids (j)); - if (isfield (hgobj, "displayname") - && ! isempty (hgobj.displayname)) + if (isfield (hgobj, "displayname") && ! isempty (hgobj.displayname)) hplots = [hplots, hgkids(j)]; - text_strings = {text_strings{:}, hbobj.displayname}; + text_strings = {text_strings{:}, hgobj.displayname}; break; endif endfor else - if (! isempty (get (kids (k), "displayname"))) - hplots = [hplots, kids(k)]; - text_strings = {text_strings{:}, get(kids (k), "displayname")}; + if (! isempty (get (kids (i), "displayname"))) + hplots = [hplots, kids(i)]; + text_strings = {text_strings{:}, get(kids (i), "displayname")}; endif endif - if (--k == 0) - break; - endif + endif - endwhile + endfor + endfunction
--- a/scripts/plot/private/__ghostscript__.m +++ b/scripts/plot/private/__ghostscript__.m @@ -44,7 +44,7 @@ cleanup_cmd = ""; args = varargin; - n = find (cellfun (@isstruct, args)); + n = find (cellfun ("isclass", args, "struct")); if (! isempty (n)) f = fieldnames (args{n}); for m = 1:numel(f)
rename from scripts/plot/__gnuplot_has_feature__.m rename to scripts/plot/private/__gnuplot_has_feature__.m
rename from scripts/plot/__gnuplot_open_stream__.m rename to scripts/plot/private/__gnuplot_open_stream__.m
rename from scripts/plot/__go_draw_axes__.m rename to scripts/plot/private/__go_draw_axes__.m --- a/scripts/plot/__go_draw_axes__.m +++ b/scripts/plot/private/__go_draw_axes__.m @@ -40,10 +40,16 @@ gnuplot_term = __gnuplot_get_var__ (axis_obj.parent, "GPVAL_TERM"); ## Set to false for plotyy axes. - if (strcmp (axis_obj.tag, "plotyy")) - ymirror = false; - else - ymirror = true; + ymirror = true; + if (isfield (axis_obj, "__plotyy_axes__")) + if (all (ishandle (axis_obj.__plotyy_axes__))) + ymirror = false; + else + h = axis_obj.__plotyy_axes__; + h = h(ishandle (h)); + h = h(isprop (h, "__ploty_axes__")); + rmappdata (h, "__plotyy_axes__") + endif endif nd = __calc_dimensions__ (h); @@ -332,12 +338,59 @@ fputs (plot_stream, "unset grid;\n"); endif + xlogscale = strcmpi (axis_obj.xscale, "log"); + ylogscale = strcmpi (axis_obj.yscale, "log"); + zlogscale = strcmpi (axis_obj.zscale, "log"); + + ## Detect logscale and negative lims + if (xlogscale && all (axis_obj.xlim < 0)) + axis_obj.xsgn = -1; + if (strcmp (axis_obj.xdir, "reverse")) + axis_obj.xdir = "normal"; + elseif (strcmp (axis_obj.xdir, "normal")) + axis_obj.xdir = "reverse"; + endif + axis_obj.xtick = -flip (axis_obj.xtick); + axis_obj.xticklabel = flip (axis_obj.xticklabel); + axis_obj.xlim = -flip (axis_obj.xlim); + else + axis_obj.xsgn = 1; + endif + if (ylogscale && all (axis_obj.ylim < 0)) + axis_obj.ysgn = -1; + if (strcmp (axis_obj.ydir, "reverse")) + axis_obj.ydir = "normal"; + elseif (strcmp (axis_obj.ydir, "normal")) + axis_obj.ydir = "reverse"; + endif + axis_obj.ytick = -flip (axis_obj.ytick); + axis_obj.yticklabel = flip (axis_obj.yticklabel); + axis_obj.ylim = -flip (axis_obj.ylim); + else + axis_obj.ysgn = 1; + endif + if (zlogscale && all (axis_obj.zlim < 0)) + axis_obj.zsgn = -1; + if (strcmp (axis_obj.zdir, "reverse")) + axis_obj.zdir = "normal"; + elseif (strcmp (axis_obj.zdir, "normal")) + axis_obj.zdir = "reverse"; + endif + axis_obj.ztick = -flip (axis_obj.ztick); + axis_obj.zticklabel = flip (axis_obj.zticklabel); + axis_obj.zlim = -flip (axis_obj.zlim); + else + axis_obj.zsgn = 1; + endif + + xlim = axis_obj.xlim; + ylim = axis_obj.ylim; + zlim = axis_obj.zlim; + clim = axis_obj.clim; + do_tics (axis_obj, plot_stream, ymirror, mono, gnuplot_term); fputs (plot_stream, "unset logscale;\n"); - xlogscale = strcmpi (axis_obj.xscale, "log"); - ylogscale = strcmpi (axis_obj.yscale, "log"); - zlogscale = strcmpi (axis_obj.zscale, "log"); if (xlogscale) fprintf (plot_stream, "set logscale %s;\n", xaxisloc); endif @@ -377,11 +430,6 @@ hidden_removal = NaN; view_map = false; - xlim = axis_obj.xlim; - ylim = axis_obj.ylim; - zlim = axis_obj.zlim; - clim = axis_obj.clim; - if (! cautoscale && clim(1) == clim(2)) clim(2)++; endif @@ -393,6 +441,7 @@ while (! isempty (kids)) obj = get (kids(end)); + if (isfield (obj, "units")) units = obj.units; unwind_protect @@ -409,12 +458,15 @@ endif if (xlogscale && isfield (obj, "xdata")) + obj.xdata = axis_obj.xsgn * obj.xdata; obj.xdata(obj.xdata<=0) = NaN; endif if (ylogscale && isfield (obj, "ydata")) + obj.ydata = axis_obj.ysgn * obj.ydata; obj.ydata(obj.ydata<=0) = NaN; endif if (zlogscale && isfield (obj, "zdata")) + obj.zdata = axis_obj.zsgn * obj.zdata; obj.zdata(obj.zdata<=0) = NaN; endif @@ -643,13 +695,18 @@ ccol = cdat; endif if (strncmp (obj.facecolor, "flat", 4)) - if (numel(ccol) == 3) + if (isequal (size (ccol), [1, 3])) + ## RGB Triplet color = ccol; elseif (nd == 3 && numel (xcol) == 3) - ccdat = ccol * ones (3,1); + ccdat = ccol; else - r = 1 + round ((size (cmap, 1) - 1) - * (ccol - clim(1))/(clim(2) - clim(1))); + if (cdatadirect) + r = round (ccol); + else + r = 1 + round ((size (cmap, 1) - 1) + * (ccol - clim(1))/(clim(2) - clim(1))); + endif r = max (1, min (r, size (cmap, 1))); color = cmap(r, :); endif @@ -665,10 +722,17 @@ ccdat = ccdat(:); endif else - warning ("\"interp\" not supported, using 1st entry of cdata"); - r = 1 + round ((size (cmap, 1) - 1) * ccol(1)); + if (sum (diff (ccol))) + warning ("\"interp\" not supported, using 1st entry of cdata"); + endif + if (cdatadirect) + r = round (ccol); + else + r = 1 + round ((size (cmap, 1) - 1) + * (ccol - clim(1))/(clim(2) - clim(1))); + endif r = max (1, min (r, size (cmap, 1))); - color = cmap(r,:); + color = cmap(r(1),:); endif endif elseif (isnumeric (obj.facecolor)) @@ -1250,6 +1314,11 @@ colorspec = get_text_colorspec (color, mono); endif + if (ischar (obj.string)) + num_lines = size (obj.string, 1); + else + num_lines = numel (obj.string); + endif switch valign ## Text offset in characters. This relies on gnuplot for font metrics. case "top" @@ -1257,27 +1326,28 @@ case "cap" dy = -0.5; case "middle" - dy = 0; + dy = 0.5 * (num_lines - 1); case "baseline" - dy = 0.5; + dy = 0.5 + (num_lines - 1); case "bottom" - dy = 0.5; + dy = 0.5 + (num_lines - 1); endswitch ## Gnuplot's Character units are different for x/y and vary with fontsize. The aspect ratio ## of 1:1.7 was determined by experiment to work for eps/ps/etc. For the MacOS aqua terminal ## a value of 2.5 is needed. However, the difference is barely noticable. dx_and_dy = [(-dy * sind (angle)), (dy * cosd(angle))] .* [1.7 1]; + ## FIXME - Multiline text produced the gnuplot "warning: ft_render: skipping glyph" if (nd == 3) ## This produces the desired vertical alignment in 3D. fprintf (plot_stream, - "set label \"%s\" at %s %.15g,%.15g,%.15g %s rotate by %f offset character %f,%f %s %s front %s;\n", + "set label \"%s\" at %s %.15e,%.15e,%.15e %s rotate by %f offset character %f,%f %s %s front %s;\n", undo_string_escapes (label), units, lpos(1), lpos(2), lpos(3), halign, angle, dx_and_dy, fontspec, __do_enhanced_option__ (enhanced, obj), colorspec); else fprintf (plot_stream, - "set label \"%s\" at %s %.15g,%.15g %s rotate by %f offset character %f,%f %s %s front %s;\n", + "set label \"%s\" at %s %.15e,%.15e %s rotate by %f offset character %f,%f %s %s front %s;\n", undo_string_escapes (label), units, lpos(1), lpos(2), halign, angle, dx_and_dy, fontspec, __do_enhanced_option__ (enhanced, obj), colorspec); @@ -1312,7 +1382,7 @@ fputs (plot_stream, "unset hidden3d;\n"); endif - have_data = (! (isempty (data) || all (cellfun (@isempty, data)))); + have_data = (! (isempty (data) || all (cellfun ("isempty", data)))); ## Note we don't use the [xy]2range of gnuplot as we don't use the ## dual axis plotting features of gnuplot. @@ -1392,23 +1462,57 @@ fprintf (plot_stream, "unset xtics; set x2tics %s nomirror\n", axis_obj.tickdir); fputs (plot_stream, "set border 12;\n"); - else + elseif (strcmpi (axis_obj.xaxislocation, "bottom")) fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", axis_obj.tickdir); fputs (plot_stream, "set border 9;\n"); + else # xaxislocation == zero + fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 8;\n"); + fprintf (plot_stream, "set xzeroaxis lt -1 lw %f;\n", + axis_obj.linewidth); endif - else + elseif (strcmpi (axis_obj.yaxislocation, "left")) fprintf (plot_stream, "unset y2tics; set ytics %s nomirror\n", axis_obj.tickdir); if (strcmpi (axis_obj.xaxislocation, "top")) fprintf (plot_stream, "unset xtics; set x2tics %s nomirror\n", axis_obj.tickdir); fputs (plot_stream, "set border 6;\n"); - else + elseif (strcmpi (axis_obj.xaxislocation, "bottom")) fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", axis_obj.tickdir); fputs (plot_stream, "set border 3;\n"); + else # xaxislocation == zero + fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 2;\n"); + fprintf (plot_stream, "set xzeroaxis lt -1 lw %f;\n", + axis_obj.linewidth); endif + else # yaxislocation == zero + fprintf (plot_stream, "unset y2tics; set ytics %s nomirror\n", + axis_obj.tickdir); + if (strcmpi (axis_obj.xaxislocation, "top")) + fprintf (plot_stream, "unset xtics; set x2tics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 4;\n"); + elseif (strcmpi (axis_obj.xaxislocation, "bottom")) + fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 1;\n"); + else # xaxislocation == zero + fprintf (plot_stream, "unset y2tics; set ytics %s nomirror\n", + axis_obj.tickdir); + fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "unset border;\n"); + fprintf (plot_stream, "set xzeroaxis lt -1 lw %f;\n", + axis_obj.linewidth); + endif + fprintf (plot_stream, "set yzeroaxis lt -1 lw %f;\n", + axis_obj.linewidth); endif endif endif @@ -1521,6 +1625,13 @@ fprintf (plot_stream, "%s \"-\" %s %s %s \\\n", plot_cmd, usingclause{1}, titlespec{1}, withclause{1}); elseif (is_image_data (1)) + if (numel (is_image_data) > 1 && is_image_data(2)) + ## Remove terminating semicolon + n = max (strfind (withclause{1}, ";")); + if (! isempty(n)) + withclause{1} = withclause{1}(1:n-1); + endif + endif fprintf (plot_stream, "%s \"-\" %s %s %s \\\n", plot_cmd, usingclause{1}, titlespec{1}, withclause{1}); else @@ -1542,9 +1653,20 @@ fputs (plot_stream, "unset obj 2; \\\n"); fg_is_set = false; endif + if (numel (is_image_data) > i && is_image_data(i+1)) + ## Remove terminating semicolon + n = max (strfind (withclause{i}, ";")); + if (! isempty(n)) + withclause{i} = withclause{i}(1:n-1); + endif + endif + fprintf (plot_stream, "%s \"-\" %s %s %s \\\n", plot_cmd, + usingclause{i}, titlespec{i}, withclause{i}); + else + ## For consecutive images continue with the same plot command + fprintf (plot_stream, "%s \"-\" %s %s %s \\\n", ",", + usingclause{i}, titlespec{i}, withclause{i}); endif - fprintf (plot_stream, "%s \"-\" %s %s %s \\\n", plot_cmd, - usingclause{i}, titlespec{i}, withclause{i}); elseif (is_image_data (i-1)) if (bg_is_set) fputs (plot_stream, "unset obj 1; \\\n"); @@ -1606,6 +1728,16 @@ endfunction +function x = flip (x) + if (size (x, 1) == 1) + x = fliplr (x); + elseif (size (x, 2) == 1 || ischar (x)) + x = flipud (x); + else + x = flipud (fliplr (x)); + endif +endfunction + function fontspec = create_fontspec (f, s, gp_term) if (strcmp (f, "*") || strcmp (gp_term, "tikz")) fontspec = sprintf ("font \",%d\"", s); @@ -1901,61 +2033,67 @@ do_tics_1 (obj.xtickmode, obj.xtick, obj.xminortick, obj.xticklabelmode, obj.xticklabel, obj.xcolor, "x2", plot_stream, true, mono, "border", obj.tickdir, ticklength, fontname, fontspec, - obj.interpreter, obj.xscale); + obj.interpreter, obj.xscale, obj.xsgn, gnuplot_term); do_tics_1 ("manual", [], "off", obj.xticklabelmode, obj.xticklabel, obj.xcolor, "x", plot_stream, true, mono, "border", - "", "", fontname, fontspec, obj.interpreter, obj.xscale); + "", "", fontname, fontspec, obj.interpreter, obj.xscale, + obj.xsgn, gnuplot_term); elseif (strcmpi (obj.xaxislocation, "zero")) do_tics_1 (obj.xtickmode, obj.xtick, obj.xminortick, obj.xticklabelmode, obj.xticklabel, obj.xcolor, "x", plot_stream, true, mono, "axis", obj.tickdir, ticklength, fontname, fontspec, - obj.interpreter, obj.xscale); + obj.interpreter, obj.xscale, obj.xsgn, gnuplot_term); do_tics_1 ("manual", [], "off", obj.xticklabelmode, obj.xticklabel, obj.xcolor, "x2", plot_stream, true, mono, "axis", - "", "", fontname, fontspec, obj.interpreter, obj.xscale); + "", "", fontname, fontspec, obj.interpreter, obj.xscale, + obj.xsgn, gnuplot_term); else do_tics_1 (obj.xtickmode, obj.xtick, obj.xminortick, obj.xticklabelmode, obj.xticklabel, obj.xcolor, "x", plot_stream, true, mono, "border", obj.tickdir, ticklength, fontname, fontspec, - obj.interpreter, obj.xscale); + obj.interpreter, obj.xscale, obj.xsgn, gnuplot_term); do_tics_1 ("manual", [], "off", obj.xticklabelmode, obj.xticklabel, obj.xcolor, "x2", plot_stream, true, mono, "border", - "", "", fontname, fontspec, obj.interpreter, obj.xscale); + "", "", fontname, fontspec, obj.interpreter, obj.xscale, + obj.xsgn, gnuplot_term); endif if (strcmpi (obj.yaxislocation, "right")) do_tics_1 (obj.ytickmode, obj.ytick, obj.yminortick, obj.yticklabelmode, obj.yticklabel, obj.ycolor, "y2", plot_stream, ymirror, mono, "border", obj.tickdir, ticklength, fontname, fontspec, - obj.interpreter, obj.yscale); + obj.interpreter, obj.yscale, obj.ysgn, gnuplot_term); do_tics_1 ("manual", [], "off", obj.yticklabelmode, obj.yticklabel, obj.ycolor, "y", plot_stream, ymirror, mono, "border", - "", "", fontname, fontspec, obj.interpreter, obj.yscale); + "", "", fontname, fontspec, obj.interpreter, obj.yscale, + obj.ysgn, gnuplot_term); elseif (strcmpi (obj.yaxislocation, "zero")) do_tics_1 (obj.ytickmode, obj.ytick, obj.yminortick, obj.yticklabelmode, obj.yticklabel, obj.ycolor, "y", plot_stream, ymirror, mono, "axis", obj.tickdir, ticklength, fontname, fontspec, - obj.interpreter, obj.yscale); + obj.interpreter, obj.yscale, obj.ysgn, gnuplot_term); do_tics_1 ("manual", [], "off", obj.yticklabelmode, obj.yticklabel, obj.ycolor, "y2", plot_stream, ymirror, mono, "axis", - "", "", fontname, fontspec, obj.interpreter, obj.yscale); + "", "", fontname, fontspec, obj.interpreter, obj.yscale, + obj.ysgn, gnuplot_term); else do_tics_1 (obj.ytickmode, obj.ytick, obj.yminortick, obj.yticklabelmode, obj.yticklabel, obj.ycolor, "y", plot_stream, ymirror, mono, "border", obj.tickdir, ticklength, fontname, fontspec, - obj.interpreter, obj.yscale); + obj.interpreter, obj.yscale, obj.ysgn, gnuplot_term); do_tics_1 ("manual", [], "off", obj.yticklabelmode, obj.yticklabel, obj.ycolor, "y2", plot_stream, ymirror, mono, "border", - "", "", fontname, fontspec, obj.interpreter, obj.yscale); + "", "", fontname, fontspec, obj.interpreter, obj.yscale, + obj.ysgn, gnuplot_term); endif do_tics_1 (obj.ztickmode, obj.ztick, obj.zminortick, obj.zticklabelmode, obj.zticklabel, obj.zcolor, "z", plot_stream, true, mono, "border", obj.tickdir, ticklength, fontname, fontspec, - obj.interpreter, obj.zscale); + obj.interpreter, obj.zscale, obj.zsgn, gnuplot_term); endfunction function do_tics_1 (ticmode, tics, mtics, labelmode, labels, color, ax, plot_stream, mirror, mono, axispos, tickdir, ticklength, - fontname, fontspec, interpreter, scale) + fontname, fontspec, interpreter, scale, sgn, gnuplot_term) persistent warned_latex = false; if (strcmpi (interpreter, "tex")) for n = 1 : numel(labels) @@ -1968,8 +2106,15 @@ endif endif if (strcmp (scale, "log")) - fmt = "10^{%T}"; num_mtics = 10; + if (any (strcmp (gnuplot_term, {"tikz", "pstex", "pslatex", "epslatex"}))) + fmt = "$10^{%T}$"; + else + fmt = "10^{%T}"; + endif + if (sgn < 0) + fmt = strcat ("-", fmt); + endif else fmt = "%g"; num_mtics = 5; @@ -2129,19 +2274,68 @@ bld = false; endif + ## The text object maybe multiline, and may be of any class str = getfield (obj, fld); + if (ischar (str) && size (str, 1) > 1) + str = cellstr (str); + elseif (isnumeric (str)) + str = cellstr (num2str (str(:))); + endif + if (iscellstr (str)) + for n = 1:numel(str) + if (isnumeric (str{n})) + str{n} = num2str (str{n}); + endif + endfor + str = sprintf ("%s\n", str{:})(1:end-1); + endif + if (enhanced) if (strcmpi (obj.interpreter, "tex")) - str = __tex2enhanced__ (str, fnt, it, bld); + if (iscellstr (str)) + for n = 1:numel(str) + str{n} = __tex2enhanced__ (str{n}, fnt, it, bld); + endfor + else + str = __tex2enhanced__ (str, fnt, it, bld); + endif elseif (strcmpi (obj.interpreter, "latex")) if (! warned_latex) warning ("latex markup not supported for text objects"); warned_latex = true; endif + elseif (enhanced) + str = no_super_sub_scripts (str); endif endif endfunction +function str = no_super_sub_scripts (str) + if (iscellstr (str)) + labels = str; + else + labels = cellstr (str); + endif + for marker = "_^" + for m = 1 : numel(labels) + n1 = strfind (labels{m}, sprintf ("\\%s", marker)); + n2 = strfind (labels{m}, marker); + if (! isempty (n1)) + n1 = n1 + 1; + n2 = setdiff (n2, n1); + end + for n = numel(n2):-1:1 + labels{m} = [labels{m}(1:n2(n)-1), "\\", labels{m}(n2(n):end)] + endfor + endfor + endfor + if (iscellstr (str)) + str = labels; + else + str = char (labels); + endif +endfunction + function str = __tex2enhanced__ (str, fnt, it, bld) persistent sym = __setup_sym_table__ (); persistent flds = fieldnames (sym); @@ -2328,7 +2522,7 @@ l = length (s) - length (strfind(s,'{')) - length (strfind(s,'}')); m = regexp (s, '/([\w-]+|[\w-]+=\d+)', 'matches'); if (!isempty (m)) - l = l - sum (cellfun (@length, m)); + l = l - sum (cellfun ("length", m)); endif endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/private/__is_function__.m @@ -0,0 +1,31 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{result} =} __is_function__ (@var{func}) +## Undocumented internal function. +## @end deftypefn + +## Author: Michael Goffioul + +function result = __is_function__ (func) + + existval = exist (func); + result = (existval == 2 || existval == 3 || existval == 5 || existval == 6); + +endfunction
--- a/scripts/plot/private/__line__.m +++ b/scripts/plot/private/__line__.m @@ -45,16 +45,12 @@ num_data_args = 0; endif - if (rem (nvargs - num_data_args, 2) != 0) - print_usage ("line"); + if (num_data_args > 0 && ! size_equal (varargin{1:num_data_args})) + error ("line: number of X, Y, and Z points must be equal"); endif - data_args = {}; - if (num_data_args > 1) - data_args(1:4) = { "xdata", varargin{1}, "ydata", varargin{2} }; - if (num_data_args == 3) - data_args(5:6) = { "zdata", varargin{3} }; - endif + if (rem (nvargs - num_data_args, 2) != 0) + error ("line: invalid number of PROPERTY / VALUE pairs"); endif other_args = {}; @@ -62,6 +58,64 @@ other_args = varargin(num_data_args+1:end); endif - h = __go_line__ (p, data_args{:}, other_args{:}); + nlines = 0; + nvecpts = 0; + ismat = false (1, 3); + for i = 1:num_data_args + tmp = varargin{i}(:,:); + if (isvector (tmp)) + nlines = max (1, nlines); + if (! isscalar (tmp)) + if (nvecpts == 0) + nvecpts = numel (tmp); + elseif (nvecpts != numel (tmp)) + error ("line: data size mismatch"); + endif + endif + else + ismat(i) = true; + nlines = max (columns (tmp), nlines); + endif + varargin{i} = tmp; + endfor + + if (num_data_args == 0) + varargin = {[0, 1], [0, 1]}; + num_data_args = 2; + nlines = 1; + endif + + handles = zeros (nlines, 1); + + data = cell (1, 3); + + if (num_data_args > 1) + data(1) = varargin{1}; + data(2) = varargin{2}; + if (num_data_args == 3) + data(3) = varargin{3}; + endif + endif + + data_args = reshape ({"xdata", "ydata", "zdata"; data{:}}, [1, 6]); + mask = reshape ([false(1,3); ismat], [1, 6]); + + for i = 1:nlines + tmp = data(ismat); + if (! size_equal (tmp) + || (nvecpts != 0 && any (nvecpts != cellfun ("size", tmp, 1)))) + error ("line: data size_mismatch"); + endif + + data_args(mask) = cellfun (@(x) x(:,i), data(ismat), + "uniformoutput", false); + + handles(i) = __go_line__ (p, data_args{:}, other_args{:}); + + endfor + + if (nargout > 0) + h = handles; + endif endfunction
rename from scripts/plot/__next_line_style__.m rename to scripts/plot/private/__next_line_style__.m --- a/scripts/plot/__next_line_style__.m +++ b/scripts/plot/private/__next_line_style__.m @@ -39,7 +39,10 @@ style_index = 1; endif elseif (reset || isempty (style_rotation)) - style_rotation = strsplit (get (gca (), "linestyleorder"), "|"); + style_rotation = get (gca (), "linestyleorder"); + if (ischar (style_rotation)) + style_rotation = strsplit (style_rotation, "|"); + endif num_styles = length (style_rotation); style_index = 1; endif
--- a/scripts/plot/private/__patch__.m +++ b/scripts/plot/private/__patch__.m @@ -29,9 +29,15 @@ function [h, failed] = __patch__ (p, varargin) + h = NaN; failed = false; - if (isstruct (varargin{1})) + is_numeric_arg = cellfun (@isnumeric, varargin); + + if (isempty (varargin)) + args = {"xdata", [0; 1; 0], "ydata", [1; 1; 0], "facecolor", [0, 0, 0]}; + args = setvertexdata (args); + elseif (isstruct (varargin{1})) if (isfield (varargin{1}, "vertices") && isfield (varargin{1}, "faces")) args{1} = "faces"; args{2} = getfield(varargin{1}, "faces"); @@ -48,26 +54,53 @@ else failed = true; endif - elseif (isnumeric (varargin{1})) - if (nargin < 3 || ! isnumeric (varargin{2})) + elseif (is_numeric_arg(1)) + if (nargin < 3 || ! is_numeric_arg(2)) failed = true; else - x = varargin{1}; - y = varargin{2}; - iarg = 3; - if (nargin > 3 && ndims (varargin{3}) == 2 && ndims (x) == 2 - && size_equal(x, varargin{3}) && !ischar(varargin{3})) + if (nargin > 4 && all (is_numeric_arg(1:4))) + x = varargin{1}; + y = varargin{2}; z = varargin{3}; - iarg++; - else + c = varargin{4}; + iarg = 5; + elseif (nargin > 3 && all (is_numeric_arg(1:3))) + x = varargin{1}; + y = varargin{2}; + iarg = 4; + if (rem (nargin - iarg, 2) == 1) + c = varargin {iarg}; + z = varargin{3}; + iarg = 5; + else + z = []; + c = varargin{3}; + endif + elseif (nargin > 2 && all (is_numeric_arg(1:2))) + x = varargin{1}; + y = varargin{2}; z = []; + iarg = 3; + if (rem (nargin - iarg, 2) == 1) + c = varargin {iarg}; + iarg++; + else + c = []; + endif endif if (isvector (x)) x = x(:); y = y(:); z = z(:); + if (isnumeric (c)) + if (isvector (c) && numel (c) == numel (x)) + c = c(:); + elseif (size (c, 1) != numel (x) && size (c, 2) == numel (x)) + c = c.'; + endif + endif endif args{1} = "xdata"; args{2} = x; @@ -76,9 +109,7 @@ args{5} = "zdata"; args{6} = z; - if (isnumeric (varargin{iarg})) - c = varargin{iarg}; - iarg++; + if (isnumeric (c)) if (ndims (c) == 3 && size (c, 2) == 1) c = permute (c, [1, 3, 2]); @@ -98,30 +129,52 @@ else error ("patch: color value not valid"); endif - elseif (size (c, ndims (c)) == 3) + elseif (isvector (c) && numel (c) == 3) args{7} = "facecolor"; - args{8} = "flat"; + args{8} = c; args{9} = "cdata"; - args{10} = c; + args{10} = []; + elseif (ndims (c) == 3 && size (c, 3) == 3) + ## CDATA is specified as RGB data + if ((size (c, 1) == 1 && size (c, 2) == 1) ... + || (size (c, 1) == 1 && size (c, 2) == columns (x))) + ## Single patch color or per-face color + args{7} = "facecolor"; + args{8} = "flat"; + args{9} = "cdata"; + args{10} = c; + elseif (size (c, 1) == rows (x) && size (c, 2) == columns (x)) + ## Per-vertex color + args{7} = "facecolor"; + args{8} = "interp"; + args{9} = "cdata"; + agrs{10} = c; + else + error ("patch: color value not valid"); + endif else ## Color Vectors - if (rows (c) != rows (x) || rows (c) != length (y)) - error ("patch: size of x, y, and c must be equal"); - else + if (isempty (c)) args{7} = "facecolor"; args{8} = "interp"; args{9} = "cdata"; args{10} = []; + elseif (isequal (size (c), size (x)) && isequal (size (c), size (y))) + args{7} = "facecolor"; + args{8} = "interp"; + args{9} = "cdata"; + args{10} = c; + else + error ("patch: size of x, y, and c must be equal"); endif endif - elseif (ischar (varargin{iarg}) && rem (nargin - iarg, 2) != 0) + elseif (ischar (c) && rem (nargin - iarg, 2) == 0) ## Assume that any additional argument over an even number is ## color string. args{7} = "facecolor"; - args{8} = tolower (varargin{iarg}); + args{8} = tolower (c); args{9} = "cdata"; args{10} = []; - iarg++; else args{7} = "facecolor"; args{8} = [0, 1, 0]; @@ -134,7 +187,7 @@ endif else args = varargin; - if (any(cellfun (@(x) strcmpi(x,"faces") || strcmpi(x, "vertices"), args))) + if (any (strcmpi (args, "faces") | strcmpi (args, "vertices"))) args = setdata (args); else args = setvertexdata (args); @@ -197,20 +250,15 @@ fc = [0, 1, 0]; endif args = {"facecolor", fc, args{:}}; - else - fc = args {idx}; endif - nr = size (faces, 2); nc = size (faces, 1); idx = faces .'; t1 = isnan (idx); - if (any (t1(:))) - t2 = find (t1 != t1([2:end,end],:)); - idx (t1) = idx (t2 (cell2mat (cellfun (@(x) x(1)*ones(1,x(2)), - mat2cell ([1 : nc; sum(t1)], 2, ones(1,nc)), - "uniformoutput", false)))); - endif + for i = find (any (t1)) + first_idx_in_column = find (t1(:,i), 1); + idx(first_idx_in_column:end,i) = idx(first_idx_in_column-1,i); + endfor x = reshape (vert(:,1)(idx), size (idx)); y = reshape (vert(:,2)(idx), size (idx)); if (size(vert,2) > 2) @@ -226,8 +274,10 @@ c = cat(3, reshape (fvc(idx, 1), size(idx)), reshape (fvc(idx, 2), size(idx)), reshape (fvc(idx, 3), size(idx))); - else + elseif (isempty (fvc)) c = []; + else ## if (size (fvc, 2) == 1) + c = permute (fvc(faces), [2, 1]); endif endif args = {"xdata", x, "ydata", y, "zdata", z, "cdata", c, args{:}}; @@ -270,23 +320,25 @@ fc = [0, 1, 0]; endif args = {"facecolor", fc, args{:}}; - else - fc = args {idx}; endif [nr, nc] = size (x); + if (nr == 1 && nc > 1) + nr = nc; + nc = 1; + end if (!isempty (z)) vert = [x(:), y(:), z(:)]; else vert = [x(:), y(:)]; endif - faces = reshape (1:numel(x), rows (x), columns (x)); + faces = reshape (1:numel(x), nr, nc); faces = faces'; if (ndims (c) == 3) fvc = reshape (c, size (c, 1) * size (c, 2), size(c, 3)); else - fvc = c(:).'; + fvc = c(:); endif args = {"faces", faces, "vertices", vert, "facevertexcdata", fvc, args{:}};
rename from scripts/plot/__print_parse_opts__.m rename to scripts/plot/private/__print_parse_opts__.m --- a/scripts/plot/__print_parse_opts__.m +++ b/scripts/plot/private/__print_parse_opts__.m @@ -361,7 +361,8 @@ endfunction -%!test +## Test blocks are not allowed (and not needed) for private functions +#%!test %! opts = __print_parse_opts__ (); %! assert (opts.devopt, "pswrite"); %! assert (opts.use_color, 1); @@ -369,11 +370,11 @@ %! assert (opts.canvas_size, [576, 432]); %! assert (opts.ghostscript.device, "pswrite") -%!test +#%!test %! opts = __print_parse_opts__ ("test.pdf", "-S640,480"); %! assert (opts.canvas_size, [307.2, 230.4], 0.1); -%!test +#%!test %! opts = __print_parse_opts__ ("-dpsc", "-append", "-loose"); %! assert (opts.devopt, "pswrite"); %! assert (opts.send_to_printer, true); @@ -382,14 +383,14 @@ %! assert (opts.ghostscript.device, "pswrite") %! assert (opts.ghostscript.epscrop, false); -%!test +#%!test %! opts = __print_parse_opts__ ("-deps", "-tight"); %! assert (opts.tight_flag, true); %! assert (opts.send_to_printer, true); %! assert (opts.use_color, -1); %! assert (opts.ghostscript.device, "") -%!test +#%!test %! opts = __print_parse_opts__ ("-djpg", "foobar", "-mono", "-loose"); %! assert (opts.devopt, "jpeg") %! assert (opts.name, "foobar.jpg") @@ -401,7 +402,7 @@ %! assert (opts.printer, ""); %! assert (opts.use_color, -1); -%!test +#%!test %! opts = __print_parse_opts__ ("-ddeskjet", "foobar", "-mono", "-Pmyprinter"); %! assert (opts.ghostscript.output, "foobar.deskjet") %! assert (opts.ghostscript.device, "deskjet") @@ -410,7 +411,7 @@ %! assert (opts.printer, "-Pmyprinter"); %! assert (opts.use_color, -1); -%!test +#%!test %! opts = __print_parse_opts__ ("-f5", "-dljet3"); %! assert (opts.ghostscript.device, "ljet3") %! assert (strfind (opts.ghostscript.output, ".ljet3")) @@ -448,7 +449,7 @@ gs_binaries = horzcat (gs_binaries, {"gs", "gs.exe"}); else ## pc - Includes Win32 and mingw. - gs_binaries = horzcat (gs_binaries, {"gs.exe", "gswin32c.exe"}); + gs_binaries = horzcat (gs_binaries, {"gs.exe", "gswin32c.exe", "mgs.exe"}); endif n = 0; while (n < numel (gs_binaries) && isempty (ghostscript_binary)) @@ -569,7 +570,7 @@ case "inches" value = value * 72; case "centimeters" - value = value * 72 / 25.4; + value = value * 72 / 2.54; case "normalized" error ("print:customnormalized", "print.m: papersize=='<custom>' and paperunits='normalized' may not be combined");
--- a/scripts/plot/private/__quiver__.m +++ b/scripts/plot/private/__quiver__.m @@ -107,18 +107,27 @@ if (autoscale && numel (u) > 1) ## Scale the arrows to fit in the grid - dx = (max(x(:)) - min(x(:))) ./ size (x, 2); - dy = (max(y(:)) - min(y(:))) ./ size (y, 1); + if (isvector (x)) + ny = nx = length (x); + else + [nx, ny] = size (x); + endif + dx = (max(x(:)) - min(x(:))) ./ nx; + dy = (max(y(:)) - min(y(:))) ./ ny; if (is3d) - ## What should this be divided by? The below seems right dz = (max(z(:)) - min(z(:))) ./ max (size (z)); - len = max (sqrt (u(:).^2 + dy(:).^2) + dz(:).^2); + len = max (sqrt (u(:).^2 + v(:).^2 + w(:).^2)); else - len = max (sqrt (u(:).^2 + dy(:).^2)); dz = 0; + len = max (sqrt (u(:).^2 + v(:).^2)); endif if (len > 0) - s = 2 * autoscale / sqrt (2) * sqrt (dx.^2 + dy.^2 + dz.^2) / len; + sd = sqrt (dx.^2 + dy.^2 + dz.^2) / len; + if (sd != 0) + s = sqrt(2) * autoscale * sd; + else # special case of identical points with multiple vectors + s = autoscale; + endif uu = s * u; vv = s * v; if (is3d) @@ -335,18 +344,25 @@ if (strcmpi (get (h, "autoscale"), "on") && s != 0) ## Scale the arrows to fit in the grid - dx = (max(x(:)) - min(x(:))) ./ size (x, 2); - dy = (max(y(:)) - min(y(:))) ./ size (y, 1); + if (isvector (x)) + ny = nx = length (x); + else + [nx, ny] = size (x); + endif + dx = (max(x(:)) - min(x(:))) ./ nx; + dy = (max(y(:)) - min(y(:))) ./ ny; if (is3d) - ## What should this be divided by? The below seems right dz = (max(z(:)) - min(z(:))) ./ max (size (z)); - len = max (sqrt (u(:).^2 + dy(:).^2) + dz(:).^2); + len = max (sqrt (u(:).^2 + v(:).^2 + w(:).^2)); else - len = max (sqrt (u(:).^2 + dy(:).^2)); dz = 0; + len = max (sqrt (u(:).^2 + v(:).^2)); endif if (len > 0) - s = 2 * s / sqrt (2) * sqrt (dx.^2 + dy.^2 + dz.^2) / len; + sd = sqrt (dx.^2 + dy.^2 + dz.^2) / len; + if (sd != 0) + s *= sqrt(2) * sd; + endif u = s * u; v = s * v; if (is3d)
--- a/scripts/plot/private/__scatter__.m +++ b/scripts/plot/private/__scatter__.m @@ -133,6 +133,8 @@ addlistener (hg, "cdata", @update_data); addlistener (hg, "sizedata", @update_data); + one_explicit_color = ischar (c) || isequal (size (c), [1, 3]); + if (numel (x) <= 100) ## For small number of points, we'll construct an object for each point. @@ -141,7 +143,7 @@ s = repmat (s, numel(x), 1); endif - if (ischar (c) || rows(c) == 1) + if (one_explicit_color) for i = 1 : numel (x) if (filled) h = __go_patch__ (hg, "xdata", x(i), "ydata", y(i), "zdata", z(i,:), @@ -160,6 +162,9 @@ endif endfor else + if (rows (c) == 1) + c = ones (rows (x), 1) * c; + endif for i = 1 : numel (x) if (filled) h = __go_patch__ (hg, "xdata", x(i), "ydata", y(i), "zdata", z(i,:), @@ -189,24 +194,28 @@ ## For larger numbers of points, we split the points by common color. vert = [x, y, z]; - - if (ischar (c) || rows (c) == 1) - h = render_size_color (hg, vert, s, c, marker, filled, false); - elseif (columns (c) == 1) + if (one_explicit_color) h = render_size_color (hg, vert, s, c, marker, filled, true); else - [cc, idx] = unique_idx (c, "rows"); - if (isscalar (s)) - for i = 1:rows (x) - h = render_size_color (hg, vert(idx{i},:), s, cc(i,:), + if (rows (c) == 1) + c = ones (rows (x), 1) * c; + endif + ## We want to group points by colour. So first get all the unique colours + [cc, ~, c_to_cc] = unique (c, "rows"); + + for i = 1:rows (cc) + ## Now for each possible unique colour, get the logical index of + ## points that correspond to that colour + idx = (i == c_to_cc); + if (isscalar (s)) + h = render_size_color (hg, vert(idx, :), s, c(idx,:), marker, filled, true); - endfor - else - for i = 1:rows (x) - h = render_size_color (hg, vert(idx{i},:), s(idx{i}), cc(i,:), + else + h = render_size_color (hg, vert(idx, :), s(idx), c(idx,:), marker, filled, true); - endfor - endif + endif + endfor + endif endif @@ -226,14 +235,14 @@ addproperty ("marker", hg, "patchmarker", marker); if (filled) addproperty ("markeredgecolor", hg, "patchmarkeredgecolor", "none"); - if (ischar (c) || rows (c) == 1) + if (one_explicit_color) addproperty ("markerfacecolor", hg, "patchmarkerfacecolor", c); else addproperty ("markerfacecolor", hg, "patchmarkerfacecolor", "flat"); endif else addproperty ("markerfacecolor", hg, "patchmarkerfacecolor", "none"); - if (ischar (c) || rows (c) == 1) + if (one_explicit_color) addproperty ("markeredgecolor", hg, "patchmarkeredgecolor", c); else addproperty ("markeredgecolor", hg, "patchmarkeredgecolor", "flat"); @@ -250,48 +259,31 @@ endfunction -function [y, idx] = unique_idx (x, byrows) - if (nargin == 2) - [xx, idx] = sortrows (x); - n = rows (x); - jdx = find (any (xx(1:n-1,:) != xx(2:n,:), 2)); - jdx(end+1) = n; - y = xx(jdx,:); - else - [xx, idx] = sort (x); - n = length (x); - jdx = find (xx(1:n-1,:) != xx(2:n,:)); - jdx(end+1) = n; - y = xx(jdx); - endif - - if (nargin == 2 || columns (x) == 1) - idx = mat2cell (idx, diff ([0; jdx]), 1); - else - idx = mat2cell (idx, 1, diff ([0, jdx])); - endif -endfunction - function h = render_size_color(hg, vert, s, c, marker, filled, isflat) if (isscalar (s)) x = vert(:,1); y = vert(:,2); z = vert(:,3:end); - if (ischar (c) || !isflat) + toolkit = get (ancestor (hg, "figure"), "__graphics_toolkit__"); + ## Does gnuplot only support triangles with different vertex colors ? + ## TODO - Verify gnuplot can only support one color. If RGB triplets + ## can be assigned to each vertex, then fix __go_draw_axe__.m + gnuplot_hack = numel (x) > 1 && strcmp (toolkit, "gnuplot"); + if (ischar (c) || ! isflat || gnuplot_hack) if (filled) h = __go_patch__ (hg, "xdata", x, "ydata", y, "zdata", z, "faces", 1:numel(x), "vertices", vert, "facecolor", "none", "edgecolor", "none", "marker", marker, "markeredgecolor", "none", - "markerfacecolor", c, + "markerfacecolor", c(1,:), "markersize", s, "linestyle", "none"); else h = __go_patch__ (hg, "xdata", x, "ydata", y, "zdata", z, "faces", 1:numel(x), "vertices", vert, "facecolor", "none", "edgecolor", "none", "marker", marker, - "markeredgecolor", c, + "markeredgecolor", c(1,:), "markerfacecolor", "none", "markersize", s, "linestyle", "none"); endif @@ -303,7 +295,7 @@ "marker", marker, "markersize", s, "markeredgecolor", "none", "markerfacecolor", "flat", - "cdata", c, "facevertexcdata", c(:), + "cdata", c, "facevertexcdata", c, "linestyle", "none"); else h = __go_patch__ (hg, "xdata", x, "ydata", y, "zdata", z, @@ -312,15 +304,16 @@ "marker", marker, "markersize", s, "markeredgecolor", "flat", "markerfacecolor", "none", - "cdata", c, "facevertexcdata", c(:), + "cdata", c, "facevertexcdata", c, "linestyle", "none"); endif endif else ## FIXME: round the size to one decimal place. It's not quite right, though. - [ss, idx] = unique_idx (ceil (s*10) / 10); + [ss, ~, s_to_ss] = unique (ceil (s*10) / 10); for i = 1:rows (ss) - h = render_size_color (hg, vert(idx{i},:), ss(i), c, + idx = (i == s_to_ss); + h = render_size_color (hg, vert(idx,:), ss(i), c, marker, filled, isflat); endfor endif @@ -368,14 +361,14 @@ if (isempty (z1)) for i = 1 : length (hlist) set (hlist(i), "vertices", [x1(i), y1(i)], "cdata", - reshape(c1(i,:),[1, size(c1)(2:end)]), + reshape(c1(i,:),[1, size(c1)(2:end)]), "facevertexcdata", c1(i,:), "markersize", size1(i)); endfor else for i = 1 : length (hlist) set (hlist(i), "vertices", [x1(i), y1(i), z1(i)], "cdata", - reshape(c1(i,:),[1, size(c1)(2:end)]), + reshape(c1(i,:),[1, size(c1)(2:end)]), "facevertexcdata", c1(i,:), "markersize", size1(i)); endfor
new file mode 100644 --- /dev/null +++ b/scripts/plot/private/__uigetdir_fltk__.m @@ -0,0 +1,34 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{dirname} =} __uigetdir_fltk__ (@var{start_path}, @var{dialog_title}) +## Undocumented internal function. +## @end deftypefn + +## Author: Michael Goffioul + +function dirname = __uigetdir_fltk__ (start_path, dialog_title) + + if (exist("__fltk_uigetfile__") != 3) + error ("uigetdir: fltk graphics toolkit required"); + endif + + dirname = __fltk_uigetfile__ ("", dialog_title, start_path, [240, 120], "dir"); + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/private/__uigetfile_fltk__.m @@ -0,0 +1,38 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} __uigetfile_fltk__ () +## Undocumented internal function. +## @end deftypefn + +## Author: Michael Goffioul + +function [retval, retpath, retindex] = __uigetfile_fltk__ (filters, title, defval, position, multiselect, defdir) + + if (exist("__fltk_uigetfile__") != 3) + error ("uigetfile: fltk graphics toolkit required"); + endif + + filters = __fltk_file_filter__ (filters); + if (length (defdir) > 0) + defval = fullfile (defdir, defval); + endif + [retval, retpath, retindex] = __fltk_uigetfile__ (filters, title, defval, position, multiselect); + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/private/__uiobject_split_args__.m @@ -0,0 +1,66 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{p}, @var{args}] =} __uiobject_split_args__ (@var{who}, @var{args}, @var{parent_type}, @var{use_gcf}) +## @end deftypefn + +## Author: goffioul + +function [parent, args] = __uiobject_split_args__ (who, in_args, parent_type = {}, use_gcf = 1) + + parent = []; + args = {}; + offset = 1; + + if (! isempty (in_args)) + if (ishandle (in_args{1})) + parent = in_args{1}; + offset = 2; + elseif (! ischar (in_args{1})) + error ("%s: invalid parent handle.", who); + endif + + args = in_args(offset:end); + endif + + if (rem (length (args), 2)) + error ("%s: expecting PROPERTY/VALUE pairs", who); + endif + + if (! isempty (args)) + i = find (strcmpi (args(1:2:end), "parent"), 1, "first"); + if (! isempty (i) && length (args) >= 2*i) + parent = args{2*i}; + if (! ishandle (parent)) + error ("%s: invalid parent handle.", who); + endif + args([2*i-1, 2*i]) = []; + endif + endif + + if (! isempty (parent)) + if (! isempty (parent_type) && isempty (find (strcmpi (get (parent, "type"), parent_type)))) + error ("%s: invalid parent, the parent type must be: %s", ... + who, sprintf ("%s, ", parent_type{:})(1:end-2)); + endif + elseif (use_gcf) + parent = gcf (); + endif + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/private/__uiputfile_fltk__.m @@ -0,0 +1,38 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} __uiputfile_fltk__ () +## Undocumented internal function. +## @end deftypefn + +## Author: Michael Goffioul + +function [retval, retpath, retindex] = __uiputfile_fltk__ (filters, title, defval, position, tag, defdir) + + if (exist("__fltk_uigetfile__") != 3) + error ("uiputfile: fltk graphics toolkit required"); + endif + + filters = __fltk_file_filter__ (filters); + if (length (defdir) > 0) + defval = fullfile (defdir, defval); + endif + [retval, retpath, retindex] = __fltk_uigetfile__ (filters, title, defval, position, tag); + +endfunction
--- a/scripts/plot/quiver.m +++ b/scripts/plot/quiver.m @@ -34,7 +34,7 @@ ## size(@var{u})}. ## ## The variable @var{s} is a scalar defining a scaling factor to use for -## the arrows of the field relative to the mesh spacing. A value of 0 +## the arrows of the field relative to the mesh spacing. A value of 0 ## disables all scaling. The default value is 1. ## ## The style to use for the plot can be defined with a line style @var{style} @@ -43,9 +43,9 @@ ## printed rather than arrows. If the argument 'filled' is given then the ## markers as filled. ## -## The optional return value @var{h} provides a quiver group that -## regroups the components of the quiver plot (body, arrow and marker), -## and allows them to be changed together +## The optional return value @var{h} is a graphics handle to a quiver object. +## A quiver object regroups the components of the quiver plot (body, arrow, +## and marker), and allows them to be changed together. ## ## @example ## @group @@ -81,14 +81,19 @@ endfunction + %!demo %! clf -%! [x,y] = meshgrid(1:2:20); -%! h = quiver(x,y,sin(2*pi*x/10),sin(2*pi*y/10)); +%! [x,y] = meshgrid (1:2:20); +%! h = quiver (x,y, sin (2*pi*x/10), sin (2*pi*y/10)); %! set (h, "maxheadsize", 0.33); %!demo -%! axis("equal"); -%! x=linspace(0,3,80); y=sin(2*pi*x); theta=2*pi*x+pi/2; -%! quiver(x,y,sin(theta)/10,cos(theta)/10); +%! clf +%! axis ("equal"); +%! x = linspace (0,3,80); +%! y = sin (2*pi*x); +%! theta = 2*pi*x + pi/2; +%! quiver (x, y, sin (theta)/10, cos (theta)/10); %! hold on; plot(x,y,"r"); hold off; +
--- a/scripts/plot/quiver3.m +++ b/scripts/plot/quiver3.m @@ -43,9 +43,9 @@ ## printed rather than arrows. If the argument 'filled' is given then the ## markers as filled. ## -## The optional return value @var{h} provides a quiver group that -## regroups the components of the quiver plot (body, arrow and marker), -## and allows them to be changed together +## The optional return value @var{h} is a graphics handle to a quiver object. +## A quiver object regroups the components of the quiver plot (body, arrow, +## and marker), and allows them to be changed together. ## ## @example ## @group @@ -86,13 +86,13 @@ %!demo %! clf -%! colormap (jet (64)) -%! [x,y]=meshgrid (-1:0.1:1); -%! z=sin(2*pi*sqrt(x.^2+y.^2)); -%! theta=2*pi*sqrt(x.^2+y.^2)+pi/2; -%! quiver3(x,y,z,sin(theta),cos(theta),ones(size(z))); +%! colormap (jet (64)); +%! [x,y] = meshgrid (-1:0.1:1); +%! z = sin (2*pi * sqrt (x.^2+y.^2)); +%! theta = 2*pi * sqrt (x.^2+y.^2) + pi/2; +%! quiver3 (x, y, z, sin (theta), cos (theta), ones (size (z))); %! hold on; -%! mesh(x,y,z); +%! mesh (x,y,z); %! hold off; %!demo @@ -106,5 +106,13 @@ %! hold off; %!demo +%! clf +%! [x, y, z] = peaks (25); +%! surf (x, y, z); +%! hold on; +%! [u, v, w] = surfnorm (x, y, z / 10); +%! h = quiver3 (x, y, z, u, v, w); +%! set (h, "maxheadsize", 0.33); +%! hold off; %! shading interp
new file mode 100644 --- /dev/null +++ b/scripts/plot/rectangle.m @@ -0,0 +1,222 @@ +## Copyright (C) 2011 David Bateman +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} rectangle () +## @deftypefnx {Function File} {} rectangle (@dots{}, "Position", @var{pos}) +## @deftypefnx {Function File} {} rectangle (@dots{}, "Curvature", @var{curv}) +## @deftypefnx {Function File} {} rectangle (@dots{}, "EdgeColor", @var{ec}) +## @deftypefnx {Function File} {} rectangle (@dots{}, "FaceColor", @var{fc}) +## @deftypefnx {Function File} {@var{h} =} rectangle (@dots{}) +## +## Draw rectangular patch defined by @var{pos} and @var{curv}. The variable +## @code{@var{pos}(1:2)} defines the lower left-hand corner of the patch +## and @code{@var{pos}(3:4)} defines its width and height. By default, the +## value of @var{pos} is @code{[0, 0, 1, 1]}. +## +## The variable @var{curv} defines the curvature of the sides of the rectangle +## and may be a scalar or two-element vector with values between 0 and 1. +## A value of 0 represents no curvature of the side, whereas a value of 1 +## means that the side is entirely curved into the arc of a circle. +## If @var{curv} is a two-element vector, then the first element is the +## curvature along the x-axis of the patch and the second along y-axis. +## +## If @var{curv} is a scalar, it represents the curvature of the shorter of the +## two sides of the rectangle and the curvature of the other side is defined +## by +## +## @example +## min (pos (1:2)) / max (pos (1:2)) * curv +## @end example +## +## Other properties are passed to the underlying patch command. +## +## The optional return value @var{h} is a graphics handle to the created +## rectangle object. +## @end deftypefn +## @seealso{patch} + +function h = rectangle (varargin) + + [hax, varargin] = __plt_get_axis_arg__ ("rectangle", varargin{:}); + + tmp = __rectangle__ (hax, varargin{:}); + + if (nargout > 0) + h = tmp; + endif +endfunction + +function hg = __rectangle__ (hax, varargin) + + iarg = 1; + pos = [0, 0, 1, 1]; + curv2 = [0, 0]; + ec = [0, 0, 0]; + fc = "none"; + + while (iarg < length (varargin)) + arg = varargin{iarg}; + if (ischar(arg)) + if (strcmpi (arg, "position")) + pos = varargin{iarg+1}; + varargin(iarg:iarg+1) = []; + if (!isvector (pos) || numel (pos) != 4) + error ("rectangle: position must be a 4 element vector"); + endif + elseif (strcmpi (arg, "curvature")) + curv2 = varargin{iarg+1}; + varargin(iarg:iarg+1) = []; + if (!isnumeric (curv2) || (numel (curv2) != 1 && numel (curv2) != 2)) + error ("rectangle: curvature must be a 2 element vector or a scalar"); + endif + if (any (curv2 < 0) || any (curv2 > 1)) + error ("rectangle: curvature values must be between 0 and 1"); + endif + elseif (strcmpi (arg, "edgecolor")) + ec = varargin{iarg+1}; + varargin(iarg:iarg+1) = []; + elseif (strcmpi (arg, "facecolor")) + fc = varargin{iarg+1}; + varargin(iarg:iarg+1) = []; + else + iarg ++; + endif + else + iarg ++; + endif + endwhile + + if (numel (curv2) == 1) + [a, ai] = min (pos (3 : 4)); + [b, bi] = max (pos (3 : 4)); + if (ai < bi) + curv = [curv2, curv2 .* a ./ b]; + else + curv = [curv2 .* a ./ b, curv2]; + endif + else + curv = curv2; + endif + + if (all (curv) < 0.01) + ## Special case : no curvature + x = [pos(1), pos(1) + pos(3), pos(1) + pos(3), pos(1), pos(1)]; + y = [pos(2), pos(2), pos(2) + pos(4), pos(2) + pos(4), pos(2)]; + else + p = pi / 2 * [0 : 15] / 15; + c = curv .* pos(3 : 4) / 2; + cx = c(1) * sin (p) - c(1); + cy = c(2) * cos (p) - c(2); + x = [pos(1) - fliplr(cx), pos(1) + pos(3) + cx, ... + pos(1) + pos(3) + fliplr(cx), pos(1) - cx, pos(1)]; + y = [pos(2) - fliplr(cy), pos(2) - cy, pos(2) + pos(4) + fliplr(cy), ... + pos(2) + pos(4) + cy, pos(2) + c(2)]; + endif + + hg = hggroup (); + + h = patch ("xdata", x(:), "ydata", y(:), "facecolor", fc, "edgecolor", ec, ... + "parent", hg, varargin{:}); + + addproperty ("curvature", hg, "data", curv2); + addproperty ("position", hg, "data", pos); + addproperty ("edgecolor", hg, "patchedgecolor", get (h, "edgecolor")); + addproperty ("linewidth", hg, "patchlinewidth", get (h, "linewidth")); + addproperty ("linestyle", hg, "patchlinestyle", get (h, "linestyle")); + addproperty ("facecolor", hg, "patchfacecolor", get (h, "facecolor")); + + addlistener (hg, "curvature", @update_data); + addlistener (hg, "position", @update_data); + addlistener (hg, "edgecolor", @update_props); + addlistener (hg, "linewidth", @update_props); + addlistener (hg, "linestyle", @update_props); + addlistener (hg, "facecolor", @update_props); +endfunction + +function update_data (h, d) + persistent recursion = false; + + ## Don't allow recursion + if (!recursion) + unwind_protect + recursion = true; + + kids = get (h, "children"); + pos = get (h, "position"); + curv2 = get (h, "curvature"); + + if (numel (curv2) == 1) + [a, ai] = min (pos (3 : 4)); + [b, bi] = max (pos (3 : 4)); + if (ai < bi) + curv = [curv2, curv2 .* a ./ b]; + else + curv = [curv2 .* a ./ b, curv2]; + endif + else + curv = curv2; + endif + + if (all (curv) < 0.01) + ## Special case : no curvature + x = [pos(1), pos(1) + pos(3), pos(1) + pos(3), pos(1), pos(1)]; + y = [pos(2), pos(2), pos(2) + pos(4), pos(2) + pos(4), pos(2)]; + else + p = pi / 2 * [0 : 15] / 15; + c = curv .* pos(3 : 4) / 2; + cx = c(1) * sin (p) - c(1); + cy = c(2) * cos (p) - c(2); + x = [pos(1) - fliplr(cx), pos(1) + pos(3) + cx, ... + pos(1) + pos(3) + fliplr(cx), pos(1) - cx, pos(1)]; + y = [pos(2) - fliplr(cy), pos(2) - cy, pos(2) + pos(4) + fliplr(cy), ... + pos(2) + pos(4) + cy, pos(2) + c(2)]; + endif + + set (kids, "xdata", x, "ydata", y); + unwind_protect_cleanup + recursion = false; + end_unwind_protect + endif +endfunction + +function update_props (h, d) + kids = get (h, "children"); + set (kids, "edgecolor", get (h, "edgecolor"), + "linewidth", get (h, "linewidth"), + "linestyle", get (h, "linestyle"), + "facecolor", get (h, "facecolor")); +endfunction + + +%!demo +%! clf +%! axis equal +%! rectangle ("Position", [0.05, 0.05, 0.9, 0.9], "Curvature", [0.5, 0.5]); + +%!demo +%! clf +%! axis equal +%! rectangle ("Position", [0.05, 0.05, 0.9, 0.4], "Curvature", 1.0); + +%!demo +%! clf +%! axis equal +%! h = rectangle ("Position", [0.05, 0.05, 0.9, 0.4], "Curvature", 1.0); +%! set (h, "FaceColor", [0, 1, 0]); +
--- a/scripts/plot/refreshdata.m +++ b/scripts/plot/refreshdata.m @@ -83,7 +83,7 @@ obj = get (h (i)); fldnames = fieldnames (obj); m = regexpi (fieldnames(obj), '^.+datasource$', "match"); - idx = cellfun (@(x) !isempty(x), m); + idx = ! cellfun ("isempty", m); if (any (idx)) tmp = m(idx); props = [props; {vertcat(tmp{:})}]; @@ -106,6 +106,7 @@ endfunction %!demo +%! clf %! x = 0:0.1:10; %! y = sin (x); %! plot (x, y, "ydatasource", "y");
--- a/scripts/plot/ribbon.m +++ b/scripts/plot/ribbon.m @@ -23,9 +23,10 @@ ## Plot a ribbon plot for the columns of @var{y} vs. @var{x}. The ## optional parameter @var{width} specifies the width of a single ribbon ## (default is 0.75). If @var{x} is omitted, a vector containing the -## row numbers is assumed (1:rows(Y)). If requested, return a vector -## @var{h} of the handles to the surface objects. -## @seealso{gca, colorbar} +## row numbers is assumed (1:rows(Y)). +## +## The optional return value @var{h} is a vector of graphics handles to +## the surface objects representing each ribbon. ## @end deftypefn ## Author: Kai Habel <kai.habel at gmx.de> @@ -85,7 +86,10 @@ endfunction + %!demo +%! clf %! [x, y, z] = sombrero (); %! [x, y] = meshgrid (x, y); %! ribbon (y, z); +
--- a/scripts/plot/rose.m +++ b/scripts/plot/rose.m @@ -30,10 +30,10 @@ ## @var{r} bins. If @var{r} is a vector, then the center of each bin are ## defined by the values of @var{r}. ## -## The optional return value @var{h} provides a list of handles to the -## the parts of the vector field (body, arrow and marker). +## The optional return value @var{h} is a vector of graphics handles to the +## line objects representing each histogram. ## -## If two output arguments are requested, then rather than plotting the +## If two output arguments are requested then, rather than plotting the ## histogram, the polar vectors necessary to plot the histogram are ## returned. ## @@ -44,8 +44,7 @@ ## @end group ## @end example ## -## -## @seealso{plot, compass, polar, hist} +## @seealso{polar, compass, hist} ## @end deftypefn function [thout, rout] = rose (varargin) @@ -107,5 +106,6 @@ %!demo +%! clf %! rose ([2*randn(1e5, 1), pi + 2*randn(1e5, 1)]);
--- a/scripts/plot/scatter.m +++ b/scripts/plot/scatter.m @@ -82,16 +82,19 @@ %!demo +%! clf %! x = randn (100, 1); %! y = randn (100, 1); %! scatter (x, y, "r"); %!demo +%! clf %! x = randn (100, 1); %! y = randn (100, 1); -%! scatter (x, y, [], sqrt(x.^2 + y.^2)); +%! scatter (x, y, [], sqrt (x.^2 + y.^2)); %!demo +%! clf %! rand_10x1_data1 = [0.171577, 0.404796, 0.025469, 0.335309, 0.047814, 0.898480, 0.639599, 0.700247, 0.497798, 0.737940]; %! rand_10x1_data2 = [0.75495, 0.83991, 0.80850, 0.73603, 0.19360, 0.72573, 0.69371, 0.74388, 0.13837, 0.54143]; %! x = rand_10x1_data1; @@ -100,6 +103,7 @@ %! h = scatter (x, y, s, s, "s", "filled"); %!demo +%! clf %! rand_10x1_data3 = [0.42262, 0.51623, 0.65992, 0.14999, 0.68385, 0.55929, 0.52251, 0.92204, 0.19762, 0.93726]; %! rand_10x1_data4 = [0.020207, 0.527193, 0.443472, 0.061683, 0.370277, 0.947349, 0.249591, 0.666304, 0.134247, 0.920356]; %! x = rand_10x1_data3; @@ -108,6 +112,7 @@ %! h = scatter (x, y, [], "r", "s", "filled"); %!demo +%! clf %! rand_10x1_data5 = [0.777753, 0.093848, 0.183162, 0.399499, 0.337997, 0.686724, 0.073906, 0.651808, 0.869273, 0.137949]; %! rand_10x1_data6 = [0.37460, 0.25027, 0.19510, 0.51182, 0.54704, 0.56087, 0.24853, 0.75443, 0.42712, 0.44273]; %! x = rand_10x1_data5; @@ -115,3 +120,64 @@ %! s = 10 - 10*log (x.^2 + y.^2); %! h = scatter (x, y, [], "r", "s"); +%!demo +%! k = 1; +%! clf +%! for m = [1, 3] +%! for n = [101, 50, 1] +%! x = rand (n, 1); +%! y = rand (n, 1); +%! if (m > 1) +%! str = "Three Colors"; +%! idx = ceil (rand (n, 1) * 3); +%! colors = eye(3); +%! colors = colors(idx, :); +%! else +%! str = "Random Colors"; +%! colors = rand (n, m); +%! endif +%! if (n == 1) +%! str = sprintf ("%s: 1 point", str); +%! elseif (n < 100) +%! str = sprintf ("%s: < 100 points", str); +%! else +%! str = sprintf ("%s: > 100 points", str); +%! endif +%! subplot (2, 3, k) +%! k = k + 1; +%! scatter (x, y, 15, colors, "filled") +%! axis ([0 1 0 1]) +%! title (str) +%! endfor +%! endfor + +%!demo +%! k = 1; +%! clf +%! for m = [1, 3] +%! for n = [101, 50, 1] +%! x = rand (n, 1); +%! y = rand (n, 1); +%! if (m > 1) +%! str = "Three Colors"; +%! idx = ceil (rand (n, 1) * 3); +%! colors = eye(3); +%! colors = colors(idx, :); +%! else +%! str = "Random Colors"; +%! colors = rand (n, m); +%! endif +%! if (n == 1) +%! str = sprintf ("%s: 1 point", str); +%! elseif (n < 100) +%! str = sprintf ("%s: < 100 points", str); +%! else +%! str = sprintf ("%s: > 100 points", str); +%! endif +%! subplot (2, 3, k) +%! k = k + 1; +%! scatter (x, y, 15, colors) +%! axis ([0 1 0 1]) +%! title (str) +%! endfor +%! endfor
--- a/scripts/plot/scatter3.m +++ b/scripts/plot/scatter3.m @@ -41,7 +41,8 @@ ## If the argument 'filled' is given then the markers as filled. All ## additional arguments are passed to the underlying patch command. ## -## The optional return value @var{h} provides a handle to the patch object +## The optional return value @var{h} is a graphics handle to the hggroup +## object representing the points. ## ## @example ## @group @@ -83,22 +84,26 @@ %!demo +%! clf %! [x, y, z] = peaks (20); %! scatter3 (x(:), y(:), z(:), [], z(:)); %!demo +%! clf %! x = rand (20,1); %! y = rand (20,1); %! z = rand (20,1); %! scatter3 (x(:), y(:), z(:), 10, z(:), "s"); %!demo +%! clf %! x = rand (20,1); %! y = rand (20,1); %! z = rand (20,1); %! scatter3 (x(:), y(:), z(:), 20*z(:), z(:), "s"); %!demo +%! clf %! x = rand (20,1); %! y = rand (20,1); %! z = rand (20,1);
--- a/scripts/plot/semilogx.m +++ b/scripts/plot/semilogx.m @@ -26,6 +26,8 @@ ## Produce a two-dimensional plot using a logarithmic scale for the @var{x} ## axis. See the documentation of @code{plot} for a description of the ## arguments that @code{semilogx} will accept. +## +## The optional return value @var{h} is a graphics handle to the created plot. ## @seealso{plot, semilogy, loglog} ## @end deftypefn @@ -59,3 +61,63 @@ end_unwind_protect endfunction + + +%!demo +%! clf (); +%! x = 1:0.01:10; +%! y = (x .* (1 + rand (size (x)))) .^ 2; +%! semilogx (y, x); + +%!demo +%! clf (); +%! x = logspace (-5, 1, 10); +%! y = logspace (-5, 1, 10); +%! +%! subplot (1, 2, 1); +%! semilogx (x, y); +%! xlabel ("semilogx (x, y)"); +%! +%! subplot (1, 2, 2); +%! semilogx (-x, y); +%! xlabel ("semilogx (-x, y)"); + +%!demo +%! clf (); +%! x = logspace (-5, 1, 10); +%! y = logspace (-5, 1, 10); +%! +%! subplot (1, 2, 1); +%! semilogx (x, y); +%! set (gca, "xdir", "reverse", "activepositionproperty", "outerposition") +%! xlabel ({"semilogx (x, y)", "xdir = reversed"}) +%! +%! subplot (1, 2, 2); +%! semilogx (-x, y); +%! set (gca, "xdir", "reverse", "activepositionproperty", "outerposition"); +%! xlabel ({"semilogx (-x, y)", "xdir = reversed"}); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b = logspace (-5, 1, 10); +%! semilogx (a, b) +%! assert (get (gca, "xscale"), "log"); +%! assert (get (gca, "yscale"), "linear"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b =-logspace (-5, 1, 10); +%! semilogx (a, b); +%! axis tight; +%! assert (all (get (gca, "ytick") < 0)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/semilogxerr.m +++ b/scripts/plot/semilogxerr.m @@ -61,6 +61,7 @@ endfunction %!demo +%! clf %! x = exp (log(0.01):0.2:log(10)); %! y = wblpdf (x, 2, 2); %! ey = 0.5*rand (size (y)) .* y;
--- a/scripts/plot/semilogy.m +++ b/scripts/plot/semilogy.m @@ -26,6 +26,8 @@ ## Produce a two-dimensional plot using a logarithmic scale for the @var{y} ## axis. See the documentation of @code{plot} for a description of the ## arguments that @code{semilogy} will accept. +## +## The optional return value @var{h} is a graphics handle to the created plot. ## @seealso{plot, semilogx, loglog} ## @end deftypefn @@ -60,3 +62,62 @@ end_unwind_protect endfunction + +%!demo +%! clf (); +%! x = 1:0.01:10; +%! y = (x .* (1 + rand (size (x)))) .^ 2; +%! semilogy (x, y); + +%!demo +%! clf (); +%! x = logspace (-5, 1, 10); +%! y = logspace (-5, 1, 10); +%! +%! subplot (2, 1, 1); +%! semilogy (x, y); +%! ylabel ("semilogy (x, y)"); +%! +%! subplot (2, 1, 2); +%! semilogy (x, -y); +%! ylabel ("semilogy (x, -y)"); + +%!demo +%! clf (); +%! x = logspace (-5, 1, 10); +%! y = logspace (-5, 1, 10); +%! +%! subplot (2, 1, 1); +%! semilogy (x, y); +%! set (gca, "ydir", "reverse", "activepositionproperty", "outerposition"); +%! ylabel ({"semilogy (x, y)", "ydir = reversed"}); +%! +%! subplot (2, 1, 2); +%! semilogy (x, -y); +%! set (gca, "ydir", "reverse", "activepositionproperty", "outerposition"); +%! ylabel ({"semilogy (x, -y)", "ydir = reversed"}); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b = logspace (-5, 1, 10); +%! semilogy (a, b); +%! assert (get (gca, "yscale"), "log"); +%! assert (get (gca, "xscale"), "linear"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b =-logspace (-5, 1, 10); +%! semilogy (a, b); +%! axis tight; +%! assert (all (get (gca, "ytick") < 0)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/semilogyerr.m +++ b/scripts/plot/semilogyerr.m @@ -61,6 +61,7 @@ endfunction %!demo +%! clf %! x = 0.25:0.25:10; %! y = wblpdf (x, 4, 2); %! eyu = rand (size (y));
--- a/scripts/plot/shading.m +++ b/scripts/plot/shading.m @@ -73,24 +73,41 @@ endfunction + %!demo %! clf %! colormap (jet) %! sombrero %! shading faceted -%! title("shading ""faceted""") +%! title ('shading "faceted"') %!demo +%! clf +%! sombrero +%! shading flat +%! title ('shading "flat"') + +%!demo +%! clf %! sombrero %! shading interp -%! title("shading ""interp""") +%! title ('shading "interp"') %!demo +%! clf %! pcolor (peaks ()) %! shading faceted -%! title("shading ""faceted""") +%! title ('shading "faceted"') %!demo +%! clf +%! pcolor (peaks ()) +%! shading flat +%! title ('shading "flat"') + +%!demo +%! clf %! pcolor (peaks ()) %! shading interp -%! title("shading ""interp""") +%! title ('shading "interp"') +
--- a/scripts/plot/slice.m +++ b/scripts/plot/slice.m @@ -55,8 +55,9 @@ ## @end table ## ## The default method is @code{"linear"}. -## The optional return value @var{h} is a vector of handles to the -## surface graphic objects. +## +## The optional return value @var{h} is a graphics handle to the created +## surface object. ## ## Examples: ## @@ -179,10 +180,18 @@ endfunction + %!demo +%! clf %! [x, y, z] = meshgrid (linspace (-8, 8, 32)); %! v = sin (sqrt (x.^2 + y.^2 + z.^2)) ./ (sqrt (x.^2 + y.^2 + z.^2)); %! slice (x, y, z, v, [], 0, []); + +%!demo +%! clf +%! [x, y, z] = meshgrid (linspace (-8, 8, 32)); +%! v = sin (sqrt (x.^2 + y.^2 + z.^2)) ./ (sqrt (x.^2 + y.^2 + z.^2)); %! [xi, yi] = meshgrid (linspace (-7, 7)); %! zi = xi + yi; %! slice (x, y, z, v, xi, yi, zi); +
--- a/scripts/plot/sombrero.m +++ b/scripts/plot/sombrero.m @@ -62,4 +62,5 @@ endfunction %!demo +%! clf %! sombrero ();
--- a/scripts/plot/sphere.m +++ b/scripts/plot/sphere.m @@ -19,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {[@var{x}, @var{y}, @var{z}] =} sphere (@var{n}) ## @deftypefnx {Function File} {} sphere (@var{h}, @dots{}) -## Generates three matrices in @code{meshgrid} format, such that +## Generate three matrices in @code{meshgrid} format, such that ## @code{surf (@var{x}, @var{y}, @var{z})} generates a unit sphere. ## The matrices of @code{@var{n}+1}-by-@code{@var{n}+1}. If @var{n} is ## omitted then a default value of 20 is assumed.
--- a/scripts/plot/stairs.m +++ b/scripts/plot/stairs.m @@ -210,12 +210,14 @@ %!demo +%! clf %! x = 1:10; %! rand_1x10_data1 = [0.073, 0.455, 0.837, 0.124, 0.426, 0.781, 0.004, 0.024, 0.519, 0.698]; %! y = rand_1x10_data1; %! stairs (x, y); %!demo +%! clf %! x = 1:10; %! rand_1x10_data2 = [0.014, 0.460, 0.622, 0.394, 0.531, 0.378, 0.466, 0.788, 0.342, 0.893]; %! y = rand_1x10_data2; @@ -223,9 +225,11 @@ %! plot (xs, ys); %!demo +%! clf %! stairs (1:9); %!demo +%! clf %! [xs, ys] = stairs (9:-1:1); %! plot (xs, ys);
--- a/scripts/plot/stem.m +++ b/scripts/plot/stem.m @@ -47,8 +47,8 @@ ## @noindent ## plots 10 stems with heights from 2 to 20 in red; ## -## The return value of @code{stem} is a vector of "stem series" graphics -## handles, with one handle per column of the variable @var{y}. This +## The optional return value @var{h} is a vector of "stem series" graphics +## handles with one handle per column of the variable @var{y}. The ## handle regroups the elements of the stem graph together as the ## children of the "stem series" handle, allowing them to be altered ## together. For example, @@ -86,38 +86,47 @@ endfunction + %!demo +%! clf %! x = 1:10; %! stem (x); %!demo +%! clf %! x = 1:10; -%! y = ones (1, length (x))*2.*x; +%! y = 2*x; %! stem (x, y); %!demo +%! clf %! x = 1:10; -%! y = ones (size (x))*2.*x; +%! y = 2*x; %! h = stem (x, y, "r"); %!demo +%! clf %! x = 1:10; -%! y = ones (size (x))*2.*x; +%! y = 2*x; %! h = stem (x, y, "-.k"); %!demo +%! clf %! x = 1:10; -%! y = ones (size (x))*2.*x; +%! y = 2*x; %! h = stem (x, y, "-.k."); %!demo +%! clf %! x = 1:10; -%! y = ones (size (x))*2.*x; +%! y = 2*x; %! h = stem (x, y, "filled"); %!demo +%! clf %! x = [0 : 10]'; %! y = [sin(x), cos(x)]; %! h = stem (x, y); %! set (h(2), "color", "g"); %! set (h(1), "basevalue", -1) +
--- a/scripts/plot/stem3.m +++ b/scripts/plot/stem3.m @@ -53,5 +53,6 @@ endfunction %!demo +%! clf %! theta = 0:0.2:6; %! stem3 (cos (theta), sin (theta), theta)
--- a/scripts/plot/subplot.m +++ b/scripts/plot/subplot.m @@ -52,8 +52,8 @@ ## @end group ## @end example ## -## @var{index} may be a vector. In which case, the new axis will enclose -## the grid locations specified. The first demo illustrates an example. +## @var{index} may be a vector. In which case, the new axis will enclose +## the grid locations specified. The first demo illustrates an example: ## ## @example ## @code{demo ("subplot", 1)} @@ -66,56 +66,96 @@ ## Author: Vinayak Dutt <Dutt.Vinayak@mayo.EDU> ## Adapted-By: jwe -function h = subplot (rows, cols, index, varargin) +function h = subplot (varargin) align_axes = false; replace_axes = false; + have_position = false; + initial_args_decoded = false; - if (! (nargin >= 3) && nargin != 1) - print_usage (); - elseif (nargin > 3) - for n = 1:numel(varargin) - switch lower(varargin{n}) - case "align" - align_axes = true; - case "replace" - replace_axes = true; - otherwise - print_usage (); - endswitch - endfor + if (nargin > 2) + ## R, C, N? + arg1 = varargin{1}; + arg2 = varargin{2}; + arg3 = varargin{3}; + if (isnumeric (arg1) && isscalar (arg1) && isnumeric (arg2) + && isscalar (arg2) && isnumeric (arg3)) + rows = arg1; + cols = arg2; + index = arg3; + varargin(1:3)= []; + initial_args_decoded = true; + endif endif - if (nargin == 1) + if (! initial_args_decoded && nargin > 1) + ## check for 'position', pos, ... + if (strcmpi (varargin{1}, "position")) + arg = varargin{2}; + if (isnumeric (arg) && numel (arg) == 4) + pos = arg; + varargin(1:2) = []; + have_position = true; + initial_args_decoded = true; + else + error ("expecting position to be a 4-element numeric array"); + endif + endif + endif + + if (! initial_args_decoded && nargin > 0) + arg = varargin{1}; + if (nargin == 1 && ishandle (arg)) + ## Axes handle? + axes (arg); + cf = get (0, "currentfigure"); + set (cf, "nextplot", "add"); + return; + elseif (isscalar (arg) && arg >= 0) + ## RCN? + index = rem (arg, 10); + arg = (arg - index) / 10; + cols = rem (arg, 10); + arg = (arg - cols) / 10; + rows = rem (arg, 10); + varargin(1) = []; + initial_args_decoded = true; + else + error ("subplot: expecting axes handle or RCN argument"); + endif + endif - if (! (isscalar (rows) && rows >= 0)) - error ("subplot: input RCN has to be a positive scalar"); + if (! initial_args_decoded) + print_usage (); + endif + + if (! have_position) + cols = round (cols); + rows = round (rows); + index = round (index); + + if (any (index < 1) || any (index > rows*cols)) + error ("subplot: INDEX value must be greater than 1 and less than ROWS*COLS"); endif - tmp = rows; - index = rem (tmp, 10); - tmp = (tmp - index) / 10; - cols = rem (tmp, 10); - tmp = (tmp - cols) / 10; - rows = rem (tmp, 10); - - elseif (! (isscalar (cols) && isscalar (rows))) - error ("subplot: COLS, and ROWS must be scalars"); - elseif (any (index < 1) || any (index > rows*cols)) - error ("subplot: INDEX value must be greater than 1 and less than ROWS*COLS"); + if (cols < 1 || rows < 1 || index < 1) + error ("subplot: COLS, ROWS, and INDEX must be be positive"); + endif endif - cols = round (cols); - rows = round (rows); - index = round (index); - - if (index > cols*rows) - error ("subplot: INDEX must be less than COLS*ROWS"); - endif - - if (cols < 1 || rows < 1 || index < 1) - error ("subplot: COLS,ROWS,INDEX must be be positive"); - endif + nargs = numel (varargin); + while (nargs > 0) + arg = varargin{1}; + if (strcmpi (arg, "align")) + align_axes = true; + elseif (strcmpi (arg, "replace")) + replace_axes = true; + else + break; + endif + varargin(1) = []; + nargs--; + endwhile axesunits = get (0, "defaultaxesunits"); cf = gcf (); @@ -124,7 +164,24 @@ units = "normalized"; set (0, "defaultaxesunits", units); set (cf, "units", "pixels"); - pos = subplot_position (rows, cols, index, "position"); + + ## FIXME: At the moment we force gnuplot to use the aligned mode + ## which will set "activepositionproperty" to "position". + ## Τhis can yield to text overlap between labels and titles + ## see bug #31610 + if (strcmp (get (cf, "__graphics_toolkit__"), "gnuplot")) + align_axes = true; + endif + + if (! have_position) + if (align_axes) + pos = subplot_position (rows, cols, index, "position"); + elseif (strcmp (get (cf, "__graphics_toolkit__"), "gnuplot")) + pos = subplot_position (rows, cols, index, "outerpositiontight"); + else + pos = subplot_position (rows, cols, index, "outerposition"); + endif + endif set (cf, "nextplot", "add"); @@ -144,7 +201,11 @@ || strcmp (get (child, "tag"), "colorbar")) continue; endif - objpos = get (child, "position"); + if (align_axes) + objpos = get (child, "position"); + else + objpos = get (child, "outerposition"); + endif if (all (objpos == pos) && ! replace_axes) ## If the new axes are in exactly the same position as an ## existing axes object, use the existing axes. @@ -170,14 +231,13 @@ if (found) set (cf, "currentaxes", tmp); + elseif (align_axes) + tmp = axes ("box", "off", "position", pos, varargin{:}); + elseif (strcmp (get (cf, "__graphics_toolkit__"), "gnuplot")) + tmp = axes ("box", "off", "outerposition", pos, varargin{:}); else - outpos = subplot_position (rows, cols, index, "outerposition"); - tmp = axes ("looseinset", [0 0 0 0], "box", "off", - "outerposition", outpos, "position", pos); - endif - - if (align_axes || strcmp (get (cf, "__graphics_toolkit__"), "gnuplot")) - set (tmp, "activepositionproperty", "position"); + tmp = axes ("looseinset", [0 0 0 0], "box", "off", "outerposition", pos, + "autopos_tag", "subplot", varargin{:}); endif unwind_protect_cleanup @@ -193,67 +253,55 @@ function pos = subplot_position (rows, cols, index, position_property) - defaultaxesposition = get (0, "defaultaxesposition"); - defaultaxesouterposition = get (0, "defaultaxesouterposition"); - if (rows == 1 && cols == 1) ## Trivial result for subplot (1,1,1) if (strcmpi (position_property, "position")) - pos = defaultaxesposition; + pos = get (0, "defaultaxesposition"); else - pos = defaultaxesouterposition; + pos = get (0, "defaultaxesouterposition"); endif return endif - ## The outer margins surrounding all subplot "positions" are independent of - ## the number of rows and/or columns - margins.left = defaultaxesposition(1); - margins.bottom = defaultaxesposition(2); - margins.right = 1.0 - margins.left - defaultaxesposition(3); - margins.top = 1.0 - margins.bottom - defaultaxesposition(4); - - ## Fit from Matlab experiments - pc = 1 ./ [0.1860, (margins.left + margins.right - 1)]; - margins.column = 1 ./ polyval (pc , cols); - pr = 1 ./ [0.2282, (margins.top + margins.bottom - 1)]; - margins.row = 1 ./ polyval (pr , rows); - - ## Calculate the width/height of the subplot axes "position". - ## This is also consistent with Matlab - width = 1 - margins.left - margins.right - (cols-1)*margins.column; - width = width / cols; - height = 1 - margins.top - margins.bottom - (rows-1)*margins.row; - height = height / rows; + if (strcmp (position_property, "outerposition") + || strcmp (position_property, "outerpositiontight")) + margins.left = 0.05; + margins.bottom = 0.05; + margins.right = 0.05; + margins.top = 0.05; + if (strcmp (position_property, "outerpositiontight")) + margins.column = 0.; + margins.row = 0.; + else + margins.column = 0.04 / cols; + margins.row = 0.04 / rows; + endif + width = 1 - margins.left - margins.right - (cols-1)*margins.column; + width = width / cols; + height = 1 - margins.top - margins.bottom - (rows-1)*margins.row; + height = height / rows; + else + defaultaxesposition = get (0, "defaultaxesposition"); - if (strcmp (position_property, "outerposition") ) - ## Calculate the inset of the position relative to the outerposition - ## The outerpositions are assumed to be tiled. Matlab's implementation - ## has outerposition overlap. - if (rows > 1) - ## Title on top and xlabel & xticks on bottom - inset.top = margins.row * (1/3); - inset.bottom = margins.row * (2/3); - ## Matlab behavior is approximately ... - % inset.bottom = margins.row; - else - inset.bottom = margins.bottom; - inset.top = margins.top; - endif - if (cols > 1) - ## ylabel & yticks on left and some overhang for xticks on right - x = 0.1; - inset.right = x * margins.column; - inset.left = (1 - x) * margins.column; - else - inset.left = margins.left; - inset.right = margins.right; - endif - ## Apply the inset to the geometries for the "position" property. - margins.column = margins.column - inset.right - inset.left; - margins.row = margins.row - inset.top - inset.bottom; - width = width + inset.right + inset.left; - height = height + inset.top + inset.bottom; + ## The outer margins surrounding all subplot "positions" are independent + ## of the number of rows and/or columns + margins.left = defaultaxesposition(1); + margins.bottom = defaultaxesposition(2); + margins.right = 1.0 - margins.left - defaultaxesposition(3); + margins.top = 1.0 - margins.bottom - defaultaxesposition(4); + + ## Fit from Matlab experiments + pc = 1 ./ [0.1860, (margins.left + margins.right - 1)]; + margins.column = 1 ./ polyval (pc , cols); + pr = 1 ./ [0.2282, (margins.top + margins.bottom - 1)]; + margins.row = 1 ./ polyval (pr , rows); + + ## Calculate the width/height of the subplot axes "position". + ## This is also consistent with Matlab + width = 1 - margins.left - margins.right - (cols-1)*margins.column; + width = width / cols; + height = 1 - margins.top - margins.bottom - (rows-1)*margins.row; + height = height / rows; endif ## Index offsets from the lower left subplot @@ -265,12 +313,6 @@ x0 = xi .* (width + margins.column) + margins.left; y0 = yi .* (height + margins.row) + margins.bottom; - if (strcmp (position_property, "outerposition") ) - ## Shift from position(1:2) to outerposition(1:2) - x0 = x0 - inset.left; - y0 = y0 - inset.bottom; - endif - if (numel(x0) > 1) ## subplot (row, col, m:n) x1 = max (x0(:)) + width;
--- a/scripts/plot/surf.m +++ b/scripts/plot/surf.m @@ -32,6 +32,9 @@ ## The color of the surface is derived from the @code{colormap} and ## the value of @var{z}. Optionally the color of the surface can be ## specified independent of @var{z}, by adding a fourth matrix, @var{c}. +## +## The optional return value @var{h} is a graphics handle to the created +## surface object. ## @seealso{colormap, contour, meshgrid, mesh} ## @end deftypefn @@ -60,3 +63,24 @@ endif endfunction + + +%!demo +%! clf +%! [~,~,Z] = peaks; +%! surf (Z); + +%!demo +%! clf +%! [~,~,Z] = sombrero; +%! [Fx,Fy] = gradient (Z); +%! surf (Z, Fx+Fy); +%! shading interp; + +%!demo +%! clf +%! [X,Y,Z] = sombrero; +%! [~,Fy] = gradient (Z); +%! surf (X, Y, Z, Fy); +%! shading interp; +
--- a/scripts/plot/surface.m +++ b/scripts/plot/surface.m @@ -33,6 +33,9 @@ ## are missing, they are constructed from size of the matrix @var{z}. ## ## Any additional properties passed are assigned to the surface. +## +## The optional return value @var{h} is a graphics handle to the created +## surface object. ## @seealso{surf, mesh, patch, line} ## @end deftypefn @@ -80,9 +83,12 @@ z = varargin{3}; c = varargin{4}; - if (! size_equal (z, c)) + [z_nr, z_nc] = size (z); + [c_nr, c_nc, c_np] = size (c); + if (! (z_nr == c_nr && z_nc == c_nc && (c_np == 1 || c_np == 3))) error ("surface: Z and C must have the same size"); endif + if (isvector (x) && isvector (y) && ismatrix (z)) if (rows (z) == length (y) && columns (z) == length (x)) x = x(:)'; @@ -136,6 +142,10 @@ else error ("surface: Z argument must be a matrix"); endif + elseif (firststring == 1) + x = 1:3; + y = (x).'; + c = z = eye(3); else bad_usage = true; endif @@ -155,3 +165,24 @@ endif endfunction + +## Functional tests for surface() are in surf.m, surfc.m, surfl.m, and pcolor.m + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = surface; +%! assert (findobj (hf, "type", "surface"), h); +%! assert (get (h, "xdata"), 1:3, eps); +%! assert (get (h, "ydata"), (1:3)', eps); +%! assert (get (h, "zdata"), eye(3)); +%! assert (get (h, "cdata"), eye(3)); +%! assert (get (h, "type"), "surface"); +%! assert (get (h, "linestyle"), get (0, "defaultsurfacelinestyle")); +%! assert (get (h, "linewidth"), get (0, "defaultsurfacelinewidth"), eps); +%! assert (get (h, "marker"), get (0, "defaultsurfacemarker")); +%! assert (get (h, "markersize"), get (0, "defaultsurfacemarkersize")); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/surfc.m +++ b/scripts/plot/surfc.m @@ -45,7 +45,26 @@ drawnow (); zmin = get (ax, "zlim")(1); - [c, tmp2] = __contour__ (ax, zmin, varargin{:}); + # don't pass axis handle and/or string arguments to __contour__() + stop_idx = nargin; + for i = 2 : nargin + if (ischar (varargin{i})) + stop_idx = i - 1; + break; + endif + endfor + + start_idx = 1; + if (ishandle (varargin{1})) + start_idx = 2; + endif + + if (stop_idx - start_idx == 1 || stop_idx - start_idx == 3) + #don't pass a color matrix c to __contour__ + stop_idx -= 1; + endif + + [c, tmp2] = __contour__ (ax, zmin, varargin{start_idx:stop_idx}); tmp = [tmp; tmp2]; @@ -54,3 +73,22 @@ endif endfunction + +%!demo +%! clf +%! [~,~,Z]=peaks; +%! surfc(Z); + +%!demo +%! clf +%! [~,~,Z]=sombrero; +%! [Fx,Fy] = gradient(Z); +%! surfc(Z,Fx+Fy); +%! shading interp; + +%!demo +%! clf +%! [X,Y,Z]=sombrero; +%! [~,Fy] = gradient(Z); +%! surfc(X,Y,Z,Fy); +%! shading interp;
--- a/scripts/plot/surfl.m +++ b/scripts/plot/surfl.m @@ -179,6 +179,7 @@ %! shading interp; %!demo +%! clf %! [X,Y,Z]=sombrero; %! colormap(copper); %! [az, el] = view;
--- a/scripts/plot/surfnorm.m +++ b/scripts/plot/surfnorm.m @@ -142,13 +142,16 @@ endfunction %!demo +%! clf %! colormap (jet (64)) %! [x, y, z] = peaks(10); %! surfnorm (x, y, z); %!demo +%! clf %! surfnorm (peaks(10)); %!demo +%! clf %! surfnorm (peaks(32)); %! shading interp
--- a/scripts/plot/text.m +++ b/scripts/plot/text.m @@ -17,13 +17,17 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{h} =} text (@var{x}, @var{y}, @var{label}) -## @deftypefnx {Function File} {@var{h} =} text (@var{x}, @var{y}, @var{z}, @var{label}) -## @deftypefnx {Function File} {@var{h} =} text (@var{x}, @var{y}, @var{label}, @var{p1}, @var{v1}, @dots{}) -## @deftypefnx {Function File} {@var{h} =} text (@var{x}, @var{y}, @var{z}, @var{label}, @var{p1}, @var{v1}, @dots{}) +## @deftypefn {Function File} {} text (@var{x}, @var{y}, @var{label}) +## @deftypefnx {Function File} {} text (@var{x}, @var{y}, @var{z}, @var{label}) +## @deftypefnx {Function File} {} text (@var{x}, @var{y}, @var{label}, @var{p1}, @var{v1}, @dots{}) +## @deftypefnx {Function File} {} text (@var{x}, @var{y}, @var{z}, @var{label}, @var{p1}, @var{v1}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} text (@dots{}) ## Create a text object with text @var{label} at position @var{x}, ## @var{y}, @var{z} on the current axes. Property-value pairs following ## @var{label} may be used to specify the appearance of the text. +## +## The optional return value @var{h} is a graphics handle to the created text +## object. ## @end deftypefn ## Author: jwe @@ -47,15 +51,33 @@ endif label = varargin{offset}; - if (ischar (label) || iscellstr (label)) - varargin(1:offset) = []; - if (ischar (label)) + varargin(1:offset) = []; + + nx = numel (x); + ny = numel (y); + nz = numel (z); + if (ischar (label) || isnumeric (label)) + nt = size (label, 1); + if (nx > 1 && nt == 1) + ## Mutiple text objects with same string + label = repmat ({label}, [nx, 1]); + nt = nx; + elseif (nx > 1 && nt == nx) + ## Mutiple text objects with different strings label = cellstr (label); + elseif (ischar (label)) + ## Single text object with one or more lines + label = {label}; endif - n = numel (label); - nx = numel (x); - ny = numel (y); - nz = numel (z); + elseif (iscell (label)) + nt = numel (label); + if (nx > 1 && nt == 1) + label = repmat ({label}, [nx, 1]); + nt = nx; + elseif (! (nx > 1 && nt == nx)) + label = {label}; + nt = 1; + endif else error ("text: expecting LABEL to be a character string or cell array of character strings"); endif @@ -63,35 +85,35 @@ x = y = z = 0; nx = ny = nz = 1; label = {""}; - n = 1; + nt = 1; endif if (rem (numel (varargin), 2) == 0) - if (nx == ny && nx == nz) + if (nx == ny && nx == nz && (nt == nx || nt == 1 || nx == 1)) pos = [x(:), y(:), z(:)]; ca = gca (); - tmp = zeros (n, 1); - if (n == 1) - label = label{1}; - for i = 1:nx - tmp(i) = __go_text__ (ca, "string", label, + tmp = zeros (nt, 1); + if (nx == 1) + ## TODO - Modify __go_text__() to accept cell-strings + tmp = __go_text__ (ca, "string", "foobar", + varargin{:}, + "position", pos); + set (tmp, "string", label{1}); + elseif (nt == nx) + for n = 1:nt + tmp(n) = __go_text__ (ca, "string", label{n}, varargin{:}, - "position", pos(i,:)); - endfor - __request_drawnow__ (); - elseif (n == nx) - for i = 1:nx - tmp(i) = __go_text__ (ca, "string", label{i}, - varargin{:}, - "position", pos(i,:)); + "position", pos(n,:)); endfor __request_drawnow__ (); else error ("text: dimension mismatch for coordinates and LABEL"); endif + elseif (nt == nx || nt == 1 || nx == 1) + error ("text: dimension mismatch for coordinates"); else - error ("text: dimension mismatch for coordinates"); + error ("text: mismatch betwween coordinates and strings"); endif if (nargout > 0) @@ -116,17 +138,17 @@ %! text (x(nh), y(nv), "Hello World", ... %! "rotation", t, ... %! "horizontalalignment", ha{nh}, ... -%! "verticalalignment", va{nv}) +%! "verticalalignment", va{nv}); %! endfor %! endfor %! endfor %! set (gca, "xtick", [0.25, 0.5, 0.75], ... %! "xticklabel", ha, ... %! "ytick", [0.25, 0.5, 0.75], ... -%! "yticklabel", va) -%! axis ([0 1 0 1]) -%! xlabel ("horizontal alignment") -%! ylabel ("vertical alignment") +%! "yticklabel", va); +%! axis ([0 1 0 1]); +%! xlabel ("horizontal alignment"); +%! ylabel ("vertical alignment"); %! title ("text alignment and rotation (0:30:360 degrees)") %!demo @@ -138,7 +160,95 @@ %! text (25, 25, 0, "Vertical Alignment = Bottom", ... %! "rotation", t, ... %! "horizontalalignment", "left", ... -%! "verticalalignment", "bottom") +%! "verticalalignment", "bottom"); %! endfor -%! caxis ([-100 100]) -%! title ("Vertically Aligned at Bottom") +%! caxis ([-100 100]); +%! title ("Vertically Aligned at Bottom"); + +%!demo +%! clf +%! axis ([0 8 0 8]); +%! title (["1st title";"2nd title"]); +%! xlabel (["1st xlabel";"2nd xlabel"]); +%! ylabel (["1st ylabel";"2nd ylabel"]); +%! text (4, 4, {"Hello", "World"}, ... +%! "horizontalalignment", "center", ... +%! "verticalalignment", "middle"); +%! grid on + +%!demo +%! clf +%! h = mesh (peaks, "edgecolor", 0.7 * [1 1 1], ... +%! "facecolor", "none", ... +%! "facealpha", 0); +%! title (["1st title";"2nd title"]); +%! xlabel (["1st xlabel";"2nd xlabel"]); +%! ylabel (["1st ylabel";"2nd ylabel"]); +%! zlabel (["1st zlabel";"2nd zlabel"]); +%! text (0, 0, 5, {"Hello", "World"}, ... +%! "horizontalalignment", "center", ... +%! "verticalalignment", "middle"); +%! hold on; +%! plot3 (0, 0, 5, "+k"); + +%!demo +%! clf +%! h = text (0.5, 0.3, "char"); +%! assert ("char", class (get (h, "string"))); +%! h = text (0.5, 0.4, ["char row 1"; "char row 2"]); +%! assert ("char", class (get (h, "string"))); +%! h = text (0.5, 0.6, {"cell2str (1,1)", "cell2str (1,2)"; "cell2str (2,1)", "cell2str (2,2)"}); +%! assert ("cell", class (get (h, "string"))); +%! h = text (0.5, 0.8, "foobar"); +%! set (h, "string", 1:3); +%! h = text ([0.1, 0.1], [0.3, 0.4], "one string & two objects"); +%! assert ("char", class (get (h(1), "string"))); +%! assert ("char", class (get (h(2), "string"))); +%! h = text ([0.1, 0.1], [0.5, 0.6], {"one cellstr & two objects"}); +%! assert ("cell", class (get (h(1), "string"))); +%! assert ("cell", class (get (h(2), "string"))); +%! h = text ([0.1, 0.1], [0.7, 0.8], {"cellstr 1 object 1", "cellstr 2 object 2"}); +%! assert ("char", class (get (h(1), "string"))); +%! assert ("char", class (get (h(2), "string"))); +%! h = text ([0.1, 0.1], [0.1, 0.2], ["1st string & 1st object"; "2nd string & 2nd object"]); +%! assert ("char", class (get (h(1), "string"))); +%! assert ("char", class (get (h(2), "string"))); +%! h = text (0.7, 0.6, "single string"); +%! assert ("char", class (get (h, "string"))); +%! h = text (0.7, 0.5, {"single cell-string"}); +%! assert ("cell", class (get (h, "string"))); +%! xlabel (1:2); +%! ylabel (1:2); +%! title (1:2); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = text (0.5, 0.3, "char"); +%! assert ("char", class (get (h, "string"))); +%! h = text (0.5, 0.4, ["char row 1"; "char row 2"]); +%! assert ("char", class (get (h, "string"))); +%! h = text (0.5, 0.6, {"cell2str (1,1)", "cell2str (1,2)"; "cell2str (2,1)", "cell2str (2,2)"}); +%! assert ("cell", class (get (h, "string"))); +%! h = text (0.5, 0.8, "foobar"); +%! set (h, "string", 1:3); +%! h = text ([0.1, 0.1], [0.3, 0.4], "one string & two objects"); +%! assert ("char", class (get (h(1), "string"))); +%! assert ("char", class (get (h(2), "string"))); +%! h = text ([0.1, 0.1], [0.5, 0.6], {"one cellstr & two objects"}); +%! assert ("cell", class (get (h(1), "string"))); +%! assert ("cell", class (get (h(2), "string"))); +%! h = text ([0.1, 0.1], [0.7, 0.8], {"cellstr 1 object 1", "cellstr 2 object 2"}); +%! assert ("char", class (get (h(1), "string"))); +%! assert ("char", class (get (h(2), "string"))); +%! h = text ([0.1, 0.1], [0.1, 0.2], ["1st string & 1st object"; "2nd string & 2nd object"]); +%! assert ("char", class (get (h(1), "string"))); +%! assert ("char", class (get (h(2), "string"))); +%! h = text (0.7, 0.6, "single string"); +%! assert ("char", class (get (h, "string"))); +%! h = text (0.7, 0.5, {"single cell-string"}); +%! assert ("cell", class (get (h, "string"))); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/title.m +++ b/scripts/plot/title.m @@ -19,21 +19,65 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} title (@var{string}) ## @deftypefnx {Function File} {} title (@var{string}, @var{p1}, @var{v1}, @dots{}) -## Create a title object and return a handle to it. +## @deftypefnx {Function File} {} title (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} title (@dots{}) +## Create a title object for a plot. +## +## The optional return value @var{h} is a graphics handle to the created object. ## @end deftypefn ## Author: jwe -function h = title (string, varargin) +function retval = title (varargin) - if (rem (nargin, 2) == 1) - if (nargout > 0) - h = __axis_label__ ("title", string, varargin{:}); - else - __axis_label__ ("title", string, varargin{:}); - endif - else + [h, varargin, nargin] = __plt_get_axis_arg__ ("title", varargin{:}); + + if (rem (nargin, 2) != 1) print_usage (); endif + tmp = __axis_label__ (h, "title", varargin{:}); + + if (nargout > 0) + retval = tmp; + endif + endfunction + + +%!demo +%! clf (); +%! ax = axes(); +%! xl = get (ax,"title"); +%! title ("Testing title"); +%! assert (get (xl,"string"), "Testing title"); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! xl = get(gca (), "title"); +%! title ("Testing title"); +%! assert (get (xl,"string"),"Testing title"); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! ax = axes(); +%! xl = get (ax,"title"); +%! title ("Testing title"); +%! assert (get (xl,"string"), "Testing title"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1], [0,1]); +%! xl = get (gca (), "title"); +%! title("Testing title"); +%! assert (get (xl,"string"), "Testing title"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
rename from scripts/geometry/trimesh.m rename to scripts/plot/trimesh.m --- a/scripts/geometry/trimesh.m +++ b/scripts/plot/trimesh.m @@ -22,8 +22,9 @@ ## Plot a triangular mesh in 3D@. The variable @var{tri} is the triangular ## meshing of the points @code{(@var{x}, @var{y})} which is returned ## from @code{delaunay}. The variable @var{z} is value at the point -## @code{(@var{x}, @var{y})}. The output argument @var{h} is the graphic -## handle of the plot. +## @code{(@var{x}, @var{y})}. +## +## The optional return value @var{h} is a graphics handle to the created plot. ## @seealso{triplot, trisurf, delaunay3} ## @end deftypefn @@ -39,28 +40,30 @@ triplot (tri, x, y, z, varargin{:}); else newplot (); - if (nargout > 0) - h = patch ("Vertices", [x(:), y(:), z(:)], "Faces", tri, - "FaceColor", "none", "EdgeColor", __next_line_color__(), - varargin{:}); - else - patch ("Vertices", [x(:), y(:), z(:)], "Faces", tri, - "FaceColor", "none", "EdgeColor", __next_line_color__(), - varargin{:}); - endif - + handle = patch ("Vertices", [x(:), y(:), z(:)], "Faces", tri, + "FaceColor", "none", "EdgeColor", __next_line_color__(), + varargin{:}); if (! ishold ()) set (gca(), "view", [-37.5, 30], "xgrid", "on", "ygrid", "on", "zgrid", "on"); endif + if (nargout > 0) + h = handle; + endif endif + endfunction + %!demo +%! clf +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 10); %! N = 10; -%! rand ('state', 10) %! x = 3 - 6 * rand (N, N); %! y = 3 - 6 * rand (N, N); %! z = peaks (x, y); %! tri = delaunay (x(:), y(:)); %! trimesh (tri, x(:), y(:), z(:)); +
rename from scripts/geometry/triplot.m rename to scripts/plot/triplot.m --- a/scripts/geometry/triplot.m +++ b/scripts/plot/triplot.m @@ -22,9 +22,10 @@ ## @deftypefnx {Function File} {@var{h} =} triplot (@dots{}) ## Plot a triangular mesh in 2D@. The variable @var{tri} is the triangular ## meshing of the points @code{(@var{x}, @var{y})} which is returned from -## @code{delaunay}. If given, the @var{linespec} determines the properties -## to use for the lines. The output argument @var{h} is the graphic handle -## of the plot. +## @code{delaunay}. If given, @var{linespec} determines the properties +## to use for the lines. +## +## The optional return value @var{h} is a graphics handle to the created plot. ## @seealso{plot, trimesh, trisurf, delaunay} ## @end deftypefn @@ -35,19 +36,25 @@ endif idx = tri(:, [1, 2, 3, 1]).'; - nt = size (tri, 1); + nt = rows (tri); + handle = plot ([x(idx); NaN(1, nt)](:), + [y(idx); NaN(1, nt)](:), varargin{:}); + if (nargout > 0) - h = plot ([x(idx); NaN(1, nt)](:), - [y(idx); NaN(1, nt)](:), varargin{:}); - else - plot ([x(idx); NaN(1, nt)](:), - [y(idx); NaN(1, nt)](:), varargin{:}); + h = handle; endif + endfunction + %!demo -%! rand ('state', 2) -%! x = rand (20, 1); -%! y = rand (20, 1); +%! clf +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 2); +%! N = 20; +%! x = rand (N, 1); +%! y = rand (N, 1); %! tri = delaunay (x, y); %! triplot (tri, x, y); +
rename from scripts/geometry/trisurf.m rename to scripts/plot/trisurf.m --- a/scripts/geometry/trisurf.m +++ b/scripts/plot/trisurf.m @@ -22,8 +22,9 @@ ## Plot a triangular surface in 3D@. The variable @var{tri} is the triangular ## meshing of the points @code{(@var{x}, @var{y})} which is returned ## from @code{delaunay}. The variable @var{z} is value at the point -## @code{(@var{x}, @var{y})}. The output argument @var{h} is the graphic -## handle of the plot. +## @code{(@var{x}, @var{y})}. +## +## The optional return value @var{h} is a graphics handle to the created plot. ## @seealso{triplot, trimesh, delaunay3} ## @end deftypefn @@ -44,18 +45,22 @@ else c = z; endif - + if (! any (strcmpi (varargin, "FaceColor"))) + nfc = numel (varargin) + 1; + varargin(nfc+(0:1)) = {"FaceColor", "flat"}; + else + nfc = find (any (strcmpi (varargin, "FaceColor")), 1); + endif + if (! any (strcmpi (varargin, "EdgeColor")) + && strcmpi (varargin{nfc+1}, "interp")) + varargin(end+(1:2)) = {"EdgeColor", "none"}; + endif newplot (); + handle = patch ("Faces", tri, "Vertices", [x(:), y(:), z(:)], + "FaceVertexCData", reshape (c, numel (c), 1), + varargin{:}); if (nargout > 0) - h = patch ("Faces", tri, "Vertices", [x(:), y(:), z(:)], - "FaceVertexCData", reshape (c, numel (c), 1), - "FaceColor", "flat", "EdgeColor", "none", - varargin{:}); - else - patch ("Faces", tri, "Vertices", [x(:), y(:), z(:)], - "FaceVertexCData", reshape (c, numel (c), 1), - "FaceColor", "flat", "EdgeColor", "none", - varargin{:}); + h = handle; endif if (! ishold ()) @@ -63,13 +68,64 @@ "xgrid", "on", "ygrid", "on", "zgrid", "on"); endif endif + endfunction %!demo +%! clf +%! N = 31; +%! [x, y] = meshgrid (1:N); +%! tri = delaunay (x, y); +%! z = peaks (N); +%! h = trisurf (tri, x, y, z, "facecolor", "interp"); +%! axis tight +%! zlim auto +%! title (sprintf ("facecolor = %s", get (h, "facecolor"))) + +%!demo +%! clf +%! N = 31; +%! [x, y] = meshgrid (1:N); +%! tri = delaunay (x, y); +%! z = peaks (N); +%! h = trisurf (tri, x, y, z, "facecolor", "flat"); +%! axis tight +%! zlim auto +%! title (sprintf ("facecolor = %s", get (h, "facecolor"))) + +%!demo +%! clf +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 10); %! N = 10; -%! rand ('state', 10) %! x = 3 - 6 * rand (N, N); %! y = 3 - 6 * rand (N, N); %! z = peaks (x, y); %! tri = delaunay (x(:), y(:)); %! trisurf (tri, x(:), y(:), z(:)); + +%!demo +%! clf +%! x = rand (100, 1); +%! y = rand (100, 1); +%! z = x.^2 + y.^2; +%! tri = delaunay (x, y); +%! trisurf (tri, x, y, z); + +%!demo +%! clf +%! x = rand (100, 1); +%! y = rand (100, 1); +%! z = x.^2 + y.^2; +%! tri = delaunay (x, y); +%! trisurf (tri, x, y, z, "facecolor", "interp"); + +%!demo +%! clf +%! x = rand (100, 1); +%! y = rand (100, 1); +%! z = x.^2 + y.^2; +%! tri = delaunay (x, y); +%! trisurf (tri, x, y, z, "facecolor", "interp", "edgecolor", "k"); +
new file mode 100644 --- /dev/null +++ b/scripts/plot/uicontextmenu.m @@ -0,0 +1,30 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uicontextmenu ('Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uicontextmenu (varargin) + + [h, args] = __uiobject_split_args__ ("uicontextmenu", varargin, {"figure"}); + handle = __go_uicontextmenu__ (h, args{:}); + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/uicontrol.m @@ -0,0 +1,36 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uicontrol ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uicontrol (@var{parent}, 'Name', value, @dots{}) +## @deftypefnx {Function File} {} uicontrol (@var{handle}) +## @end deftypefn + +## Author: goffioul + +function handle = uicontrol (varargin) + + if (nargin == 1 && ishandle (varargin{1}) && strcmpi (get (varargin{1}, "type"), "uicontrol")) + error ("uicontrol focusing not implemented yet."); + else + [h, args] = __uiobject_split_args__ ("uicontrol", varargin, {"figure", "uipanel", "uibuttongroup"}); + handle = __go_uicontrol__ (h, args{:}); + endif + +endfunction
old mode 100755 new mode 100644 --- a/scripts/plot/uigetdir.m +++ b/scripts/plot/uigetdir.m @@ -20,14 +20,28 @@ ## @deftypefn {Function File} {@var{dirname} =} uigetdir () ## @deftypefnx {Function File} {@var{dirname} =} uigetdir (@var{init_path}) ## @deftypefnx {Function File} {@var{dirname} =} uigetdir (@var{init_path}, @var{dialog_name}) -## Open a GUI dialog to select a directory. If @var{init_path} is not given -## the current working directory is used. @var{dialog_name} optionally be +## Open a GUI dialog for selecting a directory. If @var{init_path} is not +## given the current working directory is used. @var{dialog_name} may be ## used to customize the dialog title. +## @seealso{uigetfile} ## @end deftypefn ## Author: Kai Habel -function dirname = uigetdir (init_path = pwd, dialog_name = "Choose directory?") +function dirname = uigetdir (init_path = pwd, dialog_name = "Select Directory to Open") + + defaulttoolkit = get (0, "defaultfigure__graphics_toolkit__"); + funcname = ["__uigetdir_", defaulttoolkit, "__"]; + functype = exist (funcname); + if (! __is_function__ (funcname)) + funcname = "__uigetdir_fltk__"; + if (! __is_function__ (funcname)) + error ("uigetdir: fltk graphics toolkit required"); + elseif (! strcmp (defaulttoolkit, "gnuplot")) + warning ("uigetdir: no implementation for toolkit `%s', using `fltk' instead", + defaulttoolkit); + endif + endif if (nargin > 2) print_usage (); @@ -37,16 +51,16 @@ error ("uigetdir: INIT_PATH and DIALOG_NAME must be string arguments"); endif - if (exist ("__fltk_uigetfile__") == 3) - if (!isdir (init_path)) - init_path = fileparts (init_path); - endif - dirname = __fltk_uigetfile__ ("", dialog_name, init_path, [240, 120], "dir"); - else - error ("uigetdir: fltk graphics toolkit required"); + if (!isdir (init_path)) + init_path = fileparts (init_path); endif + dirname = feval (funcname, init_path, dialog_name); endfunction %!demo %! uigetdir(pwd, "Select Directory") + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1);
old mode 100755 new mode 100644 --- a/scripts/plot/uigetfile.m +++ b/scripts/plot/uigetfile.m @@ -17,29 +17,29 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} uigetfile (@var{flt}) -## @deftypefnx {Function File} {[@dots{}] =} uigetfile (@var{flt}, @var{dialog_name}, @var{default_file}) +## @deftypefn {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} uigetfile () +## @deftypefnx {Function File} {[@dots{}] =} uigetfile (@var{flt}) ## @deftypefnx {Function File} {[@dots{}] =} uigetfile (@var{flt}, @var{dialog_name}) -## @deftypefnx {Function File} {[@dots{}] =} uigetfile (@dots{}, "Position", [@var{px}, @var{py}]) -## @deftypefnx {Function File} {[@dots{}] =} uigetfile (@dots{}, "Multiselect", @var{mode}) +## @deftypefnx {Function File} {[@dots{}] =} uigetfile (@var{flt}, @var{dialog_name}, @var{default_file}) +## @deftypefnx {Function File} {[@dots{}] =} uigetfile (@dots{}, "Position", [@var{px} @var{py}]) +## @deftypefnx {Function File} {[@dots{}] =} uigetfile (@dots{}, "MultiSelect", @var{mode}) ## -## Open a GUI dialog to select a file. It returns the filename @var{fname}, +## Open a GUI dialog for selecting a file. It returns the filename @var{fname}, ## the path to this file @var{fpath}, and the filter index @var{fltidx}. ## @var{flt} contains a (list of) file filter string(s) in one of the following ## formats: ## ## @table @asis ## @item "/path/to/filename.ext" -## If a filename is given the file extension is extracted and used as filter. -## In addtion the path is selected as current path and the filname is selected -## as default file. -## Example: @code{uigetfile ("myfun.m")} +## If a filename is given then the file extension is extracted and used as +## filter. In addition, the path is selected as current path and the filename +## is selected as default file. Example: @code{uigetfile ("myfun.m")} ## ## @item A single file extension "*.ext" ## Example: @code{uigetfile ("*.ext")} ## ## @item A 2-column cell array -## containing the file extension in the first column and a brief description +## containing a file extension in the first column and a brief description ## in the second column. ## Example: @code{uigetfile (@{"*.ext", "My Description";"*.xyz", ## "XYZ-Format"@})} @@ -51,12 +51,12 @@ ## @end table ## ## @var{dialog_name} can be used to customize the dialog title. -## If @var{default_file} is given it is selected in the GUI dialog. -## If in addtion a path is given it is also used as current path. +## If @var{default_file} is given then it will be selected in the GUI dialog. +## If, in addition, a path is given it is also used as current path. ## ## The screen position of the GUI dialog can be set using the "Position" key ## and a 2-element vector containing the pixel coordinates. -## Two or more files can be selected when setting the "Multiselect" key to "on". +## Two or more files can be selected when setting the "MultiSelect" key to "on". ## In that case @var{fname} is a cell array containing the files. ## @end deftypefn @@ -64,99 +64,130 @@ function [retfile, retpath, retindex] = uigetfile (varargin) - if (nargin <= 7) - - defaultvals = {"All Files(*)", #FLTK File Filter - "Open File?", #Dialog Title - pwd, #FLTK default file name - [240, 120], #Dialog Position (pixel x/y) - "off"}; #Multiselect on/off - - outargs = cell (5, 1); - for i = 1 : 5 - outargs{i} = defaultvals{i}; - endfor - - idx1 = idx2 = []; - if (length (varargin) > 0) - for i = 1 : length (varargin) - val = varargin{i}; - if (ischar (val)) - if (strncmp (tolower (val), "multiselect", 11)) - idx1 = i; - elseif (strncmp(tolower (val), "position", 8)) - idx2 = i; - endif - endif - endfor + defaulttoolkit = get (0, "defaultfigure__graphics_toolkit__"); + funcname = ["__uigetfile_", defaulttoolkit, "__"]; + functype = exist (funcname); + if (! __is_function__ (funcname)) + funcname = "__uigetfile_fltk__"; + if (! __is_function__ (funcname)) + error ("uigetfile: fltk graphics toolkit required"); + elseif (! strcmp (defaulttoolkit, "gnuplot")) + warning ("uigetfile: no implementation for toolkit `%s', using `fltk' instead", + defaulttoolkit); endif - - stridx = [idx1, idx2, 0]; - if (length (stridx) > 1) - stridx = min (stridx(1 : end - 1)); - endif - - args = varargin; - if (stridx) - args = varargin(1 : stridx - 1); - endif + endif - len = length (args); - if (len > 0) - file_filter = args{1}; - outargs{1} = __fltk_file_filter__ (file_filter); - if (ischar (file_filter)) - outargs{3} = file_filter; - endif - endif - - if (len > 1) - outargs{2} = args{2}; - endif - - if (len > 2) - outargs{3} = args{3}; - endif - - if (stridx) - ## we have string arguments ("position" or "multiselect") - - ## check for even number of remaining arguments, prop/value pair(s) - if (rem (nargin - stridx + 1, 2)) - error ("uigetfile: expecting property/value pairs"); - endif - - for i = stridx : 2 : nargin - prop = varargin{i}; - val = varargin{i + 1}; - if (strncmp (tolower (prop), "position", 8)) - if (ismatrix (val) && length(val) == 2) - outargs{4} = val; - else - error ("uigetfile: expecting 2-element vector for position argument"); - endif - elseif (strncmp (tolower (prop), "multiselect", 11)) - if (ischar (val)) - outargs{5} = tolower (val); - else - error ("uigetfile: expecting string argument (on/off) for multiselect"); - endif - else - error ("uigetfile: unknown argument"); - endif - endfor - endif - else + if (nargin > 7) error ("uigetfile: number of input arguments must be less than eight"); endif - if (exist("__fltk_uigetfile__") == 3) - [retfile, retpath, retindex] = __fltk_uigetfile__ (outargs{:}); + defaultvals = {cell(0, 2), # File Filter + "Open File", # Dialog Title + "", # Default file name + [240, 120], # Dialog Position (pixel x/y) + "off", # MultiSelect on/off + pwd}; # Default directory + + outargs = cell (6, 1); + for i = 1 : 6 + outargs{i} = defaultvals{i}; + endfor + + idx1 = idx2 = []; + if (length (varargin) > 0) + for i = 1 : length (varargin) + val = varargin{i}; + if (ischar (val)) + if (strncmpi (val, "multiselect", 11)) + idx1 = i; + elseif (strncmpi (val, "position", 8)) + idx2 = i; + endif + endif + endfor + endif + + stridx = [idx1, idx2, 0]; + if (length (stridx) > 1) + stridx = min (stridx(1 : end - 1)); + endif + + args = varargin; + if (stridx) + args = varargin(1 : stridx - 1); + endif + + len = length (args); + if (len > 0) + file_filter = args{1}; + [outargs{1}, outargs{3}, defdir] = __file_filter__ (file_filter); + if (length (defdir) > 0) + outargs{6} = defdir; + endif else - error ("uigetfile: fltk graphics toolkit required"); + outargs{1} = __file_filter__ (outargs{1}); + endif + + if (len > 1) + if (ischar (args{2})) + if (length (args{2}) > 0) + outargs{2} = args{2}; + endif + elseif (! isempty (args{2})) + print_usage (); + endif + endif + + if (len > 2) + if (ischar (args{3})) + [fdir, fname, fext] = fileparts (args{3}); + if (length (fdir) > 0) + outargs{6} = fdir; + endif + if (length (fname) > 0 || length (fext) > 0) + outargs{3} = strcat (fname, fext); + endif + elseif (! isempty (args{3})) + print_usage (); + endif endif + if (stridx) + ## we have string arguments ("position" or "multiselect") + + ## check for even number of remaining arguments, prop/value pair(s) + if (rem (nargin - stridx + 1, 2)) + error ("uigetfile: expecting property/value pairs"); + endif + + for i = stridx : 2 : nargin + prop = varargin{i}; + val = varargin{i + 1}; + if (strncmp (tolower (prop), "position", 8)) + if (ismatrix (val) && length(val) == 2) + outargs{4} = val; + else + error ("uigetfile: expecting 2-element vector for position argument"); + endif + elseif (strncmp (tolower (prop), "multiselect", 11)) + if (ischar (val)) + outargs{5} = tolower (val); + else + error ("uigetfile: expecting string argument (on/off) for multiselect"); + endif + else + error ("uigetfile: unknown argument"); + endif + endfor + endif + + [retfile, retpath, retindex] = feval (funcname, outargs{:}); + endfunction %!demo %! uigetfile({"*.gif;*.png;*.jpg", "Supported Picture Formats"}) + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1);
--- a/scripts/plot/uimenu.m +++ b/scripts/plot/uimenu.m @@ -19,15 +19,15 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} uimenu (@var{property}, @var{value}, @dots{}) ## @deftypefnx {Function File} {} uimenu (@var{h}, @var{property}, @var{value}, @dots{}) -## Create an uimenu object and return a handle to it. If @var{h} is ommited -## then a top level menu entry for the current figure is created. If @var{h} +## Create a uimenu object and return a handle to it. If @var{h} is ommited +## then a top-level menu for the current figure is created. If @var{h} ## is given then a submenu relative to @var{h} is created. ## -## Uimenu objects have the following specific properties: +## uimenu objects have the following specific properties: ## ## @table @asis ## @item "accelerator" -## A string containg the key combination together with CTRL to execute this +## A string containing the key combination together with CTRL to execute this ## menu entry (e.g., "x" for CTRL+x). ## ## @item "callback" @@ -48,7 +48,7 @@ ## ## @item "label" ## A string containing the label for this menu entry. A "&"-symbol can be -## used to mark the "accelerator" character (e.g., "E&xit") +## used to mark the "accelerator" character (e.g., @nospell{"E&xit"}) ## ## @item "position" ## An scalar value containing the relative menu position. The entry with the @@ -58,7 +58,6 @@ ## Can be set "on" or "off". If enabled it draws a separator line above the ## current position. It is ignored for top level entries. ## -## ## @end table ## ## Examples: @@ -67,8 +66,10 @@ ## @group ## f = uimenu("label", "&File", "accelerator", "f"); ## e = uimenu("label", "&Edit", "accelerator", "e"); -## uimenu(f, "label", "Close", "accelerator", "q", "callback", "close (gcf)"); -## uimenu(e, "label", "Toggle &Grid", "accelerator", "g", "callback", "grid (gca)"); +## uimenu(f, "label", "Close", "accelerator", "q", ... +## "callback", "close (gcf)"); +## uimenu(e, "label", "Toggle &Grid", "accelerator", "g", ... +## "callback", "grid (gca)"); ## @end group ## @end example ## @seealso{figure} @@ -78,18 +79,7 @@ function hui = uimenu (varargin) - args = varargin; - - if (ishandle (args{1})) - h = args{1}; - args(1) = []; - else - h = gcf (); - endif - - if (rem (length (args), 2)) - error ("uimenu: expecting PROPERTY/VALUE pairs"); - endif + [h, args] = __uiobject_split_args__ ("uimenu", varargin, {"figure", "uicontextmenu", "uimenu"}); tmp = __go_uimenu__ (h, args{:}); @@ -99,11 +89,61 @@ endfunction + %!demo -%! surfl(peaks); -%! colormap(copper); -%! shading("interp"); -%! f = uimenu("label", "&File", "accelerator", "f"); -%! e = uimenu("label", "&Edit", "accelerator", "e"); -%! uimenu(f, "label", "Close", "accelerator", "q", "callback", "close (gcf)"); -%! uimenu(e, "label", "Toggle &Grid", "accelerator", "g", "callback", "grid (gca)"); +%! clf +%! surfl (peaks); +%! colormap (copper); +%! shading ("interp"); +%! f = uimenu ("label", "&File", "accelerator", "f"); +%! e = uimenu ("label", "&Edit", "accelerator", "e"); +%! uimenu (f, "label", "Close", "accelerator", "q", "callback", "close (gcf)"); +%! uimenu (e, "label", "Toggle &Grid", "accelerator", "g", "callback", "grid (gca)"); + +%!testif HAVE_FLTK +%! toolkit = graphics_toolkit (); +%! graphics_toolkit ("fltk"); +%! hf = figure ("visible", "off"); +%! unwind_protect +%! ui = uimenu ("label", "mylabel"); +%! assert (findobj (hf, "type", "uimenu"), ui); +%! assert (get (ui, "label"), "mylabel"); +%! assert (get (ui, "checked"), "off"); +%! assert (get (ui, "separator"), "off"); +%! assert (get (ui, "enable"), "on"); +%! assert (get (ui, "position"), 9); +%! unwind_protect_cleanup +%! close (hf); +%! graphics_toolkit (toolkit); +%! end_unwind_protect + +%% check for top level menus file, edit, and help +%!testif HAVE_FLTK +%! toolkit = graphics_toolkit (); +%! graphics_toolkit ("fltk"); +%! hf = figure ("visible", "off"); +%! unwind_protect +%! uif = findall (hf, "label", "&file"); +%! assert (ishghandle (uif)) +%! uie = findall (hf, "label", "&edit"); +%! assert (ishghandle (uie)) +%! uih = findall (hf, "label", "&help"); +%! assert (ishghandle (uih)) +%! unwind_protect_cleanup +%! close (hf); +%! graphics_toolkit (toolkit); +%! end_unwind_protect + +%!testif HAVE_FLTK +%! toolkit = graphics_toolkit (); +%! graphics_toolkit ("fltk"); +%! hf = figure ("visible", "off"); +%! unwind_protect +%! uie = findall (hf, "label", "&edit"); +%! myui = uimenu (uie, "label", "mylabel"); +%! assert (ancestor (myui, "uimenu", "toplevel"), uie) +%! unwind_protect_cleanup +%! close (hf); +%! graphics_toolkit (toolkit); +%! end_unwind_protect +
new file mode 100644 --- /dev/null +++ b/scripts/plot/uipanel.m @@ -0,0 +1,31 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uipanel ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uipanel (@var{parent}, 'Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uipanel (varargin) + + [h, args] = __uiobject_split_args__ ("uipanel", varargin, {"figure", "uipanel", "uibuttongroup"}); + handle = __go_uipanel__ (h, args{:}); + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/uipushtool.m @@ -0,0 +1,39 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uipushtool ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uipushtool (@var{parent}, 'Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uipushtool (varargin) + + [h, args] = __uiobject_split_args__ ("uipushtool", varargin, {"uitoolbar"}, 0); + if (isempty (h)) + h = findobj (gcf, "-depth", 1, "type", "uitoolbar"); + if (isempty (h)) + h = uitoolbar (); + else + h = h(1); + endif + endif + handle = __go_uipushtool__ (h, args{:}); + +endfunction
old mode 100755 new mode 100644 --- a/scripts/plot/uiputfile.m +++ b/scripts/plot/uiputfile.m @@ -17,18 +17,18 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} uiputfile (@var{flt}, @var{dialog_name}, @var{default_file}) -## @deftypefnx {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} uiputfile (@var{flt}, @var{dialog_name}) +## @deftypefn {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} uiputfile () ## @deftypefnx {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} uiputfile (@var{flt}) -## @deftypefnx {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} uiputfile ()) -## Open a GUI dialog to select a file. @var{flt} contains a (list of) file +## @deftypefnx {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} uiputfile (@var{flt}, @var{dialog_name}) +## @deftypefnx {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} uiputfile (@var{flt}, @var{dialog_name}, @var{default_file}) +## Open a GUI dialog for selecting a file. @var{flt} contains a (list of) file ## filter string(s) in one of the following formats: ## ## @table @code ## @item "/path/to/filename.ext" ## If a filename is given the file extension is ## extracted and used as filter. -## In addtion the path is selected as current path and the filname is selected +## In addition the path is selected as current path and the filename is selected ## as default file. ## Example: uiputfile("myfun.m"); ## @@ -48,53 +48,81 @@ ## ## @var{dialog_name} can be used to customize the dialog title. ## If @var{default_file} is given it is preselected in the GUI dialog. -## If in addtion a path is given it is also used as current path. +## If, in addition, a path is given it is also used as current path. ## @end deftypefn ## Author: Kai Habel function [retfile, retpath, retindex] = uiputfile (varargin) - if (nargin <= 3) - - defaultvals = {"All Files(*)", #FLTK File Filter - "Save File?", #Dialog Title - pwd, #FLTK default file name - [240, 120], #Dialog Position (pixel x/y) - "create"}; - - outargs = cell(5, 1); - for i = 1 : 5 - outargs{i} = defaultvals{i}; - endfor + defaulttoolkit = get (0, "defaultfigure__graphics_toolkit__"); + funcname = ["__uiputfile_", defaulttoolkit, "__"]; + functype = exist (funcname); + if (! __is_function__ (funcname)) + funcname = "__uiputfile_fltk__"; + if (! __is_function__ (funcname)) + error ("uiputfile: fltk graphics toolkit required"); + elseif (! strcmp (defaulttoolkit, "gnuplot")) + warning ("uiputfile: no implementation for toolkit `%s', using `fltk' instead", + defaulttoolkit); + endif + endif - if (nargin > 0) - file_filter = varargin{1}; - outargs{1} = __fltk_file_filter__ (file_filter); - if (ischar (file_filter)) - outargs{3} = file_filter; - endif - endif - - if (nargin > 1) - outargs{2} = varargin{2}; - endif - - if (nargin > 2) - outargs{3} = varargin{3}; - endif - - else - error ("uiputfile: number of input arguments must be less than four"); + if (nargin > 3) + print_usage (); endif - if (exist("__fltk_uigetfile__") == 3) - [retfile, retpath, retindex] = __fltk_uigetfile__ (outargs{:}); + defaultvals = {cell(0, 2), # File Filter + "Save File", # Dialog Title + "", # Default file name + [240, 120], # Dialog Position (pixel x/y) + "create", + pwd}; # Default directory + + outargs = cell(6, 1); + for i = 1 : 6 + outargs{i} = defaultvals{i}; + endfor + + if (nargin > 0) + file_filter = varargin{1}; + [outargs{1}, outargs{3}, defdir] = __file_filter__ (file_filter); + if (length (defdir) > 0) + outargs{6} = defdir; + endif else - error ("uiputfile: fltk graphics toolkit required"); + outargs{1} = __file_filter__ (outargs{1}); + endif + + if (nargin > 1) + if (ischar (varargin{2})) + outargs{2} = varargin{2}; + elseif (! isempty (varargin{2})) + print_usage (); + endif endif + if (nargin > 2) + if (ischar (varargin{3})) + [fdir, fname, fext] = fileparts (varargin{3}); + if (! isempty (fdir)) + outargs{6} = fdir; + endif + if (! isempty (fname) || ! isempty (fext)) + outargs{3} = strcat (fname, fext); + endif + elseif (! isempty (varargin{3})) + print_usage (); + endif + endif + + [retfile, retpath, retindex] = feval (funcname, outargs{:}); + endfunction %!demo %! uiputfile({"*.gif;*.png;*.jpg", "Supported Picture Formats"}) + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1);
new file mode 100644 --- /dev/null +++ b/scripts/plot/uiresume.m @@ -0,0 +1,45 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} uiresume (@var{h}) +## Resume program execution suspended with @code{uiwait}. The handle @var{h} +## must be the same as the on specified in @code{uiwait}. If the handle +## is invalid or there is no @code{uiwait} call pending for the figure +## with handle @var{h}, this function does nothing. +## @seealso{uiwait} +## @end deftypefn + +## Author: goffioul + +function uiresume (h) + + if (! ishandle (h) || ! strcmp (get (h, "type"), "figure")) + error ("uiresume: invalid figure handle"); + endif + + try + uiwait_state = get (h, "__uiwait_state__"); + if (strcmp (uiwait_state, "active")) + set (h, "__uiwait_state__", "triggered"); + endif + catch + # Ignore exception + end_try_catch + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/uitoggletool.m @@ -0,0 +1,39 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uitoggletool ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uitoggletool (@var{parent}, 'Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uitoggletool (varargin) + + [h, args] = __uiobject_split_args__ ("uitoggletool", varargin, {"uitoolbar"}, 0); + if (isempty (h)) + h = findobj (gcf, "-depth", 1, "type", "uitoolbar"); + if (isempty (h)) + h = uitoolbar (); + else + h = h(1); + endif + endif + handle = __go_uitoggletool__ (h, args{:}); + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/uitoolbar.m @@ -0,0 +1,31 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uitoolbar ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uitoolbar (@var{parent}, 'Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uitoolbar (varargin) + + [h, args] = __uiobject_split_args__ ("uitoolbar", varargin, {"figure"}); + handle = __go_uitoolbar__ (h, args{:}); + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/uiwait.m @@ -0,0 +1,80 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} uiwait +## @deftypefnx {Function File} {} uiwait (@var{h}) +## @deftypefnx {Function File} {} uiwait (@var{h}, @var{timeout}) +## Suspend program execution until the figure with handle @var{h} is +## deleted or @code{uiresume} is called. When no figure handle is specified, +## this function uses the current figure. +## +## If the figure handle is invalid or there is no current figure, this +## functions returns immediately. +## +## When specified, @var{timeout} defines the number of seconds to wait +## for the figure deletion or the @code{uiresume} call. The timeout value +## must be at least 1. If a smaller value is specified, a warning is issued +## and a timeout value of 1 is used instead. If a non-integer value is +## specified, it is truncated towards 0. If @var{timeout} is not specified, +## the program execution is suspended indefinitely. +## @seealso{uiresume, waitfor} +## @end deftypefn + +## Author: goffioul + +function uiwait (varargin) + + h = []; + timeout = []; + + if (nargin == 0) + h = get (0, "currentfigure"); + else + h = varargin{1}; + if (! ishandle (h) || ! strcmp (get (h, "type"), "figure")) + error ("uiwait: invalid figure handle"); + endif + if (nargin > 1) + timeout = varargin{2}; + endif + endif + + if (! isempty (h)) + unwind_protect + try + addproperty ("__uiwait_state__", h, "radio", "none|{active}|triggered"); + catch + if (! strcmp (get (h, "__uiwait_state__"), "none")) + error ("uiwait: an active uiwait call for this figure already exists"); + endif + set (h, "__uiwait_state__", "active"); + end_try_catch + waitfor_args = {h, "__uiwait_state__", "triggered"}; + if (! isempty (timeout)) + waitfor_args(end+1:end+2) = {"timeout", timeout}; + endif + waitfor (waitfor_args{:}); + unwind_protect_cleanup + if (ishandle (h) && isprop (h, "__uiwait_state__")) + set (h, "__uiwait_state__", "none"); + endif + end_unwind_protect + endif + +endfunction
--- a/scripts/plot/view.m +++ b/scripts/plot/view.m @@ -18,9 +18,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {[@var{azimuth}, @var{elevation}] =} view () -## @deftypefnx {Function File} {} view (@var{azimuth}, @var{elevation}) -## @deftypefnx {Function File} {} view ([@var{azimuth}, @var{elevation}]) -## @deftypefnx {Function File} {} view ([@var{x}, @var{y}, @var{z}]) +## @deftypefnx {Function File} {} view (@var{azimuth}, @var{elevation}) +## @deftypefnx {Function File} {} view ([@var{azimuth} @var{elevation}]) +## @deftypefnx {Function File} {} view ([@var{x} @var{y} @var{z}]) ## @deftypefnx {Function File} {} view (@var{dims}) ## @deftypefnx {Function File} {} view (@var{ax}, @dots{}) ## Query or set the viewpoint for the current axes. The parameters @@ -93,3 +93,32 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1], [0,1]); +%! [az, el] = view; +%! assert ([az, el], [-37.5, 30], eps); +%! view (2); +%! [az, el] = view; +%! assert ([az, el], [0, 90], eps); +%! view ([1 1 0]); +%! [az, el] = view; +%! assert ([az, el], [135, 0], eps); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! line; +%! [az, el] = view; +%! assert ([az, el], [0, 90], eps); +%! view (3); +%! [az, el] = view; +%! assert ([az, el], [-37.5, 30], eps); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
new file mode 100644 --- /dev/null +++ b/scripts/plot/waitbar.m @@ -0,0 +1,184 @@ +## Copyright (C) 2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} waitbar (@var{frac}) +## @deftypefnx {Function File} {@var{h} =} waitbar (@var{frac}, @var{msg}) +## @deftypefnx {Function File} {@var{h} =} waitbar (@dots{}, "FigureProperty", "Value", @dots{}) +## @deftypefnx {Function File} {} waitbar (@var{frac}) +## @deftypefnx {Function File} {} waitbar (@var{frac}, @var{hwbar}) +## @deftypefnx {Function File} {} waitbar (@var{frac}, @var{hwbar}, @var{msg}) +## Return a handle @var{h} to a new waitbar object. The waitbar is +## filled to fraction @var{frac} which must be in the range [0, 1]. The +## optional message @var{msg} is centered and displayed above the waitbar. +## The appearance of the waitbar figure window can be configured by passing +## property/value pairs to the function. +## +## When called with a single input the current waitbar, if it exists, is +## updated to the new value @var{frac}. If there are multiple outstanding +## waitbars they can be updated individually by passing the handle @var{hwbar} +## of the specific waitbar to modify. +## @end deftypefn + +## Author: jwe + +function retval = waitbar (varargin) + + persistent curr_waitbar; + + if (nargin < 1) + print_usage (); + endif + + frac = varargin{1}; + varargin(1) = []; + + if (! (isnumeric (frac) && isscalar (frac) && frac >= 0 && frac <= 1)) + error ("waitbar: FRAC must be between 0 and 1"); + endif + + ## Use existing waitbar if it still points to a valid graphics handle. + if (nargin == 1 && ishandle (curr_waitbar)) + h = curr_waitbar; + else + h = false; + endif + + if (! isempty (varargin) && isnumeric (varargin{1})) + if (! ishandle (varargin{1})) + error ("waitbar: H must be a handle to a waitbar object"); + else + h = varargin{1}; + varargin(1) = []; + if (! isfigure (h) || ! strcmp (get (h, "tag"), "waitbar")) + error ("waitbar: H must be a handle to a waitbar object"); + endif + endif + endif + + msg = false; + + if (! isempty (varargin)) + msg = varargin{1}; + varargin(1) = []; + if (! (ischar (msg) || iscellstr (msg))) + error ("waitbar: MSG must be a character string or cell array of strings"); + endif + endif + + if (rem (numel (varargin), 2) != 0) + error ("waitbar: invalid number of property-value pairs"); + endif + + if (h) + p = findobj (h, "type", "patch"); + set (p, "xdata", [0; frac; frac; 0]); + ax = findobj (h, "type", "axes"); + if (ischar (msg) || iscellstr (msg)) + th = get (ax, "title"); + curr_msg = get (th, "string"); + cmp = strcmp (msg, curr_msg); + if (all (cmp(:))) + set (th, "string", msg); + endif + endif + else + h = __go_figure__ (NaN, "position", [250, 500, 400, 100], + "numbertitle", "off", + "toolbar", "none", "menubar", "none", + "integerhandle", "off", + "handlevisibility", "callback", + "tag", "waitbar", + varargin{:}); + + ax = axes ("parent", h, "xtick", [], "ytick", [], + "xlim", [0, 1], "ylim", [0, 1], + "xlimmode", "manual", "ylimmode", "manual", + "position", [0.1, 0.3, 0.8, 0.2]); + + patch (ax, [0; frac; frac; 0], [0; 0; 1; 1], [0, 0.35, 0.75]); + + if (! (ischar (msg) || iscellstr (msg))) + msg = "Please wait..."; + endif + title (ax, msg); + endif + + drawnow (); + + if (nargout > 0) + retval = h; + endif + + ## If there were no errors, update current waitbar. + curr_waitbar = h; + +endfunction + + +%!demo +%! h = waitbar (0, "0.00%"); +%! for i = 0:0.01:1 +%! waitbar (i, h, sprintf ("%.2f%%", 100*i)); +%! endfor +%! close (h); + +%!demo +%! h = waitbar (0, "please wait..."); +%! for i = 0:0.01:0.6 +%! waitbar (i); +%! endfor +%! i = 0.3; +%! waitbar (i, h, "don't you hate taking a step backward?") +%! pause (0.5); +%! for i = i:0.005:0.7 +%! waitbar (i, h); +%! endfor +%! waitbar (i, h, "or stalling?") +%! pause (1); +%! for i = i:0.003:0.8 +%! waitbar (i, h, "just a little longer now") +%! endfor +%! for i = i:0.001:1 +%! waitbar (i, h, "please don't be impatient") +%! endfor +%! close (h); + +%!demo +%! h1 = waitbar (0, "Waitbar #1"); +%! h2 = waitbar (0, "Waitbar #2"); +%! h2pos = get (h2, "position"); +%! h2pos(1) += h2pos(3) + 50; +%! set (h2, "position", h2pos); +%! pause (0.5); +%! for i = 1:4 +%! waitbar (i/4, h1); +%! pause (0.5); +%! waitbar (i/4, h2); +%! pause (0.5); +%! endfor +%! pause (0.5); +%! close (h1); +%! close (h2); + +%% Test input validation +%!error <FRAC must be between 0 and 1> waitbar (-0.5) +%!error <FRAC must be between 0 and 1> waitbar (1.5) +%!error <MSG must be a character string> waitbar (0.5, struct ()) +%!error <invalid number of property-value pairs> waitbar (0.5, "msg", "Name") +
--- a/scripts/plot/whitebg.m +++ b/scripts/plot/whitebg.m @@ -40,7 +40,7 @@ h = 0; color = NaN; - if (nargin > 0 && nargin < 2) + if (nargin > 0 && nargin < 3) if (ishandle (varargin{1})) h = varargin{1}; if (nargin == 2) @@ -74,7 +74,7 @@ if (isroot) fac = get (0, "factory"); fields = fieldnames (fac); - fieldindex = intersect (find (!cellfun (@isempty, regexp(fields, 'color'))), union (find (!cellfun (@isempty, regexp(fields, 'factoryaxes.*'))), find (!cellfun (@isempty, regexp(fields, 'factoryfigure.*'))))); + fieldindex = intersect (find (!cellfun ("isempty", regexp(fields, 'color'))), union (find (!cellfun ("isempty", regexp(fields, 'factoryaxes.*'))), find (!cellfun ("isempty", regexp(fields, 'factoryfigure.*'))))); ## Check whether the factory value has been replaced for nf = 1 : numel (fieldindex); @@ -104,7 +104,7 @@ for nh = 1 : numel(h) p = get (h (nh)); fields = fieldnames (p); - fieldindex = find (!cellfun (@isempty, regexp(fields, 'color'))); + fieldindex = find (!cellfun ("isempty", regexp(fields, 'color'))); if (numel (fieldindex)) for nf = 1 : numel (fieldindex); field = fields {fieldindex (nf)}; @@ -121,7 +121,7 @@ def = get (h (nh), "default"); fields = fieldnames (def); if (! isempty (fields)) - fieldindex = find (!cellfun (@isempty, regexp(fields, 'color'))); + fieldindex = find (!cellfun ("isempty", regexp(fields, 'color'))); for nf = 1 : numel (fieldindex) defaultfield = fields {fieldindex (nf)}; defaultvalue = 1 - subsref (def, struct ("type", ".", "subs", defaultfield)); @@ -143,3 +143,22 @@ endif endif endfunction + +%!test +%! dac = get (0, "defaultaxescolor"); +%! dfc = get (0, "defaultfigurecolor"); +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! assert (get (hf, "color"), dfc); +%! assert (get (gca, "color"), dac); +%! whitebg (hf); +%! assert (get (hf, "color"), 1 - dfc); +%! assert (get (gca, "color"), 1 - dac); +%! c = [0.2 0.2 0.2]; +%! whitebg (hf, c); +%! assert (get (hf, "color"), 1 - dfc); +%! assert (get (gca, "color"), c); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/xlabel.m +++ b/scripts/plot/xlabel.m @@ -23,10 +23,10 @@ ## @deftypefnx {Function File} {} ylabel (@dots{}) ## @deftypefnx {Function File} {} zlabel (@dots{}) ## Specify x-, y-, or z-axis labels for the current axis. If @var{h} is -## specified then label the axis defined by @var{h}. The optional return -## value @var{h} provides a handle to the created label. -## @seealso{plot, semilogx, semilogy, loglog, polar, mesh, contour, -## bar, stairs, title} +## specified then label the axis defined by @var{h}. +## +## The optional return value @var{h} is a graphics handle to the created object. +## @seealso{title, text} ## @end deftypefn ## Author: jwe @@ -39,17 +39,25 @@ print_usage (); endif - oldh = gca (); - unwind_protect - axes (h); - tmp = __axis_label__ ("xlabel", varargin{:}, - "color", get (h, "xcolor")); - unwind_protect_cleanup - axes (oldh); - end_unwind_protect + tmp = __axis_label__ (h, "xlabel", varargin{:}, + "color", get (h, "xcolor")); if (nargout > 0) retval = tmp; endif endfunction + + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! x = xlabel ("xlabel_string"); +%! assert (get (gca, "xlabel"), x); +%! assert (get (x, "type"), "text"); +%! assert (get (x, "visible"), "on"); +%! assert (get (x, "string"), "xlabel_string"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/xlim.m +++ b/scripts/plot/xlim.m @@ -44,3 +44,53 @@ retval = ret; endif endfunction + +%!demo +%! clf (); +%! line (); +%! xlim ([0.2, 0.8]); +%! title ("xlim is [0.2, 0.8]"); +%! assert (xlim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! line (); +%! xlim ('auto'); +%! title ("xlim is auto"); +%! assert (xlim ("mode"), "auto"); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! xlim ([0.2, 0.8]); +%! title ("xlim is [0.2, 0.8]"); +%! assert (xlim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! xlim ('auto'); +%! title ("xlim is auto"); +%! assert (xlim ("mode"), "auto"); + + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1], [0,1]); +%! xlim ([0, 1.1]); +%! assert (get (gca, "xlim"), [0, 1.1], eps); +%! assert (xlim ("mode"), "manual"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = plot3 ([0,1.1], [0,1], [0, 1]); +%! assert (get (gca, "xlim"), [0, 1.4], eps); +%! assert (xlim ("mode"), "auto"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/ylabel.m +++ b/scripts/plot/ylabel.m @@ -33,17 +33,25 @@ print_usage (); endif - oldh = gca (); - unwind_protect - axes (h); - tmp = __axis_label__ ("ylabel", varargin{:}, - "color", get (h, "ycolor")); - unwind_protect_cleanup - axes (oldh); - end_unwind_protect + tmp = __axis_label__ (h, "ylabel", varargin{:}, + "color", get (h, "ycolor")); if (nargout > 0) retval = tmp; endif endfunction + + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! y = ylabel ("ylabel_string"); +%! assert (get (gca, "ylabel"), y); +%! assert (get (y, "type"), "text"); +%! assert (get (y, "visible"), "on"); +%! assert (get (y, "string"), "ylabel_string"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/ylim.m +++ b/scripts/plot/ylim.m @@ -44,3 +44,53 @@ retval = ret; endif endfunction + +%!demo +%! clf (); +%! line (); +%! ylim ([0.2, 0.8]); +%! title ("ylim is [0.2, 0.8]"); +%! assert (ylim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! line (); +%! ylim ('auto'); +%! title ("ylim is auto"); +%! assert (ylim ("mode"), "auto"); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! ylim ([0.2, 0.8]); +%! title ("ylim is [0.2, 0.8]"); +%! assert (ylim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! ylim ('auto'); +%! title ("ylim is auto"); +%! assert (ylim ("mode"), "auto"); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! limy = [0, 1.1]; +%! plot3 ([0,1], [0,1], [0,1]); +%! ylim (limy); +%! assert (get (gca, "ylim"), limy, eps); +%! assert (ylim ("mode"), "manual"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1.1], [0, 1]); +%! assert (get (gca, "ylim"), [0, 1.4], eps); +%! assert (ylim ("mode"), "auto"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/zlabel.m +++ b/scripts/plot/zlabel.m @@ -33,17 +33,38 @@ print_usage (); endif - oldh = gca (); - unwind_protect - axes (h); - tmp = __axis_label__ ("zlabel", varargin{:}, - "color", get (h, "zcolor")); - unwind_protect_cleanup - axes (oldh); - end_unwind_protect + tmp = __axis_label__ (h, "zlabel", varargin{:}, + "color", get (h, "zcolor")); if (nargout > 0) retval = tmp; endif endfunction + + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! z = zlabel ("zlabel_string"); +%! assert (get (gca, "zlabel"), z); +%! assert (get (z, "type"), "text"); +%! assert (get (z, "visible"), "off"); +%! assert (get (z, "string"), "zlabel_string"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! plot3 (0, 0, 0); +%! unwind_protect +%! z = zlabel ("zlabel_string"); +%! assert (get (gca, "zlabel"), z); +%! assert (get (z, "type"), "text"); +%! assert (get (z, "visible"), "off"); +%! assert (get (z, "string"), "zlabel_string"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/zlim.m +++ b/scripts/plot/zlim.m @@ -44,3 +44,53 @@ retval = ret; endif endfunction + +%!demo +%! clf (); +%! line (); +%! zlim ([0.2, 0.8]); +%! title ("zlim is [0.2, 0.8]"); +%! assert (zlim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! line (); +%! zlim ('auto'); +%! title ("zlim is auto"); +%! assert (zlim ("mode"), "auto"); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! zlim ([0.2, 0.8]); +%! title ("zlim is [0.2, 0.8]"); +%! assert (zlim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! zlim ('auto'); +%! title ("zlim is auto"); +%! assert (zlim ("mode"), "auto"); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! limz = [0, 1.1]; +%! plot3 ([0,1], [0,1], [0,1]); +%! zlim (limz); +%! assert (get (gca, "zlim"), limz, eps); +%! assert (zlim ("mode"), "manual"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1], [0, 1.1]); +%! assert (get (gca, "zlim"), [0, 1.4], eps); +%! assert (zlim ("mode"), "auto"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/polynomial/compan.m +++ b/scripts/polynomial/compan.m @@ -51,8 +51,7 @@ ## @end ifnottex ## The eigenvalues of the companion matrix are equal to the roots of the ## polynomial. -## @seealso{poly, roots, residue, conv, deconv, polyval, polyderiv, -## polyint} +## @seealso{roots, poly, eig} ## @end deftypefn ## Author: Tony Richardson <arichard@stark.cc.oh.us>
--- a/scripts/polynomial/conv.m +++ b/scripts/polynomial/conv.m @@ -19,12 +19,12 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} conv (@var{a}, @var{b}) ## @deftypefnx {Function File} {} conv (@var{a}, @var{b}, @var{shape}) -## Convolve two vectors. +## Convolve two vectors @var{a} and @var{b}. ## -## @code{c = conv (@var{a}, @var{b})} returns a vector of length equal to +## The output convolution is a vector with length equal to ## @code{length (@var{a}) + length (@var{b}) - 1}. -## If @var{a} and @var{b} are the coefficient vectors of two polynomials, the -## returned value is the coefficient vector of the product polynomial. +## When @var{a} and @var{b} are the coefficient vectors of two polynomials, the +## convolution represents the coefficient vector of the product polynomial. ## ## The optional @var{shape} argument may be ## @@ -36,7 +36,7 @@ ## Return the central part of the convolution with the same size as @var{a}. ## @end table ## -## @seealso{deconv, fftconv, conv2, poly} +## @seealso{deconv, conv2, convn, fftconv} ## @end deftypefn ## Author: Tony Richardson <arichard@stark.cc.oh.us> @@ -50,7 +50,9 @@ endif if (! (isvector (a) && isvector (b))) - error ("conv: both arguments must be vectors"); + error ("conv: both arguments A and B must be vectors"); + elseif (nargin == 3 && ! any (strcmpi (shape, {"full", "same"}))) + error ('conv: SHAPE argument must be "full" or "same"'); endif la = length (a); @@ -60,40 +62,31 @@ if (ly == 0) y = zeros (1, 0); - else - ## Use the shortest vector as the coefficent vector to filter. - ## Preserve the row/column orientation of the longer input. - if (la <= lb) - if (ly > lb) - if (size (b, 1) <= size (b, 2)) - x = [b, (zeros (1, ly - lb))]; - else - x = [b; (zeros (ly - lb, 1))]; - endif - else - x = b; - endif - y = filter (a, 1, x); - else - if (ly > la) - if (size (a, 1) <= size (a, 2)) - x = [a, (zeros (1, ly - la))]; - else - x = [a; (zeros (ly - la, 1))]; - endif - else - x = a; - endif - y = filter (b, 1, x); - endif - if (strcmp (shape, "same")) - idx = ceil ((ly - la) / 2); - y = y(idx+1:idx+la); - endif + return; + endif + + ## Use shortest vector as the coefficent vector to filter. + if (la > lb) + [a, b] = deal (b, a); # Swap vectors + lb = la; + endif + x = b; + + ## Pad longer vector to convolution length. + if (ly > lb) + x(end+1:end+ly-lb) = 0; + endif + + y = filter (a, 1, x); + + if (strcmp (shape, "same")) + idx = ceil ((ly - la) / 2); + y = y(idx+1:idx+la); endif endfunction + %!test %! x = ones(3,1); %! y = ones(1,3); @@ -112,35 +105,37 @@ %!test %! a = 1:10; %! b = 1:3; -%! assert (size(conv(a,b)), [1, numel(a)+numel(b)-1]) -%! assert (size(conv(b,a)), [1, numel(a)+numel(b)-1]) +%! assert (size (conv(a,b)), [1, numel(a)+numel(b)-1]); +%! assert (size (conv(b,a)), [1, numel(a)+numel(b)-1]); +%!test %! a = (1:10).'; %! b = 1:3; -%! assert (size(conv(a,b)), [numel(a)+numel(b)-1, 1]) -%! assert (size(conv(b,a)), [numel(a)+numel(b)-1, 1]) +%! assert (size (conv(a,b)), [numel(a)+numel(b)-1, 1]); +%! assert (size (conv(b,a)), [numel(a)+numel(b)-1, 1]); %!test %! a = 1:10; %! b = (1:3).'; -%! assert (size(conv(a,b)), [1, numel(a)+numel(b)-1]) -%! assert (size(conv(b,a)), [1, numel(a)+numel(b)-1]) +%! assert (size (conv(a,b)), [1, numel(a)+numel(b)-1]); +%! assert (size (conv(b,a)), [1, numel(a)+numel(b)-1]); %!test %! a = 1:10; %! b = 1:3; -%! assert (conv(a,b,"full"), conv(a,b)) -%! assert (conv(b,a,"full"), conv(b,a)) +%! assert (conv (a,b,"full"), conv (a,b)); +%! assert (conv (b,a,"full"), conv (b,a)); %!test %! a = 1:10; %! b = 1:3; -%! assert (conv(a,b,'same'), [4, 10, 16, 22, 28, 34, 40, 46, 52, 47]) -%! assert (conv(b,a,'same'), [28, 34, 40]) +%! assert (conv (a,b,"same"), [4, 10, 16, 22, 28, 34, 40, 46, 52, 47]); +%! assert (conv (b,a,"same"), [28, 34, 40]); %% Test input validation -%!error conv (1); -%!error conv (1,2,3,4); -%!error conv ([1, 2; 3, 4], 3); -%!error conv (2, []); +%!error conv (1) +%!error conv (1,2,3,4) +%!error conv ([1, 2; 3, 4], 3) +%!error conv (3, [1, 2; 3, 4]) +%!error conv (2, 3, "XXXX")
--- a/scripts/polynomial/deconv.m +++ b/scripts/polynomial/deconv.m @@ -26,7 +26,7 @@ ## If @var{y} and @var{a} are polynomial coefficient vectors, @var{b} will ## contain the coefficients of the polynomial quotient and @var{r} will be ## a remainder polynomial of lowest order. -## @seealso{conv, poly, roots, residue, polyval, polyderiv, polyint} +## @seealso{conv, residue} ## @end deftypefn ## Author: Tony Richardson <arichard@stark.cc.oh.us>
--- a/scripts/polynomial/mkpp.m +++ b/scripts/polynomial/mkpp.m @@ -17,50 +17,66 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{pp} =} mkpp (@var{x}, @var{p}) -## @deftypefnx {Function File} {@var{pp} =} mkpp (@var{x}, @var{p}, @var{d}) +## @deftypefn {Function File} {@var{pp} =} mkpp (@var{breaks}, @var{coefs}) +## @deftypefnx {Function File} {@var{pp} =} mkpp (@var{breaks}, @var{coefs}, @var{d}) +## +## Construct a piecewise polynomial (pp) structure from sample points +## @var{breaks} and coefficients @var{coefs}. @var{breaks} must be a vector of +## strictly increasing values. The number of intervals is given by +## @code{@var{ni} = length (@var{breaks}) - 1}. +## When @var{m} is the polynomial order @var{coefs} must be of +## size: @var{ni} x @var{m} + 1. ## -## Construct a piecewise polynomial structure from sample points -## @var{x} and coefficients @var{p}. The i-th row of @var{p}, -## @code{@var{p} (@var{i},:)}, contains the coefficients for the polynomial -## over the @var{i}-th interval, ordered from highest to -## lowest. There must be one row for each interval in @var{x}, so -## @code{rows (@var{p}) == length (@var{x}) - 1}. +## The i-th row of @var{coefs}, +## @code{@var{coefs} (@var{i},:)}, contains the coefficients for the polynomial +## over the @var{i}-th interval, ordered from highest (@var{m}) to +## lowest (@var{0}). ## -## @var{p} may also be a multi-dimensional array, specifying a vector-valued -## or array-valued polynomial. The shape is determined by @var{d}. If @var{d} -## is -## not given, the default is @code{size (p)(1:end-2)}. If @var{d} is given, the -## leading dimensions of @var{p} are reshaped to conform to @var{d}. +## @var{coefs} may also be a multi-dimensional array, specifying a vector-valued +## or array-valued polynomial. In that case the polynomial order is defined +## by the length of the last dimension of @var{coefs}. +## The size of first dimension(s) are given by the scalar or +## vector @var{d}. If @var{d} is not given it is set to @code{1}. +## In any case @var{coefs} is reshaped to a 2-D matrix of +## size @code{[@var{ni}*prod(@var{d} @var{m})] } ## -## @seealso{unmkpp, ppval, spline} +## @seealso{unmkpp, ppval, spline, pchip, ppder, ppint, ppjumps} ## @end deftypefn function pp = mkpp (x, P, d) + + # check number of arguments if (nargin < 2 || nargin > 3) print_usage (); endif - pp.x = x(:); - n = length (x) - 1; - if (n < 1) + + # check x + if (length (x) < 2) error ("mkpp: at least one interval is needed"); endif - nd = ndims (P); - k = size (P, nd); - if (nargin < 3) - if (nd == 2) - d = 1; - else - d = prod (size (P)(1:nd-1)); - endif + + if (!isvector (x)) + error ("mkpp: x must be a vector"); endif - pp.d = d; - pp.P = P = reshape (P, prod (d), [], k); - pp.orient = 0; + + len = length (x) - 1; + dP = length (size (P)); - if (size (P, 2) != n) - error ("mkpp: num intervals in X doesn't match num polynomials in P"); + pp = struct ("form", "pp", + "breaks", x(:).', + "coefs", [], + "pieces", len, + "order", prod (size (P)) / len, + "dim", 1); + + if (nargin == 3) + pp.dim = d; + pp.order /= prod (d); endif + + dim_vec = [pp.pieces * prod(pp.dim), pp.order]; + pp.coefs = reshape (P, dim_vec); + endfunction %!demo # linear interpolation @@ -72,3 +88,25 @@ %! xi=linspace(0,pi,50); %! plot(x,t,"x",xi,ppval(pp,xi)); %! legend("control","interp"); + +%!shared b,c,pp +%! b = 1:3; c = 1:24; pp=mkpp(b,c); +%!assert (pp.pieces,2); +%!assert (pp.order,12); +%!assert (pp.dim,1); +%!assert (size(pp.coefs),[2,12]); +%! pp=mkpp(b,c,2); +%!assert (pp.pieces,2); +%!assert (pp.order,6); +%!assert (pp.dim,2); +%!assert (size(pp.coefs),[4,6]); +%! pp=mkpp(b,c,3); +%!assert (pp.pieces,2); +%!assert (pp.order,4); +%!assert (pp.dim,3); +%!assert (size(pp.coefs),[6,4]); +%! pp=mkpp(b,c,[2,3]); +%!assert (pp.pieces,2); +%!assert (pp.order,2); +%!assert (pp.dim,[2,3]); +%!assert (size(pp.coefs),[12,2]);
--- a/scripts/polynomial/module.mk +++ b/scripts/polynomial/module.mk @@ -10,7 +10,6 @@ polynomial/poly.m \ polynomial/polyaffine.m \ polynomial/polyder.m \ - polynomial/polyderiv.m \ polynomial/polyfit.m \ polynomial/polygcd.m \ polynomial/polyint.m \
--- a/scripts/polynomial/mpoles.m +++ b/scripts/polynomial/mpoles.m @@ -17,20 +17,21 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{multp}, @var{indx}] =} mpoles (@var{p}) -## @deftypefnx {Function File} {[@var{multp}, @var{indx}] =} mpoles (@var{p}, @var{tol}) -## @deftypefnx {Function File} {[@var{multp}, @var{indx}] =} mpoles (@var{p}, @var{tol}, @var{reorder}) -## Identify unique poles in @var{p} and associates their multiplicity, -## ordering them from largest to smallest. +## @deftypefn {Function File} {[@var{multp}, @var{idxp}] =} mpoles (@var{p}) +## @deftypefnx {Function File} {[@var{multp}, @var{idxp}] =} mpoles (@var{p}, @var{tol}) +## @deftypefnx {Function File} {[@var{multp}, @var{idxp}] =} mpoles (@var{p}, @var{tol}, @var{reorder}) +## Identify unique poles in @var{p} and their associated multiplicity. The +## output is ordered from largest pole to smallest pole. ## -## If the relative difference of the poles is less than @var{tol}, then +## If the relative difference of two poles is less than @var{tol} then ## they are considered to be multiples. The default value for @var{tol} ## is 0.001. ## ## If the optional parameter @var{reorder} is zero, poles are not sorted. ## -## The value @var{multp} is a vector specifying the multiplicity of the -## poles. @var{multp}(:) refers to multiplicity of @var{p}(@var{indx}(:)). +## The output @var{multp} is a vector specifying the multiplicity of the +## poles. @code{@var{multp}(n)} refers to the multiplicity of the Nth pole +## @code{@var{p}(@var{idxp}(n))}. ## ## For example: ## @@ -44,7 +45,7 @@ ## @end group ## @end example ## -## @seealso{poly, roots, conv, deconv, polyval, polyderiv, polyint, residue} +## @seealso{residue, poly, roots, conv, deconv} ## @end deftypefn ## Author: Ben Abbott <bpabbott@mac.com>
--- a/scripts/polynomial/pchip.m +++ b/scripts/polynomial/pchip.m @@ -19,16 +19,19 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{pp} =} pchip (@var{x}, @var{y}) ## @deftypefnx {Function File} {@var{yi} =} pchip (@var{x}, @var{y}, @var{xi}) +## Return the Piecewise Cubic Hermite Interpolating Polynomial (pchip) of +## points @var{x} and @var{y}. ## -## Piecewise Cubic Hermite interpolating polynomial. Called with two -## arguments, the piecewise polynomial @var{pp} is returned, that may -## later be used with @code{ppval} to evaluate the polynomial at -## specific points. +## If called with two arguments, return the piecewise polynomial @var{pp} +## that may be used with @code{ppval} to evaluate the polynomial at specific +## points. When called with a third input argument, @code{pchip} evaluates +## the pchip polynomial at the points @var{xi}. The third calling form is +## equivalent to @code{ppval (pchip (@var{x}, @var{y}), @var{xi})}. ## ## The variable @var{x} must be a strictly monotonic vector (either -## increasing or decreasing). While @var{y} can be either a vector or -## array. In the case where @var{y} is a vector, it must have a length -## of @var{n}. If @var{y} is an array, then the size of @var{y} must +## increasing or decreasing) of length @var{n}. @var{y} can be either a +## vector or array. If @var{y} is a vector then it must be the same length +## @var{n} as @var{x}. If @var{y} is an array then the size of @var{y} must ## have the form ## @tex ## $$[s_1, s_2, \cdots, s_k, n]$$ @@ -36,7 +39,7 @@ ## @ifnottex ## @code{[@var{s1}, @var{s2}, @dots{}, @var{sk}, @var{n}]} ## @end ifnottex -## The array is then reshaped internally to a matrix where the leading +## The array is reshaped internally to a matrix where the leading ## dimension is given by ## @tex ## $$s_1 s_2 \cdots s_k$$ @@ -44,14 +47,9 @@ ## @ifnottex ## @code{@var{s1} * @var{s2} * @dots{} * @var{sk}} ## @end ifnottex -## and each row in this matrix is then treated separately. Note that this -## is exactly the opposite treatment than @code{interp1} and is done -## for compatibility. -## -## Called with a third input argument, @code{pchip} evaluates the -## piecewise polynomial at the points @var{xi}. There is an equivalence -## between @code{ppval (pchip (@var{x}, @var{y}), @var{xi})} and -## @code{pchip (@var{x}, @var{y}, @var{xi})}. +## and each row of this matrix is then treated separately. Note that this +## is exactly opposite to @code{interp1} but is done for @sc{matlab} +## compatibility. ## ## @seealso{spline, ppval, mkpp, unmkpp} ## @end deftypefn @@ -73,15 +71,22 @@ print_usage (); endif + ## make row vector x = x(:).'; n = length (x); ## Check the size and shape of y if (isvector (y)) - y = y(:).'; + y = y(:).'; ##row vector szy = size (y); + if !(size_equal (x, y)) + error ("pchip: length of X and Y must match") + endif else szy = size (y); + if (n != szy(end)) + error ("pchip: length of X and last dimension of Y must match") + endif y = reshape (y, [prod(szy(1:end-1)), szy(end)]); endif @@ -94,16 +99,12 @@ error("pchip: X must be strictly monotonic"); endif - if (columns (y) != n) - error("pchip: size of X and Y must match"); - endif - - f1 = y(:,1:n-1); + f1 = y(:, 1:n-1); ## Compute derivatives. d = __pchip_deriv__ (x, y, 2); - d1 = d(:,1:n-1); - d2 = d(:,2:n); + d1 = d(:, 1:n-1); + d2 = d(:, 2:n); ## This is taken from SLATEC. h = diag (h); @@ -114,14 +115,12 @@ c3 = del1 + del2; c2 = -c3 - del1; c3 = c3 / h; - coeffs = cat (3, c3, c2, d1, f1); - pp = mkpp (x, coeffs, szy(1:end-1)); - if (nargin == 2) - ret = pp; - else - ret = ppval (pp, xi); + ret = mkpp (x, coeffs, szy(1:end-1)); + + if (nargin == 3) + ret = ppval (ret, xi); endif endfunction @@ -138,7 +137,7 @@ %! %------------------------------------------------------------------- %! % confirm that pchip agreed better to discontinuous data than spline -%!shared x,y +%!shared x,y,y2,pp,yi1,yi2,yi3 %! x = 0:8; %! y = [1, 1, 1, 1, 0.5, 0, 0, 0, 0]; %!assert (pchip(x,y,x), y); @@ -148,3 +147,23 @@ %!assert (isempty(pchip(x',y',[]))); %!assert (isempty(pchip(x,y,[]))); %!assert (pchip(x,[y;y],x), [pchip(x,y,x);pchip(x,y,x)]) +%!assert (pchip(x,[y;y],x'), [pchip(x,y,x);pchip(x,y,x)]) +%!assert (pchip(x',[y;y],x), [pchip(x,y,x);pchip(x,y,x)]) +%!assert (pchip(x',[y;y],x'), [pchip(x,y,x);pchip(x,y,x)]) +%!test +%! x=(0:8)*pi/4;y=[sin(x);cos(x)]; +%! y2(:,:,1)=y;y2(:,:,2)=y+1;y2(:,:,3)=y-1; +%! pp=pchip(x,shiftdim(y2,2)); +%! yi1=ppval(pp,(1:4)*pi/4); +%! yi2=ppval(pp,repmat((1:4)*pi/4,[5,1])); +%! yi3=ppval(pp,[pi/2,pi]); +%!assert(size(pp.coefs),[48,4]); +%!assert(pp.pieces,8); +%!assert(pp.order,4); +%!assert(pp.dim,[3,2]); +%!assert(ppval(pp,pi),[0,-1;1,0;-1,-2],1e-14); +%!assert(yi3(:,:,2),ppval(pp,pi),1e-14); +%!assert(yi3(:,:,1),[1,0;2,1;0,-1],1e-14); +%!assert(squeeze(yi1(1,2,:)),[1/sqrt(2); 0; -1/sqrt(2);-1],1e-14); +%!assert(size(yi2),[3,2,5,4]); +%!assert(squeeze(yi2(1,2,3,:)),[1/sqrt(2); 0; -1/sqrt(2);-1],1e-14);
--- a/scripts/polynomial/poly.m +++ b/scripts/polynomial/poly.m @@ -38,13 +38,12 @@ ## numerical performance the @code{eig} function should be used to compute ## eigenvalues. ## -## If @var{x} is a vector, @code{poly (@var{x})} is a vector of the coefficients -## of the polynomial whose roots are the elements of @var{x}. That is, -## if @var{c} is a polynomial, then the elements of -## @code{@var{d} = roots (poly (@var{c}))} are contained in @var{c}. -## The vectors @var{c} and @var{d} are not identical, however, due to sorting -## and numerical errors. -## @seealso{eig, roots} +## If @var{x} is a vector, @code{poly (@var{x})} is a vector of the +## coefficients of the polynomial whose roots are the elements of @var{x}. +## That is, if @var{c} is a polynomial, then the elements of @code{@var{d} = +## roots (poly (@var{c}))} are contained in @var{c}. The vectors @var{c} and +## @var{d} are not identical, however, due to sorting and numerical errors. +## @seealso{roots, eig} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at>
--- a/scripts/polynomial/polyaffine.m +++ b/scripts/polynomial/polyaffine.m @@ -27,7 +27,7 @@ ## g(x) = f((x-@var{mu}(1))/@var{mu}(2)). ## @end example ## -## @seealso{polyval} +## @seealso{polyval, polyfit} ## @end deftypefn @@ -70,25 +70,19 @@ endfunction +%!demo +%! f = [1/5 4/5 -7/5 -2]; +%! g = polyaffine (f, [1, 1.2]); +%! x = linspace (-4, 4, 100); +%! plot(x, polyval (f, x), x, polyval (g, x)); +%! legend ("original", "affine"); +%! axis ([-4 4 -3 5]); +%! grid ("on"); + %!test %! f = [1/5 4/5 -7/5 -2]; -%! %! mu = [1, 1.2]; -%! %! g = polyaffine (f, mu); -%! %! x = linspace (-4, 4, 100); -%! -%! assert (polyval(f, x, [], mu), polyval (g, x), 1e-10); +%! assert (polyval (f, x, [], mu), polyval (g, x), 1e-10); -%!demo -%! f = [1/5 4/5 -7/5 -2]; -%! -%! g = polyaffine (f, [1, 1.2]); -%! -%! x = linspace (-4, 4, 100); -%! -%! plot(x, polyval (f, x), x, polyval (g, x)); -%! -%! axis ([-4 4 -3 5]); -%! grid ("on");
--- a/scripts/polynomial/polyder.m +++ b/scripts/polynomial/polyder.m @@ -1,4 +1,4 @@ -## Copyright (C) 1995-2011 John W. Eaton +## Copyright (C) 1994-2011 John W. Eaton ## ## This file is part of Octave. ## @@ -17,27 +17,83 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} polyderiv (@var{p}) -## @deftypefnx {Function File} {[@var{k}] =} polyderiv (@var{a}, @var{b}) -## @deftypefnx {Function File} {[@var{q}, @var{d}] =} polyderiv (@var{b}, @var{a}) -## An alias for @code{polyderiv}. -## @seealso{polyderiv} +## @deftypefn {Function File} {} polyder (@var{p}) +## @deftypefnx {Function File} {[@var{k}] =} polyder (@var{a}, @var{b}) +## @deftypefnx {Function File} {[@var{q}, @var{d}] =} polyder (@var{b}, @var{a}) +## Return the coefficients of the derivative of the polynomial whose +## coefficients are given by the vector @var{p}. If a pair of polynomials +## is given, return the derivative of the product @math{@var{a}*@var{b}}. +## If two inputs and two outputs are given, return the derivative of the +## polynomial quotient @math{@var{b}/@var{a}}. The quotient numerator is +## in @var{q} and the denominator in @var{d}. +## @seealso{polyint, polyval, polyreduce} ## @end deftypefn -## Author: John W. Eaton +## Author: Tony Richardson <arichard@stark.cc.oh.us> +## Created: June 1994 +## Adapted-By: jwe function [q, d] = polyder (p, a) - if (nargin == 1) - q = polyderiv (p); - elseif (nargin == 2) - if (nargout == 2) - [q, d] = polyderiv (p, a); + if (nargin == 1 || nargin == 2) + if (! isvector (p)) + error ("polyder: argument must be a vector"); + endif + if (nargin == 2) + if (! isvector (a)) + error ("polyder: argument must be a vector"); + endif + if (nargout == 1) + ## derivative of p*a returns a single polynomial + q = polyder (conv (p, a)); + else + ## derivative of p/a returns numerator and denominator + d = conv (a, a); + if (numel (p) == 1) + q = -p * polyder (a); + elseif (numel (a) == 1) + q = a * polyder (p); + else + q = conv (polyder (p), a) - conv (p, polyder (a)); + q = polyreduce (q); + endif + + ## remove common factors from numerator and denominator + x = polygcd (q, d); + if (length(x) != 1) + q = deconv (q, x); + d = deconv (d, x); + endif + + ## move all the gain into the numerator + q = q/d(1); + d = d/d(1); + endif else - q = polyderiv (p, a); + lp = numel (p); + if (lp == 1) + q = 0; + return; + elseif (lp == 0) + q = []; + return; + endif + + ## Force P to be a row vector. + p = p(:).'; + + q = p(1:(lp-1)) .* [(lp-1):-1:1]; endif else print_usage (); endif endfunction + + +%!assert(all (all (polyder ([1, 2, 3]) == [2, 2]))); +%!assert(polyder (13) == 0); + +%!error polyder ([]); +%!error polyder ([1, 2; 3, 4]); +
--- a/scripts/polynomial/polyfit.m +++ b/scripts/polynomial/polyfit.m @@ -21,11 +21,12 @@ ## @deftypefnx {Function File} {[@var{p}, @var{s}] =} polyfit (@var{x}, @var{y}, @var{n}) ## @deftypefnx {Function File} {[@var{p}, @var{s}, @var{mu}] =} polyfit (@var{x}, @var{y}, @var{n}) ## Return the coefficients of a polynomial @var{p}(@var{x}) of degree -## @var{n} that minimizes the least-squares-error of the fit. +## @var{n} that minimizes the least-squares-error of the fit to the points +## @code{[@var{x}, @var{y}]}. ## ## The polynomial coefficients are returned in a row vector. ## -## The second output is a structure containing the following fields: +## The optional output @var{s} is a structure containing the following fields: ## ## @table @samp ## @item R @@ -53,7 +54,7 @@ ## Where @var{mu}(1) = mean (@var{x}), and @var{mu}(2) = std (@var{x}). ## This linear transformation of @var{x} improves the numerical ## stability of the fit. -## @seealso{polyval, residue} +## @seealso{polyval, polyaffine, roots, vander, zscore} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -76,8 +77,8 @@ error ("polyfit: X and Y must be vectors of the same size"); endif - if (! (isscalar (n) && n >= 0 && ! isinf (n) && n == round (n))) - error ("polyfit: N must be a nonnegative integer"); + if (! (isscalar (n) && n >= 0 && ! isinf (n) && n == fix (n))) + error ("polyfit: N must be a non-negative integer"); endif y_is_row_vector = (rows (y) == 1);
--- a/scripts/polynomial/polygcd.m +++ b/scripts/polynomial/polygcd.m @@ -23,12 +23,11 @@ ## Find the greatest common divisor of two polynomials. This is equivalent ## to the polynomial found by multiplying together all the common roots. ## Together with deconv, you can reduce a ratio of two polynomials. -## Tolerance defaults to @code{sqrt(eps)}. +## The tolerance @var{tol} defaults to @code{sqrt(eps)}. ## -## Note that this is a numerically unstable algorithm, and should not be used -## on large polynomials. +## @strong{Caution:} This is a numerically unstable algorithm and should not be used on large polynomials. ## -## Example: +## Example code: ## ## @example ## @group @@ -39,8 +38,7 @@ ## @result{} [ 0, 0, 0 ] ## @end group ## @end example -## @seealso{poly, polyint, polyderiv, polyreduce, roots, conv, deconv, -## residue, filter, polyval, polyvalm} +## @seealso{poly, roots, conv, deconv, residue} ## @end deftypefn function x = polygcd (b, a, tol) @@ -81,3 +79,24 @@ endif endfunction + + +%!test +%! poly1 = [1 6 11 6]; % (x+1)(x+2)(x+3) +%! poly2 = [1 3 2]; % (x+1)(x+2) +%! poly3 = polygcd (poly1, poly2); +%! assert (poly3, poly2, sqrt (eps)) + +%!test +%! assert (polygcd (poly(1:8), poly(3:12)), poly(3:8), sqrt (eps)) + +%!test +%! assert (deconv (poly(1:8), polygcd (poly(1:8), poly(3:12))), poly(1:2), sqrt (eps)) + +%!test +%! for ii=1:10 +%! p = (unique (randn (10, 1)) * 10).'; +%! p1 = p(3:end); +%! p2 = p(1:end-2); +%! assert (polygcd (poly (-p1), poly (-p2)), poly (- intersect (p1, p2)), sqrt (eps)) +%! endfor
--- a/scripts/polynomial/polyint.m +++ b/scripts/polynomial/polyint.m @@ -22,8 +22,7 @@ ## Return the coefficients of the integral of the polynomial whose ## coefficients are represented by the vector @var{p}. The variable ## @var{k} is the constant of integration, which by default is set to zero. -## @seealso{poly, polyderiv, polyreduce, roots, conv, deconv, residue, -## filter, polyval, polyvalm} +## @seealso{polyder, polyval} ## @end deftypefn ## Author: Tony Richardson <arichard@stark.cc.oh.us> @@ -61,3 +60,18 @@ retval = [(p ./ [lp:-1:1]), k]; endfunction + +%!test +%! A = [3, 2, 1]; +%! assert (polyint(A),polyint(A,0)); +%! assert (polyint(A),polyint(A')); +%! assert (polyint(A),[1, 1, 1, 0]); +%! assert (polyint(A,1),ones(1,4)); + +%!test +%! A = ones(1,8); +%! B = [length(A):-1:1]; +%! assert (polyint(A),[1./B, 0]); + +%!error polyint() +%!error polyint(ones(2,2))
--- a/scripts/polynomial/polyout.m +++ b/scripts/polynomial/polyout.m @@ -31,11 +31,9 @@ ## @end example ## ## @end ifnottex -## and return it as a string or write it to the screen (if -## @var{nargout} is zero). -## @var{x} defaults to the string @code{"s"}. -## @seealso{polyval, polyvalm, poly, roots, conv, deconv, residue, -## filter, polyderiv, polyint} +## and return it as a string or write it to the screen (if @var{nargout} is +## zero). @var{x} defaults to the string @code{"s"}. +## @seealso{polyreduce} ## @end deftypefn ## Author: A. S. Hodel <a.s.hodel@eng.auburn.edu> @@ -97,3 +95,9 @@ str = num2str (c, 5); endif endfunction + +%!assert (polyout ([3 2 1]), '3*s^2 + 2*s^1 + 1') +%!assert (polyout ([3 2 1], 'x'), '3*x^2 + 2*x^1 + 1') +%!assert (polyout ([3 2 1], 'wxyz'), '3*wxyz^2 + 2*wxyz^1 + 1') +%!assert (polyout ([5 4 3 2 1], '1'),'5*1^4 + 4*1^3 + 3*1^2 + 2*1^1 + 1') +%!error polyout ([])
--- a/scripts/polynomial/polyreduce.m +++ b/scripts/polynomial/polyreduce.m @@ -18,10 +18,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} polyreduce (@var{c}) -## Reduces a polynomial coefficient vector to a minimum number of terms by +## Reduce a polynomial coefficient vector to a minimum number of terms by ## stripping off any leading zeros. -## @seealso{poly, roots, conv, deconv, residue, filter, polyval, -## polyvalm, polyderiv, polyint} +## @seealso{polyout} ## @end deftypefn ## Author: Tony Richardson <arichard@stark.cc.oh.us>
--- a/scripts/polynomial/polyval.m +++ b/scripts/polynomial/polyval.m @@ -20,36 +20,38 @@ ## @deftypefn {Function File} {@var{y} =} polyval (@var{p}, @var{x}) ## @deftypefnx {Function File} {@var{y} =} polyval (@var{p}, @var{x}, [], @var{mu}) ## Evaluate the polynomial @var{p} at the specified values of @var{x}. When -## @var{mu} is present evaluate the polynomial for +## @var{mu} is present, evaluate the polynomial for ## (@var{x}-@var{mu}(1))/@var{mu}(2). ## If @var{x} is a vector or matrix, the polynomial is evaluated for each of ## the elements of @var{x}. +## ## @deftypefnx {Function File} {[@var{y}, @var{dy}] =} polyval (@var{p}, @var{x}, @var{s}) ## @deftypefnx {Function File} {[@var{y}, @var{dy}] =} polyval (@var{p}, @var{x}, @var{s}, @var{mu}) ## In addition to evaluating the polynomial, the second output ## represents the prediction interval, @var{y} +/- @var{dy}, which ## contains at least 50% of the future predictions. To calculate the ## prediction interval, the structured variable @var{s}, originating -## form `polyfit', must be present. -## @seealso{polyfit, polyvalm, poly, roots, conv, deconv, residue, filter, -## polyderiv, polyint} +## from @code{polyfit}, must be supplied. +## @seealso{polyvalm, polyaffine, polyfit, roots, poly} ## @end deftypefn ## Author: Tony Richardson <arichard@stark.cc.oh.us> ## Created: June 1994 ## Adapted-By: jwe -function [y, dy] = polyval (p, x, s, mu) +function [y, dy] = polyval (p, x, s = [], mu) if (nargin < 2 || nargin > 4 || (nargout == 2 && nargin < 3)) print_usage (); endif - if (nargin < 3) - s = []; - endif - - if (! (isvector (p) || isempty (p))) + if (isempty (x)) + y = []; + return; + elseif (isempty (p)) + y = zeros (size (x)); + return; + elseif (! isvector (p)) error ("polyval: first argument must be a vector"); endif @@ -57,16 +59,6 @@ x = (x - mu(1)) / mu(2); endif - if (isempty (x)) - y = []; - return; - endif - - if (length (p) == 0) - y = p; - return; - endif - n = length (p) - 1; y = p(1) * ones (size (x)); for i = 2:n+1 @@ -80,10 +72,23 @@ ## dy = t * sqrt (1 + sumsq (A/s.R, 2)) * s.normr / sqrt (s.df) ## If my inference is correct, then t must equal 1 for polyval. ## This is because finv (0.5, n, n) = 1.0 for any n. - k = numel (x); - A = (x(:) * ones (1, n+1)) .^ (ones (k, 1) * (n:-1:0)); - dy = sqrt (1 + sumsq (A/s.R, 2)) * s.normr / sqrt (s.df); - dy = reshape (dy, size (x)); + try + k = numel (x); + A = (x(:) * ones (1, n+1)) .^ (ones (k, 1) * (n:-1:0)); + dy = sqrt (1 + sumsq (A/s.R, 2)) * s.normr / sqrt (s.df); + dy = reshape (dy, size (x)); + catch + if (isempty (s)) + error ("polyval: third input is required.") + elseif (isstruct (s) + && all (ismember ({"R", "normr", "df"}, fieldnames (s)))) + error (lasterr ()) + elseif (isstruct (s)) + error ("polyval: third input is missing the required fields."); + else + error ("polyval: third input is not a structure."); + endif + end_try_catch endif endfunction @@ -142,3 +147,6 @@ %! assert (y, polyval(p,x), eps) %! x = reshape(x, [1, 1, 5, 2]); +%!assert (zeros (1, 10), polyval ([], 1:10)) +%!assert ([], polyval (1, [])) +%!assert ([], polyval ([], []))
--- a/scripts/polynomial/polyvalm.m +++ b/scripts/polynomial/polyvalm.m @@ -23,11 +23,10 @@ ## ## @code{polyvalm (@var{c}, @var{x})} will evaluate the polynomial in the ## matrix sense, i.e., matrix multiplication is used instead of element by -## element multiplication as is used in polyval. +## element multiplication as used in @code{polyval}. ## ## The argument @var{x} must be a square matrix. -## @seealso{polyval, poly, roots, conv, deconv, residue, filter, -## polyderiv, polyint} +## @seealso{polyval, roots, poly} ## @end deftypefn ## Author: Tony Richardson <arichard@stark.cc.oh.us>
--- a/scripts/polynomial/ppder.m +++ b/scripts/polynomial/ppder.m @@ -17,28 +17,54 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{ppd} =} ppder (@var{pp}) -## Compute the piecewise derivative of the piecewise polynomial struct @var{pp}. -## @seealso{mkpp,ppval,ppint} +## @deftypefn {Function File} {ppd =} ppder (pp) +## @deftypefnx {Function File} {ppd =} ppder (pp, m) +## Compute the piecewise @var{m}-th derivative of a piecewise polynomial +## struct @var{pp}. If @var{m} is omitted the first derivative is calculated. +## @seealso{mkpp, ppval, ppint} ## @end deftypefn -function ppd = ppder (pp) - if (nargin != 1) +function ppd = ppder (pp, m) + + if ((nargin < 1) || (nargin > 2)) print_usage (); + elseif (nargin == 1) + m = 1; endif - if (! isstruct (pp)) + + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) error ("ppder: PP must be a structure"); endif [x, p, n, k, d] = unmkpp (pp); - p = reshape (p, [], k); - if (k <= 1) - pd = zeros (rows (p), 1); - k = 1; + + if (k - m <= 0) + x = [x(1) x(end)]; + pd = zeros (prod (d), 1); else - k -= 1; - pd = p(:,1:k) * diag (k:-1:1); + f = k : -1 : 1; + ff = bincoeff (f, m + 1) .* factorial (m + 1) ./ f; + k -= m; + pd = p(:,1:k) * diag (ff(1:k)); endif + ppd = mkpp (x, pd, d); endfunction +%!shared x,y,pp,ppd +%! x=0:8;y=[x.^2;x.^3+1];pp=spline(x,y); +%! ppd=ppder(pp); +%!assert(ppval(ppd,x),[2*x;3*x.^2],1e-14) +%!assert(ppd.order,3) +%! ppd=ppder(pp,2); +%!assert(ppval(ppd,x),[2*ones(size(x));6*x],1e-14) +%!assert(ppd.order,2) +%! ppd=ppder(pp,3); +%!assert(ppd.order,1) +%!assert(ppd.pieces,8) +%!assert(size(ppd.coefs),[16,1]) +%! ppd=ppder(pp,4); +%!assert(ppd.order,1) +%!assert(ppd.pieces,1) +%!assert(size(ppd.coefs),[2,1]) +%!assert(ppval(ppd,x),zeros(size(y)),1e-14)
--- a/scripts/polynomial/ppint.m +++ b/scripts/polynomial/ppint.m @@ -21,14 +21,14 @@ ## @deftypefnx {Function File} {@var{ppi} =} ppint (@var{pp}, @var{c}) ## Compute the integral of the piecewise polynomial struct @var{pp}. ## @var{c}, if given, is the constant of integration. -## @seealso{mkpp,ppval,ppder} +## @seealso{mkpp, ppval, ppder} ## @end deftypefn function ppi = ppint (pp, c) if (nargin < 1 || nargin > 2) print_usage (); endif - if (! isstruct (pp)) + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) error ("ppint: PP must be a structure"); endif @@ -39,17 +39,20 @@ pi = p / diag (k:-1:1); k += 1; if (nargin == 1) - pi(:,k) = 0; + pi(:, k) = 0; else - pi(:,k) = repmat (c(:), n, 1); + pi(:, k) = repmat (c(:), n, 1); endif ppi = mkpp (x, pi, d); - ## Adjust constants so the the result is continuous. - - jumps = reshape (ppjumps (ppi), prod (d), n-1); - ppi.P(:,2:n,k) -= cumsum (jumps, 2); + tmp = -cumsum (ppjumps (ppi), length (d) + 1); + ppi.coefs(prod(d)+1:end, k) = tmp(:); endfunction +%!shared x,y,pp,ppi +%! x=0:8;y=[ones(size(x));x+1];pp=spline(x,y); +%! ppi=ppint(pp); +%!assert(ppval(ppi,x),[x;0.5*x.^2+x],1e-14) +%!assert(ppi.order,5)
--- a/scripts/polynomial/ppjumps.m +++ b/scripts/polynomial/ppjumps.m @@ -28,29 +28,57 @@ if (nargin != 1) print_usage (); endif - if (! isstruct (pp)) + + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) error ("ppjumps: PP must be a structure"); endif ## Extract info. - x = pp.x; - P = pp.P; - d = pp.d; - [nd, n, k] = size (P); + [x, P, n, k, d] = unmkpp(pp); + nd = length (d) + 1; ## Offsets. - dx = diff (x(1:n)).'; - dx = dx(ones (1, nd), :); # spread (do nothing in 1D) + dx = diff(x(1:n)); + dx = repmat (dx, [prod(d), 1]); + dx = reshape (dx, [d, n-1]); + dx = shiftdim (dx, nd - 1); - ## Use Horner scheme to get limits from the left. - llim = P(:,1:n-1,1); - for i = 2:k; + ## Use Horner scheme. + if (k>1) + llim = shiftdim (reshape (P(1:(n-1) * prod(d), 1), [d, n-1]), nd - 1); + endif + + for i = 2 : k; llim .*= dx; - llim += P(:,1:n-1,i); + llim += shiftdim (reshape (P(1:(n-1) * prod (d), i), [d, n-1]), nd - 1); endfor - rlim = P(:,2:n,k); # limits from the right - jumps = reshape (rlim - llim, [d, n-1]); - + rlim = shiftdim (ppval (pp, x(2:end-1)), nd - 1); + jumps = shiftdim (rlim - llim, 1); endfunction + +%!test +%! p = [1 6 11 6]; +%! x = linspace (5, 6, 4); +%! y = polyval (p, x); +%! pp = spline (x, y); +%! jj = ppjumps (pp); +%! assert (jj, [0 0], eps) + +%!test +%! +%! breaks = [0 1 2]; +%! pp1 = poly (-[1 2 3]); +%! pp2 = poly (-([1 2 3]+1)); +%! pp = mkpp (breaks, [pp1;pp2]); +%! assert (ppjumps (pp), 0, eps) + +%!test +%! +%! breaks = [0 1 2]; +%! pp1 = poly (-[1 2 3]); +%! pp2 = poly (([1 2 3]+1)); +%! pp = mkpp (breaks, [pp1;pp2]); +%! j = - 2 * polyval (pp1, 1); +%! assert (ppjumps (pp), j, eps)
--- a/scripts/polynomial/ppval.m +++ b/scripts/polynomial/ppval.m @@ -18,16 +18,13 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{yi} =} ppval (@var{pp}, @var{xi}) -## Evaluate piecewise polynomial @var{pp} at the points @var{xi}. -## If @var{pp} is scalar-valued, the result is an array of the same shape as -## @var{xi}. -## Otherwise, the size of the result is @code{[pp.d, length(@var{xi})]} if -## @var{xi} is a vector, or @code{[pp.d, size(@var{xi})]} if it is a -## multi-dimensional array. If pp.orient is 1, the dimensions are permuted as -## in interp1, to -## @code{[pp.d, length(@var{xi})]} and @code{[pp.d, size(@var{xi})]} -## respectively. -## @seealso{mkpp, unmkpp, spline} +## Evaluate the piecewise polynomial structure @var{pp} at the points @var{xi}. +## If @var{pp} describes a scalar polynomial function, the result is an +## array of the same shape as @var{xi}. +## Otherwise, the size of the result is @code{[pp.dim, length(@var{xi})]} if +## @var{xi} is a vector, or @code{[pp.dim, size(@var{xi})]} if it is a +## multi-dimensional array. +## @seealso{mkpp, unmkpp, spline, pchip} ## @end deftypefn function yi = ppval (pp, xi) @@ -35,48 +32,85 @@ if (nargin != 2) print_usage (); endif - if (! isstruct (pp)) - error ("ppval: PP must be a structure"); + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) + error ("ppval: first argument must be a pp-form structure"); endif ## Extract info. - x = pp.x; - P = pp.P; - d = pp.d; - k = size (P, 3); - nd = size (P, 1); + [x, P, n, k, d] = unmkpp (pp); - ## Determine resulting shape. - if (d == 1) # scalar case - yisz = size (xi); - elseif (isvector (xi)) # this is special - yisz = [d, length(xi)]; - else # general - yisz = [d, size(xi)]; + ## dimension checks + sxi = size (xi); + if (isvector (xi)) + xi = xi(:).'; endif + nd = length (d); + ## Determine intervals. - xi = xi(:); xn = numel (xi); + idx = lookup (x, xi, "lr"); - idx = lookup (x, xi, "lr"); + P = reshape (P, [d, n * k]); + P = shiftdim (P, nd); + P = reshape (P, [n, k, d]); + Pidx = P(idx(:), :);#2d matrix size x: coefs*prod(d) y: prod(sxi) + + if (isvector(xi)) + Pidx = reshape (Pidx, [xn, k, d]); + Pidx = shiftdim (Pidx, 1); + dimvec = [d, xn]; + else + Pidx = reshape (Pidx, [sxi, k, d]); + Pidx = shiftdim (Pidx, length (sxi)); + dimvec = [d, sxi]; + endif + ndv = length (dimvec); ## Offsets. - dx = (xi - x(idx)).'; - dx = dx(ones (1, nd), :); # spread (do nothing in 1D) + dx = (xi - x(idx)); + dx = repmat (dx, [prod(d), 1]); + dx = reshape (dx, dimvec); + dx = shiftdim (dx, ndv - 1); ## Use Horner scheme. - yi = P(:,idx,1); - for i = 2:k; + yi = Pidx; + if (k > 1) + yi = shiftdim (reshape (Pidx(1,:), dimvec), ndv - 1); + endif + + for i = 2 : k; yi .*= dx; - yi += P(:,idx,i); + yi += shiftdim (reshape (Pidx(i,:), dimvec), ndv - 1); endfor ## Adjust shape. - yi = reshape (yi, yisz); - if (d != 1 && pp.orient == 1) - ## Switch dimensions to match interp1 order. - yi = shiftdim (yi, length (d)); + if ((numel (xi) > 1) || (length (d) == 1)) + yi = reshape (shiftdim (yi, 1), dimvec); + endif + + if (isvector (xi) && (d == 1)) + yi = reshape (yi, sxi); + elseif (isfield (pp, "orient") && strcmp (pp.orient, "first")) + yi = shiftdim(yi, nd); endif + ## + #if (d == 1) + # yi = reshape (yi, sxi); + #endif + endfunction + +%!shared b,c,pp,pp2,xi,abserr +%! b = 1:3; c = ones(2); pp=mkpp(b,c);abserr = 1e-14;pp2=mkpp(b,[c;c],2); +%! xi = [1.1 1.3 1.9 2.1]; +%!assert (ppval(pp,1.1), 1.1, abserr); +%!assert (ppval(pp,2.1), 1.1, abserr); +%!assert (ppval(pp,xi), [1.1 1.3 1.9 1.1], abserr); +%!assert (ppval(pp,xi.'), [1.1 1.3 1.9 1.1].', abserr); +%!assert (ppval(pp2,1.1), [1.1;1.1], abserr); +%!assert (ppval(pp2,2.1), [1.1;1.1], abserr); +%!assert (ppval(pp2,xi), [1.1 1.3 1.9 1.1;1.1 1.3 1.9 1.1], abserr); +%!assert (ppval(pp2,xi'), [1.1 1.3 1.9 1.1;1.1 1.3 1.9 1.1], abserr); +%!assert (size(ppval(pp2,[xi;xi])), [2 2 4]);
--- a/scripts/polynomial/residue.m +++ b/scripts/polynomial/residue.m @@ -18,9 +18,11 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{r}, @var{p}, @var{k}, @var{e}] =} residue (@var{b}, @var{a}) -## Compute the partial fraction expansion for the quotient of the -## polynomials, @var{b} and @var{a}. +## @deftypefn {Function File} {[@var{r}, @var{p}, @var{k}, @var{e}] =} residue (@var{b}, @var{a}) +## @deftypefnx {Function File} {[@var{b}, @var{a}] =} residue (@var{r}, @var{p}, @var{k}) +## @deftypefnx {Function File} {[@var{b}, @var{a}] =} residue (@var{r}, @var{p}, @var{k}, @var{e}) +## The first calling form computes the partial fraction expansion for the +## quotient of the polynomials, @var{b} and @var{a}. ## @tex ## $$ ## {B(s)\over A(s)} = \sum_{m=1}^M {r_m\over (s-p_m)^e_m} @@ -77,12 +79,11 @@ ## ## @end ifnottex ## -## @deftypefnx {Function File} {[@var{b}, @var{a}] =} residue (@var{r}, @var{p}, @var{k}) -## @deftypefnx {Function File} {[@var{b}, @var{a}] =} residue (@var{r}, @var{p}, @var{k}, @var{e}) -## Compute the reconstituted quotient of polynomials, -## @var{b}(s)/@var{a}(s), from the partial fraction expansion; -## represented by the residues, poles, and a direct polynomial specified -## by @var{r}, @var{p} and @var{k}, and the pole multiplicity @var{e}. +## The second calling form performs the inverse operation and computes +## the reconstituted quotient of polynomials, @var{b}(s)/@var{a}(s), +## from the partial fraction expansion; represented by the residues, +## poles, and a direct polynomial specified by @var{r}, @var{p} and +## @var{k}, and the pole multiplicity @var{e}. ## ## If the multiplicity, @var{e}, is not explicitly specified the multiplicity is ## determined by the function @code{mpoles}. @@ -135,7 +136,7 @@ ## @end example ## ## @end ifnottex -## @seealso{poly, roots, conv, deconv, mpoles, polyval, polyderiv, polyint} +## @seealso{mpoles, poly, roots, conv, deconv} ## @end deftypefn ## Author: Tony Richardson <arichard@stark.cc.oh.us> @@ -409,3 +410,22 @@ %! [br, ar] = residue (r, p, k); %! assert ((abs (br - b) < 1e-12 %! && abs (ar - a) < 1e-12)); + +## The following test is due to Bernard Grung (bug #34266) +%!xtest +%! z1 = 7.0372976777e6; +%! p1 = -3.1415926536e9; +%! p2 = -4.9964813512e8; +%! r1 = -(1 + z1/p1)/(1 - p1/p2)/p2/p1; +%! r2 = -(1 + z1/p2)/(1 - p2/p1)/p2/p1; +%! r3 = (1 + (p2 + p1)/p2/p1*z1)/p2/p1; +%! r4 = z1/p2/p1; +%! r = [r1; r2; r3; r4]; +%! p = [p1; p2; 0; 0]; +%! k = []; +%! e = [1; 1; 1; 2]; +%! b = [1, z1]; +%! a = [1, -(p1 + p2), p1*p2, 0, 0]; +%! [br, ar] = residue (r, p, k, e); +%! assert (br, b, 1e-8); +%! assert (ar, a, 1e-8);
--- a/scripts/polynomial/roots.m +++ b/scripts/polynomial/roots.m @@ -50,7 +50,7 @@ ## @example ## @group ## c = [1, 0, -5]; -## roots(c) +## roots (c) ## @result{} 2.2361 ## @result{} -2.2361 ## @end group @@ -70,7 +70,7 @@ ## @ifnottex ## @math{+/- 2.2361}. ## @end ifnottex -## @seealso{compan} +## @seealso{poly, compan, fzero} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at>
--- a/scripts/polynomial/spline.m +++ b/scripts/polynomial/spline.m @@ -20,23 +20,22 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{pp} =} spline (@var{x}, @var{y}) ## @deftypefnx {Function File} {@var{yi} =} spline (@var{x}, @var{y}, @var{xi}) +## Return the cubic spline interpolant of points @var{x} and @var{y}. +## +## When called with two arguments, return the piecewise polynomial @var{pp} +## that may be used with @code{ppval} to evaluate the polynomial at specific +## points. When called with a third input argument, @code{spline} evaluates +## the spline at the points @var{xi}. The third calling form @code{spline +## (@var{x}, @var{y}, @var{xi})} is equivalent to @code{ppval (spline +## (@var{x}, @var{y}), @var{xi})}. ## -## Return the cubic spline interpolant of @var{y} at points @var{x}. -## If called with two arguments, @code{spline} returns the piecewise -## polynomial @var{pp} that may later be used with @code{ppval} to -## evaluate the polynomial at specific points. -## If called with a third input argument, @code{spline} evaluates the -## spline at the points @var{xi}. There is an equivalence -## between @code{ppval (spline (@var{x}, @var{y}), @var{xi})} and -## @code{spline (@var{x}, @var{y}, @var{xi})}. -## -## The variable @var{x} must be a vector of length @var{n}, and @var{y} -## can be either a vector or array. In the case where @var{y} is a -## vector, it can have a length of either @var{n} or @code{@var{n} + 2}. -## If the length of @var{y} is @var{n}, then the 'not-a-knot' end -## condition is used. If the length of @var{y} is @code{@var{n} + 2}, -## then the first and last values of the vector @var{y} are the values -## of the first derivative of the cubic spline at the end-points. +## The variable @var{x} must be a vector of length @var{n}. @var{y} can be +## either a vector or array. If @var{y} is a vector it must have a length of +## either @var{n} or @code{@var{n} + 2}. If the length of @var{y} is +## @var{n}, then the "not-a-knot" end condition is used. If the length of +## @var{y} is @code{@var{n} + 2}, then the first and last values of the +## vector @var{y} are the values of the first derivative of the cubic spline +## at the endpoints. ## ## If @var{y} is an array, then the size of @var{y} must have the form ## @tex @@ -52,7 +51,7 @@ ## @ifnottex ## @code{[@var{s1}, @var{s2}, @dots{}, @var{sk}, @var{n} + 2]}. ## @end ifnottex -## The array is then reshaped internally to a matrix where the leading +## The array is reshaped internally to a matrix where the leading ## dimension is given by ## @tex ## $$s_1 s_2 \cdots s_k$$ @@ -61,9 +60,10 @@ ## @code{@var{s1} * @var{s2} * @dots{} * @var{sk}} ## @end ifnottex ## and each row of this matrix is then treated separately. Note that this -## is exactly the opposite treatment than @code{interp1} and is done -## for compatibility. -## @seealso{ppval, mkpp, unmkpp} +## is exactly opposite to @code{interp1} but is done for @sc{matlab} +## compatibility. +## +## @seealso{pchip, ppval, mkpp, unmkpp} ## @end deftypefn ## This code is based on csape.m from octave-forge, but has been @@ -83,15 +83,15 @@ ## Check the size and shape of y ndy = ndims (y); szy = size (y); - if (ndy == 2 && (szy(1) == 1 || szy(2) == 1)) - if (szy(1) == 1) + if (ndy == 2 && (szy(1) == n || szy(2) == n)) + if (szy(2) == n) a = y.'; else a = y; szy = fliplr (szy); endif else - a = reshape (y, [prod(szy(1:end-1)), szy(end)]).'; + a = shiftdim (reshape (y, [prod(szy(1:end-1)), szy(end)]), 1); endif for k = (1:columns (a))(any (isnan (a))) @@ -120,9 +120,9 @@ if (n == 2) d = (dfs + dfe) / (x(2) - x(1)) ^ 2 + ... - 2 * (a(1,:) - a(2,:)) / (x(2) - x(1)) ^ 3; + 2 * (a(1,:) - a(2,:)) / (x(2) - x(1)) ^ 3; c = (-2 * dfs - dfe) / (x(2) - x(1)) - ... - 3 * (a(1,:) - a(2,:)) / (x(2) - x(1)) ^ 2; + 3 * (a(1,:) - a(2,:)) / (x(2) - x(1)) ^ 2; b = dfs; a = a(1,:); @@ -132,7 +132,7 @@ a = a(1:n-1,:); else if (n == 3) - dg = 1.5 * h(1) - 0.5 * h(2); + dg = 1.5 * h(1) - 0.5 * h(2); c(2:n-1,:) = 1/dg(1); else dg = 2 * (h(1:n-2) .+ h(2:n-1)); @@ -153,9 +153,9 @@ endif c(1,:) = (3 / h(1) * (a(2,:) - a(1,:)) - 3 * dfs - - c(2,:) * h(1)) / (2 * h(1)); + - c(2,:) * h(1)) / (2 * h(1)); c(n,:) = - (3 / h(n-1) * (a(n,:) - a(n-1,:)) - 3 * dfe - + c(n-1,:) * h(n-1)) / (2 * h(n-1)); + + c(n-1,:) * h(n-1)) / (2 * h(n-1)); b(1:n-1,:) = diff (a) ./ h(1:n-1, idx) ... - h(1:n-1,idx) / 3 .* (c(2:n,:) + 2 * c(1:n-1,:)); d = diff (c) ./ (3 * h(1:n-1, idx)); @@ -229,15 +229,14 @@ - h(1:n-1, idx) / 3 .* (c(2:n,:) + 2 * c(1:n-1,:)); d = diff (c) ./ (3 * h(1:n-1, idx)); - d = d(1:n-1,:); - c = c(1:n-1,:); - b = b(1:n-1,:); - a = a(1:n-1,:); + d = d(1:n-1,:);d = d.'(:); + c = c(1:n-1,:);c = c.'(:); + b = b(1:n-1,:);b = b.'(:); + a = a(1:n-1,:);a = a.'(:); endif endif - coeffs = cat (3, d.', c.', b.', a.'); - ret = mkpp (x, coeffs, szy(1:end-1)); + ret = mkpp (x, cat (2, d, c, b, a), szy(1:end-1)); if (nargin == 3) ret = ppval (ret, xi); @@ -263,6 +262,9 @@ %!assert (isempty(spline(x',y',[]))); %!assert (isempty(spline(x,y,[]))); %!assert (spline(x,[y;y],x), [spline(x,y,x);spline(x,y,x)],abserr) +%!assert (spline(x,[y;y],x'), [spline(x,y,x);spline(x,y,x)],abserr) +%!assert (spline(x',[y;y],x), [spline(x,y,x);spline(x,y,x)],abserr) +%!assert (spline(x',[y;y],x'), [spline(x,y,x);spline(x,y,x)],abserr) %! y = cos(x) + i*sin(x); %!assert (spline(x,y,x), y, abserr) %!assert (real(spline(x,y,x)), real(y), abserr);
--- a/scripts/polynomial/unmkpp.m +++ b/scripts/polynomial/unmkpp.m @@ -20,7 +20,7 @@ ## @deftypefn {Function File} {[@var{x}, @var{p}, @var{n}, @var{k}, @var{d}] =} unmkpp (@var{pp}) ## ## Extract the components of a piecewise polynomial structure @var{pp}. -## These are as follows: +## The components are: ## ## @table @asis ## @item @var{x} @@ -43,22 +43,41 @@ ## Number of polynomials defined for each interval. ## @end table ## -## @seealso{mkpp, ppval, spline} +## @seealso{mkpp, ppval, spline, pchip} ## @end deftypefn function [x, P, n, k, d] = unmkpp (pp) - if (nargin == 0) + + if (nargin != 1) print_usage (); endif - if (! isstruct (pp)) - error ("unmkpp: expecting piecewise polynomial structure"); + if (! (isstruct (pp) && isfield (pp, "form") && strcmp (pp.form, "pp"))) + error ("unmkpp: PP must be a piecewise polynomial structure"); endif - x = pp.x; - P = pp.P; - n = size (P, 2); - k = size (P, 3); - d = pp.d; - if (d == 1) - P = reshape (P, n, k); - endif + x = pp.breaks; + P = pp.coefs; + n = pp.pieces; + k = pp.order; + d = pp.dim; + endfunction + + +%!test +%! b = 1:3; +%! c = 1:24; +%! pp = mkpp (b,c); +%! [x, P, n, k, d] = unmkpp (pp); +%! assert (x, b); +%! assert (P, reshape (c, [2 12])); +%! assert (n, 2); +%! assert (k, 12); +%! assert (d, 1); + +%% Test input validation +%!error unmkpp () +%!error unmkpp (1,2) +%!error <piecewise polynomial structure> unmkpp (1) +%!error <piecewise polynomial structure> unmkpp (struct ("field1", "pp")) +%!error <piecewise polynomial structure> unmkpp (struct ("form", "not_a_pp")) +
new file mode 100644 --- /dev/null +++ b/scripts/prefs/addpref.m @@ -0,0 +1,74 @@ +## Copyright (C) 2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} addpref (@var{group}, @var{pref}, @var{val}) +## Add a preference @var{pref} and associated value @var{val} to the +## named preference group @var{group}. +## +## The named preference group must be a character string. +## +## The preference @var{pref} may be a character string or a cell array +## of character strings. The corresponding value @var{val} may be any +## value, or, if @var{pref} is a cell array of strings, @var{val} +## must be a cell array of values with the same size as @var{pref}. +## @seealso{setpref, getpref, ispref, rmpref} +## @end deftypefn + +## Author: jwe + +function addpref (group, pref, val) + + if (nargin == 3) + if (ischar (group)) + prefs = loadprefs (); + if (ischar (pref)) + if (isfield (group, pref)) + error ("preference %s already exists in group %s", pref, group); + else + prefs.(group).(pref) = val; + endif + elseif (iscellstr (pref)) + if (size_equal (pref, val)) + for i = 1:numel(pref) + if (isfield (group, pref{i})) + error ("preference %s already exists in group %s", + pref{i}, group); + else + prefs.(group).(pref{i}) = val; + endif + endfor + else + error ("size mismatch for pref and val"); + endif + else + error ("expecting pref to be a character string or cellstr"); + endif + saveprefs (prefs); + else + error ("expecting group to be a character string"); + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
new file mode 100644 --- /dev/null +++ b/scripts/prefs/getpref.m @@ -0,0 +1,95 @@ +## Copyright (C) 2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} getpref (@var{group}, @var{pref}, @var{default}) +## Return the preference value corresponding to the named preference +## @var{pref} in the preference group @var{group}. +## +## The named preference group must be a character string. +## +## If @var{pref} does not exist in @var{group} and @var{default} is +## specified, return @var{default}. +## +## The preference @var{pref} may be a character string or a cell array +## of character strings. The corresponding default value @var{default} +## may be any value, or, if @var{pref} is a cell array of strings, +## @var{default} must be a cell array of values with the same size as +## @var{pref}. +## +## If neither @var{pref} nor @var{default} are specified, return a +## structure of preferences for the preference group @var{group}. +## +## If no arguments are specified, return a structure containing all +## groups of preferences and their values. +## @seealso{addpref, setpref, ispref, rmpref} +## @end deftypefn + +## Author: jwe + +function retval = getpref (group, pref, default) + + if (nargin == 0) + retval = loadprefs (); + elseif (nargin == 1) + if (ischar (group)) + prefs = loadprefs (); + if (isfield (prefs, group)) + retval = prefs.(group); + else + retval = []; + endif + else + error ("expecting group to be a character string"); + endif + elseif (nargin == 2 || nargin == 3) + grp = getpref (group); + if (ischar (pref)) + if (isfield (grp, pref)) + retval = grp.(pref); + elseif (nargin == 3) + retval = default; + else + error ("preference %s does not exist in group %s", pref, group); + endif + elseif (iscellstr (pref)) + if (nargin == 2 || size_equal (pref, default)) + for i = 1:numel(pref) + if (isfield (grp, pref{i})) + retval.(pref) = grp.(pref{i}); + elseif (nargin == 3) + retval.(pref) = default{i}; + else + error ("preference %s does not exist in group %s", pref{i}, group); + endif + endfor + else + error ("size mismatch for pref and default"); + endif + else + error ("expecting pref to be a character string or cellstr"); + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
new file mode 100644 --- /dev/null +++ b/scripts/prefs/ispref.m @@ -0,0 +1,60 @@ +## Copyright (C) 2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} ispref (@var{group}, @var{pref}) +## Return true if the named preference @var{pref} exists in the +## preference group @var{group}. +## +## The named preference group must be a character string. +## +## The preference @var{pref} may be a character string or a cell array +## of character strings. +## +## If @var{pref} is not specified, return true if the preference +## group @var{group} exists. +## @seealso{getpref, addpref, setpref, rmpref} +## @end deftypefn + +## Author: jwe + +function retval = ispref (group, pref) + + if (nargin == 1) + retval = isfield (loadprefs (), group); + elseif (nargin == 2) + prefs = loadprefs (); + if (isfield (prefs, group)) + grp = prefs.(group); + if (ischar (pref) || iscellstr (pref)) + retval = isfield (grp, pref); + else + retval = false; + endif + else + retval = false; + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
new file mode 100644 --- /dev/null +++ b/scripts/prefs/module.mk @@ -0,0 +1,20 @@ +FCN_FILE_DIRS += prefs + +prefs_PRIVATE_FCN_FILES = \ + prefs/private/loadprefs.m \ + prefs/private/prefsfile.m \ + prefs/private/saveprefs.m + +prefs_FCN_FILES = \ + prefs/addpref.m \ + prefs/getpref.m \ + prefs/ispref.m \ + prefs/rmpref.m \ + prefs/setpref.m \ + $(prefs_PRIVATE_FCN_FILES) + +FCN_FILES += $(prefs_FCN_FILES) + +PKG_ADD_FILES += prefs/PKG_ADD + +DIRSTAMP_FILES += prefs/$(octave_dirstamp)
new file mode 100644 --- /dev/null +++ b/scripts/prefs/private/loadprefs.m @@ -0,0 +1,43 @@ +## Copyright (C) 2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} loadprefs () +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function retval = loadprefs () + + file = prefsfile (); + + s = stat (file); + + if (isstruct (s) && S_ISREG (s.mode)) + tmp = load (file); + retval= tmp.prefs; + else + retval = []; + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
new file mode 100644 --- /dev/null +++ b/scripts/prefs/private/prefsfile.m @@ -0,0 +1,53 @@ +## Copyright (C) 2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} prefsfile () +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function retval = prefsfile () + + retval = "~/.octave_prefs"; + + ## Transition users to new filename if necessary + ## FIXME: Delete before 3.6.0 release + oldname = tilde_expand ("~/.octave-prefs"); + if (exist (oldname, "file")) + newname = tilde_expand (retval); + if (exist (newname, "file")) + error (["Octave uses the file ~/.octave_prefs to store preferences.\n",... + " The old file name was ~/.octave-prefs.\n",... + " Both files exist."... + " User must manually delete one of the files.\n"]); + endif + status = movefile (oldname, newname); + if (! status) + error (["Octave uses the file ~/.octave_prefs to store preferences.\n", + " The old file name was ~/.octave-prefs.\n", + " User must manually rename the old file to the new name.\n"]); + endif + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
new file mode 100644 --- /dev/null +++ b/scripts/prefs/private/saveprefs.m @@ -0,0 +1,36 @@ +## Copyright (C) 2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} saveprefs () +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function retval = saveprefs (s) + + prefs = s; + + save (prefsfile (), "prefs"); + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
new file mode 100644 --- /dev/null +++ b/scripts/prefs/rmpref.m @@ -0,0 +1,61 @@ +## Copyright (C) 2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} rmpref (@var{group}, @var{pref}) +## Remove the named preference @var{pref} from the preference group +## @var{group}. +## +## The named preference group must be a character string. +## +## The preference @var{pref} may be a character string or a cell array +## of character strings. +## +## If @var{pref} is not specified, remove the preference group +## @var{group}. +## +## It is an error to remove a nonexistent preference or group. +## @seealso{addpref, ispref, setpref, getpref} +## @end deftypefn + +## Author: jwe + +function retval = rmpref (group, pref) + + prefs = loadprefs (); + + if (nargin == 1) + if (ischar (group)) + retval = isfield (prefs, group); + else + error ("expecting group to be a character array"); + endif + elseif (nargin == 2) + grp = getpref (group, pref); + if (ischar (pref) || iscellstr (pref)) + retval = isfield (grp, pref); + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
new file mode 100644 --- /dev/null +++ b/scripts/prefs/setpref.m @@ -0,0 +1,67 @@ +## Copyright (C) 2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} setpref (@var{group}, @var{pref}, @var{val}) +## Set a preference @var{pref} to the given @var{val} in the named +## preference group @var{group}. +## +## The named preference group must be a character string. +## +## The preference @var{pref} may be a character string or a cell array +## of character strings. The corresponding value @var{val} may be any +## value, or, if @var{pref} is a cell array of strings, @var{val} +## must be a cell array of values with the same size as @var{pref}. +## +## If the named preference or group does not exist, it is added. +## @seealso{addpref, getpref, ispref, rmpref} +## @end deftypefn + +## Author: jwe + +function setpref (group, pref, val) + + if (nargin == 3) + if (ischar (group)) + prefs = loadprefs (); + if (ischar (pref)) + prefs.(group).(pref) = val; + elseif (iscellstr (pref)) + if (size_equal (pref, val)) + for i = 1:numel(pref) + prefs.(group).(pref{i}) = val; + endfor + else + error ("size mismatch for pref and val"); + endif + else + error ("expecting pref to be a character string or cellstr"); + endif + saveprefs (prefs); + else + error ("expecting group to be a character string"); + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
--- a/scripts/set/ismember.m +++ b/scripts/set/ismember.m @@ -77,6 +77,14 @@ print_usage (); endif + ## lookup() does not handle logical values + if (islogical (A)) + A = uint8 (A); + endif + if (islogical (s)) + s = uint8 (s); + endif + [A, s] = validargs ("ismember", A, s, varargin{:}); if (nargin == 2)
--- a/scripts/set/powerset.m +++ b/scripts/set/powerset.m @@ -75,3 +75,9 @@ endif endfunction + + +%!test +%! c = sort (cellstr ({ [], [1], [2], [3], [1, 2], [1, 3], [2, 3], [1, 2, 3]})); +%! p = sort (cellstr (powerset ([1, 2, 3]))); +%! assert (p, c);
--- a/scripts/set/private/validargs.m +++ b/scripts/set/private/validargs.m @@ -37,12 +37,12 @@ elseif (nargin == 4) if (strcmpi (byrows_arg, "rows")) if (iscell (x) || iscell (y)) - error ("%s: cells not supported with ""rows"""); + error ('%s: cells not supported with "rows"', caller); elseif (! (ismatrix (x) && ismatrix (y))) error ("%s: input arguments must be arrays or cell arrays of strings", caller); else if (ndims (x) > 2 || ndims (y) > 2) - error ("%s: need 2-dimensional matrices for ""rows""", caller); + error ('%s: need 2-dimensional matrices for "rows"', caller); elseif (columns (x) != columns (y) && ! (isempty (x) || isempty (y))) error ("%s: number of columns must match", caller); endif
--- a/scripts/set/setxor.m +++ b/scripts/set/setxor.m @@ -4,14 +4,14 @@ ## 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 +## 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. +## 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 @@ -20,17 +20,16 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} setxor (@var{a}, @var{b}) ## @deftypefnx {Function File} {} setxor (@var{a}, @var{b}, 'rows') +## @deftypefnx {Function File} {[@var{c}, @var{ia}, @var{ib}] =} setxor (@var{a}, @var{b}) ## ## Return the elements exclusive to @var{a} or @var{b}, sorted in ascending ## order. If @var{a} and @var{b} are both column vectors return a column ## vector, otherwise return a row vector. ## @var{a}, @var{b} may be cell arrays of string(s). ## -## @deftypefnx {Function File} {[@var{c}, @var{ia}, @var{ib}] =} setxor (@var{a}, @var{b}) -## -## Return index vectors @var{ia} and @var{ib} such that @code{a(ia)} and -## @code{b(ib)} are -## disjoint sets whose union is @var{c}. +## With three output arguments, return index vectors @var{ia} and @var{ib} +## such that @code{a(ia)} and @code{b(ib)} are disjoint sets whose union +## is @var{c}. ## ## @seealso{unique, union, intersect, setdiff, ismember} ## @end deftypefn
--- a/scripts/signal/autoreg_matrix.m +++ b/scripts/signal/autoreg_matrix.m @@ -47,3 +47,16 @@ endfor endfunction + + +%!test +%! K=4; +%! A = zeros(1,K+1); +%! A(1) = 1; +%! B = eye(K+1); +%! B(:,1) = 1; +%! assert (autoreg_matrix(A,K),B); + +%!error autoreg_matrix() +%!error autoreg_matrix(1) +%!error autoreg_matrix(ones(4,1),5)
--- a/scripts/signal/bartlett.m +++ b/scripts/signal/bartlett.m @@ -34,7 +34,7 @@ print_usage (); endif - if (! (isscalar (m) && (m == round (m)) && (m > 0))) + if (! (isscalar (m) && (m == fix (m)) && (m > 0))) error ("bartlett: M has to be an integer > 0"); endif @@ -47,3 +47,17 @@ endif endfunction + +%!assert (bartlett (1), 1); +%!assert (bartlett (2), zeros (2,1)); +%!assert (bartlett (16), fliplr (bartlett (16))); +%!assert (bartlett (15), fliplr (bartlett (15))); +%!test +%! N = 9; +%! A = bartlett (N); +%! assert (A (ceil (N/2)), 1); + +%!error bartlett (); +%!error bartlett (0.5); +%!error bartlett (-1); +%!error bartlett (ones(1,4));
--- a/scripts/signal/blackman.m +++ b/scripts/signal/blackman.m @@ -33,7 +33,7 @@ print_usage (); endif - if (! (isscalar (m) && (m == round (m)) && (m > 0))) + if (! (isscalar (m) && (m == fix (m)) && (m > 0))) error ("blackman: M has to be an integer > 0"); endif @@ -46,3 +46,18 @@ endif endfunction + +%!assert (blackman (1), 1); +%!assert (blackman (2), zeros(2,1), 1e-6); +%!assert (blackman (16), fliplr (blackman (16))); +%!assert (blackman (15), fliplr (blackman (15))); +%!test +%! N = 9; +%! A = blackman (N); +%! assert (A (ceil (N/2)), 1, 1e-6); +%! assert ([A(1), A(length (A))], zeros (1, 2), 1e-6); + +%!error blackman (); +%!error blackman (0.5); +%!error blackman (-1); +%!error blackman (ones(1,4));
--- a/scripts/signal/detrend.m +++ b/scripts/signal/detrend.m @@ -45,7 +45,7 @@ p = 0; elseif (ischar (p) && strcmpi (p, "linear")) p = 1; - elseif (!isscalar (p) || p < 0 || p != round (p)) + elseif (!isscalar (p) || p < 0 || p != fix (p)) error ("detrend: second input argument must be 'constant', 'linear' or a positive integer"); endif else
--- a/scripts/signal/fftfilt.m +++ b/scripts/signal/fftfilt.m @@ -26,6 +26,7 @@ ## overlap-add method to filter @var{x} with @var{b} using an N-point FFT. ## ## If @var{x} is a matrix, filter each column of the matrix. +## @seealso{filter, filter2} ## @end deftypefn ## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> @@ -53,8 +54,12 @@ [r_x, c_x] = size (x); [r_b, c_b] = size (b); - if min ([r_b, c_b]) != 1 - error ("fftfilt: B should be a vector"); + if (! isvector (b)) + error ("fftfilt: B must be a vector"); + endif + + if (ndims (x) != 2) + error ("fftfilt: X must be a 1-D or 2-D array"); endif l_b = r_b * c_b; @@ -63,18 +68,18 @@ if (nargin == 2) ## Use FFT with the smallest power of 2 which is >= length (x) + ## length (b) - 1 as number of points ... - n = 2 ^ (ceil (log (r_x + l_b - 1) / log (2))); + n = 2 ^ nextpow2 (r_x + l_b - 1); B = fft (b, n); - y = ifft (fft (x, n) .* B(:,ones (1, c_x))); + y = ifft (fft (x, n) .* B(:, ones (1, c_x))); else ## Use overlap-add method ... if (! (isscalar (n))) error ("fftfilt: N has to be a scalar"); endif - n = 2 ^ (ceil (log (max ([n, l_b])) / log (2))); + n = 2 ^ nextpow2 (max ([n, l_b])); L = n - l_b + 1; B = fft (b, n); - B = B(:,ones (c_x,1)); + B = B(:, ones (c_x,1)); R = ceil (r_x / L); y = zeros (r_x, c_x); for r = 1:R; @@ -88,20 +93,59 @@ endfor endif - y = y(1:r_x,:); + y = y(1:r_x, :); if (transpose) y = y.'; endif - ## Final cleanups: if both x and b are real respectively integer, y - ## should also be + ## Final cleanups: If both x and b are real, y should be real. + ## If both x and b are integer, y should be integer. if (isreal (b) && isreal (x)) y = real (y); endif - if (! any (b - round (b))) - idx = !any (x - round (x)); - y(:,idx) = round (y(:,idx)); + if (! any (b - fix (b))) + idx = !any (x - fix (x)); + y(:, idx) = round (y(:, idx)); endif endfunction + + +%!shared b, x, r +%!test +%! b = [1 1]; +%! x = [1, zeros(1,9)]; +%! assert(fftfilt(b, x ), [1 1 0 0 0 0 0 0 0 0] , eps); +%! assert(fftfilt(b, x.'), [1 1 0 0 0 0 0 0 0 0].', eps); +%! assert(fftfilt(b.',x ), [1 1 0 0 0 0 0 0 0 0] , eps); +%! assert(fftfilt(b.',x.'), [1 1 0 0 0 0 0 0 0 0].', eps); + +%!test +%! r = sqrt(1/2) * (1+i); +%! b = b*r; +%! assert(fftfilt(b, x ), r*[1 1 0 0 0 0 0 0 0 0] , eps); +%! assert(fftfilt(b, r*x), r*r*[1 1 0 0 0 0 0 0 0 0], eps); +%! assert(fftfilt(b, x.'), r*[1 1 0 0 0 0 0 0 0 0].', eps); + +%!test +%! b = [1 1]; +%! x = zeros (10,3); x(1,1)=-1; x(1,2)=1; +%! y0 = zeros (10,3); y0(1:2,1)=-1; y0(1:2,2)=1; +%! y = fftfilt (b, x); +%! assert (y,y0); + +%!test +%! b = rand (10, 1); +%! x = rand (10, 1); +%! y0 = filter (b, 1, x); +%! y = filter (b, 1, x); +%! assert (y, y0); + +%% Test input validation +%!error fftfilt (1) +%!error fftfilt (1, 2, 3, 4) +%!error fftfilt (ones (2), 1) +%!error fftfilt (2, ones (3,3,3)) +%!error fftfilt (2, 1, ones (2)) +
--- a/scripts/signal/fftshift.m +++ b/scripts/signal/fftshift.m @@ -24,13 +24,16 @@ ## center of the vector or matrix. ## ## If @var{x} is a vector of @math{N} elements corresponding to @math{N} -## time samples spaced of @math{Dt} each, then @code{fftshift (fft -## (@var{x}))} corresponds to frequencies +## time samples spaced by @math{dt}, then +## @code{fftshift (fft (@var{x}))} corresponds to frequencies ## ## @example -## f = ((1:N) - ceil(N/2)) / N / Dt +## f = [ -(ceil((N-1)/2):-1:1)*df 0 (1:floor((N-1)/2))*df ] ## @end example ## +## @noindent +## where @nospell{@math{df}} = 1 / @math{dt}. +## ## If @var{x} is a matrix, the same holds for rows and columns. If ## @var{x} is an array, then the same holds along each dimension. ## @@ -44,23 +47,19 @@ function retval = fftshift (x, dim) - retval = 0; - if (nargin != 1 && nargin != 2) print_usage (); endif if (nargin == 2) - if (!isscalar (dim)) - error ("fftshift: dimension must be an integer scalar"); + if (! (isscalar (dim) && dim > 0 && dim == fix (dim))) + error ("fftshift: dimension DIM must be a positive integer"); endif nd = ndims (x); sz = size (x); sz2 = ceil (sz(dim) / 2); idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor + idx = repmat ({':'}, nd, 1); idx{dim} = [sz2+1:sz(dim), 1:sz2]; retval = x(idx{:}); else @@ -83,3 +82,50 @@ endif endfunction + + +%!test +%! x = [0:7]; +%! y = fftshift (x); +%! assert(y, [4 5 6 7 0 1 2 3]); +%! assert(fftshift (y), x); + +%!test +%! x = [0:6]; +%! y = fftshift (x); +%! assert(y, [4 5 6 0 1 2 3]); +%! assert(fftshift (y), [1 2 3 4 5 6 0]); + +%!test +%! x = [0:7]'; +%! y = fftshift (x); +%! assert(y, [4;5;6;7;0;1;2;3]); +%! assert(fftshift (y), x); + +%!test +%! x = [0:6]'; +%! y = fftshift (x); +%! assert(y, [4;5;6;0;1;2;3]); +%! assert(fftshift (y), [1;2;3;4;5;6;0]); + +%!test +%! x = [0:3]; +%! x = [x;2*x;3*x+1;4*x+1]; +%! y = fftshift (x); +%! assert(y, [[7 10 1 4];[9 13 1 5];[2 3 0 1];[4 6 0 2]]); +%! assert(fftshift (y), x); + +%!test +%! x = [0:3]; +%! x = [x;2*x;3*x+1;4*x+1]; +%! y = fftshift (x,1); +%! assert(y, [[1 4 7 10];[1 5 9 13];[0 1 2 3];[0 2 4 6]]); +%! assert(fftshift (y,1), x); + +%!test +%! x = [0:3]; +%! x = [x;2*x;3*x+1;4*x+1]; +%! y = fftshift (x,2); +%! assert(y, [[2 3 0 1];[4 6 0 2];[7 10 1 4];[9 13 1 5]]); +%! assert(fftshift (y,2), x); +
--- a/scripts/signal/hamming.m +++ b/scripts/signal/hamming.m @@ -33,7 +33,7 @@ print_usage (); endif - if (! (isscalar (m) && (m == round (m)) && (m > 0))) + if (! (isscalar (m) && (m == fix (m)) && (m > 0))) error ("hamming: M has to be an integer > 0"); endif @@ -45,3 +45,17 @@ endif endfunction + +%!assert (hamming (1), 1); +%!assert (hamming (2), (0.54 - 0.46)*ones(2,1)); +%!assert (hamming (16), fliplr (hamming (16))); +%!assert (hamming (15), fliplr (hamming (15))); +%!test +%! N = 15; +%! A = hamming (N); +%! assert (A (ceil (N/2)), 1); + +%!error hamming (); +%!error hamming (0.5); +%!error hamming (-1); +%!error hamming (ones(1,4));
--- a/scripts/signal/hanning.m +++ b/scripts/signal/hanning.m @@ -33,7 +33,7 @@ print_usage (); endif - if (! (isscalar (m) && (m == round (m)) && (m > 0))) + if (! (isscalar (m) && (m == fix (m)) && (m > 0))) error ("hanning: M has to be an integer > 0"); endif @@ -45,3 +45,17 @@ endif endfunction + +%!assert (hanning (1), 1); +%!assert (hanning (2), zeros(2,1)); +%!assert (hanning (16), fliplr (hanning (16))); +%!assert (hanning (15), fliplr (hanning (15))); +%!test +%! N = 15; +%! A = hanning (N); +%! assert (A (ceil (N/2)), 1); + +%!error hanning (); +%!error hanning (0.5); +%!error hanning (-1); +%!error hanning (ones(1,4));
--- a/scripts/signal/ifftshift.m +++ b/scripts/signal/ifftshift.m @@ -45,17 +45,14 @@ nd = ndims (x); sz = size (x); sz2 = floor (sz(dim) / 2); - idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor + idx = repmat ({':'}, nd, 1); idx{dim} = [sz2+1:sz(dim), 1:sz2]; retval = x(idx{:}); else if (isvector (x)) - x = length (x); - xx = floor (x/2); - retval = x([xx+1:x, 1:xx]); + xl = length (x); + xx = floor (xl/2); + retval = x([xx+1:xl, 1:xx]); elseif (ismatrix (x)) nd = ndims (x); sz = size (x); @@ -71,3 +68,49 @@ endif endfunction + +%!test +%! x = [0:7]; +%! y = ifftshift (x); +%! assert(y, [4 5 6 7 0 1 2 3]); +%! assert(ifftshift (y), x); + +%!test +%! x = [0:6]; +%! y = ifftshift (x); +%! assert(y, [3 4 5 6 0 1 2]); +%! assert(ifftshift (y), [6 0 1 2 3 4 5]); + +%!test +%! x = [0:7]'; +%! y = ifftshift (x); +%! assert(y, [4;5;6;7;0;1;2;3]); +%! assert(ifftshift (y), x); + +%!test +%! x = [0:6]'; +%! y = ifftshift (x); +%! assert(y, [3;4;5;6;0;1;2]); +%! assert(ifftshift (y), [6;0;1;2;3;4;5]); + +%!test +%! x = [0:3]; +%! x = [x;2*x;3*x+1;4*x+1]; +%! y = ifftshift (x); +%! assert(y, [[7 10 1 4];[9 13 1 5];[2 3 0 1];[4 6 0 2]]); +%! assert(ifftshift (y), x); + +%!test +%! x = [0:3]; +%! x = [x;2*x;3*x+1;4*x+1]; +%! y = ifftshift (x,1); +%! assert(y, [[1 4 7 10];[1 5 9 13];[0 1 2 3];[0 2 4 6]]); +%! assert(ifftshift (y,1), x); + +%!test +%! x = [0:3]; +%! x = [x;2*x;3*x+1;4*x+1]; +%! y = ifftshift (x,2); +%! assert(y, [[2 3 0 1];[4 6 0 2];[7 10 1 4];[9 13 1 5]]); +%! assert(ifftshift (y,2), x); +
--- a/scripts/signal/module.mk +++ b/scripts/signal/module.mk @@ -1,5 +1,11 @@ FCN_FILE_DIRS += signal +signal_PRIVATE_FCN_FILES = \ + signal/private/rectangle_lw.m \ + signal/private/rectangle_sw.m \ + signal/private/triangle_lw.m \ + signal/private/triangle_sw.m + signal_FCN_FILES = \ signal/arch_fit.m \ signal/arch_rnd.m \ @@ -23,8 +29,6 @@ signal/hurst.m \ signal/ifftshift.m \ signal/periodogram.m \ - signal/rectangle_lw.m \ - signal/rectangle_sw.m \ signal/sinc.m \ signal/sinetone.m \ signal/sinewave.m \ @@ -33,10 +37,9 @@ signal/spencer.m \ signal/stft.m \ signal/synthesis.m \ - signal/triangle_lw.m \ - signal/triangle_sw.m \ signal/unwrap.m \ - signal/yulewalker.m + signal/yulewalker.m \ + $(signal_PRIVATE_FCN_FILES) FCN_FILES += $(signal_FCN_FILES)
--- a/scripts/signal/periodogram.m +++ b/scripts/signal/periodogram.m @@ -46,7 +46,7 @@ ## ## @item range: "@nospell{onesided}" computes spectrum from [0..nfft/2+1]. ## "@nospell{twosided}" computes spectrum from [0..nfft-1]. These strings -## can appear at any position in the list input arguments after window. +## can appear at any position in the list input arguments after window. ## ## @item Pxx: one-, or two-sided power spectrum. ##
--- a/scripts/signal/sinc.m +++ b/scripts/signal/sinc.m @@ -45,3 +45,10 @@ endif endfunction + + +%!assert (sinc (0), 1); +%!assert (sinc (1), 0,1e-6); +%!assert (sinc (1/2), 2/pi, 1e-6) + +%!error sinc()
--- a/scripts/signal/sinewave.m +++ b/scripts/signal/sinewave.m @@ -43,3 +43,13 @@ endif endfunction + +%!assert (sinewave (1), 0); +%!assert (sinewave (1, 4, 1), 1); +%!assert (sinewave (1, 12, 1), 1/2, 1e-6); +%!assert (sinewave (1, 12, 2), sqrt (3)/2, 1e-6); +%!assert (sinewave (1, 20, 1), (sqrt (5)-1)/4, 1e-6); +%!assert (sinewave (1), sinewave (1, 1,0)); +%!assert (sinewave (3, 4), sinewave(3, 4, 0)); + +%!error sinewave ();
--- a/scripts/signal/unwrap.m +++ b/scripts/signal/unwrap.m @@ -55,11 +55,8 @@ error ("unwrap: DIM must be an integer and a valid dimension"); endif else - ## Find the first non-singleton dimension - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); endif rng = 2*pi; @@ -74,17 +71,14 @@ ## Take first order difference to see so that wraps will show up ## as large values, and the sign will show direction. - idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor + idx = repmat ({':'}, nd, 1); idx{dim} = [1,1:m-1]; d = x(idx{:}) - x; - ## Find only the peaks, and multiply them by the range so that there - ## are kronecker deltas at each wrap point multiplied by the range - ## value. - p = rng * (((d > tol) > 0) - ((d < -tol) > 0)); + ## Find only the peaks, and multiply them by the appropriate amount + ## of ranges so that there are kronecker deltas at each wrap point + ## multiplied by the appropriate amount of range values. + p = ceil(abs(d)./rng) .* rng .* (((d > tol) > 0) - ((d < -tol) > 0)); ## Now need to "integrate" this so that the deltas become steps. r = cumsum (p, dim); @@ -95,7 +89,7 @@ endfunction -%!function t = xassert(a,b,tol) +%!function t = __xassert(a,b,tol) %! if (nargin == 1) %! t = all(a(:)); %! else @@ -110,6 +104,7 @@ %! t = 1; %! endif %! endif +%!endfunction %! %!test %! @@ -120,18 +115,42 @@ %! w = r - 2*pi*floor((r+pi)/(2*pi)); # wrapped into [-pi,pi] %! tol = 1e3*eps; # maximum expected deviation %! -%! t(++i) = xassert(r, unwrap(w), tol); #unwrap single row -%! t(++i) = xassert(r', unwrap(w'), tol); #unwrap single column -%! t(++i) = xassert([r',r'], unwrap([w',w']), tol); #unwrap 2 columns -%! t(++i) = xassert([r;r], unwrap([w;w],[],2), tol); #verify that dim works -%! t(++i) = xassert(r+10, unwrap(10+w), tol); #verify that r(1)>pi works +%! t(++i) = __xassert(r, unwrap(w), tol); #unwrap single row +%! t(++i) = __xassert(r', unwrap(w'), tol); #unwrap single column +%! t(++i) = __xassert([r',r'], unwrap([w',w']), tol); #unwrap 2 columns +%! t(++i) = __xassert([r;r], unwrap([w;w],[],2), tol); #check that dim works +%! t(++i) = __xassert(r+10, unwrap(10+w), tol); #check r(1)>pi works %! -%! t(++i) = xassert(w', unwrap(w',[],2)); #unwrap col by rows should not change it -%! t(++i) = xassert(w, unwrap(w,[],1)); #unwrap row by cols should not change it -%! t(++i) = xassert([w;w], unwrap([w;w])); #unwrap 2 rows by cols should not change them +%! t(++i) = __xassert(w', unwrap(w',[],2)); #unwrap col by rows should not change it +%! t(++i) = __xassert(w, unwrap(w,[],1)); #unwrap row by cols should not change it +%! t(++i) = __xassert([w;w], unwrap([w;w])); #unwrap 2 rows by cols should not change them %! %! ## verify that setting tolerance too low will cause bad results. -%! t(++i) = xassert(any(abs(r - unwrap(w,0.8)) > 100)); +%! t(++i) = __xassert(any(abs(r - unwrap(w,0.8)) > 100)); %! %! assert(all(t)); - +%! +%!test +%! A = [pi*(-4), pi*(-2+1/6), pi/4, pi*(2+1/3), pi*(4+1/2), pi*(8+2/3), pi*(16+1), pi*(32+3/2), pi*64]; +%! assert (unwrap(A), unwrap(A, pi)); +%! assert (unwrap(A, pi), unwrap(A, pi, 2)); +%! assert (unwrap(A', pi), unwrap(A', pi, 1)); +%! +%!test +%! A = [pi*(-4); pi*(2+1/3); pi*(16+1)]; +%! B = [pi*(-2+1/6); pi*(4+1/2); pi*(32+3/2)]; +%! C = [pi/4; pi*(8+2/3); pi*64]; +%! D = [pi*(-2+1/6); pi*(2+1/3); pi*(8+2/3)]; +%! E(:, :, 1) = [A, B, C, D]; +%! E(:, :, 2) = [A+B, B+C, C+D, D+A]; +%! F(:, :, 1) = [unwrap(A), unwrap(B), unwrap(C), unwrap(D)]; +%! F(:, :, 2) = [unwrap(A+B), unwrap(B+C), unwrap(C+D), unwrap(D+A)]; +%! assert (unwrap(E), F); +%! +%!test +%! A = [0, 2*pi, 4*pi, 8*pi, 16*pi, 65536*pi]; +%! B = [pi*(-2+1/6), pi/4, pi*(2+1/3), pi*(4+1/2), pi*(8+2/3), pi*(16+1), pi*(32+3/2), pi*64]; +%! assert (unwrap(A), zeros(1, length(A))); +%! assert (diff(unwrap(B), 1)<2*pi, true(1, length(B)-1)); +%! +%!error unwrap()
new file mode 100644 --- /dev/null +++ b/scripts/sparse/bicg.m @@ -0,0 +1,262 @@ +## Copyright (C) 2006 Sylvain Pelissier <sylvain.pelissier@gmail.com> +## Copyright (C) 2011 Carlo de Falco +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## +## @deftypefn {Function File} {@var{x} =} bicg (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) +## @deftypefnx {Function File} {@var{x} =} bicg (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{P}) +## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}] =} bicg (@var{A}, @var{b}, @dots{}) +## Solve @code{A x = b} using the Bi-conjugate gradient iterative method. +## +## @itemize @minus +## @item @var{rtol} is the relative tolerance, if not given +## or set to [] the default value 1e-6 is used. +## +## @item @var{maxit} the maximum number of outer iterations, +## if not given or set to [] the default value +## @code{min (20, numel (b))} is used. +## +## @item @var{x0} the initial guess, if not given or set to [] +## the default value @code{zeros (size (b))} is used. +## @end itemize +## +## @var{A} can be passed as a matrix or as a function handle or +## inline function @code{f} such that @code{f(x, "notransp") = A*x} +## and @code{f(x, "transp") = A'*x}. +## +## The preconditioner @var{P} is given as @code{P = M1 * M2}. +## Both @var{M1} and @var{M2} can be passed as a matrix or as +## a function handle or inline function @code{g} such that +## @code{g(x, 'notransp') = M1 \ x} or @code{g(x, 'notransp') = M2 \ x} and +## @code{g(x, 'transp') = M1' \ x} or @code{g(x, 'transp') = M2' \ x}. +## +## If called with more than one output parameter +## +## @itemize @minus +## @item @var{flag} indicates the exit status: +## @itemize @minus +## @item 0: iteration converged to the within the chosen tolerance +## +## @item 1: the maximum number of iterations was reached before convergence +## +## @item 3: the algorithm reached stagnation +## @end itemize +## (the value 2 is unused but skipped for compatibility). +## +## @item @var{relres} is the final value of the relative residual. +## +## @item @var{iter} is the number of iterations performed. +## +## @item @var{resvec} is a vector containing the relative residual at each iteration. +## @end itemize +## +## @seealso{bicgstab, cgs, gmres, pcg} +## +## @end deftypefn + + +function [x, flag, res1, k, resvec] = bicg (A, b, tol, maxit, M1, M2, x0) + + if (nargin >= 2 && isvector (full (b))) + + if (ischar (A)) + fun = str2func (A); + Ax = @(x) feval (fun, x, "notransp"); + Atx = @(x) feval (fun, x, "transp"); + elseif (ismatrix (A)) + Ax = @(x) A * x; + Atx = @(x) A' * x; + elseif (isa (A, "function_handle")) + Ax = @(x) feval (A, x, "notransp"); + Atx = @(x) feval (A, x, "transp"); + else + error (["bicg: first argument is expected to " ... + "be a function or a square matrix"]); + endif + + if (nargin < 3 || isempty (tol)) + tol = 1e-6; + endif + + if (nargin < 4 || isempty (maxit)) + maxit = min (rows (b), 20); + endif + + if (nargin < 5 || isempty (M1)) + M1m1x = @(x, ignore) x; + M1tm1x = M1m1x; + elseif (ischar (M1)) + fun = str2func (M1); + M1m1x = @(x) feval (fun, x, "notransp"); + M1tm1x = @(x) feval (fun, x, "transp"); + elseif (ismatrix (M1)) + M1m1x = @(x) M1 \ x; + M1tm1x = @(x) M1' \ x; + elseif (isa (M1, "function_handle")) + M1m1x = @(x) feval (M1, x, "notransp"); + M1tm1x = @(x) feval (M1, x, "transp"); + else + error (["bicg: preconditioner is expected to " ... + "be a function or matrix"]); + endif + + if (nargin < 6 || isempty (M2)) + M2m1x = @(x, ignore) x; + M2tm1x = M2m1x; + elseif (ischar (M2)) + fun = str2func (M2); + M2m1x = @(x) feval (fun, x, "notransp"); + M2tm1x = @(x) feval (fun, x, "transp"); + elseif (ismatrix (M2)) + M2m1x = @(x) M2 \ x; + M2tm1x = @(x) M2' \ x; + elseif (isa (M2, "function_handle")) + M2m1x = @(x) feval (M2, x, "notransp"); + M2tm1x = @(x) feval (M2, x, "transp"); + else + error (["bicg: preconditioner is expected to " ... + "be a function or matrix"]); + endif + + Pm1x = @(x) M2m1x (M1m1x (x)); + Ptm1x = @(x) M1tm1x (M2tm1x (x)); + + if (nargin < 7 || isempty (x0)) + x0 = zeros (size (b)); + endif + + y = x = x0; + c = b; + + r0 = b - Ax (x); + s0 = c - Atx (y); + + d = Pm1x (r0); + f = Ptm1x (s0); + + bnorm = norm (b); + res0 = Inf; + + if (any (r0 != 0)) + + for k = 1:maxit + + a = (s0' * Pm1x (r0)) ./ (f' * Ax (d)); + + x += a * d; + y += conj (a) * f; + + r1 = r0 - a * Ax (d); + s1 = s0 - conj (a) * Atx (f); + + beta = (s1' * Pm1x (r1)) ./ (s0' * Pm1x (r0)); + + d = Pm1x (r1) + beta * d; + f = Ptm1x (s1) + conj (beta) * f; + + r0 = r1; + s0 = s1; + + res1 = norm (b - Ax (x)) / bnorm; + if (res1 < tol) + flag = 0; + if (nargout < 2) + printf ("bicg converged at iteration %i ", k); + printf ("to a solution with relative residual %e\n", res1); + endif + break; + endif + + if (res0 <= res1) + flag = 3; + printf ("bicg stopped at iteration %i ", k); + printf ("without converging to the desired tolerance %e\n", tol); + printf ("because the method stagnated.\n"); + printf ("The iterate returned (number %i) ", k-1); + printf ("has relative residual %e\n", res0); + break + endif + res0 = res1; + if (nargout > 4) + resvec(k) = res0; + endif + endfor + + if (k == maxit) + flag = 1; + printf ("bicg stopped at iteration %i ", maxit); + printf ("without converging to the desired tolerance %e\n", tol); + printf ("because the maximum number of iterations was reached. "); + printf ("The iterate returned (number %i) has ", maxit); + printf ("relative residual %e\n", res1); + endif + + else + flag = 0; + if (nargout < 2) + printf ("bicg converged after 0 interations\n"); + endif + endif + + else + print_usage (); + endif + +endfunction; + + +%!test +%! n = 100; +%! A = spdiags ([-2*ones(n,1) 4*ones(n,1) -ones(n,1)], -1:1, n, n); +%! b = sum (A, 2); +%! tol = 1e-8; +%! maxit = 15; +%! M1 = spdiags ([ones(n,1)/(-2) ones(n,1)],-1:0, n, n); +%! M2 = spdiags ([4*ones(n,1) -ones(n,1)], 0:1, n, n); +%! [x, flag, relres, iter, resvec] = bicg (A, b, tol, maxit, M1, M2); +%! assert (x, ones (size (b)), 1e-7); +%! + +%!function y = afun (x, t, a) +%! switch t +%! case "notransp" +%! y = a * x; +%! case "transp" +%! y = a' * x; +%! endswitch +%!endfunction +%! +%!test +%! n = 100; +%! A = spdiags ([-2*ones(n,1) 4*ones(n,1) -ones(n,1)], -1:1, n, n); +%! b = sum (A, 2); +%! tol = 1e-8; +%! maxit = 15; +%! M1 = spdiags ([ones(n,1)/(-2) ones(n,1)],-1:0, n, n); +%! M2 = spdiags ([4*ones(n,1) -ones(n,1)], 0:1, n, n); +%! +%! [x, flag, relres, iter, resvec] = bicg (@(x, t) afun (x, t, A), +%! b, tol, maxit, M1, M2); +%! assert (x, ones (size (b)), 1e-7); + +%!test +%! n = 100; +%! tol = 1e-8; +%! a = sprand (n, n, .1); +%! A = a' * a + 100 * eye (n); +%! b = sum (A, 2); +%! [x, flag, relres, iter, resvec] = bicg (A, b, tol, [], diag (diag (A))); +%! assert (x, ones (size (b)), 1e-7);
--- a/scripts/sparse/bicgstab.m +++ b/scripts/sparse/bicgstab.m @@ -1,4 +1,5 @@ ## Copyright (C) 2008-2011 Radek Salac +## Copyright (C) 2011 Carlo de Falco ## ## This file is part of Octave. ## @@ -17,155 +18,190 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} bicgstab (@var{A}, @var{b}) -## @deftypefnx {Function File} {} bicgstab (@var{A}, @var{b}, @var{tol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) -## This procedure attempts to solve a system of linear equations A*x = b for x. -## The @var{A} must be square, symmetric and positive definite real matrix N*N. -## The @var{b} must be a one column vector with a length of N. -## The @var{tol} specifies the tolerance of the method, the default value is -## 1e-6. -## The @var{maxit} specifies the maximum number of iterations, the default value -## is min(20,N). -## The @var{M1} specifies a preconditioner, can also be a function handler which -## returns M\X. -## The @var{M2} combined with @var{M1} defines preconditioner as -## preconditioner=M1*M2. -## The @var{x0} is the initial guess, the default value is zeros(N,1). +## +## @deftypefn {Function File} {@var{x} =} bicgstab (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) +## @deftypefnx {Function File} {@var{x} =} bicgstab (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{P}) +## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}] =} bicgstab (@var{A}, @var{b}, @dots{}) +## Solve @code{A x = b} using the stabilizied Bi-conjugate gradient iterative +## method. +## +## @itemize @minus +## @item @var{rtol} is the relative tolerance, if not given or set to +## [] the default value 1e-6 is used. +## +## @item @var{maxit} the maximum number of outer iterations, if not +## given or set to [] the default value @code{min (20, numel (b))} is +## used. +## +## @item @var{x0} the initial guess, if not given or set to [] the +## default value @code{zeros (size (b))} is used. +## @end itemize +## +## @var{A} can be passed as a matrix or as a function handle or +## inline function @code{f} such that @code{f(x) = A*x}. ## -## The value @var{x} is a computed result of this procedure. -## The value @var{flag} can be 0 when we reach tolerance in @var{maxit} -## iterations, 1 when -## we don't reach tolerance in @var{maxit} iterations and 3 when the procedure -## stagnates. -## The value @var{relres} is a relative residual - norm(b-A*x)/norm(b). -## The value @var{iter} is an iteration number in which x was computed. -## The value @var{resvec} is a vector of @var{relres} for each iteration. +## The preconditioner @var{P} is given as @code{P = M1 * M2}. +## Both @var{M1} and @var{M2} can be passed as a matrix or as a function +## handle or inline function @code{g} such that @code{g(x) = M1 \ x} or +## @code{g(x) = M2 \ x}. +## +## If called with more than one output parameter +## +## @itemize @minus +## @item @var{flag} indicates the exit status: +## @itemize @minus +## @item 0: iteration converged to the within the chosen tolerance +## +## @item 1: the maximum number of iterations was reached before convergence +## +## @item 3: the algorithm reached stagnation +## @end itemize +## (the value 2 is unused but skipped for compatibility). +## +## @item @var{relres} is the final value of the relative residual. +## +## @item @var{iter} is the number of iterations performed. +## +## @item @var{resvec} is a vector containing the relative residual at each iteration. +## @end itemize +## +## @seealso{bicg, cgs, gmres, pcg} ## ## @end deftypefn -function [x, flag, relres, iter, resvec] = bicgstab (A, b, tol, maxit, M1, M2, x0) +function [x, flag, relres, iter, resvec] = bicgstab (A, b, tol, maxit, + M1, M2, x0) + + if (nargin >= 2 && nargin <= 7 && isvector (full (b))) - if (nargin < 2 || nargin > 7 || nargout > 5) - print_usage (); - elseif (!(isnumeric (A) && issquare (A))) - error ("bicgstab: A must be a square numeric matrix"); - elseif (!isvector (b)) - error ("bicgstab: B must be a vector"); - elseif (!any (b)) - error ("bicgstab: B must not be a vector of all zeros"); - elseif (rows (A) != rows (b)) - error ("bicgstab: A and B must have the same number of rows"); - elseif (nargin > 2 && !isscalar (tol)) - error ("bicgstab: TOL must be a scalar"); - elseif (nargin > 3 && !isscalar (maxit)) - error ("bicgstab: MAXIT must be a scalar"); - elseif (nargin > 4 && ismatrix (M1) && (rows (M1) != rows (A) || columns (M1) != columns (A))) - error ("bicgstab: M1 must have the same number of rows and columns as A"); - elseif (nargin > 5 && (!ismatrix (M2) || rows (M2) != rows (A) || columns (M2) != columns (A))) - error ("bicgstab: M2 must have the same number of rows and columns as A"); - elseif (nargin > 6 && !isvector (x0)) - error ("bicgstab: X0 must be a vector"); - elseif (nargin > 6 && rows (x0) != rows (b)) - error ("bicgstab: X0 must have the same number of rows as B"); - endif + if (ischar (A)) + A = str2func (A); + elseif (ismatrix (A)) + Ax = @(x) A * x; + elseif (isa (A, "function_handle")) + Ax = @(x) feval (A, x); + else + error (["bicgstab: first argument is expected " ... + "to be a function or a square matrix"]); + endif - ## Default tolerance. - if (nargin < 3) - tol = 1e-6; - endif + if (nargin < 3 || isempty (tol)) + tol = 1e-6; + endif - ## Default maximum number of iteration. - if (nargin < 4) - maxit = min (rows (b), 20); - endif + if (nargin < 4 || isempty (maxit)) + maxit = min (rows (b), 20); + endif - ## Left preconditioner. - if (nargin == 5) - if (isnumeric (M1)) - precon = @(x) M1 \ x; + if (nargin < 5 || isempty (M1)) + M1m1x = @(x) x; + elseif (ischar (M1)) + M1m1x = str2func (M1); + elseif (ismatrix (M1)) + M1m1x = @(x) M1 \ x; + elseif (isa (M1, "function_handle")) + M1m1x = @(x) feval (M1, x); + else + error (["bicgstab: preconditioner is " ... + "expected to be a function or matrix"]); endif - elseif (nargin > 5) - if (issparse (M1) && issparse (M2)) - precon = @(x) M2 \ (M1 \ x); - else - M = M1*M2; - precon = @(x) M \ x; - endif - else - precon = @(x) x; - endif - ## specifies initial estimate x0 - if (nargin < 7) - x = zeros (rows (b), 1); - else - x = x0; - endif - - norm_b = norm (b); - - res = b - A*x; - rr = res; + if (nargin < 6 || isempty (M2)) + M2m1x = @(x) x; + elseif (ischar (M2)) + M2m1x = str2func (M2); + elseif (ismatrix (M2)) + M2m1x = @(x) M2 \ x; + elseif (isa (M2, "function_handle")) + M2m1x = @(x) feval (M2, x); + else + error (["bicgstab: preconditioner is "... + "expected to be a function or matrix"]); + endif - ## Vector of the residual norms for each iteration. - resvec = [norm(res)/norm_b]; + precon = @(x) M2m1x (M1m1x (x)); - ## Default behaviour we don't reach tolerance tol within maxit iterations. - flag = 1; + if (nargin < 7 || isempty (x0)) + x0 = zeros (size (b)); + endif - for iter = 1:maxit - rho_1 = res' * rr; - - if (iter == 1) - p = res; + ## specifies initial estimate x0 + if (nargin < 7) + x = zeros (rows (b), 1); else - beta = (rho_1 / rho_2) * (alpha / omega); - p = res + beta * (p - omega * v); + x = x0; endif - phat = precon (p); + norm_b = norm (b); + + res = b - Ax (x); + rr = res; - v = A * phat; - alpha = rho_1 / (rr' * v); - s = res - alpha * v; + ## Vector of the residual norms for each iteration. + resvec = norm(res) / norm_b; - shat = precon (s); + ## Default behaviour we don't reach tolerance tol within maxit iterations. + flag = 1; + + for iter = 1:maxit + rho_1 = res' * rr; - t = A * shat; - omega = (t' * s) / (t' * t); - x = x + alpha * phat + omega * shat; - res = s - omega * t; - rho_2 = rho_1; + if (iter == 1) + p = res; + else + beta = (rho_1 / rho_2) * (alpha / omega); + p = res + beta * (p - omega * v); + endif + + phat = precon (p); - relres = norm (res) / norm_b; - resvec = [resvec; relres]; + v = Ax (phat); + alpha = rho_1 / (rr' * v); + s = res - alpha * v; + + shat = precon (s); + + t = Ax (shat); + omega = (t' * s) / (t' * t); + x = x + alpha * phat + omega * shat; + res = s - omega * t; + rho_2 = rho_1; - if (relres <= tol) - ## We reach tolerance tol within maxit iterations. - flag = 0; - break; - elseif (resvec (end) == resvec (end - 1)) - ## The method stagnates. - flag = 3; - break; - endif - endfor + relres = norm (res) / norm_b; + resvec = [resvec; relres]; + + if (relres <= tol) + ## We reach tolerance tol within maxit iterations. + flag = 0; + break; + elseif (resvec(end) == resvec(end - 1)) + ## The method stagnates. + flag = 3; + break; + endif + endfor - if (nargout < 2) - if (flag == 0) - printf (["bicgstab converged at iteration %i ", - "to a solution with relative residual %e\n"],iter,relres); - elseif (flag == 3) - printf (["bicgstab stopped at iteration %i ", - "without converging to the desired tolerance %e\n", - "because the method stagnated.\n", - "The iterate returned (number %i) has relative residual %e\n"],iter,tol,iter,relres); - else - printf (["bicgstab stopped at iteration %i ", - "without converging to the desired toleranc %e\n", - "because the maximum number of iterations was reached.\n", - "The iterate returned (number %i) has relative residual %e\n"],iter,tol,iter,relres); + if (nargout < 2) + if (flag == 0) + printf ("bicgstab converged at iteration %i ", iter); + printf ("to a solution with relative residual %e\n", relres); + elseif (flag == 3) + printf ("bicgstab stopped at iteration %i ", iter); + printf ("without converging to the desired tolerance %e\n", tol); + printf ("because the method stagnated.\n"); + printf ("The iterate returned (number %i) ", iter); + printf ("has relative residual %e\n", relres); + else + printf ("bicgstab stopped at iteration %i ", iter); + printf ("without converging to the desired toleranc %e\n", tol); + printf ("because the maximum number of iterations was reached.\n"); + printf ("The iterate returned (number %i) ", iter); + printf ("has relative residual %e\n", relres); + endif endif + + else + print_usage (); endif endfunction @@ -176,3 +212,36 @@ %! b = [7;-1;4] %! [x, flag, relres, iter, resvec] = bicgstab(A, b) +%!shared A, b, n, M1, M2 +%! +%!test +%! n = 100; +%! A = spdiags ([-2*ones(n,1) 4*ones(n,1) -ones(n,1)], -1:1, n, n); +%! b = sum (A, 2); +%! tol = 1e-8; +%! maxit = 15; +%! M1 = spdiags ([ones(n,1)/(-2) ones(n,1)],-1:0, n, n); +%! M2 = spdiags ([4*ones(n,1) -ones(n,1)], 0:1, n, n); +%! [x, flag, relres, iter, resvec] = bicgstab (A, b, tol, maxit, M1, M2); +%! assert (x, ones (size (b)), 1e-7); +%! +%!test +%!function y = afun (x, a) +%! y = a * x; +%!endfunction +%! +%! tol = 1e-8; +%! maxit = 15; +%! +%! [x, flag, relres, iter, resvec] = bicgstab (@(x) afun (x, A), b, +%! tol, maxit, M1, M2); +%! assert (x, ones (size (b)), 1e-7); + +%!test +%! n = 100; +%! tol = 1e-8; +%! a = sprand (n, n, .1); +%! A = a'*a + 100 * eye (n); +%! b = sum (A, 2); +%! [x, flag, relres, iter, resvec] = bicgstab (A, b, tol, [], diag (diag (A))); +%! assert (x, ones (size (b)), 1e-7);
--- a/scripts/sparse/cgs.m +++ b/scripts/sparse/cgs.m @@ -1,4 +1,5 @@ ## Copyright (C) 2008-2011 Radek Salac +## Copyright (C) 2011 Carlo de Falco ## ## This file is part of Octave. ## @@ -17,134 +18,172 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} cgs (@var{A}, @var{b}) -## @deftypefnx {Function File} {} cgs (@var{A}, @var{b}, @var{tol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) -## This procedure attempts to solve a system of linear equations A*x = b for x. -## The @var{A} must be square, symmetric and positive definite real matrix N*N. -## The @var{b} must be a one column vector with a length of N. -## The @var{tol} specifies the tolerance of the method, default value is 1e-6. -## The @var{maxit} specifies the maximum number of iteration, default value is -## MIN(20,N). -## The @var{M1} specifies a preconditioner, can also be a function handler which -## returns M\X. -## The @var{M2} combined with @var{M1} defines preconditioner as -## preconditioner=M1*M2. -## The @var{x0} is initial guess, default value is zeros(N,1). +## +## @deftypefn {Function File} {@var{x} =} cgs (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) +## @deftypefnx {Function File} {@var{x} =} cgs (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{P}) +## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}] =} cgs (@var{A}, @var{b}, @dots{}) +## Solve @code{A x = b}, where @var{A} is a square matrix, using the +## Conjugate Gradients Squared method. +## +## @itemize @minus +## @item @var{rtol} is the relative tolerance, if not given or set to [] +## the default value 1e-6 is used. +## +## @item @var{maxit} the maximum number of outer iterations, if not +## given or set to [] the default value @code{min (20, numel (b))} is +## used. +## +## @item @var{x0} the initial guess, if not given or set to [] the +## default value @code{zeros (size (b))} is used. +## @end itemize +## +## @var{A} can be passed as a matrix or as a function handle or +## inline function @code{f} such that @code{f(x) = A*x}. ## +## The preconditioner @var{P} is given as @code{P = M1 * M2}. +## Both @var{M1} and @var{M2} can be passed as a matrix or as a function +## handle or inline function @code{g} such that @code{g(x) = M1 \ x} or +## @code{g(x) = M2 \ x}. +## +## If called with more than one output parameter +## +## @itemize @minus +## @item @var{flag} indicates the exit status: +## @itemize @minus +## @item 0: iteration converged to the within the chosen tolerance +## +## @item 1: the maximum number of iterations was reached before convergence +## +## @item 3: the algorithm reached stagnation +## @end itemize +## (the value 2 is unused but skipped for compatibility). +## +## @item @var{relres} is the final value of the relative residual. +## +## @item @var{iter} is the number of iterations performed. +## +## @item @var{resvec} is a vector containing the relative residual at +## each iteration. +## @end itemize +## +## @seealso{pcg, bicgstab, bicg, gmres} ## @end deftypefn function [x, flag, relres, iter, resvec] = cgs (A, b, tol, maxit, M1, M2, x0) - if (nargin < 2 || nargin > 7 || nargout > 5) - print_usage (); - elseif (!(isnumeric (A) && issquare (A))) - error ("cgs: A must be a square numeric matrix"); - elseif (!isvector (b)) - error ("cgs: B must be a vector"); - elseif (rows (A) != rows (b)) - error ("cgs: A and B must have the same number of rows"); - elseif (nargin > 2 && !isscalar (tol)) - error ("cgs: TOL must be a scalar"); - elseif (nargin > 3 && !isscalar (maxit)) - error ("cgs: MAXIT must be a scalar"); - elseif (nargin > 4 && ismatrix (M1) && (rows (M1) != rows (A) || columns (M1) != columns (A))) - error ("cgs: M1 must have the same number of rows and columns as A"); - elseif (nargin > 5 && (!ismatrix (M2) || rows (M2) != rows (A) || columns (M2) != columns (A))) - error ("cgs: M2 must have the same number of rows and columns as A"); - elseif (nargin > 6 && !isvector (x0)) - error ("cgs: X0 must be a vector"); - elseif (nargin > 6 && rows (x0) != rows (b)) - error ("cgs: X0 must have the same number of rows as B"); - endif + if (nargin >= 2 && nargin <= 7 && isvector (full (b))) - ## Default tolerance. - if (nargin < 3) - tol = 1e-6; - endif + if (ischar (A)) + A = str2func (A); + elseif (ismatrix (A)) + Ax = @(x) A * x; + elseif (isa (A, "function_handle")) + Ax = @(x) feval (A, x); + else + error (["cgs: first argument is expected to "... + "be a function or a square matrix"]); + endif + + if (nargin < 3 || isempty (tol)) + tol = 1e-6; + endif + + if (nargin < 4 || isempty (maxit)) + maxit = min (rows (b), 20); + endif - ## Default maximum number of iteration. - if (nargin < 4) - maxit = min (rows (b),20); - endif - - ## Left preconditioner. - if (nargin == 5) - if (isnumeric (M1)) - precon = @(x) M1 \ x; - endif - elseif (nargin > 5) - if (issparse (M1) && issparse (M2)) - precon = @(x) M2 \ (M1 \ x); + if (nargin < 5 || isempty (M1)) + M1m1x = @(x) x; + elseif (ischar (M1)) + M1m1x = str2func (M1); + elseif (ismatrix (M1)) + M1m1x = @(x) M1 \ x; + elseif (isa (M1, "function_handle")) + M1m1x = @(x) feval (M1, x); else - M = M1*M2; - precon = @(x) M \ x; + error ("cgs: preconditioner is expected to be a function or matrix"); endif - else - precon = @(x) x; - endif - ## Specifies initial estimate x0. - if (nargin < 7) - x = zeros (rows (b), 1); - else + if (nargin < 6 || isempty (M2)) + M2m1x = @(x) x; + elseif (ischar (M2)) + M2m1x = str2func (M2); + elseif (ismatrix (M2)) + M2m1x = @(x) M2 \ x; + elseif (isa (M2, "function_handle")) + M2m1x = @(x) feval (M2, x); + else + error ("cgs: preconditioner is expected to be a function or matrix"); + endif + + precon = @(x) M2m1x (M1m1x (x)); + + if (nargin < 7 || isempty (x0)) + x0 = zeros (size (b)); + endif + + x = x0; - endif - res = b - A * x; - norm_b = norm (b); - ## Vector of the residual norms for each iteration. - resvec = [ norm(res)/norm_b ]; - ro = 0; - ## Default behavior we don't reach tolerance tol within maxit iterations. - flag = 1; - for iter = 1 : maxit + res = b - Ax (x); + norm_b = norm (b); + ## Vector of the residual norms for each iteration. + resvec = norm (res) / norm_b; + ro = 0; + ## Default behavior we don't reach tolerance tol within maxit iterations. + flag = 1; + for iter = 1:maxit - z = precon (res); + z = precon (res); - ## Cache. - ro_old = ro; - ro = res' * z; - if (iter == 1) - p = z; - else - beta = ro / ro_old; - p = z + beta * p; - endif - ## Cache. - q = A * p; - alpha = ro / (p' * q); - x = x + alpha * p; + ## Cache. + ro_old = ro; + ro = res' * z; + if (iter == 1) + p = z; + else + beta = ro / ro_old; + p = z + beta * p; + endif + ## Cache. + q = Ax (p); + alpha = ro / (p' * q); + x = x + alpha * p; + + res = res - alpha * q; + relres = norm (res) / norm_b; + resvec = [resvec; relres]; - res = res - alpha * q; - relres = norm(res) / norm_b; - resvec = [resvec;relres]; - - if (relres <= tol) - ## We reach tolerance tol within maxit iterations. - flag = 0; - break; - elseif (resvec (end) == resvec (end - 1)) - ## The method stagnates. - flag = 3; - break; - endif - endfor; + if (relres <= tol) + ## We reach tolerance tol within maxit iterations. + flag = 0; + break + elseif (resvec (end) == resvec (end - 1)) + ## The method stagnates. + flag = 3; + break + endif + endfor - if (nargout < 1) - if ( flag == 0 ) - printf (["cgs converged at iteration %i ", - "to a solution with relative residual %e\n"],iter,relres); - elseif (flag == 3) - printf (["cgs stopped at iteration %i ", - "without converging to the desired tolerance %e\n", - "because the method stagnated.\n", - "The iterate returned (number %i) has relative residual %e\n"],iter,tol,iter,relres); - else - printf (["cgs stopped at iteration %i ", - "without converging to the desired tolerance %e\n", - "because the maximum number of iterations was reached.\n", - "The iterate returned (number %i) has relative residual %e\n"],iter,tol,iter,relres); + if (nargout < 1) + if (flag == 0) + printf ("cgs converged at iteration %i to a solution with relative residual %e\n", + iter, relres); + elseif (flag == 3) + printf (["cgs stopped at iteration %i without converging to the desired tolerance %e\n", + "because the method stagnated.\n", + "The iterate returned (number %i) has relative residual %e\n"], + iter, tol, iter, relres); + else + printf (["cgs stopped at iteration %i without converging to the desired tolerance %e\n", + "because the maximum number of iterations was reached.\n", + "The iterate returned (number %i) has relative residual %e\n"], + iter, tol, iter, relres); + endif endif + + else + print_usage (); endif endfunction @@ -156,3 +195,31 @@ %! A=[5 -1 3;-1 2 -2;3 -2 3] %! b=[7;-1;4] %! [a,b,c,d,e]=cgs(A,b) + +%!shared A, b, n, M +%! +%!test +%! n = 100; +%! A = spdiags ([-ones(n,1) 4*ones(n,1) -ones(n,1)], -1:1, n, n); +%! b = sum (A, 2); +%! tol = 1e-8; +%! maxit = 1000; +%! M = 4*eye (n); +%! [x, flag, relres, iter, resvec] = cgs (A, b, tol, maxit, M); +%! assert (x, ones (size (b)), 1e-7); +%! +%!test +%! tol = 1e-8; +%! maxit = 15; +%! +%! [x, flag, relres, iter, resvec] = cgs (@(x) A * x, b, tol, maxit, M); +%! assert (x, ones (size (b)), 1e-7); + +%!test +%! n = 100; +%! tol = 1e-8; +%! a = sprand (n, n, .1); +%! A = a'*a + 100 * eye (n); +%! b = sum (A, 2); +%! [x, flag, relres, iter, resvec] = cgs (A, b, tol, [], diag (diag (A))); +%! assert (x, ones (size (b)), 1e-7);
--- a/scripts/sparse/colperm.m +++ b/scripts/sparse/colperm.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{p} =} colperm (@var{s}) -## Returns the column permutations such that the columns of +## Return the column permutations such that the columns of ## @code{@var{s} (:, @var{p})} are ordered in terms of increase number ## of non-zero elements. If @var{s} is symmetric, then @var{p} is chosen ## such that @code{@var{s} (@var{p}, @var{p})} orders the rows and
--- a/scripts/sparse/etreeplot.m +++ b/scripts/sparse/etreeplot.m @@ -20,7 +20,7 @@ ## @deftypefn {Function File} {} etreeplot (@var{A}) ## @deftypefnx {Function File} {} etreeplot (@var{A}, @var{node_style}, @var{edge_style}) ## Plot the elimination tree of the matrix @var{A} or -## @code{@var{A}+@var{A}'} if @var{A} in not symmetric. The optional +## @xcode{@var{A}+@var{A}'} if @var{A} in not symmetric. The optional ## parameters @var{node_style} and @var{edge_style} define the output ## style. ## @seealso{treeplot, gplot}
new file mode 100644 --- /dev/null +++ b/scripts/sparse/gmres.m @@ -0,0 +1,218 @@ +## Copyright (C) 2009-2011 Carlo de Falco +## +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} gmres (@var{A}, @var{b}, @var{m}, @var{rtol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) +## @deftypefnx {Function File} {@var{x} =} gmres (@var{A}, @var{b}, @var{m}, @var{rtol}, @var{maxit}, @var{P}) +## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}] =} gmres (@dots{}) +## Solve @code{A x = b} using the Preconditioned GMRES iterative method +## with restart, a.k.a. PGMRES(m). +## +## @itemize @minus +## @item @var{rtol} is the relative tolerance, +## if not given or set to [] the default value 1e-6 is used. +## +## @item @var{maxit} is the maximum number of outer iterations, +## if not given or set to [] the default value +## @code{min (10, numel (b) / restart)} is used. +## +## @item @var{x0} is the initial guess, +## if not given or set to [] the default value @code{zeros(size (b))} is used. +## +## @item @var{m} is the restart parameter, +## if not given or set to [] the default value @code{numel (b)} is used. +## @end itemize +## +## Argument @var{A} can be passed as a matrix, function handle, or +## inline function @code{f} such that @code{f(x) = A*x}. +## +## The preconditioner @var{P} is given as @code{P = M1 * M2}. +## Both @var{M1} and @var{M2} can be passed as a matrix, function handle, or +## inline function @code{g} such that @code{g(x) = M1\x} or @code{g(x) = M2\x}. +## +## Besides the vector @var{x}, additional outputs are: +## +## @itemize @minus +## @item @var{flag} indicates the exit status: +## @table @asis +## @item 0 : iteration converged to within the specified tolerance +## +## @item 1 : maximum number of iterations exceeded +## +## @item 2 : unused, but skipped for compatibility +## +## @item 3 : algorithm reached stagnation +## @end table +## +## @item @var{relres} is the final value of the relative residual. +## +## @item @var{iter} is a vector containing the number of outer iterations and +## total iterations performed. +## +## @item @var{resvec} is a vector containing the relative residual at each +## iteration. +## @end itemize +## +## @seealso{bicg, bicgstab, cgs, pcg} +## @end deftypefn + +function [x, flag, presn, it, resids] = gmres (A, b, restart, rtol, maxit, M1, M2, x0) + + if (nargin < 2 || nargin > 8) + print_usage (); + endif + + if (ischar (A)) + Ax = str2func (A); + elseif (ismatrix (A)) + Ax = @(x) A*x; + elseif (isa (A, "function_handle")) + Ax = A; + else + error ("gmres: A must be a function or matrix"); + endif + + if (nargin < 3 || isempty (restart)) + restart = rows (b); + endif + + if (nargin < 4 || isempty (rtol)) + rtol = 1e-6; + endif + + if (nargin < 5 || isempty (maxit)) + maxit = min (rows (b)/restart, 10); + endif + + if (nargin < 6 || isempty (M1)) + M1m1x = @(x) x; + elseif (ischar (M1)) + M1m1x = str2func (M1); + elseif (ismatrix (M1)) + M1m1x = @(x) M1 \ x; + elseif (isa (M1, "function_handle")) + M1m1x = M1; + else + error ("gmres: preconditioner M1 must be a function or matrix"); + endif + + if (nargin < 7 || isempty (M2)) + M2m1x = @(x) x; + elseif (ischar (M2)) + M2m1x = str2func (M2); + elseif (ismatrix (M2)) + M2m1x = @(x) M2 \ x; + elseif (isa (M2, "function_handle")) + M2m1x = M2; + else + error ("gmres: preconditioner M2 must be a function or matrix"); + endif + + Pm1x = @(x) M2m1x (M1m1x (x)); + + if (nargin < 8 || isempty (x0)) + x0 = zeros (size (b)); + endif + + x_old = x0; + x = x_old; + prec_res = Pm1x (b - Ax (x_old)); + presn = norm (prec_res, 2); + + B = zeros (restart + 1, 1); + V = zeros (rows (x), restart); + H = zeros (restart + 1, restart); + + ## begin loop + iter = 1; + restart_it = restart + 1; + resids = zeros (maxit, 1); + resids(1) = presn; + prec_b_norm = norm (Pm1x (b), 2); + flag = 1; + + while (iter <= maxit * restart && presn > rtol * prec_b_norm) + + ## restart + if (restart_it > restart) + restart_it = 1; + x_old = x; + prec_res = Pm1x (b - Ax (x_old)); + presn = norm (prec_res, 2); + B(1) = presn; + H(:) = 0; + V(:, 1) = prec_res / presn; + endif + + ## basic iteration + tmp = Pm1x (Ax (V(:, restart_it))); + [V(:,restart_it+1), H(1:restart_it+1, restart_it)] = ... + mgorth (tmp, V(:,1:restart_it)); + + Y = (H(1:restart_it+1, 1:restart_it) \ B (1:restart_it+1)); + + little_res = B(1:restart_it+1) - ... + H(1:restart_it+1, 1:restart_it) * Y(1:restart_it); + + presn = norm (little_res, 2); + + x = x_old + V(:, 1:restart_it) * Y(1:restart_it); + + resids(iter) = presn; + if (norm (x - x_old, inf) <= eps) + flag = 3; + break + endif + + restart_it++ ; + iter++; + endwhile + + if (presn > rtol * prec_b_norm) + flag = 0; + endif + + resids = resids(1:iter-1); + it = [ceil(iter / restart), rem(iter, restart)]; + +endfunction + + +%!shared A, b, dim +%! dim = 100; +%!test +%! A = spdiags ([-ones(dim,1) 2*ones(dim,1) ones(dim,1)], [-1:1], dim, dim); +%! b = ones(dim, 1); +%! x = gmres (A, b, 10, 1e-10, dim, @(x) x./diag(A), [], b); +%! assert(x, A\b, 1e-9*norm(x,inf)); +%! +%!test +%! x = gmres (A, b, dim, 1e-10, 1e4, @(x) diag(diag(A))\x, [], b); +%! assert(x, A\b, 1e-7*norm(x,inf)); +%! +%!test +%! A = spdiags ([[1./(2:2:2*(dim-1)) 0]; 1./(1:2:2*dim-1); [0 1./(2:2:2*(dim-1))]]', -1:1, dim, dim); +%! A = A'*A; +%! b = rand (dim, 1); +%! [x, resids] = gmres (@(x) A*x, b, dim, 1e-10, dim, @(x) x./diag(A), [], []); +%! assert(x, A\b, 1e-9*norm(x,inf)) +%! x = gmres (@(x) A*x, b, dim, 1e-10, 1e6, @(x) diag(diag(A))\x, [], []); +%! assert(x, A\b, 1e-9*norm(x,inf)); +%!test +%! x = gmres (@(x) A*x, b, dim, 1e-10, 1e6, @(x) x./diag(A), [], []); +%! assert(x, A\b, 1e-7*norm(x,inf));
--- a/scripts/sparse/gplot.m +++ b/scripts/sparse/gplot.m @@ -54,3 +54,31 @@ endif endfunction + + +%!demo +%! ## Binary Tree Representation +%! A = [0 1 0 0 0 0 0 +%! 1 0 1 1 0 0 0 +%! 0 1 0 0 0 0 0 +%! 0 1 0 0 1 0 0 +%! 0 0 0 1 0 1 1 +%! 0 0 0 0 1 0 0 +%! 0 0 0 0 1 0 0]; +%! +%! xy = [1, 0 +%! 1.5, 1 +%! 2, 0 +%! 2.5, 2 +%! 3.5, 1 +%! 3, 0 +%! 4, 0]; +%! +%! clf; +%! gplot (A, xy, "o-"); +%! set (get (gca, ("children")), "markersize", 12); +%! title ("gplot() of Binary Tree Adjacency matrix"); + +%% Mark graphical function as tested by demo block +%!assert (1); +
--- a/scripts/sparse/module.mk +++ b/scripts/sparse/module.mk @@ -1,10 +1,15 @@ FCN_FILE_DIRS += sparse +sparse_PRIVATE_FCN_FILES = \ + sparse/private/__sprand_impl__.m + sparse_FCN_FILES = \ + sparse/bicg.m \ sparse/bicgstab.m \ sparse/cgs.m \ sparse/colperm.m \ sparse/etreeplot.m \ + sparse/gmres.m \ sparse/gplot.m \ sparse/nonzeros.m \ sparse/pcg.m \ @@ -22,7 +27,8 @@ sparse/spy.m \ sparse/svds.m \ sparse/treelayout.m \ - sparse/treeplot.m + sparse/treeplot.m \ + $(sparse_PRIVATE_FCN_FILES) FCN_FILES += $(sparse_FCN_FILES)
--- a/scripts/sparse/nonzeros.m +++ b/scripts/sparse/nonzeros.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} nonzeros (@var{s}) -## Returns a vector of the non-zero values of the sparse matrix @var{s}. +## Return a vector of the non-zero values of the sparse matrix @var{s}. ## @end deftypefn function t = nonzeros (s) @@ -27,12 +27,13 @@ print_usage (); endif - [i, j, t] = find (s); + [~, ~, t] = find (s); t = t(:); endfunction + %!assert(nonzeros([1,2;3,0]),[1;3;2]) %!assert(nonzeros([1,2,3,0]),[1;2;3]) %!assert(nonzeros(sparse([1,2;3,0])),[1;3;2])
--- a/scripts/sparse/pcg.m +++ b/scripts/sparse/pcg.m @@ -20,7 +20,7 @@ ## @deftypefn {Function File} {@var{x} =} pcg (@var{A}, @var{b}, @var{tol}, @var{maxit}, @var{m1}, @var{m2}, @var{x0}, @dots{}) ## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}, @var{eigest}] =} pcg (@dots{}) ## -## Solves the linear system of equations @code{@var{A} * @var{x} = @var{b}} +## Solve the linear system of equations @code{@var{A} * @var{x} = @var{b}} ## by means of the Preconditioned Conjugate Gradient iterative ## method. The input arguments are ##
--- a/scripts/sparse/pcr.m +++ b/scripts/sparse/pcr.m @@ -20,7 +20,7 @@ ## @deftypefn {Function File} {@var{x} =} pcr (@var{A}, @var{b}, @var{tol}, @var{maxit}, @var{m}, @var{x0}, @dots{}) ## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}] =} pcr (@dots{}) ## -## Solves the linear system of equations @code{@var{A} * @var{x} = @var{b}} +## Solve the linear system of equations @code{@var{A} * @var{x} = @var{b}} ## by means of the Preconditioned Conjugate Residuals iterative ## method. The input arguments are ##
new file mode 100644 --- /dev/null +++ b/scripts/sparse/private/__sprand_impl__.m @@ -0,0 +1,63 @@ +## Copyright (C) 2004-2011 Paul Kienzle +## Copyright (C) 2011 Jordi Gutiérrez Hermoso +## +## 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/>. +## +## Original version by Paul Kienzle distributed as free software in the +## public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {} __sprand_impl__ (@var{s}, @var{randfun}) +## @deftypefnx {Function File} {} __sprand_impl__ (@var{m}, @var{n}, @var{d}, @var{funname}, @var{randfun}) +## Undocumented internal function. +## @end deftypefn + +## Actual implementation of sprand and sprandn happens here. + +function S = __sprand_impl__ (varargin) + + if (nargin == 2) + m = varargin{1}; + randfun = varargin{2}; + [i, j] = find (m); + [nr, nc] = size (m); + S = sparse (i, j, randfun (size (i)), nr, nc); + return; + endif + + [m, n, d, funname, randfun] = deal(varargin{:}); + + if (!(isscalar (m) && m == fix (m) && m > 0)) + error ("%s: M must be an integer greater than 0", funname); + endif + + if (!(isscalar (n) && n == fix (n) && n > 0)) + error ("%s: N must be an integer greater than 0", funname); + endif + + if (d < 0 || d > 1) + error ("%s: density D must be between 0 and 1", funname); + endif + + mn = m*n; + k = round (d*mn); + idx = randperm (mn, k); + + [i, j] = ind2sub ([m, n], idx); + S = sparse (i, j, randfun (k, 1), m, n); + +endfunction \ No newline at end of file
--- a/scripts/sparse/spaugment.m +++ b/scripts/sparse/spaugment.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{s} =} spaugment (@var{A}, @var{c}) -## Creates the augmented matrix of @var{A}. This is given by +## Create the augmented matrix of @var{A}. This is given by ## ## @example ## @group
--- a/scripts/sparse/spconvert.m +++ b/scripts/sparse/spconvert.m @@ -43,3 +43,25 @@ endif endfunction + + +%!test +%! i = [1; 3; 5]; +%! j = [2; 4; 6]; +%! v = [7; 8; 9]; +%! s = spconvert ([i, j, v]); +%! assert (issparse (s)); +%! [fi, fj, fv] = find (s); +%! assert (isequal (i, fi) && isequal (j, fj) && isequal (v, fv)); +%! s = spconvert ([i, j, v, j]); +%! [fi, fj, fv] = find (s); +%! assert (isequal (i, fi) && isequal (j, fj) && isequal (complex (v, j), fv)); +%! assert (size (spconvert ([1, 1, 3; 5, 15, 0])), [5, 15]); + +%% Test input validation +%!error spconvert () +%!error spconvert (1, 2) +%!error spconvert ({[1 2 3]}) +%!error spconvert ([1 2]) +%!error spconvert ([1 2 3i]) +%!error spconvert ([1 2 3 4 5])
--- a/scripts/sparse/spdiags.m +++ b/scripts/sparse/spdiags.m @@ -79,10 +79,16 @@ ## Create new matrix of size mxn using v,c [j, i, v] = find (v); offset = max (min (c(:), n-m), 0); - j = j(:) + offset(i); + j = j + offset(i); i = j-c(:)(i); idx = i > 0 & i <= m & j > 0 & j <= n; A = sparse (i(idx), j(idx), v(idx), m, n); endif endfunction + +%!test +%assert(spdiags(zeros(1,0),1,1,1),0) + +%!test +%assert(spdiags(zeros(0,1),1,1,1),0)
--- a/scripts/sparse/speye.m +++ b/scripts/sparse/speye.m @@ -20,7 +20,7 @@ ## @deftypefn {Function File} {@var{y} =} speye (@var{m}) ## @deftypefnx {Function File} {@var{y} =} speye (@var{m}, @var{n}) ## @deftypefnx {Function File} {@var{y} =} speye (@var{sz}) -## Returns a sparse identity matrix. This is significantly more +## Return a sparse identity matrix. This is significantly more ## efficient than @code{sparse (eye (@var{m}))} as the full matrix ## is not constructed. ##
--- a/scripts/sparse/sprand.m +++ b/scripts/sparse/sprand.m @@ -27,12 +27,9 @@ ## @var{d} should be between 0 and 1. Values will be uniformly ## distributed between 0 and 1. ## -## Note: sometimes the actual density may be a bit smaller than @var{d}. -## This is unlikely to happen for large, truly sparse, matrices. -## ## If called with a single matrix argument, a random sparse matrix is ## generated wherever the matrix @var{S} is non-zero. -## @seealso{sprandn} +## @seealso{sprandn, sprandsym} ## @end deftypefn ## Author: Paul Kienzle <pkienzle@users.sf.net> @@ -47,48 +44,39 @@ function S = sprand (m, n, d) - if (nargin != 1 && nargin != 3) + if (nargin == 1 ) + S = __sprand_impl__ (m, @rand); + elseif ( nargin == 3) + S = __sprand_impl__ (m, n, d, "sprand", @rand); + else print_usage (); endif - if (nargin == 1) - [i, j, v] = find (m); - [nr, nc] = size (m); - S = sparse (i, j, rand (size (v)), nr, nc); - return; - endif - - if (!(isscalar (m) && m == fix (m) && m > 0)) - error ("sprand: M must be an integer greater than 0"); - endif - - if (!(isscalar (n) && n == fix (n) && n > 0)) - error ("sprand: N must be an integer greater than 0"); - endif - - if (d < 0 || d > 1) - error ("sprand: density D must be between 0 and 1"); - endif - - mn = m*n; - ## how many entries in S would be satisfactory? - k = round (d*mn); - idx = unique (fix (rand (min (k*1.01, k+10), 1) * mn)) + 1; - ## idx contains random numbers in [1,mn] - ## generate 1% or 10 more random values than necessary in order to - ## reduce the probability that there are less than k distinct - ## values; maybe a better strategy could be used but I don't think - ## it's worth the price - - ## actual number of entries in S - k = min (length (idx), k); - j = floor ((idx(1:k)-1)/m); - i = idx(1:k) - j*m; - if (isempty (i)) - S = sparse (m, n); - else - S = sparse (i, j+1, rand (k, 1), m, n); - endif - endfunction +%!test +%! s = sprand (4, 10, 0.1); +%! assert (size (s), [4, 10]); +%! assert (nnz (s) / numel (s), 0.1); + +%% Test 1-input calling form +%!test +%! s = sprand (sparse ([1 2 3], [3 2 3], [2 2 2])); +%! [i, j, v] = find (s); +%! assert (sort (i), [1 2 3]'); +%! assert (sort (j), [2 3 3]'); +%! assert (all (v > 0 & v < 1)); + +%% Test input validation +%!error sprand () +%!error sprand (1, 2) +%!error sprand (1, 2, 3, 4) +%!error sprand (ones(3), 3, 0.5) +%!error sprand (3.5, 3, 0.5) +%!error sprand (0, 3, 0.5) +%!error sprand (3, ones(3), 0.5) +%!error sprand (3, 3.5, 0.5) +%!error sprand (3, 0, 0.5) +%!error sprand (3, 3, -1) +%!error sprand (3, 3, 2) +
--- a/scripts/sparse/sprandn.m +++ b/scripts/sparse/sprandn.m @@ -27,41 +27,48 @@ ## @var{d} should be between 0 and 1. Values will be normally ## distributed with mean of zero and variance 1. ## -## Note: sometimes the actual density may be a bit smaller than @var{d}. -## This is unlikely to happen for large really sparse matrices. -## ## If called with a single matrix argument, a random sparse matrix is ## generated wherever the matrix @var{S} is non-zero. -## @seealso{sprand} +## @seealso{sprand, sprandsym} ## @end deftypefn ## Author: Paul Kienzle <pkienzle@users.sf.net> function S = sprandn (m, n, d) - if (nargin == 1) - [i, j, v] = find (m); - [nr, nc] = size (m); - S = sparse (i, j, randn (size (v)), nr, nc); - elseif (nargin == 3) - mn = m*n; - k = round (d*mn); - idx = unique (fix (rand (min (k*1.01, k+10), 1) * mn)) + 1; - ## idx contains random numbers in [1,mn] - ## generate 1% or 10 more random values than necessary in order to - ## reduce the probability that there are less than k distinct - ## values; maybe a better strategy could be used but I don't think - ## it's worth the price. - ## actual number of entries in S - k = min (length (idx), k); - j = floor ((idx(1:k)-1)/m); - i = idx(1:k) - j*m; - if (isempty (i)) - S = sparse (m, n); - else - S = sparse (i, j+1, randn (k, 1), m, n); - endif + if (nargin == 1 ) + S = __sprand_impl__ (m, @randn); + elseif ( nargin == 3) + S = __sprand_impl__ (m, n, d, "sprandn", @randn); else print_usage (); endif + endfunction + + +%!test +%! s = sprandn (4, 10, 0.1); +%! assert (size (s), [4, 10]); +%! assert (nnz (s) / numel (s), 0.1); + +%% Test 1-input calling form +%!test +%! s = sprandn (sparse ([1 2 3], [3 2 3], [2 2 2])); +%! [i, j] = find (s); +%! assert (sort (i), [1 2 3]'); +%! assert (sort (j), [2 3 3]'); + +%% Test input validation +%!error sprandn () +%!error sprandn (1, 2) +%!error sprandn (1, 2, 3, 4) +%!error sprandn (ones(3), 3, 0.5) +%!error sprandn (3.5, 3, 0.5) +%!error sprandn (0, 3, 0.5) +%!error sprandn (3, ones(3), 0.5) +%!error sprandn (3, 3.5, 0.5) +%!error sprandn (3, 0, 0.5) +%!error sprandn (3, 3, -1) +%!error sprandn (3, 3, 2) +
--- a/scripts/sparse/sprandsym.m +++ b/scripts/sparse/sprandsym.m @@ -1,4 +1,5 @@ ## Copyright (C) 2004-2011 David Bateman and Andy Adler +## Copyright (C) 2011 Jordi Gutiérrez Hermoso ## ## This file is part of Octave. ## @@ -24,9 +25,6 @@ ## @var{d} should be between 0 and 1. Values will be normally ## distributed with mean of zero and variance 1. ## -## Note: sometimes the actual density may be a bit smaller than @var{d}. -## This is unlikely to happen for large really sparse matrices. -## ## If called with a single matrix argument, a random sparse matrix is ## generated wherever the matrix @var{S} is non-zero in its lower ## triangular part. @@ -34,44 +32,145 @@ ## @end deftypefn function S = sprandsym (n, d) - if (nargin == 1) - [i, j, v] = find (tril (n)); - [nr, nc] = size (n); - S = sparse (i, j, randn (size (v)), nr, nc); - S = S + tril (S, -1)'; - elseif (nargin == 2) - m1 = floor (n/2); - n1 = m1 + rem (n, 2); - mn1 = m1*n1; - k1 = round (d*mn1); - idx1 = unique (fix (rand (min (k1*1.01, k1+10), 1) * mn1)) + 1; - ## idx contains random numbers in [1,mn] generate 1% or 10 more - ## random values than necessary in order to reduce the probability - ## that there are less than k distinct values; maybe a better - ## strategy could be used but I don't think it's worth the price. - ## Actual number of entries in S. - k1 = min (length (idx1), k1); - j1 = floor ((idx1(1:k1)-1)/m1); - i1 = idx1(1:k1) - j1*m1; - - n2 = ceil (n/2); - nn2 = n2*n2; - k2 = round (d*nn2); - idx2 = unique (fix (rand (min (k2*1.01, k1+10), 1) * nn2)) + 1; - k2 = min (length (idx2), k2); - j2 = floor ((idx2(1:k2)-1)/n2); - i2 = idx2(1:k2) - j2*n2; - - if (isempty (i1) && isempty (i2)) - S = sparse (n, n); - else - S1 = sparse (i1, j1+1, randn (k1, 1), m1, n1); - S = [tril(S1), sparse(m1,m1); ... - sparse(i2,j2+1,randn(k2,1),n2,n2), triu(S1,1)']; - S = S + tril (S, -1)'; - endif - else + if (nargin != 1 && nargin != 2) print_usage (); endif + + if (nargin == 1) + [i, j] = find (tril (n)); + [nr, nc] = size (n); + S = sparse (i, j, randn (size (i)), nr, nc); + S = S + tril (S, -1)'; + return; + endif + + if (!(isscalar (n) && n == fix (n) && n > 0)) + error ("sprandsym: N must be an integer greater than 0"); + endif + + if (d < 0 || d > 1) + error ("sprandsym: density D must be between 0 and 1"); + endif + + ## Actual number of nonzero entries + k = round (n^2*d); + + ## Diagonal nonzero entries, same parity as k + r = pick_rand_diag (n, k); + + ## Off diagonal nonzero entries + m = (k - r)/2; + + ondiag = randperm (n, r); + offdiag = randperm (n*(n - 1)/2, m); + + ## Row index + i = lookup (cumsum (0:n), offdiag - 1) + 1; + + ## Column index + j = offdiag - (i - 1).*(i - 2)/2; + + diagvals = randn (1, r); + offdiagvals = randn (1, m); + + S = sparse ([ondiag, i, j], [ondiag, j, i], + [diagvals, offdiagvals, offdiagvals], n, n); + endfunction + +function r = pick_rand_diag (n, k) + ## Pick a random number R of entries for the diagonal of a sparse NxN + ## symmetric square matrix with exactly K nonzero entries, ensuring + ## that this R is chosen uniformly over all such matrices. + ## + ## Let D be the number of diagonal entries and M the number of + ## off-diagonal entries. Then K = D + 2*M. Let A = N*(N-1)/2 be the + ## number of available entries in the upper triangle of the matrix. + ## Then, by a simple counting argument, there is a total of + ## + ## T = nchoosek (N, D) * nchoosek (A, M) + ## + ## symmetric NxN matrices with a total of K nonzero entries and D on + ## the diagonal. Letting D range from mod (K,2) through min (N,K), and + ## dividing by this sum, we obtain the probability P for D to be each + ## of those values. + ## + ## However, we cannot use this form for computation, as the binomial + ## coefficients become unmanageably large. Instead, we use the + ## successive quotients Q(i) = T(i+1)/T(i), which we easily compute to + ## be + ## + ## (N - D)*(N - D - 1)*M + ## Q = ------------------------------- + ## (D + 2)*(D + 1)*(A - M + 1) + ## + ## Then, after prepending 1, the cumprod of these quotients is + ## + ## C = [ T(1)/T(1), T(2)/T(1), T(3)/T(1), ..., T(N)/T(1) ] + ## + ## Their sum is thus S = sum (T)/T(1), and then C(i)/S is the desired + ## probability P(i) for i=1:N. The cumsum will finally give the + ## distribution function for computing the random number of entries on + ## the diagonal R. + ## + ## Thanks to Zsbán Ambrus <ambrus@math.bme.hu> for most of the ideas + ## of the implementation here, especially how to do the computation + ## numerically to avoid overflow. + + ## Degenerate case + if k == 1 + r = 1; + return + endif + + ## Compute the stuff described above + a = n*(n - 1)/2; + d = [mod(k,2):2:min(n,k)-2]; + m = (k - d)/2; + q = (n - d).*(n - d - 1).*m ./ (d + 2)./(d + 1)./(a - m + 1); + + ## Slight modification from discussion above: pivot around the max in + ## order to avoid overflow (underflow is fine, just means effectively + ## zero probabilities). + [~, midx] = max (cumsum (log (q))) ; + midx++; + lc = fliplr (cumprod (1./q(midx-1:-1:1))); + rc = cumprod (q(midx:end)); + + ## Now c = t(i)/t(midx), so c > 1 == []. + c = [lc, 1, rc]; + s = sum (c); + p = c/s; + + ## Add final d + d(end+1) = d(end) + 2; + + ## Pick a random r using this distribution + r = d(sum (cumsum (p) < rand) + 1); + +endfunction + +%!test +%! s = sprandsym (10, 0.1); +%! assert (issparse (s)); +%! assert (issymmetric (s)); +%! assert (size (s), [10, 10]); +%! assert (nnz (s) / numel (s), 0.1, .01); + +%% Test 1-input calling form +%!test +%! s = sprandsym (sparse ([1 2 3], [3 2 3], [2 2 2])); +%! [i, j] = find (s); +%! assert (sort (i), [2 3]'); +%! assert (sort (j), [2 3]'); + +%% Test input validation +%!error sprandsym () +%!error sprandsym (1, 2, 3) +%!error sprandsym (ones(3), 0.5) +%!error sprandsym (3.5, 0.5) +%!error sprandsym (0, 0.5) +%!error sprandsym (3, -1) +%!error sprandsym (3, 2) +
--- a/scripts/sparse/spy.m +++ b/scripts/sparse/spy.m @@ -21,7 +21,7 @@ ## @deftypefnx {Function File} {} spy (@dots{}, @var{markersize}) ## @deftypefnx {Function File} {} spy (@dots{}, @var{line_spec}) ## Plot the sparsity pattern of the sparse matrix @var{x}. If the argument -## @var{markersize} is given as an scalar value, it is used to determine the +## @var{markersize} is given as a scalar value, it is used to determine the ## point size in the plot. If the string @var{line_spec} is given it is ## passed to @code{plot} and determines the appearance of the plot. ## @seealso{plot} @@ -41,7 +41,11 @@ endif for i = 1:length (varargin) if (ischar (varargin{i})) - line_spec = varargin{i}; + if (length (varargin{i}) == 1) + line_spec = [line_spec, varargin{i}]; + else + line_spec = varargin{i}; + endif elseif (isscalar (varargin{i})) markersize = varargin{i}; else @@ -61,3 +65,11 @@ axis ([0, n+1, 0, m+1], "ij"); endfunction + + +%!demo +%! clf; +%! spy (sprand (10,10, 0.2)); + +%% Mark graphical function as tested by demo block +%!assert (1);
--- a/scripts/sparse/svds.m +++ b/scripts/sparse/svds.m @@ -150,6 +150,8 @@ ## Scale everything by the 1-norm to make things more stable. b = A / max_a; b_opts = opts; + ## Call to eigs is always a symmetric matrix by construction + b_opts.issym = true; b_opts.tol = opts.tol / max_a; b_sigma = sigma; if (!ischar (b_sigma)) @@ -173,10 +175,10 @@ if (nargout > 1) [V, s, flag] = eigs ([sparse(m,m), b; b', sparse(n,n)], b_k, b_sigma, b_opts); + s = diag (s); else s = eigs ([sparse(m,m), b; b', sparse(n,n)], b_k, b_sigma, b_opts); endif - s = diag (s); if (ischar (sigma)) norma = max (s); @@ -224,11 +226,11 @@ else if (max_a == 0) u = eye (m, k); - s = diag(s); + s = diag (s); v = eye (n, k); else u = root2 * V(1:m,ind); - s = diag(s); + s = diag (s); v = root2 * V(m+1:end,ind); endif @@ -239,38 +241,56 @@ endfunction -%!shared n, k, A, u, s, v, opts +%!shared n, k, A, u, s, v, opts, rand_state, randn_state %! n = 100; %! k = 7; -%! A = sparse([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),0.4*n*ones(1,n),ones(1,n-2)]); -%! [u,s,v] = svd(full(A)); -%! s = diag(s); -%! [~, idx] = sort(abs(s)); +%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),0.4*n*ones(1,n),ones(1,n-2)]); +%! [u,s,v] = svd (full (A)); +%! s = diag (s); +%! [~, idx] = sort (abs(s)); %! s = s(idx); -%! u = u(:,idx); -%! v = v(:,idx); -%! randn('state',42); % Initialize to make normest function reproducible -%! rand('state',42) +%! u = u(:, idx); +%! v = v(:, idx); +%! randn_state = randn ("state"); +%! rand_state = rand ("state"); +%! randn ("state", 42); % Initialize to make normest function reproducible +%! rand ("state", 42); %! opts.v0 = rand (2*n,1); % Initialize eigs ARPACK starting vector %! % to guarantee reproducible results +%! %!test -%! [u2,s2,v2,flag] = svds(A,k); -%! s2 = diag(s2); -%! assert(flag,!1); -%! assert(s2, s(end:-1:end-k+1), 1e-10); +%! [u2,s2,v2,flag] = svds (A,k); +%! s2 = diag (s2); +%! assert (flag, !1); +%! assert (s2, s(end:-1:end-k+1), 1e-10); +%! %!testif HAVE_UMFPACK -%! [u2,s2,v2,flag] = svds(A,k,0,opts); -%! s2 = diag(s2); -%! assert(flag,!1); -%! assert(s2, s(k:-1:1), 1e-10); +%! [u2,s2,v2,flag] = svds (A,k,0,opts); +%! s2 = diag (s2); +%! assert (flag, !1); +%! assert (s2, s(k:-1:1), 1e-10); +%! %!testif HAVE_UMFPACK %! idx = floor(n/2); %! % Don't put sigma right on a singular value or there are convergence issues %! sigma = 0.99*s(idx) + 0.01*s(idx+1); -%! [u2,s2,v2,flag] = svds(A,k,sigma,opts); -%! s2 = diag(s2); -%! assert(flag,!1); -%! assert(s2, s((idx+floor(k/2)):-1:(idx-floor(k/2))), 1e-10); +%! [u2,s2,v2,flag] = svds (A,k,sigma,opts); +%! s2 = diag (s2); +%! assert (flag, !1); +%! assert (s2, s((idx+floor(k/2)):-1:(idx-floor(k/2))), 1e-10); +%! %!test -%! [u2,s2,v2,flag] = svds(zeros (10), k); -%! assert (isequal(u2, eye (10, k)) && isequal (s2, zeros(k)) && isequal (v2, eye(10, 7))) +%! [u2,s2,v2,flag] = svds (zeros (10), k); +%! assert (u2, eye (10, k)); +%! assert (s2, zeros (k)); +%! assert (v2, eye (10, 7)); +%! +%!test +%! s = svds (speye (10)); +%! assert (s, ones (6, 1), 2*eps); + +%!test +%! ## Restore random number generator seeds at end of tests +%! rand ("state", rand_state); +%! randn ("state", randn_state); +
--- a/scripts/sparse/treelayout.m +++ b/scripts/sparse/treelayout.m @@ -25,7 +25,7 @@ ## permutation. ## The complexity of the algorithm is O(n) in ## terms of time and memory requirements. -## @seealso{etreeplot, gplot,treeplot} +## @seealso{etreeplot, gplot, treeplot} ## @end deftypefn function [x_coordinate, y_coordinate, height, s] = treelayout (tree, permutation) @@ -202,10 +202,26 @@ endif endfunction -%!demo +%!test %! % Compute a simple tree layout -%! [x,y,h,s]=treelayout([0 1 2 2]) +%! [x, y, h, s] = treelayout ([0, 1, 2, 2]); +%! assert (x, [1.5, 1.5, 2, 1]); +%! assert (y, [3, 2, 1, 1]); +%! assert (h, 2); +%! assert (s, 2); -%!demo +%!test %! % Compute a simple tree layout with defined postorder permutation -%! [x,y,h,s]=treelayout([0 1 2 2],[1 2 3 4]) +%! [x, y, h, s] = treelayout ([0, 1, 2, 2], [1, 2, 4, 3]); +%! assert (x, [1.5, 1.5, 1, 2]); +%! assert (y, [3, 2, 1, 1]); +%! assert (h, 2); +%! assert (s, 2); + +%!test +%! % Compute a simple tree layout with defined postorder permutation +%! [x, y, h, s] = treelayout ([0, 1, 2, 2], [4, 2, 3, 1]); +%! assert (x, [0, 0, 0, 1]); +%! assert (y, [0, 0, 0, 3]); +%! assert (h, 0); +%! assert (s, 1);
--- a/scripts/sparse/treeplot.m +++ b/scripts/sparse/treeplot.m @@ -19,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} treeplot (@var{tree}) ## @deftypefnx {Function File} {} treeplot (@var{tree}, @var{node_style}, @var{edge_style}) -## Produces a graph of tree or forest. The first argument is vector of +## Produce a graph of tree or forest. The first argument is vector of ## predecessors, optional parameters @var{node_style} and @var{edge_style} ## define the output style. The complexity of the algorithm is O(n) in ## terms of is time and memory requirements.
--- a/scripts/specfun/bessel.m +++ b/scripts/specfun/bessel.m @@ -91,3 +91,4 @@ error ("bessel: you must use besselj, bessely, besseli, or besselk"); endfunction +%!error bessel ()
--- a/scripts/specfun/betaln.m +++ b/scripts/specfun/betaln.m @@ -21,16 +21,17 @@ ## Return the natural logarithm of the Beta function, ## @tex ## $$ -## B (a, b) = \log {\Gamma (a) \Gamma (b) \over \Gamma (a + b)}. +## {\rm betaln} (a, b) = \ln (B (a,b)) \equiv \ln ({\Gamma (a) \Gamma (b) \over \Gamma (a + b)}). ## $$ ## @end tex ## @ifnottex ## ## @example -## betaln (a, b) = gammaln (a) + gammaln (b) - gammaln (a + b) +## betaln (a, b) = log (beta (a, b)) ## @end example ## ## @end ifnottex +## calculated in a way to reduce the occurrence of underflow. ## @seealso{beta, betainc, gammaln} ## @end deftypefn @@ -39,14 +40,18 @@ ## Keywords: log beta special function function retval = betaln (a, b) + if (nargin != 2) print_usage (); endif retval = gammaln (a) + gammaln (b) - gammaln (a + b); + endfunction -%!assert (betaln(3,4),log(beta(3,4)),eps) + +%!assert (betaln (3,4), log (beta(3,4)),eps); -%!error (betaln(1.)) -%!error (betaln(1.,1.,1.)) +%% Test input validation +%!error (betaln (1)) +%!error (betaln (1,2,3))
--- a/scripts/specfun/factorial.m +++ b/scripts/specfun/factorial.m @@ -29,8 +29,8 @@ function x = factorial (n) if (nargin != 1) print_usage (); - elseif (any (n(:) < 0 | n(:) != round (n(:)))) - error ("factorial: N must all be nonnegative integers"); + elseif (any (n(:) < 0 | n(:) != fix (n(:)))) + error ("factorial: N must all be non-negative integers"); endif x = round (gamma (n+1)); endfunction @@ -38,5 +38,5 @@ %!assert (factorial(5), prod(1:5)) %!assert (factorial([1,2;3,4]), [1,2;6,24]) %!assert (factorial(70), exp(sum(log(1:70))), -128*eps) -%!fail ('factorial(5.5)', "must all be nonnegative integers") -%!fail ('factorial(-3)', "must all be nonnegative integers") +%!fail ('factorial(5.5)', "must all be non-negative integers") +%!fail ('factorial(-3)', "must all be non-negative integers")
rename from scripts/elfun/lcm.m rename to scripts/specfun/lcm.m --- a/scripts/elfun/lcm.m +++ b/scripts/specfun/lcm.m @@ -34,7 +34,7 @@ if (nargin > 1) if (common_size (varargin{:}) != 0) error ("lcm: all args must be of the same size or scalar"); - elseif (! all (cellfun (@isnumeric, varargin))) + elseif (! all (cellfun ("isnumeric", varargin))) error ("lcm: all arguments must be numeric"); endif
--- a/scripts/specfun/legendre.m +++ b/scripts/specfun/legendre.m @@ -166,7 +166,7 @@ error ("legendre: N must be a non-negative scalar integer"); endif - if (!isvector (x) || !isreal (x) || any (x < -1 | x > 1)) + if (!isreal (x) || any (x(:) < -1 | x(:) > 1)) error ("legendre: X must be real-valued vector in the range -1 <= X <= 1"); endif @@ -187,10 +187,7 @@ error ('legendre: expecting NORMALIZATION option to be "norm", "sch", or "unnorm"'); endswitch - if (rows (x) != 1) - x = x'; - endif - scale = scale * ones (1, numel (x)); + scale = scale * ones (size (x)); ## Based on the recurrence relation below ## m m m @@ -199,6 +196,7 @@ ## http://en.wikipedia.org/wiki/Associated_Legendre_function overflow = false; + retval = zeros([n+1, size(x)]); for m = 1:n lpm1 = scale; lpm2 = (2*m-1) .* x .* scale; @@ -217,7 +215,7 @@ endif endif endfor - retval(m,:) = lpm3; + retval(m,:) = lpm3(:); if (strcmp (normalization, "unnorm")) scale = -scale * (2*m-1); else @@ -227,7 +225,12 @@ scale = scale .* sqrt(1-x.^2); endfor - retval(n+1,:) = scale; + retval(n+1,:) = scale(:); + + if (isvector (x)) + ## vector case is special + retval = reshape (retval, n + 1, length (x)); + endif if (strcmp (normalization, "sch")) retval(1,:) = retval(1,:) / sqrt (2); @@ -240,6 +243,7 @@ endfunction + %!test %! result = legendre (3, [-1.0 -0.9 -0.8]); %! expected = [ @@ -278,11 +282,25 @@ %!test %! result = legendre (150, 0); %! ## This agrees with Matlab's result. -%! assert (result(end), 3.7532741115719e+306, 0.0000000000001e+306) +%! assert (result(end), 3.7532741115719e+306, 0.0000000000001e+306); %!test %! result = legendre (0, 0:0.1:1); -%! assert (result, full(ones(1,11))) +%! assert (result, full(ones(1,11))); + +%!test +%! result = legendre (3, [-1,0,1;1,0,-1]); +%! ## Test matrix input +%! expected(:,:,1) = [-1,1;0,0;0,0;0,0]; +%! expected(:,:,2) = [0,0;1.5,1.5;0,0;-15,-15]; +%! expected(:,:,3) = [1,-1;0,0;0,0;0,0]; +%! assert (result, expected); + +%!test +%! result = legendre (3, [-1,0,1;1,0,-1]'); +%! expected(:,:,1) = [-1,0,1;0,1.5,0;0,0,0;0,-15,0]; +%! expected(:,:,2) = [1,0,-1;0,1.5,0;0,0,0;0,-15,0]; +%! assert (result, expected); %% Check correct invocation %!error legendre ();
--- a/scripts/specfun/module.mk +++ b/scripts/specfun/module.mk @@ -7,6 +7,7 @@ specfun/factor.m \ specfun/factorial.m \ specfun/isprime.m \ + specfun/lcm.m \ specfun/legendre.m \ specfun/nchoosek.m \ specfun/nthroot.m \
--- a/scripts/specfun/nchoosek.m +++ b/scripts/specfun/nchoosek.m @@ -18,11 +18,13 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{c} =} nchoosek (@var{n}, @var{k}) +## @deftypefn {Function File} {@var{c} =} nchoosek (@var{n}, @var{k}) +## @deftypefnx {Function File} {@var{c} =} nchoosek (@var{set}, @var{k}) ## -## Compute the binomial coefficient or all combinations of @var{n}. -## If @var{n} is a scalar then, calculate the binomial coefficient -## of @var{n} and @var{k}, defined as +## Compute the binomial coefficient or all combinations of a set of items. +## +## If @var{n} is a scalar then calculate the binomial coefficient +## of @var{n} and @var{k} which is defined as ## @tex ## $$ ## {n \choose k} = {n (n-1) (n-2) \cdots (n-k+1) \over k!} @@ -42,17 +44,43 @@ ## @end example ## ## @end ifnottex +## @noindent +## This is the number of combinations of @var{n} items taken in groups of +## size @var{k}. ## -## If @var{n} is a vector generate all combinations of the elements -## of @var{n}, taken @var{k} at a time, one row per combination. The -## resulting @var{c} has size @code{[nchoosek (length (@var{n}), -## @var{k}), @var{k}]}. +## If the first argument is a vector, @var{set}, then generate all +## combinations of the elements of @var{set}, taken @var{k} at a time, with +## one row per combination. The result @var{c} has @var{k} columns and +## @w{@code{nchoosek (length (@var{set}), @var{k})}} rows. +## +## For example: +## +## How many ways can three items be grouped into pairs? ## -## @code{nchoosek} works only for non-negative integer arguments; use -## @code{bincoeff} for non-integer scalar arguments and for using vector -## arguments to compute many coefficients at once. +## @example +## @group +## nchoosek (3, 2) +## @result{} 3 +## @end group +## @end example +## +## What are the possible pairs? ## -## @seealso{bincoeff} +## @example +## @group +## nchoosek (1:3, 2) +## @result{} 1 2 +## 1 3 +## 2 3 +## @end group +## @end example +## +## @code{nchoosek} works only for non-negative, integer arguments. Use +## @code{bincoeff} for non-integer and negative scalar arguments, or for +## computing many binomial coefficients at once with vector inputs +## for @var{n} or @var{k}. +## +## @seealso{bincoeff, perms} ## @end deftypefn ## Author: Rolf Fabian <fabian@tu-cottbus.de> @@ -62,13 +90,13 @@ function A = nchoosek (v, k) if (nargin != 2 - || !isnumeric(k) || !isnumeric(v) - || !isscalar(k) || (!isscalar(v) && !isvector(v))) + || !isnumeric (k) || !isnumeric (v) + || !isscalar (k) || ! (isscalar (v) || isvector (v))) print_usage (); endif - if ((isscalar(v) && v < k) || k < 0 - || k != round(k) || any (v < 0 || v != round(v))) - error ("nchoosek: args are nonnegative integers with V not less than K"); + if (k < 0 || k != fix (k) + || (isscalar (v) && (v < k || v < 0 || v != fix (v)))) + error ("nchoosek: args are non-negative integers with V not less than K"); endif n = length (v); @@ -111,8 +139,19 @@ endif endfunction -%!warning (nchoosek(100,45)); -%!error (nchoosek(100,45.5)); -%!error (nchoosek(100,145)); -%!assert (nchoosek(80,10), bincoeff(80,10)) -%!assert (nchoosek(1:5,3),[1:3;1,2,4;1,2,5;1,3,4;1,3,5;1,4,5;2:4;2,3,5;2,4,5;3:5]) + +%!assert (nchoosek (80,10), bincoeff (80,10)) +%!assert (nchoosek(1:5,3), [1:3;1,2,4;1,2,5;1,3,4;1,3,5;1,4,5;2:4;2,3,5;2,4,5;3:5]) + +%% Test input validation +%!warning nchoosek (100,45); +%!error nchoosek ("100", 45) +%!error nchoosek (100, "45") +%!error nchoosek (100, ones (2,2)) +%!error nchoosek (repmat (100, [2 2]), 45) +%!error nchoosek (100, -45) +%!error nchoosek (100, 45.5) +%!error nchoosek (100, 145) +%!error nchoosek (-100, 45) +%!error nchoosek (100.5, 45) +
--- a/scripts/specfun/nthroot.m +++ b/scripts/specfun/nthroot.m @@ -35,8 +35,9 @@ ## @end group ## @end example ## -## @var{n} must be a scalar. If @var{n} is not an even integer and @var{X} has -## negative entries, an error is produced. +## @var{x} must have all real entries. @var{n} must be a scalar. +## If @var{n} is an even integer and @var{X} has negative entries, an +## error is produced. ## @seealso{realsqrt, sqrt, cbrt} ## @end deftypefn @@ -46,7 +47,11 @@ print_usage (); endif - if (! isscalar (n)) + if (any (iscomplex (x(:)))) + error ("nthroot: X must not contain complex values"); + endif + + if (! isscalar (n) || n == 0) error ("nthroot: N must be a nonzero scalar"); endif @@ -58,7 +63,7 @@ y = 1 ./ nthroot (x, -n); else ## Compute using power. - if (n == round (n) && mod (n, 2) == 1) + if (n == fix (n) && mod (n, 2) == 1) y = abs (x) .^ (1/n) .* sign (x); elseif (any (x(:) < 0)) error ("nthroot: if X contains negative values, N must be an odd integer"); @@ -66,7 +71,7 @@ y = x .^ (1/n); endif - if (finite (n) && n > 0 && n == round (n)) + if (finite (n) && n > 0 && n == fix (n)) ## Correction. y = ((n-1)*y + x ./ (y.^(n-1))) / n; y = merge (finite (y), y, x); @@ -76,8 +81,18 @@ endfunction -%!assert(nthroot(-32,5), -2); -%!assert(nthroot(81,4), 3); -%!assert(nthroot(Inf,4), Inf); -%!assert(nthroot(-Inf,7), -Inf); -%!assert(nthroot(-Inf,-7), 0); +%!assert (nthroot(-32,5), -2); +%!assert (nthroot(81,4), 3); +%!assert (nthroot(Inf,4), Inf); +%!assert (nthroot(-Inf,7), -Inf); +%!assert (nthroot(-Inf,-7), 0); + +%% Test input validation +%!error (nthroot ()) +%!error (nthroot (1)) +%!error (nthroot (1,2,3)) +%!error (nthroot (1+j,2)) +%!error (nthroot (1,[1 2])) +%!error (nthroot (1,0)) +%!error (nthroot (-1,2)) +
--- a/scripts/specfun/perms.m +++ b/scripts/specfun/perms.m @@ -63,3 +63,11 @@ endfor endif endfunction + +%!error perms (); +%!error perms (1, 2); + +%!assert (perms ([1,2,3]), [1,2,3;2,1,3;1,3,2;2,3,1;3,1,2;3,2,1]); +%!assert (perms (1:3), perms ([1,2,3])); + +%!assert (perms (int8([1,2,3])), int8([1,2,3;2,1,3;1,3,2;2,3,1;3,1,2;3,2,1]));
--- a/scripts/specfun/primes.m +++ b/scripts/specfun/primes.m @@ -92,3 +92,11 @@ endif endfunction + +%!error primes (); +%!error primes (1, 2); + +%!assert (size (primes (350)), [1, 70]); +%!assert (size (primes (350)), [1, 70]); + +%!assert (primes (357)(end), 353);
--- a/scripts/special-matrix/hadamard.m +++ b/scripts/special-matrix/hadamard.m @@ -21,32 +21,32 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} hadamard (@var{n}) -## Construct a Hadamard matrix @var{Hn} of size @var{n}-by-@var{n}. The -## size @var{n} must be of the form @code{2 ^ @var{k} * @var{p}} in which -## @var{p} is one of 1, 12, 20 or 28. The returned matrix is normalized, -## meaning @code{Hn(:,1) == 1} and @code{Hn(1,:) == 1}. +## Construct a Hadamard matrix (@nospell{Hn}) of size @var{n}-by-@var{n}. The +## size @var{n} must be of the form @math{2^k * p} in which +## p is one of 1, 12, 20 or 28. The returned matrix is normalized, +## meaning @w{@code{Hn(:,1) == 1}} and @w{@code{Hn(1,:) == 1}}. ## ## Some of the properties of Hadamard matrices are: ## ## @itemize @bullet ## @item -## @code{kron (@var{Hm}, @var{Hn})} is a Hadamard matrix of size -## @var{m}-by-@var{n}. +## @code{kron (Hm, Hn)} is a Hadamard matrix of size @var{m}-by-@var{n}. ## ## @item -## @code{Hn * Hn' == @var{n} * eye (@var{n})}. +## @code{Hn * Hn' = @var{n} * eye (@var{n})}. +## +## @item +## The rows of @nospell{Hn} are orthogonal. ## ## @item -## The rows of @var{Hn} are orthogonal. +## @code{det (@var{A}) <= abs (det (Hn))} for all @var{A} with +## @w{@code{abs (@var{A}(i, j)) <= 1}}. ## ## @item -## @code{det (@var{A}) <= abs(det (@var{Hn}))} for all @var{A} with -## @code{abs (@var{A} (@var{i}, @var{j})) <= 1}. -## -## @item -## Multiply any row or column by -1 and still have a Hadamard matrix. +## Multiplying any row or column by -1 and the matrix will remain a Hadamard +## matrix. ## @end itemize -## +## @seealso{compan, hankel, toeplitz} ## @end deftypefn @@ -66,9 +66,9 @@ ## Find k if n = 2^k*p. k = 0; - while (n > 1 && floor (n/2) == n/2) + while (n > 1 && fix (n/2) == n/2) k++; - n = n/2; + n /= 2; endwhile ## Find base hadamard. @@ -90,7 +90,7 @@ case 5 h = h20 (); case 7 - h = hnormalize (h28 ()); + h = h28 (); otherwise error ("hadamard: N must be 2^k*p, for p = 1, 12, 20 or 28"); endswitch @@ -98,15 +98,16 @@ ## Build H(2^k*n) from kron(H(2^k),H(n)). h2 = [1,1;1,-1]; while (true) - if (floor (k/2) != k/2) + if (fix (k/2) != k/2) h = kron (h2, h); endif - k = floor (k/2); + k = fix (k/2); if (k == 0) break; endif h2 = kron (h2, h2); endwhile + endfunction function h = h12 () @@ -117,7 +118,6 @@ h(2:end,2:end) = toeplitz (tu, tl); endfunction - function h = h20 () tu = [+1,-1,-1,+1,+1,+1,+1,-1,+1,-1,+1,-1,-1,-1,-1,+1,+1,-1,-1]; tl = [+1,-1,-1,+1,+1,-1,-1,-1,-1,+1,-1,+1,-1,+1,+1,+1,+1,-1,-1]; @@ -126,53 +126,50 @@ h(2:end,2:end) = fliplr (toeplitz (tu, tl)); endfunction -function h = hnormalize (h) - ## Make sure each row and column starts with +1. - h(h(:,1)==-1,:) *= -1; - h(:,h(1,:)==-1) *= -1; -endfunction - function h = h28 () ## Williamson matrix construction from ## http://www.research.att.com/~njas/hadamard/had.28.will.txt - s = ["+------++----++-+--+-+--++--"; - "-+-----+++-----+-+--+-+--++-"; - "--+-----+++---+-+-+----+--++"; - "---+-----+++---+-+-+-+--+--+"; - "----+-----+++---+-+-+++--+--"; - "-----+-----++++--+-+--++--+-"; - "------++----++-+--+-+--++--+"; - "--++++-+-------++--+++-+--+-"; - "---++++-+-----+-++--+-+-+--+"; - "+---+++--+----++-++--+-+-+--"; - "++---++---+----++-++--+-+-+-"; - "+++---+----+----++-++--+-+-+"; - "++++--------+-+--++-++--+-+-"; - "-++++--------+++--++--+--+-+"; - "-+-++-++--++--+--------++++-"; - "+-+-++--+--++--+--------++++"; - "-+-+-++--+--++--+----+---+++"; - "+-+-+-++--+--+---+---++---++"; - "++-+-+-++--+------+--+++---+"; - "-++-+-+-++--+------+-++++---"; - "+-++-+---++--+------+-++++--"; - "-++--++-+-++-+++----++------"; - "+-++--++-+-++-+++-----+-----"; - "++-++---+-+-++-+++-----+----"; - "-++-++-+-+-+-+--+++-----+---"; - "--++-++++-+-+----+++-----+--"; - "+--++-+-++-+-+----+++-----+-"; - "++--++-+-++-+-+----++------+"]; - ## Without this, the assignment of -1 will not work properly - ## (compatibility forces LHS(idx) = ANY_VAL to keep the LHS logical - ## instead of widening to a type that can represent ANY_VAL). - h = double (s == "+"); - h(!h) = -1; + ## Normalized so that each row and column starts with +1 + h = [1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 -1 -1 -1 -1 -1 -1 -1 1 -1 -1 -1 1 1 1 1 1 -1 1 1 1 1 -1 1 -1 1 -1 + 1 -1 1 -1 -1 -1 -1 1 -1 1 1 -1 -1 1 -1 -1 -1 -1 1 1 -1 1 -1 1 1 1 1 1 + 1 -1 -1 1 -1 -1 -1 1 1 1 1 1 -1 1 1 1 1 1 -1 -1 -1 -1 -1 -1 -1 1 -1 1 + 1 -1 -1 -1 1 -1 -1 1 1 -1 1 1 1 1 1 -1 -1 -1 1 1 1 -1 1 -1 1 -1 -1 -1 + 1 -1 -1 -1 -1 1 -1 1 1 -1 -1 1 1 -1 -1 -1 1 1 -1 -1 -1 1 1 1 1 1 1 -1 + 1 -1 -1 -1 -1 -1 1 -1 1 -1 -1 -1 1 -1 1 1 1 -1 1 1 1 1 -1 1 -1 1 -1 1 + 1 -1 1 1 1 1 -1 -1 1 -1 -1 -1 -1 1 1 1 -1 -1 -1 -1 1 -1 -1 1 1 1 1 -1 + 1 -1 -1 1 1 1 1 1 -1 -1 -1 -1 -1 1 -1 -1 -1 1 -1 1 1 1 1 -1 -1 1 -1 1 + 1 1 1 1 -1 -1 -1 -1 -1 -1 1 1 1 -1 1 -1 -1 -1 -1 -1 1 1 1 -1 -1 1 1 1 + 1 -1 1 1 1 -1 -1 -1 -1 1 -1 1 1 -1 -1 -1 1 1 -1 1 1 -1 -1 1 1 -1 -1 1 + 1 -1 -1 1 1 1 -1 -1 -1 1 1 -1 1 -1 -1 1 1 -1 1 1 -1 -1 1 -1 -1 1 1 -1 + 1 -1 -1 -1 1 1 1 -1 -1 1 1 1 -1 -1 1 1 -1 -1 -1 -1 -1 1 1 1 1 -1 -1 1 + 1 1 1 1 1 -1 -1 1 1 -1 -1 -1 -1 -1 -1 1 1 -1 1 -1 -1 1 1 -1 1 -1 -1 1 + 1 1 -1 1 1 -1 1 -1 1 -1 1 1 -1 1 -1 -1 1 -1 -1 1 -1 1 -1 1 -1 -1 1 -1 + 1 1 -1 1 -1 -1 1 -1 1 1 1 -1 -1 -1 -1 -1 -1 1 1 -1 1 -1 1 1 1 1 -1 -1 + 1 1 -1 1 -1 1 1 1 1 1 -1 -1 1 -1 1 -1 -1 -1 -1 1 -1 -1 -1 -1 1 -1 1 1 + 1 1 -1 1 -1 1 -1 1 -1 1 -1 1 1 1 -1 1 -1 -1 1 -1 1 1 -1 1 -1 -1 -1 -1 + 1 -1 1 -1 1 -1 1 1 1 1 1 -1 1 -1 -1 1 -1 1 -1 -1 1 1 -1 -1 -1 -1 1 -1 + 1 1 1 -1 1 -1 1 1 -1 1 -1 -1 1 1 1 -1 1 -1 -1 -1 -1 -1 1 1 -1 1 -1 -1 + 1 1 -1 -1 1 -1 1 -1 -1 -1 -1 1 1 1 -1 1 -1 1 1 -1 -1 -1 -1 -1 1 1 1 1 + 1 1 1 -1 -1 1 1 1 -1 -1 1 1 -1 -1 -1 1 1 -1 -1 1 1 -1 -1 -1 1 1 -1 -1 + 1 1 -1 -1 1 1 -1 1 -1 -1 1 -1 -1 -1 1 -1 1 1 1 -1 1 -1 -1 1 -1 -1 1 1 + 1 -1 1 -1 -1 1 1 -1 1 1 -1 1 -1 1 -1 -1 1 -1 1 -1 1 -1 1 -1 -1 -1 1 1 + 1 1 1 -1 1 1 -1 -1 1 1 -1 1 -1 -1 1 -1 -1 1 1 1 -1 1 -1 -1 -1 1 -1 -1 + 1 -1 1 1 -1 1 1 -1 -1 -1 1 -1 1 1 1 -1 1 1 1 -1 -1 1 -1 -1 1 -1 -1 -1 + 1 1 1 -1 -1 1 -1 -1 1 -1 1 -1 1 1 -1 1 -1 1 -1 1 -1 -1 1 1 -1 -1 -1 1 + 1 -1 1 1 -1 -1 1 1 -1 -1 -1 1 -1 -1 1 1 -1 1 1 1 -1 -1 1 1 -1 -1 1 -1]; endfunction -%!assert(hadamard(1),1) -%!assert(hadamard(2),[1,1;1,-1]) + +%!assert (hadamard (1), 1) +%!assert (hadamard (2), [1,1;1,-1]) %!test -%! for n=[1,2,4,8,12,24,48,20,28,2^9] -%! h=hadamard(n); assert(norm(h*h'-n*eye(n)),0); -%! end +%! for n = [1,2,4,8,12,24,48,20,28,2^9] +%! h = hadamard(n); +%! assert (norm (h*h' - n*eye (n)), 0); +%! endfor + +%!error hadamard () +%!error hadamard (1,2) +%!error <N must be 2\^k\*p> hadamard (5) +
--- a/scripts/special-matrix/hankel.m +++ b/scripts/special-matrix/hankel.m @@ -19,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} hankel (@var{c}) ## @deftypefnx {Function File} {} hankel (@var{c}, @var{r}) -## Return the Hankel matrix constructed given the first column @var{c}, and +## Return the Hankel matrix constructed from the first column @var{c}, and ## (optionally) the last row @var{r}. If the last element of @var{c} is ## not the same as the first element of @var{r}, the last element of ## @var{c} is used. If the second argument is omitted, it is assumed to @@ -42,76 +42,57 @@ ## @end example ## ## @end ifnottex -## @seealso{vander, sylvester_matrix, hilb, invhilb, toeplitz} +## @seealso{hadamard, toeplitz} ## @end deftypefn ## Author: jwe function retval = hankel (c, r) - if (nargin == 1) - r = resize (resize (c, 0), size(c)); - elseif (nargin != 2) + if (nargin < 1 || nargin > 2) print_usage (); endif - [c_nr, c_nc] = size (c); - [r_nr, r_nc] = size (r); - - if ((c_nr != 1 && c_nc != 1) || (r_nr != 1 && r_nc != 1)) - error ("hankel: expecting vector arguments"); - endif - if (nargin == 1) - r (1) = c (length (c)); - endif + + if (! isvector (c)) + error ("hankel: C must be a vector"); + endif - if (c_nc != 1) - c = c.'; - endif + nr = length (c); + nc = nr; + data = [c(:) ; zeros(nr, 1)]; + + else - if (r_nr != 1) - r = r.'; - endif + if (! (isvector (c) && isvector (r))) + error ("hankel: C and R must be vectors"); + elseif (r(1) != c(end)) + warning ("hankel: column wins anti-diagonal conflict"); + endif - nc = length (r); - nr = length (c); + nr = length (c); + nc = length (r); + data = [c(:) ; r(2:end)(:)]; - if (r (1) != c (nr)) - warning ("hankel: column wins anti-diagonal conflict"); endif - - ## This should probably be done with the colon operator... - - retval = resize (resize (c, 0), nr, nc); - - for i = 1:min (nr, nc) - retval (1:nr-i+1, i) = c (i:nr); - endfor - - tmp = 1; - if (nc <= nr) - tmp = nr - nc + 2; - endif - - for i = nr:-1:tmp - retval (i, 2+nr-i:nc) = r (2:nc-nr+i); - endfor + + slices = cellslices (data, 1:nc, nr:1:nc+nr-1); + retval = horzcat (slices{:}); endfunction -%!assert(hankel(1:3),[1,2,3;2,3,0;3,0,0]) -%!assert(hankel(1),[1]); -%!assert(hankel(1:3,3:6),[1,2,3,4;2,3,4,5;3,4,5,6]); -%!assert(hankel(1:3,3:4),[1,2;2,3;3,4]); -%!assert(hankel(1:3,4:6),[1,2,3;2,3,5;3,5,6]); -%!assert((hankel (1) == 1 && hankel ([1, 2]) == [1, 2; 2, 0] -%! && hankel ([1, 2], [2; -1; -3]) == [1, 2, -1; 2, -1, -3])); - -%!error hankel ([1, 2; 3, 4], [1, 2; 3, 4]); +%!assert (hankel (1), [1]) +%!assert (hankel ([1, 2]), [1, 2; 2, 0]) +%!assert (hankel ([1, 2], [2; -1; -3]), [1, 2, -1; 2, -1, -3]) +%!assert (hankel (1:3), [1,2,3;2,3,0;3,0,0]) +%!assert (hankel (1:3,3:6), [1,2,3,4;2,3,4,5;3,4,5,6]) +%!assert (hankel (1:3,3:4), [1,2;2,3;3,4]) +%!assert (hankel (1:3,4:6), [1,2,3;2,3,5;3,5,6]) %!error hankel (); +%!error hankel (1, 2, 3); +%!error <C must be a vector> hankel ([1, 2; 3, 4]) +%!error <C and R must be vectors> hankel (1:4, [1, 2; 3, 4]) -%!error hankel (1, 2, 3); -
--- a/scripts/special-matrix/hilb.m +++ b/scripts/special-matrix/hilb.m @@ -18,14 +18,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} hilb (@var{n}) -## Return the Hilbert matrix of order @var{n}. The -## @tex -## $i,\,j$ -## @end tex -## @ifnottex -## i, j -## @end ifnottex -## element of a Hilbert matrix is defined as +## Return the Hilbert matrix of order @var{n}. The @math{i,j} element +## of a Hilbert matrix is defined as ## @tex ## $$ ## H (i, j) = {1 \over (i + j - 1)} @@ -38,35 +32,48 @@ ## @end example ## ## @end ifnottex -## @seealso{hankel, vander, sylvester_matrix, invhilb, toeplitz} +## +## Hilbert matrices are close to being singular which make them difficult to +## invert with numerical routines. +## Comparing the condition number of a random matrix 5x5 matrix with that of +## a Hilbert matrix of order 5 reveals just how difficult the problem is. +## +## @example +## @group +## cond (rand (5)) +## @result{} 14.392 +## cond (hilb (5)) +## @result{} 4.7661e+05 +## @end group +## @end example +## +## @seealso{invhilb} ## @end deftypefn ## Author: jwe function retval = hilb (n) - if (nargin != 1) print_usage (); + elseif (! isscalar (n)) + error ("hilb: N must be a scalar integer"); endif - nmax = length (n); - if (nmax == 1) - retval = zeros (n); - tmp = 1:n; - for i = 1:n - retval (i, :) = 1.0 ./ (tmp + (i - 1)); - endfor - else - error ("hilb: expecting scalar argument, found something else"); - endif + retval = zeros (n); + tmp = 1:n; + for i = 1:n + retval(i, :) = 1.0 ./ tmp; + tmp++; + endfor endfunction -%!assert((hilb (2) == [1, 1/2; 1/2, 1/3] -%! && hilb (3) == [1, 1/2, 1/3; 1/2, 1/3, 1/4; 1/3, 1/4, 1/5])); + +%!assert (hilb (2), [1, 1/2; 1/2, 1/3]) +%!assert (hilb (3), [1, 1/2, 1/3; 1/2, 1/3, 1/4; 1/3, 1/4, 1/5]) -%!error hilb (); +%!error hilb () +%!error hilb (1, 2) +%!error <N must be a scalar integer> hilb (ones(2)) -%!error hilb (1, 2); -
--- a/scripts/special-matrix/invhilb.m +++ b/scripts/special-matrix/invhilb.m @@ -68,7 +68,7 @@ ## Compare this with the numerical calculation of @code{inverse (hilb (n))}, ## which suffers from the ill-conditioning of the Hilbert matrix, and the ## finite precision of your computer's floating point arithmetic. -## @seealso{hilb, hankel, vander, sylvester_matrix, toeplitz} +## @seealso{hilb} ## @end deftypefn ## Author: Dirk Laurie <dlaurie@na-net.ornl.gov> @@ -77,57 +77,52 @@ if (nargin != 1) print_usage (); + elseif (! isscalar (n)) + error ("invhilb: N must be a scalar integer"); endif - nmax = length (n); - if (nmax == 1) + ## The point about the second formula above is that when vectorized, + ## p(k) is evaluated for k=1:n which involves O(n) calls to bincoeff + ## instead of O(n^2). + ## + ## We evaluate the expression as (-1)^(i+j)*(p(i)*p(j))/(i+j-1) except + ## when p(i)*p(j) would overflow. In cases where p(i)*p(j) is an exact + ## machine number, the result is also exact. Otherwise we calculate + ## (-1)^(i+j)*p(i)*(p(j)/(i+j-1)). + ## + ## The Octave bincoeff routine uses transcendental functions (gammaln + ## and exp) rather than multiplications, for the sake of speed. + ## However, it rounds the answer to the nearest integer, which + ## justifies the claim about exactness made above. - ## The point about the second formula above is that when vectorized, - ## p(k) is evaluated for k=1:n which involves O(n) calls to bincoeff - ## instead of O(n^2). - ## - ## We evaluate the expression as (-1)^(i+j)*(p(i)*p(j))/(i+j-1) except - ## when p(i)*p(j) would overflow. In cases where p(i)*p(j) is an exact - ## machine number, the result is also exact. Otherwise we calculate - ## (-1)^(i+j)*p(i)*(p(j)/(i+j-1)). - ## - ## The Octave bincoeff routine uses transcendental functions (gammaln - ## and exp) rather than multiplications, for the sake of speed. - ## However, it rounds the answer to the nearest integer, which - ## justifies the claim about exactness made above. - - retval = zeros (n); - k = [1:n]; - p = k .* bincoeff (k+n-1, k-1) .* bincoeff (n, k); - p(2:2:n) = -p(2:2:n); - if (n < 203) - for l = 1:n - retval(l,:) = (p(l) * p) ./ [l:l+n-1]; - endfor - else - for l = 1:n - retval(l,:) = p(l) * (p ./ [l:l+n-1]); - endfor - endif + retval = zeros (n); + k = [1:n]; + p = k .* bincoeff (k+n-1, k-1) .* bincoeff (n, k); + p(2:2:n) = -p(2:2:n); + if (n < 203) + for l = 1:n + retval(l,:) = (p(l) * p) ./ [l:l+n-1]; + endfor else - error ("invhilb: expecting scalar argument, found something else"); + for l = 1:n + retval(l,:) = p(l) * (p ./ [l:l+n-1]); + endfor endif endfunction + +%!assert (invhilb (1), 1) +%!assert (invhilb (2), [4, -6; -6, 12]) %!test -%! result4 = [16, -120, 240, -140; -%! -120, 1200, -2700, 1680; -%! 240, -2700, 6480, -4200; -%! -140, 1680, -4200, 2800]; -%! -%! assert((invhilb (1) == 1 && invhilb (2) == [4, -6; -6, 12] -%! && invhilb (4) == result4 -%! && abs (invhilb (7) * hilb (7) - eye (7)) < sqrt (eps))); +%! result4 = [16 , -120 , 240 , -140; +%! -120, 1200 , -2700, 1680; +%! 240 , -2700, 6480 , -4200; +%! -140, 1680 , -4200, 2800]; +%! assert (invhilb (4), result4); +%!assert (abs (invhilb (7) * hilb (7) - eye (7)) < sqrt (eps)) -%!error invhilb ([1, 2]); +%!error invhilb () +%!error invhilb (1, 2) +%!error <N must be a scalar integer> invhilb ([1, 2]) -%!error invhilb (); - -%!error invhilb (1, 2); -
--- a/scripts/special-matrix/magic.m +++ b/scripts/special-matrix/magic.m @@ -19,9 +19,11 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} magic (@var{n}) ## -## Create an @var{n}-by-@var{n} magic square. Note that @code{magic -## (@var{2})} is undefined since there is no 2-by-2 magic square. +## Create an @var{n}-by-@var{n} magic square. A magic square is an arrangement +## of the integers @code{1:n^2} such that the row sums, column sums, and +## diagonal sums are all equal to the same value. ## +## Note: @var{n} must be greater than 2 for the magic square to exist. ## @end deftypefn function A = magic(n) @@ -30,8 +32,8 @@ print_usage (); endif - if (n != floor (n) || n < 0 || n == 2) - error ("magic: N must be an positive integer not equal to 2"); + if (n != fix (n) || n < 0 || n == 2) + error ("magic: N must be a positive integer not equal to 2"); endif if (n == 0) @@ -43,7 +45,7 @@ shift = floor ((0:n*n-1)/n); c = mod ([1:n*n] - shift + (n-3)/2, n); r = mod ([n*n:-1:1] + 2*shift, n); - A (c*n+r+1) = 1:n*n; + A(c*n+r+1) = 1:n*n; A = reshape (A, n, n); elseif (mod (n, 4) == 0) @@ -62,7 +64,7 @@ A = magic (m); A = [A, A+2*m*m; A+3*m*m, A+m*m]; k = (m-1)/2; - if (k>1) + if (k > 1) I = 1:m; J = [2:k, n-k+2:n]; A([I,I+m],J) = A([I+m,I],J); @@ -76,11 +78,20 @@ endfunction + %!test %! for i=3:30 -%! A=magic(i); -%! assert(norm(diff([sum(diag(A)),sum(diag(flipud(A))),sum(A),sum(A')])),0) +%! A = magic (i); +%! assert (norm(diff([sum(diag(A)),sum(diag(flipud(A))),sum(A),sum(A')])),0); %! endfor -%!assert(isempty(magic(0))); -%!assert(magic(1),1); -%!error magic(2) + +%!assert (isempty (magic (0))) +%!assert (magic(1), 1) + +%% Test input validation +%!error magic () +%!error magic (1, 2) +%!error <N must be a positive integer not equal to 2> magic (1.5) +%!error <N must be a positive integer not equal to 2> magic (-1) +%!error <N must be a positive integer not equal to 2> magic (2) +
--- a/scripts/special-matrix/module.mk +++ b/scripts/special-matrix/module.mk @@ -8,7 +8,6 @@ special-matrix/magic.m \ special-matrix/pascal.m \ special-matrix/rosser.m \ - special-matrix/sylvester_matrix.m \ special-matrix/toeplitz.m \ special-matrix/vander.m \ special-matrix/wilkinson.m
--- a/scripts/special-matrix/pascal.m +++ b/scripts/special-matrix/pascal.m @@ -20,75 +20,71 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} pascal (@var{n}) ## @deftypefnx {Function File} {} pascal (@var{n}, @var{t}) -## Return the Pascal matrix of order @var{n} if @code{@var{t} = 0}. -## @var{t} defaults to 0. Return the pseudo-lower triangular -## Cholesky@tie{}factor of the Pascal matrix if @code{@var{t} = 1} (The sign -## of some columns may be negative). This matrix is its own -## inverse, that is @code{pascal (@var{n}, 1) ^ 2 == eye (@var{n})}. -## If @code{@var{t} = -1}, return the true Cholesky@tie{}factor with strictly -## positive values on the diagonal. -## If @code{@var{t} = 2}, return a transposed and permuted version of -## @code{pascal (@var{n}, 1)}, which is the cube root of the identity -## matrix. That is, @code{pascal (@var{n}, 2) ^ 3 == eye (@var{n})}. +## Return the Pascal matrix of order @var{n} if @code{@var{t} = 0}. @var{t} +## defaults to 0. Return the pseudo-lower triangular Cholesky@tie{}factor of +## the Pascal matrix if @code{@var{t} = 1} (The sign of some columns may be +## negative). This matrix is its own inverse, that is @code{pascal (@var{n}, +## 1) ^ 2 == eye (@var{n})}. If @code{@var{t} = -1}, return the true +## Cholesky@tie{}factor with strictly positive values on the diagonal. If +## @code{@var{t} = 2}, return a transposed and permuted version of @code{pascal +## (@var{n}, 1)}, which is the cube root of the identity matrix. That is, +## @code{pascal (@var{n}, 2) ^ 3 == eye (@var{n})}. ## -## @seealso{hankel, vander, sylvester_matrix, hilb, invhilb, toeplitz, -## hadamard, wilkinson, compan, rosser} +## @seealso{chol} ## @end deftypefn ## Author: Peter Ekberg ## (peda) -function retval = pascal (n, t) - - if (nargin > 2) || (nargin == 0) - print_usage (); - endif +function retval = pascal (n, t = 0) - if (nargin == 1) - t = 0; - endif - - if (! isscalar (n) || ! isscalar (t)) - error ("pascal: expecting scalar arguments, found something else"); - endif - - if (t < -1 || t > 2) + if (nargin < 1 || nargin > 2) + print_usage (); + elseif (! (isscalar (n) && isscalar (t))) + error ("pascal: N and T must be scalars"); + elseif (! any (t == [-1, 0, 1, 2])) error ("pascal: expecting T to be -1, 0, 1, or 2, found %d", t); endif retval = zeros (n); - retval(:,1) = 1; + if (n > 0) + retval(:,1) = 1; + endif if (t == -1) for j = 2:n - retval(j:n,j) = cumsum (retval (j-1:n-1,j-1)); + retval(j:n,j) = cumsum (retval(j-1:n-1,j-1)); endfor else for j = 2:n - retval(j:n,j) = -cumsum (retval (j-1:n-1,j-1)); + retval(j:n,j) = -cumsum (retval(j-1:n-1,j-1)); endfor endif if (t == 0) retval = retval*retval'; elseif (t == 2) - retval = retval'; - retval = retval(n:-1:1,:); - retval(:,n) = -retval(:,n); - retval(n,:) = -retval(n,:); - if (rem(n,2) != 1) - retval = -retval; + retval = rot90 (retval, 3); + if (rem (n,2) != 1) + retval *= -1; endif endif endfunction -%!assert (pascal(3,-1), [1,0,0;1,1,0;1,2,1]) -%!assert (pascal(3,0), [1,1,1;1,2,3;1,3,6]) -%!assert (pascal(3,0), pascal(3)) -%!assert (pascal(3,1), [1,0,0;1,-1,0;1,-2,1]) -%!assert (pascal(3,2), [0,0,-1;0,-1,2;-1,-1,1]) -%!error (pascal(3,4)) -%!error (pascal(3,-2)) -%!error (pascal()) -%!error (pascal(1,2,3)) + +%!assert (pascal (3,-1), [1,0,0;1,1,0;1,2,1]) +%!assert (pascal (3,0), [1,1,1;1,2,3;1,3,6]) +%!assert (pascal (3,0), pascal (3)) +%!assert (pascal (3,1), [1,0,0;1,-1,0;1,-2,1]) +%!assert (pascal (3,2), [1,1,1;-2,-1,0;1,0,0]) +%!assert (pascal (0,2), []) + +%% Test input validation +%!error pascal () +%!error pascal (1,2,3) +%!error <N and T must be scalars> pascal ([1 2]) +%!error <N and T must be scalars> pascal (1, [1 2]) +%!error <expecting T to be> pascal (3,-2) +%!error <expecting T to be> pascal (3,4) +
--- a/scripts/special-matrix/rosser.m +++ b/scripts/special-matrix/rosser.m @@ -21,8 +21,7 @@ ## Return the Rosser matrix. This is a difficult test case used to evaluate ## eigenvalue algorithms. ## -## @seealso{hankel, vander, sylvester_matrix, hilb, invhilb, toeplitz, -## hadamard, wilkinson, compan, pascal} +## @seealso{wilkinson, eig} ## @end deftypefn ## Author: Peter Ekberg @@ -42,6 +41,7 @@ -52, -43, 49, 44, -599, 411, 208, 208; -49, -8, 8, 59, 208, 208, 99, -911; 29, -44, 52, -23, 208, 208, -911, 99]; + endfunction %!assert (size(rosser()), [8,8])
--- a/scripts/special-matrix/toeplitz.m +++ b/scripts/special-matrix/toeplitz.m @@ -20,9 +20,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} toeplitz (@var{c}) ## @deftypefnx {Function File} {} toeplitz (@var{c}, @var{r}) -## Return the Toeplitz matrix constructed given the first column @var{c}, -## and (optionally) the first row @var{r}. If the first element of @var{c} -## is not the same as the first element of @var{r}, the first element of +## Return the Toeplitz matrix constructed from the first column @var{c}, +## and (optionally) the first row @var{r}. If the first element of @var{r} +## is not the same as the first element of @var{c}, the first element of ## @var{c} is used. If the second argument is omitted, the first row is ## taken to be the same as the first column. ## @@ -51,57 +51,62 @@ ## @end example ## ## @end ifnottex -## @seealso{hankel, vander, sylvester_matrix, hilb, invhilb} +## @seealso{hankel} ## @end deftypefn ## Author: jwe && jh function retval = toeplitz (c, r) - if (nargin == 1) - r = c; - elseif (nargin != 2) + if (nargin < 1 || nargin > 2) print_usage (); endif - if (! (isvector (c) && isvector (r))) - error ("toeplitz: expecting vector arguments"); + if (nargin == 1) + if (! isvector (c)) + error ("toeplitz: C must be a vector"); + endif + + r = c; + nr = length (c); + nc = nr; + else + if (! (isvector (c) && isvector (r))) + error ("toeplitz: C and R must be vectors"); + elseif (r(1) != c(1)) + warning ("toeplitz: column wins anti-diagonal conflict"); + endif + + nr = length (c); + nc = length (r); endif - nc = length (r); - nr = length (c); - if (nr == 0 || nc == 0) ## Empty matrix. retval = zeros (nr, nc, class (c)); return; endif - if (r (1) != c (1)) - warning ("toeplitz: column wins diagonal conflict"); - endif - ## If we have a single complex argument, we want to return a ## Hermitian-symmetric matrix (actually, this will really only be ## Hermitian-symmetric if the first element of the vector is real). - if (nargin == 1 && iscomplex (c)) c = conj (c); c(1) = conj (c(1)); endif - if (issparse(c) && issparse(r)) - c = c(:).'; - r = r(:).'; - cidx = find(c); - ridx = find(r); + if (issparse (c) && issparse (r)) + c = c(:).'; ## enforce row vector + r = r(:).'; ## enforce row vector + cidx = find (c); + ridx = find (r); ## Ignore the first element in r. ridx = ridx(ridx > 1); ## Form matrix. - retval = spdiags(repmat(c(cidx),nr,1),1-cidx,nr,nc)+... - spdiags(repmat(r(ridx),nr,1),ridx-1,nr,nc); + retval = spdiags(repmat (c(cidx),nr,1),1-cidx,nr,nc) + ... + spdiags(repmat (r(ridx),nr,1),ridx-1,nr,nc); else ## Concatenate data into a single column vector. data = [r(end:-1:2)(:); c(:)]; @@ -112,15 +117,18 @@ ## Form matrix. retval = horzcat (slices{:}); endif + endfunction -%!assert((toeplitz (1) == 1 -%! && toeplitz ([1, 2, 3], [1; -3; -5]) == [1, -3, -5; 2, 1, -3; 3, 2, 1] -%! && toeplitz ([1, 2, 3], [1; -3i; -5i]) == [1, -3i, -5i; 2, 1, -3i; 3, 2, 1])); + +%!assert (toeplitz (1), [1]) +%!assert (toeplitz ([1, 2, 3], [1; -3; -5]), [1, -3, -5; 2, 1, -3; 3, 2, 1]) +%!assert (toeplitz ([1, 2, 3], [1; -3i; -5i]), [1, -3i, -5i; 2, 1, -3i; 3, 2, 1]) -%!error toeplitz ([1, 2; 3, 4], 1); +%% Test input validation +%!error toeplitz () +%!error toeplitz (1, 2, 3) +%!error <C must be a vector> toeplitz ([1, 2; 3, 4]) +%!error <C and R must be vectors> toeplitz ([1, 2; 3, 4], 1) +%!error <C and R must be vectors> toeplitz (1, [1, 2; 3, 4]) -%!error toeplitz (); - -%!error toeplitz (1, 2, 3); -
--- a/scripts/special-matrix/vander.m +++ b/scripts/special-matrix/vander.m @@ -47,7 +47,7 @@ ## @end example ## ## @end ifnottex -## @seealso{hankel, sylvester_matrix, hilb, invhilb, toeplitz} +## @seealso{polyfit} ## @end deftypefn ## Author: jwe @@ -60,37 +60,36 @@ print_usage (); endif - if (isvector (c)) - retval = zeros (length (c), n, class (c)); - ## avoiding many ^s appears to be faster for n >= 100. - d = 1; - c = c(:); - for i = n:-1:1 - retval(:,i) = d; - d = c .* d; - endfor - else - error ("vander: argument must be a vector"); + if (! isvector (c)) + error ("vander: polynomial C must be a vector"); endif + ## avoiding many ^s appears to be faster for n >= 100. + retval = zeros (length (c), n, class (c)); + d = 1; + c = c(:); + for i = n:-1:1 + retval(:,i) = d; + d .*= c; + endfor + endfunction + %!test %! c = [0,1,2,3]; %! expect = [0,0,0,1; 1,1,1,1; 8,4,2,1; 27,9,3,1]; -%! result = vander(c); -%! assert(expect, result); +%! assert(vander (c), expect); -%!assert((vander (1) == 1 && vander ([1, 2, 3]) == vander ([1; 2; 3]) -%! && vander ([1, 2, 3]) == [1, 1, 1; 4, 2, 1; 9, 3, 1] -%! && vander ([1, 2, 3]*i) == [-1, i, 1; -4, 2i, 1; -9, 3i, 1])); +%!assert (vander (1), 1) +%!assert (vander ([1, 2, 3]), vander ([1; 2; 3])) +%!assert (vander ([1, 2, 3]), [1, 1, 1; 4, 2, 1; 9, 3, 1]) +%!assert (vander ([1, 2, 3]*i), [-1, i, 1; -4, 2i, 1; -9, 3i, 1]) %!assert(vander (2, 3), [4, 2, 1]) %!assert(vander ([2, 3], 3), [4, 2, 1; 9, 3, 1]) -%!error vander ([1, 2; 3, 4]); +%!error vander (); +%!error vander (1, 2, 3); +%!error <polynomial C must be a vector> vander ([1, 2; 3, 4]); -%!error vander (); - -%!error vander (1, 2, 3); -
--- a/scripts/special-matrix/wilkinson.m +++ b/scripts/special-matrix/wilkinson.m @@ -20,10 +20,10 @@ ## @deftypefn {Function File} {} wilkinson (@var{n}) ## Return the Wilkinson matrix of order @var{n}. Wilkinson matrices are ## symmetric and tridiagonal with pairs of nearly, but not exactly, equal -## eigenvalues. +## eigenvalues. They are useful in testing the behavior and performance +## of eigenvalue solvers. ## -## @seealso{hankel, vander, sylvester_matrix, hilb, invhilb, toeplitz, -## hadamard, rosser, compan, pascal} +## @seealso{rosser, eig} ## @end deftypefn ## Author: Peter Ekberg @@ -35,8 +35,8 @@ print_usage (); endif - if (! (isscalar (n) && (n == fix (n)) && n > 0)) - error ("wilkinson: N must be an integer greater than 0"); + if (! (isscalar (n) && n >= 0 && (n == fix (n)))) + error ("wilkinson: N must be a non-negative integer"); endif side = ones (n-1, 1); @@ -45,9 +45,17 @@ endfunction -%!assert (wilkinson(1), []) -%!assert (wilkinson(2), [0.5,1;1,0.5]) -%!assert (wilkinson(3), [1,1,0;1,0,1;0,1,1]) -%!assert (wilkinson(4), [1.5,1,0,0;1,0.5,1,0;0,1,0.5,1;0,0,1,1.5]) -%!error (wilkinson()) -%!error (wilkinson(1,2)) + +%!assert (wilkinson (0), []) +%!assert (wilkinson (1), 0) +%!assert (wilkinson (2), [0.5,1;1,0.5]) +%!assert (wilkinson (3), [1,1,0;1,0,1;0,1,1]) +%!assert (wilkinson (4), [1.5,1,0,0;1,0.5,1,0;0,1,0.5,1;0,0,1,1.5]) + +%% Test input validation +%!error wilkinson () +%!error wilkinson (1,2) +%!error <N must be a non-negative integer> wilkinson (ones (2)) +%!error <N must be a non-negative integer> wilkinson (-1) +%!error <N must be a non-negative integer> wilkinson (1.5) +
--- a/scripts/startup/__finish__.m +++ b/scripts/startup/__finish__.m @@ -36,3 +36,5 @@ endfunction +## No test needed for internal helper function. +%!assert (1)
--- a/scripts/startup/module.mk +++ b/scripts/startup/module.mk @@ -3,24 +3,22 @@ startup_FCN_FILES = \ startup/__finish__.m +LOCAL_STARTUP_FILE_SRC = startup/local-rcfile + SYSTEM_STARTUP_FILE_SRC = startup/main-rcfile SYSTEM_INPUTRC_FILE_SRC = startup/inputrc -LOCAL_STARTUP_FILE_SRC = startup/local-rcfile - STARTUP_FILE_SRC = \ + $(LOCAL_STARTUP_FILE_SRC) \ $(SYSTEM_STARTUP_FILE_SRC) \ - $(SYSTEM_INPUTRC_FILE_SRC) \ - $(LOCAL_STARTUP_FILE_SRC) + $(SYSTEM_INPUTRC_FILE_SRC) FCN_FILES += \ - $(startup_FCN_FILES) \ - $(SYSTEM_STARTUP_FILE_SRC) \ - $(LOCAL_STARTUP_FILE_SRC) + $(startup_FCN_FILES) EXTRA_DIST += \ - $(SYSTEM_INPUTRC_FILE_SRC) + $(STARTUP_FILE_SRC) PKG_ADD_FILES += startup/PKG_ADD
--- a/scripts/statistics/base/center.m +++ b/scripts/statistics/base/center.m @@ -23,7 +23,7 @@ ## If @var{x} is a vector, subtract its mean. ## If @var{x} is a matrix, do the above for each column. ## If the optional argument @var{dim} is given, operate along this dimension. -## @seealso{studentize} +## @seealso{zscore} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -35,7 +35,7 @@ print_usage (); endif - if (!isnumeric (x)) + if (! (isnumeric (x) || islogical (x))) error ("center: X must be a numeric vector or matrix"); endif @@ -47,10 +47,7 @@ sz = size (x); if (nargin != 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -58,25 +55,28 @@ endif endif - n = size (x, dim); + n = sz(dim); if (n == 0) retval = x; else - retval = bsxfun (@minus, x, sum (x, dim) / n); + retval = bsxfun (@minus, x, mean (x, dim)); endif endfunction %!assert(center ([1,2,3]), [-1,0,1]) +%!assert(center (single([1,2,3])), single([-1,0,1])) %!assert(center (int8 ([1,2,3])), [-1,0,1]) +%!assert(center (logical ([1, 0, 0, 1])), [0.5, -0.5, -0.5, 0.5]) %!assert(center (ones (3,2,0,2)), zeros (3,2,0,2)) +%!assert(center (ones (3,2,0,2, 'single')), zeros (3,2,0,2, 'single')) %!assert(center (magic (3)), [3,-4,1;-2,0,2;-1,4,-3]) +%!assert(center ([1 2 3; 6 5 4], 2), [-1 0 1; 1 0 -1]) %% Test input validation %!error center () %!error center (1, 2, 3) -%!error center ([true true]) %!error center (1, ones(2,2)) %!error center (1, 1.5) %!error center (1, 0)
new file mode 100644 --- /dev/null +++ b/scripts/statistics/base/corr.m @@ -0,0 +1,112 @@ +## Copyright (C) 1996-2011 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} corr (@var{x}) +## @deftypefnx {Function File} {} corr (@var{x}, @var{y}) +## Compute matrix of correlation coefficients. +## +## If each row of @var{x} and @var{y} is an observation and each column is +## a variable, then the @w{(@var{i}, @var{j})-th} entry of +## @code{corr (@var{x}, @var{y})} is the correlation between the +## @var{i}-th variable in @var{x} and the @var{j}-th variable in @var{y}. +## @tex +## $$ +## {\rm corr}(x,y) = {{\rm cov}(x,y) \over {\rm std}(x) {\rm std}(y)} +## $$ +## @end tex +## @ifnottex +## +## @example +## corr(x,y) = cov(x,y)/(std(x)*std(y)) +## @end example +## +## @end ifnottex +## If called with one argument, compute @code{corr (@var{x}, @var{x})}, +## the correlation between the columns of @var{x}. +## @seealso{cov} +## @end deftypefn + +## Author: Kurt Hornik <hornik@wu-wien.ac.at> +## Created: March 1993 +## Adapted-By: jwe + +function retval = corr (x, y = []) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + ## Input validation is done by cov.m. Don't repeat tests here + + ## Special case, scalar is always 100% correlated with itself + if (isscalar (x)) + if (isa (x, 'single')) + retval = single (1); + else + retval = 1; + endif + return; + endif + + ## No check for division by zero error, which happens only when + ## there is a constant vector and should be rare. + if (nargin == 2) + c = cov (x, y); + s = std (x)' * std (y); + retval = c ./ s; + else + c = cov (x); + s = sqrt (diag (c)); + retval = c ./ (s * s'); + endif + +endfunction + + +%!test +%! x = rand (10); +%! cc1 = corr (x); +%! cc2 = corr (x, x); +%! assert (size (cc1) == [10, 10] && size (cc2) == [10, 10]); +%! assert (cc1, cc2, sqrt (eps)); + +%!test +%! x = [1:3]'; +%! y = [3:-1:1]'; +%! assert (corr (x,y), -1, 5*eps) +%! assert (corr (x,flipud (y)), 1, 5*eps) +%! assert (corr ([x, y]), [1 -1; -1 1], 5*eps) + +%!test +%! x = single ([1:3]'); +%! y = single ([3:-1:1]'); +%! assert (corr (x,y), single (-1), 5*eps) +%! assert (corr (x,flipud (y)), single (1), 5*eps) +%! assert (corr ([x, y]), single ([1 -1; -1 1]), 5*eps) + +%!assert (corr (5), 1); +%!assert (corr (single(5)), single(1)); + +%% Test input validation +%!error corr (); +%!error corr (1, 2, 3); +%!error corr ([1; 2], ["A", "B"]); +%!error corr (ones (2,2,2)); +%!error corr (ones (2,2), ones (2,2,2)); +
--- a/scripts/statistics/base/cov.m +++ b/scripts/statistics/base/cov.m @@ -55,7 +55,7 @@ ## @item 1: ## normalize with @math{N}, this provides the second moment around the mean ## @end table -## @seealso{corrcoef, cor} +## @seealso{corr} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -67,7 +67,8 @@ print_usage (); endif - if (! (isnumeric (x) && isnumeric (y))) + if ( ! (isnumeric (x) || islogical (x)) + || ! (isnumeric (y) || islogical (y))) error ("cov: X and Y must be numeric matrices or vectors"); endif @@ -75,7 +76,7 @@ error ("cov: X and Y must be 2-D matrices or vectors"); endif - if (nargin == 2 && isscalar(y)) + if (nargin == 2 && isscalar (y)) opt = y; endif @@ -83,22 +84,27 @@ error ("cov: normalization OPT must be 0 or 1"); endif + ## Special case, scalar has zero covariance if (isscalar (x)) - c = 0; + if (isa (x, 'single')) + c = single (0); + else + c = 0; + endif return; endif - if (rows (x) == 1) - x = x'; + if (isrow (x)) + x = x.'; endif n = rows (x); - if (nargin == 1 || isscalar(y)) + if (nargin == 1 || isscalar (y)) x = center (x, 1); c = conj (x' * x / (n - 1 + opt)); else - if (rows (y) == 1) - y = y'; + if (isrow (y)) + y = y.'; endif if (rows (y) != n) error ("cov: X and Y must have the same number of observations"); @@ -110,17 +116,36 @@ endfunction + %!test %! x = rand (10); %! cx1 = cov (x); %! cx2 = cov (x, x); -%! assert(size (cx1) == [10, 10] && size (cx2) == [10, 10] && norm(cx1-cx2) < 1e1*eps); +%! assert(size (cx1) == [10, 10] && size (cx2) == [10, 10]); +%! assert(cx1, cx2, 1e1*eps); + +%!test +%! x = [1:3]'; +%! y = [3:-1:1]'; +%! assert (cov (x,y), -1, 5*eps) +%! assert (cov (x,flipud (y)), 1, 5*eps) +%! assert (cov ([x, y]), [1 -1; -1 1], 5*eps) + +%!test +%! x = single ([1:3]'); +%! y = single ([3:-1:1]'); +%! assert (cov (x,y), single (-1), 5*eps) +%! assert (cov (x,flipud (y)), single (1), 5*eps) +%! assert (cov ([x, y]), single ([1 -1; -1 1]), 5*eps) %!test %! x = [1:5]; %! c = cov (x); -%! assert(isscalar (c)); -%! assert(c, 2.5); +%! assert (isscalar (c)); +%! assert (c, 2.5); + +%!assert(cov (5), 0); +%!assert(cov (single(5)), single(0)); %!test %! x = [1:5]; @@ -129,13 +154,10 @@ %! c = cov (x, 1); %! assert(c, 2); -%!assert(cov (5), 0); - %% Test input validation %!error cov (); %!error cov (1, 2, 3, 4); -%!error cov ([true, true]); -%!error cov ([1, 2], [true, true]); +%!error cov ([1; 2], ["A", "B"]); %!error cov (ones (2,2,2)); %!error cov (ones (2,2), ones (2,2,2)); %!error cov (1, 3);
--- a/scripts/statistics/base/gls.m +++ b/scripts/statistics/base/gls.m @@ -82,10 +82,21 @@ if (rx != ry) error ("gls: number of rows of X and Y must be equal"); endif - if (!issquare(o) || ro != ry*cy) + if (!issquare (o) || ro != ry*cy) error ("gls: matrix O must be square matrix with rows = rows (Y) * cols (Y)"); endif + if (isinteger (x)) + x = double (x); + endif + if (isinteger (y)) + y = double (y); + endif + if (isinteger (o)) + o = double (o); + endif + + ## Start of algorithm o = o^(-1/2); z = kron (eye (cy), x); z = o * z; @@ -116,7 +127,7 @@ %! y = 3*x + 2; %! x = [x, ones(5,1)]; %! o = diag (ones (5,1)); -%! assert (gls (y,x,o), [3; 2], 50*eps) +%! assert (gls (y,x,o), [3; 2], 50*eps); %% Test input validation %!error gls ()
--- a/scripts/statistics/base/histc.m +++ b/scripts/statistics/base/histc.m @@ -61,7 +61,7 @@ error ("histc: EDGES must be real-valued, not complex"); else ## Make sure 'edges' is sorted - edges = edges (:); + edges = edges(:); if (!issorted (edges) || edges(1) > edges(end)) warning ("histc: edge values not sorted on input"); edges = sort (edges); @@ -72,10 +72,7 @@ sz = size (x); if (nargin < 3) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -103,25 +100,25 @@ ## Prepare indices idx1 = cell (1, dim-1); for k = 1:length (idx1) - idx1 {k} = 1:sz(k); + idx1{k} = 1:sz(k); endfor idx2 = cell (length (sz) - dim); for k = 1:length (idx2) - idx2 {k} = 1:sz(k+dim); + idx2{k} = 1:sz(k+dim); endfor ## Compute the histograms for k = 1:num_edges-1 b = (edges (k) <= x & x < edges (k+1)); - n (idx1 {:}, k, idx2 {:}) = sum (b, dim); + n(idx1{:}, k, idx2{:}) = sum (b, dim); if (nargout > 1) - idx (b) = k; + idx(b) = k; endif endfor b = (x == edges (end)); - n (idx1 {:}, num_edges, idx2 {:}) = sum (b, dim); + n(idx1{:}, num_edges, idx2{:}) = sum (b, dim); if (nargout > 1) - idx (b) = num_edges; + idx(b) = num_edges; endif else @@ -160,6 +157,7 @@ endfunction + %!test %! x = linspace (0, 10, 1001); %! n = histc (x, 0:10);
--- a/scripts/statistics/base/iqr.m +++ b/scripts/statistics/base/iqr.m @@ -39,7 +39,7 @@ print_usage (); endif - if (!(ismatrix (x) && isnumeric (x)) || isscalar(x)) + if (! (isnumeric (x) || islogical (x))) error ("iqr: X must be a numeric vector or matrix"); endif @@ -48,10 +48,7 @@ nel = numel (x); if (nargin != 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -60,27 +57,33 @@ endif ## This code is a bit heavy, but is needed until empirical_inv - ## takes other than vector arguments. - c = sz(dim); + ## can take a matrix, rather than just a vector argument. + n = sz(dim); sz(dim) = 1; - y = zeros (sz); + if (isa (x, 'single')) + y = zeros (sz, 'single'); + else + y = zeros (sz); + endif stride = prod (sz(1:dim-1)); - for i = 1 : nel / c; + for i = 1 : nel / n; offset = i; offset2 = 0; while (offset > stride) offset -= stride; offset2++; endwhile - offset += offset2 * stride * c; - rng = [0 : c-1] * stride + offset; + offset += offset2 * stride * n; + rng = [0 : n-1] * stride + offset; - y (i) = empirical_inv (3/4, x(rng)) - empirical_inv (1/4, x(rng)); + y(i) = diff (empirical_inv ([1/4, 3/4], x(rng))); endfor endfunction + %!assert (iqr (1:101), 50); +%!assert (iqr (single(1:101)), single(50)); %%!test %%! x = [1:100]; @@ -90,5 +93,6 @@ %!error iqr (); %!error iqr (1, 2, 3); %!error iqr (1); -%!error iqr ([true, true]); +%!error iqr (['A'; 'B']); %!error iqr (1:10, 3); +
--- a/scripts/statistics/base/kendall.m +++ b/scripts/statistics/base/kendall.m @@ -74,7 +74,8 @@ print_usage (); endif - if (! (isnumeric (x) && isnumeric (y))) + if ( ! (isnumeric (x) || islogical (x)) + || ! (isnumeric (y) || islogical (y))) error ("kendall: X and Y must be numeric matrices or vectors"); endif @@ -82,14 +83,14 @@ error ("kendall: X and Y must be 2-D matrices or vectors"); endif - if (rows (x) == 1) - x = x'; + if (isrow (x)) + x = x.'; endif [n, c] = size (x); if (nargin == 2) - if (rows (y) == 1) - y = y'; + if (isrow (y)) + y = y.'; endif if (rows (y) != n) error ("kendall: X and Y must have the same number of observations"); @@ -98,22 +99,36 @@ endif endif + if (isa (x, 'single') || isa (y, 'single')) + cls = 'single'; + else + cls = 'double'; + endif r = ranks (x); - m = sign (kron (r, ones (n, 1)) - kron (ones (n, 1), r)); - tau = corrcoef (m); + m = sign (kron (r, ones (n, 1, cls)) - kron (ones (n, 1, cls), r)); + tau = corr (m); if (nargin == 2) - tau = tau (1 : c, (c + 1) : columns (x)); + tau = tau(1 : c, (c + 1) : columns (x)); endif endfunction +%!test +%! x = [1:2:10]; +%! y = [100:10:149]; +%! assert (kendall (x,y), 1, 5*eps); +%! assert (kendall (x,fliplr (y)), -1, 5*eps); + +%!assert (kendall (logical(1)), 1); +%!assert (kendall (single(1)), single(1)); + %% Test input validation %!error kendall (); %!error kendall (1, 2, 3); -%!error kendall ([true, true]); -%!error kendall (ones(1,2), [true, true]); +%!error kendall (['A'; 'B']); +%!error kendall (ones(2,1), ['A'; 'B']); %!error kendall (ones (2,2,2)); %!error kendall (ones (2,2), ones (2,2,2)); %!error kendall (ones (2,2), ones (3,2));
--- a/scripts/statistics/base/kurtosis.m +++ b/scripts/statistics/base/kurtosis.m @@ -41,7 +41,7 @@ ## stdnormal distribution and is sometimes referred to as "excess kurtosis". ## To calculate kurtosis without the normalization factor of @math{-3} use ## @code{moment (@var{x}, 4, 'c') / std (@var{x})^4}. -## @seealso{var,skewness,moment} +## @seealso{var, skewness, moment} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -54,7 +54,7 @@ print_usage (); endif - if (!isnumeric (x)) + if (! (isnumeric (x) || islogical (x))) error ("kurtosis: X must be a numeric vector or matrix"); endif @@ -62,10 +62,7 @@ sz = size (x); if (nargin != 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -73,16 +70,14 @@ endif endif - c = sz(dim); + n = sz(dim); sz(dim) = 1; - idx = ones (1, nd); - idx(dim) = c; - x = x - repmat (mean (x, dim), idx); + x = center (x, dim); # center also promotes integer to double for next line retval = zeros (sz, class (x)); s = std (x, [], dim); + idx = find (s > 0); x = sum (x.^4, dim); - ind = find (s > 0); - retval(ind) = x(ind) ./ (c * s(ind) .^ 4) - 3; + retval(idx) = x(idx) ./ (n * s(idx) .^ 4) - 3; endfunction @@ -90,12 +85,14 @@ %!test %! x = [-1; 0; 0; 0; 1]; %! y = [x, 2*x]; -%! assert(all (abs (kurtosis (y) - [-1.4, -1.4]) < sqrt (eps))); +%! assert (kurtosis (y), [-1.4, -1.4], sqrt (eps)); + +%!assert (kurtosis (single(1)), single(0)); %% Test input validation %!error kurtosis () %!error kurtosis (1, 2, 3) -%!error kurtosis (true(1,2)) +%!error kurtosis (['A'; 'B']) %!error kurtosis (1, ones(2,2)) %!error kurtosis (1, 1.5) %!error kurtosis (1, 0)
--- a/scripts/statistics/base/logit.m +++ b/scripts/statistics/base/logit.m @@ -47,6 +47,7 @@ endfunction + %!test %! p = [0.01:0.01:0.99]; %! assert(logit (p), log (p ./ (1-p)), 25*eps)
--- a/scripts/statistics/base/mahalanobis.m +++ b/scripts/statistics/base/mahalanobis.m @@ -34,7 +34,8 @@ print_usage (); endif - if (! (isnumeric (x) && isnumeric (y))) + if ( ! (isnumeric (x) || islogical (x)) + || ! (isnumeric (y) || islogical (y))) error ("mahalanobis: X and Y must be numeric matrices or vectors"); endif @@ -49,11 +50,16 @@ error ("mahalanobis: X and Y must have the same number of columns"); endif + if (isinteger (x)) + x = double (x); + endif + xm = mean (x); ym = mean (y); - x = x - ones (xr, 1) * xm; - y = y - ones (yr, 1) * ym; + ## Center data by subtracting means + x = bsxfun (@minus, x, xm); + y = bsxfun (@minus, y, ym); w = (x' * x + y' * y) / (xr + yr - 2); @@ -63,11 +69,12 @@ endfunction + %% Test input validation %!error mahalanobis (); %!error mahalanobis (1, 2, 3); -%!error mahalanobis ([true], [true]); -%!error mahalanobis ([1, 2], [true, true]); +%!error mahalanobis ('A', 'B'); +%!error mahalanobis ([1, 2], ['A', 'B']); %!error mahalanobis (ones (2,2,2)); %!error mahalanobis (ones (2,2), ones (2,2,2)); %!error mahalanobis (ones (2,2), ones (2,3));
--- a/scripts/statistics/base/mean.m +++ b/scripts/statistics/base/mean.m @@ -53,7 +53,7 @@ ## ## Both @var{dim} and @var{opt} are optional. If both are supplied, ## either may appear first. -## @seealso{median,mode} +## @seealso{median, mode} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -69,15 +69,15 @@ error ("mean: X must be a numeric vector or matrix"); endif - need_dim = 0; + need_dim = false; if (nargin == 1) opt = "a"; - need_dim = 1; + need_dim = true; elseif (nargin == 2) if (ischar (opt1)) opt = opt1; - need_dim = 1; + need_dim = true; else dim = opt1; opt = "a"; @@ -100,22 +100,15 @@ sz = size (x); if (need_dim) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("mean: DIM must be an integer and a valid dimension"); endif endif - if (!(isscalar (dim) && dim == fix (dim)) - || !(1 <= dim && dim <= nd)) - error ("mean: DIM must be an integer and a valid dimension"); - endif - - if (dim > nd) - n = 1; - else - n = sz(dim); - endif + n = sz(dim); if (strcmp (opt, "a")) y = sum (x, dim) / n; @@ -129,6 +122,7 @@ endfunction + %!test %! x = -10:10; %! y = x'; @@ -137,9 +131,12 @@ %! assert(mean (y) == 0); %! assert(mean (z) == [0, 10]); +%!assert(mean (magic(3), 1), [5, 5, 5]); +%!assert(mean (magic(3), 2), [5; 5; 5]); %!assert(mean ([2 8], 'g'), 4); %!assert(mean ([4 4 2], 'h'), 3); %!assert(mean (logical ([1 0 1 1])), 0.75); +%!assert(mean (single ([1 0 1 1])), single (0.75)); %% Test input validation %!error mean ();
--- a/scripts/statistics/base/meansq.m +++ b/scripts/statistics/base/meansq.m @@ -40,7 +40,7 @@ ## of each column. ## ## If the optional argument @var{dim} is given, operate along this dimension. -## @seealso{var,std,moment} +## @seealso{var, std, moment} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -52,7 +52,7 @@ print_usage (); endif - if (!isnumeric (x)) + if (! (isnumeric (x) || islogical (x))) error ("mean: X must be a numeric vector or matrix"); endif @@ -60,29 +60,28 @@ sz = size (x); if (nargin < 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("mean: DIM must be an integer and a valid dimension"); endif endif - if (!(isscalar (dim) && dim == fix (dim)) - || !(1 <= dim && dim <= nd)) - error ("mean: DIM must be an integer and a valid dimension"); - endif - - y = sumsq (x, dim) / size (x, dim); + y = sumsq (x, dim) / sz(dim); endfunction -%!assert(meansq (1:5), 11) -%!assert(meansq (magic (4)), [94.5, 92.5, 92.5, 94.5]) +%!assert(meansq (1:5), 11); +%!assert(meansq (single(1:5)), single(11)); +%!assert(meansq (magic (4)), [94.5, 92.5, 92.5, 94.5]); +%!assert(meansq (magic (4), 2), [109.5; 77.5; 77.5; 109.5]); %% Test input validation %!error meansq () %!error meansq (1, 2, 3) -%!error kurtosis ([true true]) +%!error meansq (['A'; 'B']); %!error meansq (1, ones(2,2)) %!error meansq (1, 1.5) %!error meansq (1, 0)
--- a/scripts/statistics/base/median.m +++ b/scripts/statistics/base/median.m @@ -44,7 +44,7 @@ ## If @var{x} is a matrix, compute the median value for each ## column and return them in a row vector. If the optional @var{dim} ## argument is given, operate along this dimension. -## @seealso{mean,mode} +## @seealso{mean, mode} ## @end deftypefn ## Author: jwe @@ -55,18 +55,19 @@ print_usage (); endif - if (!isnumeric (x)) + if (! (isnumeric (x) || islogical (x))) error ("median: X must be a numeric vector or matrix"); endif + if (isempty (x)) + error ("median: X cannot be an empty matrix"); + endif + nd = ndims (x); sz = size (x); - if (nargin != 2) + if (nargin < 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -74,22 +75,19 @@ endif endif - if (numel (x) > 0) - n = size (x, dim); - k = floor ((n+1) / 2); - if (mod (n, 2) == 1) - retval = nth_element (x, k, dim); - else - retval = mean (nth_element (x, k:k+1, dim), dim); - endif - ## Inject NaNs where needed, to be consistent with Matlab. - retval(any (isnan (x), dim)) = NaN; + n = sz(dim); + k = floor ((n+1) / 2); + if (mod (n, 2) == 1) + retval = nth_element (x, k, dim); else - error ("median: invalid matrix argument"); + retval = mean (nth_element (x, k:k+1, dim), dim); endif + ## Inject NaNs where needed, to be consistent with Matlab. + retval(any (isnan (x), dim)) = NaN; endfunction + %!test %! x = [1, 2, 3, 4, 5, 6]; %! x2 = x'; @@ -101,13 +99,14 @@ %! assert(median ([x2, 2*x2]) == [3.5, 7]); %! assert(median ([y2, 3*y2]) == [4, 12]); +%!assert(median (single([1,2,3])), single(2)); %!assert(median ([1,2,NaN;4,5,6;NaN,8,9]), [NaN, 5, NaN]); %% Test input validation %!error median (); %!error median (1, 2, 3); %!error median ({1:5}); -%!error median (true(1,5)); +%!error median (['A'; 'B']); %!error median (1, ones(2,2)); %!error median (1, 1.5); %!error median (1, 0);
--- a/scripts/statistics/base/mode.m +++ b/scripts/statistics/base/mode.m @@ -30,7 +30,7 @@ ## The return variable @var{f} is the number of occurrences of the mode in ## in the dataset. The cell array @var{c} contains all of the elements ## with the maximum frequency. -## @seealso{mean,median} +## @seealso{mean, median} ## @end deftypefn function [m, f, c] = mode (x, dim) @@ -39,20 +39,17 @@ print_usage (); endif - if (!isnumeric(x)) + if (! (isnumeric (x) || islogical (x))) error ("mode: X must be a numeric vector or matrix"); endif nd = ndims (x); sz = size (x); - if (nargin != 2) + if (nargin < 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else - if (!(isscalar (dim) && dim == round (dim)) + if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) error ("mode: DIM must be an integer and a valid dimension"); endif @@ -78,11 +75,11 @@ t = cat (dim, true (sz2), diff (xs, 1, dim) != 0); if (dim != 1) - t2 (permute (t != 0, perm)) = diff ([find(permute (t, perm))(:); prod(sz)+1]); + t2(permute (t != 0, perm)) = diff ([find(permute (t, perm))(:); prod(sz)+1]); f = max (ipermute (t2, perm), [], dim); xs = permute (xs, perm); else - t2 (t) = diff ([find(t)(:); prod(sz)+1]); + t2(t) = diff ([find(t)(:); prod(sz)+1]); f = max (t2, [], dim); endif @@ -90,14 +87,15 @@ if (issparse (x)) m = sparse (sz2(1), sz2(2)); else - m = zeros (sz2); + m = zeros (sz2, class (x)); endif for i = 1 : prod (sz2) - c{i} = xs (t2 (:, i) == f(i), i); - m (i) = c{i}(1); + c{i} = xs(t2(:, i) == f(i), i); + m(i) = c{i}(1); endfor endfunction + %!test %! [m, f, c] = mode (toeplitz (1:5)); %! assert (m, [1,2,2,2,1]); @@ -114,15 +112,19 @@ %! [m2, f2, c2] = mode (full (a)); %! assert (m, sparse (m2)); %! assert (f, sparse (f2)); -%! assert (c, cellfun (@(x) sparse (0), c2, 'uniformoutput', false)); +%! c_exp(1:length(a)) = { sparse (0) }; +%! assert (c ,c_exp); +%! assert (c2,c_exp ); -%!assert(mode([2,3,1,2,3,4],1),[2,3,1,2,3,4]) -%!assert(mode([2,3,1,2,3,4],2),2) -%!assert(mode([2,3,1,2,3,4]),2) +%!assert(mode ([2,3,1,2,3,4],1),[2,3,1,2,3,4]); +%!assert(mode ([2,3,1,2,3,4],2),2); +%!assert(mode ([2,3,1,2,3,4]),2); +%!assert(mode (single([2,3,1,2,3,4])), single(2)); +%!assert(mode (int8([2,3,1,2,3,4])), int8(2)); -%!assert(mode([2;3;1;2;3;4],1),2) -%!assert(mode([2;3;1;2;3;4],2),[2;3;1;2;3;4]) -%!assert(mode([2;3;1;2;3;4]),2) +%!assert(mode ([2;3;1;2;3;4],1),2); +%!assert(mode ([2;3;1;2;3;4],2),[2;3;1;2;3;4]); +%!assert(mode ([2;3;1;2;3;4]),2); %!shared x %! x(:,:,1) = toeplitz (1:3); @@ -157,7 +159,7 @@ %!error mode () %!error mode (1, 2, 3) %!error mode ({1 2 3}) -%!error mode (true(1,3)) +%!error mode (['A'; 'B']) %!error mode (1, ones(2,2)) %!error mode (1, 1.5) %!error mode (1, 0)
--- a/scripts/statistics/base/module.mk +++ b/scripts/statistics/base/module.mk @@ -3,10 +3,8 @@ statistics_base_FCN_FILES = \ statistics/base/center.m \ statistics/base/cloglog.m \ - statistics/base/cor.m \ - statistics/base/corrcoef.m \ + statistics/base/corr.m \ statistics/base/cov.m \ - statistics/base/cut.m \ statistics/base/gls.m \ statistics/base/histc.m \ statistics/base/iqr.m \ @@ -28,13 +26,14 @@ statistics/base/range.m \ statistics/base/ranks.m \ statistics/base/run_count.m \ + statistics/base/runlength.m \ statistics/base/skewness.m \ statistics/base/spearman.m \ statistics/base/statistics.m \ statistics/base/std.m \ - statistics/base/studentize.m \ statistics/base/table.m \ - statistics/base/var.m + statistics/base/var.m \ + statistics/base/zscore.m FCN_FILES += $(statistics_base_FCN_FILES)
--- a/scripts/statistics/base/moment.m +++ b/scripts/statistics/base/moment.m @@ -99,7 +99,7 @@ ## If the optional argument @var{dim} is given, operate along this dimension. ## ## If both @var{type} and @var{dim} are given they may appear in any order. -## @seealso{var,skewness,kurtosis} +## @seealso{var, skewness, kurtosis} ## @end deftypefn ## Can easily be made to work for continuous distributions (using quad) @@ -110,27 +110,27 @@ function m = moment (x, p, opt1, opt2) - if ((nargin < 2) || (nargin > 4)) + if (nargin < 2 || nargin > 4) print_usage (); endif - if (!isnumeric(x) || isempty(x) ) + if (!(isnumeric (x) || islogical (x)) || isempty (x)) error ("moment: X must be a non-empty numeric matrix or vector"); endif - if (!(isnumeric(p) && isscalar(p))) + if (! (isnumeric (p) && isscalar (p))) error ("moment: P must be a numeric scalar"); endif - need_dim = 0; + need_dim = false; if (nargin == 2) type = ""; - need_dim = 1; + need_dim = true; elseif (nargin == 3) if (ischar (opt1)) type = opt1; - need_dim = 1; + need_dim = true; else dim = opt1; type = ""; @@ -151,10 +151,7 @@ sz = size (x); if (need_dim) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -164,10 +161,8 @@ n = sz(dim); - if any (type == "c") - rng = ones (1, length (sz)); - rng(dim) = sz(dim); - x = x - repmat (sum (x, dim), rng) / n; + if (any (type == "c")) + x = center (x, dim); endif if any (type == "a") x = abs (x); @@ -178,11 +173,21 @@ endfunction +%!test +%! x = rand (10); +%! assert (moment (x,1), mean (x), 1e1*eps); +%! assert (moment (x,2), meansq (x), 1e1*eps); +%! assert (moment (x,1,2), mean (x,2), 1e1*eps); +%! assert (moment (x,1,'c'), mean (center (x)), 1e1*eps); +%! assert (moment (x,1,'a'), mean (abs (x)), 1e1*eps); + +%!assert (moment (single([1 2 3]),1), single(2)); + %% Test input validation %!error moment () %!error moment (1) %!error moment (1, 2, 3, 4, 5) -%!error moment ([true true], 2) +%!error moment (['A'; 'B'], 2) %!error moment (ones(2,0,3), 2) %!error moment (1, true) %!error moment (1, ones(2,2))
--- a/scripts/statistics/base/ols.m +++ b/scripts/statistics/base/ols.m @@ -100,24 +100,33 @@ error ("ols: number of rows of X and Y must be equal"); endif - z = x' * x; - r = rank (z); + if (isinteger (x)) + x = double (x); + endif + if (isinteger (y)) + y = double (y); + endif - if (r == nc) - beta = inv (z) * x' * y; + ## Start of algorithm + z = x' * x; + [u, p] = chol (z); + + if (p) + beta = pinv (x) * y; else - beta = pinv (x) * y; + beta = u \ (u' \ (x' * y)); endif if (isargout (2) || isargout (3)) r = y - x * beta; endif if (isargout (2)) - sigma = r' * r / (nr - r); + sigma = r' * r / (nr - rnk); endif endfunction + %!test %! x = [1:5]'; %! y = 3*x + 2;
--- a/scripts/statistics/base/ppplot.m +++ b/scripts/statistics/base/ppplot.m @@ -77,6 +77,7 @@ endfunction + %% Test input validation %!error ppplot (); %!error ppplot (ones(2,2));
--- a/scripts/statistics/base/prctile.m +++ b/scripts/statistics/base/prctile.m @@ -17,9 +17,10 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{y} =} prctile (@var{x}, @var{p}) +## @deftypefn {Function File} {@var{q} =} prctile (@var{x}) +## @deftypefnx {Function File} {@var{q} =} prctile (@var{x}, @var{p}) ## @deftypefnx {Function File} {@var{q} =} prctile (@var{x}, @var{p}, @var{dim}) -## For a sample @var{x}, compute the quantiles, @var{y}, corresponding +## For a sample @var{x}, compute the quantiles, @var{q}, corresponding ## to the cumulative probability values, @var{p}, in percent. All non-numeric ## values (NaNs) of @var{x} are ignored. ## @@ -27,10 +28,11 @@ ## return them in a matrix, such that the i-th row of @var{y} contains the ## @var{p}(i)th percentiles of each column of @var{x}. ## +## If @var{p} is unspecified, return the quantiles for @code{[0 25 50 75 100]}. ## The optional argument @var{dim} determines the dimension along which ## the percentiles are calculated. If @var{dim} is omitted, and @var{x} is ## a vector or matrix, it defaults to 1 (column-wise quantiles). When -## @var{x} is an N-d array, @var{dim} defaults to the first non-singleton +## @var{x} is an N-D array, @var{dim} defaults to the first non-singleton ## dimension. ## @seealso{quantile} ## @end deftypefn @@ -38,52 +40,48 @@ ## Author: Ben Abbott <bpabbott@mac.com> ## Description: Matlab style prctile function. -function q = prctile (x, p, dim) +function q = prctile (x, p = [], dim) if (nargin < 1 || nargin > 3) print_usage (); endif - if (!isnumeric(x)) + if (! (isnumeric (x) || islogical (x))) error ("prctile: X must be a numeric vector or matrix"); endif - if (!isnumeric(p)) - error ("prctile: P must be a numeric vector"); + + if (isempty (p)) + p = [0, 25, 50, 75, 100]; endif - if (nargin == 1) - p = [0, 25, 50, 75, 100]; + if (! (isnumeric (p) && isvector (p))) + error ("prctile: P must be a numeric vector"); endif nd = ndims (x); if (nargin == 2) if (nd == 2) - ## If a matrix or vector, use the 1st dimension. + ## If a matrix or vector, always use 1st dimension. dim = 1; else ## If an N-d array, find the first non-singleton dimension. - dim = find (size(v) > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); endif else - if (!(isscalar (dim) && dim == fix (dim)) || - !(1 <= dim && dim <= nd)) + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) error ("prctile: DIM must be an integer and a valid dimension"); endif endif ## Convert from percent to decimal. - p = p / 100; + p /= 100; - ## The 5th method is compatible with Matlab. - method = 5; - - q = quantile (x, p, dim, method); + q = quantile (x, p, dim); endfunction + %!test %! pct = 50; %! q = prctile (1:4, pct, 1); @@ -169,8 +167,9 @@ %% Test input validation %!error prctile () %!error prctile (1, 2, 3, 4) -%!error prctile ([true, false], 10) +%!error prctile (['A'; 'B'], 10) %!error prctile (1:10, [true, false]) +%!error prctile (1:10, ones (2,2)) %!error prctile (1, 1, 1.5) %!error prctile (1, 1, 0) %!error prctile (1, 1, 3)
--- a/scripts/statistics/base/probit.m +++ b/scripts/statistics/base/probit.m @@ -27,10 +27,18 @@ function y = probit (p) - if (nargin == 1) - y = stdnormal_inv (p); - else + + if (nargin != 1) print_usage (); endif + y = stdnormal_inv (p); + endfunction + +%!assert(probit([-1, 0, 0.5, 1, 2]), [NaN, -Inf, 0, Inf, NaN]); + +%% Test input validation +%!error probit () +%!error probit (1, 2) +
--- a/scripts/statistics/base/qqplot.m +++ b/scripts/statistics/base/qqplot.m @@ -20,6 +20,7 @@ ## @deftypefn {Function File} {[@var{q}, @var{s}] =} qqplot (@var{x}) ## @deftypefnx {Function File} {[@var{q}, @var{s}] =} qqplot (@var{x}, @var{dist}) ## @deftypefnx {Function File} {[@var{q}, @var{s}] =} qqplot (@var{x}, @var{dist}, @var{params}) +## @deftypefnx {Function File} {} qqplot (@dots{}) ## Perform a QQ-plot (quantile plot). ## ## If F is the CDF of the distribution @var{dist} with parameters @@ -37,7 +38,7 @@ ## distribution on [2,4] and @var{x}, use ## ## @example -## qqplot (x, "uniform", 2, 4) +## qqplot (x, "unif", 2, 4) ## @end example ## ## @noindent
--- a/scripts/statistics/base/quantile.m +++ b/scripts/statistics/base/quantile.m @@ -31,7 +31,7 @@ ## The optional argument @var{dim} determines the dimension along which ## the quantiles are calculated. If @var{dim} is omitted, and @var{x} is ## a vector or matrix, it defaults to 1 (column-wise quantiles). If -## @var{x} is an N-d array, @var{dim} defaults to the first non-singleton +## @var{x} is an N-D array, @var{dim} defaults to the first non-singleton ## dimension. ## ## The methods available to calculate sample quantiles are the nine methods @@ -87,24 +87,43 @@ ## @item R: A Language and Environment for Statistical Computing; ## @url{http://cran.r-project.org/doc/manuals/fullrefman.pdf}. ## @end itemize +## +## Examples: +## @c Set example in small font to prevent overfull line +## +## @smallexample +## @group +## x = randi (1000, [10, 1]); # Create empirical data in range 1-1000 +## q = quantile (x, [0, 1]); # Return minimum, maximum of distribution +## q = quantile (x, [0.25 0.5 0.75]); # Return quartiles of distribution +## @end group +## @end smallexample ## @seealso{prctile} ## @end deftypefn ## Author: Ben Abbott <bpabbott@mac.com> ## Description: Matlab style quantile function of a discrete/continuous distribution -function q = quantile (x, p, dim = 1, method = 5) +function q = quantile (x, p = [], dim = 1, method = 5) if (nargin < 1 || nargin > 4) print_usage (); endif - if (nargin < 2) + if (! (isnumeric (x) || islogical (x))) + error ("quantile: X must be a numeric vector or matrix"); + endif + + if (isempty (p)) p = [0.00 0.25, 0.50, 0.75, 1.00]; endif - if (!(isscalar (dim) && dim == fix (dim)) || - !(1 <= dim && dim <= ndims (x))) + if (! (isnumeric (p) && isvector (p))) + error ("quantile: P must be a numeric vector"); + endif + + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= ndims (x))) error ("quantile: DIM must be an integer and a valid dimension"); endif @@ -133,6 +152,7 @@ endfunction + %!test %! p = 0.5; %! x = sort (rand (11)); @@ -272,9 +292,14 @@ %% Test input validation %!error quantile () %!error quantile (1, 2, 3, 4, 5) +%!error quantile (['A'; 'B'], 10) +%!error quantile (1:10, [true, false]) +%!error quantile (1:10, ones (2,2)) %!error quantile (1, 1, 1.5) %!error quantile (1, 1, 0) %!error quantile (1, 1, 3) +%!error quantile ((1:5)', 0.5, 1, 0) +%!error quantile ((1:5)', 0.5, 1, 10) ## For the cumulative probability values in @var{p}, compute the ## quantiles, @var{q} (the inverse of the cdf), for the sample, @var{x}. @@ -294,37 +319,35 @@ print_usage (); endif - if (!isnumeric (x)) - error ("quantile: X must be a numeric vector or matrix"); + if (isinteger (x) || islogical (x)) + x = double (x); endif - ## Save length and set shape of quantiles. - n = numel (p); + ## set shape of quantiles to column vector. p = p(:); ## Save length and set shape of samples. ## FIXME: does sort guarantee that NaN's come at the end? x = sort (x); m = sum (! isnan (x)); - mx = size (x, 1); - nx = size (x, 2); + [xr, xc] = size (x); ## Initialize output values. - inv = Inf*(-(p < 0) + (p > 1)); - inv = repmat (inv, 1, nx); + inv = Inf (class (x)) * (-(p < 0) + (p > 1)); + inv = repmat (inv, 1, xc); ## Do the work. - if (any(k = find((p >= 0) & (p <= 1)))) + if (any (k = find ((p >= 0) & (p <= 1)))) n = length (k); - p = p (k); - ## Special case. - if (mx == 1) + p = p(k); + ## Special case of 1 row. + if (xr == 1) inv(k,:) = repmat (x, n, 1); - return + return; endif ## The column-distribution indices. - pcd = kron (ones (n, 1), mx*(0:nx-1)); + pcd = kron (ones (n, 1), xr*(0:xc-1)); mm = kron (ones (n, 1), m); switch (method) case {1, 2, 3} @@ -365,7 +388,7 @@ p = kron (p, m-1) + 1; case 8 - ## Median unbiased . + ## Median unbiased. p = kron (p, m+1/3) + 1/3; case 9 @@ -377,7 +400,7 @@ endswitch ## Duplicate single values. - imm1 = mm == 1; + imm1 = (mm == 1); x(2,imm1) = x(1,imm1); ## Interval indices.
--- a/scripts/statistics/base/range.m +++ b/scripts/statistics/base/range.m @@ -37,20 +37,24 @@ function y = range (x, dim) + if (nargin < 1 || nargin > 2) + print_usage (); + endif + if (nargin == 1) y = max (x) - min (x); - elseif (nargin == 2) + else y = max (x, [], dim) - min (x, [], dim); - else - print_usage (); endif endfunction -%!assert(range (1:10), 9) -%!assert(range (magic (3)), [5, 8, 5]) -%!assert(range (magic (3), 2), [7; 4; 7]) -%!assert(range (2), 0) + +%!assert(range (1:10), 9); +%!assert(range (single(1:10)), single(9)); +%!assert(range (magic (3)), [5, 8, 5]); +%!assert(range (magic (3), 2), [7; 4; 7]); +%!assert(range (2), 0); %% Test input validation %!error range ()
--- a/scripts/statistics/base/ranks.m +++ b/scripts/statistics/base/ranks.m @@ -21,7 +21,7 @@ ## Return the ranks of @var{x} along the first non-singleton dimension ## adjusted for ties. If the optional argument @var{dim} is ## given, operate along this dimension. -## @seealso{spearman,kendall} +## @seealso{spearman, kendall} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -37,7 +37,7 @@ print_usage (); endif - if (!isnumeric(x)) + if (! (isnumeric (x) || islogical (x))) error ("ranks: X must be a numeric vector or matrix"); endif @@ -45,10 +45,7 @@ sz = size (x); if (nargin != 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -89,18 +86,18 @@ endfunction -%!assert(ranks (1:2:10), 1:5) -%!assert(ranks (10:-2:1), 5:-1:1) -%!assert(ranks ([2, 1, 2, 4]), [2.5, 1, 2.5, 4]) -%!assert(ranks (ones(1, 5)), 3*ones(1, 5)) -%!assert(ranks (1e6*ones(1, 5)), 3*ones(1, 5)) -%!assert(ranks (rand (1, 5), 1), ones(1, 5)) +%!assert(ranks (1:2:10), 1:5); +%!assert(ranks (10:-2:1), 5:-1:1); +%!assert(ranks ([2, 1, 2, 4]), [2.5, 1, 2.5, 4]); +%!assert(ranks (ones(1, 5)), 3*ones(1, 5)); +%!assert(ranks (1e6*ones(1, 5)), 3*ones(1, 5)); +%!assert(ranks (rand (1, 5), 1), ones(1, 5)); %% Test input validation %!error ranks () %!error ranks (1, 2, 3) %!error ranks ({1, 2}) -%!error ranks (true(2,1)) +%!error ranks (['A'; 'B']) %!error ranks (1, 1.5) %!error ranks (1, 0) %!error ranks (1, 3)
--- a/scripts/statistics/base/run_count.m +++ b/scripts/statistics/base/run_count.m @@ -36,7 +36,7 @@ print_usage (); endif - if (!isnumeric(x)) + if (! (isnumeric (x) || islogical (x))) error ("run_count: X must be a numeric vector or matrix"); endif @@ -48,10 +48,7 @@ sz = size (x); if (nargin != 3) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -59,6 +56,7 @@ endif endif + ## Algorithm works on rows. Permute array if necessary, ipermute back at end if (dim != 1) perm = [1 : nd]; perm(1) = dim; @@ -76,7 +74,7 @@ infvec = Inf ([1, sz(2 : end)]); ind = find (diff ([infvec; x; -infvec]) < 0); - tmp(ind(2:end) - 1) = diff(ind); + tmp(ind(2:end) - 1) = diff (ind); tmp = tmp(idx{:}); sz(1) = n; @@ -86,7 +84,7 @@ retval(idx{:}) = sum (tmp == k); endfor idx{1} = n; - retval (idx{:}) = sum (tmp >= n); + retval(idx{:}) = sum (tmp >= n); if (dim != 1) retval = ipermute (retval, perm); @@ -105,7 +103,7 @@ %!error run_count (1) %!error run_count (1, 2, 3, 4) %!error run_count ({1, 2}, 3) -%!error run_count (true(3), 3) +%!error run_count (['A'; 'A'; 'B'], 3) %!error run_count (1:5, ones(2,2)) %!error run_count (1:5, 1.5) %!error run_count (1:5, -2)
rename from scripts/general/runlength.m rename to scripts/statistics/base/runlength.m --- a/scripts/general/runlength.m +++ b/scripts/statistics/base/runlength.m @@ -17,7 +17,7 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} runlength (@var{x}) +## @deftypefn {Function File} {[count, value] =} runlength (@var{x}) ## Find the lengths of all sequences of common values. Return the ## vector of lengths and the value that was repeated. ## @@ -30,9 +30,37 @@ ## @end deftypefn function [count, value] = runlength (x) + + if (nargin != 1) + print_usage (); + endif + + if (!(isnumeric (x) || islogical (x)) || !isvector (x)) + error ("runlength: X must be a numeric vector"); + endif + + if (iscolumn (x)) + x = x.'; + endif + idx = [find(x(1:end-1) != x(2:end)), length(x)]; - value = x(idx); count = diff ([0 idx]); + if (nargout == 2) + value = x(idx); + endif + endfunction + %!assert (runlength([2 2 0 4 4 4 0 1 1 1 1]), [2 1 3 1 4]); +%!assert (runlength([2 2 0 4 4 4 0 1 1 1 1]'), [2 1 3 1 4]); +%!test +%! [c, v] = runlength ([2 2 0 4 4 4 0 1 1 1 1]); +%! assert (c, [2 1 3 1 4]); +%! assert (v, [2 0 4 0 1]); + +%% Test input validation +%!error runlength () +%!error runlength (1, 2) +%!error runlength (['A'; 'B']) +%!error runlength (ones(2,2))
--- a/scripts/statistics/base/skewness.m +++ b/scripts/statistics/base/skewness.m @@ -38,7 +38,7 @@ ## If @var{x} is a matrix, return the skewness along the ## first non-singleton dimension of the matrix. If the optional ## @var{dim} argument is given, operate along this dimension. -## @seealso{var,kurtosis,moment} +## @seealso{var, kurtosis, moment} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -51,7 +51,7 @@ print_usage (); endif - if (!isnumeric(x)) + if (! (isnumeric (x) || islogical (x))) error ("skewness: X must be a numeric vector or matrix"); endif @@ -59,30 +59,26 @@ sz = size (x); if (nargin != 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else - if (!(isscalar (dim) && dim == round (dim)) + if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) error ("skewness: DIM must be an integer and a valid dimension"); endif endif - c = sz(dim); - idx = ones (1, nd); - idx(dim) = c; - x = x - repmat (mean (x, dim), idx); + n = sz(dim); sz(dim) = 1; + x = center (x, dim); # center also promotes integer to double for next line retval = zeros (sz, class (x)); s = std (x, [], dim); - ind = find (s > 0); + idx = find (s > 0); x = sum (x .^ 3, dim); - retval(ind) = x(ind) ./ (c * s(ind) .^ 3); + retval(idx) = x(idx) ./ (n * s(idx) .^ 3); endfunction + %!assert(skewness ([-1,0,1]), 0); %!assert(skewness ([-2,0,1]) < 0); %!assert(skewness ([-1,0,2]) > 0); @@ -92,10 +88,12 @@ %! y = [x, 2*x]; %! assert(all (abs (skewness (y) - [0.75, 0.75]) < sqrt (eps))); +%!assert (skewness (single(1)), single(0)); + %% Test input validation %!error skewness () %!error skewness (1, 2, 3) -%!error skewness ([true true]) +%!error skewness (['A'; 'B']) %!error skewness (1, ones(2,2)) %!error skewness (1, 1.5) %!error skewness (1, 0)
--- a/scripts/statistics/base/spearman.m +++ b/scripts/statistics/base/spearman.m @@ -39,11 +39,12 @@ function rho = spearman (x, y = []) - if ((nargin < 1) || (nargin > 2)) + if (nargin < 1 || nargin > 2) print_usage (); endif - if (! (isnumeric (x) && isnumeric (y))) + if ( ! (isnumeric (x) || islogical (x)) + || ! (isnumeric (y) || islogical (y))) error ("spearman: X and Y must be numeric matrices or vectors"); endif @@ -51,30 +52,43 @@ error ("spearman: X and Y must be 2-D matrices or vectors"); endif - if (rows (x) == 1) - x = x'; + if (isrow (x)) + x = x.'; endif - n = rows (x); if (nargin == 1) - rho = corrcoef (ranks (x)); + rho = corr (ranks (x)); else - if (rows (y) == 1) - y = y'; + if (isrow (y)) + y = y.'; endif - if (rows (y) != n) + if (rows (x) != rows (y)) error ("spearman: X and Y must have the same number of observations"); endif - rho = corrcoef (ranks (x), ranks (y)); + rho = corr (ranks (x), ranks (y)); + endif + + ## Restore class cleared by ranks + if (isa (x, 'single') || isa (y, 'single')) + rho = single (rho); endif endfunction + +%!test +%! x = 1:10; +%! y = exp (x); +%! assert (spearman (x,y), 1, 5*eps); +%! assert (spearman (x,-y), -1, 5*eps); + +%!assert(spearman ([1 2 3], [-1 1 -2]), -0.5, 5*eps) + %% Test input validation %!error spearman (); %!error spearman (1, 2, 3); -%!error spearman ([true, true]); -%!error spearman (ones(1,2), [true, true]); +%!error spearman (['A'; 'B']); +%!error spearman (ones(1,2), {1, 2}); %!error spearman (ones (2,2,2)); %!error spearman (ones (2,2), ones (2,2,2)); %!error spearman (ones (2,2), ones (3,2));
--- a/scripts/statistics/base/statistics.m +++ b/scripts/statistics/base/statistics.m @@ -26,7 +26,7 @@ ## If @var{x} is a matrix, calculate statistics over the first ## non-singleton dimension. ## If the optional argument @var{dim} is given, operate along this dimension. -## @seealso{min,max,median,mean,std,skewness,kurtosis} +## @seealso{min, max, median, mean, std, skewness, kurtosis} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -38,7 +38,7 @@ print_usage (); endif - if (!isnumeric(x)) + if (! (isnumeric (x) || islogical (x))) error ("statistics: X must be a numeric vector or matrix"); endif @@ -46,12 +46,9 @@ sz = size (x); if (nargin != 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else - if (!(isscalar (dim) && dim == round (dim)) + if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) error ("statistics: DIM must be an integer and a valid dimension"); endif @@ -68,16 +65,22 @@ endfunction + %!test -%! x = rand(7,5); +%! x = rand (7,5); %! s = statistics (x); -%! m = median (x); -%! assert (m, s(3,:), eps); +%! assert (min (x), s(1,:), eps); +%! assert (median (x), s(3,:), eps); +%! assert (max (x), s(5,:), eps); +%! assert (mean (x), s(6,:), eps); +%! assert (std (x), s(7,:), eps); +%! assert (skewness (x), s(8,:), eps); +%! assert (kurtosis (x), s(9,:), eps); %% Test input validation %!error statistics () %!error statistics (1, 2, 3) -%!error statistics ([true true]) +%!error statistics (['A'; 'B']) %!error statistics (1, ones(2,2)) %!error statistics (1, 1.5) %!error statistics (1, 0)
--- a/scripts/statistics/base/std.m +++ b/scripts/statistics/base/std.m @@ -67,7 +67,7 @@ print_usage (); endif - if (! (isnumeric (x))) + if (! (isnumeric (x) || islogical (x))) error ("std: X must be a numeric vector or matrix"); endif @@ -78,22 +78,27 @@ error ("std: normalization OPT must be 0 or 1"); endif + nd = ndims (x); sz = size (x); if (nargin < 3) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("std: DIM must be an integer and a valid dimension"); endif endif - n = size (x, dim); - if (n == 1) - retval = zeros (sz); - elseif (numel (x) > 0) + n = sz(dim); + if (n == 1 || isempty (x)) + if (isa (x, 'single')) + retval = zeros (sz, 'single'); + else + retval = zeros (sz); + endif + else retval = sqrt (sumsq (center (x, dim), dim) / (n - 1 + opt)); - else - error ("std: X must not be empty"); endif endfunction @@ -102,14 +107,21 @@ %!test %! x = ones (10, 2); %! y = [1, 3]; -%! assert(std (x) == [0, 0] && abs (std (y) - sqrt (2)) < sqrt (eps)); -%! assert (std (x, 0, 3), zeros (10, 2)) -%! assert (std (ones (3, 1, 2), 0, 2), zeros (3, 1, 2)) +%! assert(std (x) == [0, 0]); +%! assert(std (y), sqrt (2), sqrt (eps)); +%! assert(std (x, 0, 2), zeros (10, 1)); + +%!assert(std (ones (3, 1, 2), 0, 2), zeros (3, 1, 2)); +%!assert(std ([1 2], 0), sqrt(2)/2, 5*eps); +%!assert(std ([1 2], 1), 0.5, 5*eps); +%!assert(std(1), 0); +%!assert(std(single(1)), single(0)); +%!assert(std([]), []); +%!assert(std(ones (1,3,0,2)), ones (1,3,0,2)); %% Test input validation %!error std (); %!error std (1, 2, 3, 4); -%!error std (true(1,2)) +%!error std (['A'; 'B']) %!error std (1, -1); -%!error std ([], 1);
--- a/scripts/statistics/base/table.m +++ b/scripts/statistics/base/table.m @@ -60,6 +60,7 @@ endfunction + %% Test input validation %!error table () %!error table (1, 2, 3)
--- a/scripts/statistics/base/var.m +++ b/scripts/statistics/base/var.m @@ -23,7 +23,7 @@ ## Compute the variance of the elements of the vector @var{x}. ## @tex ## $$ -## {\rm std} (x) = \sigma^2 = {\sum_{i=1}^N (x_i - \bar{x})^2 \over N - 1} +## {\rm var} (x) = \sigma^2 = {\sum_{i=1}^N (x_i - \bar{x})^2 \over N - 1} ## $$ ## where $\bar{x}$ is the mean value of $x$. ## @end tex @@ -31,7 +31,7 @@ ## ## @example ## @group -## std (x) = 1/(N-1) SUM_i (x(i) - mean(x))^2 +## var (x) = 1/(N-1) SUM_i (x(i) - mean(x))^2 ## @end group ## @end example ## @@ -52,7 +52,7 @@ ## @end table ## ## If the optional argument @var{dim} is given, operate along this dimension. -## @seealso{cov,std,skewness,kurtosis,moment} +## @seealso{cov, std, skewness, kurtosis, moment} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -64,7 +64,7 @@ print_usage (); endif - if (!isnumeric (x)) + if (! (isnumeric (x) || islogical (x))) error ("var: X must be a numeric vector or matrix"); endif @@ -75,16 +75,25 @@ error ("var: normalization OPT must be 0 or 1"); endif + nd = ndims (x); + sz = size (x); if (nargin < 3) - dim = find (size (x) > 1, 1); - if (isempty (dim)) - dim = 1; + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("var: DIM must be an integer and a valid dimension"); endif endif - n = size (x, dim); + n = sz(dim); if (n == 1) - retval = zeros (size (x), class (x)); + if (isa (x, 'single')) + retval = zeros (sz, 'single'); + else + retval = zeros (sz); + endif elseif (numel (x) > 0) retval = sumsq (center (x, dim), dim) / (n - 1 + opt); else @@ -93,15 +102,17 @@ endfunction -%!assert (var (13), 0) -%!assert (var ([1,2,3]), 1) -%!assert (var ([1,2,3], 1), 2/3, eps) -%!assert (var ([1,2,3], [], 1), [0,0,0]) + +%!assert(var (13), 0); +%!assert(var (single(13)), single(0)); +%!assert(var ([1,2,3]), 1); +%!assert(var ([1,2,3], 1), 2/3, eps); +%!assert(var ([1,2,3], [], 1), [0,0,0]); %% Test input validation %!error var () %!error var (1,2,3,4) -%!error var (true(1,2)) +%!error var (['A'; 'B']) %!error var (1, -1); %!error var ([],1)
copy from scripts/statistics/base/studentize.m copy to scripts/statistics/base/zscore.m --- a/scripts/statistics/base/studentize.m +++ b/scripts/statistics/base/zscore.m @@ -17,8 +17,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} studentize (@var{x}) -## @deftypefnx {Function File} {} studentize (@var{x}, @var{dim}) +## @deftypefn {Function File} {} zscore (@var{x}) +## @deftypefnx {Function File} {} zscore (@var{x}, @var{dim}) ## If @var{x} is a vector, subtract its mean and divide by its standard ## deviation. ## @@ -31,58 +31,54 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Subtract mean and divide by standard deviation -function t = studentize (x, dim) +function z = zscore (x, dim) if (nargin != 1 && nargin != 2) print_usage (); endif - if (! isnumeric(x)) - error ("studentize: X must be a numeric vector or matrix"); - endif - - if (isinteger (x)) - x = double (x); + if (! (isnumeric (x) || islogical (x))) + error ("zscore: X must be a numeric vector or matrix"); endif nd = ndims (x); sz = size (x); if (nargin != 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) - error ("studentize: DIM must be an integer and a valid dimension"); + error ("zscore: DIM must be an integer and a valid dimension"); endif endif - c = sz(dim); - if (c == 0) - t = x; + n = sz(dim); + if (n == 0) + z = x; else - idx = ones (1, nd); - idx(dim) = c; - t = x - repmat (mean (x, dim), idx); - t = t ./ repmat (max (cat (dim, std(t, [], dim), ! any (t, dim)), [], dim), idx); + x = center (x, dim); # center also promotes integer to double for next line + z = zeros (sz, class (x)); + s = std (x, [], dim); + s(s==0) = 1; + z = bsxfun (@rdivide, x, s); endif endfunction -%!assert(studentize ([1,2,3]), [-1,0,1]) -%!assert(studentize (int8 ([1,2,3])), [-1,0,1]) -#%!assert(studentize (ones (3,2,0,2)), zeros (3,2,0,2)) -%!assert(studentize ([2,0,-2;0,2,0;-2,-2,2]), [1,0,-1;0,1,0;-1,-1,1]) + +%!assert(zscore ([1,2,3]), [-1,0,1]) +%!assert(zscore (single([1,2,3])), single([-1,0,1])) +%!assert(zscore (int8([1,2,3])), [-1,0,1]) +%!assert(zscore (ones (3,2,2,2)), zeros (3,2,2,2)) +%!assert(zscore ([2,0,-2;0,2,0;-2,-2,2]), [1,0,-1;0,1,0;-1,-1,1]) %% Test input validation -%!error studentize () -%!error studentize (1, 2, 3) -%!error studentize ([true true]) -%!error studentize (1, ones(2,2)) -%!error studentize (1, 1.5) -%!error studentize (1, 0) -%!error studentize (1, 3) +%!error zscore () +%!error zscore (1, 2, 3) +%!error zscore (['A'; 'B']) +%!error zscore (1, ones(2,2)) +%!error zscore (1, 1.5) +%!error zscore (1, 0) +%!error zscore (1, 3)
--- a/scripts/statistics/distributions/betacdf.m +++ b/scripts/statistics/distributions/betacdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,9 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} betacdf (@var{x}, @var{a}, @var{b}) -## For each element of @var{x}, returns the CDF at @var{x} of the beta -## distribution with parameters @var{a} and @var{b}, i.e., -## PROB (beta (@var{a}, @var{b}) @leq{} @var{x}). +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the Beta distribution with parameters @var{a} and +## @var{b}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -32,33 +33,61 @@ print_usage (); endif - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("betacdf: X, A and B must be of common size or scalar"); + error ("betacdf: X, A, and B must be of common size or scalars"); endif endif - sz = size(x); - cdf = zeros (sz); + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("betacdf: X, A, and B must not be complex"); + endif - k = find (!(a > 0) | !(b > 0) | isnan (x)); - if (any (k)) - cdf (k) = NaN; + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x >= 1) & (a > 0) & (b > 0)); - if (any (k)) - cdf (k) = 1; - endif + k = isnan (x) | !(a > 0) | !(b > 0); + cdf(k) = NaN; + + k = (x >= 1) & (a > 0) & (b > 0); + cdf(k) = 1; - k = find ((x > 0) & (x < 1) & (a > 0) & (b > 0)); - if (any (k)) - if (isscalar (a) && isscalar(b)) - cdf (k) = betainc (x(k), a, b); - else - cdf (k) = betainc (x(k), a(k), b(k)); - endif + k = (x > 0) & (x < 1) & (a > 0) & (b > 0); + if (isscalar (a) && isscalar (b)) + cdf(k) = betainc (x(k), a, b); + else + cdf(k) = betainc (x(k), a(k), b(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = [0 0 0.75 1 1]; +%!assert(betacdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(betacdf (x, 1, 2*ones(1,5)), y); +%!assert(betacdf (x, ones(1,5), 2), y); +%!assert(betacdf (x, [0 1 NaN 1 1], 2), [NaN 0 NaN 1 1]); +%!assert(betacdf (x, 1, 2*[0 1 NaN 1 1]), [NaN 0 NaN 1 1]); +%!assert(betacdf ([x(1:2) NaN x(4:5)], 1, 2), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(betacdf ([x, NaN], 1, 2), [y, NaN]); +%!assert(betacdf (single([x, NaN]), 1, 2), single([y, NaN])); +%!assert(betacdf ([x, NaN], single(1), 2), single([y, NaN])); +%!assert(betacdf ([x, NaN], 1, single(2)), single([y, NaN])); + +%% Test input validation +%!error betacdf () +%!error betacdf (1) +%!error betacdf (1,2) +%!error betacdf (1,2,3,4) +%!error betacdf (ones(3),ones(2),ones(2)) +%!error betacdf (ones(2),ones(3),ones(2)) +%!error betacdf (ones(2),ones(2),ones(3)) +
--- a/scripts/statistics/distributions/betainv.m +++ b/scripts/statistics/distributions/betainv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} betainv (@var{x}, @var{a}, @var{b}) -## For each component of @var{x}, compute the quantile (the inverse of +## For each element of @var{x}, compute the quantile (the inverse of ## the CDF) at @var{x} of the Beta distribution with parameters @var{a} ## and @var{b}. ## @end deftypefn @@ -32,36 +33,39 @@ print_usage (); endif - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("betainv: X, A and B must be of common size or scalars"); + error ("betainv: X, A, and B must be of common size or scalars"); endif endif - sz = size (x); - inv = zeros (sz); - - k = find ((x < 0) | (x > 1) | !(a > 0) | !(b > 0) | isnan (x)); - if (any (k)) - inv (k) = NaN; + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("betainv: X, A, and B must not be complex"); endif - k = find ((x == 1) & (a > 0) & (b > 0)); - if (any (k)) - inv (k) = 1; + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); endif + k = (x < 0) | (x > 1) | !(a > 0) | !(b > 0) | isnan (x); + inv(k) = NaN; + + k = (x == 1) & (a > 0) & (b > 0); + inv(k) = 1; + k = find ((x > 0) & (x < 1) & (a > 0) & (b > 0)); if (any (k)) - if (!isscalar(a) || !isscalar(b)) - a = a (k); - b = b (k); + if (!isscalar (a) || !isscalar (b)) + a = a(k); + b = b(k); y = a ./ (a + b); else y = a / (a + b) * ones (size (k)); endif - x = x (k); + x = x(k); if (isa (y, "single")) myeps = eps ("single"); @@ -97,7 +101,36 @@ y_old = y_new; endfor - inv (k) = y_new; + inv(k) = y_new; endif endfunction + + +%!shared x +%! x = [-1 0 0.75 1 2]; +%!assert(betainv (x, ones(1,5), 2*ones(1,5)), [NaN 0 0.5 1 NaN]); +%!assert(betainv (x, 1, 2*ones(1,5)), [NaN 0 0.5 1 NaN]); +%!assert(betainv (x, ones(1,5), 2), [NaN 0 0.5 1 NaN]); +%!assert(betainv (x, [1 0 NaN 1 1], 2), [NaN NaN NaN 1 NaN]); +%!assert(betainv (x, 1, 2*[1 0 NaN 1 1]), [NaN NaN NaN 1 NaN]); +%!assert(betainv ([x(1:2) NaN x(4:5)], 1, 2), [NaN 0 NaN 1 NaN]); + +%% Test class of input preserved +%!assert(betainv ([x, NaN], 1, 2), [NaN 0 0.5 1 NaN NaN]); +%!assert(betainv (single([x, NaN]), 1, 2), single([NaN 0 0.5 1 NaN NaN])); +%!assert(betainv ([x, NaN], single(1), 2), single([NaN 0 0.5 1 NaN NaN])); +%!assert(betainv ([x, NaN], 1, single(2)), single([NaN 0 0.5 1 NaN NaN])); + +%% Test input validation +%!error betainv () +%!error betainv (1) +%!error betainv (1,2) +%!error betainv (1,2,3,4) +%!error betainv (ones(3),ones(2),ones(2)) +%!error betainv (ones(2),ones(3),ones(2)) +%!error betainv (ones(2),ones(2),ones(3)) +%!error betainv (i, 2, 2) +%!error betainv (2, i, 2) +%!error betainv (2, 2, i) +
--- a/scripts/statistics/distributions/betapdf.m +++ b/scripts/statistics/distributions/betapdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## Copyright (C) 2010 Christos Dimitrakakis ## @@ -19,8 +20,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} betapdf (@var{x}, @var{a}, @var{b}) -## For each element of @var{x}, returns the PDF at @var{x} of the beta -## distribution with parameters @var{a} and @var{b}. +## For each element of @var{x}, compute the probability density function (PDF) +## at @var{x} of the Beta distribution with parameters @var{a} and @var{b}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at>, CD <christos.dimitrakakis@gmail.com> @@ -32,70 +33,98 @@ print_usage (); endif - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("betapdf: X, A and B must be of common size or scalar"); + error ("betapdf: X, A, and B must be of common size or scalars"); endif endif - sz = size (x); - pdf = zeros (sz); + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("betapdf: X, A, and B must not be complex"); + endif - k = find (!(a > 0) | !(b > 0) | isnan (x)); - if (any (k)) - pdf (k) = NaN; + if (isa (x, "single") || isa (a, "single") || isa (b, "single")); + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); endif - k = find ((x > 0) & (x < 1) & (a > 0) & (b > 0) & ((a != 1) | (b != 1))); - if (any (k)) - if (isscalar(a) && isscalar(b)) - pdf(k) = exp ((a - 1) .* log (x(k)) - + (b - 1) .* log (1 - x(k)) - + lgamma(a + b) - lgamma(a) - lgamma(b)); - else - pdf(k) = exp ((a(k) - 1) .* log (x(k)) - + (b(k) - 1) .* log (1 - x(k)) - + lgamma(a(k) + b(k)) - lgamma(a(k)) - lgamma(b(k))); - endif + k = !(a > 0) | !(b > 0) | isnan (x); + pdf(k) = NaN; + + k = (x > 0) & (x < 1) & (a > 0) & (b > 0) & ((a != 1) | (b != 1)); + if (isscalar (a) && isscalar (b)) + pdf(k) = exp ((a - 1) * log (x(k)) + + (b - 1) * log (1 - x(k)) + + lgamma (a + b) - lgamma (a) - lgamma (b)); + else + pdf(k) = exp ((a(k) - 1) .* log (x(k)) + + (b(k) - 1) .* log (1 - x(k)) + + lgamma (a(k) + b(k)) - lgamma (a(k)) - lgamma (b(k))); endif ## Most important special cases when the density is finite. - k = find ((x == 0) & (a == 1) & (b > 0) & (b != 1)); - if (any (k)) - if (isscalar(a) && isscalar(b)) - pdf(k) = exp(lgamma(a + b) - lgamma(a) - lgamma(b)); - else - pdf(k) = exp(lgamma(a(k) + b(k)) - lgamma(a(k)) - lgamma(b(k))); - endif + k = (x == 0) & (a == 1) & (b > 0) & (b != 1); + if (isscalar (a) && isscalar (b)) + pdf(k) = exp (lgamma (a + b) - lgamma (a) - lgamma (b)); + else + pdf(k) = exp (lgamma (a(k) + b(k)) - lgamma (a(k)) - lgamma (b(k))); endif - k = find ((x == 1) & (b == 1) & (a > 0) & (a != 1)); - if (any (k)) - if (isscalar(a) && isscalar(b)) - pdf(k) = exp(lgamma(a + b) - lgamma(a) - lgamma(b)); - else - pdf(k) = exp(lgamma(a(k) + b(k)) - lgamma(a(k)) - lgamma(b(k))); - endif + k = (x == 1) & (b == 1) & (a > 0) & (a != 1); + if (isscalar (a) && isscalar (b)) + pdf(k) = exp (lgamma (a + b) - lgamma (a) - lgamma (b)); + else + pdf(k) = exp (lgamma (a(k) + b(k)) - lgamma (a(k)) - lgamma (b(k))); endif - k = find ((x >= 0) & (x <= 1) & (a == 1) & (b == 1)); - if (any (k)) - pdf(k) = 1; - endif + k = (x >= 0) & (x <= 1) & (a == 1) & (b == 1); + pdf(k) = 1; ## Other special case when the density at the boundary is infinite. - k = find ((x == 0) & (a < 1)); - if (any (k)) - pdf(k) = Inf; - endif + k = (x == 0) & (a < 1); + pdf(k) = Inf; - k = find ((x == 1) & (b < 1)); - if (any (k)) - pdf(k) = Inf; - endif + k = (x == 1) & (b < 1); + pdf(k) = Inf; endfunction -%% Test large values for betapdf + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = [0 2 1 0 0]; +%!assert(betapdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(betapdf (x, 1, 2*ones(1,5)), y); +%!assert(betapdf (x, ones(1,5), 2), y); +%!assert(betapdf (x, [0 NaN 1 1 1], 2), [NaN NaN y(3:5)]); +%!assert(betapdf (x, 1, 2*[0 NaN 1 1 1]), [NaN NaN y(3:5)]); +%!assert(betapdf ([x, NaN], 1, 2), [y, NaN]); + +%% Test class of input preserved +%!assert(betapdf (single([x, NaN]), 1, 2), single([y, NaN])); +%!assert(betapdf ([x, NaN], single(1), 2), single([y, NaN])); +%!assert(betapdf ([x, NaN], 1, single(2)), single([y, NaN])); + +%% Beta (1/2,1/2) == arcsine distribution +%!test +%! x = rand (10,1); +%! y = 1./(pi * sqrt (x.*(1-x))); +%! assert(betapdf (x, 1/2, 1/2), y, 50*eps); + +%% Test large input values to betapdf %!assert (betapdf(0.5, 1000, 1000), 35.678, 1e-3) + +%% Test input validation +%!error betapdf () +%!error betapdf (1) +%!error betapdf (1,2) +%!error betapdf (1,2,3,4) +%!error betapdf (ones(3),ones(2),ones(2)) +%!error betapdf (ones(2),ones(3),ones(2)) +%!error betapdf (ones(2),ones(2),ones(3)) +%!error betapdf (i, 2, 2) +%!error betapdf (2, i, 2) +%!error betapdf (2, 2, i) +
--- a/scripts/statistics/distributions/betarnd.m +++ b/scripts/statistics/distributions/betarnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,83 +18,120 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} betarnd (@var{a}, @var{b}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} betarnd (@var{a}, @var{b}, @var{sz}) -## Return an @var{r} by @var{c} or @code{size (@var{sz})} matrix of -## random samples from the Beta distribution with parameters @var{a} and -## @var{b}. Both @var{a} and @var{b} must be scalar or of size @var{r} -## by @var{c}. +## @deftypefn {Function File} {} betarnd (@var{a}, @var{b}) +## @deftypefnx {Function File} {} betarnd (@var{a}, @var{b}, @var{r}) +## @deftypefnx {Function File} {} betarnd (@var{a}, @var{b}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} betarnd (@var{a}, @var{b}, [@var{sz}]) +## Return a matrix of random samples from the Beta distribution with parameters +## @var{a} and @var{b}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{a} and @var{b}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{a} and @var{b}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the Beta distribution -function rnd = betarnd (a, b, r, c) +function rnd = betarnd (a, b, varargin) - if (nargin > 1) - if (!isscalar(a) || !isscalar(b)) - [retval, a, b] = common_size (a, b); - if (retval > 0) - error ("betarnd: A and B must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, a, b] = common_size (a, b); + if (retval > 0) + error ("betarnd: A and B must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("betarnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("betarnd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (a) || iscomplex (b)) + error ("betarnd: A and B must not be complex"); + endif - if (any (size (a) != 1) - && (length (size (a)) != length (sz) || any (size (a) != sz))) - error ("betarnd: A and B must be scalar or of size [R,C]"); - endif + if (nargin == 2) + sz = size (a); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("betarnd: R must be a positive integer or vector"); + error ("betarnd: dimension vector must be row vector of non-negative integers"); endif - - if (any (size (a) != 1) - && (length (size (a)) != length (sz) || any (size (a) != sz))) - error ("betarnd: A and B must be scalar or of size SZ"); + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("betarnd: dimensions must be non-negative integers"); endif - elseif (nargin == 2) - sz = size(a); - else - print_usage (); + sz = [varargin{:}]; endif - if (isscalar(a) && isscalar(b)) - if (find (!(a > 0) | !(a < Inf) | !(b > 0) | !(b < Inf))) - rnd = NaN (sz); + if (!isscalar (a) && !isequal (size (a), sz)) + error ("betarnd: A and B must be scalar or of size SZ"); + endif + + if (isa (a, "single") || isa (b, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (a) && isscalar (b)) + if ((a > 0) && (a < Inf) && (b > 0) && (b < Inf)) + r = randg (a, sz); + rnd = r ./ (r + randg (b, sz)); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif else - r1 = randg(a,sz); - rnd = r1 ./ (r1 + randg(b,sz)); + rnd = NaN (sz, cls); endif else - rnd = zeros (sz); + rnd = NaN (sz, cls); - k = find (!(a > 0) | !(a < Inf) | !(b > 0) | !(b < Inf)); - if (any (k)) - rnd(k) = NaN (size (k)); - endif - - k = find ((a > 0) & (a < Inf) & (b > 0) & (b < Inf)); - if (any (k)) - r1 = randg(a(k),size(k)); - rnd(k) = r1 ./ (r1 + randg(b(k),size(k))); - endif + k = (a > 0) & (a < Inf) & (b > 0) & (b < Inf); + r = randg (a(k)); + rnd(k) = r ./ (r + randg (b(k))); endif endfunction + + +%!assert(size (betarnd (1,2)), [1, 1]); +%!assert(size (betarnd (ones(2,1), 2)), [2, 1]); +%!assert(size (betarnd (ones(2,2), 2)), [2, 2]); +%!assert(size (betarnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (betarnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (betarnd (1, 2, 3)), [3, 3]); +%!assert(size (betarnd (1, 2, [4 1])), [4, 1]); +%!assert(size (betarnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (betarnd (1, 2)), "double"); +%!assert(class (betarnd (single(1), 2)), "single"); +%!assert(class (betarnd (single([1 1]), 2)), "single"); +%!assert(class (betarnd (1, single(2))), "single"); +%!assert(class (betarnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error betarnd () +%!error betarnd (1) +%!error betarnd (ones(3),ones(2)) +%!error betarnd (ones(2),ones(3)) +%!error betarnd (i, 2) +%!error betarnd (2, i) +%!error betarnd (1,2, -1) +%!error betarnd (1,2, ones(2)) +%!error binornd (1,2, [2 -1 2]) +%!error betarnd (1,2, 1, ones(2)) +%!error betarnd (1,2, 1, -1) +%!error betarnd (ones(2,2), 2, 3) +%!error betarnd (ones(2,2), 2, [3, 2]) +%!error betarnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/binocdf.m +++ b/scripts/statistics/distributions/binocdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,8 +19,10 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} binocdf (@var{x}, @var{n}, @var{p}) -## For each element of @var{x}, compute the CDF at @var{x} of the -## binomial distribution with parameters @var{n} and @var{p}. +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the binomial distribution with parameters @var{n} and +## @var{p}, where @var{n} is the number of trials and @var{p} is the +## probability of success. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -34,34 +37,62 @@ if (!isscalar (n) || !isscalar (p)) [retval, x, n, p] = common_size (x, n, p); if (retval > 0) - error ("binocdf: X, N and P must be of common size or scalar"); + error ("binocdf: X, N, and P must be of common size or scalars"); endif endif - sz = size (x); - cdf = zeros (sz); + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("binocdf: X, N, and P must not be complex"); + endif - k = find (isnan (x) | !(n >= 0) | (n != round (n)) - | !(p >= 0) | !(p <= 1)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (n, "single") || isa (p, "single")); + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x >= n) & (n >= 0) & (n == round (n)) - & (p >= 0) & (p <= 1)); - if (any (k)) - cdf(k) = 1; - endif + k = isnan (x) | !(n >= 0) | (n != fix (n)) | !(p >= 0) | !(p <= 1); + cdf(k) = NaN; + + k = (x >= n) & (n >= 0) & (n == fix (n) & (p >= 0) & (p <= 1)); + cdf(k) = 1; - k = find ((x >= 0) & (x < n) & (n == round (n)) - & (p >= 0) & (p <= 1)); - if (any (k)) - tmp = floor (x(k)); - if (isscalar (n) && isscalar (p)) - cdf(k) = 1 - betainc (p, tmp + 1, n - tmp); - else - cdf(k) = 1 - betainc (p(k), tmp + 1, n(k) - tmp); - endif + k = (x >= 0) & (x < n) & (n == fix (n)) & (p >= 0) & (p <= 1); + tmp = floor (x(k)); + if (isscalar (n) && isscalar (p)) + cdf(k) = 1 - betainc (p, tmp + 1, n - tmp); + else + cdf(k) = 1 - betainc (p(k), tmp + 1, n(k) - tmp); endif endfunction + + +%!shared x,y +%! x = [-1 0 1 2 3]; +%! y = [0 1/4 3/4 1 1]; +%!assert(binocdf (x, 2*ones(1,5), 0.5*ones(1,5)), y); +%!assert(binocdf (x, 2, 0.5*ones(1,5)), y); +%!assert(binocdf (x, 2*ones(1,5), 0.5), y); +%!assert(binocdf (x, 2*[0 -1 NaN 1.1 1], 0.5), [0 NaN NaN NaN 1]); +%!assert(binocdf (x, 2, 0.5*[0 -1 NaN 3 1]), [0 NaN NaN NaN 1]); +%!assert(binocdf ([x(1:2) NaN x(4:5)], 2, 0.5), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(binocdf ([x, NaN], 2, 0.5), [y, NaN]); +%!assert(binocdf (single([x, NaN]), 2, 0.5), single([y, NaN])); +%!assert(binocdf ([x, NaN], single(2), 0.5), single([y, NaN])); +%!assert(binocdf ([x, NaN], 2, single(0.5)), single([y, NaN])); + +%% Test input validation +%!error binocdf () +%!error binocdf (1) +%!error binocdf (1,2) +%!error binocdf (1,2,3,4) +%!error binocdf (ones(3),ones(2),ones(2)) +%!error binocdf (ones(2),ones(3),ones(2)) +%!error binocdf (ones(2),ones(2),ones(3)) +%!error binocdf (i, 2, 2) +%!error binocdf (2, i, 2) +%!error binocdf (2, 2, i) +
--- a/scripts/statistics/distributions/binoinv.m +++ b/scripts/statistics/distributions/binoinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,8 +19,10 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} binoinv (@var{x}, @var{n}, @var{p}) -## For each element of @var{x}, compute the quantile at @var{x} of the -## binomial distribution with parameters @var{n} and @var{p}. +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the binomial distribution with parameters +## @var{n} and @var{p}, where @var{n} is the number of trials and +## @var{p} is the probability of success. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -34,24 +37,29 @@ if (!isscalar (n) || !isscalar (p)) [retval, x, n, p] = common_size (x, n, p); if (retval > 0) - error ("binoinv: X, N and P must be of common size or scalars"); + error ("binoinv: X, N, and P must be of common size or scalars"); endif endif - sz = size (x); - inv = zeros (sz); + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("binoinv: X, N, and P must not be complex"); + endif - k = find (!(x >= 0) | !(x <= 1) | !(n >= 0) | (n != round (n)) - | !(p >= 0) | !(p <= 1)); - if (any (k)) - inv(k) = NaN; + if (isa (x, "single") || isa (n, "single") || isa (p, "single")); + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); endif - k = find ((x >= 0) & (x <= 1) & (n >= 0) & (n == round (n)) - & (p >= 0) & (p <= 1)); + k = (!(x >= 0) | !(x <= 1) | !(n >= 0) | (n != fix (n)) | + !(p >= 0) | !(p <= 1)); + inv(k) = NaN; + + k = find ((x >= 0) & (x <= 1) & (n >= 0) & (n == fix (n) + & (p >= 0) & (p <= 1))); if (any (k)) if (isscalar (n) && isscalar (p)) - cdf = binopdf (0, n, p) * ones (size(k)); + cdf = binopdf (0, n, p) * ones (size (k)); while (any (inv(k) < n)) m = find (cdf < x(k)); if (any (m)) @@ -76,3 +84,32 @@ endif endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(binoinv (x, 2*ones(1,5), 0.5*ones(1,5)), [NaN 0 1 2 NaN]); +%!assert(binoinv (x, 2, 0.5*ones(1,5)), [NaN 0 1 2 NaN]); +%!assert(binoinv (x, 2*ones(1,5), 0.5), [NaN 0 1 2 NaN]); +%!assert(binoinv (x, 2*[0 -1 NaN 1.1 1], 0.5), [NaN NaN NaN NaN NaN]); +%!assert(binoinv (x, 2, 0.5*[0 -1 NaN 3 1]), [NaN NaN NaN NaN NaN]); +%!assert(binoinv ([x(1:2) NaN x(4:5)], 2, 0.5), [NaN 0 NaN 2 NaN]); + +%% Test class of input preserved +%!assert(binoinv ([x, NaN], 2, 0.5), [NaN 0 1 2 NaN NaN]); +%!assert(binoinv (single([x, NaN]), 2, 0.5), single([NaN 0 1 2 NaN NaN])); +%!assert(binoinv ([x, NaN], single(2), 0.5), single([NaN 0 1 2 NaN NaN])); +%!assert(binoinv ([x, NaN], 2, single(0.5)), single([NaN 0 1 2 NaN NaN])); + +%% Test input validation +%!error binoinv () +%!error binoinv (1) +%!error binoinv (1,2) +%!error binoinv (1,2,3,4) +%!error binoinv (ones(3),ones(2),ones(2)) +%!error binoinv (ones(2),ones(3),ones(2)) +%!error binoinv (ones(2),ones(2),ones(3)) +%!error binoinv (i, 2, 2) +%!error binoinv (2, i, 2) +%!error binoinv (2, 2, i) +
--- a/scripts/statistics/distributions/binopdf.m +++ b/scripts/statistics/distributions/binopdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -20,7 +21,8 @@ ## @deftypefn {Function File} {} binopdf (@var{x}, @var{n}, @var{p}) ## For each element of @var{x}, compute the probability density function ## (PDF) at @var{x} of the binomial distribution with parameters @var{n} -## and @var{p}. +## and @var{p}, where @var{n} is the number of trials and @var{p} is the +## probability of success. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -35,26 +37,65 @@ if (! isscalar (n) || ! isscalar (p)) [retval, x, n, p] = common_size (x, n, p); if (retval > 0) - error ("binopdf: X, N and P must be of common size or scalar"); + error ("binopdf: X, N, and P must be of common size or scalars"); endif endif - k = ((x >= 0) & (x <= n) - & (x == round (x)) & (n == round (n)) - & (p >= 0) & (p <= 1)); + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("binopdf: X, N, and P must not be complex"); + endif - pdf = zeros (size (x)); + if (isa (x, "single") || isa (n, "single") || isa (p, "single")); + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = (x == fix (x)) & (n == fix (n)) & (n >= 0) & (p >= 0) & (p <= 1); + pdf(! k) = NaN; - if (any (k(:))) - x = x(k); - if (! isscalar (n)) - n = n(k); - endif - if (! isscalar (p)) - p = p(k); - endif - z = gammaln(n+1) - gammaln(x+1) - gammaln(n-x+1) + x.*log(p) + (n-x).*log(1-p); - pdf(k) = exp (z); + + k &= ((x >= 0) & (x <= n)); + if (isscalar (n) && isscalar (p)) + pdf(k) = exp (gammaln (n+1) - gammaln (x(k)+1) - gammaln (n-x(k)+1) + + x(k)*log (p) + (n-x(k))*log (1-p)); + else + pdf(k) = exp (gammaln (n(k)+1) - gammaln (x(k)+1) - gammaln (n(k)-x(k)+1) + + x(k).*log (p(k)) + (n(k)-x(k)).*log (1-p(k))); endif endfunction + + +%!shared x,y,tol +%! if (ismac ()) +%! tol = eps (); +%! else +%! tol = 0; +%! endif +%! x = [-1 0 1 2 3]; +%! y = [0 1/4 1/2 1/4 0]; +%!assert(binopdf (x, 2*ones(1,5), 0.5*ones(1,5)), y, tol); +%!assert(binopdf (x, 2, 0.5*ones(1,5)), y, tol); +%!assert(binopdf (x, 2*ones(1,5), 0.5), y, tol); +%!assert(binopdf (x, 2*[0 -1 NaN 1.1 1], 0.5), [0 NaN NaN NaN 0]); +%!assert(binopdf (x, 2, 0.5*[0 -1 NaN 3 1]), [0 NaN NaN NaN 0]); +%!assert(binopdf ([x, NaN], 2, 0.5), [y, NaN], tol); + +%% Test class of input preserved +%!assert(binopdf (single([x, NaN]), 2, 0.5), single([y, NaN])); +%!assert(binopdf ([x, NaN], single(2), 0.5), single([y, NaN])); +%!assert(binopdf ([x, NaN], 2, single(0.5)), single([y, NaN])); + +%% Test input validation +%!error binopdf () +%!error binopdf (1) +%!error binopdf (1,2) +%!error binopdf (1,2,3,4) +%!error binopdf (ones(3),ones(2),ones(2)) +%!error binopdf (ones(2),ones(3),ones(2)) +%!error binopdf (ones(2),ones(2),ones(3)) +%!error binopdf (i, 2, 2) +%!error binopdf (2, i, 2) +%!error binopdf (2, 2, i) +
--- a/scripts/statistics/distributions/binornd.m +++ b/scripts/statistics/distributions/binornd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,96 +18,137 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} binornd (@var{n}, @var{p}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} binornd (@var{n}, @var{p}, @var{sz}) -## Return an @var{r} by @var{c} or a @code{size (@var{sz})} matrix of -## random samples from the binomial distribution with parameters @var{n} -## and @var{p}. Both @var{n} and @var{p} must be scalar or of size -## @var{r} by @var{c}. +## @deftypefn {Function File} {} binornd (@var{n}, @var{p}) +## @deftypefnx {Function File} {} binornd (@var{n}, @var{p}, @var{r}) +## @deftypefnx {Function File} {} binornd (@var{n}, @var{p}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} binornd (@var{n}, @var{p}, [@var{sz}]) +## Return a matrix of random samples from the binomial distribution with +## parameters @var{n} and @var{p}, where @var{n} is the number of trials +## and @var{p} is the probability of success. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{n} and @var{p}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{n} and @var{p}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the binomial distribution -function rnd = binornd (n, p, r, c) +function rnd = binornd (n, p, varargin) - if (nargin > 1) - if (!isscalar(n) || !isscalar(p)) - [retval, n, p] = common_size (n, p); - if (retval > 0) - error ("binornd: N and P must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (n) || !isscalar (p)) + [retval, n, p] = common_size (n, p); + if (retval > 0) + error ("binornd: N and P must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("binornd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("binornd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (n) || iscomplex (p)) + error ("binornd: N and P must not be complex"); + endif - if (any (size (n) != 1) - && (length (size (n)) != length (sz) || any (size (n) != sz))) - error ("binornd: N and must be scalar or of size [R, C]"); - endif + if (nargin == 2) + sz = size (n); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("binornd: R must be a positive integer or vector"); + error ("binornd: dimension vector must be row vector of non-negative integers"); endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("binornd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif - if (any (size (n) != 1) - && (length (size (n)) != length (sz) || any (size (n) != sz))) - error ("binornd: N and must be scalar or of size SZ"); - endif - elseif (nargin == 2) - sz = size(n); + if (!isscalar (n) && !isequal (size (n), sz)) + error ("binornd: N and P must be scalar or of size SZ"); + endif + + if (isa (n, "single") || isa (p, "single")) + cls = "single"; else - print_usage (); + cls = "double"; endif if (isscalar (n) && isscalar (p)) - if (find (!(n >= 0) | !(n < Inf) | !(n == round (n)) | - !(p >= 0) | !(p <= 1))) - rnd = NaN (sz); - elseif (n == 0) - rnd = zeros (sz); - else + if ((n > 0) && (n < Inf) && (n == fix (n)) && (p >= 0) && (p <= 1)) nel = prod (sz); tmp = rand (n, nel); - rnd = sum(tmp < ones (n, nel) * p, 1); - rnd = reshape(rnd, sz); + rnd = sum (tmp < p, 1); + rnd = reshape (rnd, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + elseif ((n == 0) && (p >= 0) && (p <= 1)) + rnd = zeros (sz, cls); + else + rnd = NaN (sz, cls); endif else - rnd = zeros (sz); + rnd = zeros (sz, cls); - k = find (!(n >= 0) | !(n < Inf) | !(n == round (n)) | - !(p >= 0) | !(p <= 1)); - if (any (k)) - rnd(k) = NaN; - endif + k = !(n >= 0) | !(n < Inf) | !(n == fix (n)) | !(p >= 0) | !(p <= 1); + rnd(k) = NaN; - k = find ((n > 0) & (n < Inf) & (n == round (n)) & (p >= 0) & (p <= 1)); - if (any (k)) + k = (n > 0) & (n < Inf) & (n == fix (n)) & (p >= 0) & (p <= 1); + if (any (k(:))) N = max (n(k)); - L = length (k); + L = sum (k(:)); tmp = rand (N, L); - ind = (1 : N)' * ones (1, L); - rnd(k) = sum ((tmp < ones (N, 1) * p(k)(:)') & - (ind <= ones (N, 1) * n(k)(:)'),1); + ind = repmat ((1 : N)', 1, L); + rnd(k) = sum ((tmp < repmat (p(k)(:)', N, 1)) & + (ind <= repmat (n(k)(:)', N, 1)), 1); endif endif endfunction -%!assert (binornd(0, 0, 1), 0) -%!assert (binornd([0, 0], [0, 0], 1, 2), [0, 0]) + +%!assert (binornd (0, 0, 1), 0) +%!assert (binornd ([0, 0], [0, 0], 1, 2), [0, 0]) + +%!assert(size (binornd (2, 1/2)), [1, 1]); +%!assert(size (binornd (2*ones(2,1), 1/2)), [2, 1]); +%!assert(size (binornd (2*ones(2,2), 1/2)), [2, 2]); +%!assert(size (binornd (2, 1/2*ones(2,1))), [2, 1]); +%!assert(size (binornd (2, 1/2*ones(2,2))), [2, 2]); +%!assert(size (binornd (2, 1/2, 3)), [3, 3]); +%!assert(size (binornd (2, 1/2, [4 1])), [4, 1]); +%!assert(size (binornd (2, 1/2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (binornd (2, 0.5)), "double"); +%!assert(class (binornd (single(2), 0.5)), "single"); +%!assert(class (binornd (single([2 2]), 0.5)), "single"); +%!assert(class (binornd (2, single(0.5))), "single"); +%!assert(class (binornd (2, single([0.5 0.5]))), "single"); + +%% Test input validation +%!error binornd () +%!error binornd (1) +%!error binornd (ones(3),ones(2)) +%!error binornd (ones(2),ones(3)) +%!error binornd (i, 2) +%!error binornd (2, i) +%!error binornd (1,2, -1) +%!error binornd (1,2, ones(2)) +%!error binornd (1,2, [2 -1 2]) +%!error binornd (1,2, 1, ones(2)) +%!error binornd (1,2, 1, -1) +%!error binornd (ones(2,2), 2, 3) +%!error binornd (ones(2,2), 2, [3, 2]) +%!error binornd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/cauchy_cdf.m +++ b/scripts/statistics/distributions/cauchy_cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} cauchy_cdf (@var{x}, @var{location}, @var{scale}) +## @deftypefn {Function File} {} cauchy_cdf (@var{x}) +## @deftypefnx {Function File} {} cauchy_cdf (@var{x}, @var{location}, @var{scale}) ## For each element of @var{x}, compute the cumulative distribution ## function (CDF) at @var{x} of the Cauchy distribution with location ## parameter @var{location} and scale parameter @var{scale}. Default @@ -27,35 +29,63 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: CDF of the Cauchy distribution -function cdf = cauchy_cdf (x, location, scale) +function cdf = cauchy_cdf (x, location = 0, scale = 1) - if (! (nargin == 1 || nargin == 3)) + if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - location = 0; - scale = 1; - endif - if (!isscalar (location) || !isscalar (scale)) [retval, x, location, scale] = common_size (x, location, scale); if (retval > 0) - error ("cauchy_cdf: X, LOCATION and SCALE must be of common size or scalar"); + error ("cauchy_cdf: X, LOCATION, and SCALE must be of common size or scalars"); endif endif - sz = size (x); - cdf = NaN (sz); + if (iscomplex (x) || iscomplex (location) || iscomplex (scale)) + error ("cauchy_cdf: X, LOCATION, and SCALE must not be complex"); + endif - k = find ((x > -Inf) & (x < Inf) & (location > -Inf) & - (location < Inf) & (scale > 0) & (scale < Inf)); - if (any (k)) - if (isscalar (location) && isscalar (scale)) - cdf(k) = 0.5 + atan ((x(k) - location) ./ scale) / pi; - else - cdf(k) = 0.5 + atan ((x(k) - location(k)) ./ scale(k)) / pi; - endif + if (isa (x, "single") || isa (location, "single") || isa (scale, "single")); + cdf = NaN (size (x), "single"); + else + cdf = NaN (size (x)); + endif + + k = !isinf (location) & (scale > 0) & (scale < Inf); + if (isscalar (location) && isscalar (scale)) + cdf = 0.5 + atan ((x - location) / scale) / pi; + else + cdf(k) = 0.5 + atan ((x(k) - location(k)) ./ scale(k)) / pi; endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = 1/pi * atan ((x-1) / 2) + 1/2; +%!assert(cauchy_cdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(cauchy_cdf (x, 1, 2*ones(1,5)), y); +%!assert(cauchy_cdf (x, ones(1,5), 2), y); +%!assert(cauchy_cdf (x, [-Inf 1 NaN 1 Inf], 2), [NaN y(2) NaN y(4) NaN]); +%!assert(cauchy_cdf (x, 1, 2*[0 1 NaN 1 Inf]), [NaN y(2) NaN y(4) NaN]); +%!assert(cauchy_cdf ([x(1:2) NaN x(4:5)], 1, 2), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(cauchy_cdf ([x, NaN], 1, 2), [y, NaN]); +%!assert(cauchy_cdf (single([x, NaN]), 1, 2), single([y, NaN]), eps("single")); +%!assert(cauchy_cdf ([x, NaN], single(1), 2), single([y, NaN]), eps("single")); +%!assert(cauchy_cdf ([x, NaN], 1, single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error cauchy_cdf () +%!error cauchy_cdf (1,2) +%!error cauchy_cdf (1,2,3,4) +%!error cauchy_cdf (ones(3),ones(2),ones(2)) +%!error cauchy_cdf (ones(2),ones(3),ones(2)) +%!error cauchy_cdf (ones(2),ones(2),ones(3)) +%!error cauchy_cdf (i, 2, 2) +%!error cauchy_cdf (2, i, 2) +%!error cauchy_cdf (2, 2, i) +
--- a/scripts/statistics/distributions/cauchy_inv.m +++ b/scripts/statistics/distributions/cauchy_inv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} cauchy_inv (@var{x}, @var{location}, @var{scale}) +## @deftypefn {Function File} {} cauchy_inv (@var{x}) +## @deftypefnx {Function File} {} cauchy_inv (@var{x}, @var{location}, @var{scale}) ## For each element of @var{x}, compute the quantile (the inverse of the ## CDF) at @var{x} of the Cauchy distribution with location parameter ## @var{location} and scale parameter @var{scale}. Default values are @@ -27,47 +29,70 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Quantile function of the Cauchy distribution -function inv = cauchy_inv (x, location, scale) +function inv = cauchy_inv (x, location = 0, scale = 1) - if (! (nargin == 1 || nargin == 3)) + if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - location = 0; - scale = 1; - endif - if (!isscalar (location) || !isscalar (scale)) [retval, x, location, scale] = common_size (x, location, scale); if (retval > 0) - error ("cauchy_inv: X, LOCATION and SCALE must be of common size or scalar"); + error ("cauchy_inv: X, LOCATION, and SCALE must be of common size or scalars"); endif endif - sz = size (x); - inv = NaN (sz); + if (iscomplex (x) || iscomplex (location) || iscomplex (scale)) + error ("cauchy_inv: X, LOCATION, and SCALE must not be complex"); + endif - ok = ((location > -Inf) & (location < Inf) & - (scale > 0) & (scale < Inf)); - - k = find ((x == 0) & ok); - if (any (k)) - inv(k) = -Inf; + if (isa (x, "single") || isa (location, "single") || isa (scale, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find ((x > 0) & (x < 1) & ok); - if (any (k)) - if (isscalar (location) && isscalar (scale)) - inv(k) = location - scale .* cot (pi * x(k)); - else - inv(k) = location(k) - scale(k) .* cot (pi * x(k)); - endif - endif + ok = !isinf (location) & (scale > 0) & (scale < Inf); + + k = (x == 0) & ok; + inv(k) = -Inf; - k = find ((x == 1) & ok); - if (any (k)) - inv(k) = Inf; + k = (x == 1) & ok; + inv(k) = Inf; + + k = (x > 0) & (x < 1) & ok; + if (isscalar (location) && isscalar (scale)) + inv(k) = location - scale * cot (pi * x(k)); + else + inv(k) = location(k) - scale(k) .* cot (pi * x(k)); endif endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(cauchy_inv (x, ones(1,5), 2*ones(1,5)), [NaN -Inf 1 Inf NaN], eps); +%!assert(cauchy_inv (x, 1, 2*ones(1,5)), [NaN -Inf 1 Inf NaN], eps); +%!assert(cauchy_inv (x, ones(1,5), 2), [NaN -Inf 1 Inf NaN], eps); +%!assert(cauchy_inv (x, [1 -Inf NaN Inf 1], 2), [NaN NaN NaN NaN NaN]); +%!assert(cauchy_inv (x, 1, 2*[1 0 NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(cauchy_inv ([x(1:2) NaN x(4:5)], 1, 2), [NaN -Inf NaN Inf NaN]); + +%% Test class of input preserved +%!assert(cauchy_inv ([x, NaN], 1, 2), [NaN -Inf 1 Inf NaN NaN], eps); +%!assert(cauchy_inv (single([x, NaN]), 1, 2), single([NaN -Inf 1 Inf NaN NaN]), eps("single")); +%!assert(cauchy_inv ([x, NaN], single(1), 2), single([NaN -Inf 1 Inf NaN NaN]), eps("single")); +%!assert(cauchy_inv ([x, NaN], 1, single(2)), single([NaN -Inf 1 Inf NaN NaN]), eps("single")); + +%% Test input validation +%!error cauchy_inv () +%!error cauchy_inv (1,2) +%!error cauchy_inv (1,2,3,4) +%!error cauchy_inv (ones(3),ones(2),ones(2)) +%!error cauchy_inv (ones(2),ones(3),ones(2)) +%!error cauchy_inv (ones(2),ones(2),ones(3)) +%!error cauchy_inv (i, 2, 2) +%!error cauchy_inv (2, i, 2) +%!error cauchy_inv (2, 2, i) +
--- a/scripts/statistics/distributions/cauchy_pdf.m +++ b/scripts/statistics/distributions/cauchy_pdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} cauchy_pdf (@var{x}, @var{location}, @var{scale}) +## @deftypefn {Function File} {} cauchy_pdf (@var{x}) +## @deftypefnx {Function File} {} cauchy_pdf (@var{x}, @var{location}, @var{scale}) ## For each element of @var{x}, compute the probability density function ## (PDF) at @var{x} of the Cauchy distribution with location parameter ## @var{location} and scale parameter @var{scale} > 0. Default values are @@ -27,37 +29,69 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: PDF of the Cauchy distribution -function pdf = cauchy_pdf (x, location, scale) +function pdf = cauchy_pdf (x, location = 0, scale = 1) - if (! (nargin == 1 || nargin == 3)) + if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - location = 0; - scale = 1; - endif - if (!isscalar (location) || !isscalar (scale)) [retval, x, location, scale] = common_size (x, location, scale); if (retval > 0) - error ("cauchy_pdf: X, LOCATION and SCALE must be of common size or scalar"); + error ("cauchy_pdf: X, LOCATION, and SCALE must be of common size or scalars"); endif endif - sz = size (x); - pdf = NaN (sz); + if (iscomplex (x) || iscomplex (location) || iscomplex (scale)) + error ("cauchy_pdf: X, LOCATION, and SCALE must not be complex"); + endif - k = find ((x > -Inf) & (x < Inf) & (location > -Inf) & - (location < Inf) & (scale > 0) & (scale < Inf)); - if (any (k)) - if (isscalar (location) && isscalar (scale)) - pdf(k) = ((1 ./ (1 + ((x(k) - location) ./ scale) .^ 2)) - / pi ./ scale); - else - pdf(k) = ((1 ./ (1 + ((x(k) - location(k)) ./ scale(k)) .^ 2)) - / pi ./ scale(k)); - endif + if (isa (x, "single") || isa (location, "single") || isa (scale, "single")) + pdf = NaN (size (x), "single"); + else + pdf = NaN (size (x)); + endif + + k = !isinf (location) & (scale > 0) & (scale < Inf); + if (isscalar (location) && isscalar (scale)) + pdf = ((1 ./ (1 + ((x - location) / scale) .^ 2)) + / pi / scale); + else + pdf(k) = ((1 ./ (1 + ((x(k) - location(k)) ./ scale(k)) .^ 2)) + / pi ./ scale(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = 1/pi * ( 2 ./ ((x-1).^2 + 2^2) ); +%!assert(cauchy_pdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(cauchy_pdf (x, 1, 2*ones(1,5)), y); +%!assert(cauchy_pdf (x, ones(1,5), 2), y); +%!assert(cauchy_pdf (x, [-Inf 1 NaN 1 Inf], 2), [NaN y(2) NaN y(4) NaN]); +%!assert(cauchy_pdf (x, 1, 2*[0 1 NaN 1 Inf]), [NaN y(2) NaN y(4) NaN]); +%!assert(cauchy_pdf ([x, NaN], 1, 2), [y, NaN]); + +%% Test class of input preserved +%!assert(cauchy_pdf (single([x, NaN]), 1, 2), single([y, NaN]), eps("single")); +%!assert(cauchy_pdf ([x, NaN], single(1), 2), single([y, NaN]), eps("single")); +%!assert(cauchy_pdf ([x, NaN], 1, single(2)), single([y, NaN]), eps("single")); + +%% Cauchy (0,1) == Student's T distribution with 1 DOF +%!test +%! x = rand (10, 1); +%! assert(cauchy_pdf (x, 0, 1), tpdf (x, 1), eps); + +%% Test input validation +%!error cauchy_pdf () +%!error cauchy_pdf (1,2) +%!error cauchy_pdf (1,2,3,4) +%!error cauchy_pdf (ones(3),ones(2),ones(2)) +%!error cauchy_pdf (ones(2),ones(3),ones(2)) +%!error cauchy_pdf (ones(2),ones(2),ones(3)) +%!error cauchy_pdf (i, 2, 2) +%!error cauchy_pdf (2, i, 2) +%!error cauchy_pdf (2, 2, i) +
--- a/scripts/statistics/distributions/cauchy_rnd.m +++ b/scripts/statistics/distributions/cauchy_rnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,78 +18,115 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} cauchy_rnd (@var{location}, @var{scale}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} cauchy_rnd (@var{location}, @var{scale}, @var{sz}) -## Return an @var{r} by @var{c} or a @code{size (@var{sz})} matrix of -## random samples from the Cauchy distribution with parameters @var{location} -## and @var{scale} which must both be scalar or of size @var{r} by @var{c}. +## @deftypefn {Function File} {} cauchy_rnd (@var{location}, @var{scale}) +## @deftypefnx {Function File} {} cauchy_rnd (@var{location}, @var{scale}, @var{r}) +## @deftypefnx {Function File} {} cauchy_rnd (@var{location}, @var{scale}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} cauchy_rnd (@var{location}, @var{scale}, [@var{sz}]) +## Return a matrix of random samples from the Cauchy distribution with +## parameters @var{location} and @var{scale}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{location} and @var{scale}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{location} and @var{scale}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the Cauchy distribution -function rnd = cauchy_rnd (location, scale, r, c) +function rnd = cauchy_rnd (location, scale, varargin) - if (nargin > 1) - if (!isscalar (location) || !isscalar (scale)) - [retval, location, scale] = common_size (location, scale); - if (retval > 0) - error ("cauchy_rnd: LOCATION and SCALE must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (location) || !isscalar (scale)) + [retval, location, scale] = common_size (location, scale); + if (retval > 0) + error ("cauchy_rnd: LOCATION and SCALE must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("cauchy_rnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("cauchy_rnd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (location) || iscomplex (scale)) + error ("cauchy_rnd: LOCATION and SCALE must not be complex"); + endif - if (any (size (location) != 1) - && (length (size (location)) != length (sz) - || any (size (location) != sz))) - error ("cauchy_rnd: LOCATION and SCALE must be scalar or of size [R, C]"); - endif + if (nargin == 2) + sz = size (location); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("cauchy_rnd: R must be a positive integer or vector"); + error ("cauchy_rnd: dimension vector must be row vector of non-negative integers"); endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("cauchy_rnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif - if (any (size (location) != 1) - && (length (size (location)) != length (sz) - || any (size (location) != sz))) - error ("cauchy_rnd: LOCATION and SCALE must be scalar or of size SZ"); - endif - elseif (nargin == 2) - sz = size(location); + if (!isscalar (location) && !isequal (size (location), sz)) + error ("cauchy_rnd: LOCATION and SCALE must be scalar or of size SZ"); + endif + + if (isa (location, "single") || isa (scale, "single")) + cls = "single"; else - print_usage (); + cls = "double"; endif if (isscalar (location) && isscalar (scale)) - if (find (!(location > -Inf) | !(location < Inf) - | !(scale > 0) | !(scale < Inf))) - rnd = NaN (sz); + if (!isinf (location) && (scale > 0) && (scale < Inf)) + rnd = location - cot (pi * rand (sz)) * scale; else - rnd = location - cot (pi * rand (sz)) .* scale; + rnd = NaN (sz, cls); endif else - rnd = NaN (sz); - k = find ((location > -Inf) & (location < Inf) - & (scale > 0) & (scale < Inf)); - if (any (k)) - rnd(k) = location(k)(:) - cot (pi * rand (size (k))) .* scale(k)(:); - endif + rnd = NaN (sz, cls); + + k = !isinf (location) & (scale > 0) & (scale < Inf); + rnd(k) = location(k)(:) - cot (pi * rand (sum (k(:)), 1)) .* scale(k)(:); endif endfunction + + +%!assert(size (cauchy_rnd (1,2)), [1, 1]); +%!assert(size (cauchy_rnd (ones(2,1), 2)), [2, 1]); +%!assert(size (cauchy_rnd (ones(2,2), 2)), [2, 2]); +%!assert(size (cauchy_rnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (cauchy_rnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (cauchy_rnd (1, 2, 3)), [3, 3]); +%!assert(size (cauchy_rnd (1, 2, [4 1])), [4, 1]); +%!assert(size (cauchy_rnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (cauchy_rnd (1, 2)), "double"); +%!assert(class (cauchy_rnd (single(1), 2)), "single"); +%!assert(class (cauchy_rnd (single([1 1]), 2)), "single"); +%!assert(class (cauchy_rnd (1, single(2))), "single"); +%!assert(class (cauchy_rnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error cauchy_rnd () +%!error cauchy_rnd (1) +%!error cauchy_rnd (ones(3),ones(2)) +%!error cauchy_rnd (ones(2),ones(3)) +%!error cauchy_rnd (i, 2) +%!error cauchy_rnd (2, i) +%!error cauchy_rnd (1,2, -1) +%!error cauchy_rnd (1,2, ones(2)) +%!error cauchy_rnd (1,2, [2 -1 2]) +%!error cauchy_rnd (1,2, 1, ones(2)) +%!error cauchy_rnd (1,2, 1, -1) +%!error cauchy_rnd (ones(2,2), 2, 3) +%!error cauchy_rnd (ones(2,2), 2, [3, 2]) +%!error cauchy_rnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/chi2cdf.m +++ b/scripts/statistics/distributions/chi2cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,7 +20,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} chi2cdf (@var{x}, @var{n}) ## For each element of @var{x}, compute the cumulative distribution -## function (CDF) at @var{x} of the chisquare distribution with @var{n} +## function (CDF) at @var{x} of the chi-square distribution with @var{n} ## degrees of freedom. ## @end deftypefn @@ -35,10 +36,38 @@ if (!isscalar (n)) [retval, x, n] = common_size (x, n); if (retval > 0) - error ("chi2cdf: X and N must be of common size or scalar"); + error ("chi2cdf: X and N must be of common size or scalars"); endif endif - cdf = gamcdf (x, n / 2, 2); + if (iscomplex (x) || iscomplex (n)) + error ("chi2cdf: X and N must not be complex"); + endif + + cdf = gamcdf (x, n/2, 2); endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = [0, 1 - exp(-x(2:end)/2)]; +%!assert(chi2cdf (x, 2*ones(1,5)), y, eps); +%!assert(chi2cdf (x, 2), y, eps); +%!assert(chi2cdf (x, 2*[1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)], eps); +%!assert(chi2cdf ([x(1:2) NaN x(4:5)], 2), [y(1:2) NaN y(4:5)], eps); + +%% Test class of input preserved +%!assert(chi2cdf ([x, NaN], 2), [y, NaN], eps); +%!assert(chi2cdf (single([x, NaN]), 2), single([y, NaN]), eps("single")); +%!assert(chi2cdf ([x, NaN], single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error chi2cdf () +%!error chi2cdf (1) +%!error chi2cdf (1,2,3) +%!error chi2cdf (ones(3),ones(2)) +%!error chi2cdf (ones(2),ones(3)) +%!error chi2cdf (i, 2) +%!error chi2cdf (2, i) +
--- a/scripts/statistics/distributions/chi2inv.m +++ b/scripts/statistics/distributions/chi2inv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,7 +20,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} chi2inv (@var{x}, @var{n}) ## For each element of @var{x}, compute the quantile (the inverse of the -## CDF) at @var{x} of the chisquare distribution with @var{n} degrees of +## CDF) at @var{x} of the chi-square distribution with @var{n} degrees of ## freedom. ## @end deftypefn @@ -35,10 +36,37 @@ if (!isscalar (n)) [retval, x, n] = common_size (x, n); if (retval > 0) - error ("chi2inv: X and N must be of common size or scalar"); + error ("chi2inv: X and N must be of common size or scalars"); endif endif - inv = gaminv (x, n / 2, 2); + if (iscomplex (x) || iscomplex (n)) + error ("chi2inv: X and N must not be complex"); + endif + + inv = gaminv (x, n/2, 2); endfunction + + +%!shared x +%! x = [-1 0 0.3934693402873666 1 2]; +%!assert(chi2inv (x, 2*ones(1,5)), [NaN 0 1 Inf NaN], 5*eps); +%!assert(chi2inv (x, 2), [NaN 0 1 Inf NaN], 5*eps); +%!assert(chi2inv (x, 2*[0 1 NaN 1 1]), [NaN 0 NaN Inf NaN], 5*eps); +%!assert(chi2inv ([x(1:2) NaN x(4:5)], 2), [NaN 0 NaN Inf NaN], 5*eps); + +%% Test class of input preserved +%!assert(chi2inv ([x, NaN], 2), [NaN 0 1 Inf NaN NaN], 5*eps); +%!assert(chi2inv (single([x, NaN]), 2), single([NaN 0 1 Inf NaN NaN]), 5*eps("single")); +%!assert(chi2inv ([x, NaN], single(2)), single([NaN 0 1 Inf NaN NaN]), 5*eps("single")); + +%% Test input validation +%!error chi2inv () +%!error chi2inv (1) +%!error chi2inv (1,2,3) +%!error chi2inv (ones(3),ones(2)) +%!error chi2inv (ones(2),ones(3)) +%!error chi2inv (i, 2) +%!error chi2inv (2, i) +
--- a/scripts/statistics/distributions/chi2pdf.m +++ b/scripts/statistics/distributions/chi2pdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,7 +20,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} chi2pdf (@var{x}, @var{n}) ## For each element of @var{x}, compute the probability density function -## (PDF) at @var{x} of the chisquare distribution with @var{n} degrees +## (PDF) at @var{x} of the chi-square distribution with @var{n} degrees ## of freedom. ## @end deftypefn @@ -35,10 +36,37 @@ if (!isscalar (n)) [retval, x, n] = common_size (x, n); if (retval > 0) - error ("chi2pdf: X and N must be of common size or scalar"); + error ("chi2pdf: X and N must be of common size or scalars"); endif endif - pdf = gampdf (x, n / 2, 2); + if (iscomplex (x) || iscomplex (n)) + error ("chi2pdf: X and N must not be complex"); + endif + + pdf = gampdf (x, n/2, 2); endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0, 1/2 * exp(-x(2:5)/2)]; +%!assert(chi2pdf (x, 2*ones(1,5)), y); +%!assert(chi2pdf (x, 2), y); +%!assert(chi2pdf (x, 2*[1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)]); +%!assert(chi2pdf ([x, NaN], 2), [y, NaN]); + +%% Test class of input preserved +%!assert(chi2pdf (single([x, NaN]), 2), single([y, NaN])); +%!assert(chi2pdf ([x, NaN], single(2)), single([y, NaN])); + +%% Test input validation +%!error chi2pdf () +%!error chi2pdf (1) +%!error chi2pdf (1,2,3) +%!error chi2pdf (ones(3),ones(2)) +%!error chi2pdf (ones(2),ones(3)) +%!error chi2pdf (i, 2) +%!error chi2pdf (2, i) +
--- a/scripts/statistics/distributions/chi2rnd.m +++ b/scripts/statistics/distributions/chi2rnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,75 +18,103 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} chi2rnd (@var{n}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} chi2rnd (@var{n}, @var{sz}) -## Return an @var{r} by @var{c} or a @code{size (@var{sz})} matrix of -## random samples from the chisquare distribution with @var{n} degrees -## of freedom. @var{n} must be a scalar or of size @var{r} by @var{c}. +## @deftypefn {Function File} {} chi2rnd (@var{n}) +## @deftypefnx {Function File} {} chi2rnd (@var{n}, @var{r}) +## @deftypefnx {Function File} {} chi2rnd (@var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} chi2rnd (@var{n}, [@var{sz}]) +## Return a matrix of random samples from the chi-square distribution with +## @var{n} degrees of freedom. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the size of @var{n}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{n}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the chi-square distribution -function rnd = chi2rnd (n, r, c) - - if (nargin == 3) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("chi2rnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("chi2rnd: C must be a positive integer"); - endif - sz = [r, c]; +function rnd = chi2rnd (n, varargin) - if (any (size (n) != 1) - && (length (size (n)) != length (sz) || any (size (n) != sz))) - error ("chi2rnd: N must be scalar or of size [R, C]"); - endif - elseif (nargin == 2) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("chi2rnd: R must be a positive integer or vector"); - endif - - if (any (size (n) != 1) - && (length (size (n)) != length (sz) || any (size (n) != sz))) - error ("chi2rnd: N must be scalar or of size SZ"); - endif - elseif (nargin == 1) - sz = size(n); - else + if (nargin < 1) print_usage (); endif - if (isscalar (n)) - if (find (!(n > 0) | !(n < Inf))) - rnd = NaN (sz); - else - rnd = 2 * randg(n/2, sz); - endif - else - [retval, n, dummy] = common_size (n, ones (sz)); - if (retval > 0) - error ("chi2rnd: a and b must be of common size or scalar"); + if (nargin == 1) + sz = size (n); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("chi2rnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("chi2rnd: dimensions must be non-negative integers"); endif + sz = [varargin{:}]; + endif - rnd = zeros (sz); - k = find (!(n > 0) | !(n < Inf)); - if (any (k)) - rnd(k) = NaN; + if (!isscalar (n) && !isequal (size (n), sz)) + error ("chi2rnd: N must be scalar or of size SZ"); + endif + + if (iscomplex (n)) + error ("chi2rnd: N must not be complex"); + endif + + if (isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (n)) + if ((n > 0) && (n < Inf)) + rnd = 2 * randg (n/2, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + else + rnd = NaN (sz, cls); endif + else + rnd = NaN (sz, cls); - k = find ((n > 0) & (n < Inf)); - if (any (k)) - rnd(k) = 2 * randg(n(k)/2, size(k)); - endif + k = (n > 0) | (n < Inf); + rnd(k) = 2 * randg (n(k)/2); endif endfunction + + +%!assert(size (chi2rnd (2)), [1, 1]); +%!assert(size (chi2rnd (ones(2,1))), [2, 1]); +%!assert(size (chi2rnd (ones(2,2))), [2, 2]); +%!assert(size (chi2rnd (1, 3)), [3, 3]); +%!assert(size (chi2rnd (1, [4 1])), [4, 1]); +%!assert(size (chi2rnd (1, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (chi2rnd (2)), "double"); +%!assert(class (chi2rnd (single(2))), "single"); +%!assert(class (chi2rnd (single([2 2]))), "single"); + +%% Test input validation +%!error chi2rnd () +%!error chi2rnd (ones(3),ones(2)) +%!error chi2rnd (ones(2),ones(3)) +%!error chi2rnd (i) +%!error chi2rnd (1, -1) +%!error chi2rnd (1, ones(2)) +%!error chi2rnd (1, [2 -1 2]) +%!error chi2rnd (ones(2,2), 3) +%!error chi2rnd (ones(2,2), [3, 2]) +%!error chi2rnd (ones(2,2), 2, 3) +
--- a/scripts/statistics/distributions/discrete_cdf.m +++ b/scripts/statistics/distributions/discrete_cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 2010-2011 David Bateman ## ## This file is part of Octave. @@ -29,28 +30,52 @@ print_usage (); endif - sz = size (x); - if (! isvector (v)) error ("discrete_cdf: V must be a vector"); + elseif (any (isnan (v))) + error ("discrete_cdf: V must not have any NaN elements"); elseif (! isvector (p) || (length (p) != length (v))) error ("discrete_cdf: P must be a vector with length (V) elements"); elseif (! (all (p >= 0) && any (p))) - error ("discrete_cdf: P must be a nonzero, nonnegative vector"); + error ("discrete_cdf: P must be a nonzero, non-negative vector"); + endif + + p = p(:) / sum (p); # Reshape and normalize probability vector + + if (isa (x, "single") || isa (v, "single") || isa (p, "single")); + cdf = NaN (size (x), "single"); + else + cdf = NaN (size (x)); endif - n = numel (x); - m = length (v); - x = reshape (x, n, 1); - v = reshape (v, 1, m); - p = reshape (p / sum (p), m, 1); - - cdf = NaN (sz); - k = find (!isnan (x)); - if (any (k)) - n = length (k); - [vs, vi] = sort (v); - cdf(k) = [0 ; cumsum(p(vi))](lookup (vs, x(k)) + 1); - endif + k = !isnan (x); + [vs, vi] = sort (v); + cdf(k) = [0 ; cumsum(p(vi))](lookup (vs, x(k)) + 1); endfunction + + +%!shared x,v,p,y +%! x = [-1 0.1 1.1 1.9 3]; +%! v = 0.1:0.2:1.9; +%! p = 1/length(v) * ones(1, length(v)); +%! y = [0 0.1 0.6 1 1]; +%!assert(discrete_cdf ([x, NaN], v, p), [y, NaN], eps); + +%% Test class of input preserved +%!assert(discrete_cdf (single([x, NaN]), v, p), single([y, NaN]), 2*eps("single")); +%!assert(discrete_cdf ([x, NaN], single(v), p), single([y, NaN]), 2*eps("single")); +%!assert(discrete_cdf ([x, NaN], v, single(p)), single([y, NaN]), 2*eps("single")); + +%% Test input validation +%!error discrete_cdf () +%!error discrete_cdf (1) +%!error discrete_cdf (1,2) +%!error discrete_cdf (1,2,3,4) +%!error discrete_cdf (1, ones(2), ones(2,1)) +%!error discrete_cdf (1, [1 ; NaN], ones(2,1)) +%!error discrete_cdf (1, ones(2,1), ones(1,1)) +%!error discrete_cdf (1, ones(2,1), [1 -1]) +%!error discrete_cdf (1, ones(2,1), [1 NaN]) +%!error discrete_cdf (1, ones(2,1), [0 0]) +
--- a/scripts/statistics/distributions/discrete_inv.m +++ b/scripts/statistics/distributions/discrete_inv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} discrete_inv (@var{x}, @var{v}, @var{p}) -## For each component of @var{x}, compute the quantile (the inverse of +## For each element of @var{x}, compute the quantile (the inverse of ## the CDF) at @var{x} of the univariate distribution which assumes the ## values in @var{v} with probabilities @var{p}. ## @end deftypefn @@ -32,35 +33,63 @@ print_usage (); endif - sz = size (x); - if (! isvector (v)) error ("discrete_inv: V must be a vector"); elseif (! isvector (p) || (length (p) != length (v))) error ("discrete_inv: P must be a vector with length (V) elements"); + elseif (any (isnan (p))) + error ("discrete_rnd: P must not have any NaN elements"); elseif (! (all (p >= 0) && any (p))) - error ("discrete_inv: P must be a nonzero, nonnegative vector"); + error ("discrete_inv: P must be a nonzero, non-negative vector"); + endif + + if (isa (x, "single") || isa (v, "single") || isa (p, "single")); + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - n = numel (x); - x = reshape (x, 1, n); - m = length (v); - [v, idx] = sort (v); - p = reshape (cumsum (p (idx) / sum (p)), m, 1); - - inv = NaN (sz); - if (any (k = find (x == 0))) - inv(k) = -Inf; - endif - if (any (k = find (x == 1))) - inv(k) = v(m) * ones (size (k)); + ## FIXME: This isn't elegant. But cumsum and lookup together produce + ## different results when called with a single or a double. + if (isa (p, "single")); + p = double (p); endif - if (any (k = find ((x > 0) & (x < 1)))) - n = length (k); - inv (k) = v(length (p) - lookup (sort (p,"descend"), x(k)) + 1); - endif + [v, idx] = sort (v); + p = cumsum (p(idx)(:)) / sum (p); # Reshape and normalize probability vector + + k = (x == 0); + inv(k) = v(1); + + k = (x == 1); + inv(k) = v(end); + + k = (x > 0) & (x < 1); + inv(k) = v(length (p) - lookup (sort (p, "descend"), x(k)) + 1); endfunction +%!shared x,v,p,y +%! x = [-1 0 0.1 0.5 1 2]; +%! v = 0.1:0.2:1.9; +%! p = 1/length(v) * ones(1, length(v)); +%! y = [NaN v(1) v(1) v(end/2) v(end) NaN]; +%!assert(discrete_inv ([x, NaN], v, p), [y, NaN], eps); + +%% Test class of input preserved +%!assert(discrete_inv (single([x, NaN]), v, p), single([y, NaN]), eps("single")); +%!assert(discrete_inv ([x, NaN], single(v), p), single([y, NaN]), eps("single")); +%!assert(discrete_inv ([x, NaN], v, single(p)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error discrete_inv () +%!error discrete_inv (1) +%!error discrete_inv (1,2) +%!error discrete_inv (1,2,3,4) +%!error discrete_inv (1, ones(2), ones(2,1)) +%!error discrete_inv (1, ones(2,1), ones(1,1)) +%!error discrete_inv (1, ones(2,1), [1 NaN]) +%!error discrete_inv (1, ones(2,1), [1 -1]) +%!error discrete_inv (1, ones(2,1), [0 0]) +
--- a/scripts/statistics/distributions/discrete_pdf.m +++ b/scripts/statistics/distributions/discrete_pdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -24,7 +25,7 @@ ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> -## Description: pDF of a discrete distribution +## Description: PDF of a discrete distribution function pdf = discrete_pdf (x, v, p) @@ -32,28 +33,53 @@ print_usage (); endif - sz = size (x); - if (! isvector (v)) error ("discrete_pdf: V must be a vector"); + elseif (any (isnan (v))) + error ("discrete_pdf: V must not have any NaN elements"); elseif (! isvector (p) || (length (p) != length (v))) error ("discrete_pdf: P must be a vector with length (V) elements"); elseif (! (all (p >= 0) && any (p))) - error ("discrete_pdf: P must be a nonzero, nonnegative vector"); + error ("discrete_pdf: P must be a nonzero, non-negative vector"); + endif + + ## Reshape and normalize probability vector. Values not in table get 0 prob. + p = [0 ; p(:)/sum(p)]; + + if (isa (x, "single") || isa (v, "single") || isa (p, "single")) + pdf = NaN (size (x), "single"); + else + pdf = NaN (size (x)); endif - n = numel (x); - m = length (v); - x = reshape (x, n, 1); - v = reshape (v, 1, m); - p = reshape (p / sum (p), m, 1); - - pdf = NaN (sz); - k = find (!isnan (x)); - if (any (k)) - n = length (k); - [vs, vi] = sort (v); - pdf (k) = p (vi(lookup (vs, x(k), 'm'))); - endif + k = !isnan (x); + [vs, vi] = sort (v(:)); + pdf(k) = p([0 ; vi](lookup (vs, x(k), 'm') + 1) + 1); endfunction + + +%!shared x,v,p,y +%! x = [-1 0.1 1.1 1.9 3]; +%! v = 0.1:0.2:1.9; +%! p = 1/length(v) * ones(1, length(v)); +%! y = [0 0.1 0.1 0.1 0]; +%!assert(discrete_pdf ([x, NaN], v, p), [y, NaN], 5*eps); + +%% Test class of input preserved +%!assert(discrete_pdf (single([x, NaN]), v, p), single([y, NaN]), 5*eps("single")); +%!assert(discrete_pdf ([x, NaN], single(v), p), single([y, NaN]), 5*eps("single")); +%!assert(discrete_pdf ([x, NaN], v, single(p)), single([y, NaN]), 5*eps("single")); + +%% Test input validation +%!error discrete_pdf () +%!error discrete_pdf (1) +%!error discrete_pdf (1,2) +%!error discrete_pdf (1,2,3,4) +%!error discrete_pdf (1, ones(2), ones(2,1)) +%!error discrete_pdf (1, [1 ; NaN], ones(2,1)) +%!error discrete_pdf (1, ones(2,1), ones(1,1)) +%!error discrete_pdf (1, ones(2,1), [1 -1]) +%!error discrete_pdf (1, ones(2,1), [1 NaN]) +%!error discrete_pdf (1, ones(2,1), [0 0]) +
--- a/scripts/statistics/distributions/discrete_rnd.m +++ b/scripts/statistics/distributions/discrete_rnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,51 +18,29 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} discrete_rnd (@var{n}, @var{v}, @var{p}) -## @deftypefnx {Function File} {} discrete_rnd (@var{v}, @var{p}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} discrete_rnd (@var{v}, @var{p}, @var{sz}) -## Generate a row vector containing a random sample of size @var{n} from -## the univariate distribution which assumes the values in @var{v} with -## probabilities @var{p}. @var{n} must be a scalar. +## @deftypefn {Function File} {} discrete_rnd (@var{v}, @var{p}) +## @deftypefnx {Function File} {} discrete_rnd (@var{v}, @var{p}, @var{r}) +## @deftypefnx {Function File} {} discrete_rnd (@var{v}, @var{p}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} discrete_rnd (@var{v}, @var{p}, [@var{sz}]) +## Return a matrix of random samples from the univariate distribution which +## assumes the values in @var{v} with probabilities @var{p}. ## -## If @var{r} and @var{c} are given create a matrix with @var{r} rows and -## @var{c} columns. Or if @var{sz} is a vector, create a matrix of size -## @var{sz}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{v} and @var{p}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from a discrete distribution -function rnd = discrete_rnd (v, p, r, c) +function rnd = discrete_rnd (v, p, varargin) - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("discrete_rnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("discrete_rnd: C must be a positive integer"); - endif - sz = [r, c]; - elseif (nargin == 3) - ## A potential problem happens here if all args are scalar, as - ## we can't distiguish between the command syntax. Thankfully this - ## case doesn't make much sense. So we assume the first syntax - ## if the first arg is scalar - - if (isscalar (v)) - sz = [1, floor(v)]; - v = p; - p = r; - else - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("discrete_rnd: R must be a positive integer or vector"); - endif - endif - else + if (nargin < 2) print_usage (); endif @@ -69,9 +48,57 @@ error ("discrete_rnd: V must be a vector"); elseif (! isvector (p) || (length (p) != length (v))) error ("discrete_rnd: P must be a vector with length (V) elements"); + elseif (any (isnan (p))) + error ("discrete_rnd: P must not have any NaN elements"); elseif (! (all (p >= 0) && any (p))) - error ("discrete_rnd: P must be a nonzero, nonnegative vector"); + error ("discrete_rnd: P must be a nonzero, non-negative vector"); + endif + + if (nargin == 2) + sz = size (v); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("discrete_rnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("discrete_rnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; endif - rnd = v (lookup (cumsum (p (1 : end-1)) / sum(p), rand (sz)) + 1); + rnd = v(lookup (cumsum (p(1:end-1)) / sum (p), rand (sz)) + 1); + rnd = reshape (rnd, sz); + endfunction + + +%!assert(size (discrete_rnd (1:2, 1:2, 3)), [3, 3]); +%!assert(size (discrete_rnd (1:2, 1:2, [4 1])), [4, 1]); +%!assert(size (discrete_rnd (1:2, 1:2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (discrete_rnd (1:2, 1:2)), "double"); +%!assert(class (discrete_rnd (single(1:2), 1:2)), "single"); +## FIXME: Maybe this should work, maybe it shouldn't. +#%!assert(class (discrete_rnd (1:2, single(1:2))), "single"); + +%% Test input validation +%!error discrete_rnd () +%!error discrete_rnd (1) +%!error discrete_rnd (1:2,1:2, -1) +%!error discrete_rnd (1:2,1:2, ones(2)) +%!error discrete_rnd (1:2,1:2, [2 -1 2]) +%!error discrete_rnd (1:2,1:2, 1, ones(2)) +%!error discrete_rnd (1:2,1:2, 1, -1) +%% test v,p verification +%!error discrete_rnd (1, ones(2), ones(2,1)) +%!error discrete_rnd (1, ones(2,1), ones(1,1)) +%!error discrete_rnd (1, ones(2,1), [1 -1]) +%!error discrete_rnd (1, ones(2,1), [1 NaN]) +%!error discrete_rnd (1, ones(2,1), [0 0]) +
--- a/scripts/statistics/distributions/empirical_cdf.m +++ b/scripts/statistics/distributions/empirical_cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -36,6 +37,26 @@ error ("empirical_cdf: DATA must be a vector"); endif - cdf = discrete_cdf (x, data, ones (size (data)) / length (data)); + cdf = discrete_cdf (x, data, ones (size (data))); endfunction + + +%!shared x,v,y +%! x = [-1 0.1 1.1 1.9 3]; +%! v = 0.1:0.2:1.9; +%! y = [0 0.1 0.6 1 1]; +%!assert(empirical_cdf (x, v), y, eps); +%!assert(empirical_cdf ([x(1) NaN x(3:5)], v), [0 NaN 0.6 1 1], eps); + +%% Test class of input preserved +%!assert(empirical_cdf ([x, NaN], v), [y, NaN], eps); +%!assert(empirical_cdf (single([x, NaN]), v), single([y, NaN]), eps); +%!assert(empirical_cdf ([x, NaN], single(v)), single([y, NaN]), eps); + +%% Test input validation +%!error empirical_cdf () +%!error empirical_cdf (1) +%!error empirical_cdf (1,2,3) +%!error empirical_cdf (1, ones(2)) +
--- a/scripts/statistics/distributions/empirical_inv.m +++ b/scripts/statistics/distributions/empirical_inv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -36,6 +37,25 @@ error ("empirical_inv: DATA must be a vector"); endif - inv = discrete_inv (x, data, ones (size (data)) / length (data)); + inv = discrete_inv (x, data, ones (size (data))); endfunction + + +%!shared x,v,y +%! x = [-1 0 0.1 0.5 1 2]; +%! v = 0.1:0.2:1.9; +%! y = [NaN v(1) v(1) v(end/2) v(end) NaN]; +%!assert(empirical_inv (x, v), y, eps); + +%% Test class of input preserved +%!assert(empirical_inv ([x, NaN], v), [y, NaN], eps); +%!assert(empirical_inv (single([x, NaN]), v), single([y, NaN]), eps); +%!assert(empirical_inv ([x, NaN], single(v)), single([y, NaN]), eps); + +%% Test input validation +%!error empirical_inv () +%!error empirical_inv (1) +%!error empirical_inv (1,2,3) +%!error empirical_inv (1, ones(2)) +
--- a/scripts/statistics/distributions/empirical_pdf.m +++ b/scripts/statistics/distributions/empirical_pdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -36,6 +37,24 @@ error ("empirical_pdf: DATA must be a vector"); endif - pdf = discrete_pdf (x, data, ones (size (data)) / length (data)); + pdf = discrete_pdf (x, data, ones (size (data))); endfunction + + +%!shared x,v,y +%! x = [-1 0.1 1.1 1.9 3]; +%! v = 0.1:0.2:1.9; +%! y = [0 0.1 0.1 0.1 0]; +%!assert(empirical_pdf (x, v), y); + +%% Test class of input preserved +%!assert(empirical_pdf (single(x), v), single (y)); +%!assert(empirical_pdf (x, single(v)), single (y)); + +%% Test input validation +%!error empirical_pdf () +%!error empirical_pdf (1) +%!error empirical_pdf (1,2,3) +%!error empirical_inv (1, ones(2)) +
--- a/scripts/statistics/distributions/empirical_rnd.m +++ b/scripts/statistics/distributions/empirical_rnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,29 +18,29 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} empirical_rnd (@var{n}, @var{data}) -## @deftypefnx {Function File} {} empirical_rnd (@var{data}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} empirical_rnd (@var{data}, @var{sz}) -## Generate a bootstrap sample of size @var{n} from the empirical -## distribution obtained from the univariate sample @var{data}. +## @deftypefn {Function File} {} empirical_rnd (@var{data}) +## @deftypefnx {Function File} {} empirical_rnd (@var{data}, @var{r}) +## @deftypefnx {Function File} {} empirical_rnd (@var{data}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} empirical_rnd (@var{data}, [@var{sz}]) +## Return a matrix of random samples from the empirical distribution obtained +## from the univariate sample @var{data}. ## -## If @var{r} and @var{c} are given create a matrix with @var{r} rows and -## @var{c} columns. Or if @var{sz} is a vector, create a matrix of size -## @var{sz}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is a random ordering +## of the sample @var{data}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Bootstrap samples from the empirical distribution -function rnd = empirical_rnd (data, r, c) +function rnd = empirical_rnd (data, varargin) - if (nargin == 2) - if (isscalar(data)) - c = data; - data = r; - r = 1; - endif - elseif (nargin != 3) + if (nargin < 1) print_usage (); endif @@ -47,6 +48,22 @@ error ("empirical_rnd: DATA must be a vector"); endif - rnd = discrete_rnd (data, ones (size (data)) / length (data), r, c); + rnd = discrete_rnd (data, ones (size (data)), varargin{:}); endfunction + + +%!assert(size (empirical_rnd (ones (3, 1))), [3, 1]); +%!assert(size (empirical_rnd (1:2, [4 1])), [4, 1]); +%!assert(size (empirical_rnd (1:2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (empirical_rnd (1:2, 1)), "double"); +%!assert(class (empirical_rnd (single(1:2), 1)), "single"); + +%% Test input validation +%!error empirical_rnd () +%!error empirical_rnd (ones(2), 1) +%% test data verification +%!error empirical_rnd (ones(2), 1, 1) +
--- a/scripts/statistics/distributions/expcdf.m +++ b/scripts/statistics/distributions/expcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -22,7 +23,7 @@ ## function (CDF) at @var{x} of the exponential distribution with ## mean @var{lambda}. ## -## The arguments can be of common size or scalar. +## The arguments can be of common size or scalars. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -34,40 +35,57 @@ print_usage (); endif - if (!isscalar (x) && !isscalar(lambda)) + if (!isscalar (lambda)) [retval, x, lambda] = common_size (x, lambda); if (retval > 0) - error ("expcdf: X and LAMBDA must be of common size or scalar"); + error ("expcdf: X and LAMBDA must be of common size or scalars"); endif endif - if (isscalar (x)) - sz = size (lambda); - else - sz = size (x); + if (iscomplex (x) || iscomplex (lambda)) + error ("expcdf: X and LAMBDA must not be complex"); endif - cdf = zeros (sz); - - k = find (isnan (x) | !(lambda > 0)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (lambda, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x == Inf) & (lambda > 0)); - if (any (k)) - cdf(k) = 1; - endif + k = isnan (x) | !(lambda > 0); + cdf(k) = NaN; + + k = (x == Inf) & (lambda > 0); + cdf(k) = 1; - k = find ((x > 0) & (x < Inf) & (lambda > 0)); - if (any (k)) - if isscalar (lambda) - cdf (k) = 1 - exp (- x(k) ./ lambda); - elseif isscalar (x) - cdf (k) = 1 - exp (- x ./ lambda(k)); - else - cdf (k) = 1 - exp (- x(k) ./ lambda(k)); - endif + k = (x > 0) & (x < Inf) & (lambda > 0); + if isscalar (lambda) + cdf(k) = 1 - exp (- x(k) / lambda); + else + cdf(k) = 1 - exp (- x(k) ./ lambda(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0, 1 - exp(-x(2:end)/2)]; +%!assert(expcdf (x, 2*ones(1,5)), y); +%!assert(expcdf (x, 2), y); +%!assert(expcdf (x, 2*[1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)]); + +%% Test class of input preserved +%!assert(expcdf ([x, NaN], 2), [y, NaN]); +%!assert(expcdf (single([x, NaN]), 2), single([y, NaN])); +%!assert(expcdf ([x, NaN], single(2)), single([y, NaN])); + +%% Test input validation +%!error expcdf () +%!error expcdf (1) +%!error expcdf (1,2,3) +%!error expcdf (ones(3),ones(2)) +%!error expcdf (ones(2),ones(3)) +%!error expcdf (i, 2) +%!error expcdf (2, i) +
--- a/scripts/statistics/distributions/expinv.m +++ b/scripts/statistics/distributions/expinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,8 +20,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} expinv (@var{x}, @var{lambda}) ## For each element of @var{x}, compute the quantile (the inverse of the -## CDF) at @var{x} of the exponential distribution with mean -## @var{lambda}. +## CDF) at @var{x} of the exponential distribution with mean @var{lambda}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -32,41 +32,64 @@ print_usage (); endif - if (!isscalar (x) && !isscalar(lambda)) + if (!isscalar (lambda)) [retval, x, lambda] = common_size (x, lambda); if (retval > 0) - error ("expinv: X and LAMBDA must be of common size or scalar"); + error ("expinv: X and LAMBDA must be of common size or scalars"); endif endif - if (isscalar (x)) - sz = size (lambda); - else - sz = size (x); + if (iscomplex (x) || iscomplex (lambda)) + error ("expinv: X and LAMBDA must not be complex"); endif - inv = zeros (sz); + if (!isscalar (x)) + sz = size (x); + else + sz = size (lambda); + endif - k = find (!(lambda > 0) | (x < 0) | (x > 1) | isnan (x)); - if (any (k)) - inv(k) = NaN; + if (iscomplex (x) || iscomplex (lambda)) + error ("expinv: X and LAMBDA must not be complex"); endif - k = find ((x == 1) & (lambda > 0)); - if (any (k)) - inv(k) = Inf; + if (isa (x, "single") || isa (lambda, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find ((x > 0) & (x < 1) & (lambda > 0)); - if (any (k)) - if isscalar (lambda) - inv(k) = - lambda .* log (1 - x(k)); - elseif isscalar (x) - inv(k) = - lambda(k) .* log (1 - x); - else - inv(k) = - lambda(k) .* log (1 - x(k)); - endif + k = (x == 1) & (lambda > 0); + inv(k) = Inf; + + k = (x >= 0) & (x < 1) & (lambda > 0); + if isscalar (lambda) + inv(k) = - lambda * log (1 - x(k)); + else + inv(k) = - lambda(k) .* log (1 - x(k)); endif endfunction + +%!shared x +%! x = [-1 0 0.3934693402873666 1 2]; +%!assert(expinv (x, 2*ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(expinv (x, 2), [NaN 0 1 Inf NaN], eps); +%!assert(expinv (x, 2*[1 0 NaN 1 1]), [NaN NaN NaN Inf NaN], eps); +%!assert(expinv ([x(1:2) NaN x(4:5)], 2), [NaN 0 NaN Inf NaN], eps); + +%% Test class of input preserved +%!assert(expinv ([x, NaN], 2), [NaN 0 1 Inf NaN NaN], eps); +%!assert(expinv (single([x, NaN]), 2), single([NaN 0 1 Inf NaN NaN]), eps); +%!assert(expinv ([x, NaN], single(2)), single([NaN 0 1 Inf NaN NaN]), eps); + +%% Test input validation +%!error expinv () +%!error expinv (1) +%!error expinv (1,2,3) +%!error expinv (ones(3),ones(2)) +%!error expinv (ones(2),ones(3)) +%!error expinv (i, 2) +%!error expinv (2, i) +
--- a/scripts/statistics/distributions/exppdf.m +++ b/scripts/statistics/distributions/exppdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,7 +20,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} exppdf (@var{x}, @var{lambda}) ## For each element of @var{x}, compute the probability density function -## (PDF) of the exponential distribution with mean @var{lambda}. +## (PDF) at @var{x} of the exponential distribution with mean @var{lambda}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -31,34 +32,53 @@ print_usage (); endif - if (!isscalar (x) && !isscalar(lambda)) + if (!isscalar (lambda)) [retval, x, lambda] = common_size (x, lambda); if (retval > 0) - error ("exppdf: X and LAMBDA must be of common size or scalar"); + error ("exppdf: X and LAMBDA must be of common size or scalars"); endif endif - if (isscalar (x)) - sz = size (lambda); - else - sz = size (x); - endif - pdf = zeros (sz); - - k = find (!(lambda > 0) | isnan (x)); - if (any (k)) - pdf(k) = NaN; + if (iscomplex (x) || iscomplex (lambda)) + error ("exppdf: X and LAMBDA must not be complex"); endif - k = find ((x > 0) & (x < Inf) & (lambda > 0)); - if (any (k)) - if isscalar (lambda) - pdf(k) = exp (- x(k) ./ lambda) ./ lambda; - elseif isscalar (x) - pdf(k) = exp (- x ./ lambda(k)) ./ lambda(k); - else - pdf(k) = exp (- x(k) ./ lambda(k)) ./ lambda(k); - endif + if (isa (x, "single") || isa (lambda, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | !(lambda > 0); + pdf(k) = NaN; + + k = (x >= 0) & (x < Inf) & (lambda > 0); + if isscalar (lambda) + pdf(k) = exp (- x(k) / lambda) / lambda; + else + pdf(k) = exp (- x(k) ./ lambda(k)) ./ lambda(k); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = gampdf (x, 1, 2); +%!assert(exppdf (x, 2*ones(1,5)), y); +%!assert(exppdf (x, 2*[1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)]); +%!assert(exppdf ([x, NaN], 2), [y, NaN]); + +%% Test class of input preserved +%!assert(exppdf (single([x, NaN]), 2), single([y, NaN])); +%!assert(exppdf ([x, NaN], single(2)), single([y, NaN])); + +%% Test input validation +%!error exppdf () +%!error exppdf (1) +%!error exppdf (1,2,3) +%!error exppdf (ones(3),ones(2)) +%!error exppdf (ones(2),ones(3)) +%!error exppdf (i, 2) +%!error exppdf (2, i) +
--- a/scripts/statistics/distributions/exprnd.m +++ b/scripts/statistics/distributions/exprnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,71 +18,100 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} exprnd (@var{lambda}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} exprnd (@var{lambda}, @var{sz}) -## Return an @var{r} by @var{c} matrix of random samples from the -## exponential distribution with mean @var{lambda}, which must be a -## scalar or of size @var{r} by @var{c}. Or if @var{sz} is a vector, -## create a matrix of size @var{sz}. +## @deftypefn {Function File} {} exprnd (@var{lambda}) +## @deftypefnx {Function File} {} exprnd (@var{lambda}, @var{r}) +## @deftypefnx {Function File} {} exprnd (@var{lambda}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} exprnd (@var{lambda}, [@var{sz}]) +## Return a matrix of random samples from the exponential distribution with +## mean @var{lambda}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the size of @var{lambda}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{lambda}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the exponential distribution -function rnd = exprnd (lambda, r, c) - - if (nargin == 3) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("exprnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("exprnd: C must be a positive integer"); - endif - sz = [r, c]; +function rnd = exprnd (lambda, varargin) - if (any (size (lambda) != 1) - && (length (size (lambda)) != length (sz) || any (size (lambda) != sz))) - error ("exprnd: LAMBDA must be scalar or of size [R, C]"); - endif - elseif (nargin == 2) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("exprnd: R must be a positive integer or vector"); - endif - - if (any (size (lambda) != 1) - && ((length (size (lambda)) != length (sz)) || any (size (lambda) != sz))) - error ("exprnd: LAMBDA must be scalar or of size SZ"); - endif - elseif (nargin == 1) - sz = size (lambda); - else + if (nargin < 1) print_usage (); endif + if (nargin == 1) + sz = size (lambda); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("exprnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("exprnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (lambda) && !isequal (size (lambda), sz)) + error ("exprnd: LAMBDA must be scalar or of size SZ"); + endif + + if (iscomplex (lambda)) + error ("exprnd: LAMBDA must not be complex"); + endif + + if (isa (lambda, "single")) + cls = "single"; + else + cls = "double"; + endif if (isscalar (lambda)) if ((lambda > 0) && (lambda < Inf)) - rnd = rande(sz) * lambda; + rnd = rande (sz) * lambda; else - rnd = NaN (sz); + rnd = NaN (sz, cls); endif else - rnd = zeros (sz); - k = find (!(lambda > 0) | !(lambda < Inf)); - if (any (k)) - rnd(k) = NaN; - endif - k = find ((lambda > 0) & (lambda < Inf)); - if (any (k)) - rnd(k) = rande(size(k)) .* lambda(k); - endif + rnd = NaN (sz, cls); + + k = (lambda > 0) & (lambda < Inf); + rnd(k) = rande (sum (k(:)), 1) .* lambda(k)(:); endif endfunction + + +%!assert(size (exprnd (2)), [1, 1]); +%!assert(size (exprnd (ones(2,1))), [2, 1]); +%!assert(size (exprnd (ones(2,2))), [2, 2]); +%!assert(size (exprnd (1, 3)), [3, 3]); +%!assert(size (exprnd (1, [4 1])), [4, 1]); +%!assert(size (exprnd (1, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (exprnd (1)), "double"); +%!assert(class (exprnd (single(1))), "single"); +%!assert(class (exprnd (single([1 1]))), "single"); + +%% Test input validation +%!error exprnd () +%!error exprnd (1, -1) +%!error exprnd (1, ones(2)) +%!error exprnd (i) +%!error exprnd (1, [2 -1 2]) +%!error exprnd (1, 2, -1) +%!error exprnd (1, 2, ones(2)) +%!error exprnd (ones(2,2), 3) +%!error exprnd (ones(2,2), [3, 2]) +%!error exprnd (ones(2,2), 2, 3) +
--- a/scripts/statistics/distributions/fcdf.m +++ b/scripts/statistics/distributions/fcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,9 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} fcdf (@var{x}, @var{m}, @var{n}) -## For each element of @var{x}, compute the CDF at @var{x} of the F -## distribution with @var{m} and @var{n} degrees of freedom, i.e., -## PROB (F (@var{m}, @var{n}) @leq{} @var{x}). +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the F distribution with @var{m} and @var{n} degrees of +## freedom. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -35,31 +36,61 @@ if (!isscalar (m) || !isscalar (n)) [retval, x, m, n] = common_size (x, m, n); if (retval > 0) - error ("fcdf: X, M and N must be of common size or scalar"); + error ("fcdf: X, M, and N must be of common size or scalars"); endif endif - sz = size (x); - cdf = zeros (sz); + if (iscomplex (x) || iscomplex (m) || iscomplex (n)) + error ("fcdf: X, M, and N must not be complex"); + endif - k = find (!(m > 0) | !(n > 0) | isnan (x)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (m, "single") || isa (n, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x == Inf) & (m > 0) & (n > 0)); - if (any (k)) - cdf(k) = 1; - endif + k = isnan (x) | !(m > 0) | !(m < Inf) | !(n > 0) | !(n < Inf); + cdf(k) = NaN; + + k = (x == Inf) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + cdf(k) = 1; - k = find ((x > 0) & (x < Inf) & (m > 0) & (n > 0)); - if (any (k)) - if (isscalar (m) && isscalar (n)) - cdf(k) = 1 - betainc (1 ./ (1 + m .* x(k) ./ n), n / 2, m / 2); - else - cdf(k) = 1 - betainc (1 ./ (1 + m(k) .* x(k) ./ n(k)), n(k) / 2, - m(k) / 2); - endif + k = (x > 0) & (x < Inf) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + if (isscalar (m) && isscalar (n)) + cdf(k) = 1 - betainc (1 ./ (1 + m * x(k) / n), n/2, m/2); + else + cdf(k) = 1 - betainc (1 ./ (1 + m(k) .* x(k) ./ n(k)), n(k)/2, m(k)/2); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2 Inf]; +%! y = [0 0 1/3 1/2 2/3 1]; +%!assert(fcdf (x, 2*ones(1,6), 2*ones(1,6)), y, eps); +%!assert(fcdf (x, 2, 2*ones(1,6)), y, eps); +%!assert(fcdf (x, 2*ones(1,6), 2), y, eps); +%!assert(fcdf (x, [0 NaN Inf 2 2 2], 2), [NaN NaN NaN y(4:6)], eps); +%!assert(fcdf (x, 2, [0 NaN Inf 2 2 2]), [NaN NaN NaN y(4:6)], eps); +%!assert(fcdf ([x(1:2) NaN x(4:6)], 2, 2), [y(1:2) NaN y(4:6)], eps); + +%% Test class of input preserved +%!assert(fcdf ([x, NaN], 2, 2), [y, NaN], eps); +%!assert(fcdf (single([x, NaN]), 2, 2), single([y, NaN]), eps("single")); +%!assert(fcdf ([x, NaN], single(2), 2), single([y, NaN]), eps("single")); +%!assert(fcdf ([x, NaN], 2, single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error fcdf () +%!error fcdf (1) +%!error fcdf (1,2) +%!error fcdf (1,2,3,4) +%!error fcdf (ones(3),ones(2),ones(2)) +%!error fcdf (ones(2),ones(3),ones(2)) +%!error fcdf (ones(2),ones(2),ones(3)) +%!error fcdf (i, 2, 2) +%!error fcdf (2, i, 2) +%!error fcdf (2, 2, i) +
--- a/scripts/statistics/distributions/finv.m +++ b/scripts/statistics/distributions/finv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,9 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} finv (@var{x}, @var{m}, @var{n}) -## For each component of @var{x}, compute the quantile (the inverse of -## the CDF) at @var{x} of the F distribution with parameters @var{m} and -## @var{n}. +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the F distribution with @var{m} and @var{n} +## degrees of freedom. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -35,31 +36,58 @@ if (!isscalar (m) || !isscalar (n)) [retval, x, m, n] = common_size (x, m, n); if (retval > 0) - error ("finv: X, M and N must be of common size or scalar"); + error ("finv: X, M, and N must be of common size or scalars"); endif endif - sz = size (x); - inv = zeros (sz); + if (iscomplex (x) || iscomplex (m) || iscomplex (n)) + error ("finv: X, M, and N must not be complex"); + endif - k = find ((x < 0) | (x > 1) | isnan (x) | !(m > 0) | !(n > 0)); - if (any (k)) - inv(k) = NaN; + if (isa (x, "single") || isa (m, "single") || isa (n, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find ((x == 1) & (m > 0) & (n > 0)); - if (any (k)) - inv(k) = Inf; - endif + k = (x == 1) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + inv(k) = Inf; - k = find ((x > 0) & (x < 1) & (m > 0) & (n > 0)); - if (any (k)) - if (isscalar (m) && isscalar (n)) - inv(k) = ((1 ./ betainv (1 - x(k), n / 2, m / 2) - 1) .* n ./ m); - else - inv(k) = ((1 ./ betainv (1 - x(k), n(k) / 2, m(k) / 2) - 1) - .* n(k) ./ m(k)); - endif + k = (x >= 0) & (x < 1) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + if (isscalar (m) && isscalar (n)) + inv(k) = ((1 ./ betainv (1 - x(k), n/2, m/2) - 1) * n / m); + else + inv(k) = ((1 ./ betainv (1 - x(k), n(k)/2, m(k)/2) - 1) + .* n(k) ./ m(k)); endif endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(finv (x, 2*ones(1,5), 2*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(finv (x, 2, 2*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(finv (x, 2*ones(1,5), 2), [NaN 0 1 Inf NaN]); +%!assert(finv (x, [2 -Inf NaN Inf 2], 2), [NaN NaN NaN NaN NaN]); +%!assert(finv (x, 2, [2 -Inf NaN Inf 2]), [NaN NaN NaN NaN NaN]); +%!assert(finv ([x(1:2) NaN x(4:5)], 2, 2), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(finv ([x, NaN], 2, 2), [NaN 0 1 Inf NaN NaN]); +%!assert(finv (single([x, NaN]), 2, 2), single([NaN 0 1 Inf NaN NaN])); +%!assert(finv ([x, NaN], single(2), 2), single([NaN 0 1 Inf NaN NaN])); +%!assert(finv ([x, NaN], 2, single(2)), single([NaN 0 1 Inf NaN NaN])); + +%% Test input validation +%!error finv () +%!error finv (1) +%!error finv (1,2) +%!error finv (1,2,3,4) +%!error finv (ones(3),ones(2),ones(2)) +%!error finv (ones(2),ones(3),ones(2)) +%!error finv (ones(2),ones(2),ones(3)) +%!error finv (i, 2, 2) +%!error finv (2, i, 2) +%!error finv (2, 2, i) +
--- a/scripts/statistics/distributions/fpdf.m +++ b/scripts/statistics/distributions/fpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -35,31 +36,70 @@ if (!isscalar (m) || !isscalar (n)) [retval, x, m, n] = common_size (x, m, n); if (retval > 0) - error ("fpdf: X, M and N must be of common size or scalar"); + error ("fpdf: X, M, and N must be of common size or scalars"); endif endif - sz = size (x); - pdf = zeros (sz); + if (iscomplex (x) || iscomplex (m) || iscomplex (n)) + error ("fpdf: X, M, and N must not be complex"); + endif - k = find (isnan (x) | !(m > 0) | !(n > 0)); - if (any (k)) - pdf(k) = NaN; + if (isa (x, "single") || isa (m, "single") || isa (n, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); endif - k = find ((x > 0) & (x < Inf) & (m > 0) & (n > 0)); - if (any (k)) - if (isscalar (m) && isscalar (n)) - tmp = m / n * x(k); - pdf(k) = (exp ((m / 2 - 1) .* log (tmp) - - ((m + n) / 2) .* log (1 + tmp)) - .* (m / n) ./ beta (m / 2, n / 2)); - else - tmp = m(k) .* x(k) ./ n(k); - pdf(k) = (exp ((m(k) / 2 - 1) .* log (tmp) - - ((m(k) + n(k)) / 2) .* log (1 + tmp)) - .* (m(k) ./ n(k)) ./ beta (m(k) / 2, n(k) / 2)); - endif + k = isnan (x) | !(m > 0) | !(m < Inf) | !(n > 0) | !(n < Inf); + pdf(k) = NaN; + + k = (x > 0) & (x < Inf) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + if (isscalar (m) && isscalar (n)) + tmp = m / n * x(k); + pdf(k) = (exp ((m/2 - 1) * log (tmp) + - ((m + n) / 2) * log (1 + tmp)) + * (m / n) ./ beta (m/2, n/2)); + else + tmp = m(k) .* x(k) ./ n(k); + pdf(k) = (exp ((m(k)/2 - 1) .* log (tmp) + - ((m(k) + n(k)) / 2) .* log (1 + tmp)) + .* (m(k) ./ n(k)) ./ beta (m(k)/2, n(k)/2)); endif endfunction + + +%% F (x, 1, m) == T distribution (sqrt (x), m) / sqrt (x) +%!test +%! x = rand (10,1); +%! x = x(x > 0.1 & x < 0.9); +%! y = tpdf (sqrt (x), 2) ./ sqrt (x); +%! assert(fpdf (x, 1, 2), y, 5*eps); + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = [0 0 4/9 1/4 1/9]; +%!assert(fpdf (x, 2*ones(1,5), 2*ones(1,5)), y, eps); +%!assert(fpdf (x, 2, 2*ones(1,5)), y, eps); +%!assert(fpdf (x, 2*ones(1,5), 2), y, eps); +%!assert(fpdf (x, [0 NaN Inf 2 2], 2), [NaN NaN NaN y(4:5)], eps); +%!assert(fpdf (x, 2, [0 NaN Inf 2 2]), [NaN NaN NaN y(4:5)], eps); +%!assert(fpdf ([x, NaN], 2, 2), [y, NaN], eps); + +%% Test class of input preserved +%!assert(fpdf (single([x, NaN]), 2, 2), single([y, NaN]), eps("single")); +%!assert(fpdf ([x, NaN], single(2), 2), single([y, NaN]), eps("single")); +%!assert(fpdf ([x, NaN], 2, single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error fpdf () +%!error fpdf (1) +%!error fpdf (1,2) +%!error fpdf (1,2,3,4) +%!error fpdf (ones(3),ones(2),ones(2)) +%!error fpdf (ones(2),ones(3),ones(2)) +%!error fpdf (ones(2),ones(2),ones(3)) +%!error fpdf (i, 2, 2) +%!error fpdf (2, i, 2) +%!error fpdf (2, 2, i) +
--- a/scripts/statistics/distributions/frnd.m +++ b/scripts/statistics/distributions/frnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,103 +18,115 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} frnd (@var{m}, @var{n}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} frnd (@var{m}, @var{n}, @var{sz}) -## Return an @var{r} by @var{c} matrix of random samples from the F -## distribution with @var{m} and @var{n} degrees of freedom. Both -## @var{m} and @var{n} must be scalar or of size @var{r} by @var{c}. -## If @var{sz} is a vector the random samples are in a matrix of -## size @var{sz}. +## @deftypefn {Function File} {} frnd (@var{m}, @var{n}) +## @deftypefnx {Function File} {} frnd (@var{m}, @var{n}, @var{r}) +## @deftypefnx {Function File} {} frnd (@var{m}, @var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} frnd (@var{m}, @var{n}, [@var{sz}]) +## Return a matrix of random samples from the F distribution with +## @var{m} and @var{n} degrees of freedom. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{m} and @var{n}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{m} and @var{n}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the F distribution -function rnd = frnd (m, n, r, c) +function rnd = frnd (m, n, varargin) - if (nargin > 1) - if (!isscalar(m) || !isscalar(n)) - [retval, m, n] = common_size (m, n); - if (retval > 0) - error ("frnd: M and N must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (m) || !isscalar (n)) + [retval, m, n] = common_size (m, n); + if (retval > 0) + error ("frnd: M and N must be of common size or scalars"); endif endif - - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("frnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("frnd: C must be a positive integer"); - endif - sz = [r, c]; - - if (any (size (m) != 1) - && ((length (size (m)) != length (sz)) || any (size (m) != sz))) - error ("frnd: M and N must be scalar or of size [R,C]"); - endif - elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("frnd: R must be a positive integer or vector"); - endif - - if (any (size (m) != 1) - && ((length (size (m)) != length (sz)) || any (size (m) != sz))) - error ("frnd: M and N must be scalar or of size SZ"); - endif - elseif (nargin == 2) - sz = size(a); - else - print_usage (); + if (iscomplex (m) || iscomplex (n)) + error ("frnd: M and N must not be complex"); endif + if (nargin == 2) + sz = size (m); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("frnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("frnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (m) && !isequal (size (m), sz)) + error ("frnd: M and N must be scalar or of size SZ"); + endif + + if (isa (m, "single") || isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif if (isscalar (m) && isscalar (n)) - if (isinf (m) || isinf (n)) - if (isinf (m)) - rnd = ones (sz); - else - rnd = 2 ./ m .* randg(m / 2, sz); - endif - if (! isinf (n)) - rnd = 0.5 .* n .* rnd ./ randg (n / 2, sz); - endif - elseif ((m > 0) && (m < Inf) && (n > 0) && (n < Inf)) - rnd = n ./ m .* randg (m / 2, sz) ./ randg (n / 2, sz); + if ((m > 0) && (m < Inf) && (n > 0) && (n < Inf)) + rnd = n/m * randg (m/2, sz) ./ randg (n/2, sz); else - rnd = NaN (sz); + rnd = NaN (sz, cls); endif else - rnd = zeros (sz); - - k = find (isinf(m) | isinf(n)); - if (any (k)) - rnd (k) = 1; - k2 = find (!isinf(m) & isinf(n)); - rnd (k2) = 2 ./ m(k2) .* randg (m(k2) ./ 2, size(k2)); - k2 = find (isinf(m) & !isinf(n)); - rnd (k2) = 0.5 .* n(k2) .* rnd(k2) ./ randg (n(k2) ./ 2, size(k2)); - endif + rnd = NaN (sz, cls); - k = find (!(m > 0) | !(n > 0)); - if (any (k)) - rnd(k) = NaN; - endif - - k = find ((m > 0) & (m < Inf) & - (n > 0) & (n < Inf)); - if (any (k)) - rnd(k) = n(k) ./ m(k) .* randg(m(k)./2,size(k)) ./ randg(n(k)./2,size(k)); - endif + k = (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + rnd(k) = n(k) ./ m(k) .* randg (m(k)/2) ./ randg (n(k)/2); endif endfunction + + +%!assert(size (frnd (1,2)), [1, 1]); +%!assert(size (frnd (ones(2,1), 2)), [2, 1]); +%!assert(size (frnd (ones(2,2), 2)), [2, 2]); +%!assert(size (frnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (frnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (frnd (1, 2, 3)), [3, 3]); +%!assert(size (frnd (1, 2, [4 1])), [4, 1]); +%!assert(size (frnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (frnd (1, 2)), "double"); +%!assert(class (frnd (single(1), 2)), "single"); +%!assert(class (frnd (single([1 1]), 2)), "single"); +%!assert(class (frnd (1, single(2))), "single"); +%!assert(class (frnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error frnd () +%!error frnd (1) +%!error frnd (ones(3),ones(2)) +%!error frnd (ones(2),ones(3)) +%!error frnd (i, 2) +%!error frnd (2, i) +%!error frnd (1,2, -1) +%!error frnd (1,2, ones(2)) +%!error frnd (1, 2, [2 -1 2]) +%!error frnd (1,2, 1, ones(2)) +%!error frnd (1,2, 1, -1) +%!error frnd (ones(2,2), 2, 3) +%!error frnd (ones(2,2), 2, [3, 2]) +%!error frnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/gamcdf.m +++ b/scripts/statistics/distributions/gamcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,9 +20,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} gamcdf (@var{x}, @var{a}, @var{b}) ## For each element of @var{x}, compute the cumulative distribution -## function (CDF) at @var{x} of the Gamma distribution with parameters -## @var{a} and @var{b}. -## @seealso{gamma, gammaln, gammainc, gampdf, gaminv, gamrnd} +## function (CDF) at @var{x} of the Gamma distribution with shape +## parameter @var{a} and scale @var{b}. ## @end deftypefn ## Author: TT <Teresa.Twaroch@ci.tuwien.ac.at> @@ -33,28 +33,59 @@ print_usage (); endif - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("gamcdf: X, A and B must be of common size or scalars"); + error ("gamcdf: X, A, and B must be of common size or scalars"); endif endif - sz = size (x); - cdf = zeros (sz); - - k = find (!(a > 0) | !(b > 0) | isnan (x)); - if (any (k)) - cdf (k) = NaN; + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("gamcdf: X, A, and B must not be complex"); endif - k = find ((x > 0) & (a > 0) & (b > 0)); - if (any (k)) - if (isscalar (a) && isscalar(b)) - cdf (k) = gammainc (x(k) ./ b, a); - else - cdf (k) = gammainc (x(k) ./ b(k), a(k)); - endif + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + k = isnan (x) | !(a > 0) | !(a < Inf) | !(b > 0) | !(b < Inf); + cdf(k) = NaN; + + k = (x > 0) & (a > 0) & (a < Inf) & (b > 0) & (b < Inf); + if (isscalar (a) && isscalar (b)) + cdf(k) = gammainc (x(k) / b, a); + else + cdf(k) = gammainc (x(k) ./ b(k), a(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2 Inf]; +%! y = [0, gammainc(x(2:end), 1)]; +%!assert(gamcdf (x, ones(1,6), ones(1,6)), y); +%!assert(gamcdf (x, 1, ones(1,6)), y); +%!assert(gamcdf (x, ones(1,6), 1), y); +%!assert(gamcdf (x, [0 -Inf NaN Inf 1 1], 1), [NaN NaN NaN NaN y(5:6)]); +%!assert(gamcdf (x, 1, [0 -Inf NaN Inf 1 1]), [NaN NaN NaN NaN y(5:6)]); +%!assert(gamcdf ([x(1:2) NaN x(4:6)], 1, 1), [y(1:2) NaN y(4:6)]); + +%% Test class of input preserved +%!assert(gamcdf ([x, NaN], 1, 1), [y, NaN]); +%!assert(gamcdf (single([x, NaN]), 1, 1), single([y, NaN]), eps("single")); + +%% Test input validation +%!error gamcdf () +%!error gamcdf (1) +%!error gamcdf (1,2) +%!error gamcdf (1,2,3,4) +%!error gamcdf (ones(3),ones(2),ones(2)) +%!error gamcdf (ones(2),ones(3),ones(2)) +%!error gamcdf (ones(2),ones(2),ones(3)) +%!error gamcdf (i, 2, 2) +%!error gamcdf (2, i, 2) +%!error gamcdf (2, 2, i) +
--- a/scripts/statistics/distributions/gaminv.m +++ b/scripts/statistics/distributions/gaminv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,10 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} gaminv (@var{x}, @var{a}, @var{b}) -## For each component of @var{x}, compute the quantile (the inverse of -## the CDF) at @var{x} of the Gamma distribution with parameters @var{a} -## and @var{b}. -## @seealso{gamma, gammaln, gammainc, gampdf, gamcdf, gamrnd} +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the Gamma distribution with shape parameter +## @var{a} and scale @var{b}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -33,36 +33,40 @@ print_usage (); endif - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("gaminv: X, A and B must be of common size or scalars"); + error ("gaminv: X, A, and B must be of common size or scalars"); endif endif - sz = size (x); - inv = zeros (sz); + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("gaminv: X, A, and B must not be complex"); + endif - k = find ((x < 0) | (x > 1) | isnan (x) | !(a > 0) | !(b > 0)); - if (any (k)) - inv (k) = NaN; + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); endif - k = find ((x == 1) & (a > 0) & (b > 0)); - if (any (k)) - inv (k) = Inf; - endif + k = ((x < 0) | (x > 1) | isnan (x) + | !(a > 0) | !(a < Inf) | !(b > 0) | !(b < Inf)); + inv(k) = NaN; - k = find ((x > 0) & (x < 1) & (a > 0) & (b > 0)); + k = (x == 1) & (a > 0) & (a < Inf) & (b > 0) & (b < Inf); + inv(k) = Inf; + + k = find ((x > 0) & (x < 1) & (a > 0) & (a < Inf) & (b > 0) & (b < Inf)); if (any (k)) - if (!isscalar(a) || !isscalar(b)) - a = a (k); - b = b (k); + if (!isscalar (a) || !isscalar (b)) + a = a(k); + b = b(k); y = a .* b; else y = a * b * ones (size (k)); endif - x = x (k); + x = x(k); if (isa (x, "single")) myeps = eps ("single"); @@ -90,7 +94,36 @@ y_old = y_new; endfor - inv (k) = y_new; + inv(k) = y_new; endif endfunction + + +%!shared x +%! x = [-1 0 0.63212055882855778 1 2]; +%!assert(gaminv (x, ones(1,5), ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(gaminv (x, 1, ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(gaminv (x, ones(1,5), 1), [NaN 0 1 Inf NaN], eps); +%!assert(gaminv (x, [1 -Inf NaN Inf 1], 1), [NaN NaN NaN NaN NaN]); +%!assert(gaminv (x, 1, [1 -Inf NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(gaminv ([x(1:2) NaN x(4:5)], 1, 1), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(gaminv ([x, NaN], 1, 1), [NaN 0 1 Inf NaN NaN], eps); +%!assert(gaminv (single([x, NaN]), 1, 1), single([NaN 0 1 Inf NaN NaN]), eps("single")); +%!assert(gaminv ([x, NaN], single(1), 1), single([NaN 0 1 Inf NaN NaN]), eps("single")); +%!assert(gaminv ([x, NaN], 1, single(1)), single([NaN 0 1 Inf NaN NaN]), eps("single")); + +%% Test input validation +%!error gaminv () +%!error gaminv (1) +%!error gaminv (1,2) +%!error gaminv (1,2,3,4) +%!error gaminv (ones(3),ones(2),ones(2)) +%!error gaminv (ones(2),ones(3),ones(2)) +%!error gaminv (ones(2),ones(2),ones(3)) +%!error gaminv (i, 2, 2) +%!error gaminv (2, i, 2) +%!error gaminv (2, 2, i) +
--- a/scripts/statistics/distributions/gampdf.m +++ b/scripts/statistics/distributions/gampdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,9 +20,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} gampdf (@var{x}, @var{a}, @var{b}) ## For each element of @var{x}, return the probability density function -## (PDF) at @var{x} of the Gamma distribution with parameters @var{a} -## and @var{b}. -## @seealso{gamma, gammaln, gammainc, gamcdf, gaminv, gamrnd} +## (PDF) at @var{x} of the Gamma distribution with shape parameter +## @var{a} and scale @var{b}. ## @end deftypefn ## Author: TT <Teresa.Twaroch@ci.tuwien.ac.at> @@ -33,41 +33,71 @@ print_usage (); endif - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("gampdf: X, A and B must be of common size or scalars"); + error ("gampdf: X, A, and B must be of common size or scalars"); endif endif - sz = size(x); - pdf = zeros (sz); + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("gampdf: X, A, and B must not be complex"); + endif - k = find (!(a > 0) | !(b > 0) | isnan (x)); - if (any (k)) - pdf (k) = NaN; + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); endif - k = find ((x > 0) & (a > 0) & (a <= 1) & (b > 0)); - if (any (k)) - if (isscalar(a) && isscalar(b)) - pdf(k) = (x(k) .^ (a - 1)) ... - .* exp(- x(k) ./ b) ./ gamma (a) ./ (b .^ a); - else - pdf(k) = (x(k) .^ (a(k) - 1)) ... - .* exp(- x(k) ./ b(k)) ./ gamma (a(k)) ./ (b(k) .^ a(k)); - endif + k = !(a > 0) | !(b > 0) | isnan (x); + pdf(k) = NaN; + + k = (x >= 0) & (a > 0) & (a <= 1) & (b > 0); + if (isscalar (a) && isscalar (b)) + pdf(k) = (x(k) .^ (a - 1)) ... + .* exp (- x(k) / b) / gamma (a) / (b ^ a); + else + pdf(k) = (x(k) .^ (a(k) - 1)) ... + .* exp (- x(k) ./ b(k)) ./ gamma (a(k)) ./ (b(k) .^ a(k)); endif - k = find ((x > 0) & (a > 1) & (b > 0)); - if (any (k)) - if (isscalar(a) && isscalar(b)) - pdf(k) = exp (- a .* log (b) + (a-1) .* log (x(k)) - - x(k) ./ b - gammaln (a)); - else - pdf(k) = exp (- a(k) .* log (b(k)) + (a(k)-1) .* log (x(k)) - - x(k) ./ b(k) - gammaln (a(k))); - endif + k = (x >= 0) & (a > 1) & (b > 0); + if (isscalar (a) && isscalar (b)) + pdf(k) = exp (- a * log (b) + (a-1) * log (x(k)) + - x(k) / b - gammaln (a)); + else + pdf(k) = exp (- a(k) .* log (b(k)) + (a(k)-1) .* log (x(k)) + - x(k) ./ b(k) - gammaln (a(k))); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0 exp(-x(2:end))]; +%!assert(gampdf (x, ones(1,5), ones(1,5)), y); +%!assert(gampdf (x, 1, ones(1,5)), y); +%!assert(gampdf (x, ones(1,5), 1), y); +%!assert(gampdf (x, [0 -Inf NaN Inf 1], 1), [NaN NaN NaN NaN y(5)]); +%!assert(gampdf (x, 1, [0 -Inf NaN Inf 1]), [NaN NaN NaN 0 y(5)]); +%!assert(gampdf ([x, NaN], 1, 1), [y, NaN]); + +%% Test class of input preserved +%!assert(gampdf (single([x, NaN]), 1, 1), single([y, NaN])); +%!assert(gampdf ([x, NaN], single(1), 1), single([y, NaN])); +%!assert(gampdf ([x, NaN], 1, single(1)), single([y, NaN])); + +%% Test input validation +%!error gampdf () +%!error gampdf (1) +%!error gampdf (1,2) +%!error gampdf (1,2,3,4) +%!error gampdf (ones(3),ones(2),ones(2)) +%!error gampdf (ones(2),ones(3),ones(2)) +%!error gampdf (ones(2),ones(2),ones(3)) +%!error gampdf (i, 2, 2) +%!error gampdf (2, i, 2) +%!error gampdf (2, 2, i) +
--- a/scripts/statistics/distributions/gamrnd.m +++ b/scripts/statistics/distributions/gamrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,81 +18,118 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} gamrnd (@var{a}, @var{b}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} gamrnd (@var{a}, @var{b}, @var{sz}) -## Return an @var{r} by @var{c} or a @code{size (@var{sz})} matrix of -## random samples from the Gamma distribution with parameters @var{a} -## and @var{b}. Both @var{a} and @var{b} must be scalar or of size -## @var{r} by @var{c}. +## @deftypefn {Function File} {} gamrnd (@var{a}, @var{b}) +## @deftypefnx {Function File} {} gamrnd (@var{a}, @var{b}, @var{r}) +## @deftypefnx {Function File} {} gamrnd (@var{a}, @var{b}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} gamrnd (@var{a}, @var{b}, [@var{sz}]) +## Return a matrix of random samples from the Gamma distribution with +## shape parameter @var{a} and scale @var{b}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{a} and @var{b}. -## @seealso{gamma, gammaln, gammainc, gampdf, gamcdf, gaminv} +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{a} and @var{b}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the Gamma distribution -function rnd = gamrnd (a, b, r, c) +function rnd = gamrnd (a, b, varargin) - if (nargin > 1) - if (!isscalar(a) || !isscalar(b)) - [retval, a, b] = common_size (a, b); - if (retval > 0) - error ("gamrnd: A and B must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, a, b] = common_size (a, b); + if (retval > 0) + error ("gamrnd: A and B must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("gamrnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("gamrnd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (a) || iscomplex (b)) + error ("gamrnd: A and B must not be complex"); + endif - if (any (size (a) != 1) - && (length (size (a)) != length (sz) || any (size (a) != sz))) - error ("gamrnd: A and B must be scalar or of size [R, C]"); - endif + if (nargin == 2) + sz = size (a); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("gamrnd: R must be a positive integer or vector"); + error ("gamrnd: dimension vector must be row vector of non-negative integers"); endif - - if (any (size (a) != 1) - && (length (size (a)) != length (sz) || any (size (a) != sz))) - error ("gamrnd: A and B must be scalar or of size SZ"); + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("gamrnd: dimensions must be non-negative integers"); endif - elseif (nargin == 2) - sz = size(a); - else - print_usage (); + sz = [varargin{:}]; endif - rnd = zeros (sz); + if (!isscalar (a) && !isequal (size (a), sz)) + error ("gamrnd: A and B must be scalar or of size SZ"); + endif - if (isscalar (a) && isscalar(b)) - if (find (!(a > 0) | !(a < Inf) | !(b > 0) | !(b < Inf))) - rnd = NaN (sz); - else - rnd = b .* randg(a, sz); + if (isa (a, "single") || isa (b, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (a) && isscalar (b)) + if ((a > 0) && (a < Inf) && (b > 0) && (b < Inf)) + rnd = b * randg (a, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + else + rnd = NaN (sz, cls); endif else - k = find (!(a > 0) | !(a < Inf) | !(b > 0) | !(b < Inf)); - if (any (k)) - rnd(k) = NaN; - endif - k = find ((a > 0) & (a < Inf) & (b > 0) & (b < Inf)); - if (any (k)) - rnd(k) = b(k) .* randg(a(k), size(k)); - endif + rnd = NaN (sz, cls); + + k = (a > 0) & (a < Inf) & (b > 0) & (b < Inf); + rnd(k) = b(k) .* randg (a(k)); endif endfunction + + +%!assert(size (gamrnd (1,2)), [1, 1]); +%!assert(size (gamrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (gamrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (gamrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (gamrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (gamrnd (1, 2, 3)), [3, 3]); +%!assert(size (gamrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (gamrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (gamrnd (1, 2)), "double"); +%!assert(class (gamrnd (single(1), 2)), "single"); +%!assert(class (gamrnd (single([1 1]), 2)), "single"); +%!assert(class (gamrnd (1, single(2))), "single"); +%!assert(class (gamrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error gamrnd () +%!error gamrnd (1) +%!error gamrnd (ones(3),ones(2)) +%!error gamrnd (ones(2),ones(3)) +%!error gamrnd (i, 2) +%!error gamrnd (2, i) +%!error gamrnd (1,2, -1) +%!error gamrnd (1,2, ones(2)) +%!error gamrnd (1, 2, [2 -1 2]) +%!error gamrnd (1,2, 1, ones(2)) +%!error gamrnd (1,2, 1, -1) +%!error gamrnd (ones(2,2), 2, 3) +%!error gamrnd (ones(2,2), 2, [3, 2]) +%!error gamrnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/geocdf.m +++ b/scripts/statistics/distributions/geocdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,8 +19,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} geocdf (@var{x}, @var{p}) -## For each element of @var{x}, compute the CDF at @var{x} of the -## geometric distribution with parameter @var{p}. +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the geometric distribution with parameter @var{p}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -31,34 +32,58 @@ print_usage (); endif - if (!isscalar (x) && !isscalar (p)) + if (!isscalar (p)) [retval, x, p] = common_size (x, p); if (retval > 0) - error ("geocdf: X and P must be of common size or scalar"); + error ("geocdf: X and P must be of common size or scalars"); endif endif - cdf = zeros (size (x)); + if (iscomplex (x) || iscomplex (p)) + error ("geocdf: X and P must not be complex"); + endif - k = find (isnan (x) | !(p >= 0) | !(p <= 1)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (p, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x == Inf) & (p >= 0) & (p <= 1)); - if (any (k)) - cdf(k) = 1; - endif + k = isnan (x) | !(p >= 0) | !(p <= 1); + cdf(k) = NaN; + + k = (x == Inf) & (p >= 0) & (p <= 1); + cdf(k) = 1; - k = find ((x >= 0) & (x < Inf) & (x == round (x)) & (p > 0) & (p <= 1)); - if (any (k)) - if (isscalar (x)) - cdf(k) = 1 - ((1 - p(k)) .^ (x + 1)); - elseif (isscalar (p)) - cdf(k) = 1 - ((1 - p) .^ (x(k) + 1)); - else - cdf(k) = 1 - ((1 - p(k)) .^ (x(k) + 1)); - endif + k = (x >= 0) & (x < Inf) & (x == fix (x)) & (p > 0) & (p <= 1); + if (isscalar (p)) + cdf(k) = 1 - ((1 - p) .^ (x(k) + 1)); + else + cdf(k) = 1 - ((1 - p(k)) .^ (x(k) + 1)); endif endfunction + + +%!shared x,y +%! x = [-1 0 1 Inf]; +%! y = [0 0.5 0.75 1]; +%!assert(geocdf (x, 0.5*ones(1,4)), y); +%!assert(geocdf (x, 0.5), y); +%!assert(geocdf (x, 0.5*[-1 NaN 4 1]), [NaN NaN NaN y(4)]); +%!assert(geocdf ([x(1:2) NaN x(4)], 0.5), [y(1:2) NaN y(4)]); + +%% Test class of input preserved +%!assert(geocdf ([x, NaN], 0.5), [y, NaN]); +%!assert(geocdf (single([x, NaN]), 0.5), single([y, NaN])); +%!assert(geocdf ([x, NaN], single(0.5)), single([y, NaN])); + +%% Test input validation +%!error geocdf () +%!error geocdf (1) +%!error geocdf (1,2,3) +%!error geocdf (ones(3),ones(2)) +%!error geocdf (ones(2),ones(3)) +%!error geocdf (i, 2) +%!error geocdf (2, i) +
--- a/scripts/statistics/distributions/geoinv.m +++ b/scripts/statistics/distributions/geoinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,8 +19,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} geoinv (@var{x}, @var{p}) -## For each element of @var{x}, compute the quantile at @var{x} of the -## geometric distribution with parameter @var{p}. +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the geometric distribution with parameter @var{p}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -31,34 +32,54 @@ print_usage (); endif - if (!isscalar (x) && !isscalar (p)) + if (!isscalar (p)) [retval, x, p] = common_size (x, p); if (retval > 0) - error ("geoinv: X and P must be of common size or scalar"); + error ("geoinv: X and P must be of common size or scalars"); endif endif - inv = zeros (size (x)); - - k = find (!(x >= 0) | !(x <= 1) | !(p >= 0) | !(p <= 1)); - if (any (k)) - inv(k) = NaN; + if (iscomplex (x) || iscomplex (p)) + error ("geoinv: X and P must not be complex"); endif - k = find ((x == 1) & (p >= 0) & (p <= 1)); - if (any (k)) - inv(k) = Inf; + if (isa (x, "single") || isa (p, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find ((x > 0) & (x < 1) & (p > 0) & (p <= 1)); - if (any (k)) - if (isscalar (x)) - inv(k) = max (ceil (log (1 - x) ./ log (1 - p(k))) - 1, 0); - elseif (isscalar (p)) - inv(k) = max (ceil (log (1 - x(k)) / log (1 - p)) - 1, 0); - else - inv(k) = max (ceil (log (1 - x(k)) ./ log (1 - p(k))) - 1, 0); - endif + k = (x == 1) & (p >= 0) & (p <= 1); + inv(k) = Inf; + + k = (x >= 0) & (x < 1) & (p > 0) & (p <= 1); + if (isscalar (p)) + inv(k) = max (ceil (log (1 - x(k)) / log (1 - p)) - 1, 0); + else + inv(k) = max (ceil (log (1 - x(k)) ./ log (1 - p(k))) - 1, 0); endif endfunction + + +%!shared x +%! x = [-1 0 0.75 1 2]; +%!assert(geoinv (x, 0.5*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(geoinv (x, 0.5), [NaN 0 1 Inf NaN]); +%!assert(geoinv (x, 0.5*[1 -1 NaN 4 1]), [NaN NaN NaN NaN NaN]); +%!assert(geoinv ([x(1:2) NaN x(4:5)], 0.5), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(geoinv ([x, NaN], 0.5), [NaN 0 1 Inf NaN NaN]); +%!assert(geoinv (single([x, NaN]), 0.5), single([NaN 0 1 Inf NaN NaN])); +%!assert(geoinv ([x, NaN], single(0.5)), single([NaN 0 1 Inf NaN NaN])); + +%% Test input validation +%!error geoinv () +%!error geoinv (1) +%!error geoinv (1,2,3) +%!error geoinv (ones(3),ones(2)) +%!error geoinv (ones(2),ones(3)) +%!error geoinv (i, 2) +%!error geoinv (2, i) +
--- a/scripts/statistics/distributions/geopdf.m +++ b/scripts/statistics/distributions/geopdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -31,35 +32,54 @@ print_usage (); endif - if (!isscalar (x) && !isscalar (p)) + if (!isscalar (p)) [retval, x, p] = common_size (x, p); if (retval > 0) - error ("geopdf: X and P must be of common size or scalar"); + error ("geopdf: X and P must be of common size or scalars"); endif endif - pdf = zeros (size (x)); - - k = find (isnan (x) | !(p >= 0) | !(p <= 1)); - if (any (k)) - pdf(k) = NaN; + if (iscomplex (x) || iscomplex (p)) + error ("geopdf: X and P must not be complex"); endif - ## Just for the fun of it ... - k = find ((x == Inf) & (p == 0)); - if (any (k)) - pdf(k) = 1; + if (isa (x, "single") || isa (p, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); endif - k = find ((x >= 0) & (x < Inf) & (x == round (x)) & (p > 0) & (p <= 1)); - if (any (k)) - if (isscalar (x)) - pdf(k) = p(k) .* ((1 - p(k)) .^ x); - elseif (isscalar (p)) - pdf(k) = p .* ((1 - p) .^ x(k)); - else - pdf(k) = p(k) .* ((1 - p(k)) .^ x(k)); - endif + k = isnan (x) | (x == Inf) | !(p >= 0) | !(p <= 1); + pdf(k) = NaN; + + k = (x >= 0) & (x < Inf) & (x == fix (x)) & (p > 0) & (p <= 1); + if (isscalar (p)) + pdf(k) = p * ((1 - p) .^ x(k)); + else + pdf(k) = p(k) .* ((1 - p(k)) .^ x(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 1 Inf]; +%! y = [0, 1/2, 1/4, NaN]; +%!assert(geopdf (x, 0.5*ones(1,4)), y); +%!assert(geopdf (x, 0.5), y); +%!assert(geopdf (x, 0.5*[-1 NaN 4 1]), [NaN NaN NaN y(4)]); +%!assert(geopdf ([x, NaN], 0.5), [y, NaN]); + +%% Test class of input preserved +%!assert(geopdf (single([x, NaN]), 0.5), single([y, NaN]), 5*eps("single")); +%!assert(geopdf ([x, NaN], single(0.5)), single([y, NaN]), 5*eps("single")); + +%% Test input validation +%!error geopdf () +%!error geopdf (1) +%!error geopdf (1,2,3) +%!error geopdf (ones(3),ones(2)) +%!error geopdf (ones(2),ones(3)) +%!error geopdf (i, 2) +%!error geopdf (2, i) +
--- a/scripts/statistics/distributions/geornd.m +++ b/scripts/statistics/distributions/geornd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,77 +18,108 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} geornd (@var{p}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} geornd (@var{p}, @var{sz}) -## Return an @var{r} by @var{c} matrix of random samples from the -## geometric distribution with parameter @var{p}, which must be a scalar -## or of size @var{r} by @var{c}. +## @deftypefn {Function File} {} geornd (@var{p}) +## @deftypefnx {Function File} {} geornd (@var{p}, @var{r}) +## @deftypefnx {Function File} {} geornd (@var{p}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} geornd (@var{p}, [@var{sz}]) +## Return a matrix of random samples from the geometric distribution with +## parameter @var{p}. ## -## If @var{r} and @var{c} are given create a matrix with @var{r} rows and -## @var{c} columns. Or if @var{sz} is a vector, create a matrix of size -## @var{sz}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{p}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the geometric distribution -function rnd = geornd (p, r, c) - - if (nargin == 3) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("geornd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("geornd: C must be a positive integer"); - endif - sz = [r, c]; +function rnd = geornd (p, varargin) - if (any (size (p) != 1) - && ((length (size (p)) != length (sz)) || any (size (p) != sz))) - error ("geornd: P must be scalar or of size [R, C]"); - endif - elseif (nargin == 2) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("geornd: R must be a positive integer or vector"); - endif - - if (any (size (p) != 1) - && ((length (size (p)) != length (sz)) || any (size (p) != sz))) - error ("geornd: n must be scalar or of size SZ"); - endif - elseif (nargin == 1) - sz = size(n); - elseif (nargin != 1) + if (nargin < 1) print_usage (); endif + if (nargin == 1) + sz = size (p); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("geornd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("geornd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (p) && !isequal (size (p), sz)) + error ("geornd: P must be scalar or of size SZ"); + endif + + if (iscomplex (p)) + error ("geornd: P must not be complex"); + endif + + if (isa (p, "single")) + cls = "single"; + else + cls = "double"; + endif if (isscalar (p)) - if (p < 0 || p > 1) - rnd = NaN (sz); + if (p > 0 && p < 1); + rnd = floor (- rande (sz) ./ log (1 - p)); elseif (p == 0) - rnd = Inf (sz); - elseif (p > 0 && p < 1); - rnd = floor (- rande(sz) ./ log (1 - p)); - else - rnd = zeros (sz); + rnd = Inf (sz, cls); + elseif (p == 1) + rnd = zeros (sz, cls); + elseif (p < 0 || p > 1) + rnd = NaN (sz, cls); endif else - rnd = floor (- rande(sz) ./ log (1 - p)); + rnd = floor (- rande (sz) ./ log (1 - p)); - k = find (!(p >= 0) | !(p <= 1)); - if (any (k)) - rnd(k) = NaN (1, length (k)); - endif + k = !(p >= 0) | !(p <= 1); + rnd(k) = NaN; - k = find (p == 0); - if (any (k)) - rnd(k) = Inf (1, length (k)); - endif + k = (p == 0); + rnd(k) = Inf; endif endfunction + + +%!assert(size (geornd (0.5)), [1, 1]); +%!assert(size (geornd (0.5*ones(2,1))), [2, 1]); +%!assert(size (geornd (0.5*ones(2,2))), [2, 2]); +%!assert(size (geornd (0.5, 3)), [3, 3]); +%!assert(size (geornd (0.5, [4 1])), [4, 1]); +%!assert(size (geornd (0.5, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (geornd (0.5)), "double"); +%!assert(class (geornd (single(0.5))), "single"); +%!assert(class (geornd (single([0.5 0.5]))), "single"); +%!assert(class (geornd (single(0))), "single"); +%!assert(class (geornd (single(1))), "single"); + +%% Test input validation +%!error geornd () +%!error geornd (ones(3),ones(2)) +%!error geornd (ones(2),ones(3)) +%!error geornd (i) +%!error geornd (1, -1) +%!error geornd (1, ones(2)) +%!error geornd (1, [2 -1 2]) +%!error geornd (ones(2,2), 2, 3) +%!error geornd (ones(2,2), 3, 2) +
--- a/scripts/statistics/distributions/hygecdf.m +++ b/scripts/statistics/distributions/hygecdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1997-2011 Kurt Hornik ## ## This file is part of Octave. @@ -25,7 +26,7 @@ ## replacement from a population of total size @var{t} containing ## @var{m} marked items. ## -## The parameters @var{t}, @var{m}, and @var{n} must positive integers +## The parameters @var{t}, @var{m}, and @var{n} must be positive integers ## with @var{m} and @var{n} not greater than @var{t}. ## @end deftypefn @@ -39,14 +40,70 @@ endif if (!isscalar (t) || !isscalar (m) || !isscalar (n)) - error ("hygecdf: T, M and N must all be positive integers"); + [retval, x, t, m, n] = common_size (x, t, m, n); + if (retval > 0) + error ("hygecdf: X, T, M, and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (t) || iscomplex (m) || iscomplex (n)) + error ("hygecdf: X, T, M, and N must not be complex"); endif - if (t < 0 || m < 0 || n <= 0 || t != round (t) || m != round (m) - || n != round (n) || m > t || n > t) + if (isa (x, "single") || isa (t, "single") || isa (m, "single") || isa (n, "single")) + cdf = NaN (size (x), "single"); + else cdf = NaN (size (x)); + endif + + ok = ((t >= 0) & (m >= 0) & (n > 0) & (m <= t) & (n <= t) & + (t == fix (t)) & (m == fix (m)) & (n == fix (n))); + + if (isscalar (t)) + if (ok) + cdf = discrete_cdf (x, 0 : n, hygepdf (0 : n, t, m, n)); + endif else - cdf = discrete_cdf (x, 0 : n, hygepdf (0 : n, t, m, n)); + for i = find (ok(:)') # Must be row vector arg to for loop + v = 0 : n(i); + cdf(i) = discrete_cdf (x(i), v, hygepdf (v, t(i), m(i), n(i))); + endfor endif endfunction + + +%!shared x,y +%! x = [-1 0 1 2 3]; +%! y = [0 1/6 5/6 1 1]; +%!assert(hygecdf (x, 4*ones(1,5), 2, 2), y, eps); +%!assert(hygecdf (x, 4, 2*ones(1,5), 2), y, eps); +%!assert(hygecdf (x, 4, 2, 2*ones(1,5)), y, eps); +%!assert(hygecdf (x, 4*[1 -1 NaN 1.1 1], 2, 2), [y(1) NaN NaN NaN y(5)], eps); +%!assert(hygecdf (x, 4, 2*[1 -1 NaN 1.1 1], 2), [y(1) NaN NaN NaN y(5)], eps); +%!assert(hygecdf (x, 4, 5, 2), [NaN NaN NaN NaN NaN]); +%!assert(hygecdf (x, 4, 2, 2*[1 -1 NaN 1.1 1]), [y(1) NaN NaN NaN y(5)], eps); +%!assert(hygecdf (x, 4, 2, 5), [NaN NaN NaN NaN NaN]); +%!assert(hygecdf ([x(1:2) NaN x(4:5)], 4, 2, 2), [y(1:2) NaN y(4:5)], eps); + +%% Test class of input preserved +%!assert(hygecdf ([x, NaN], 4, 2, 2), [y, NaN], eps); +%!assert(hygecdf (single([x, NaN]), 4, 2, 2), single([y, NaN]), eps("single")); +%!assert(hygecdf ([x, NaN], single(4), 2, 2), single([y, NaN]), eps("single")); +%!assert(hygecdf ([x, NaN], 4, single(2), 2), single([y, NaN]), eps("single")); +%!assert(hygecdf ([x, NaN], 4, 2, single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error hygecdf () +%!error hygecdf (1) +%!error hygecdf (1,2) +%!error hygecdf (1,2,3) +%!error hygecdf (1,2,3,4,5) +%!error hygecdf (ones(2), ones(3), 1, 1) +%!error hygecdf (1, ones(2), ones(3), 1) +%!error hygecdf (1, 1, ones(2), ones(3)) +%!error hygecdf (i, 2, 2, 2) +%!error hygecdf (2, i, 2, 2) +%!error hygecdf (2, 2, i, 2) +%!error hygecdf (2, 2, 2, i) +
--- a/scripts/statistics/distributions/hygeinv.m +++ b/scripts/statistics/distributions/hygeinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1997-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,11 +19,14 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} hygeinv (@var{x}, @var{t}, @var{m}, @var{n}) -## For each element of @var{x}, compute the quantile at @var{x} of the -## hypergeometric distribution with parameters @var{t}, @var{m}, and -## @var{n}. +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the hypergeometric distribution with parameters +## @var{t}, @var{m}, and @var{n}. This is the probability of obtaining @var{x} +## marked items when randomly drawing a sample of size @var{n} without +## replacement from a population of total size @var{t} containing @var{m} +## marked items. ## -## The parameters @var{t}, @var{m}, and @var{n} must positive integers +## The parameters @var{t}, @var{m}, and @var{n} must be positive integers ## with @var{m} and @var{n} not greater than @var{t}. ## @end deftypefn @@ -36,14 +40,75 @@ endif if (!isscalar (t) || !isscalar (m) || !isscalar (n)) - error ("hygeinv: T, M and N must all be positive integers"); + [retval, x, t, m, n] = common_size (x, t, m, n); + if (retval > 0) + error ("hygeinv: X, T, M, and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (t) || iscomplex (m) || iscomplex (n)) + error ("hygeinv: X, T, M, and N must not be complex"); + endif + + if (isa (x, "single") || isa (t, "single") || isa (m, "single") || isa (n, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - if (t < 0 || m < 0 || n <= 0 || t != round (t) || m != round (m) - || n != round (n) || m > t || n > t) - inv = NaN (size (x)); + ok = ((t >= 0) & (m >= 0) & (n > 0) & (m <= t) & (n <= t) & + (t == fix (t)) & (m == fix (m)) & (n == fix (n))); + + if (isscalar (t)) + if (ok) + inv = discrete_inv (x, 0 : n, hygepdf (0 : n, t, m, n)); + inv(x == 0) = 0; # Hack to return correct value for start of distribution + endif else - inv = discrete_inv (x, 0 : n, hygepdf (0 : n, t, m, n)); + for i = find (ok(:)') # Must be row vector arg to for loop + v = 0 : n(i); + if (x(i) == 0) + inv(i) = 0; # Hack to return correct value for start of distribution + else + inv(i) = discrete_inv (x(i), v, hygepdf (v, t(i), m(i), n(i))); + endif + endfor endif endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(hygeinv (x, 4*ones(1,5), 2*ones(1,5), 2*ones(1,5)), [NaN 0 1 2 NaN]); +%!assert(hygeinv (x, 4*ones(1,5), 2, 2), [NaN 0 1 2 NaN]); +%!assert(hygeinv (x, 4, 2*ones(1,5), 2), [NaN 0 1 2 NaN]); +%!assert(hygeinv (x, 4, 2, 2*ones(1,5)), [NaN 0 1 2 NaN]); +%!assert(hygeinv (x, 4*[1 -1 NaN 1.1 1], 2, 2), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv (x, 4, 2*[1 -1 NaN 1.1 1], 2), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv (x, 4, 5, 2), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv (x, 4, 2, 2*[1 -1 NaN 1.1 1]), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv (x, 4, 2, 5), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv ([x(1:2) NaN x(4:5)], 4, 2, 2), [NaN 0 NaN 2 NaN]); + +%% Test class of input preserved +%!assert(hygeinv ([x, NaN], 4, 2, 2), [NaN 0 1 2 NaN NaN]); +%!assert(hygeinv (single([x, NaN]), 4, 2, 2), single([NaN 0 1 2 NaN NaN])); +%!assert(hygeinv ([x, NaN], single(4), 2, 2), single([NaN 0 1 2 NaN NaN])); +%!assert(hygeinv ([x, NaN], 4, single(2), 2), single([NaN 0 1 2 NaN NaN])); +%!assert(hygeinv ([x, NaN], 4, 2, single(2)), single([NaN 0 1 2 NaN NaN])); + +%% Test input validation +%!error hygeinv () +%!error hygeinv (1) +%!error hygeinv (1,2) +%!error hygeinv (1,2,3) +%!error hygeinv (1,2,3,4,5) +%!error hygeinv (ones(2), ones(3), 1, 1) +%!error hygeinv (1, ones(2), ones(3), 1) +%!error hygeinv (1, 1, ones(2), ones(3)) +%!error hygeinv (i, 2, 2, 2) +%!error hygeinv (2, i, 2, 2) +%!error hygeinv (2, 2, i, 2) +%!error hygeinv (2, 2, 2, i) +
--- a/scripts/statistics/distributions/hygepdf.m +++ b/scripts/statistics/distributions/hygepdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -24,7 +25,8 @@ ## when randomly drawing a sample of size @var{n} without replacement ## from a population of total size @var{t} containing @var{m} marked items. ## -## The arguments must be of common size or scalar. +## The parameters @var{t}, @var{m}, and @var{n} must be positive integers +## with @var{m} and @var{n} not greater than @var{t}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -39,34 +41,72 @@ if (!isscalar (t) || !isscalar (m) || !isscalar (n)) [retval, x, t, m, n] = common_size (x, t, m, n); if (retval > 0) - error ("hygepdf: X, T, M, and N must be of common size or scalar"); + error ("hygepdf: X, T, M, and N must be of common size or scalars"); endif endif - pdf = zeros (size (x)); + if (iscomplex (x) || iscomplex (t) || iscomplex (m) || iscomplex (n)) + error ("hygepdf: X, T, M, and N must not be complex"); + endif + + if (isa (x, "single") || isa (t, "single") || isa (m, "single") || isa (n, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif - ## everything in i1 gives NaN - i1 = ((t < 0) | (m < 0) | (n <= 0) | (t != round (t)) | - (m != round (m)) | (n != round (n)) | (m > t) | (n > t)); - ## everything in i2 gives 0 unless in i1 - i2 = ((x != round (x)) | (x < 0) | (x > m) | (n < x) | (n-x > t-m)); - k = find (i1); - if (any (k)) + ## everything in nel gives NaN + nel = (isnan (x) | (t < 0) | (m < 0) | (n <= 0) | (m > t) | (n > t) | + (t != fix (t)) | (m != fix (m)) | (n != fix (n))); + ## everything in zel gives 0 unless in nel + zel = ((x != fix (x)) | (x < 0) | (x > m) | (n < x) | (n-x > t-m)); + + pdf(nel) = NaN; + + k = !nel & !zel; + if (any (k(:))) if (isscalar (t) && isscalar (m) && isscalar (n)) - pdf = NaN (size (x)); + pdf(k) = (bincoeff (m, x(k)) .* bincoeff (t-m, n-x(k)) + / bincoeff (t, n)); else - pdf (k) = NaN; - endif - endif - k = find (!i1 & !i2); - if (any (k)) - if (isscalar (t) && isscalar (m) && isscalar (n)) - pdf (k) = (bincoeff (m, x(k)) .* bincoeff (t-m, n-x(k)) - / bincoeff (t, n)); - else - pdf (k) = (bincoeff (m(k), x(k)) .* bincoeff (t(k)-m(k), n(k)-x(k)) - ./ bincoeff (t(k), n(k))); + pdf(k) = (bincoeff (m(k), x(k)) .* bincoeff (t(k)-m(k), n(k)-x(k)) + ./ bincoeff (t(k), n(k))); endif endif endfunction + + +%!shared x,y +%! x = [-1 0 1 2 3]; +%! y = [0 1/6 4/6 1/6 0]; +%!assert(hygepdf (x, 4*ones(1,5), 2, 2), y); +%!assert(hygepdf (x, 4, 2*ones(1,5), 2), y); +%!assert(hygepdf (x, 4, 2, 2*ones(1,5)), y); +%!assert(hygepdf (x, 4*[1 -1 NaN 1.1 1], 2, 2), [0 NaN NaN NaN 0]); +%!assert(hygepdf (x, 4, 2*[1 -1 NaN 1.1 1], 2), [0 NaN NaN NaN 0]); +%!assert(hygepdf (x, 4, 5, 2), [NaN NaN NaN NaN NaN]); +%!assert(hygepdf (x, 4, 2, 2*[1 -1 NaN 1.1 1]), [0 NaN NaN NaN 0]); +%!assert(hygepdf (x, 4, 2, 5), [NaN NaN NaN NaN NaN]); +%!assert(hygepdf ([x, NaN], 4, 2, 2), [y, NaN], eps); + +%% Test class of input preserved +%!assert(hygepdf (single([x, NaN]), 4, 2, 2), single([y, NaN])); +%!assert(hygepdf ([x, NaN], single(4), 2, 2), single([y, NaN])); +%!assert(hygepdf ([x, NaN], 4, single(2), 2), single([y, NaN])); +%!assert(hygepdf ([x, NaN], 4, 2, single(2)), single([y, NaN])); + +%% Test input validation +%!error hygepdf () +%!error hygepdf (1) +%!error hygepdf (1,2) +%!error hygepdf (1,2,3) +%!error hygepdf (1,2,3,4,5) +%!error hygepdf (1, ones(3),ones(2),ones(2)) +%!error hygepdf (1, ones(2),ones(3),ones(2)) +%!error hygepdf (1, ones(2),ones(2),ones(3)) +%!error hygepdf (i, 2, 2, 2) +%!error hygepdf (2, i, 2, 2) +%!error hygepdf (2, 2, i, 2) +%!error hygepdf (2, 2, 2, i) +
--- a/scripts/statistics/distributions/hygernd.m +++ b/scripts/statistics/distributions/hygernd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1997-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,81 +18,131 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} hygernd (@var{t}, @var{m}, @var{n}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} hygernd (@var{t}, @var{m}, @var{n}, @var{sz}) -## @deftypefnx {Function File} {} hygernd (@var{t}, @var{m}, @var{n}) -## Return an @var{r} by @var{c} matrix of random samples from the -## hypergeometric distribution with parameters @var{t}, @var{m}, -## and @var{n}. +## @deftypefn {Function File} {} hygernd (@var{t}, @var{m}, @var{n}) +## @deftypefnx {Function File} {} hygernd (@var{t}, @var{m}, @var{n}, @var{r}) +## @deftypefnx {Function File} {} hygernd (@var{t}, @var{m}, @var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} hygernd (@var{t}, @var{m}, @var{n}, [@var{sz}]) +## Return a matrix of random samples from the hypergeometric distribution +## with parameters @var{t}, @var{m}, and @var{n}. ## -## The parameters @var{t}, @var{m}, and @var{n} must positive integers +## The parameters @var{t}, @var{m}, and @var{n} must be positive integers ## with @var{m} and @var{n} not greater than @var{t}. ## -## The parameter @var{sz} must be scalar or a vector of matrix -## dimensions. If @var{sz} is scalar, then a @var{sz} by @var{sz} -## matrix of random samples is generated. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{t}, @var{m}, and @var{n}. ## @end deftypefn -function rnd = hygernd (t, m, n, r, c) +function rnd = hygernd (t, m, n, varargin) - if (nargin == 5) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("hygernd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("hygernd: C must be a positive integer"); - endif - sz = [r, c]; - elseif (nargin == 4) - if (isvector (r) && all (r > 0) && all (r == round (r))) - if (isscalar (r)) - sz = [r, r]; - else - sz = r(:)'; - endif - else - error ("hygernd: R must be a vector of positive integers"); - endif - elseif (nargin != 3) + if (nargin < 3) print_usage (); endif if (! isscalar (t) || ! isscalar (m) || ! isscalar (n)) [retval, t, m, n] = common_size (t, m, n); if (retval > 0) - error ("hygernd: T, M and N must be of common size or scalar"); + error ("hygernd: T, M, and N must be of common size or scalars"); + endif + endif + + if (iscomplex (t) || iscomplex (m) || iscomplex (n)) + error ("hygernd: T, M, and N must not be complex"); + endif + + if (nargin == 3) + sz = size (t); + elseif (nargin == 4) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("hygernd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 4) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("hygernd: dimensions must be non-negative integers"); endif - if (nargin > 3) - if (any (sz != size (t))) - error ("hygernd: T, M and N must have the same size as implied by R and C or must be scalar"); + sz = [varargin{:}]; + endif + + if (!isscalar (t) && !isequal (size (t), sz)) + error ("hygernd: T, M, and N must be scalar or of size SZ"); + endif + + if (isa (t, "single") || isa (m, "single") || isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif + + ok = ((t >= 0) & (m >= 0) & (n > 0) & (m <= t) & (n <= t) & + (t == fix (t)) & (m == fix (m)) & (n == fix (n))); + + if (isscalar (t)) + if (ok) + v = 0:n; + p = hygepdf (v, t, m, n); + rnd = v(lookup (cumsum (p(1:end-1)) / sum (p), rand (sz)) + 1); + rnd = reshape (rnd, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); endif else - sz = size (t); + rnd = NaN (sz, cls); endif - elseif (nargin == 3) - sz = 1; - endif - - ## NaN elements - ne = (! (t >= 0) | ! (m >= 0) | ! (n > 0) | ! (t == round (t)) | ! (m == round (m)) | ! (n == round (n)) | ! (m <= t) | ! (n <= t)); - - if (! isscalar (t)) - rnd = zeros (sz); - rnd(ne) = NaN; + else + rnd = NaN (sz, cls); rn = rand (sz); - for i = find (! ne) + for i = find (ok(:)') # Must be row vector arg to for loop v = 0 : n(i); p = hygepdf (v, t(i), m(i), n(i)); rnd(i) = v(lookup (cumsum (p(1 : end-1)) / sum (p), rn(i)) + 1); endfor - else - if (ne) - rnd = NaN (sz); - else - v = 0:n; - p = hygepdf (v, t, m, n); - rnd = v(lookup (cumsum (p(1:end-1)) / sum (p), rand (sz)) + 1); - endif endif endfunction + + +%!assert(size (hygernd (4,2,2)), [1, 1]); +%!assert(size (hygernd (4*ones(2,1), 2,2)), [2, 1]); +%!assert(size (hygernd (4*ones(2,2), 2,2)), [2, 2]); +%!assert(size (hygernd (4, 2*ones(2,1), 2)), [2, 1]); +%!assert(size (hygernd (4, 2*ones(2,2), 2)), [2, 2]); +%!assert(size (hygernd (4, 2, 2*ones(2,1))), [2, 1]); +%!assert(size (hygernd (4, 2, 2*ones(2,2))), [2, 2]); +%!assert(size (hygernd (4, 2, 2, 3)), [3, 3]); +%!assert(size (hygernd (4, 2, 2, [4 1])), [4, 1]); +%!assert(size (hygernd (4, 2, 2, 4, 1)), [4, 1]); + +%!assert(class (hygernd (4,2,2)), "double"); +%!assert(class (hygernd (single(4),2,2)), "single"); +%!assert(class (hygernd (single([4 4]),2,2)), "single"); +%!assert(class (hygernd (4,single(2),2)), "single"); +%!assert(class (hygernd (4,single([2 2]),2)), "single"); +%!assert(class (hygernd (4,2,single(2))), "single"); +%!assert(class (hygernd (4,2,single([2 2]))), "single"); + +%% Test input validation +%!error hygernd () +%!error hygernd (1) +%!error hygernd (1,2) +%!error hygernd (ones(3),ones(2),ones(2), 2) +%!error hygernd (ones(2),ones(3),ones(2), 2) +%!error hygernd (ones(2),ones(2),ones(3), 2) +%!error hygernd (i, 2, 2) +%!error hygernd (2, i, 2) +%!error hygernd (2, 2, i) +%!error hygernd (4,2,2, -1) +%!error hygernd (4,2,2, ones(2)) +%!error hygernd (4,2,2, [2 -1 2]) +%!error hygernd (4*ones(2),2,2, 3) +%!error hygernd (4*ones(2),2,2, [3, 2]) +%!error hygernd (4*ones(2),2,2, 3, 2) +
--- a/scripts/statistics/distributions/kolmogorov_smirnov_cdf.m +++ b/scripts/statistics/distributions/kolmogorov_smirnov_cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,16 +19,17 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} kolmogorov_smirnov_cdf (@var{x}, @var{tol}) -## Return the CDF at @var{x} of the Kolmogorov-Smirnov distribution, +## Return the cumulative distribution function (CDF) at @var{x} of the +## Kolmogorov-Smirnov distribution, ## @tex -## $$ Q(x) = \sum_{k=-\infty}^\infty (-1)^k \exp(-2 k^2 x^2) $$ +## $$ Q(x) = \sum_{k=-\infty}^\infty (-1)^k \exp (-2 k^2 x^2) $$ ## @end tex ## @ifnottex ## ## @example ## @group ## Inf -## Q(x) = SUM (-1)^k exp(-2 k^2 x^2) +## Q(x) = SUM (-1)^k exp (-2 k^2 x^2) ## k = -Inf ## @end group ## @end example @@ -61,8 +63,7 @@ endif endif - n = numel (x); - if (n == 0) + if (numel (x) == 0) error ("kolmogorov_smirnov_cdf: X must not be empty"); endif @@ -70,10 +71,10 @@ ind = find (x > 0); if (length (ind) > 0) - if (size(ind,2) < size(ind,1)) + if (columns (ind) < rows (ind)) y = x(ind.'); else - y = x(ind); + y = x(ind); endif K = ceil (sqrt (- log (tol) / 2) / min (y)); k = (1:K)'; @@ -84,3 +85,11 @@ endif endfunction + + +%% Test input validation +%!error kolmogorov_smirnov_cdf () +%!error kolmogorov_smirnov_cdf (1,2,3) +%!error kolmogorov_smirnov_cdf (1, ones(2)) +%!error kolmogorov_smirnov_cdf ([], 1) +
--- a/scripts/statistics/distributions/laplace_cdf.m +++ b/scripts/statistics/distributions/laplace_cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -31,21 +32,25 @@ print_usage (); endif - cdf = zeros (size (x)); - - k = find (isnan (x)); - if (any (k)) - cdf(k) = NaN; + if (iscomplex (x)) + error ("laplace_cdf: X must not be complex"); endif - k = find (x == Inf); - if (any (k)) - cdf(k) = 1; - endif - - k = find ((x > -Inf) & (x < Inf)); - if (any (k)) - cdf(k) = (1 + sign (x(k)) .* (1 - exp (- abs (x(k))))) / 2; - endif + cdf = (1 + sign (x) .* (1 - exp (- abs (x)))) / 2; endfunction + + +%!shared x,y +%! x = [-Inf -log(2) 0 log(2) Inf]; +%! y = [0, 1/4, 1/2, 3/4, 1]; +%!assert(laplace_cdf ([x, NaN]), [y, NaN]); + +%% Test class of input preserved +%!assert(laplace_cdf (single([x, NaN])), single([y, NaN])); + +%% Test input validation +%!error laplace_cdf () +%!error laplace_cdf (1,2) +%!error laplace_cdf (i) +
--- a/scripts/statistics/distributions/laplace_inv.m +++ b/scripts/statistics/distributions/laplace_inv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -31,22 +32,33 @@ print_usage (); endif - inv = -Inf (size (x)); + if (iscomplex (x)) + error ("laplace_inv: X must not be complex"); + endif - k = find (isnan (x) | (x < 0) | (x > 1)); - if (any (k)) - inv(k) = NaN; + if (isa (x, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find (x == 1); - if (any (k)) - inv(k) = Inf; - endif - - k = find ((x > 0) & (x < 1)); - if (any (k)) - inv(k) = ((x(k) < 1/2) .* log (2 * x(k)) - - (x(k) > 1/2) .* log (2 * (1 - x(k)))); - endif + k = (x >= 0) & (x <= 1); + inv(k) = ((x(k) < 1/2) .* log (2 * x(k)) + - (x(k) > 1/2) .* log (2 * (1 - x(k)))); endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(laplace_inv (x), [NaN -Inf 0 Inf NaN]); + +%% Test class of input preserved +%!assert(laplace_inv ([x, NaN]), [NaN -Inf 0 Inf NaN NaN]); +%!assert(laplace_inv (single([x, NaN])), single([NaN -Inf 0 Inf NaN NaN])); + +%% Test input validation +%!error laplace_inv () +%!error laplace_inv (1,2) +%!error laplace_inv (i) +
--- a/scripts/statistics/distributions/laplace_pdf.m +++ b/scripts/statistics/distributions/laplace_pdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -30,17 +31,26 @@ if (nargin != 1) print_usage (); endif - - pdf = zeros (size (x)); - - k = find (isnan (x)); - if (any (k)) - pdf(k) = NaN; + + if (iscomplex (x)) + error ("laplace_pdf: X must not be complex"); endif - k = find ((x > -Inf) & (x < Inf)); - if (any (k)) - pdf(k) = exp (- abs (x(k))) / 2; - endif + pdf = exp (- abs (x)) / 2; endfunction + + +%!shared x,y +%! x = [-Inf -log(2) 0 log(2) Inf]; +%! y = [0, 1/4, 1/2, 1/4, 0]; +%!assert(laplace_pdf ([x, NaN]), [y, NaN]); + +%% Test class of input preserved +%!assert(laplace_pdf (single([x, NaN])), single([y, NaN])); + +%% Test input validation +%!error laplace_pdf () +%!error laplace_pdf (1,2) +%!error laplace_pdf (i) +
--- a/scripts/statistics/distributions/laplace_rnd.m +++ b/scripts/statistics/distributions/laplace_rnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,40 +18,57 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} laplace_rnd (@var{r}, @var{c}) -## @deftypefnx {Function File} {} laplace_rnd (@var{sz}); -## Return an @var{r} by @var{c} matrix of random numbers from the -## Laplace distribution. Or if @var{sz} is a vector, create a matrix of -## @var{sz}. +## @deftypefn {Function File} {} laplace_rnd (@var{r}) +## @deftypefnx {Function File} {} laplace_rnd (@var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} laplace_rnd ([@var{sz}]) +## Return a matrix of random samples from the Laplace distribution. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the Laplace distribution -function rnd = laplace_rnd (r, c) +function rnd = laplace_rnd (varargin) - if (nargin == 2) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("laplace_rnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("laplace_rnd: C must be a positive integer"); - endif - sz = [r, c]; - elseif (nargin == 1) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("laplace_rnd: R must be a positive integer or vector"); - endif - else + if (nargin < 1) print_usage (); endif + if (nargin == 1) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}(:)'; + else + error ("laplace_rnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 1) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("laplace_rnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + tmp = rand (sz); - rnd = ((tmp < 1/2) .* log (2 * tmp) - - (tmp > 1/2) .* log (2 * (1 - tmp))); + rnd = (tmp < 1/2) .* log (2 * tmp) - (tmp > 1/2) .* log (2 * (1 - tmp)); endfunction + + +%!assert(size (laplace_rnd (3)), [3, 3]); +%!assert(size (laplace_rnd ([4 1])), [4, 1]); +%!assert(size (laplace_rnd (4,1)), [4, 1]); + +%% Test input validation +%!error laplace_rnd () +%!error laplace_rnd (-1) +%!error laplace_rnd (ones(2)) +%!error laplace_rnd ([2 -1 2]) +%!error laplace_rnd (1, ones(2)) +%!error laplace_rnd (1, -1) +
--- a/scripts/statistics/distributions/logistic_cdf.m +++ b/scripts/statistics/distributions/logistic_cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,8 +19,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} logistic_cdf (@var{x}) -## For each component of @var{x}, compute the CDF at @var{x} of the -## logistic distribution. +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the logistic distribution. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -31,6 +32,25 @@ print_usage (); endif - cdf = 1 ./ (1 + exp (- x)); + if (iscomplex (x)) + error ("logistic_cdf: X must not be complex"); + endif + + cdf = 1 ./ (1 + exp (-x)); endfunction + + +%!shared x,y +%! x = [-Inf -log(3) 0 log(3) Inf]; +%! y = [0, 1/4, 1/2, 3/4, 1]; +%!assert(logistic_cdf ([x, NaN]), [y, NaN], eps); + +%% Test class of input preserved +%!assert(logistic_cdf (single([x, NaN])), single([y, NaN]), eps ("single")); + +%% Test input validation +%!error logistic_cdf () +%!error logistic_cdf (1,2) +%!error logistic_cdf (i) +
--- a/scripts/statistics/distributions/logistic_inv.m +++ b/scripts/statistics/distributions/logistic_inv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} logistic_inv (@var{x}) -## For each component of @var{x}, compute the quantile (the inverse of +## For each element of @var{x}, compute the quantile (the inverse of ## the CDF) at @var{x} of the logistic distribution. ## @end deftypefn @@ -31,26 +32,38 @@ print_usage (); endif - inv = zeros (size (x)); - - k = find ((x < 0) | (x > 1) | isnan (x)); - if (any (k)) - inv(k) = NaN; + if (iscomplex (x)) + error ("logistic_inv: X must not be complex"); endif - k = find (x == 0); - if (any (k)) - inv(k) = -Inf; + if (isa (x, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find (x == 1); - if (any (k)) - inv(k) = Inf; - endif + k = (x == 0); + inv(k) = -Inf; - k = find ((x > 0) & (x < 1)); - if (any (k)) - inv (k) = - log (1 ./ x(k) - 1); - endif + k = (x == 1); + inv(k) = Inf; + + k = (x > 0) & (x < 1); + inv(k) = - log (1 ./ x(k) - 1); endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(logistic_inv (x), [NaN -Inf 0 Inf NaN]); + +%% Test class of input preserved +%!assert(logistic_inv ([x, NaN]), [NaN -Inf 0 Inf NaN NaN]); +%!assert(logistic_inv (single([x, NaN])), single([NaN -Inf 0 Inf NaN NaN])); + +%% Test input validation +%!error logistic_inv () +%!error logistic_inv (1,2) +%!error logistic_inv (i) +
--- a/scripts/statistics/distributions/logistic_pdf.m +++ b/scripts/statistics/distributions/logistic_pdf.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} logistic_pdf (@var{x}) -## For each component of @var{x}, compute the PDF at @var{x} of the +## For each element of @var{x}, compute the PDF at @var{x} of the ## logistic distribution. ## @end deftypefn @@ -31,7 +31,26 @@ print_usage (); endif + if (iscomplex (x)) + error ("logistic_pdf: X must not be complex"); + endif + cdf = logistic_cdf (x); pdf = cdf .* (1 - cdf); endfunction + + +%!shared x,y +%! x = [-Inf -log(4) 0 log(4) Inf]; +%! y = [0, 0.16, 1/4, 0.16, 0]; +%!assert(logistic_pdf ([x, NaN]), [y, NaN], eps); + +%% Test class of input preserved +%!assert(logistic_pdf (single([x, NaN])), single([y, NaN]), eps ("single")); + +%% Test input validation +%!error logistic_pdf () +%!error logistic_pdf (1,2) +%!error logistic_pdf (i) +
--- a/scripts/statistics/distributions/logistic_rnd.m +++ b/scripts/statistics/distributions/logistic_rnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,39 +18,56 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} logistic_rnd (@var{r}, @var{c}) -## @deftypefnx {Function File} {} logistic_rnd (@var{sz}) -## Return an @var{r} by @var{c} matrix of random numbers from the -## logistic distribution. Or if @var{sz} is a vector, create a matrix of -## @var{sz}. +## @deftypefn {Function File} {} logistic_rnd (@var{r}) +## @deftypefnx {Function File} {} logistic_rnd (@var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} logistic_rnd ([@var{sz}]) +## Return a matrix of random samples from the logistic distribution. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the logistic distribution -function rnd = logistic_rnd (r, c) +function rnd = logistic_rnd (varargin) + if (nargin < 1) + print_usage (); + endif - if (nargin == 2) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("logistic_rnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("logistic_rnd: C must be a positive integer"); + if (nargin == 1) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("logistic_rnd: dimension vector must be row vector of non-negative integers"); endif - sz = [r, c]; - elseif (nargin == 1) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("logistic_rnd: R must be a positive integer or vector"); + elseif (nargin > 1) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("logistic_rnd: dimensions must be non-negative integers"); endif - else - print_usage (); + sz = [varargin{:}]; endif rnd = - log (1 ./ rand (sz) - 1); endfunction + + +%!assert(size (logistic_rnd (3)), [3, 3]); +%!assert(size (logistic_rnd ([4 1])), [4, 1]); +%!assert(size (logistic_rnd (4,1)), [4, 1]); + +%% Test input validation +%!error logistic_rnd () +%!error logistic_rnd (-1) +%!error logistic_rnd (ones(2)) +%!error logistic_rnd ([2 -1 2]) +%!error logistic_rnd (1, ones(2)) +%!error logistic_rnd (1, -1) +
--- a/scripts/statistics/distributions/logncdf.m +++ b/scripts/statistics/distributions/logncdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} logncdf (@var{x}, @var{mu}, @var{sigma}) +## @deftypefn {Function File} {} logncdf (@var{x}) +## @deftypefnx {Function File} {} logncdf (@var{x}, @var{mu}, @var{sigma}) ## For each element of @var{x}, compute the cumulative distribution ## function (CDF) at @var{x} of the lognormal distribution with ## parameters @var{mu} and @var{sigma}. If a random variable follows this @@ -30,48 +32,69 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: CDF of the log normal distribution -function cdf = logncdf (x, mu, sigma) +function cdf = logncdf (x, mu = 0, sigma = 1) - if (! ((nargin == 1) || (nargin == 3))) + if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - mu = 0; - sigma = 1; - endif - - ## The following "straightforward" implementation unfortunately does - ## not work (because exp (Inf) -> NaN etc): - ## cdf = normal_cdf (log (x), log (mu), sigma); - ## Hence ... - if (!isscalar (mu) || !isscalar (sigma)) [retval, x, mu, sigma] = common_size (x, mu, sigma); if (retval > 0) - error ("logncdf: X, MU and SIGMA must be of common size or scalars"); + error ("logncdf: X, MU, and SIGMA must be of common size or scalars"); endif endif - cdf = zeros (size (x)); + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("logncdf: X, MU, and SIGMA must not be complex"); + endif - k = find (isnan (x) | !(sigma > 0) | !(sigma < Inf)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x == Inf) & (sigma > 0) & (sigma < Inf)); - if (any (k)) - cdf(k) = 1; - endif + k = isnan (x) | !(sigma > 0) | !(sigma < Inf); + cdf(k) = NaN; + + k = (x == Inf) & (sigma > 0) & (sigma < Inf); + cdf(k) = 1; - k = find ((x > 0) & (x < Inf) & (sigma > 0) & (sigma < Inf)); - if (any (k)) - if (isscalar (mu) && isscalar (sigma)) - cdf(k) = stdnormal_cdf ((log (x(k)) - mu) / sigma); - else - cdf(k) = stdnormal_cdf ((log (x(k)) - mu(k)) ./ sigma(k)); - endif + k = (x > 0) & (x < Inf) & (sigma > 0) & (sigma < Inf); + if (isscalar (mu) && isscalar (sigma)) + cdf(k) = stdnormal_cdf ((log (x(k)) - mu) / sigma); + else + cdf(k) = stdnormal_cdf ((log (x(k)) - mu(k)) ./ sigma(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 1 e Inf]; +%! y = [0, 0, 0.5, 1/2+1/2*erf(1/2), 1]; +%!assert(logncdf (x, zeros(1,5), sqrt(2)*ones(1,5)), y); +%!assert(logncdf (x, 0, sqrt(2)*ones(1,5)), y); +%!assert(logncdf (x, zeros(1,5), sqrt(2)), y); +%!assert(logncdf (x, [0 1 NaN 0 1], sqrt(2)), [0 0 NaN y(4:5)]); +%!assert(logncdf (x, 0, sqrt(2)*[0 NaN Inf 1 1]), [NaN NaN NaN y(4:5)]); +%!assert(logncdf ([x(1:3) NaN x(5)], 0, sqrt(2)), [y(1:3) NaN y(5)]); + +%% Test class of input preserved +%!assert(logncdf ([x, NaN], 0, sqrt(2)), [y, NaN]); +%!assert(logncdf (single([x, NaN]), 0, sqrt(2)), single([y, NaN]), eps("single")); +%!assert(logncdf ([x, NaN], single(0), sqrt(2)), single([y, NaN]), eps("single")); +%!assert(logncdf ([x, NaN], 0, single(sqrt(2))), single([y, NaN]), eps("single")); + +%% Test input validation +%!error logncdf () +%!error logncdf (1,2) +%!error logncdf (1,2,3,4) +%!error logncdf (ones(3),ones(2),ones(2)) +%!error logncdf (ones(2),ones(3),ones(2)) +%!error logncdf (ones(2),ones(2),ones(3)) +%!error logncdf (i, 2, 2) +%!error logncdf (2, i, 2) +%!error logncdf (2, 2, i) +
--- a/scripts/statistics/distributions/logninv.m +++ b/scripts/statistics/distributions/logninv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} logninv (@var{x}, @var{mu}, @var{sigma}) +## @deftypefn {Function File} {} logninv (@var{x}) +## @deftypefnx {Function File} {} logninv (@var{x}, @var{mu}, @var{sigma}) ## For each element of @var{x}, compute the quantile (the inverse of the ## CDF) at @var{x} of the lognormal distribution with parameters @var{mu} ## and @var{sigma}. If a random variable follows this distribution, its @@ -30,48 +32,68 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Quantile function of the log normal distribution -function inv = logninv (x, mu, sigma) +function inv = logninv (x, mu = 0, sigma = 1) - if (! ((nargin == 1) || (nargin == 3))) + if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - mu = 0; - sigma = 1; - endif - - ## The following "straightforward" implementation unfortunately does - ## not work (because exp (Inf) -> NaN): - ## inv = exp (norminv (x, mu, sigma)); - ## Hence ... - if (!isscalar (mu) || !isscalar (sigma)) [retval, x, mu, sigma] = common_size (x, mu, sigma); if (retval > 0) - error ("logninv: X, MU and SIGMA must be of common size or scalars"); + error ("logninv: X, MU, and SIGMA must be of common size or scalars"); endif endif - inv = zeros (size (x)); + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("logninv: X, MU, and SIGMA must not be complex"); + endif - k = find (!(x >= 0) | !(x <= 1) | !(sigma > 0) | !(sigma < Inf)); - if (any (k)) - inv(k) = NaN; + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find ((x == 1) & (sigma > 0) & (sigma < Inf)); - if (any (k)) - inv(k) = Inf; - endif + k = !(x >= 0) | !(x <= 1) | !(sigma > 0) | !(sigma < Inf); + inv(k) = NaN; + + k = (x == 1) & (sigma > 0) & (sigma < Inf); + inv(k) = Inf; - k = find ((x > 0) & (x < 1) & (sigma > 0) & (sigma < Inf)); - if (any (k)) - if (isscalar (mu) && isscalar (sigma)) - inv(k) = exp (mu) .* exp (sigma .* stdnormal_inv (x(k))); - else - inv(k) = exp (mu(k)) .* exp (sigma(k) .* stdnormal_inv (x(k))); - endif + k = (x >= 0) & (x < 1) & (sigma > 0) & (sigma < Inf); + if (isscalar (mu) && isscalar (sigma)) + inv(k) = exp (mu) .* exp (sigma .* stdnormal_inv (x(k))); + else + inv(k) = exp (mu(k)) .* exp (sigma(k) .* stdnormal_inv (x(k))); endif endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(logninv (x, ones(1,5), ones(1,5)), [NaN 0 e Inf NaN]); +%!assert(logninv (x, 1, ones(1,5)), [NaN 0 e Inf NaN]); +%!assert(logninv (x, ones(1,5), 1), [NaN 0 e Inf NaN]); +%!assert(logninv (x, [1 1 NaN 0 1], 1), [NaN 0 NaN Inf NaN]); +%!assert(logninv (x, 1, [1 0 NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(logninv ([x(1:2) NaN x(4:5)], 1, 2), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(logninv ([x, NaN], 1, 1), [NaN 0 e Inf NaN NaN]); +%!assert(logninv (single([x, NaN]), 1, 1), single([NaN 0 e Inf NaN NaN])); +%!assert(logninv ([x, NaN], single(1), 1), single([NaN 0 e Inf NaN NaN])); +%!assert(logninv ([x, NaN], 1, single(1)), single([NaN 0 e Inf NaN NaN])); + +%% Test input validation +%!error logninv () +%!error logninv (1,2) +%!error logninv (1,2,3,4) +%!error logninv (ones(3),ones(2),ones(2)) +%!error logninv (ones(2),ones(3),ones(2)) +%!error logninv (ones(2),ones(2),ones(3)) +%!error logninv (i, 2, 2) +%!error logninv (2, i, 2) +%!error logninv (2, 2, i) +
--- a/scripts/statistics/distributions/lognpdf.m +++ b/scripts/statistics/distributions/lognpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} lognpdf (@var{x}, @var{mu}, @var{sigma}) +## @deftypefn {Function File} {} lognpdf (@var{x}) +## @deftypefnx {Function File} {} lognpdf (@var{x}, @var{mu}, @var{sigma}) ## For each element of @var{x}, compute the probability density function ## (PDF) at @var{x} of the lognormal distribution with parameters ## @var{mu} and @var{sigma}. If a random variable follows this distribution, @@ -30,43 +32,65 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: PDF of the log normal distribution -function pdf = lognpdf (x, mu, sigma) +function pdf = lognpdf (x, mu = 0, sigma = 1) - if (! ((nargin == 1) || (nargin == 3))) + if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - mu = 0; - sigma = 1; - endif - - ## The following "straightforward" implementation unfortunately does - ## not work for the special cases (Inf, ...) - ## pdf = (x > 0) ./ x .* normpdf (log (x), mu, sigma); - ## Hence ... - if (!isscalar (mu) || !isscalar (sigma)) [retval, x, mu, sigma] = common_size (x, mu, sigma); if (retval > 0) - error ("lognpdf: X, MU and SIGMA must be of common size or scalars"); + error ("lognpdf: X, MU, and SIGMA must be of common size or scalars"); endif endif - pdf = zeros (size (x)); - - k = find (isnan (x) | !(sigma > 0) | !(sigma < Inf)); - if (any (k)) - pdf(k) = NaN; + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("lognpdf: X, MU, and SIGMA must not be complex"); endif - k = find ((x > 0) & (x < Inf) & (sigma > 0) & (sigma < Inf)); - if (any (k)) - if (isscalar (mu) && isscalar (sigma)) - pdf(k) = normpdf (log (x(k)), mu, sigma) ./ x(k); - else - pdf(k) = normpdf (log (x(k)), mu(k), sigma(k)) ./ x(k); - endif + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | !(sigma > 0) | !(sigma < Inf); + pdf(k) = NaN; + + k = (x > 0) & (x < Inf) & (sigma > 0) & (sigma < Inf); + if (isscalar (mu) && isscalar (sigma)) + pdf(k) = normpdf (log (x(k)), mu, sigma) ./ x(k); + else + pdf(k) = normpdf (log (x(k)), mu(k), sigma(k)) ./ x(k); endif endfunction + + +%!shared x,y +%! x = [-1 0 e Inf]; +%! y = [0, 0, 1/(e*sqrt(2*pi)) * exp(-1/2), 0]; +%!assert(lognpdf (x, zeros(1,4), ones(1,4)), y, eps); +%!assert(lognpdf (x, 0, ones(1,4)), y, eps); +%!assert(lognpdf (x, zeros(1,4), 1), y, eps); +%!assert(lognpdf (x, [0 1 NaN 0], 1), [0 0 NaN y(4)], eps); +%!assert(lognpdf (x, 0, [0 NaN Inf 1]), [NaN NaN NaN y(4)], eps); +%!assert(lognpdf ([x, NaN], 0, 1), [y, NaN], eps); + +%% Test class of input preserved +%!assert(lognpdf (single([x, NaN]), 0, 1), single([y, NaN]), eps("single")); +%!assert(lognpdf ([x, NaN], single(0), 1), single([y, NaN]), eps("single")); +%!assert(lognpdf ([x, NaN], 0, single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error lognpdf () +%!error lognpdf (1,2) +%!error lognpdf (1,2,3,4) +%!error lognpdf (ones(3),ones(2),ones(2)) +%!error lognpdf (ones(2),ones(3),ones(2)) +%!error lognpdf (ones(2),ones(2),ones(3)) +%!error lognpdf (i, 2, 2) +%!error lognpdf (2, i, 2) +%!error lognpdf (2, 2, i) +
--- a/scripts/statistics/distributions/lognrnd.m +++ b/scripts/statistics/distributions/lognrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,76 +18,115 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} lognrnd (@var{mu}, @var{sigma}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} lognrnd (@var{mu}, @var{sigma}, @var{sz}) -## Return an @var{r} by @var{c} matrix of random samples from the -## lognormal distribution with parameters @var{mu} and @var{sigma}. Both -## @var{mu} and @var{sigma} must be scalar or of size @var{r} by @var{c}. -## Or if @var{sz} is a vector, create a matrix of size @var{sz}. +## @deftypefn {Function File} {} lognrnd (@var{mu}, @var{sigma}) +## @deftypefnx {Function File} {} lognrnd (@var{mu}, @var{sigma}, @var{r}) +## @deftypefnx {Function File} {} lognrnd (@var{mu}, @var{sigma}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} lognrnd (@var{mu}, @var{sigma}, [@var{sz}]) +## Return a matrix of random samples from the lognormal distribution with +## parameters @var{mu} and @var{sigma}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{mu} and @var{sigma}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{mu} and @var{sigma}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the log normal distribution -function rnd = lognrnd (mu, sigma, r, c) +function rnd = lognrnd (mu, sigma, varargin) - if (nargin > 1) - if (!isscalar(mu) || !isscalar(sigma)) - [retval, mu, sigma] = common_size (mu, sigma); - if (retval > 0) - error ("lognrnd: MU and SIGMA must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (mu) || !isscalar (sigma)) + [retval, mu, sigma] = common_size (mu, sigma); + if (retval > 0) + error ("lognrnd: MU and SIGMA must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("lognrnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("lognrnd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (mu) || iscomplex (sigma)) + error ("lognrnd: MU and SIGMA must not be complex"); + endif - if (any (size (mu) != 1) - && ((length (size (mu)) != length (sz)) || any (size (mu) != sz))) - error ("lognrnd: MU and SIGMA must be scalar or of size [R, C]"); - endif - + if (nargin == 2) + sz = size (mu); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("lognrnd: R must be a positive integer or vector"); + error ("lognrnd: dimension vector must be row vector of non-negative integers"); endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("lognrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif - if (any (size (mu) != 1) - && ((length (size (mu)) != length (sz)) || any (size (mu) != sz))) - error ("lognrnd: MU and SIGMA must be scalar or of size SZ"); - endif - elseif (nargin == 2) - sz = size(mu); + if (!isscalar (mu) && !isequal (size (mu), sz)) + error ("lognrnd: MU and SIGMA must be scalar or of size SZ"); + endif + + if (isa (mu, "single") || isa (sigma, "single")) + cls = "single"; else - print_usage (); + cls = "double"; endif if (isscalar (mu) && isscalar (sigma)) - if (!(sigma > 0) || !(sigma < Inf)) - rnd = NaN (sz); + if ((sigma > 0) && (sigma < Inf)) + rnd = exp (mu + sigma * randn (sz)); else - rnd = exp(mu + sigma .* randn (sz)); + rnd = NaN (sz, cls); endif else rnd = exp (mu + sigma .* randn (sz)); - k = find ((sigma < 0) | (sigma == Inf)); - if (any (k)) - rnd(k) = NaN; - endif + + k = (sigma < 0) | (sigma == Inf); + rnd(k) = NaN; endif endfunction + + +%!assert(size (lognrnd (1,2)), [1, 1]); +%!assert(size (lognrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (lognrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (lognrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (lognrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (lognrnd (1, 2, 3)), [3, 3]); +%!assert(size (lognrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (lognrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (lognrnd (1, 2)), "double"); +%!assert(class (lognrnd (single(1), 2)), "single"); +%!assert(class (lognrnd (single([1 1]), 2)), "single"); +%!assert(class (lognrnd (1, single(2))), "single"); +%!assert(class (lognrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error lognrnd () +%!error lognrnd (1) +%!error lognrnd (ones(3),ones(2)) +%!error lognrnd (ones(2),ones(3)) +%!error lognrnd (i, 2) +%!error lognrnd (2, i) +%!error lognrnd (1,2, -1) +%!error lognrnd (1,2, ones(2)) +%!error lognrnd (1, 2, [2 -1 2]) +%!error lognrnd (1,2, 1, ones(2)) +%!error lognrnd (1,2, 1, -1) +%!error lognrnd (ones(2,2), 2, 3) +%!error lognrnd (ones(2,2), 2, [3, 2]) +%!error lognrnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/nbincdf.m +++ b/scripts/statistics/distributions/nbincdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,9 +19,13 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} nbincdf (@var{x}, @var{n}, @var{p}) -## For each element of @var{x}, compute the CDF at x of the Pascal -## (negative binomial) distribution with parameters @var{n} and @var{p}. +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the negative binomial distribution with +## parameters @var{n} and @var{p}. ## +## When @var{n} is integer this is the Pascal distribution. When +## @var{n} is extended to real numbers this is the Polya distribution. +## ## The number of failures in a Bernoulli experiment with success ## probability @var{p} before the @var{n}-th success follows this ## distribution. @@ -35,58 +40,66 @@ print_usage (); endif - if (!isscalar(n) || !isscalar(p)) + if (!isscalar (n) || !isscalar (p)) [retval, x, n, p] = common_size (x, n, p); if (retval > 0) - error ("nbincdf: X, N and P must be of common size or scalar"); + error ("nbincdf: X, N, and P must be of common size or scalars"); endif endif - cdf = zeros (size (x)); - - k = find (isnan (x) | (n < 1) | (n == Inf) | (n != round (n)) - | (p < 0) | (p > 1)); - if (any (k)) - cdf(k) = NaN; + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("nbincdf: X, N, and P must not be complex"); endif - k = find ((x == Inf) & (n > 0) & (n < Inf) & (n == round (n)) - & (p >= 0) & (p <= 1)); - if (any (k)) - cdf(k) = 1; + if (isa (x, "single") || isa (n, "single") || isa (p, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x >= 0) & (x < Inf) & (x == round (x)) & (n > 0) - & (n < Inf) & (n == round (n)) & (p > 0) & (p <= 1)); - if (any (k)) - ## Does anyone know a better way to do the summation? - m = zeros (size (k)); - x = floor (x(k)); - y = cdf(k); - if (isscalar (n) && isscalar (p)) - while (1) - l = find (m <= x); - if (any (l)) - y(l) = y(l) + nbinpdf (m(l), n, p); - m(l) = m(l) + 1; - else - break; - endif - endwhile - else - n = n(k); - p = p(k); - while (1) - l = find (m <= x); - if (any (l)) - y(l) = y(l) + nbinpdf (m(l), n(l), p(l)); - m(l) = m(l) + 1; - else - break; - endif - endwhile - endif - cdf(k) = y; + k = (isnan (x) | isnan (n) | (n < 1) | (n == Inf) + | (p < 0) | (p > 1) | isnan (p)); + cdf(k) = NaN; + + k = (x == Inf) & (n > 0) & (n < Inf) & (p >= 0) & (p <= 1); + cdf(k) = 1; + + k = ((x >= 0) & (x < Inf) & (x == fix (x)) + & (n > 0) & (n < Inf) & (p > 0) & (p <= 1)); + if (isscalar (n) && isscalar (p)) + cdf(k) = 1 - betainc (1-p, x(k)+1, n); + else + cdf(k) = 1 - betainc (1-p(k), x(k)+1, n(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 1 2 Inf]; +%! y = [0 1/2 3/4 7/8 1]; +%!assert(nbincdf (x, ones(1,5), 0.5*ones(1,5)), y); +%!assert(nbincdf (x, 1, 0.5*ones(1,5)), y); +%!assert(nbincdf (x, ones(1,5), 0.5), y); +%!assert(nbincdf ([x(1:3) 0 x(5)], [0 1 NaN 1.5 Inf], 0.5), [NaN 1/2 NaN nbinpdf(0,1.5,0.5) NaN], eps); +%!assert(nbincdf (x, 1, 0.5*[-1 NaN 4 1 1]), [NaN NaN NaN y(4:5)]); +%!assert(nbincdf ([x(1:2) NaN x(4:5)], 1, 0.5), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(nbincdf ([x, NaN], 1, 0.5), [y, NaN]); +%!assert(nbincdf (single([x, NaN]), 1, 0.5), single([y, NaN])); +%!assert(nbincdf ([x, NaN], single(1), 0.5), single([y, NaN])); +%!assert(nbincdf ([x, NaN], 1, single(0.5)), single([y, NaN])); + +%% Test input validation +%!error nbincdf () +%!error nbincdf (1) +%!error nbincdf (1,2) +%!error nbincdf (1,2,3,4) +%!error nbincdf (ones(3),ones(2),ones(2)) +%!error nbincdf (ones(2),ones(3),ones(2)) +%!error nbincdf (ones(2),ones(2),ones(3)) +%!error nbincdf (i, 2, 2) +%!error nbincdf (2, i, 2) +%!error nbincdf (2, 2, i) +
--- a/scripts/statistics/distributions/nbininv.m +++ b/scripts/statistics/distributions/nbininv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,10 +19,13 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} nbininv (@var{x}, @var{n}, @var{p}) -## For each element of @var{x}, compute the quantile at @var{x} of the -## Pascal (negative binomial) distribution with parameters @var{n} and -## @var{p}. +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the negative binomial distribution +## with parameters @var{n} and @var{p}. ## +## When @var{n} is integer this is the Pascal distribution. When +## @var{n} is extended to real numbers this is the Polya distribution. +## ## The number of failures in a Bernoulli experiment with success ## probability @var{p} before the @var{n}-th success follows this ## distribution. @@ -36,58 +40,89 @@ print_usage (); endif - if (!isscalar(n) || !isscalar(p)) + if (!isscalar (n) || !isscalar (p)) [retval, x, n, p] = common_size (x, n, p); if (retval > 0) - error ("nbininv: X, N and P must be of common size or scalar"); + error ("nbininv: X, N, and P must be of common size or scalars"); endif endif - inv = zeros (size (x)); - - k = find (isnan (x) | (x < 0) | (x > 1) | (n < 1) | (n == Inf) - | (n != round (n)) | (p < 0) | (p > 1)); - if (any (k)) - inv(k) = NaN; + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("nbininv: X, N, and P must not be complex"); endif - k = find ((x == 1) & (n > 0) & (n < Inf) & (n == round (n)) - & (p >= 0) & (p <= 1)); - if (any (k)) - inv(k) = Inf; + if (isa (x, "single") || isa (n, "single") || isa (p, "single")) + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); endif + k = (isnan (x) | (x < 0) | (x > 1) | isnan (n) | (n < 1) | (n == Inf) + | isnan (p) | (p < 0) | (p > 1)); + inv(k) = NaN; + + k = (x == 1) & (n > 0) & (n < Inf) & (p >= 0) & (p <= 1); + inv(k) = Inf; + k = find ((x >= 0) & (x < 1) & (n > 0) & (n < Inf) - & (n == round (n)) & (p > 0) & (p <= 1)); - if (any (k)) - m = zeros (size (k)); - x = x(k); - if (isscalar (n) && isscalar (p)) - s = p ^ n * ones (size(k)); - while (1) - l = find (s < x); - if (any (l)) - m(l) = m(l) + 1; - s(l) = s(l) + nbinpdf (m(l), n, p); - else - break; - endif - endwhile - else - n = n(k); - p = p(k); - s = p .^ n; - while (1) - l = find (s < x); - if (any (l)) - m(l) = m(l) + 1; - s(l) = s(l) + nbinpdf (m(l), n(l), p(l)); - else - break; - endif - endwhile - endif - inv(k) = m; + & (p > 0) & (p <= 1)); + m = zeros (size (k)); + x = x(k); + if (isscalar (n) && isscalar (p)) + s = p ^ n * ones (size (k)); + while (1) + l = find (s < x); + if (any (l)) + m(l) = m(l) + 1; + s(l) = s(l) + nbinpdf (m(l), n, p); + else + break; + endif + endwhile + else + n = n(k); + p = p(k); + s = p .^ n; + while (1) + l = find (s < x); + if (any (l)) + m(l) = m(l) + 1; + s(l) = s(l) + nbinpdf (m(l), n(l), p(l)); + else + break; + endif + endwhile endif + inv(k) = m; endfunction + + +%!shared x +%! x = [-1 0 3/4 1 2]; +%!assert(nbininv (x, ones(1,5), 0.5*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(nbininv (x, 1, 0.5*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(nbininv (x, ones(1,5), 0.5), [NaN 0 1 Inf NaN]); +%!assert(nbininv (x, [1 0 NaN Inf 1], 0.5), [NaN NaN NaN NaN NaN]); +%!assert(nbininv (x, [1 0 1.5 Inf 1], 0.5), [NaN NaN 2 NaN NaN]); +%!assert(nbininv (x, 1, 0.5*[1 -Inf NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(nbininv ([x(1:2) NaN x(4:5)], 1, 0.5), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(nbininv ([x, NaN], 1, 0.5), [NaN 0 1 Inf NaN NaN]); +%!assert(nbininv (single([x, NaN]), 1, 0.5), single([NaN 0 1 Inf NaN NaN])); +%!assert(nbininv ([x, NaN], single(1), 0.5), single([NaN 0 1 Inf NaN NaN])); +%!assert(nbininv ([x, NaN], 1, single(0.5)), single([NaN 0 1 Inf NaN NaN])); + +%% Test input validation +%!error nbininv () +%!error nbininv (1) +%!error nbininv (1,2) +%!error nbininv (1,2,3,4) +%!error nbininv (ones(3),ones(2),ones(2)) +%!error nbininv (ones(2),ones(3),ones(2)) +%!error nbininv (ones(2),ones(2),ones(3)) +%!error nbininv (i, 2, 2) +%!error nbininv (2, i, 2) +%!error nbininv (2, 2, i) +
--- a/scripts/statistics/distributions/nbinpdf.m +++ b/scripts/statistics/distributions/nbinpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,9 +20,12 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} nbinpdf (@var{x}, @var{n}, @var{p}) ## For each element of @var{x}, compute the probability density function -## (PDF) at @var{x} of the Pascal (negative binomial) distribution with +## (PDF) at @var{x} of the negative binomial distribution with ## parameters @var{n} and @var{p}. ## +## When @var{n} is integer this is the Pascal distribution. When +## @var{n} is extended to real numbers this is the Polya distribution. +## ## The number of failures in a Bernoulli experiment with success ## probability @var{p} before the @var{n}-th success follows this ## distribution. @@ -36,36 +40,63 @@ print_usage (); endif - if (!isscalar(n) || !isscalar(p)) + if (!isscalar (n) || !isscalar (p)) [retval, x, n, p] = common_size (x, n, p); if (retval > 0) - error ("nbinpdf: X, N and P must be of common size or scalar"); + error ("nbinpdf: X, N, and P must be of common size or scalars"); endif endif - pdf = zeros (size (x)); + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("nbinpdf: X, N, and P must not be complex"); + endif - k = find (isnan (x) | (n < 1) | (n == Inf) | (n != round (n)) - | (p < 0) | (p > 1)); - if (any (k)) - pdf(k) = NaN; + if (isa (x, "single") || isa (n, "single") || isa (p, "single")) + pdf = NaN (size (x), "single"); + else + pdf = NaN (size (x)); endif - ## Just for the fun of it ... - k = find ((x == Inf) & (n > 0) & (n < Inf) & (n == round (n)) - & (p == 0)); - if (any (k)) - pdf(k) = 1; - endif + ok = (x < Inf) & (x == fix (x)) & (n > 0) & (n < Inf) & (p >= 0) & (p <= 1); + + k = (x < 0) & ok; + pdf(k) = 0; - k = find ((x >= 0) & (x < Inf) & (x == round (x)) & (n > 0) - & (n < Inf) & (n == round (n)) & (p > 0) & (p <= 1)); - if (any (k)) - if (isscalar (n) && isscalar (p)) - pdf(k) = bincoeff (-n, x(k)) .* (p ^ n) .* ((p - 1) .^ x(k)); - else - pdf(k) = bincoeff (-n(k), x(k)) .* (p(k) .^ n(k)) .* ((p(k) - 1) .^ x(k)); - endif + k = (x >= 0) & ok; + if (isscalar (n) && isscalar (p)) + pdf(k) = bincoeff (-n, x(k)) .* (p ^ n) .* ((p - 1) .^ x(k)); + else + pdf(k) = bincoeff (-n(k), x(k)) .* (p(k) .^ n(k)) .* ((p(k) - 1) .^ x(k)); endif + endfunction + + +%!shared x,y +%! x = [-1 0 1 2 Inf]; +%! y = [0 1/2 1/4 1/8 NaN]; +%!assert(nbinpdf (x, ones(1,5), 0.5*ones(1,5)), y); +%!assert(nbinpdf (x, 1, 0.5*ones(1,5)), y); +%!assert(nbinpdf (x, ones(1,5), 0.5), y); +%!assert(nbinpdf (x, [0 1 NaN 1.5 Inf], 0.5), [NaN 1/2 NaN 1.875*0.5^1.5/4 NaN], eps); +%!assert(nbinpdf (x, 1, 0.5*[-1 NaN 4 1 1]), [NaN NaN NaN y(4:5)]); +%!assert(nbinpdf ([x, NaN], 1, 0.5), [y, NaN]); + +%% Test class of input preserved +%!assert(nbinpdf (single([x, NaN]), 1, 0.5), single([y, NaN])); +%!assert(nbinpdf ([x, NaN], single(1), 0.5), single([y, NaN])); +%!assert(nbinpdf ([x, NaN], 1, single(0.5)), single([y, NaN])); + +%% Test input validation +%!error nbinpdf () +%!error nbinpdf (1) +%!error nbinpdf (1,2) +%!error nbinpdf (1,2,3,4) +%!error nbinpdf (ones(3),ones(2),ones(2)) +%!error nbinpdf (ones(2),ones(3),ones(2)) +%!error nbinpdf (ones(2),ones(2),ones(3)) +%!error nbinpdf (i, 2, 2) +%!error nbinpdf (2, i, 2) +%!error nbinpdf (2, 2, i) +
--- a/scripts/statistics/distributions/nbinrnd.m +++ b/scripts/statistics/distributions/nbinrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,85 +18,123 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} nbinrnd (@var{n}, @var{p}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} nbinrnd (@var{n}, @var{p}, @var{sz}) -## Return an @var{r} by @var{c} matrix of random samples from the Pascal -## (negative binomial) distribution with parameters @var{n} and @var{p}. -## Both @var{n} and @var{p} must be scalar or of size @var{r} by @var{c}. +## @deftypefn {Function File} {} nbinrnd (@var{n}, @var{p}) +## @deftypefnx {Function File} {} nbinrnd (@var{n}, @var{p}, @var{r}) +## @deftypefnx {Function File} {} nbinrnd (@var{n}, @var{p}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} nbinrnd (@var{n}, @var{p}, [@var{sz}]) +## Return a matrix of random samples from the negative binomial +## distribution with parameters @var{n} and @var{p}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{n} and @var{p}. Or if @var{sz} is a vector, -## create a matrix of size @var{sz}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{n} and @var{p}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the Pascal distribution -function rnd = nbinrnd (n, p, r, c) +function rnd = nbinrnd (n, p, varargin) - if (nargin > 1) - if (!isscalar(n) || !isscalar(p)) - [retval, n, p] = common_size (n, p); - if (retval > 0) - error ("nbinrnd: N and P must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (n) || !isscalar (p)) + [retval, n, p] = common_size (n, p); + if (retval > 0) + error ("nbinrnd: N and P must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("nbinrnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("nbinrnd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (n) || iscomplex (p)) + error ("nbinrnd: N and P must not be complex"); + endif - if (any (size (n) != 1) - && ((length (size (n)) != length (sz)) || any (size (n) != sz))) - error ("nbinrnd: N and P must be scalar or of size [R, C]"); - endif - + if (nargin == 2) + sz = size (n); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("nbinrnd: R must be a positive integer or vector"); + error ("nbinrnd: dimension vector must be row vector of non-negative integers"); endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("nbinrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif - if (any (size (n) != 1) - && ((length (size (n)) != length (sz)) || any (size (n) != sz))) - error ("nbinrnd: N and P must be scalar or of size SZ"); - endif - elseif (nargin == 2) - sz = size(n); + if (!isscalar (n) && !isequal (size (n), sz)) + error ("nbinrnd: N and P must be scalar or of size SZ"); + endif + + if (isa (n, "single") || isa (p, "single")) + cls = "single"; else - print_usage (); + cls = "double"; endif if (isscalar (n) && isscalar (p)) - if ((n < 1) || (n == Inf) || (n != round (n)) || (p <= 0) || (p > 1)); - rnd = NaN (sz); - elseif ((n > 0) && (n < Inf) && (n == round (n)) - && (p > 0) && (p <= 1)) + if ((n > 0) && (n < Inf) && (p > 0) && (p <= 1)) rnd = randp ((1 - p) ./ p .* randg (n, sz)); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + elseif ((n > 0) && (n < Inf) && (p == 0)) + rnd = zeros (sz, cls); else - rnd = zeros (sz); + rnd = NaN (sz, cls); endif else - rnd = zeros (sz); + rnd = NaN (sz, cls); - k = find ((n < 1) | (n == Inf) | (n != round (n)) | (p <= 0) | (p > 1)); - if (any (k)) - rnd(k) = NaN; - endif + k = (n > 0) & (n < Inf) & (p == 0); + rnd(k) = 0; - k = find ((n > 0) & (n < Inf) & (n == round (n)) & (p > 0) & (p <= 1)); - if (any (k)) - rnd(k) = randp ((1 - p(k)) ./ p(k) .* randg (n(k), size(k))); - endif + k = (n > 0) & (n < Inf) & (p > 0) & (p <= 1); + rnd(k) = randp ((1 - p(k)) ./ p(k) .* randg (n(k))); endif endfunction + + +%!assert(size (nbinrnd (2, 1/2)), [1, 1]); +%!assert(size (nbinrnd (2*ones(2,1), 1/2)), [2, 1]); +%!assert(size (nbinrnd (2*ones(2,2), 1/2)), [2, 2]); +%!assert(size (nbinrnd (2, 1/2*ones(2,1))), [2, 1]); +%!assert(size (nbinrnd (2, 1/2*ones(2,2))), [2, 2]); +%!assert(size (nbinrnd (2, 1/2, 3)), [3, 3]); +%!assert(size (nbinrnd (2, 1/2, [4 1])), [4, 1]); +%!assert(size (nbinrnd (2, 1/2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (nbinrnd (2, 1/2)), "double"); +%!assert(class (nbinrnd (single(2), 1/2)), "single"); +%!assert(class (nbinrnd (single([2 2]), 1/2)), "single"); +%!assert(class (nbinrnd (2, single(1/2))), "single"); +%!assert(class (nbinrnd (2, single([1/2 1/2]))), "single"); + +%% Test input validation +%!error nbinrnd () +%!error nbinrnd (1) +%!error nbinrnd (ones(3),ones(2)) +%!error nbinrnd (ones(2),ones(3)) +%!error nbinrnd (i, 2) +%!error nbinrnd (2, i) +%!error nbinrnd (1,2, -1) +%!error nbinrnd (1,2, ones(2)) +%!error nbinrnd (1, 2, [2 -1 2]) +%!error nbinrnd (1,2, 1, ones(2)) +%!error nbinrnd (1,2, 1, -1) +%!error nbinrnd (ones(2,2), 2, 3) +%!error nbinrnd (ones(2,2), 2, [3, 2]) +%!error nbinrnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/normcdf.m +++ b/scripts/statistics/distributions/normcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,56 +18,82 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} normcdf (@var{x}, @var{m}, @var{s}) +## @deftypefn {Function File} {} normcdf (@var{x}) +## @deftypefnx {Function File} {} normcdf (@var{x}, @var{mu}, @var{sigma}) ## For each element of @var{x}, compute the cumulative distribution ## function (CDF) at @var{x} of the normal distribution with mean -## @var{m} and standard deviation @var{s}. +## @var{mu} and standard deviation @var{sigma}. ## -## Default values are @var{m} = 0, @var{s} = 1. +## Default values are @var{mu} = 0, @var{sigma} = 1. ## @end deftypefn ## Author: TT <Teresa.Twaroch@ci.tuwien.ac.at> ## Description: CDF of the normal distribution -function cdf = normcdf (x, m, s) +function cdf = normcdf (x, mu = 0, sigma = 1) - if (! ((nargin == 1) || (nargin == 3))) + if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - m = 0; - s = 1; - endif - - if (!isscalar (m) || !isscalar (s)) - [retval, x, m, s] = common_size (x, m, s); + if (!isscalar (mu) || !isscalar (sigma)) + [retval, x, mu, sigma] = common_size (x, mu, sigma); if (retval > 0) - error ("normcdf: X, M and S must be of common size or scalar"); + error ("normcdf: X, MU, and SIGMA must be of common size or scalars"); endif endif - sz = size (x); - cdf = zeros (sz); + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("normcdf: X, MU, and SIGMA must not be complex"); + endif - if (isscalar (m) && isscalar(s)) - if (find (isinf (m) | isnan (m) | !(s >= 0) | !(s < Inf))) - cdf = NaN (sz); + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")); + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + if (isscalar (mu) && isscalar (sigma)) + if (!isinf (mu) && !isnan (mu) && (sigma > 0) && (sigma < Inf)) + cdf = stdnormal_cdf ((x - mu) / sigma); else - cdf = stdnormal_cdf ((x - m) ./ s); + cdf = NaN (size (x), class (cdf)); endif else - k = find (isinf (m) | isnan (m) | !(s >= 0) | !(s < Inf)); - if (any (k)) - cdf(k) = NaN; - endif + k = isinf (mu) | isnan (mu) | !(sigma > 0) | !(sigma < Inf); + cdf(k) = NaN; - k = find (!isinf (m) & !isnan (m) & (s >= 0) & (s < Inf)); - if (any (k)) - cdf(k) = stdnormal_cdf ((x(k) - m(k)) ./ s(k)); - endif + k = ! k; + cdf(k) = stdnormal_cdf ((x(k) - mu(k)) ./ sigma(k)); endif - cdf((s == 0) & (x == m)) = 0.5; +endfunction + + +%!shared x,y +%! x = [-Inf 1 2 Inf]; +%! y = [0, 0.5, 1/2*(1+erf(1/sqrt(2))), 1]; +%!assert(normcdf (x, ones(1,4), ones(1,4)), y); +%!assert(normcdf (x, 1, ones(1,4)), y); +%!assert(normcdf (x, ones(1,4), 1), y); +%!assert(normcdf (x, [0 -Inf NaN Inf], 1), [y(1) NaN NaN NaN]); +%!assert(normcdf (x, 1, [Inf NaN -1 0]), [NaN NaN NaN NaN]); +%!assert(normcdf ([x(1:2) NaN x(4)], 1, 1), [y(1:2) NaN y(4)]); -endfunction +%% Test class of input preserved +%!assert(normcdf ([x, NaN], 1, 1), [y, NaN]); +%!assert(normcdf (single([x, NaN]), 1, 1), single([y, NaN]), eps("single")); +%!assert(normcdf ([x, NaN], single(1), 1), single([y, NaN]), eps("single")); +%!assert(normcdf ([x, NaN], 1, single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error normcdf () +%!error normcdf (1,2) +%!error normcdf (1,2,3,4) +%!error normcdf (ones(3),ones(2),ones(2)) +%!error normcdf (ones(2),ones(3),ones(2)) +%!error normcdf (ones(2),ones(2),ones(3)) +%!error normcdf (i, 2, 2) +%!error normcdf (2, i, 2) +%!error normcdf (2, 2, i) +
--- a/scripts/statistics/distributions/norminv.m +++ b/scripts/statistics/distributions/norminv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,62 +18,76 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} norminv (@var{x}, @var{m}, @var{s}) +## @deftypefn {Function File} {} norminv (@var{x}) +## @deftypefnx {Function File} {} norminv (@var{x}, @var{mu}, @var{sigma}) ## For each element of @var{x}, compute the quantile (the inverse of the -## CDF) at @var{x} of the normal distribution with mean @var{m} and -## standard deviation @var{s}. +## CDF) at @var{x} of the normal distribution with mean @var{mu} and +## standard deviation @var{sigma}. ## -## Default values are @var{m} = 0, @var{s} = 1. +## Default values are @var{mu} = 0, @var{sigma} = 1. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Quantile function of the normal distribution -function inv = norminv (x, m, s) +function inv = norminv (x, mu = 0, sigma = 1) if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - m = 0; - s = 1; - endif - - if (!isscalar (m) || !isscalar (s)) - [retval, x, m, s] = common_size (x, m, s); + if (!isscalar (mu) || !isscalar (sigma)) + [retval, x, mu, sigma] = common_size (x, mu, sigma); if (retval > 0) - error ("norminv: X, M and S must be of common size or scalars"); + error ("norminv: X, MU, and SIGMA must be of common size or scalars"); endif endif - sz = size (x); - inv = zeros (sz); + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("norminv: X, MU, and SIGMA must not be complex"); + endif - if (isscalar (m) && isscalar (s)) - if (find (isinf (m) | isnan (m) | !(s > 0) | !(s < Inf))) - inv = NaN (sz); - else - inv = m + s .* stdnormal_inv (x); + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + if (isscalar (mu) && isscalar (sigma)) + if (!isinf (mu) && !isnan (mu) && (sigma > 0) && (sigma < Inf)) + inv = mu + sigma * stdnormal_inv (x); endif else - k = find (isinf (m) | isnan (m) | !(s > 0) | !(s < Inf)); - if (any (k)) - inv(k) = NaN; - endif - - k = find (!isinf (m) & !isnan (m) & (s > 0) & (s < Inf)); - if (any (k)) - inv(k) = m(k) + s(k) .* stdnormal_inv (x(k)); - endif + k = !isinf (mu) & !isnan (mu) & (sigma > 0) & (sigma < Inf); + inv(k) = mu(k) + sigma(k) .* stdnormal_inv (x(k)); endif - k = find ((s == 0) & (x > 0) & (x < 1)); - if (any (k)) - inv(k) = m(k); - endif +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(norminv (x, ones(1,5), ones(1,5)), [NaN -Inf 1 Inf NaN]); +%!assert(norminv (x, 1, ones(1,5)), [NaN -Inf 1 Inf NaN]); +%!assert(norminv (x, ones(1,5), 1), [NaN -Inf 1 Inf NaN]); +%!assert(norminv (x, [1 -Inf NaN Inf 1], 1), [NaN NaN NaN NaN NaN]); +%!assert(norminv (x, 1, [1 0 NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(norminv ([x(1:2) NaN x(4:5)], 1, 1), [NaN -Inf NaN Inf NaN]); - inv((s == 0) & (x == 0)) = -Inf; - inv((s == 0) & (x == 1)) = Inf; +%% Test class of input preserved +%!assert(norminv ([x, NaN], 1, 1), [NaN -Inf 1 Inf NaN NaN]); +%!assert(norminv (single([x, NaN]), 1, 1), single([NaN -Inf 1 Inf NaN NaN])); +%!assert(norminv ([x, NaN], single(1), 1), single([NaN -Inf 1 Inf NaN NaN])); +%!assert(norminv ([x, NaN], 1, single(1)), single([NaN -Inf 1 Inf NaN NaN])); -endfunction +%% Test input validation +%!error norminv () +%!error norminv (1,2) +%!error norminv (1,2,3,4) +%!error norminv (ones(3),ones(2),ones(2)) +%!error norminv (ones(2),ones(3),ones(2)) +%!error norminv (ones(2),ones(2),ones(3)) +%!error norminv (i, 2, 2) +%!error norminv (2, i, 2) +%!error norminv (2, 2, i) +
--- a/scripts/statistics/distributions/normpdf.m +++ b/scripts/statistics/distributions/normpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,57 +18,81 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} normpdf (@var{x}, @var{m}, @var{s}) +## @deftypefn {Function File} {} normpdf (@var{x}) +## @deftypefnx {Function File} {} normpdf (@var{x}, @var{mu}, @var{sigma}) ## For each element of @var{x}, compute the probability density function -## (PDF) at @var{x} of the normal distribution with mean @var{m} and -## standard deviation @var{s}. +## (PDF) at @var{x} of the normal distribution with mean @var{mu} and +## standard deviation @var{sigma}. ## -## Default values are @var{m} = 0, @var{s} = 1. +## Default values are @var{mu} = 0, @var{sigma} = 1. ## @end deftypefn ## Author: TT <Teresa.Twaroch@ci.tuwien.ac.at> ## Description: PDF of the normal distribution -function pdf = normpdf (x, m, s) +function pdf = normpdf (x, mu = 0, sigma = 1) if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - m = 0; - s = 1; - endif - - if (!isscalar (m) || !isscalar (s)) - [retval, x, m, s] = common_size (x, m, s); + if (!isscalar (mu) || !isscalar (sigma)) + [retval, x, mu, sigma] = common_size (x, mu, sigma); if (retval > 0) - error ("normpdf: X, M and S must be of common size or scalars"); + error ("normpdf: X, MU, and SIGMA must be of common size or scalars"); endif endif - sz = size (x); - pdf = zeros (sz); + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("normpdf: X, MU, and SIGMA must not be complex"); + endif - if (isscalar (m) && isscalar (s)) - if (find (isinf (m) | isnan (m) | !(s >= 0) | !(s < Inf))) - pdf = NaN (sz); + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + if (isscalar (mu) && isscalar (sigma)) + if (!isinf (mu) && !isnan (mu) && (sigma > 0) && (sigma < Inf)) + pdf = stdnormal_pdf ((x - mu) / sigma) / sigma; else - pdf = stdnormal_pdf ((x - m) ./ s) ./ s; + pdf = NaN (size (x), class (pdf)); endif else - k = find (isinf (m) | isnan (m) | !(s >= 0) | !(s < Inf)); - if (any (k)) - pdf(k) = NaN; - endif + k = isinf (mu) | !(sigma > 0) | !(sigma < Inf); + pdf(k) = NaN; - k = find (!isinf (m) & !isnan (m) & (s >= 0) & (s < Inf)); - if (any (k)) - pdf(k) = stdnormal_pdf ((x(k) - m(k)) ./ s(k)) ./ s(k); - endif + k = !isinf (mu) & (sigma > 0) & (sigma < Inf); + pdf(k) = stdnormal_pdf ((x(k) - mu(k)) ./ sigma(k)) ./ sigma(k); endif - pdf((s == 0) & (x == m)) = Inf; - pdf((s == 0) & ((x < m) | (x > m))) = 0; +endfunction + + +%!shared x,y +%! x = [-Inf 1 2 Inf]; +%! y = 1/sqrt(2*pi)*exp (-(x-1).^2/2); +%!assert(normpdf (x, ones(1,4), ones(1,4)), y); +%!assert(normpdf (x, 1, ones(1,4)), y); +%!assert(normpdf (x, ones(1,4), 1), y); +%!assert(normpdf (x, [0 -Inf NaN Inf], 1), [y(1) NaN NaN NaN]); +%!assert(normpdf (x, 1, [Inf NaN -1 0]), [NaN NaN NaN NaN]); +%!assert(normpdf ([x, NaN], 1, 1), [y, NaN]); -endfunction +%% Test class of input preserved +%!assert(normpdf (single([x, NaN]), 1, 1), single([y, NaN]), eps("single")); +%!assert(normpdf ([x, NaN], single(1), 1), single([y, NaN]), eps("single")); +%!assert(normpdf ([x, NaN], 1, single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error normpdf () +%!error normpdf (1,2) +%!error normpdf (1,2,3,4) +%!error normpdf (ones(3),ones(2),ones(2)) +%!error normpdf (ones(2),ones(3),ones(2)) +%!error normpdf (ones(2),ones(2),ones(3)) +%!error normpdf (i, 2, 2) +%!error normpdf (2, i, 2) +%!error normpdf (2, 2, i) +
--- a/scripts/statistics/distributions/normrnd.m +++ b/scripts/statistics/distributions/normrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,75 +18,114 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} normrnd (@var{m}, @var{s}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} normrnd (@var{m}, @var{s}, @var{sz}) -## Return an @var{r} by @var{c} or @code{size (@var{sz})} matrix of -## random samples from the normal distribution with parameters mean @var{m} -## and standard deviation @var{s}. Both @var{m} and @var{s} must be scalar -## or of size @var{r} by @var{c}. +## @deftypefn {Function File} {} normrnd (@var{mu}, @var{sigma}) +## @deftypefnx {Function File} {} normrnd (@var{mu}, @var{sigma}, @var{r}) +## @deftypefnx {Function File} {} normrnd (@var{mu}, @var{sigma}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} normrnd (@var{mu}, @var{sigma}, [@var{sz}]) +## Return a matrix of random samples from the normal distribution with +## parameters mean @var{mu} and standard deviation @var{sigma}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{m} and @var{s}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{mu} and @var{sigma}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the normal distribution -function rnd = normrnd (m, s, r, c) +function rnd = normrnd (mu, sigma, varargin) - if (nargin > 1) - if (!isscalar (m) || !isscalar (s)) - [retval, m, s] = common_size (m, s); - if (retval > 0) - error ("normrnd: M and S must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (mu) || !isscalar (sigma)) + [retval, mu, sigma] = common_size (mu, sigma); + if (retval > 0) + error ("normrnd: mu and sigma must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("normrnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("normrnd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (mu) || iscomplex (sigma)) + error ("normrnd: MU and SIGMA must not be complex"); + endif - if (any (size (m) != 1) - && (length (size (m)) != length (sz) || any (size (m) != sz))) - error ("normrnd: M and S must be scalar or of size [R, C]"); - endif + if (nargin == 2) + sz = size (mu); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("normrnd: R must be a positive integer or vector"); + error ("normrnd: dimension vector must be row vector of non-negative integers"); endif - - if (any (size (m) != 1) - && (length (size (m)) != length (sz) || any (size (m) != sz))) - error ("normrnd: M and S must be scalar or of size SZ"); + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("normrnd: dimensions must be non-negative integers"); endif - elseif (nargin == 2) - sz = size(m); - else - print_usage (); + sz = [varargin{:}]; endif - if (isscalar (m) && isscalar (s)) - if (find (isnan (m) | isinf (m) | !(s > 0) | !(s < Inf))) - rnd = NaN (sz); + if (!isscalar (mu) && !isequal (size (mu), sz)) + error ("normrnd: mu and sigma must be scalar or of size SZ"); + endif + + if (isa (mu, "single") || isa (sigma, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (mu) && isscalar (sigma)) + if (!isnan (mu) && !isinf (mu) && (sigma > 0) && (sigma < Inf)) + rnd = mu + sigma * randn (sz); else - rnd = m + s .* randn (sz); + rnd = NaN (sz, cls); endif else - rnd = m + s .* randn (sz); - k = find (isnan (m) | isinf (m) | !(s > 0) | !(s < Inf)); - if (any (k)) - rnd(k) = NaN; - endif + rnd = mu + sigma .* randn (sz); + k = isnan (mu) | isinf (mu) | !(sigma > 0) | !(sigma < Inf); + rnd(k) = NaN; endif endfunction + + +%!assert(size (normrnd (1,2)), [1, 1]); +%!assert(size (normrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (normrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (normrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (normrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (normrnd (1, 2, 3)), [3, 3]); +%!assert(size (normrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (normrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (normrnd (1, 2)), "double"); +%!assert(class (normrnd (single(1), 2)), "single"); +%!assert(class (normrnd (single([1 1]), 2)), "single"); +%!assert(class (normrnd (1, single(2))), "single"); +%!assert(class (normrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error normrnd () +%!error normrnd (1) +%!error normrnd (ones(3),ones(2)) +%!error normrnd (ones(2),ones(3)) +%!error normrnd (i, 2) +%!error normrnd (2, i) +%!error normrnd (1,2, -1) +%!error normrnd (1,2, ones(2)) +%!error normrnd (1, 2, [2 -1 2]) +%!error normrnd (1,2, 1, ones(2)) +%!error normrnd (1,2, 1, -1) +%!error normrnd (ones(2,2), 2, 3) +%!error normrnd (ones(2,2), 2, [3, 2]) +%!error normrnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/poisscdf.m +++ b/scripts/statistics/distributions/poisscdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -35,29 +36,55 @@ if (!isscalar (lambda)) [retval, x, lambda] = common_size (x, lambda); if (retval > 0) - error ("poisscdf: X and LAMBDA must be of common size or scalar"); + error ("poisscdf: X and LAMBDA must be of common size or scalars"); endif endif - cdf = zeros (size (x)); + if (iscomplex (x) || iscomplex (lambda)) + error ("poisscdf: X and LAMBDA must not be complex"); + endif - k = find (isnan (x) | !(lambda > 0)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (lambda, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x == Inf) & (lambda > 0)); - if (any (k)) - cdf(k) = 1; - endif + k = isnan (x) | !(lambda > 0); + cdf(k) = NaN; + + k = (x == Inf) & (lambda > 0); + cdf(k) = 1; - k = find ((x >= 0) & (x < Inf) & (lambda > 0)); - if (any (k)) - if (isscalar (lambda)) - cdf(k) = 1 - gammainc (lambda, floor (x(k)) + 1); - else - cdf(k) = 1 - gammainc (lambda(k), floor (x(k)) + 1); - endif + k = (x >= 0) & (x < Inf) & (lambda > 0); + if (isscalar (lambda)) + cdf(k) = 1 - gammainc (lambda, floor (x(k)) + 1); + else + cdf(k) = 1 - gammainc (lambda(k), floor (x(k)) + 1); endif endfunction + + +%!shared x,y +%! x = [-1 0 1 2 Inf]; +%! y = [0, gammainc(1, (x(2:4) +1), 'upper'), 1]; +%!assert(poisscdf (x, ones(1,5)), y); +%!assert(poisscdf (x, 1), y); +%!assert(poisscdf (x, [1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)]); +%!assert(poisscdf ([x(1:2) NaN Inf x(5)], 1), [y(1:2) NaN 1 y(5)]); + +%% Test class of input preserved +%!assert(poisscdf ([x, NaN], 1), [y, NaN]); +%!assert(poisscdf (single([x, NaN]), 1), single([y, NaN]), eps("single")); +%!assert(poisscdf ([x, NaN], single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error poisscdf () +%!error poisscdf (1) +%!error poisscdf (1,2,3) +%!error poisscdf (ones(3),ones(2)) +%!error poisscdf (ones(2),ones(3)) +%!error poisscdf (i, 2) +%!error poisscdf (2, i) +
--- a/scripts/statistics/distributions/poissinv.m +++ b/scripts/statistics/distributions/poissinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} poissinv (@var{x}, @var{lambda}) -## For each component of @var{x}, compute the quantile (the inverse of +## For each element of @var{x}, compute the quantile (the inverse of ## the CDF) at @var{x} of the Poisson distribution with parameter ## @var{lambda}. ## @end deftypefn @@ -35,42 +36,68 @@ if (!isscalar (lambda)) [retval, x, lambda] = common_size (x, lambda); if (retval > 0) - error ("poissinv: X and LAMBDA must be of common size or scalar"); + error ("poissinv: X and LAMBDA must be of common size or scalars"); endif endif - inv = zeros (size (x)); - - k = find ((x < 0) | (x > 1) | isnan (x) | !(lambda > 0)); - if (any (k)) - inv(k) = NaN; + if (iscomplex (x) || iscomplex (lambda)) + error ("poissinv: X and LAMBDA must not be complex"); endif - k = find ((x == 1) & (lambda > 0)); - if (any (k)) - inv(k) = Inf; + if (isa (x, "single") || isa (lambda, "single")) + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); endif + k = (x < 0) | (x > 1) | isnan (x) | !(lambda > 0); + inv(k) = NaN; + + k = (x == 1) & (lambda > 0); + inv(k) = Inf; + k = find ((x > 0) & (x < 1) & (lambda > 0)); - if (any (k)) - if (isscalar (lambda)) - cdf = exp (-lambda) * ones (size (k)); + if (isscalar (lambda)) + cdf = exp (-lambda) * ones (size (k)); + else + cdf = exp (-lambda(k)); + endif + + while (1) + m = find (cdf < x(k)); + if (any (m)) + inv(k(m)) += 1; + if (isscalar (lambda)) + cdf(m) = cdf(m) + poisspdf (inv(k(m)), lambda); + else + cdf(m) = cdf(m) + poisspdf (inv(k(m)), lambda(k(m))); + endif else - cdf = exp (-lambda(k)); + break; endif - while (1) - m = find (cdf < x(k)); - if (any (m)) - inv(k(m)) = inv(k(m)) + 1; - if (isscalar (lambda)) - cdf(m) = cdf(m) + poisspdf (inv(k(m)), lambda); - else - cdf(m) = cdf(m) + poisspdf (inv(k(m)), lambda(k(m))); - endif - else - break; - endif - endwhile - endif + endwhile endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(poissinv (x, ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(poissinv (x, 1), [NaN 0 1 Inf NaN]); +%!assert(poissinv (x, [1 0 NaN 1 1]), [NaN NaN NaN Inf NaN]); +%!assert(poissinv ([x(1:2) NaN x(4:5)], 1), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(poissinv ([x, NaN], 1), [NaN 0 1 Inf NaN NaN]); +%!assert(poissinv (single([x, NaN]), 1), single([NaN 0 1 Inf NaN NaN])); +%!assert(poissinv ([x, NaN], single(1)), single([NaN 0 1 Inf NaN NaN])); + +%% Test input validation +%!error poissinv () +%!error poissinv (1) +%!error poissinv (1,2,3) +%!error poissinv (ones(3),ones(2)) +%!error poissinv (ones(2),ones(3)) +%!error poissinv (i, 2) +%!error poissinv (2, i) +
--- a/scripts/statistics/distributions/poisspdf.m +++ b/scripts/statistics/distributions/poisspdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -34,24 +35,51 @@ if (!isscalar (lambda)) [retval, x, lambda] = common_size (x, lambda); if (retval > 0) - error ("poisspdf: X and LAMBDA must be of common size or scalar"); + error ("poisspdf: X and LAMBDA must be of common size or scalars"); endif endif - pdf = zeros (size (x)); - - k = find (!(lambda > 0) | isnan (x)); - if (any (k)) - pdf(k) = NaN; + if (iscomplex (x) || iscomplex (lambda)) + error ("poisspdf: X and LAMBDA must not be complex"); endif - k = find ((x >= 0) & (x < Inf) & (x == round (x)) & (lambda > 0)); - if (any (k)) - if (isscalar (lambda)) - pdf(k) = exp (x(k) .* log (lambda) - lambda - gammaln (x(k) + 1)); - else - pdf(k) = exp (x(k) .* log (lambda(k)) - lambda(k) - gammaln (x(k) + 1)); - endif + if (isa (x, "single") || isa (lambda, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | !(lambda > 0); + pdf(k) = NaN; + + k = (x >= 0) & (x < Inf) & (x == fix (x)) & (lambda > 0); + if (isscalar (lambda)) + pdf(k) = exp (x(k) * log (lambda) - lambda - gammaln (x(k) + 1)); + else + pdf(k) = exp (x(k) .* log (lambda(k)) - lambda(k) - gammaln (x(k) + 1)); endif endfunction + + +%!shared x,y +%! x = [-1 0 1 2 Inf]; +%! y = [0, exp(-1)*[1 1 0.5], 0]; +%!assert(poisspdf (x, ones(1,5)), y, eps); +%!assert(poisspdf (x, 1), y, eps); +%!assert(poisspdf (x, [1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)], eps); +%!assert(poisspdf ([x, NaN], 1), [y, NaN], eps); + +%% Test class of input preserved +%!assert(poisspdf (single([x, NaN]), 1), single([y, NaN]), eps("single")); +%!assert(poisspdf ([x, NaN], single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error poisspdf () +%!error poisspdf (1) +%!error poisspdf (1,2,3) +%!error poisspdf (ones(3),ones(2)) +%!error poisspdf (ones(2),ones(3)) +%!error poisspdf (i, 2) +%!error poisspdf (2, i) +
--- a/scripts/statistics/distributions/poissrnd.m +++ b/scripts/statistics/distributions/poissrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,73 +18,103 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} poissrnd (@var{lambda}, @var{r}, @var{c}) -## Return an @var{r} by @var{c} matrix of random samples from the -## Poisson distribution with parameter @var{lambda}, which must be a -## scalar or of size @var{r} by @var{c}. +## @deftypefn {Function File} {} poissrnd (@var{lambda}) +## @deftypefnx {Function File} {} poissrnd (@var{lambda}, @var{r}) +## @deftypefnx {Function File} {} poissrnd (@var{lambda}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} poissrnd (@var{lambda}, [@var{sz}]) +## Return a matrix of random samples from the Poisson distribution with +## parameter @var{lambda}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the size of @var{lambda}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{lambda}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the Poisson distribution -function rnd = poissrnd (lambda, r, c) - - if (nargin == 3) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("poissrnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("poissrnd: C must be a positive integer"); - endif - sz = [r, c]; +function rnd = poissrnd (lambda, varargin) - if (any (size (lambda) != 1) - && ((length (size (lambda)) != length (sz)) || any (size (lambda) != sz))) - error ("poissrnd: LAMBDA must be scalar or of size [R, C]"); - endif - elseif (nargin == 2) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("poissrnd: R must be a positive integer or vector"); - endif - - if (any (size (lambda) != 1) - && ((length (size (lambda)) != length (sz)) || any (size (lambda) != sz))) - error ("poissrnd: LAMBDA must be scalar or of size sz"); - endif - elseif (nargin == 1) - sz = size (lambda); - else + if (nargin < 1) print_usage (); endif - if (isscalar (lambda)) + if (nargin == 1) + sz = size (lambda); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("poissrnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("poissrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif - if (!(lambda >= 0) || !(lambda < Inf)) - rnd = NaN (sz); - elseif (lambda > 0 && lambda < Inf) - rnd = randp(lambda, sz); + if (!isscalar (lambda) && !isequal (size (lambda), sz)) + error ("poissrnd: LAMBDA must be scalar or of size SZ"); + endif + + if (iscomplex (lambda)) + error ("poissrnd: LAMBDA must not be complex"); + endif + + if (isa (lambda, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (lambda)) + if (lambda > 0 && lambda < Inf) + rnd = randp (lambda, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif else - rnd = zeros (sz); + rnd = NaN (sz, cls); endif else - rnd = zeros (sz); + rnd = NaN (sz, cls); - k = find (!(lambda >= 0) | !(lambda < Inf)); - if (any (k)) - rnd(k) = NaN; - endif - - k = find ((lambda > 0) & (lambda < Inf)); - if (any (k)) - rnd(k) = randp(lambda(k), size(k)); - endif + k = (lambda > 0) & (lambda < Inf); + rnd(k) = randp (lambda(k)); endif endfunction + + +%!assert(size (poissrnd (2)), [1, 1]); +%!assert(size (poissrnd (ones(2,1))), [2, 1]); +%!assert(size (poissrnd (ones(2,2))), [2, 2]); +%!assert(size (poissrnd (1, 3)), [3, 3]); +%!assert(size (poissrnd (1, [4 1])), [4, 1]); +%!assert(size (poissrnd (1, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (poissrnd (2)), "double"); +%!assert(class (poissrnd (single(2))), "single"); +%!assert(class (poissrnd (single([2 2]))), "single"); + +%% Test input validation +%!error poissrnd () +%!error poissrnd (1, -1) +%!error poissrnd (1, ones(2)) +%!error poissrnd (1, 2, ones(2)) +%!error poissrnd (i) +%!error poissrnd (1, 2, -1) +%!error poissrnd (1, [2 -1 2]) +%!error poissrnd (ones(2,2), 3) +%!error poissrnd (ones(2,2), [3, 2]) +%!error poissrnd (ones(2,2), 2, 3) +
--- a/scripts/statistics/distributions/stdnormal_cdf.m +++ b/scripts/statistics/distributions/stdnormal_cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,8 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} stdnormal_cdf (@var{x}) -## For each component of @var{x}, compute the CDF of the standard normal -## distribution at @var{x}. +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the standard normal distribution +## (mean = 0, standard deviation = 1). ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -31,9 +33,8 @@ print_usage (); endif - sz = size (x); - if (numel(x) == 0) - error ("stdnormal_cdf: X must not be empty"); + if (iscomplex (x)) + error ("stdnormal_cdf: X must not be complex"); endif cdf = erfc (x / (-sqrt(2))) / 2; @@ -41,5 +42,16 @@ endfunction +%!shared x,y +%! x = [-Inf 0 1 Inf]; +%! y = [0, 0.5, 1/2*(1+erf(1/sqrt(2))), 1]; +%!assert(stdnormal_cdf ([x, NaN]), [y, NaN]); +%% Test class of input preserved +%!assert(stdnormal_cdf (single([x, NaN])), single([y, NaN]), eps("single")); +%% Test input validation +%!error stdnormal_cdf () +%!error stdnormal_cdf (1,2) +%!error stdnormal_cdf (i) +
--- a/scripts/statistics/distributions/stdnormal_inv.m +++ b/scripts/statistics/distributions/stdnormal_inv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,8 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} stdnormal_inv (@var{x}) -## For each component of @var{x}, compute the quantile (the -## inverse of the CDF) at @var{x} of the standard normal distribution. +## For each element of @var{x}, compute the quantile (the +## inverse of the CDF) at @var{x} of the standard normal distribution +## (mean = 0, standard deviation = 1). ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -31,6 +33,25 @@ print_usage (); endif + if (iscomplex (x)) + error ("stdnormal_inv: X must not be complex"); + endif + inv = sqrt (2) * erfinv (2 * x - 1); endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(stdnormal_inv (x), [NaN -Inf 0 Inf NaN]); + +%% Test class of input preserved +%!assert(stdnormal_inv ([x, NaN]), [NaN -Inf 0 Inf NaN NaN]); +%!assert(stdnormal_inv (single([x, NaN])), single([NaN -Inf 0 Inf NaN NaN])); + +%% Test input validation +%!error stdnormal_inv () +%!error stdnormal_inv (1,2) +%!error stdnormal_inv (i) +
--- a/scripts/statistics/distributions/stdnormal_pdf.m +++ b/scripts/statistics/distributions/stdnormal_pdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,7 +20,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} stdnormal_pdf (@var{x}) ## For each element of @var{x}, compute the probability density function -## (PDF) of the standard normal distribution at @var{x}. +## (PDF) at @var{x} of the standard normal distribution (mean = 0, +## standard deviation = 1). ## @end deftypefn ## Author: TT <Teresa.Twaroch@ci.tuwien.ac.at> @@ -31,17 +33,25 @@ print_usage (); endif - sz = size(x); - pdf = zeros (sz); - - k = find (isnan (x)); - if (any (k)) - pdf(k) = NaN; + if (iscomplex (x)) + error ("stdnormal_pdf: X must not be complex"); endif - k = find (!isinf (x)); - if (any (k)) - pdf (k) = (2 * pi)^(- 1/2) * exp (- x(k) .^ 2 / 2); - endif + pdf = (2 * pi)^(- 1/2) * exp (- x .^ 2 / 2); endfunction + + +%!shared x,y +%! x = [-Inf 0 1 Inf]; +%! y = 1/sqrt(2*pi)*exp (-x.^2/2); +%!assert(stdnormal_pdf ([x, NaN]), [y, NaN], eps); + +%% Test class of input preserved +%!assert(stdnormal_pdf (single([x, NaN])), single([y, NaN]), eps("single")); + +%% Test input validation +%!error stdnormal_pdf () +%!error stdnormal_pdf (1,2) +%!error stdnormal_pdf (i) +
--- a/scripts/statistics/distributions/stdnormal_rnd.m +++ b/scripts/statistics/distributions/stdnormal_rnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,39 +18,57 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} stdnormal_rnd (@var{r}, @var{c}) -## @deftypefnx {Function File} {} stdnormal_rnd (@var{sz}) -## Return an @var{r} by @var{c} or @code{size (@var{sz})} matrix of -## random numbers from the standard normal distribution. +## @deftypefn {Function File} {} stdnormal_rnd (@var{r}) +## @deftypefnx {Function File} {} stdnormal_rnd (@var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} stdnormal_rnd ([@var{sz}]) +## Return a matrix of random samples from the standard normal distribution +## (mean = 0, standard deviation = 1). +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the standard normal distribution -function rnd = stdnormal_rnd (r, c) +function rnd = stdnormal_rnd (varargin) - if (nargin != 1 && nargin != 2) + if (nargin < 1) print_usage (); endif - if (nargin == 2) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("stdnormal_rnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("stdnormal_rnd: C must be a positive integer"); + if (nargin == 1) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("stdnormal_rnd: dimension vector must be row vector of non-negative integers"); endif - sz = [r, c]; - else - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("stdnormal_rnd: R must be a positive integer or vector"); + elseif (nargin > 1) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("stdnormal_rnd: dimensions must be non-negative integers"); endif + sz = [varargin{:}]; endif rnd = randn (sz); endfunction + + +%!assert(size (stdnormal_rnd (3)), [3, 3]); +%!assert(size (stdnormal_rnd ([4 1])), [4, 1]); +%!assert(size (stdnormal_rnd (4,1)), [4, 1]); + +%% Test input validation +%!error stdnormal_rnd () +%!error stdnormal_rnd (-1) +%!error stdnormal_rnd (ones(2)) +%!error stdnormal_rnd ([2 -1 2]) +%!error stdnormal_rnd (1, ones(2)) +%!error stdnormal_rnd (1, -1) +
--- a/scripts/statistics/distributions/tcdf.m +++ b/scripts/statistics/distributions/tcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -35,33 +36,59 @@ if (!isscalar (n)) [retval, x, n] = common_size (x, n); if (retval > 0) - error ("tcdf: X and N must be of common size or scalar"); + error ("tcdf: X and N must be of common size or scalars"); endif endif - cdf = zeros (size (x)); + if (iscomplex (x) || iscomplex (n)) + error ("tcdf: X and N must not be complex"); + endif - k = find (isnan (x) | !(n > 0)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (n, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x == Inf) & (n > 0)); - if (any (k)) - cdf(k) = 1; + k = !isinf (x) & (n > 0); + if (isscalar (n)) + cdf(k) = betainc (1 ./ (1 + x(k) .^ 2 / n), n/2, 1/2) / 2; + else + cdf(k) = betainc (1 ./ (1 + x(k) .^ 2 ./ n(k)), n(k)/2, 1/2) / 2; + endif + k &= (x > 0); + if (any (k(:))) + cdf(k) = 1 - cdf(k); endif - k = find ((x > -Inf) & (x < Inf) & (n > 0)); - if (any (k)) - if (isscalar (n)) - cdf(k) = betainc (1 ./ (1 + x(k) .^ 2 ./ n), n / 2, 1 / 2) / 2; - else - cdf(k) = betainc (1 ./ (1 + x(k) .^ 2 ./ n(k)), n(k) / 2, 1 / 2) / 2; - endif - ind = find (x(k) > 0); - if (any (ind)) - cdf(k(ind)) = 1 - cdf(k(ind)); - endif - endif + k = isnan (x) | !(n > 0); + cdf(k) = NaN; + + k = (x == Inf) & (n > 0); + cdf(k) = 1; endfunction + + +%!shared x,y +%! x = [-Inf 0 1 Inf]; +%! y = [0 1/2 3/4 1]; +%!assert(tcdf (x, ones(1,4)), y, eps); +%!assert(tcdf (x, 1), y, eps); +%!assert(tcdf (x, [0 1 NaN 1]), [NaN 1/2 NaN 1], eps); +%!assert(tcdf ([x(1:2) NaN x(4)], 1), [y(1:2) NaN y(4)], eps); + +%% Test class of input preserved +%!assert(tcdf ([x, NaN], 1), [y, NaN], eps); +%!assert(tcdf (single([x, NaN]), 1), single([y, NaN]), eps("single")); +%!assert(tcdf ([x, NaN], single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error tcdf () +%!error tcdf (1) +%!error tcdf (1,2,3) +%!error tcdf (ones(3),ones(2)) +%!error tcdf (ones(2),ones(3)) +%!error tcdf (i, 2) +%!error tcdf (2, i) +
--- a/scripts/statistics/distributions/tinv.m +++ b/scripts/statistics/distributions/tinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,11 +19,10 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} tinv (@var{x}, @var{n}) -## For each probability value @var{x}, compute the inverse of the -## cumulative distribution function (CDF) of the t (Student) -## distribution with degrees of freedom @var{n}. This function is -## analogous to looking in a table for the t-value of a single-tailed -## distribution. +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the t (Student) distribution with @var{n} +## degrees of freedom. This function is analogous to looking in a table +## for the t-value of a single-tailed distribution. ## @end deftypefn ## For very large n, the "correct" formula does not really work well, @@ -41,44 +41,68 @@ if (!isscalar (n)) [retval, x, n] = common_size (x, n); if (retval > 0) - error ("tinv: X and N must be of common size or scalar"); + error ("tinv: X and N must be of common size or scalars"); endif endif - inv = zeros (size (x)); - - k = find ((x < 0) | (x > 1) | isnan (x) | !(n > 0)); - if (any (k)) - inv(k) = NaN; + if (iscomplex (x) || iscomplex (n)) + error ("tinv: X and N must not be complex"); endif - k = find ((x == 0) & (n > 0)); - if (any (k)) - inv(k) = -Inf; - endif - - k = find ((x == 1) & (n > 0)); - if (any (k)) - inv(k) = Inf; + if (isa (x, "single") || isa (n, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find ((x > 0) & (x < 1) & (n > 0) & (n < 10000)); - if (any (k)) - if (isscalar (n)) - inv(k) = (sign (x(k) - 1/2) - .* sqrt (n .* (1 ./ betainv (2*min (x(k), 1 - x(k)), - n/2, 1/2) - 1))); - else + k = (x == 0) & (n > 0); + inv(k) = -Inf; + + k = (x == 1) & (n > 0); + inv(k) = Inf; + + if (isscalar (n)) + k = (x > 0) & (x < 1); + if ((n > 0) && (n < 10000)) inv(k) = (sign (x(k) - 1/2) - .* sqrt (n(k) .* (1 ./ betainv (2*min (x(k), 1 - x(k)), - n(k)/2, 1/2) - 1))); + .* sqrt (n * (1 ./ betainv (2*min (x(k), 1 - x(k)), + n/2, 1/2) - 1))); + elseif (n >= 10000) + ## For large n, use the quantiles of the standard normal + inv(k) = stdnormal_inv (x(k)); endif - endif + else + k = (x > 0) & (x < 1) & (n > 0) & (n < 10000); + inv(k) = (sign (x(k) - 1/2) + .* sqrt (n(k) .* (1 ./ betainv (2*min (x(k), 1 - x(k)), + n(k)/2, 1/2) - 1))); - ## For large n, use the quantiles of the standard normal - k = find ((x > 0) & (x < 1) & (n >= 10000)); - if (any (k)) + ## For large n, use the quantiles of the standard normal + k = (x > 0) & (x < 1) & (n >= 10000); inv(k) = stdnormal_inv (x(k)); endif endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(tinv (x, ones(1,5)), [NaN -Inf 0 Inf NaN]); +%!assert(tinv (x, 1), [NaN -Inf 0 Inf NaN], eps); +%!assert(tinv (x, [1 0 NaN 1 1]), [NaN NaN NaN Inf NaN], eps); +%!assert(tinv ([x(1:2) NaN x(4:5)], 1), [NaN -Inf NaN Inf NaN]); + +%% Test class of input preserved +%!assert(tinv ([x, NaN], 1), [NaN -Inf 0 Inf NaN NaN], eps); +%!assert(tinv (single([x, NaN]), 1), single([NaN -Inf 0 Inf NaN NaN]), eps("single")); +%!assert(tinv ([x, NaN], single(1)), single([NaN -Inf 0 Inf NaN NaN]), eps("single")); + +%% Test input validation +%!error tinv () +%!error tinv (1) +%!error tinv (1,2,3) +%!error tinv (ones(3),ones(2)) +%!error tinv (ones(2),ones(3)) +%!error tinv (i, 2) +%!error tinv (2, i) +
--- a/scripts/statistics/distributions/tpdf.m +++ b/scripts/statistics/distributions/tpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -35,26 +36,58 @@ if (!isscalar (n)) [retval, x, n] = common_size (x, n); if (retval > 0) - error ("tpdf: X and N must be of common size or scalar"); + error ("tpdf: X and N must be of common size or scalars"); endif endif - pdf = zeros (size (x)); + if (iscomplex (x) || iscomplex (n)) + error ("tpdf: X and N must not be complex"); + endif - k = find (isnan (x) | !(n > 0) | !(n < Inf)); - if (any (k)) - pdf(k) = NaN; + if (isa (x, "single") || isa (n, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); endif - k = find (!isinf (x) & !isnan (x) & (n > 0) & (n < Inf)); - if (any (k)) - if (isscalar (n)) - pdf(k) = (exp (- (n + 1) .* log (1 + x(k) .^ 2 ./ n)/2) - / (sqrt (n) * beta (n/2, 1/2))); - else - pdf(k) = (exp (- (n(k) + 1) .* log (1 + x(k) .^ 2 ./ n(k))/2) - ./ (sqrt (n(k)) .* beta (n(k)/2, 1/2))); - endif + k = isnan (x) | !(n > 0) | !(n < Inf); + pdf(k) = NaN; + + k = !isinf (x) & !isnan (x) & (n > 0) & (n < Inf); + if (isscalar (n)) + pdf(k) = (exp (- (n + 1) * log (1 + x(k) .^ 2 / n)/2) + / (sqrt (n) * beta (n/2, 1/2))); + else + pdf(k) = (exp (- (n(k) + 1) .* log (1 + x(k) .^ 2 ./ n(k))/2) + ./ (sqrt (n(k)) .* beta (n(k)/2, 1/2))); endif endfunction + + +%!test +%! x = rand (10,1); +%! y = 1./(pi * (1 + x.^2)); +%! assert(tpdf (x, 1), y, 5*eps); + +%!shared x,y +%! x = [-Inf 0 0.5 1 Inf]; +%! y = 1./(pi * (1 + x.^2)); +%!assert(tpdf (x, ones(1,5)), y, eps); +%!assert(tpdf (x, 1), y, eps); +%!assert(tpdf (x, [0 NaN 1 1 1]), [NaN NaN y(3:5)], eps); + +%% Test class of input preserved +%!assert(tpdf ([x, NaN], 1), [y, NaN], eps); +%!assert(tpdf (single([x, NaN]), 1), single([y, NaN]), eps("single")); +%!assert(tpdf ([x, NaN], single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error tpdf () +%!error tpdf (1) +%!error tpdf (1,2,3) +%!error tpdf (ones(3),ones(2)) +%!error tpdf (ones(2),ones(3)) +%!error tpdf (i, 2) +%!error tpdf (2, i) +
--- a/scripts/statistics/distributions/trnd.m +++ b/scripts/statistics/distributions/trnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,74 +18,100 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} trnd (@var{n}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} trnd (@var{n}, @var{sz}) -## Return an @var{r} by @var{c} matrix of random samples from the t -## (Student) distribution with @var{n} degrees of freedom. @var{n} must -## be a scalar or of size @var{r} by @var{c}. Or if @var{sz} is a -## vector create a matrix of size @var{sz}. +## @deftypefn {Function File} {} trnd (@var{n}) +## @deftypefnx {Function File} {} trnd (@var{n}, @var{r}) +## @deftypefnx {Function File} {} trnd (@var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} trnd (@var{n}, [@var{sz}]) +## Return a matrix of random samples from the t (Student) distribution with +## @var{n} degrees of freedom. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the size of @var{n}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{n}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the t distribution -function rnd = trnd (n, r, c) - - if (nargin == 3) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("trnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("trnd: C must be a positive integer"); - endif - sz = [r, c]; +function rnd = trnd (n, varargin) - if (any (size (n) != 1) - && ((length (size (n)) != length (sz)) || any (size (n) != sz))) - error ("trnd: N must be scalar or of size SZ"); - endif - elseif (nargin == 2) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("trnd: R must be a positive integer or vector"); - endif - - if (any (size (n) != 1) - && ((length (size (n)) != length (sz)) || any (size (n) != sz))) - error ("trnd: N must be scalar or of size SZ"); - endif - elseif (nargin == 1) - sz = size (n); - else + if (nargin < 1) print_usage (); endif + if (nargin == 1) + sz = size (n); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("trnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("trnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (n) && !isequal (size (n), sz)) + error ("trnd: N must be scalar or of size SZ"); + endif + + if (iscomplex (n)) + error ("trnd: N must not be complex"); + endif + + if (isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif + if (isscalar (n)) - if (!(n > 0) || !(n < Inf)) - rnd = NaN (sz); - elseif ((n > 0) && (n < Inf)) - rnd = randn(sz) ./ sqrt(2*randg(n/2,sz)./n); + if ((n > 0) && (n < Inf)) + rnd = randn (sz) ./ sqrt (2*randg (n/2, sz) / n); else - rnd = zeros (size (n)); + rnd = NaN (sz, cls); endif else - rnd = zeros (size (n)); + rnd = NaN (sz, cls); - k = find (!(n > 0) | !(n < Inf)); - if (any (k)) - rnd(k) = NaN; - endif - - k = find ((n > 0) & (n < Inf)); - if (any (k)) - rnd(k) = randn(size(k)) ./ sqrt(2*randg(n(k)/2,size(k))./n(k)); - endif + k = (n > 0) & (n < Inf); + rnd(k) = randn (sum (k(:)), 1) ./ sqrt (2*randg (n(k)/2) ./ n(k))(:); endif endfunction + + +%!assert(size (trnd (2)), [1, 1]); +%!assert(size (trnd (ones(2,1))), [2, 1]); +%!assert(size (trnd (ones(2,2))), [2, 2]); +%!assert(size (trnd (1, 3)), [3, 3]); +%!assert(size (trnd (1, [4 1])), [4, 1]); +%!assert(size (trnd (1, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (trnd (1)), "double"); +%!assert(class (trnd (single(1))), "single"); +%!assert(class (trnd (single([1 1]))), "single"); + +%% Test input validation +%!error trnd () +%!error trnd (1, -1) +%!error trnd (1, ones(2)) +%!error trnd (i) +%!error trnd (1, [2 -1 2]) +%!error trnd (1, 2, ones(2)) +%!error trnd (1, 2, -1) +%!error trnd (ones(2,2), 3) +%!error trnd (ones(2,2), [3, 2]) +%!error trnd (ones(2,2), 2, 3) +
--- a/scripts/statistics/distributions/unidcdf.m +++ b/scripts/statistics/distributions/unidcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 2007-2011 David Bateman ## ## This file is part of Octave. @@ -17,26 +18,72 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unidcdf (@var{x}, @var{v}) +## @deftypefn {Function File} {} unidcdf (@var{x}, @var{n}) ## For each element of @var{x}, compute the cumulative distribution -## function (CDF) at @var{x} of a discrete uniform distribution which -## assumes the values in @var{v} with equal probability. -## If @var{v} is a scalar then @code{1/@var{v}} is the probability of a -## single element. +## function (CDF) at @var{x} of a discrete uniform distribution which assumes +## the integer values 1--@var{n} with equal probability. ## @end deftypefn -function cdf = unidcdf (x, v) +function cdf = unidcdf (x, n) if (nargin != 2) print_usage (); endif - if (isscalar(v)) - v = [1:v].'; + if (! isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("unidcdf: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("unidcdf: X and N must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single")) + cdf = zeros (size (x), "single"); else - v = v(:); + cdf = zeros (size (x)); + endif + + knan = isnan (x) | ! (n > 0 & n == fix (n)); + if (any (knan(:))) + cdf(knan) = NaN; endif - cdf = discrete_cdf (x, v, ones(size(v))); + k = (x >= n) & !knan; + cdf(k) = 1; + + k = (x >= 1) & (x < n) & !knan; + if (isscalar (n)) + cdf(k) = floor (x(k)) / n; + else + cdf(k) = floor (x(k)) ./ n(k); + endif endfunction + + +%!shared x,y +%! x = [0 1 2.5 10 11]; +%! y = [0, 0.1 0.2 1.0 1.0]; +%!assert(unidcdf (x, 10*ones(1,5)), y); +%!assert(unidcdf (x, 10), y); +%!assert(unidcdf (x, 10*[0 1 NaN 1 1]), [NaN 0.1 NaN y(4:5)]); +%!assert(unidcdf ([x(1:2) NaN Inf x(5)], 10), [y(1:2) NaN 1 y(5)]); + +%% Test class of input preserved +%!assert(unidcdf ([x, NaN], 10), [y, NaN]); +%!assert(unidcdf (single([x, NaN]), 10), single([y, NaN])); +%!assert(unidcdf ([x, NaN], single(10)), single([y, NaN])); + +%% Test input validation +%!error unidcdf () +%!error unidcdf (1) +%!error unidcdf (1,2,3) +%!error unidcdf (ones(3),ones(2)) +%!error unidcdf (ones(2),ones(3)) +%!error unidcdf (i, 2) +%!error unidcdf (2, i) +
--- a/scripts/statistics/distributions/unidinv.m +++ b/scripts/statistics/distributions/unidinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 2007-2011 David Bateman ## ## This file is part of Octave. @@ -17,25 +18,64 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unidinv (@var{x}, @var{v}) -## For each component of @var{x}, compute the quantile (the inverse of -## the CDF) at @var{x} of the discrete uniform distribution which assumes the -## values in @var{v} with equal probability. -## If @var{v} is a scalar then @code{1/@var{v}} is the probability of a -## single element. +## @deftypefn {Function File} {} unidinv (@var{x}, @var{n}) +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the discrete uniform distribution which assumes +## the integer values 1--@var{n} with equal probability. ## @end deftypefn -function inv = unidinv (x, v) +function inv = unidinv (x, n) if (nargin != 2) print_usage (); endif - if (isscalar(v)) - v = [1:v].'; + if (! isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("unidcdf: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("unidinv: X and N must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single")) + inv = NaN (size (x), "single"); else - v = v(:); + inv = NaN (size (x)); + endif + + ## For Matlab compatibility, unidinv(0) = NaN + k = (x > 0) & (x <= 1) & (n > 0 & n == fix (n)); + if (isscalar (n)) + inv(k) = floor (x(k) * n); + else + inv(k) = floor (x(k) .* n(k)); endif - inv = discrete_inv (x, v, ones(size(v))); endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(unidinv (x, 10*ones(1,5)), [NaN NaN 5 10 NaN], eps); +%!assert(unidinv (x, 10), [NaN NaN 5 10 NaN], eps); +%!assert(unidinv (x, 10*[0 1 NaN 1 1]), [NaN NaN NaN 10 NaN], eps); +%!assert(unidinv ([x(1:2) NaN x(4:5)], 10), [NaN NaN NaN 10 NaN], eps); + +%% Test class of input preserved +%!assert(unidinv ([x, NaN], 10), [NaN NaN 5 10 NaN NaN], eps); +%!assert(unidinv (single([x, NaN]), 10), single([NaN NaN 5 10 NaN NaN]), eps); +%!assert(unidinv ([x, NaN], single(10)), single([NaN NaN 5 10 NaN NaN]), eps); + +%% Test input validation +%!error unidinv () +%!error unidinv (1) +%!error unidinv (1,2,3) +%!error unidinv (ones(3),ones(2)) +%!error unidinv (ones(2),ones(3)) +%!error unidinv (i, 2) +%!error unidinv (2, i) +
--- a/scripts/statistics/distributions/unidpdf.m +++ b/scripts/statistics/distributions/unidpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 2007-2011 David Bateman ## ## This file is part of Octave. @@ -17,25 +18,70 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unidpdf (@var{x}, @var{v}) +## @deftypefn {Function File} {} unidpdf (@var{x}, @var{n}) ## For each element of @var{x}, compute the probability density function ## (PDF) at @var{x} of a discrete uniform distribution which assumes -## the values in @var{v} with equal probability. -## If @var{v} is a scalar then @code{1/@var{v}} is the probability of a -## single element. +## the integer values 1--@var{n} with equal probability. +## +## Warning: The underlying implementation uses the double class and +## will only be accurate for @var{n} @leq{} @code{bitmax} +## (@w{@math{2^{53} - 1}} on IEEE-754 compatible systems). ## @end deftypefn -function pdf = unidpdf (x, v) +function pdf = unidpdf (x, n) if (nargin != 2) print_usage (); endif - if (isscalar(v)) - v = [1:v].'; + if (! isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("unidpdf: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("unidpdf: X and N must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single")) + pdf = zeros (size (x), "single"); else - v = v(:); + pdf = zeros (size (x)); endif - pdf = discrete_pdf (x, v, ones(size(v))); + k = isnan (x) | ! (n > 0 & n == fix (n)); + pdf(k) = NaN; + + k = !k & (x >= 1) & (x <= n) & (x == fix (x)); + if (isscalar (n)) + pdf(k) = 1 / n; + else + pdf(k) = 1 ./ n(k); + endif + endfunction + + +%!shared x,y +%! x = [-1 0 1 2 10 11]; +%! y = [0 0 0.1 0.1 0.1 0]; +%!assert(unidpdf (x, 10*ones(1,6)), y); +%!assert(unidpdf (x, 10), y); +%!assert(unidpdf (x, 10*[0 NaN 1 1 1 1]), [NaN NaN y(3:6)]); +%!assert(unidpdf ([x, NaN], 10), [y, NaN]); + +%% Test class of input preserved +%!assert(unidpdf (single([x, NaN]), 10), single([y, NaN])); +%!assert(unidpdf ([x, NaN], single(10)), single([y, NaN])); + +%% Test input validation +%!error unidpdf () +%!error unidpdf (1) +%!error unidpdf (1,2,3) +%!error unidpdf (ones(3),ones(2)) +%!error unidpdf (ones(2),ones(3)) +%!error unidpdf (i, 2) +%!error unidpdf (2, i) +
--- a/scripts/statistics/distributions/unidrnd.m +++ b/scripts/statistics/distributions/unidrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 2005-2011 John W. Eaton ## ## This file is part of Octave. @@ -17,44 +18,94 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unidrnd (@var{mx}); -## @deftypefnx {Function File} {} unidrnd (@var{mx}, @var{v}); -## @deftypefnx {Function File} {} unidrnd (@var{mx}, @var{m}, @var{n}, @dots{}); -## Return random values from a discrete uniform distribution with maximum -## value(s) given by the integer @var{mx} (which may be a scalar or -## multi-dimensional array). +## @deftypefn {Function File} {} unidrnd (@var{n}) +## @deftypefnx {Function File} {} unidrnd (@var{n}, @var{r}) +## @deftypefnx {Function File} {} unidrnd (@var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} unidrnd (@var{n}, [@var{sz}]) +## Return a matrix of random samples from the discrete uniform distribution +## which assumes the integer values 1--@var{n} with equal probability. +## @var{n} may be a scalar or a multi-dimensional array. ## -## If @var{mx} is a scalar, the size of the result is specified by -## the vector @var{v}, or by the optional arguments @var{m}, @var{n}, -## @dots{}. Otherwise, the size of the result is the same as the size -## of @var{mx}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{n}. ## @end deftypefn ## Author: jwe -function retval = unidrnd (n, varargin) +function rnd = unidrnd (n, varargin) + + if (nargin < 1) + print_usage (); + endif + if (nargin == 1) - dims = size (n); + sz = size (n); elseif (nargin == 2) - if (rows (varargin{1}) == 1 && columns (varargin{1}) > 1) - dims = varargin{1}; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("unidrnd: invalid dimension vector"); + error ("unidrnd: dimension vector must be row vector of non-negative integers"); endif elseif (nargin > 2) - for i = 1:nargin-1 - if (! isscalar (varargin{i})) - error ("unidrnd: expecting scalar dimensions"); - endif - endfor - dims = [varargin{:}]; + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("unidrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (n) && !isequal (size (n), sz)) + error ("unidrnd: N must be scalar or of size SZ"); + endif + + if (iscomplex (n)) + error ("unidrnd: N must not be complex"); + endif + + if (isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (n)) + if (n > 0 && n == fix (n)) + rnd = ceil (rand (sz) * n); + else + rnd = NaN (sz, cls); + endif else - print_usage (); + rnd = ceil (rand (sz) .* n); + + k = ! (n > 0 & n == fix (n)); + rnd(k) = NaN; endif - if (isscalar (n) - || (length (size (n)) == length (dims) && all (size (n) == dims))) - retval = ceil (rand (dims) .* n); - else - error ("unidrnd: dimension mismatch"); - endif + endfunction + + +%!assert(size (unidrnd (2)), [1, 1]); +%!assert(size (unidrnd (ones(2,1))), [2, 1]); +%!assert(size (unidrnd (ones(2,2))), [2, 2]); +%!assert(size (unidrnd (10, [4 1])), [4, 1]); +%!assert(size (unidrnd (10, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (unidrnd (2)), "double"); +%!assert(class (unidrnd (single(2))), "single"); +%!assert(class (unidrnd (single([2 2]))), "single"); + +%% Test input validation +%!error unidrnd () +%!error unidrnd (10, [1;2;3]) +%!error unidrnd (10, 2, ones(2)) +%!error unidrnd (10*ones(2), 2, 1) +%!error unidrnd (i) +
--- a/scripts/statistics/distributions/unifcdf.m +++ b/scripts/statistics/distributions/unifcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,9 +18,11 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unifcdf (@var{x}, @var{a}, @var{b}) -## Return the CDF at @var{x} of the uniform distribution on [@var{a}, -## @var{b}], i.e., PROB (uniform (@var{a}, @var{b}) @leq{} x). +## @deftypefn {Function File} {} unifcdf (@var{x}) +## @deftypefnx {Function File} {} unifcdf (@var{x}, @var{a}, @var{b}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the uniform distribution on the interval +## [@var{a}, @var{b}]. ## ## Default values are @var{a} = 0, @var{b} = 1. ## @end deftypefn @@ -27,44 +30,69 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: CDF of the uniform distribution -function cdf = unifcdf (x, a, b) +function cdf = unifcdf (x, a = 0, b = 1) if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - a = 0; - b = 1; - endif - - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("unifcdf: X, A and B must be of common size or scalar"); + error ("unifcdf: X, A, and B must be of common size or scalars"); endif endif - sz = size (x); - cdf = zeros (sz); + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("unifcdf: X, A, and B must not be complex"); + endif - k = find (isnan (x) | !(a < b)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x >= b) & (a < b)); - if (any (k)) - cdf(k) = 1; - endif + k = isnan (x) | !(a < b); + cdf(k) = NaN; + + k = (x >= b) & (a < b); + cdf(k) = 1; - k = find ((x > a) & (x < b)); - if (any (k)) - if (isscalar (a) && isscalar(b)) - cdf(k) = (x(k) < b) .* (x(k) - a) ./ (b - a); - else - cdf(k) = (x(k) < b(k)) .* (x(k) - a(k)) ./ (b(k) - a(k)); - endif + k = (x > a) & (x < b); + if (isscalar (a) && isscalar (b)) + cdf(k) = (x(k) < b) .* (x(k) - a) / (b - a); + else + cdf(k) = (x(k) < b(k)) .* (x(k) - a(k)) ./ (b(k) - a(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2] + 1; +%! y = [0 0 0.5 1 1]; +%!assert(unifcdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(unifcdf (x, 1, 2*ones(1,5)), y); +%!assert(unifcdf (x, ones(1,5), 2), y); +%!assert(unifcdf (x, [2 1 NaN 1 1], 2), [NaN 0 NaN 1 1]); +%!assert(unifcdf (x, 1, 2*[0 1 NaN 1 1]), [NaN 0 NaN 1 1]); +%!assert(unifcdf ([x(1:2) NaN x(4:5)], 1, 2), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(unifcdf ([x, NaN], 1, 2), [y, NaN]); +%!assert(unifcdf (single([x, NaN]), 1, 2), single([y, NaN])); +%!assert(unifcdf ([x, NaN], single(1), 2), single([y, NaN])); +%!assert(unifcdf ([x, NaN], 1, single(2)), single([y, NaN])); + +%% Test input validation +%!error unifcdf () +%!error unifcdf (1,2) +%!error unifcdf (1,2,3,4) +%!error unifcdf (ones(3),ones(2),ones(2)) +%!error unifcdf (ones(2),ones(3),ones(2)) +%!error unifcdf (ones(2),ones(2),ones(3)) +%!error unifcdf (i, 2, 2) +%!error unifcdf (2, i, 2) +%!error unifcdf (2, 2, i) +
--- a/scripts/statistics/distributions/unifinv.m +++ b/scripts/statistics/distributions/unifinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,9 +18,11 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unifinv (@var{x}, @var{a}, @var{b}) +## @deftypefn {Function File} {} unifinv (@var{x}) +## @deftypefnx {Function File} {} unifinv (@var{x}, @var{a}, @var{b}) ## For each element of @var{x}, compute the quantile (the inverse of the -## CDF) at @var{x} of the uniform distribution on [@var{a}, @var{b}]. +## CDF) at @var{x} of the uniform distribution on the interval +## [@var{a}, @var{b}]. ## ## Default values are @var{a} = 0, @var{b} = 1. ## @end deftypefn @@ -27,39 +30,62 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Quantile function of the uniform distribution -function inv = unifinv (x, a, b) +function inv = unifinv (x, a = 0, b = 1) if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - a = 0; - b = 1; - endif - - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("unifinv: X, A and B must be of common size or scalar"); + error ("unifinv: X, A, and B must be of common size or scalars"); endif endif - sz = size (x); - inv = zeros (sz); - - k = find ((x < 0) | (x > 1) | isnan (x) | !(a < b)); - if (any (k)) - inv(k) = NaN; + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("unifinv: X, A, and B must not be complex"); endif - k = find ((x >= 0) & (x <= 1) & (a < b)); - if (any (k)) - if (isscalar (a) && isscalar(b)) - inv(k) = a + x(k) .* (b - a); - else - inv(k) = a(k) + x(k) .* (b(k) - a(k)); - endif + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + k = (x >= 0) & (x <= 1) & (a < b); + if (isscalar (a) && isscalar (b)) + inv(k) = a + x(k) * (b - a); + else + inv(k) = a(k) + x(k) .* (b(k) - a(k)); endif endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(unifinv (x, ones(1,5), 2*ones(1,5)), [NaN 1 1.5 2 NaN]); +%!assert(unifinv (x, 1, 2*ones(1,5)), [NaN 1 1.5 2 NaN]); +%!assert(unifinv (x, ones(1,5), 2), [NaN 1 1.5 2 NaN]); +%!assert(unifinv (x, [1 2 NaN 1 1], 2), [NaN NaN NaN 2 NaN]); +%!assert(unifinv (x, 1, 2*[1 0 NaN 1 1]), [NaN NaN NaN 2 NaN]); +%!assert(unifinv ([x(1:2) NaN x(4:5)], 1, 2), [NaN 1 NaN 2 NaN]); + +%% Test class of input preserved +%!assert(unifinv ([x, NaN], 1, 2), [NaN 1 1.5 2 NaN NaN]); +%!assert(unifinv (single([x, NaN]), 1, 2), single([NaN 1 1.5 2 NaN NaN])); +%!assert(unifinv ([x, NaN], single(1), 2), single([NaN 1 1.5 2 NaN NaN])); +%!assert(unifinv ([x, NaN], 1, single(2)), single([NaN 1 1.5 2 NaN NaN])); + +%% Test input validation +%!error unifinv () +%!error unifinv (1,2) +%!error unifinv (1,2,3,4) +%!error unifinv (ones(3),ones(2),ones(2)) +%!error unifinv (ones(2),ones(3),ones(2)) +%!error unifinv (ones(2),ones(2),ones(3)) +%!error unifinv (i, 2, 2) +%!error unifinv (2, i, 2) +%!error unifinv (2, 2, i) +
--- a/scripts/statistics/distributions/unifpdf.m +++ b/scripts/statistics/distributions/unifpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,9 +18,10 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unifpdf (@var{x}, @var{a}, @var{b}) -## For each element of @var{x}, compute the PDF at @var{x} of the uniform -## distribution on [@var{a}, @var{b}]. +## @deftypefn {Function File} {} unifpdf (@var{x}) +## @deftypefnx {Function File} {} unifpdf (@var{x}, @var{a}, @var{b}) +## For each element of @var{x}, compute the probability density function (PDF) +## at @var{x} of the uniform distribution on the interval [@var{a}, @var{b}]. ## ## Default values are @var{a} = 0, @var{b} = 1. ## @end deftypefn @@ -27,39 +29,65 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: PDF of the uniform distribution -function pdf = unifpdf (x, a, b) +function pdf = unifpdf (x, a = 0, b = 1) if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - a = 0; - b = 1; - endif - - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("unifpdf: X, A and B must be of common size or scalars"); + error ("unifpdf: X, A, and B must be of common size or scalars"); endif endif - sz = size (x); - pdf = zeros (sz); - - k = find (isnan (x) | !(a < b)); - if (any (k)) - pdf(k) = NaN; + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("unifpdf: X, A, and B must not be complex"); endif - k = find ((x > a) & (x < b)); - if (any (k)) - if (isscalar (a) && isscalar(b)) - pdf(k) = 1 ./ (b - a); - else - pdf(k) = 1 ./ (b(k) - a(k)); - endif + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | !(a < b); + pdf(k) = NaN; + + k = (x >= a) & (x <= b) & (a < b); + if (isscalar (a) && isscalar (b)) + pdf(k) = 1 / (b - a); + else + pdf(k) = 1 ./ (b(k) - a(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2] + 1; +%! y = [0 1 1 1 0]; +%!assert(unifpdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(unifpdf (x, 1, 2*ones(1,5)), y); +%!assert(unifpdf (x, ones(1,5), 2), y); +%!assert(unifpdf (x, [2 NaN 1 1 1], 2), [NaN NaN y(3:5)]); +%!assert(unifpdf (x, 1, 2*[0 NaN 1 1 1]), [NaN NaN y(3:5)]); +%!assert(unifpdf ([x, NaN], 1, 2), [y, NaN]); + +%% Test class of input preserved +%!assert(unifpdf (single([x, NaN]), 1, 2), single([y, NaN])); +%!assert(unifpdf (single([x, NaN]), single(1), 2), single([y, NaN])); +%!assert(unifpdf ([x, NaN], 1, single(2)), single([y, NaN])); + +%% Test input validation +%!error unifpdf () +%!error unifpdf (1,2) +%!error unifpdf (1,2,3,4) +%!error unifpdf (ones(3),ones(2),ones(2)) +%!error unifpdf (ones(2),ones(3),ones(2)) +%!error unifpdf (ones(2),ones(2),ones(3)) +%!error unifpdf (i, 2, 2) +%!error unifpdf (2, i, 2) +%!error unifpdf (2, 2, i) +
--- a/scripts/statistics/distributions/unifrnd.m +++ b/scripts/statistics/distributions/unifrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,75 +18,115 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unifrnd (@var{a}, @var{b}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} unifrnd (@var{a}, @var{b}, @var{sz}) -## Return an @var{r} by @var{c} or a @code{size (@var{sz})} matrix of -## random samples from the uniform distribution on [@var{a}, @var{b}]. -## Both @var{a} and @var{b} must be scalar or of size @var{r} by @var{c}. +## @deftypefn {Function File} {} unifrnd (@var{a}, @var{b}) +## @deftypefnx {Function File} {} unifrnd (@var{a}, @var{b}, @var{r}) +## @deftypefnx {Function File} {} unifrnd (@var{a}, @var{b}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} unifrnd (@var{a}, @var{b}, [@var{sz}]) +## Return a matrix of random samples from the uniform distribution on +## [@var{a}, @var{b}]. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{a} and @var{b}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{a} and @var{b}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the uniform distribution -function rnd = unifrnd (a, b, r, c) +function rnd = unifrnd (a, b, varargin) - if (nargin > 1) - if (!isscalar(a) || !isscalar(b)) - [retval, a, b] = common_size (a, b); - if (retval > 0) - error ("unifrnd: A and B must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, a, b] = common_size (a, b); + if (retval > 0) + error ("unifrnd: A and B must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("unifrnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("unifrnd: C must be a positive integer"); - endif - sz = [r, c]; - - if (any (size (a) != 1) - && (length (size (a)) != length (sz) || any (size (a) != sz))) - error ("unifrnd: A and B must be scalar or of size [R, C]"); - endif - elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("unifrnd: R must be a positive integer or vector"); - endif - - if (any (size (a) != 1) - && (length (size (a)) != length (sz) || any (size (a) != sz))) - error ("unifrnd: A and B must be scalar or of size SZ"); - endif - elseif (nargin == 2) - sz = size(a); - else - print_usage (); + if (iscomplex (a) || iscomplex (b)) + error ("unifrnd: A and B must not be complex"); endif - if (isscalar(a) && isscalar(b)) - if (find (!(-Inf < a) | !(a < b) | !(b < Inf))) - rnd = NaN(sz); + if (nargin == 2) + sz = size (a); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - rnd = a + (b - a) .* rand (sz); + error ("unifrnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("unifrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (a) && !isequal (size (a), sz)) + error ("unifrnd: A and B must be scalar or of size SZ"); + endif + + if (isa (a, "single") || isa (b, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (a) && isscalar (b)) + if ((-Inf < a) && (a < b) && (b < Inf)) + rnd = a + (b - a) * rand (sz); + else + rnd = NaN (sz, cls); endif else rnd = a + (b - a) .* rand (sz); - k = find (!(-Inf < a) | !(a < b) | !(b < Inf)); - if (any (k)) - rnd(k) = NaN; - endif + k = !(-Inf < a) | !(a < b) | !(b < Inf); + rnd(k) = NaN; endif endfunction + + +%!assert(size (unifrnd (1,2)), [1, 1]); +%!assert(size (unifrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (unifrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (unifrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (unifrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (unifrnd (1, 2, 3)), [3, 3]); +%!assert(size (unifrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (unifrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (unifrnd (1, 2)), "double"); +%!assert(class (unifrnd (single(1), 2)), "single"); +%!assert(class (unifrnd (single([1 1]), 2)), "single"); +%!assert(class (unifrnd (1, single(2))), "single"); +%!assert(class (unifrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error unifrnd () +%!error unifrnd (1) +%!error unifrnd (ones(3),ones(2)) +%!error unifrnd (ones(2),ones(3)) +%!error unifrnd (i, 2) +%!error unifrnd (2, i) +%!error unifrnd (1,2, -1) +%!error unifrnd (1,2, ones(2)) +%!error unifrnd (1, 2, [2 -1 2]) +%!error unifrnd (1,2, 1, ones(2)) +%!error unifrnd (1,2, 1, -1) +%!error unifrnd (ones(2,2), 2, 3) +%!error unifrnd (ones(2,2), 2, [3, 2]) +%!error unifrnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/wblcdf.m +++ b/scripts/statistics/distributions/wblcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,9 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} wblcdf (@var{x}, @var{scale}, @var{shape}) +## @deftypefn {Function File} {} wblcdf (@var{x}) +## @deftypefnx {Function File} {} wblcdf (@var{x}, @var{scale}) +## @deftypefnx {Function File} {} wblcdf (@var{x}, @var{scale}, @var{shape}) ## Compute the cumulative distribution function (CDF) at @var{x} of the ## Weibull distribution with scale parameter @var{scale} and shape ## parameter @var{shape}, which is @@ -28,59 +31,83 @@ ## @ifnottex ## ## @example -## 1 - exp(-(x/scale)^shape) +## 1 - exp (-(x/scale)^shape) ## @end example ## ## @noindent ## for @var{x} @geq{} 0. +## +## Default values are @var{scale} = 1, @var{shape} = 1. ## @end ifnottex ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: CDF of the Weibull distribution -function cdf = wblcdf (x, scale, shape) +function cdf = wblcdf (x, scale = 1, shape = 1) if (nargin < 1 || nargin > 3) print_usage (); endif - if (nargin < 3) - shape = 1; - endif - - if (nargin < 2) - scale = 1; - endif - if (!isscalar (shape) || !isscalar (scale)) [retval, x, shape, scale] = common_size (x, shape, scale); if (retval > 0) - error ("wblcdf: X, SCALE and SHAPE must be of common size or scalar"); + error ("wblcdf: X, SCALE, and SHAPE must be of common size or scalars"); endif endif - cdf = NaN (size (x)); - - ok = ((shape > 0) & (shape < Inf) & (scale > 0) & (scale < Inf)); + if (iscomplex (x) || iscomplex (scale) || iscomplex (shape)) + error ("wblcdf: X, SCALE, and SHAPE must not be complex"); + endif - k = find ((x <= 0) & ok); - if (any (k)) - cdf(k) = 0; + if (isa (x, "single") || isa (scale, "single") || isa (shape, "single")) + cdf = NaN (size (x), "single"); + else + cdf = NaN (size (x)); endif - k = find ((x > 0) & (x < Inf) & ok); - if (any (k)) - if (isscalar (shape) && isscalar (scale)) - cdf(k) = 1 - exp (- (x(k) / scale) .^ shape); - else - cdf(k) = 1 - exp (- (x(k) ./ scale(k)) .^ shape(k)); - endif - endif + ok = (shape > 0) & (shape < Inf) & (scale > 0) & (scale < Inf); + + k = (x <= 0) & ok; + cdf(k) = 0; - k = find ((x == Inf) & ok); - if (any (k)) - cdf(k) = 1; + k = (x == Inf) & ok; + cdf(k) = 1; + + k = (x > 0) & (x < Inf) & ok; + if (isscalar (shape) && isscalar (scale)) + cdf(k) = 1 - exp (- (x(k) / scale) .^ shape); + else + cdf(k) = 1 - exp (- (x(k) ./ scale(k)) .^ shape(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0, 1-exp(-x(2:4)), 1]; +%!assert(wblcdf (x, ones(1,5), ones(1,5)), y); +%!assert(wblcdf (x, 1, ones(1,5)), y); +%!assert(wblcdf (x, ones(1,5), 1), y); +%!assert(wblcdf (x, [0 1 NaN Inf 1], 1), [NaN 0 NaN NaN 1]); +%!assert(wblcdf (x, 1, [0 1 NaN Inf 1]), [NaN 0 NaN NaN 1]); +%!assert(wblcdf ([x(1:2) NaN x(4:5)], 1, 1), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(wblcdf ([x, NaN], 1, 1), [y, NaN]); +%!assert(wblcdf (single([x, NaN]), 1, 1), single([y, NaN])); +%!assert(wblcdf ([x, NaN], single(1), 1), single([y, NaN])); +%!assert(wblcdf ([x, NaN], 1, single(1)), single([y, NaN])); + +%% Test input validation +%!error wblcdf () +%!error wblcdf (1,2,3,4) +%!error wblcdf (ones(3),ones(2),ones(2)) +%!error wblcdf (ones(2),ones(3),ones(2)) +%!error wblcdf (ones(2),ones(2),ones(3)) +%!error wblcdf (i, 2, 2) +%!error wblcdf (2, i, 2) +%!error wblcdf (2, 2, i) +
--- a/scripts/statistics/distributions/wblinv.m +++ b/scripts/statistics/distributions/wblinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,57 +18,82 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} wblinv (@var{x}, @var{scale}, @var{shape}) +## @deftypefn {Function File} {} wblinv (@var{x}) +## @deftypefnx {Function File} {} wblinv (@var{x}, @var{scale}) +## @deftypefnx {Function File} {} wblinv (@var{x}, @var{scale}, @var{shape}) ## Compute the quantile (the inverse of the CDF) at @var{x} of the ## Weibull distribution with scale parameter @var{scale} and shape ## parameter @var{shape}. +## +## Default values are @var{scale} = 1, @var{shape} = 1. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Quantile function of the Weibull distribution -function inv = wblinv (x, scale, shape) +function inv = wblinv (x, scale = 1, shape = 1) if (nargin < 1 || nargin > 3) print_usage (); endif - if (nargin < 3) - shape = 1; - endif - - if (nargin < 2) - scale = 1; - endif - if (!isscalar (scale) || !isscalar (shape)) [retval, x, scale, shape] = common_size (x, scale, shape); if (retval > 0) - error ("wblinv: X, SCALE and SHAPE must be of common size or scalar"); + error ("wblinv: X, SCALE, and SHAPE must be of common size or scalars"); endif endif - inv = NaN (size (x)); - - ok = ((scale > 0) & (scale < Inf) & (shape > 0) & (shape < Inf)); + if (iscomplex (x) || iscomplex (scale) || iscomplex (shape)) + error ("wblinv: X, SCALE, and SHAPE must not be complex"); + endif - k = find ((x == 0) & ok); - if (any (k)) - inv(k) = -Inf; + if (isa (x, "single") || isa (scale, "single") || isa (shape, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find ((x > 0) & (x < 1) & ok); - if (any (k)) - if (isscalar (scale) && isscalar (shape)) - inv(k) = scale * (- log (1 - x(k))) .^ (1 / shape); - else - inv(k) = scale(k) .* (- log (1 - x(k))) .^ (1 ./ shape(k)); - endif - endif + ok = (scale > 0) & (scale < Inf) & (shape > 0) & (shape < Inf); + + k = (x == 0) & ok; + inv(k) = 0; - k = find ((x == 1) & ok); - if (any (k)) - inv(k) = Inf; + k = (x == 1) & ok; + inv(k) = Inf; + + k = (x > 0) & (x < 1) & ok; + if (isscalar (scale) && isscalar (shape)) + inv(k) = scale * (- log (1 - x(k))) .^ (1 / shape); + else + inv(k) = scale(k) .* (- log (1 - x(k))) .^ (1 ./ shape(k)); endif endfunction + + +%!shared x +%! x = [-1 0 0.63212055882855778 1 2]; +%!assert(wblinv (x, ones(1,5), ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(wblinv (x, 1, ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(wblinv (x, ones(1,5), 1), [NaN 0 1 Inf NaN], eps); +%!assert(wblinv (x, [1 -1 NaN Inf 1], 1), [NaN NaN NaN NaN NaN]); +%!assert(wblinv (x, 1, [1 -1 NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(wblinv ([x(1:2) NaN x(4:5)], 1, 1), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(wblinv ([x, NaN], 1, 1), [NaN 0 1 Inf NaN NaN], eps); +%!assert(wblinv (single([x, NaN]), 1, 1), single([NaN 0 1 Inf NaN NaN]), eps("single")); +%!assert(wblinv ([x, NaN], single(1), 1), single([NaN 0 1 Inf NaN NaN]), eps("single")); +%!assert(wblinv ([x, NaN], 1, single(1)), single([NaN 0 1 Inf NaN NaN]), eps("single")); + +%% Test input validation +%!error wblinv () +%!error wblinv (1,2,3,4) +%!error wblinv (ones(3),ones(2),ones(2)) +%!error wblinv (ones(2),ones(3),ones(2)) +%!error wblinv (ones(2),ones(2),ones(3)) +%!error wblinv (i, 2, 2) +%!error wblinv (2, i, 2) +%!error wblinv (2, 2, i) +
--- a/scripts/statistics/distributions/wblpdf.m +++ b/scripts/statistics/distributions/wblpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,9 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} wblpdf (@var{x}, @var{scale}, @var{shape}) +## @deftypefn {Function File} {} wblpdf (@var{x}) +## @deftypefnx {Function File} {} wblpdf (@var{x}, @var{scale}) +## @deftypefnx {Function File} {} wblpdf (@var{x}, @var{scale}, @var{shape}) ## Compute the probability density function (PDF) at @var{x} of the ## Weibull distribution with scale parameter @var{scale} and shape ## parameter @var{shape} which is given by @@ -27,57 +30,83 @@ ## @ifnottex ## ## @example -## shape * scale^(-shape) * x^(shape-1) * exp(-(x/scale)^shape) +## shape * scale^(-shape) * x^(shape-1) * exp (-(x/scale)^shape) ## @end example ## ## @end ifnottex ## @noindent ## for @var{x} @geq{} 0. +## +## Default values are @var{scale} = 1, @var{shape} = 1. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: PDF of the Weibull distribution -function pdf = wblpdf (x, scale, shape) +function pdf = wblpdf (x, scale = 1, shape = 1) if (nargin < 1 || nargin > 3) print_usage (); endif - if (nargin < 3) - shape = 1; - endif - - if (nargin < 2) - scale = 1; - endif - if (!isscalar (scale) || !isscalar (shape)) [retval, x, scale, shape] = common_size (x, scale, shape); if (retval > 0) - error ("wblpdf: X, SCALE and SHAPE must be of common size or scalar"); + error ("wblpdf: X, SCALE, and SHAPE must be of common size or scalars"); endif endif - pdf = NaN (size (x)); - ok = ((scale > 0) & (scale < Inf) & (shape > 0) & (shape < Inf)); + if (iscomplex (x) || iscomplex (scale) || iscomplex (shape)) + error ("wblpdf: X, SCALE, and SHAPE must not be complex"); + endif - k = find ((x > -Inf) & (x <= 0) & ok); - if (any (k)) - pdf(k) = 0; + if (isa (x, "single") || isa (scale, "single") || isa (shape, "single")) + pdf = NaN (size (x), "single"); + else + pdf = NaN (size (x)); endif - k = find ((x > 0) & (x < Inf) & ok); - if (any (k)) - if (isscalar (scale) && isscalar (shape)) - pdf(k) = (shape .* (scale .^ -shape) - .* (x(k) .^ (shape - 1)) - .* exp(- (x(k) / scale) .^ shape)); - else - pdf(k) = (shape(k) .* (scale(k) .^ -shape(k)) - .* (x(k) .^ (shape(k) - 1)) - .* exp(- (x(k) ./ scale(k)) .^ shape(k))); - endif + ok = ((scale > 0) & (scale < Inf) & (shape > 0) & (shape < Inf)); + + k = (x < 0) & ok; + pdf(k) = 0; + + k = (x >= 0) & (x < Inf) & ok; + if (isscalar (scale) && isscalar (shape)) + pdf(k) = (shape * (scale .^ -shape) + .* (x(k) .^ (shape - 1)) + .* exp (- (x(k) / scale) .^ shape)); + else + pdf(k) = (shape(k) .* (scale(k) .^ -shape(k)) + .* (x(k) .^ (shape(k) - 1)) + .* exp (- (x(k) ./ scale(k)) .^ shape(k))); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0, exp(-x(2:4)), NaN]; +%!assert(wblpdf (x, ones(1,5), ones(1,5)), y); +%!assert(wblpdf (x, 1, ones(1,5)), y); +%!assert(wblpdf (x, ones(1,5), 1), y); +%!assert(wblpdf (x, [0 NaN Inf 1 1], 1), [NaN NaN NaN y(4:5)]); +%!assert(wblpdf (x, 1, [0 NaN Inf 1 1]), [NaN NaN NaN y(4:5)]); +%!assert(wblpdf ([x, NaN], 1, 1), [y, NaN]); + +%% Test class of input preserved +%!assert(wblpdf (single([x, NaN]), 1, 1), single([y, NaN])); +%!assert(wblpdf ([x, NaN], single(1), 1), single([y, NaN])); +%!assert(wblpdf ([x, NaN], 1, single(1)), single([y, NaN])); + +%% Test input validation +%!error wblpdf () +%!error wblpdf (1,2,3,4) +%!error wblpdf (ones(3),ones(2),ones(2)) +%!error wblpdf (ones(2),ones(3),ones(2)) +%!error wblpdf (ones(2),ones(2),ones(3)) +%!error wblpdf (i, 2, 2) +%!error wblpdf (2, i, 2) +%!error wblpdf (2, 2, i) +
--- a/scripts/statistics/distributions/wblrnd.m +++ b/scripts/statistics/distributions/wblrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,78 +18,115 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} wblrnd (@var{scale}, @var{shape}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} wblrnd (@var{scale}, @var{shape}, @var{sz}) -## Return an @var{r} by @var{c} matrix of random samples from the -## Weibull distribution with parameters @var{scale} and @var{shape} -## which must be scalar or of size @var{r} by @var{c}. Or if @var{sz} -## is a vector return a matrix of size @var{sz}. +## @deftypefn {Function File} {} wblrnd (@var{scale}, @var{shape}) +## @deftypefnx {Function File} {} wblrnd (@var{scale}, @var{shape}, @var{r}) +## @deftypefnx {Function File} {} wblrnd (@var{scale}, @var{shape}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} wblrnd (@var{scale}, @var{shape}, [@var{sz}]) +## Return a matrix of random samples from the Weibull distribution with +## parameters @var{scale} and @var{shape}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{alpha} and @var{sigma}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{scale} and @var{shape}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the Weibull distribution -function rnd = wblrnd (scale, shape, r, c) +function rnd = wblrnd (scale, shape, varargin) - if (nargin > 1) - if (!isscalar(scale) || !isscalar(shape)) - [retval, scale, shape] = common_size (scale, shape); - if (retval > 0) - error ("wblrnd: SCALE and SHAPE must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (scale) || !isscalar (shape)) + [retval, scale, shape] = common_size (scale, shape); + if (retval > 0) + error ("wblrnd: SCALE and SHAPE must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("wblrnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("wblrnd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (scale) || iscomplex (shape)) + error ("wblrnd: SCALE and SHAPE must not be complex"); + endif - if (any (size (scale) != 1) - && ((length (size (scale)) != length (sz)) - || any (size (scale) != sz))) - error ("wblrnd: SCALE and SHAPE must be scalar or of size [R, C]"); - endif + if (nargin == 2) + sz = size (scale); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("wblrnd: R must be a positive integer or vector"); + error ("wblrnd: dimension vector must be row vector of non-negative integers"); endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("wblrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif - if (any (size (scale) != 1) - && ((length (size (scale)) != length (sz)) - || any (size (scale) != sz))) - error ("wblrnd: SCALE and SHAPE must be scalar or of size SZ"); - endif - elseif (nargin == 2) - sz = size(scale); + if (!isscalar (scale) && !isequal (size (scale), sz)) + error ("wblrnd: SCALE and SHAPE must be scalar or of size SZ"); + endif + + if (isa (scale, "single") || isa (shape, "single")) + cls = "single"; else - print_usage (); + cls = "double"; endif if (isscalar (scale) && isscalar (shape)) - if (scale > 0 && scale < Inf && shape > 0 && shape < Inf) - rnd = scale .* rande(sz) .^ (1./shape); + if ((scale > 0) && (scale < Inf) && (shape > 0) && (shape < Inf)) + rnd = scale * rande (sz) .^ (1/shape); else - rnd = NaN (sz); + rnd = NaN (sz, cls); endif else - rnd = scale .* rande(sz) .^ (1./shape); - k = find ((scale <= 0) | (scale == Inf) | ((shape <= 0) & (shape == Inf))); - if (any(k)) - rnd(k) = NaN; - endif + rnd = scale .* rande (sz) .^ (1./shape); + + k = (scale <= 0) | (scale == Inf) | (shape <= 0) | (shape == Inf); + rnd(k) = NaN; endif endfunction + +%!assert(size (wblrnd (1,2)), [1, 1]); +%!assert(size (wblrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (wblrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (wblrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (wblrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (wblrnd (1, 2, 3)), [3, 3]); +%!assert(size (wblrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (wblrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (wblrnd (1, 2)), "double"); +%!assert(class (wblrnd (single(1), 2)), "single"); +%!assert(class (wblrnd (single([1 1]), 2)), "single"); +%!assert(class (wblrnd (1, single(2))), "single"); +%!assert(class (wblrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error wblrnd () +%!error wblrnd (1) +%!error wblrnd (ones(3),ones(2)) +%!error wblrnd (ones(2),ones(3)) +%!error wblrnd (i, 2) +%!error wblrnd (2, i) +%!error wblrnd (1,2, -1) +%!error wblrnd (1,2, ones(2)) +%!error wblrnd (1, 2, [2 -1 2]) +%!error wblrnd (1,2, 1, ones(2)) +%!error wblrnd (1,2, 1, -1) +%!error wblrnd (ones(2,2), 2, 3) +%!error wblrnd (ones(2,2), 2, [3, 2]) +%!error wblrnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/models/logistic_regression.m +++ b/scripts/statistics/models/logistic_regression.m @@ -84,8 +84,7 @@ ## Uses the auxiliary functions logistic_regression_derivatives and ## logistic_regression_likelihood. -function [theta, beta, dev, dl, d2l, p] ... - = logistic_regression (y, x, print, theta, beta) +function [theta, beta, dev, dl, d2l, p] = logistic_regression (y, x, print, theta, beta) ## check input y = round (vec (y));
--- a/scripts/statistics/models/module.mk +++ b/scripts/statistics/models/module.mk @@ -1,9 +1,12 @@ FCN_FILE_DIRS += statistics/models +statistics_models_PRIVATE_FCN_FILES = \ + statistics/models/private/logistic_regression_derivatives.m \ + statistics/models/private/logistic_regression_likelihood.m + statistics_models_FCN_FILES = \ statistics/models/logistic_regression.m \ - statistics/models/logistic_regression_derivatives.m \ - statistics/models/logistic_regression_likelihood.m + $(statistics_models_PRIVATE_FCN_FILES) FCN_FILES += $(statistics_models_FCN_FILES)
rename from scripts/statistics/models/logistic_regression_derivatives.m rename to scripts/statistics/models/private/logistic_regression_derivatives.m --- a/scripts/statistics/models/logistic_regression_derivatives.m +++ b/scripts/statistics/models/private/logistic_regression_derivatives.m @@ -18,8 +18,10 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {[@var{dl}, @var{d2l}] =} logistic_regression_derivatives (@var{x}, @var{z}, @var{z1}, @var{g}, @var{g1}, @var{p}) -## Called by logistic_regression. Calculates derivates of the -## log-likelihood for ordinal logistic regression model. +## Calculate derivatives of the log-likelihood for ordinal logistic regression +## model. +## Private function called by @code{logistic_regression}. +## @seealso{logistic_regression} ## @end deftypefn ## Author: Gordon K. Smyth <gks@maths.uq.oz.au>
rename from scripts/statistics/models/logistic_regression_likelihood.m rename to scripts/statistics/models/private/logistic_regression_likelihood.m --- a/scripts/statistics/models/logistic_regression_likelihood.m +++ b/scripts/statistics/models/private/logistic_regression_likelihood.m @@ -18,8 +18,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {[@var{g}, @var{g1}, @var{p}, @var{dev}] =} logistic_regression_likelihood (@var{y}, @var{x}, @var{beta}, @var{z}, @var{z1}) -## Calculates likelihood for the ordinal logistic regression model. -## Called by logistic_regression. +## Calculate the likelihood for the ordinal logistic regression model. +## Private function called by @code{logistic_regression}. +## @seealso{logistic_regression} ## @end deftypefn ## Author: Gordon K. Smyth <gks@maths.uq.oz.au>
--- a/scripts/statistics/tests/anova.m +++ b/scripts/statistics/tests/anova.m @@ -88,7 +88,7 @@ v_b = SSB / df_b; v_w = SSW / df_w; f = v_b / v_w; - pval = 1 - f_cdf (f, df_b, df_w); + pval = 1 - fcdf (f, df_b, df_w); if (nargout == 0) ## This eventually needs to be done more cleanly ...
--- a/scripts/statistics/tests/cor_test.m +++ b/scripts/statistics/tests/cor_test.m @@ -91,7 +91,7 @@ m = method (1); if (m == "p") - r = cor (x, y); + r = corr (x, y); df = n - 2; t.method = "Pearson's product moment correlation"; t.params = df;
--- a/scripts/statistics/tests/f_test_regression.m +++ b/scripts/statistics/tests/f_test_regression.m @@ -68,7 +68,7 @@ [b, v] = ols (y, x); diff = rr * b - r; f = diff' * inv (rr * inv (x' * x) * rr') * diff / (q * v); - pval = 1 - f_cdf (f, df_num, df_den); + pval = 1 - fcdf (f, df_num, df_den); if (nargout == 0) printf (" pval: %g\n", pval);
--- a/scripts/statistics/tests/hotelling_test.m +++ b/scripts/statistics/tests/hotelling_test.m @@ -63,7 +63,7 @@ d = mean (x) - m; Tsq = n * d * (cov (x) \ d'); - pval = 1 - f_cdf ((n-p) * Tsq / (p * (n-1)), p, n-p); + pval = 1 - fcdf ((n-p) * Tsq / (p * (n-1)), p, n-p); if (nargout == 0) printf (" pval: %g\n", pval);
--- a/scripts/statistics/tests/hotelling_test_2.m +++ b/scripts/statistics/tests/hotelling_test_2.m @@ -76,7 +76,7 @@ d = mean (x) - mean (y); S = ((n_x - 1) * cov (x) + (n_y - 1) * cov (y)) / (n_x + n_y - 2); Tsq = (n_x * n_y / (n_x + n_y)) * d * (S \ d'); - pval = 1 - f_cdf ((n_x + n_y - p - 1) * Tsq / (p * (n_x + n_y - 2)), + pval = 1 - fcdf ((n_x + n_y - p - 1) * Tsq / (p * (n_x + n_y - 2)), p, n_x + n_y - p - 1); if (nargout == 0)
--- a/scripts/statistics/tests/manova.m +++ b/scripts/statistics/tests/manova.m @@ -34,7 +34,7 @@ ## Three test statistics (Wilks, Hotelling-Lawley, and Pillai-Bartlett) ## and corresponding approximate p-values are calculated and displayed. -## (Currently NOT because the f_cdf respectively betai code is too bad.) +## (Currently NOT because the fcdf respectively betai code is too bad.) ## Author: TF <Thomas.Fuereder@ci.tuwien.ac.at> ## Adapted-By: KH <Kurt.Hornik@wu-wien.ac.at> @@ -107,7 +107,7 @@ df_den = delta * eta - df_num / 2 + 1; WT = exp (- log (Lambda) / eta) - 1; - W_pval_2 = 1 - f_cdf (WT * df_den / df_num, df_num, df_den); + W_pval_2 = 1 - fcdf (WT * df_den / df_num, df_num, df_den); if (0) @@ -123,7 +123,7 @@ df_num = theta * (2 * u + theta + 1); df_den = 2 * (theta * v + 1); - HL_pval = 1 - f_cdf (HL * df_den / df_num, df_num, df_den); + HL_pval = 1 - fcdf (HL * df_den / df_num, df_num, df_den); ## Pillai-Bartlett ## =============== @@ -131,7 +131,7 @@ PB = sum (l ./ (1 + l)); df_den = theta * (2 * v + theta + 1); - PB_pval = 1 - f_cdf (PB * df_den / df_num, df_num, df_den); + PB_pval = 1 - fcdf (PB * df_den / df_num, df_num, df_den); printf ("\n"); printf ("One-way MANOVA Table:\n");
--- a/scripts/statistics/tests/mcnemar_test.m +++ b/scripts/statistics/tests/mcnemar_test.m @@ -42,8 +42,8 @@ if (! (min (size (x)) > 1) && issquare (x)) error ("mcnemar_test: X must be a square matrix of size > 1"); - elseif (! (all (all (x >= 0)) && all (all (x == round (x))))) - error ("mcnemar_test: all entries of X must be nonnegative integers"); + elseif (! (all (all (x >= 0)) && all (all (x == fix (x))))) + error ("mcnemar_test: all entries of X must be non-negative integers"); endif r = rows (x);
--- a/scripts/statistics/tests/var_test.m +++ b/scripts/statistics/tests/var_test.m @@ -54,7 +54,7 @@ df_num = length (x) - 1; df_den = length (y) - 1; f = var (x) / var (y); - cdf = f_cdf (f, df_num, df_den); + cdf = fcdf (f, df_num, df_den); if (nargin == 2) alt = "!=";
--- a/scripts/statistics/tests/wilcoxon_test.m +++ b/scripts/statistics/tests/wilcoxon_test.m @@ -23,7 +23,7 @@ ## @var{y}) == 1/2. Under the null, the test statistic @var{z} ## approximately follows a standard normal distribution when @var{n} > 25. ## -## @strong{Warning}: This function assumes a normal distribution for @var{z} +## @strong{Caution:} This function assumes a normal distribution for @var{z} ## and thus is invalid for @var{n} @leq{} 25. ## ## With the optional argument string @var{alt}, the alternative of
--- a/scripts/strings/base2dec.m +++ b/scripts/strings/base2dec.m @@ -28,10 +28,12 @@ ## @end group ## @end example ## -## If @var{s} is a matrix, returns a column vector with one value per +## If @var{s} is a string matrix, return a column vector with one value per ## row of @var{s}. If a row contains invalid symbols then the -## corresponding value will be NaN@. Rows are right-justified before -## converting so that trailing spaces are ignored. +## corresponding value will be NaN@. +## +## If @var{s} is a cell array of strings, return a column vector with one +## value per cell element in @var{s}. ## ## If @var{base} is a string, the characters of @var{base} are used as the ## symbols for the digits of @var{s}. Space (' ') may not be used as a @@ -55,6 +57,12 @@ print_usage (); endif + if (iscellstr (s)) + s = char (s); + elseif (! ischar (s)) + error ("base2dec: S must be a string or cellstring"); + endif + symbols = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; if (ischar (base)) symbols = base; @@ -89,9 +97,11 @@ endfunction + %!assert(base2dec ("11120", 3), 123); %!assert(base2dec ("yyyzx", "xyz"), 123); %!assert(base2dec ("-1", 2), NaN); +%!assert(base2dec ({"A1", "1A"}, 16), [161; 26]); %%Test input validation %!error base2dec ();
--- a/scripts/strings/bin2dec.m +++ b/scripts/strings/bin2dec.m @@ -28,8 +28,11 @@ ## @end group ## @end example ## -## If @var{s} is a string matrix, return a column vector of converted -## numbers, one per row of @var{s}. Invalid rows evaluate to NaN. +## If @var{s} is a string matrix, return a column vector with one converted +## number per row of @var{s}; Invalid rows evaluate to NaN@. +## +## If @var{s} is a cell array of strings, return a column vector with one +## converted number per cell element in @var{s}. ## @seealso{dec2bin, base2dec, hex2dec} ## @end deftypefn @@ -38,17 +41,19 @@ function d = bin2dec (s) - if (nargin == 1 && ischar (s)) - d = base2dec (s, 2); - else + if (nargin != 1) print_usage (); endif + d = base2dec (s, 2); + endfunction + %!assert(bin2dec ("0000"), 0); %!assert(bin2dec ("1110"), 14); %!assert(bin2dec ("11111111111111111111111111111111111111111111111111111"), 2^53-1); +%!assert(bin2dec ({"1110", "1111"}), [14; 15]); %%Test input validation %!error bin2dec ();
--- a/scripts/strings/blanks.m +++ b/scripts/strings/blanks.m @@ -22,7 +22,7 @@ ## ## @example ## @group -## blanks(10); +## blanks (10); ## whos ans; ## @result{} ## Attr Name Size Bytes Class @@ -40,7 +40,7 @@ if (nargin != 1) print_usage (); - elseif (! (isscalar (n) && n == round (n))) + elseif (! (isscalar (n) && n == fix (n) && n >= 0)) error ("blanks: N must be a non-negative integer"); endif @@ -50,14 +50,16 @@ endfunction + ## There really isn't that much to test here %!assert(blanks (0), "") %!assert(blanks (5), " ") %!assert(blanks (10), " ") -%!assert(strcmp (blanks (3), " ")); +%% Test input validation +%!error blanks () +%!error blanks (1, 2) +%!error blanks (ones (2)) +%!error blanks (2.1) +%!error blanks (-2) -%!error blanks (); - -%!error blanks (1, 2); -
--- a/scripts/strings/cstrcat.m +++ b/scripts/strings/cstrcat.m @@ -44,36 +44,27 @@ function st = cstrcat (varargin) - if (nargin > 0) + if (nargin < 1) + print_usage (); + elseif (! iscellstr (varargin)) + error ("cstrcat: expecting arguments to character strings"); + endif - if (iscellstr (varargin)) - ## All arguments are character strings. - unwind_protect - tmp = warning ("query", "Octave:empty-list-elements"); - warning ("off", "Octave:empty-list-elements"); - st = [varargin{:}]; - unwind_protect_cleanup - warning (tmp.state, "Octave:empty-list-elements"); - end_unwind_protect - else - error ("cstrcat: expecting arguments to character strings"); - endif - else - print_usage (); - endif + st = [varargin{:}]; endfunction -## test the dimensionality -## 1d -%!assert(cstrcat("ab ", "ab "), "ab ab ") -## 2d -%!assert(cstrcat(["ab ";"cde"], ["ab ";"cde"]), ["ab ab ";"cdecde"]) -%!assert((strcmp (cstrcat ("foo", "bar"), "foobar") -%! && strcmp (cstrcat (["a"; "bb"], ["foo"; "bar"]), ["a foo"; "bbbar"]))); +## Test the dimensionality +## 1d +%!assert (cstrcat ("ab ", "ab "), "ab ab ") +## 2d +%!assert (cstrcat (["ab ";"cde"], ["ab ";"cde"]), ["ab ab ";"cdecde"]) +%!assert (cstrcat ("foo", "bar"), "foobar") +%!assert (cstrcat (["a"; "bb"], ["foo"; "bar"]), ["a foo"; "bbbar"]) + +%% Test input validation %!error cstrcat (); - %!error cstrcat (1, 2);
--- a/scripts/strings/deblank.m +++ b/scripts/strings/deblank.m @@ -18,10 +18,23 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} deblank (@var{s}) -## Remove trailing blanks and nulls from @var{s}. If @var{s} +## Remove trailing whitespace and nulls from @var{s}. If @var{s} ## is a matrix, @var{deblank} trims each row to the length of longest -## string. If @var{s} is a cell array, operate recursively on each -## element of the cell array. +## string. If @var{s} is a cell array of strings, operate recursively on each +## string element. +## +## Examples: +## +## @example +## @group +## deblank (" abc ") +## @result{} " abc" +## +## deblank ([" abc "; " def "]) +## @result{} [" abc " ; " def"] +## @end group +## @end example +## @seealso{strtrim} ## @end deftypefn ## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> @@ -33,53 +46,44 @@ print_usage (); endif - char_arg = ischar (s); - - if (char_arg || isnumeric (s)) + if (ischar (s)) - if (! isempty (s)) - if (char_arg) - k = find (! isspace (s) & s != "\0"); - else - warning ("deblank: expecting character string argument"); - k = find (s != 0); - endif - - if (isempty (k)) - s = resize (s, 0, 0); - else - s = s(:,1:ceil (max (k) / rows (s))); - endif + k = find (! isspace (s) & s != "\0"); + if (isempty (s) || isempty (k)) + s = ""; + else + s = s(:,1:ceil (max (k) / rows (s))); endif - elseif (iscell(s)) + elseif (iscell (s)) - s = cellfun (@deblank, s, "uniformoutput", false); + char_idx = cellfun ("isclass", s, "char"); + cell_idx = cellfun ("isclass", s, "cell"); + if (! all (char_idx | cell_idx)) + error ("deblank: S argument must be a string or cellstring"); + endif + + ## Divide work load. Recursive cellfun deblank call is slow + ## and avoided where possible. + s(char_idx) = regexprep (s(char_idx), "[\\s\v\\0]+$", ''); + s(cell_idx) = cellfun ("deblank", s(cell_idx), "UniformOutput", false); else - error ("deblank: expecting character string argument"); + error ("deblank: S argument must be a string or cellstring"); endif endfunction -%!assert (strcmp (deblank (" f o o "), " f o o")); - -%!assert (deblank ([]), []) -%!assert (deblank ({}), {}) -%!assert (deblank (""), "") - -%!assert (deblank ([0,0,0]), []) -%!assert (deblank (' '), '') -%!assert (deblank (" "), "") -%!assert (typeinfo (deblank (" ")), "string") -%!assert (typeinfo (deblank (' ')), "sq_string") - -%!assert (deblank ([1,2,0]), [1,2]) -%!assert (deblank ([1,2,0,32]), [1,2,0,32]) +%!assert (deblank (" f o o \0"), " f o o"); +%!assert (deblank (' '), ''); +%!assert (deblank (" "), ""); +%!assert (deblank (""), ""); +%!assert (deblank ({}), {}); +%!assert (deblank ({" abc ", {" def "}}), {" abc", {" def"}}); -%!assert (deblank (int8 ([1,2,0])), int8 ([1,2])) +%!error <Invalid call to deblank> deblank (); +%!error <Invalid call to deblank> deblank ("foo", "bar"); +%!error <argument must be a string> deblank (1); +%!error <argument must be a string> deblank ({[]}); -%!error deblank (); - -%!error deblank ("foo", "bar");
--- a/scripts/strings/dec2base.m +++ b/scripts/strings/dec2base.m @@ -29,8 +29,9 @@ ## @end group ## @end example ## -## If @var{d} is a vector, return a string matrix with one row per value, -## padded with leading zeros to the width of the largest value. +## If @var{d} is a matrix or cell array, return a string matrix with one +## row per element in @var{d}, padded with leading zeros to the width of +## the largest value. ## ## If @var{base} is a string then the characters of @var{base} are used as ## the symbols for the digits of @var{d}. Space (' ') may not be used @@ -57,13 +58,17 @@ print_usage (); endif + if (iscell (d)) + d = cell2mat (d); + endif + # Create column vector for algorithm - if (columns (d) > 1 || !isvector (d)) + if (! iscolumn (d)) d = d(:); endif - if (any (d < 0 | d != fix (d))) - error ("dec2base: input must be non-negative integers"); + if (! isnumeric (d) || iscomplex (d) || any (d < 0 | d != fix (d))) + error ("dec2base: input must be real non-negative integers"); endif symbols = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; @@ -84,7 +89,7 @@ ## determine number of digits required to handle all numbers, can overflow ## by 1 digit - max_len = round (log (max (max (d), 1)) ./ log (base)) + 1; + max_len = round (log (max (max (d(:)), 1)) / log (base)) + 1; if (nargin == 3) max_len = max (max_len, len); @@ -93,12 +98,12 @@ ## determine digits for each number digits = zeros (length (d), max_len); for k = max_len:-1:1 - digits(:,k) = mod(d, base); + digits(:,k) = mod (d, base); d = round ((d - digits(:,k)) / base); endfor ## convert digits to symbols - retval = reshape (symbols (digits+1), size (digits)); + retval = reshape (symbols(digits+1), size (digits)); ## Check if the first element is the zero symbol. It seems possible ## that LEN is provided, and is less than the computed MAX_LEN and @@ -106,51 +111,56 @@ ## have a leading zero to remove. But if LEN >= MAX_LEN, we should ## not remove any leading zeros. if ((nargin == 2 || (nargin == 3 && max_len > len)) - && all (retval(:,1) == symbols(1)) && length (retval) != 1) + && length (retval) != 1 && ! any (retval(:,1) != symbols(1))) retval = retval(:,2:end); endif endfunction + %!test -%! s0=''; -%! for n=1:13 -%! for b=2:16 -%! pp=dec2base(b^n+1,b); -%! assert(dec2base(b^n,b),['1',s0,'0']); -%! assert(dec2base(b^n+1,b),['1',s0,'1']); -%! end -%! s0=[s0,'0']; -%! end +%! s0 = ''; +%! for n = 1:13 +%! for b = 2:16 +%! pp = dec2base (b^n+1, b); +%! assert (dec2base(b^n, b), ['1',s0,'0']); +%! assert (dec2base(b^n+1, b), ['1',s0,'1']); +%! endfor +%! s0 = [s0,'0']; +%! endfor %!test %! digits='0123456789ABCDEF'; -%! for n=1:13 -%! for b=2:16 -%! pm=dec2base(b^n-1,b); -%! assert(length(pm),n); -%! assert(all(pm==digits(b))); -%! end -%! end +%! for n = 1:13 +%! for b = 2:16 +%! pm = dec2base(b^n-1, b); +%! assert (length (pm), n); +%! assert (all (pm==digits(b))); +%! endfor +%! endfor %!test -%! for b=2:16 -%! assert(dec2base(0,b),'0'); -%! end +%! for b = 2:16 +%! assert (dec2base (0, b), '0'); +%! endfor -%!assert(dec2base(0,2,4), "0000"); -%!assert(dec2base(2^51-1,2), ... +%!assert(dec2base (0, 2, 4), "0000"); +%!assert(dec2base (2^51-1, 2), ... %! '111111111111111111111111111111111111111111111111111'); -%!assert(dec2base(uint64(2)^63-1,16), '7FFFFFFFFFFFFFFF'); +%!assert(dec2base(uint64(2)^63-1, 16), '7FFFFFFFFFFFFFFF'); +%!assert(dec2base([1, 2; 3, 4], 2, 3), ["001"; "011"; "010"; "100"]); +%!assert(dec2base({1, 2; 3, 4}, 2, 3), ["001"; "011"; "010"; "100"]); %%Test input validation %!error dec2base () %!error dec2base (1) %!error dec2base (1, 2, 3, 4) +%!error dec2base ("A") +%!error dec2base (2i) %!error dec2base (-1) %!error dec2base (1.1) -%!error dec2base (1,"ABA") -%!error dec2base (1,"A B") +%!error dec2base (1, "ABA") +%!error dec2base (1, "A B") %!error dec2base (1, ones(2)) %!error dec2base (1, 1) %!error dec2base (1, 37)
--- a/scripts/strings/dec2bin.m +++ b/scripts/strings/dec2bin.m @@ -28,8 +28,9 @@ ## @end group ## @end example ## -## If @var{d} is a vector, returns a string matrix, one row per value, -## padded with leading zeros to the width of the largest value. +## If @var{d} is a matrix or cell array, return a string matrix with one +## row per element in @var{d}, padded with leading zeros to the width of +## the largest value. ## ## The optional second argument, @var{len}, specifies the minimum ## number of digits in the result. @@ -51,8 +52,10 @@ endfunction -%!assert(strcmp (dec2bin (14), "1110")); -%!assert(strcmp (dec2bin (14, 6), "001110")); + +%!assert(dec2bin (14), "1110"); +%!assert(dec2bin (14, 6), "001110"); +%!assert(dec2bin ({1, 2; 3, 4}), ["001"; "011"; "010"; "100"]); %%Test input validation %!error dec2bin ();
--- a/scripts/strings/dec2hex.m +++ b/scripts/strings/dec2hex.m @@ -28,8 +28,9 @@ ## @end group ## @end example ## -## If @var{d} is a vector, return a string matrix, one row per value, -## padded with leading zeros to the width of the largest value. +## If @var{d} is a matrix or cell array, return a string matrix with one +## row per element in @var{d}, padded with leading zeros to the width of +## the largest value. ## ## The optional second argument, @var{len}, specifies the minimum ## number of digits in the result. @@ -51,8 +52,10 @@ endfunction -%!assert(strcmpi (dec2hex (2748), "abc")); -%!assert(strcmpi (dec2hex (2748, 5), "00abc")); + +%!assert(dec2hex (2748), "ABC"); +%!assert(dec2hex (2748, 5), "00ABC"); +%!assert(dec2hex ({2748, 2746}), ["ABC"; "ABA"]); %% Test input validation %!error dec2hex ();
--- a/scripts/strings/findstr.m +++ b/scripts/strings/findstr.m @@ -17,20 +17,24 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} findstr (@var{s}, @var{t}, @var{overlap}) +## @deftypefn {Function File} {} findstr (@var{s}, @var{t}) +## @deftypefnx {Function File} {} findstr (@var{s}, @var{t}, @var{overlap}) ## Return the vector of all positions in the longer of the two strings ## @var{s} and @var{t} where an occurrence of the shorter of the two starts. -## If the optional argument @var{overlap} is nonzero, the returned vector +## If the optional argument @var{overlap} is true, the returned vector ## can include overlapping positions (this is the default). For example: ## ## @example ## @group ## findstr ("ababab", "a") -## @result{} [1, 3, 5] +## @result{} [1, 3, 5]; ## findstr ("abababa", "aba", 0) ## @result{} [1, 5] ## @end group ## @end example +## +## @strong{Caution:} @code{findstr} is scheduled for deprecation. Use +## @code{strfind} in all new code. ## @seealso{strfind, strmatch, strcmp, strncmp, strcmpi, strncmpi, find} ## @end deftypefn @@ -40,7 +44,7 @@ ## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> ## Adapted-By: jwe -function v = findstr (s, t, overlap) +function v = findstr (s, t, overlap = true) if (nargin < 2 || nargin > 3) print_usage (); @@ -50,15 +54,9 @@ error ("findstr: arguments must have only one non-singleton dimension"); endif - if (nargin == 2) - overlap = 1; - endif - ## Make S be the longer string. if (length (s) < length (t)) - tmp = s; - s = t; - t = tmp; + [s, t] = deal (t, s); endif l_s = length (s); @@ -126,18 +124,20 @@ v = []; endif - ## Always return a column vector, because that's what the old one did. - if (rows (v) > 1) + ## Always return a row vector, because that's what the old one did. + if (iscolumn (v)) v = v.'; endif endfunction -%!assert ((findstr ("abababa", "a") == [1, 3, 5, 7] -%! && findstr ("abababa", "aba") == [1, 3, 5] -%! && findstr ("abababa", "aba", 0) == [1, 5])); + +%!assert (findstr ("abababa", "a"), [1, 3, 5, 7]) +%!assert (findstr ("abababa", "aba"), [1, 3, 5]); +%!assert (findstr ("aba", "abababa", 0), [1, 5]); -%!error findstr (); +%% Test input validation +%!error findstr () +%!error findstr ("foo", "bar", 3, 4); +%!error findstr (["AB" ; "CD"], "C"); -%!error findstr ("foo", "bar", 3, 4); -
--- a/scripts/strings/hex2dec.m +++ b/scripts/strings/hex2dec.m @@ -30,8 +30,12 @@ ## @end group ## @end example ## -## If @var{s} is a string matrix, returns a column vector of converted -## numbers, one per row of @var{s}. Invalid rows evaluate to NaN. +## If @var{s} is a string matrix, return a column vector with one converted +## number per row of @var{s}; Invalid rows evaluate to NaN@. +## +## If @var{s} is a cell array of strings, return a column vector with one +## converted number per cell element in @var{s}. +## ## @seealso{dec2hex, base2dec, bin2dec} ## @end deftypefn @@ -40,17 +44,19 @@ function d = hex2dec (s) - if (nargin == 1 && ischar (s)) - d = base2dec (s, 16); - else + if (nargin != 1) print_usage (); endif + d = base2dec (s, 16); + endfunction + %!assert(hex2dec ("0000"), 0); %!assert(hex2dec ("1FFFFFFFFFFFFF"), 2^53-1); -%!assert(hex2dec ("12b") == 299 && hex2dec ("12B") == 299); +%!assert(hex2dec (["12b"; "12B"]), [299; 299]); +%!assert(hex2dec ({"A1", "1A"}), [161; 26]); %%Test input validation %!error hex2dec ();
--- a/scripts/strings/index.m +++ b/scripts/strings/index.m @@ -20,7 +20,10 @@ ## @deftypefn {Function File} {} index (@var{s}, @var{t}) ## @deftypefnx {Function File} {} index (@var{s}, @var{t}, @var{direction}) ## Return the position of the first occurrence of the string @var{t} in the -## string @var{s}, or 0 if no occurrence is found. For example: +## string @var{s}, or 0 if no occurrence is found. @var{s} may also be a +## string array or cell array of strings. +## +## For example: ## ## @example ## @group @@ -31,70 +34,83 @@ ## ## If @var{direction} is @samp{"first"}, return the first element found. ## If @var{direction} is @samp{"last"}, return the last element found. -## The @code{rindex} function is equivalent to @code{index} with -## @var{direction} set to @samp{"last"}. ## -## @strong{Caution:} This function does not work for arrays of -## character strings. ## @seealso{find, rindex} ## @end deftypefn ## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> ## Adapted-By: jwe +## This is patterned after the AWK function of the same name. -function n = index (s, t, direction) - - ## This is patterned after the AWK function of the same name. +function n = index (s, t, direction = "first") if (nargin < 2 || nargin > 3) print_usage (); - elseif (nargin < 3) - direction = "first"; endif - direction = lower (direction); + + if (ischar (s)) + if (! isrow (s)) + s = cellstr (s); # Handle string arrays by conversion to cellstr + endif + elseif (! iscellstr (s)) + error ("index: S must be a string, string array, or cellstr"); + endif f = strfind (s, t); - if (iscell (f)) + if (isempty (f)) + f = 0; + elseif (iscell (f)) f(cellfun ("isempty", f)) = {0}; - elseif (isempty (f)) - f = 0; endif - if (strcmp (direction, "last")) + direction = tolower (direction); + + if (strcmp (direction, "first")) if (iscell (f)) - n = cellfun (@min, f); + n = cellfun ("min", f); + else + n = f(1); + endif + elseif (strcmp (direction, "last")) + if (iscell (f)) + n = cellfun ("max", f); else n = f(end); endif - elseif (strcmp (direction, "first")) - if (iscell (f)) - n = cellfun (@max, f); - else - n = f(1); - endif else - error ("index: DIRECTION must be either \"first\" or \"last\""); + error ('index: DIRECTION must be either "first" or "last"'); endif + endfunction -## Test the function out -%!assert(index("astringbstringcstring", "s"), 2) -%!assert(index("astringbstringcstring", "st"), 2) -%!assert(index("astringbstringcstring", "str"), 2) -%!assert(index("astringbstringcstring", "string"), 2) -%!assert(index("abc---", "abc+++"), 0) + +%!assert (index ("foobarbaz", "b") == 4 && index ("foobarbaz", "z") == 9); + +%!assert (index("astringbstringcstring", "s"), 2) +%!assert (index("astringbstringcstring", "st"), 2) +%!assert (index("astringbstringcstring", "str"), 2) +%!assert (index("astringbstringcstring", "string"), 2) +%!assert (index("abc---", "abc+++"), 0) ## test everything out in reverse -%!assert(index("astringbstringcstring", "s", "last"), 16) -%!assert(index("astringbstringcstring", "st", "last"), 16) -%!assert(index("astringbstringcstring", "str", "last"), 16) -%!assert(index("astringbstringcstring", "string", "last"), 16) -%!assert(index("abc---", "abc+++", "last"), 0) - +%!assert (index("astringbstringcstring", "s", "last"), 16) +%!assert (index("astringbstringcstring", "st", "last"), 16) +%!assert (index("astringbstringcstring", "str", "last"), 16) +%!assert (index("astringbstringcstring", "string", "last"), 16) +%!assert (index("abc---", "abc+++", "last"), 0) -%!assert(index ("foobarbaz", "b") == 4 && index ("foobarbaz", "z") == 9); +%!test +%! str = char ("Hello", "World", "Goodbye", "World"); +%! assert (index (str, "o"), [5; 2; 2; 2]); +%! assert (index (str, "o", "last"), [5; 2; 3; 2]); +%! str = cellstr (str); +%! assert (index (str, "o"), [5; 2; 2; 2]); +%! assert (index (str, "o", "last"), [5; 2; 3; 2]); -%!error index (); +%% Test input validation +%!error index () +%!error index ("a") +%!error index ("a", "b", "first", "d") +%!error index (1, "bar") +%!error index ("foo", "bar", 3) -%!error index ("foo", "bar", 3); -
--- a/scripts/strings/isstrprop.m +++ b/scripts/strings/isstrprop.m @@ -43,10 +43,10 @@ ## True for characters that are alphabetic or digits. ## ## @item "lower" -## True for lower-case letters. +## True for lowercase letters. ## ## @item "upper" -## True for upper-case letters. +## True for uppercase letters. ## ## @item "digit" ## True for decimal digits (0-9). @@ -84,47 +84,52 @@ function retval = isstrprop (str, prop) - if (nargin == 2) - switch (prop) - case "alpha" - retval = isalpha (str); - case {"alnum", "alphanum"} - retval = isalnum (str); - case "ascii" - retval = isascii (str); - case "cntrl" - retval = iscntrl (str); - case "digit" - retval = isdigit (str); - case {"graph", "graphic"} - retval = isgraph (str); - case "lower" - retval = islower (str); - case "print" - retval = isprint (str); - case "punct" - retval = ispunct (str); - case {"space", "wspace"} - retval = isspace (str); - case "upper" - retval = isupper (str); - case "xdigit" - retval = isxdigit (str); - otherwise - error ("isstrprop: invalid string property"); - endswitch - else + if (nargin != 2) print_usage (); endif + switch (prop) + case "alpha" + retval = isalpha (str); + case {"alnum", "alphanum"} + retval = isalnum (str); + case "ascii" + retval = isascii (str); + case "cntrl" + retval = iscntrl (str); + case "digit" + retval = isdigit (str); + case {"graph", "graphic"} + retval = isgraph (str); + case "lower" + retval = islower (str); + case "print" + retval = isprint (str); + case "punct" + retval = ispunct (str); + case {"space", "wspace"} + retval = isspace (str); + case "upper" + retval = isupper (str); + case "xdigit" + retval = isxdigit (str); + otherwise + error ("isstrprop: invalid string property"); + endswitch + endfunction -%!error <invalid string property> isstrprop ("abc123", "foo") + %!assert (isstrprop ("abc123", "alpha"), logical ([1, 1, 1, 0, 0, 0])) +%!assert (isstrprop ("abc123", "digit"), logical ([0, 0, 0, 1, 1, 1])) %!assert (isstrprop ("Hello World", "wspace"), isspace ("Hello World")) %!assert (isstrprop ("Hello World", "graphic"), isgraph ("Hello World")) +%!assert (isstrprop (char ("AbC", "123"), "upper"), logical ([1 0 1; 0 0 0])) +%!assert (isstrprop ({"AbC", "123"}, "lower"), {logical([0 1 0]), logical([0 0 0])}) %%Input Validation %!error isstrprop () %!error isstrprop ("abc123") %!error isstrprop ("abc123", "alpha", "alpha") +%!error <invalid string property> isstrprop ("abc123", "foo") +
--- a/scripts/strings/mat2str.m +++ b/scripts/strings/mat2str.m @@ -18,20 +18,19 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{s} =} mat2str (@var{x}, @var{n}) -## @deftypefnx {Function File} {@var{s} =} mat2str (@dots{}, 'class') -## -## Format real/complex numerical matrices as strings. This function -## returns values that are suitable for the use of the @code{eval} -## function. +## @deftypefnx {Function File} {@var{s} =} mat2str (@var{x}, @var{n}, "class") +## Format real, complex, and logical matrices as strings. The +## returned string may be used to reconstruct the original matrix by using +## the @code{eval} function. ## ## The precision of the values is given by @var{n}. If @var{n} is a ## scalar then both real and imaginary parts of the matrix are printed -## to the same precision. Otherwise @code{@var{n} (1)} defines the -## precision of the real part and @code{@var{n} (2)} defines the -## precision of the imaginary part. The default for @var{n} is 17. +## to the same precision. Otherwise @code{@var{n}(1)} defines the +## precision of the real part and @code{@var{n}(2)} defines the +## precision of the imaginary part. The default for @var{n} is 15. ## -## If the argument 'class' is given, then the class of @var{x} is -## included in the string in such a way that the eval will result in the +## If the argument "class" is given then the class of @var{x} is +## included in the string in such a way that @code{eval} will result in the ## construction of a matrix of the same class. ## ## @example @@ -40,10 +39,16 @@ ## @result{} "[-0.3333+0.14i;0.3333-0.14i]" ## ## mat2str ([ -1/3 +i/7; 1/3 -i/7 ], [4 2]) -## @result{} "[-0.3333+0i,0+0.14i;0.3333+0i,-0-0.14i]" +## @result{} "[-0.3333+0i 0+0.14i;0.3333+0i -0-0.14i]" +## +## mat2str (int16([1 -1]), "class") +## @result{} "int16([1 -1])" ## -## mat2str (int16([1 -1]), 'class') -## @result{} "int16([1,-1])" +## mat2str (logical (eye (2))) +## @result{} "[true false;false true]" +## +## isequal (x, eval (mat2str (x))) +## @result{} 1 ## @end group ## @end example ## @@ -52,35 +57,26 @@ ## Author: Rolf Fabian <fabian@tu-cottbus.de> -function s = mat2str (x, n, cls) - - if (nargin < 2 || isempty (n)) - ## Default precision - n = 17; - endif - - if (nargin < 3) - if (ischar (n)) - cls = n; - n = 17; - else - cls = ""; - endif - endif +function s = mat2str (x, n = 15, cls = "") if (nargin < 1 || nargin > 3 || ! (isnumeric (x) || islogical (x))) print_usage (); + elseif (ndims (x) > 2) + error ("mat2str: X must be two dimensional"); endif - if (ndims (x) > 2) - error ("mat2str: X must be two dimensional"); + if (nargin == 2 && ischar (n)) + cls = n; + n = 15; + elseif (isempty (n)) + n = 15; # Default precision endif x_islogical = islogical (x); x_iscomplex = iscomplex (x); if (x_iscomplex) - if (length (n) == 1) + if (isscalar (n)) n = [n, n]; endif fmt = sprintf ("%%.%dg%%+.%dgi", n(1), n(2)); @@ -107,7 +103,7 @@ endif else ## Non-scalar X, print brackets - fmt = cstrcat (fmt, ","); + fmt = cstrcat (fmt, " "); if (x_iscomplex) t = x.'; s = sprintf (fmt, [real(t(:))'; imag(t(:))']); @@ -120,20 +116,32 @@ s = cstrcat ("[", s); s(end) = "]"; - ind = find (s == ","); + idx = strfind (s, " "); nc = columns (x); - s(ind(nc:nc:end)) = ";"; + s(idx(nc:nc:end)) = ";"; endif if (strcmp ("class", cls)) - s = cstrcat (class(x), "(", s, ")"); + s = cstrcat (class (x), "(", s, ")"); endif + endfunction + +%!assert (mat2str (0.7), "0.7"); +%!assert (mat2str (pi), "3.14159265358979"); +%!assert (mat2str (pi, 5), "3.1416"); +%!assert (mat2str (single (pi), 5, "class"), "single(3.1416)"); %!assert (mat2str ([-1/3 + i/7; 1/3 - i/7], [4 2]), "[-0.3333+0.14i;0.3333-0.14i]") -%!assert (mat2str ([-1/3 +i/7; 1/3 -i/7], [4 2]), "[-0.3333+0i,0+0.14i;0.3333+0i,-0-0.14i]") -%!assert (mat2str (int16 ([1 -1]), 'class'), "int16([1,-1])") - +%!assert (mat2str ([-1/3 +i/7; 1/3 -i/7], [4 2]), "[-0.3333+0i 0+0.14i;0.3333+0i -0-0.14i]") +%!assert (mat2str (int16 ([1 -1]), 'class'), "int16([1 -1])") %!assert (mat2str (true), "true"); %!assert (mat2str (false), "false"); -%!assert (mat2str (logical (eye (2))), "[true,false;false,true]"); +%!assert (mat2str (logical (eye (2))), "[true false;false true]"); + +%% Test input validation +%!error mat2str () +%!error mat2str (1,2,3,4) +%!error mat2str (["Hello"]) +%!error mat2str (ones(3,3,2)) +
--- a/scripts/strings/regexptranslate.m +++ b/scripts/strings/regexptranslate.m @@ -18,14 +18,14 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} regexptranslate (@var{op}, @var{s}) -## Translate a string for use in a regular expression. This might +## Translate a string for use in a regular expression. This may ## include either wildcard replacement or special character escaping. -## The behavior can be controlled by the @var{op} that can have the +## The behavior is controlled by @var{op} which can take the following ## values ## ## @table @asis ## @item "wildcard" -## The wildcard characters @code{.}, @code{*} and @code{?} are replaced +## The wildcard characters @code{.}, @code{*}, and @code{?} are replaced ## with wildcards that are appropriate for a regular expression. ## For example: ## @@ -57,29 +57,31 @@ print_usage (); endif - if (ischar (op)) - op = tolower (op); - if (strcmp ("wildcard", op)) - y = regexprep (regexprep (regexprep (s, '\.', '\.'), '\*', - '.*'), '\?', '.'); - elseif (strcmp ("escape", op)) - ch = {'\$', '\.', '\?', '\[', '\]'}; - y = s; - for i = 1 : length (ch) - y = regexprep (y, ch{i}, ch{i}); - endfor - else - error ("regexptranslate: unexpected operation"); - endif + if (! ischar (op)) + error ("regexptranslate: operation OP must be a string"); + endif + + op = tolower (op); + if (strcmp ("wildcard", op)) + y = regexprep (regexprep (regexprep (s, '\.', '\.'), + '\*', '.*'), + '\?', '.'); + elseif (strcmp ("escape", op)) + y = regexprep (s, '([^\w])', '\$1'); else - error ("regexptranslate: expecting operation to be a string"); + error ("regexptranslate: invalid operation OP"); endif + endfunction -%!error <Invalid call to regexptranslate> regexptranslate (); -%!error <Invalid call to regexptranslate> regexptranslate ("wildcard"); -%!error <Invalid call to regexptranslate> regexptranslate ("a", "b", "c"); -%!error <unexpected operation> regexptranslate ("foo", "abc"); -%!error <expecting operation to be a string> regexptranslate (10, "abc"); + %!assert (regexptranslate ("wildcard", "/a*b?c."), "/a.*b.c\\.") -%!assert (regexptranslate ("escape", '$.?[]'), '\$\.\?\[\]') +%!assert (regexptranslate ("escape", '$.?[abc]'), '\$\.\?\[abc\]') + +%% Test input validation +%!error <Invalid call to regexptranslate> regexptranslate () +%!error <Invalid call to regexptranslate> regexptranslate ("wildcard") +%!error <Invalid call to regexptranslate> regexptranslate ("a", "b", "c") +%!error <invalid operation> regexptranslate ("foo", "abc") +%!error <operation OP must be a string> regexptranslate (10, "abc") +
--- a/scripts/strings/rindex.m +++ b/scripts/strings/rindex.m @@ -20,7 +20,9 @@ ## @deftypefn {Function File} {} rindex (@var{s}, @var{t}) ## Return the position of the last occurrence of the character string ## @var{t} in the character string @var{s}, or 0 if no occurrence is -## found. For example: +## found. @var{s} may also be a string array or cell array of strings. +## +## For example: ## ## @example ## @group @@ -29,18 +31,18 @@ ## @end group ## @end example ## -## @strong{Caution:} This function does not work for arrays of -## character strings. +## The @code{rindex} function is equivalent to @code{index} with +## @var{direction} set to @samp{"last"}. +## ## @seealso{find, index} ## @end deftypefn ## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> ## Adapted-By: jwe +## This is patterned after the AWK function of the same name. function n = rindex (s, t) - ## This is patterned after the AWK function of the same name. - if (nargin != 2) print_usage (); endif @@ -49,9 +51,17 @@ endfunction + %!assert(rindex ("foobarbaz", "b") == 7 && rindex ("foobarbaz", "o") == 3); -%!error rindex (); +%!test +%! str = char ("Hello", "World", "Goodbye", "World"); +%! assert (rindex (str, "o"), [5; 2; 3; 2]); +%! str = cellstr (str); +%! assert (rindex (str, "o"), [5; 2; 3; 2]); -%!error rindex ("foo", "bar", 3); +%% Test input validation +%!error rindex () +%!error rindex ("foo") +%!error rindex ("foo", "bar", "last")
--- a/scripts/strings/str2num.m +++ b/scripts/strings/str2num.m @@ -17,51 +17,69 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} str2num (@var{s}) +## @deftypefn {Function File} {@var{x} =} str2num (@var{s}) +## @deftypefnx {Function File} {[@var{x}, @var{state}] =} str2num (@var{s}) ## Convert the string (or character array) @var{s} to a number (or an ## array). Examples: ## ## @example ## @group -## str2num("3.141596") -## @result{} 3.141596 +## str2num ("3.141596") +## @result{} 3.141596 ## -## str2num(["1, 2, 3"; "4, 5, 6"]); -## @result{} ans = -## 1 2 3 -## 4 5 6 +## str2num (["1, 2, 3"; "4, 5, 6"]); +## @result{} ans = +## 1 2 3 +## 4 5 6 ## @end group ## @end example ## +## The optional second output, @var{state}, is logically true when the +## conversion is successful. If the conversion fails the numeric output, +## @var{x}, is empty and @var{state} is false. +## ## @strong{Caution:} As @code{str2num} uses the @code{eval} function ## to do the conversion, @code{str2num} will execute any code contained -## in the string @var{s}. Use @code{str2double} instead if you want to -## avoid the use of @code{eval}. +## in the string @var{s}. Use @code{str2double} for a safer and faster +## conversion. +## +## For cell array of strings use @code{str2double}. ## @seealso{str2double, eval} ## @end deftypefn ## Author: jwe -function m = str2num (s) +function [m, state] = str2num (s) + + if (nargin != 1) + print_usage (); + elseif (! ischar (s)) + error ("str2num: S must be a string or string array"); + endif - if (nargin == 1 && ischar (s)) - [nr, nc] = size (s); - sep = ";"; - sep = sep (ones (nr, 1), 1); - s = sprintf ("m = [%s];", reshape ([s, sep]', 1, nr * (nc + 1))); - eval (s, "m = [];"); - if (ischar (m)) - m = []; - endif - else - print_usage (); + s(:, end+1) = ";"; + s = sprintf ("m = [%s];", reshape (s', 1, numel (s))); + state = true; + eval (s, "m = []; state = false;"); + if (ischar (m)) + m = []; + state = false; endif endfunction -%!assert(str2num ("-1.3e2") == -130 && str2num ("[1, 2; 3, 4]") == [1, 2; 3, 4]); + +%!assert(str2num ("-1.3e2"), -130); +%!assert(str2num ("[1, 2; 3, 4]"), [1, 2; 3, 4]); -%!error str2num (); +%!test +%! [x, state] = str2num ("pi"); +%! assert (state); +%! [x, state] = str2num ("Hello World"); +%! assert (! state); -%!error str2num ("string", 1); +%% Test input validation +%!error str2num () +%!error str2num ("string", 1) +%!error <S must be a string> str2num ({"string"})
--- a/scripts/strings/strcat.m +++ b/scripts/strings/strcat.m @@ -61,14 +61,14 @@ elseif (nargin > 1) ## Convert to cells of strings uo = "uniformoutput"; - reals = cellfun (@isreal, varargin); + reals = cellfun ("isreal", varargin); if (any (reals)) - varargin(reals) = cellfun (@char, varargin(reals), uo, false); + varargin(reals) = cellfun ("char", varargin(reals), uo, false); endif - chars = cellfun (@ischar, varargin); + chars = cellfun ("isclass", varargin, "char"); allchar = all (chars); - varargin(chars) = cellfun (@cellstr, varargin(chars), uo, false); - if (! all (cellfun (@iscell, varargin))) + varargin(chars) = cellfun ("cellstr", varargin(chars), uo, false); + if (! all (cellfun ("isclass", varargin, "cell"))) error ("strcat: inputs must be strings or cells of strings"); endif @@ -81,7 +81,7 @@ endif ## Cellfun handles everything for us. - st = cellfun (@horzcat, varargin{:}, uo, false); + st = cellfun ("horzcat", varargin{:}, uo, false); if (allchar) ## If all inputs were strings, return strings.
--- a/scripts/strings/strchr.m +++ b/scripts/strings/strchr.m @@ -20,8 +20,9 @@ ## @deftypefn {Function File} {@var{idx} =} strchr (@var{str}, @var{chars}) ## @deftypefnx {Function File} {@var{idx} =} strchr (@var{str}, @var{chars}, @var{n}) ## @deftypefnx {Function File} {@var{idx} =} strchr (@var{str}, @var{chars}, @var{n}, @var{direction}) +## @deftypefnx {Function File} {[@var{i}, @var{j}] =} strchr (@dots{}) ## Search for the string @var{str} for occurrences of characters from -## the set @var{chars}. The return value, as well as the @var{n} and +## the set @var{chars}. The return value(s), as well as the @var{n} and ## @var{direction} arguments behave identically as in @code{find}. ## ## This will be faster than using regexp in most cases. @@ -30,12 +31,18 @@ ## @end deftypefn function varargout = strchr (str, chars, varargin) - if (nargin < 2 || ! ischar (str) || ! ischar (chars)) + + if (nargin < 2) print_usage (); + elseif (! ischar (str)) + error ("strchr: STR argument must be a string or string array"); + elseif (! ischar (chars)) + error ("strchr: CHARS argument must be a string"); endif + if (isempty (chars)) mask = false (size (str)); - elseif (length (chars) <= 6) + elseif (length (chars) <= 4) ## With a few characters, it pays off to build the mask incrementally. ## We do it via a for loop to save memory. mask = str == chars(1); @@ -43,22 +50,31 @@ mask |= str == chars(i); endfor else - ## Index the str into a mask of valid values. This is slower than - ## it could be because of the +1 issue. - f = false (1, 256); + ## Index the str into a mask of valid values. + ## This is slower than it could be because of the +1 issue. + f = false (256, 1); f(uint8(chars)+1) = true; ## Default goes via double -- unnecessarily long. si = uint32 (str); - ## in-place + ## in-place is faster than str+1 ++si; mask = reshape (f(si), size (str)); endif + varargout = cell (1, nargout); varargout{1} = []; [varargout{:}] = find (mask, varargin{:}); + endfunction -%!assert(strchr("Octave is the best software",""),zeros(1,0)) -%!assert(strchr("Octave is the best software","best"),[3, 6, 9, 11, 13, 15, 16, 17, 18, 20, 23, 27]) -%!assert(strchr("Octave is the best software","software"),[3, 4, 6, 9, 11, 13, 16, 17, 18, 20, 21, 22, 23, 24, 25, 26, 27]) + +%!assert (strchr ("Octave is the best software", ""), zeros (1,0)) +%!assert (strchr ("Octave is the best software", "best"), [3, 6, 9, 11, 13, 15, 16, 17, 18, 20, 23, 27]) +%!assert (strchr ("Octave is the best software", "software"), [3, 4, 6, 9, 11, 13, 16, 17, 18, 20, 21, 22, 23, 24, 25, 26, 27]) +%% Test input validation +%!error strchr () +%!error strchr (1) +%!error <STR argument must be a string> strchr (1, "aeiou") +%!error <CHARS argument must be a string> strchr ("aeiou", 1) +
--- a/scripts/strings/strjust.m +++ b/scripts/strings/strjust.m @@ -18,10 +18,11 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} strjust (@var{s}, @var{pos}) +## @deftypefn {Function File} {} strjust (@var{s}) +## @deftypefnx {Function File} {} strjust (@var{s}, @var{pos}) ## Return the text, @var{s}, justified according to @var{pos}, which may ## be @samp{"left"}, @samp{"center"}, or @samp{"right"}. If @var{pos} -## is omitted, @samp{"right"} is assumed. +## is omitted it defaults to @samp{"right"}. ## ## Null characters are replaced by spaces. All other character ## data are treated as non-white space. @@ -41,69 +42,71 @@ ## @seealso{deblank, strrep, strtrim, untabify} ## @end deftypefn -function y = strjust (s, pos) +function y = strjust (s, pos = "right") if (nargin < 1 || nargin > 2) print_usage (); - endif - - if (nargin == 1) - pos = "right"; - else - pos = tolower (pos); - endif - - if (ndims (s) != 2) - error ("strjust: input must be a string or character matrix"); + elseif (! ischar (s) || ndims (s) > 2) + error ("strjust: S must be a string or 2-D character matrix"); endif if (isempty (s)) y = s; - else - ## Apparently, Matlab considers nulls to be blanks as well; however, does - ## not preserve the nulls, but rather converts them to blanks. That's a - ## bit unexpected, but it allows simpler processing, because we can move - ## just the nonblank characters. So we'll do the same here. + return; + endif - [nr, nc] = size (s); - ## Find the indices of all nonblanks. - nonbl = s != " " & s != "\0"; - [idx, jdx] = find (nonbl); + ## Apparently, Matlab considers nulls to be blanks as well; however, does + ## not preserve the nulls, but rather converts them to blanks. That's a + ## bit unexpected, but it allows simpler processing, because we can move + ## just the nonblank characters. So we'll do the same here. + + [nr, nc] = size (s); + ## Find the indices of all nonblanks. + nonbl = s != " " & s != "\0"; + [idx, jdx] = find (nonbl); - if (strcmp (pos, "right")) - ## We wish to find the maximum column index for each row. Because jdx is - ## sorted, we can take advantage of the fact that assignment is processed - ## sequentially and for duplicate indices the last value will remain. - maxs = nc * ones (nr, 1); - maxs(idx) = jdx; - shift = nc - maxs; - elseif (strcmp (pos, "left")) - ## See above for explanation. - mins = ones (nr, 1); - mins(flipud (idx(:))) = flipud (jdx(:)); - shift = 1 - mins; - else - ## Use both of the above. - mins = ones (nr, 1); - mins(flipud (idx(:))) = flipud (jdx(:)); - maxs = nc * ones (nr, 1); - maxs(idx) = jdx; - shift = floor ((nc + 1 - maxs - mins) / 2); - endif + if (strcmpi (pos, "right")) + ## We wish to find the maximum column index for each row. Because jdx is + ## sorted, we can take advantage of the fact that assignment is processed + ## sequentially and for duplicate indices the last value will remain. + maxs = repmat (nc, [nr, 1]); + maxs(idx) = jdx; + shift = nc - maxs; + elseif (strcmpi (pos, "left")) + ## See above for explanation. + mins = ones (nr, 1); + mins(flipud (idx(:))) = flipud (jdx(:)); + shift = 1 - mins; + else + ## Use both of the above to achieve centering. + mins = ones (nr, 1); + mins(flipud (idx(:))) = flipud (jdx(:)); + maxs = repmat (nc, [nr, 1]); + maxs(idx) = jdx; + shift = floor ((nc + 1 - maxs - mins) / 2); + endif - ## Adjust the column indices. - jdx += shift (idx); + ## Adjust the column indices. + jdx += shift(idx); - ## Create a blank matrix and position the nonblank characters. - y = " "(ones (1, nr), ones (1, nc)); - y(sub2ind ([nr, nc], idx, jdx)) = s(nonbl); - endif + ## Create a blank matrix and position the nonblank characters. + y = repmat (" ", nr, nc); + y(sub2ind ([nr, nc], idx, jdx)) = s(nonbl); endfunction -%!error <Invalid call to strjust> strjust(); -%!error <Invalid call to strjust> strjust(["a";"ab"], "center", 1); + %!assert (strjust (["a"; "ab"; "abc"; "abcd"]), %! [" a";" ab"; " abc"; "abcd"]); -%!assert (strjust (["a"; "ab"; "abc"; "abcd"], "center"), +%!assert (strjust ([" a"; " ab"; "abc"; "abcd"], "left"), +%! ["a "; "ab "; "abc "; "abcd"]); +%!assert (strjust (["a"; "ab"; "abc"; "abcd"], "CENTER"), %! [" a "; " ab"; "abc "; "abcd"]); +%!assert (strjust (["";""]), ""); + +%% Test input validation +%!error <Invalid call to strjust> strjust () +%!error <Invalid call to strjust> strjust (["a";"ab"], "center", 1) +%!error <S must be a string> strjust (ones(3,3)) +%!error <S must be a string> strjust (char (ones(3,3,3))) +
--- a/scripts/strings/strmatch.m +++ b/scripts/strings/strmatch.m @@ -19,13 +19,15 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} strmatch (@var{s}, @var{A}, "exact") -## Return indices of entries of @var{A} that match the string @var{s}. -## The second argument @var{A} may be a string matrix or a cell array of -## strings. If the third argument @code{"exact"} is not given, then +## @deftypefn {Function File} {} strmatch (@var{s}, @var{A}) +## @deftypefnx {Function File} {} strmatch (@var{s}, @var{A}, "exact") +## Return indices of entries of @var{A} which begin with the string @var{s}. +## The second argument @var{A} must be a string, character matrix, or a cell +## array of strings. If the third argument @code{"exact"} is not given, then ## @var{s} only needs to match @var{A} up to the length of @var{s}. -## Trailing whitespace is ignored. -## Results are returned as a column vector. +## Trailing spaces and nulls in @var{s} and @var{A} are ignored when matching. +## option. +## ## For example: ## ## @example @@ -33,13 +35,16 @@ ## strmatch ("apple", "apple juice") ## @result{} 1 ## -## strmatch ("apple", ["apple pie"; "apple juice"; "an apple"]) +## strmatch ("apple", ["apple "; "apple juice"; "an apple"]) ## @result{} [1; 2] ## -## strmatch ("apple", @{"apple pie"; "apple juice"; "tomato"@}) -## @result{} [1; 2] +## strmatch ("apple", ["apple "; "apple juice"; "an apple"], "exact") +## @result{} [1] ## @end group ## @end example +## +## @strong{Caution:} @code{strmatch} is scheduled for deprecation. Use +## @code{strcmpi} or @code{strncmpi} in all new code. ## @seealso{strfind, findstr, strcmp, strncmp, strcmpi, strncmpi, find} ## @end deftypefn @@ -52,29 +57,19 @@ print_usage (); endif - if (! ischar (s)) + if (! ischar (s) || (! isempty (s) && ! isvector (s))) error ("strmatch: S must be a string"); + elseif (! (ischar (A) || iscellstr (A))) + error ("strmatch: A must be a string or cell array of strings"); endif - ## Truncate trailing whitespace. - s = strtrimr (s); - + ## Trim blanks and nulls from search string + s = regexprep (s, "[ \\0]+$", ''); len = length (s); exact = nargin == 3 && ischar (exact) && strcmp (exact, "exact"); - if (iscell (A)) - if (len > 0) - idx = find (strncmp (s, A, len)); - else - idx = find (strcmp (s, A)); - endif - if (exact) - ## We can't just use strcmp, because we need to ignore whitespace. - B = cellfun (@strtrimr, A(idx), "uniformoutput", false); - idx = idx (strcmp (s, B)); - endif - elseif (ischar (A)) + if (ischar (A)) [nr, nc] = size (A); if (len > nc) idx = []; @@ -82,34 +77,43 @@ match = all (bsxfun (@eq, A(:,1:len), s), 2); if (exact) AA = A(:,len+1:nc); - match &= all (AA == "\0" | AA == " ", 2); + match &= all (AA == " " | AA == "\0", 2); endif idx = find (match); endif else - error ("strmatch: A must be a string or cell array of strings"); + if (len > 0) + idx = find (strncmp (s, A, len)); + else + idx = find (strcmp (s, A)); + endif + if (exact) + ## We can't just use strcmp, because we need to ignore spaces at end. + B = regexprep (A(idx), "[ \\0]+$", ''); + idx = idx(strcmp (s, B)); + endif endif endfunction -## Removes nuls and blanks from the end of the array -function s = strtrimr (s) - blnks = s == "\0" | s == " "; - i = find (blnks, 1, "last"); - if (i && all (blnks(i:end))) - s = s(1:i-1); - endif -endfunction -%!error <Invalid call to strmatch> strmatch(); -%!error <Invalid call to strmatch> strmatch("a", "aaa", "exact", 1); %!assert (strmatch("a", {"aaa", "bab", "bbb"}), 1); %!assert (strmatch ("apple", "apple juice"), 1); -%!assert (strmatch ("apple", ["apple pie"; "apple juice"; "an apple"]), -%! [1; 2]); -%!assert (strmatch ("apple", {"apple pie"; "apple juice"; "tomato"}), -%! [1; 2]); +%!assert (strmatch ("apple", ["apple pie"; "apple juice"; "an apple"]), [1; 2]); +%!assert (strmatch ("apple", {"apple pie"; "apple juice"; "tomato"}), [1; 2]); %!assert (strmatch ("apple pie", "apple"), []); -%!assert (strmatch ("a b", {"a b", "a c", "c d"})); -%!assert (strmatch ("", {"", "foo", "bar", ""}), [1, 4]) -%!assert (strmatch ('', { '', '% comment line', 'var a = 5', ''}, 'exact'), [1,4]) +%!assert (strmatch ("a ", "a"), 1); +%!assert (strmatch ("a", "a \0", "exact"), 1); +%!assert (strmatch ("a b", {"a b", "a c", "c d"}), 1); +%!assert (strmatch ("", {"", "foo", "bar", ""}), [1, 4]); +%!assert (strmatch ('', { '', '% comment', 'var a = 5', ''}, 'exact'), [1,4]); + +%% Test input validation +%!error <Invalid call to strmatch> strmatch(); +%!error <Invalid call to strmatch> strmatch("a"); +%!error <Invalid call to strmatch> strmatch("a", "aaa", "exact", 1); +%!error <S must be a string> strmatch(1, "aaa"); +%!error <S must be a string> strmatch(char ("a", "bb"), "aaa"); +%!error <A must be a string> strmatch("a", 1); +%!error <A must be a string> strmatch("a", {"hello", [1]}); +
--- a/scripts/strings/strsplit.m +++ b/scripts/strings/strsplit.m @@ -17,53 +17,102 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{s}] =} strsplit (@var{p}, @var{sep}, @var{strip_empty}) -## Split a single string using one or more delimiters and return a cell -## array of strings. Consecutive delimiters and delimiters at +## @deftypefn {Function File} {[@var{cstr}] =} strsplit (@var{s}, @var{sep}) +## @deftypefnx {Function File} {[@var{cstr}] =} strsplit (@var{s}, @var{sep}, @var{strip_empty}) +## Split the string @var{s} using one or more separators @var{sep} and return +## a cell array of strings. Consecutive separators and separators at ## boundaries result in empty strings, unless @var{strip_empty} is true. ## The default value of @var{strip_empty} is false. +## +## 2-D character arrays are split at separators and at the original column +## boundaries. +## +## Example: +## +## @example +## @group +## strsplit ("a,b,c", ",") +## @result{} +## @{ +## [1,1] = a +## [1,2] = b +## [1,3] = c +## @} +## +## strsplit (["a,b" ; "cde"], ",") +## @result{} +## @{ +## [1,1] = a +## [1,2] = b +## [1,3] = cde +## @} +## @end group +## @end example ## @seealso{strtok} ## @end deftypefn -function s = strsplit (p, sep, strip_empty = false) +function cstr = strsplit (s, sep, strip_empty = false) - if (nargin < 2 || nargin > 3 || ! ischar (p) || rows (p) > 1 - || ! ischar (sep) || ! islogical (strip_empty)) + if (nargin < 2 || nargin > 3) print_usage (); + elseif (! ischar (s) || ! ischar (sep)) + error ("strsplit: S and SEP must be string values"); + elseif (! isscalar (strip_empty)) + error ("strsplit: STRIP_EMPTY must be a scalar value"); endif - if (isempty (p)) - s = cell (size (p)); + if (isempty (s)) + cstr = cell (size (s)); else - ## Split p according to delimiter. - if (isscalar (sep)) - ## Single separator. - idx = find (p == sep); - else - ## Multiple separators. - idx = strchr (p, sep); + if (rows (s) > 1) + ## For 2-D arrays, add separator character at line boundaries + ## and transform to single string + s(:, end+1) = sep(1); + s = reshape (s.', 1, numel (s)); + s(end) = []; endif - ## Get substring sizes. + ## Split s according to delimiter + if (isscalar (sep)) + ## Single separator + idx = find (s == sep); + else + ## Multiple separators + idx = strchr (s, sep); + endif + + ## Get substring lengths. if (isempty (idx)) - sizes = numel (p); + strlens = length (s); else - sizes = [idx(1)-1, diff(idx)-1, numel(p)-idx(end)]; + strlens = [idx(1)-1, diff(idx)-1, numel(s)-idx(end)]; endif ## Remove separators. - p(idx) = []; + s(idx) = []; if (strip_empty) ## Omit zero lengths. - sizes = sizes (sizes != 0); + strlens = strlens(strlens != 0); endif + ## Convert! - s = mat2cell (p, 1, sizes); + cstr = mat2cell (s, 1, strlens); endif endfunction -%!assert (all (strcmp (strsplit ("road to hell", " "), {"road", "to", "hell"}))) + +%!assert (strsplit ("road to hell", " "), {"road", "to", "hell"}) +%!assert (strsplit ("road to^hell", " ^"), {"road", "to", "hell"}) +%!assert (strsplit ("road to--hell", " -", true), {"road", "to", "hell"}) +%!assert (strsplit (["a,bc";",de"], ","), {"a", "bc", ones(1,0), "de "}) +%!assert (strsplit (["a,bc";",de"], ",", true), {"a", "bc", "de "}) +%!assert (strsplit (["a,bc";",de"], ", ", true), {"a", "bc", "de"}) -%!assert (all (strcmp (strsplit ("road to^hell", " ^"), {"road", "to", "hell"}))) +%% Test input validation +%!error strsplit () +%!error strsplit ("abc") +%!error strsplit ("abc", "b", true, 4) +%!error <S and SEP must be string values> strsplit (123, "b") +%!error <S and SEP must be string values> strsplit ("abc", 1) +%!error <STRIP_EMPTY must be a scalar value> strsplit ("abc", "def", ones(3,3)) -%!assert (all (strcmp (strsplit ("road to--hell", " -", true), {"road", "to", "hell"})))
--- a/scripts/strings/strtok.m +++ b/scripts/strings/strtok.m @@ -17,13 +17,18 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{tok}, @var{rem}] =} strtok (@var{str}, @var{delim}) +## @deftypefn {Function File} {[@var{tok}, @var{rem}] =} strtok (@var{str}) +## @deftypefnx {Function File} {[@var{tok}, @var{rem}] =} strtok (@var{str}, @var{delim}) ## -## Find all characters up to but not including the first character which -## is in the string delim. If @var{rem} is requested, it contains the -## remainder of the string, starting at the first delimiter. Leading -## delimiters are ignored. If @var{delim} is not specified, space is -## assumed. For example: +## Find all characters in the string @var{str} up to, but not including, the +## first character which is in the string @var{delim}. If @var{rem} is +## requested, it contains the remainder of the string, starting at the first +## delimiter. Leading delimiters are ignored. If @var{delim} is not +## specified, whitespace is assumed. @var{str} may also be a cell array of +## strings in which case the function executes on every individual string +## and returns a cell array of tokens and remainders. +## +## Examples: ## ## @example ## @group @@ -36,126 +41,184 @@ ## rem = *27+31 ## @end group ## @end example -## @seealso{index, strsplit} +## @seealso{index, strsplit, strchr, isspace} ## @end deftypefn -## FIXME: check what to do for a null delimiter - function [tok, rem] = strtok (str, delim) - if (nargin<1 || nargin > 2) + if (nargin < 1 || nargin > 2) print_usage (); + elseif (! (ischar (str) || iscellstr (str))) + error ("strtok: STR must be a string or cell array of strings."); + elseif (ischar (str) && ! isvector (str) &&! isempty (str)) + error ("strtok: STR cannot be a 2-D character array."); endif if (nargin < 2 || isempty (delim)) - delim = "\t\n\v\f\r "; + ws_delim = true; + else + ws_delim = false; endif if (isempty (str)) tok = rem = ""; - elseif (length (delim) > 3) - start = 1; - len = length (str); - while (start <= len) - if (all (str(start) != delim)) - break; - endif - start++; - endwhile - stop = start; - while (stop <= len) - if (any (str(stop) == delim)) - break; - endif - stop++; - endwhile - tok = str(start:stop-1); - rem = str(stop:len); - else - if (length (delim) == 1) - idx = find (str == delim); - elseif (length (delim) == 2) - idx = find (str == delim(1) | str == delim(2)); + elseif (ischar (str)) + if (ws_delim) + idx = isspace (str); + elseif (length (delim) <= 7) + ## Build index of delimiters incrementally for low N. + idx = str == delim(1); + for i = 2:length (delim) + idx |= str == delim(i); + endfor else - idx = find (str == delim(1) | str == delim(2) | str == delim(3)); + ## Index the str into a mask of valid values. Faster for large N. + f = false (256, 1); + ## This is slower than it could be because of the +1 issue. + f(uint8(delim)+1) = true; + ## Default goes via double -- unnecessarily long. + si = uint32 (str); + ## in-place is faster than str+1 + ++si; + idx = f(si); endif - if (isempty (idx)) + + idx_dlim = find (idx, 1); + idx_nodlim = find (! idx, 1); + if (isempty (idx_dlim)) + ## No delimiter. Return whole string. tok = str; rem = ""; + elseif (idx_dlim > idx_nodlim) + ## Normal case. No leading delimiters and at least 1 delimiter in STR. + tok = str(1:idx_dlim-1); + rem = str(idx_dlim:end); else - ## Find first non-leading delimiter. - skip = find (idx(:)' != 1:length(idx)); - if (isempty (skip)) - tok = str(idx(length(idx))+1:length(str)); + ## Leading delimiter found. + idx_dlim = find (idx(idx_nodlim+1:end), 1); + if (isempty (idx_dlim)) + ## No further delimiters. Return STR stripped of delimiter prefix. + tok = str(idx_nodlim:end); rem = ""; else - tok = str(skip(1):idx(skip(1))-1); - rem = str(idx(skip(1)):length(str)); + ## Strip delimiter prefix. Return STR up to 1st delimiter + tok = str(idx_nodlim:(idx_dlim + idx_nodlim -1)); + rem = str((idx_dlim + idx_nodlim):end); endif endif + else # Cell array of strings + if (ws_delim) + delim = '\s'; + endif + ptn = [ '^[' delim ']*','([^' delim ']+)','([' delim '].*)$' ]; + matches = regexp (str, ptn, "tokens"); + eidx = cellfun ("isempty", matches); + midx = ! eidx; + tok = cell (size (str)); + tok(eidx) = regexprep (str(eidx), [ '^[' delim ']+' ], ''); + ## Unwrap doubly nested cell array from regexp + tmp = [matches{midx}]; + if (! isempty (tmp)) + tmp = [tmp{:}]; + endif + tok(midx) = tmp(1:2:end); + if (isargout (2)) + rem = cell (size (str)); + rem(eidx) = {""}; + rem(midx) = tmp(2:2:end); + endif endif endfunction + %!demo %! strtok("this is the life") %! % split at the first space, returning "this" %!demo %! s = "14*27+31" -%! while 1 -%! [t,s] = strtok(s, "+-*/"); -%! printf("<%s>", t); -%! if isempty(s), break; endif -%! printf("<%s>", s(1)); +%! while (1) +%! [t, s] = strtok (s, "+-*/"); +%! printf ("<%s>", t); +%! if (isempty (s)) +%! break; +%! endif +%! printf ("<%s>", s(1)); %! endwhile %! printf("\n"); %! % ---------------------------------------------------- %! % Demonstrates processing of an entire string split on -%! % a variety of delimiters. Tokens and delimiters are -%! % printed one after another in angle brackets. The -%! % string is: +%! % a variety of delimiters. Tokens and delimiters are +%! % printed one after another in angle brackets. -%!# test the tokens for all cases -%!assert(strtok(""), ""); # no string -%!assert(strtok("this"), "this"); # no delimiter in string -%!assert(strtok("this "), "this"); # delimiter at end -%!assert(strtok("this is"), "this"); # delimiter in middle -%!assert(strtok(" this"), "this"); # delimiter at start -%!assert(strtok(" this "), "this"); # delimiter at start and end -%!assert(strtok(" "), ""(1:0)); # delimiter only +%% Test the tokens for all cases +%!assert (strtok (""), ""); # no string +%!assert (strtok ("this"), "this"); # no delimiter in string +%!assert (strtok ("this "), "this"); # delimiter at end +%!assert (strtok ("this is"), "this"); # delimiter in middle +%!assert (strtok (" this"), "this"); # delimiter at start +%!assert (strtok (" this "), "this"); # delimiter at start and end +%!assert (strtok (" "), ""(1:0)); # delimiter only + +%% Test the remainder for all cases +%!test [t,r] = strtok (""); assert (r, ""); +%!test [t,r] = strtok ("this"); assert (r, ""); +%!test [t,r] = strtok ("this "); assert (r, " "); +%!test [t,r] = strtok ("this is"); assert (r, " is"); +%!test [t,r] = strtok (" this"); assert (r, ""); +%!test [t,r] = strtok (" this "); assert (r, " "); +%!test [t,r] = strtok (" "); assert (r, ""); -%!# test the remainder for all cases -%!test [t,r] = strtok(""); assert(r, ""); -%!test [t,r] = strtok("this"); assert(r, char (zeros (1, 0))); -%!test [t,r] = strtok("this "); assert(r, " "); -%!test [t,r] = strtok("this is"); assert(r, " is"); -%!test [t,r] = strtok(" this"); assert(r, char (zeros (1, 0))); -%!test [t,r] = strtok(" this "); assert(r, " "); -%!test [t,r] = strtok(" "); assert(r, char (zeros (1, 0))); - -%!# simple check with 2 and 3 delimeters -%!assert(strtok("this is", "i "), "th"); -%!assert(strtok("this is", "ij "), "th"); +%% Test all tokens and remainders with cell array input +%!test +%! str = {"", "this", "this ", "this is", " this", " this ", " "}; +%! [t, r] = strtok (str); +%! assert (t{1}, ""); +%! assert (r{1}, ""); +%! assert (t{2}, "this"); +%! assert (r{2}, ""); +%! assert (t{3}, "this"); +%! assert (r{3}, " "); +%! assert (t{4}, "this"); +%! assert (r{4}, " is"); +%! assert (t{5}, "this"); +%! assert (r{5}, ""); +%! assert (t{6}, "this"); +%! assert (r{6}, " "); +%! assert (t{7}, ""); +%! assert (r{7}, ""); -%!# test all cases for 4 delimiters since a different -%!# algorithm is used when more than 3 delimiters -%!assert(strtok("","jkl "), ""); -%!assert(strtok("this","jkl "), "this"); -%!assert(strtok("this ","jkl "), "this"); -%!assert(strtok("this is","jkl "), "this"); -%!assert(strtok(" this","jkl "), "this"); -%!assert(strtok(" this ","jkl "), "this"); -%!assert(strtok(" ","jkl "), ""(1:0)); +%% Simple check for 2, 3, and 4 delimeters +%!assert(strtok ("this is", "i "), "th"); +%!assert(strtok ("this is", "ij "), "th"); +%!assert(strtok ("this is", "ijk "), "th"); -%!# test 'bad' string orientations -%!assert(strtok(" this "'), "this"'); # delimiter at start and end -%!assert(strtok(" this "',"jkl "), "this"'); +%% Test all cases for 8 delimiters since a different +%!# algorithm is used when more than 7 delimiters +%!assert (strtok ("","jklmnop "), ""); +%!assert (strtok ("this","jklmnop "), "this"); +%!assert (strtok ("this ","jklmnop "), "this"); +%!assert (strtok ("this is","jklmnop "), "this"); +%!assert (strtok (" this","jklmnop "), "this"); +%!assert (strtok (" this ","jklmnop "), "this"); +%!assert (strtok (" ","jklmnop "), ""(1:0)); -%!# test with TAB, LF, VT, FF, and CR +%% Test 'bad' string orientations +%!assert (strtok (" this ".'), "this".'); # delimiter at start and end +%!assert (strtok (" this ".',"jkl "), "this".'); + +%% Test with TAB, LF, VT, FF, and CR %!test %! for ch = "\t\n\v\f\r" %! [t, r] = strtok (cstrcat ("beg", ch, "end")); %! assert (t, "beg"); %! assert (r, cstrcat (ch, "end")) %! endfor + +%% Test input validation +%!error strtok () +%!error strtok ("a", "b", "c") +%!error <STR must be a string> strtok (1, "b") +%!error <STR cannot be a 2-D> strtok (char ("hello", "world"), "l") +
--- a/scripts/strings/strtrim.m +++ b/scripts/strings/strtrim.m @@ -18,20 +18,21 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} strtrim (@var{s}) -## Remove leading and trailing blanks and nulls from @var{s}. If +## Remove leading and trailing whitespace from @var{s}. If ## @var{s} is a matrix, @var{strtrim} trims each row to the length of -## longest string. If @var{s} is a cell array, operate recursively on -## each element of the cell array. For example: +## longest string. If @var{s} is a cell array of strings, operate recursively +## on each string element. For example: ## ## @example ## @group ## strtrim (" abc ") -## @result{} "abc" +## @result{} "abc" ## ## strtrim ([" abc "; " def "]) -## @result{} ["abc "; " def"] +## @result{} ["abc " ; " def"] ## @end group ## @end example +## @seealso{deblank} ## @end deftypefn ## Author: John Swensen <jpswensen@jhu.edu> @@ -46,24 +47,42 @@ if (ischar (s)) - k = find (! isspace (s) & s != "\0"); + k = find (! isspace (s)); if (isempty (s) || isempty (k)) s = ""; else - s = s(:,ceil (min (k) / rows (s)):ceil (max (k) / rows (s))); + s = s(:, ceil (min (k) / rows (s)):ceil (max (k) / rows (s))); endif - elseif (iscell(s)) + elseif (iscell (s)) - s = cellfun (@strtrim, s, "uniformoutput", false); + char_idx = cellfun ("isclass", s, "char"); + cell_idx = cellfun ("isclass", s, "cell"); + if (! all (char_idx | cell_idx)) + error ("strtrim: S argument must be a string or cellstring"); + endif + + ## Divide work load. Recursive cellfun strtrim call is slow + ## and avoided where possible. + s(char_idx) = regexprep (s(char_idx), "^[\\s\v]+|[\\s\v]+$", ''); + s(cell_idx) = cellfun ("strtrim", s(cell_idx), "UniformOutput", false); else - error ("strtrim: expecting string argument"); + error ("strtrim: S argument must be a string or cellstring"); endif endfunction -%!error <Invalid call to strtrim> strtrim(); -%!error <Invalid call to strtrim> strtrim("abc", "def"); + %!assert (strtrim (" abc "), "abc"); +%!assert (strtrim (" "), ""); +%!assert (strtrim ("abc"), "abc"); %!assert (strtrim ([" abc "; " def "]), ["abc "; " def"]); +%!assert (strtrim ({" abc "; " def "}), {"abc"; "def"}); +%!assert (strtrim ({" abc ", {" def "}}), {"abc", {"def"}}); + +%!error <Invalid call to strtrim> strtrim (); +%!error <Invalid call to strtrim> strtrim ("abc", "def"); +%!error <argument must be a string> strtrim (1); +%!error <argument must be a string> strtrim ({[]}); +
--- a/scripts/strings/strtrunc.m +++ b/scripts/strings/strtrunc.m @@ -19,10 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} strtrunc (@var{s}, @var{n}) ## Truncate the character string @var{s} to length @var{n}. If @var{s} -## is a char matrix, then the number of columns is adjusted. -## +## is a character matrix, then the number of columns is adjusted. ## If @var{s} is a cell array of strings, then the operation is performed -## on its members and the new cell array is returned. +## on each cell element and the new cell array is returned. ## @end deftypefn function s = strtrunc (s, n) @@ -31,29 +30,49 @@ print_usage (); endif - if (ischar (s)) - s_was_char = true; - s = {s}; - else - s_was_char = false; + n = fix (n); + if (! isscalar (n) || n < 0) + error ("strtrunc: length N must be a positive integer (N >= 0)"); endif - if (iscellstr (s)) - for i = 1:(numel (s)) - s{i} = s{i}(:,1:(min (n, columns (s{i})))); - endfor + if (ischar (s)) + if (n < columns (s)) + s = s(:, 1:n); + endif + elseif (iscellstr (s)) + ## Convoluted approach converts cellstr to char matrix, trims the character + ## matrix using indexing, and then converts back to cellstr with mat2cell. + ## This approach is 24X faster than using cellfun with call to strtrunc + idx = cellfun ("size", s, 2) > n; + rows = cellfun ("size", s(idx), 1); + if (! isempty (rows)) + s(idx) = mat2cell (char (s(idx))(:, 1:n), rows); + endif else error ("strtrunc: S must be a character string or a cell array of strings"); endif - if (s_was_char) - s = s{:}; - endif - endfunction -%!error <Invalid call to strtrunc> strtrunc (); -%!error <S must be a character string or a cell array of strings> strtrunc (1, 1) + %!assert (strtrunc("abcdefg", 4), "abcd"); %!assert (strtrunc("abcdefg", 10), "abcdefg"); +%!assert (strtrunc(char ("abcdef", "fedcba"), 3), ["abc"; "fed"]); %!assert (strtrunc({"abcdef", "fedcba"}, 3), {"abc", "fed"}); +%!assert (strtrunc({"", "1", "21", "321"}, 1), {"", "1", "2", "3"}) +%!assert (strtrunc({"1", "", "2"}, 1), {"1", "", "2"}) +%!test +%! cstr = {"line1"; ["line2"; "line3"]; "line4"}; +%! y = strtrunc (cstr, 4); +%! assert (size (y), [3, 1]); +%! assert (size (y{2}), [2, 4]); +%! assert (y{2}, repmat ("line", 2, 1)); + +%% Test input validation +%!error strtrunc () +%!error strtrunc ("abcd") +%!error strtrunc ("abcd", 4, 5) +%!error <N must be a positive integer> strtrunc ("abcd", ones (2,2)) +%!error <N must be a positive integer> strtrunc ("abcd", -1) +%!error <S must be a character string or a cell array of strings> strtrunc (1, 1) +
--- a/scripts/strings/substr.m +++ b/scripts/strings/substr.m @@ -17,25 +17,32 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} substr (@var{s}, @var{offset}, @var{len}) +## @deftypefn {Function File} {} substr (@var{s}, @var{offset}) +## @deftypefnx {Function File} {} substr (@var{s}, @var{offset}, @var{len}) ## Return the substring of @var{s} which starts at character number ## @var{offset} and is @var{len} characters long. ## -## If @var{offset} is negative, extraction starts that far from the end of -## the string. If @var{len} is omitted, the substring extends to the end -## of S. +## Position numbering for offsets begins with 1. If @var{offset} is negative, +## extraction starts that far from the end of the string. +## +## If @var{len} is omitted, the substring extends to the end of @var{S}. A +## negative value for @var{len} extracts to within @var{len} characters of +## the end of the string ## -## For example: +## Examples: ## ## @example ## @group ## substr ("This is a test string", 6, 9) ## @result{} "is a test" +## substr ("This is a test string", -11) +## @result{} "test string" +## substr ("This is a test string", -11, -7) +## @result{} "test" ## @end group ## @end example ## -## This function is patterned after AWK@. You can get the same result by -## @code{@var{s}(@var{offset} : (@var{offset} + @var{len} - 1))}. +## This function is patterned after the equivalent function in Perl. ## @end deftypefn ## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> @@ -47,34 +54,60 @@ print_usage (); endif - if (ischar (s)) - nc = columns (s); - if (abs (offset) > 0 && abs (offset) <= nc) - if (offset <= 0) - offset += nc + 1; - endif - if (nargin == 2) - eos = nc; - else - eos = offset + len - 1; - endif - if (eos <= nc) - t = s (:, offset:eos); - else - error ("substr: length = %d out of range", len); - endif + if (! ischar (s)) + error ("substr: S must be a string or string array"); + elseif (! isscalar (offset) || (nargin == 3 && ! isscalar (len))) + error ("substr: OFFSET and LEN must be scalar integers"); + endif + + offset = fix (offset); + nc = columns (s); + if (abs (offset) > nc || offset == 0) + error ("substr: OFFSET = %d out of range", offset); + endif + + if (offset <= 0) + offset += nc + 1; + endif + + if (nargin == 2) + eos = nc; + else + len = fix (len); + if (len < 0) + eos = nc + len; else - error ("substr: OFFSET = %d out of range", offset); + eos = offset + len - 1; endif - else - error ("substr: expecting string argument"); endif + if (eos > nc) + error ("substr: length LEN = %d out of range", len); + elseif (offset > eos && len != 0) + error ("substr: No overlap with chosen values of OFFSET and LEN"); + endif + + t = s(:, offset:eos); + endfunction -%!assert(strcmp (substr ("This is a test string", 6, 9), "is a test")); + +%!assert (substr ("This is a test string", 6, 9), "is a test"); +%!assert (substr ("This is a test string", -11), "test string"); +%!assert (substr ("This is a test string", -11, 4), "test"); +%!assert (substr ("This is a test string", -11, -7), "test"); +%!assert (substr ("This is a test string", 1, -7), "This is a test"); +%!assert (isempty (substr ("This is a test string", 1, 0))); -%!error substr (); +%% Test input validation +%!error substr () +%!error substr ("foo", 2, 3, 4) +%!error substr (ones (5, 1), 1, 1) +%!error substr ("foo", ones(2,2)) +%!error substr ("foo", 1, ones(2,2)) +%!error substr ("foo", 0) +%!error substr ("foo", 5) +%!error substr ("foo", 1, 5) +%!error substr ("foo", -1, 5) +%!error substr ("foo", 2, -5) -%!error substr ("foo", 2, 3, 4); -
--- a/scripts/strings/untabify.m +++ b/scripts/strings/untabify.m @@ -52,64 +52,72 @@ function s = untabify (t, tw = 8, dblank = false) - if (nargin > 0 && nargin < 4 && (ischar (t) || iscellstr (t))) - if (ischar (t)) - s = replace_tabs (t, tw); - else - s = cellfun (@(str) replace_tabs (str, tw), t, "uniformoutput", false); - endif - if (dblank) - s = deblank (s); - endif - else - print_usage (); - endif + if (nargin < 1 || nargin > 3) + print_usage (); + elseif (! (ischar (t) || iscellstr (t))) + error ("untabify: T must be a string or cellstring"); + endif + + if (ischar (t)) + s = replace_tabs (t, tw); + else + s = cellfun (@(str) replace_tabs (str, tw), t, "uniformoutput", false); + endif + + if (dblank) + s = deblank (s); + endif endfunction function s = replace_tabs (t, tw) - if (ndims (t) == 2) - if (isempty (t)) - s = t; - else - nr = rows (t); - sc = cell (nr, 1); - for j = 1:nr - n = 1:numel(t(j,:)); - m = find (t(j,:) == "\t"); - t(j,m) = " "; - for i = 1:numel(m) - k = tw * ceil (n(m(i)) / tw); - dn = k - n(m(i)); - n(m(i):end) += dn; - endfor - sc{j} = blanks (n(end)); - sc{j}(n) = t(j,:); - endfor - s = char (sc); - endif - else - error ("untabify: character strings to untabify must have 2 dimensions"); - endif + + if (ndims (t) != 2) + error ("untabify: character strings to untabify must have 2 dimensions"); + endif + + if (isempty (t)) + s = t; + else + nr = rows (t); + sc = cell (nr, 1); + for j = 1:nr + n = 1:numel(t(j,:)); + m = find (t(j,:) == "\t"); + t(j,m) = " "; + for i = 1:numel(m) + k = tw * ceil (n(m(i)) / tw); + dn = k - n(m(i)); + n(m(i):end) += dn; + endfor + sc{j} = blanks (n(end)); + sc{j}(n) = t(j,:); + endfor + s = char (sc); + endif + endfunction + %!test %! s = untabify ("\thello\t"); -%! assert (isequal (s, horzcat (blanks(8), "hello "))) +%! assert (s, [blanks(8) "hello" blanks(3)]); + +%!test +%! s = untabify ("\thello\t", 2); +%! assert (s, [blanks(2) "hello" blanks(1)]); %!test %! s = untabify ("\thello\t", 4, true); -%! assert (isequal (s, horzcat (blanks(4), "hello"))) +%! assert (s, [blanks(4) "hello"]); -%!test -%! s = untabify ("\thello\t", 2, true); -%! assert (isequal (s, horzcat (blanks(2), "hello"))) +%!assert (isempty (untabify (""))) %!test -%! s = untabify (""); -%! assert (isempty (s)) +%! s = char (randi ([97 97+25], 3, 3)); +%! assert (untabify (s), char (untabify (cellstr (s)))); -%!test -%! s = char (fix (100 + 10*rand (3,3))); -%! assert (isequal (untabify (s), untabify ({s}){1})) +%!error untabify () +%!error untabify (1,2,3,4) +%!error <must be a string> untabify (1)
--- a/scripts/strings/validatestring.m +++ b/scripts/strings/validatestring.m @@ -21,18 +21,37 @@ ## @deftypefnx {Function File} {@var{validstr} =} validatestring (@var{str}, @var{strarray}, @var{funcname}) ## @deftypefnx {Function File} {@var{validstr} =} validatestring (@var{str}, @var{strarray}, @var{funcname}, @var{varname}) ## @deftypefnx {Function File} {@var{validstr} =} validatestring (@dots{}, @var{position}) -## Verify that @var{str} is a string or substring of an element of +## Verify that @var{str} is an element, or substring of an element, in ## @var{strarray}. ## -## @var{str} is a character string to be tested, and @var{strarray} is a -## cellstr of valid values. @var{validstr} will be the validated form +## When @var{str} is a character string to be tested, and @var{strarray} is a +## cellstr of valid values, then @var{validstr} will be the validated form ## of @var{str} where validation is defined as @var{str} being a member -## or substring of @var{validstr}. If @var{str} is a substring of -## @var{validstr} and there are multiple matches, the shortest match -## will be returned if all matches are substrings of each other, and an -## error will be raised if the matches are not substrings of each other. +## or substring of @var{validstr}. This is useful for both verifying +## and expanding short options, such as "r", to their longer forms, such as +## "red". If @var{str} is a substring of @var{validstr}, and there are +## multiple matches, the shortest match will be returned if all matches are +## substrings of each other. Otherwise, an error will be raised because the +## expansion of @var{str} is ambiguous. All comparisons are case insensitive. +## +## The additional inputs @var{funcname}, @var{varname}, and @var{position} +## are optional and will make any generated validation error message more +## specific. ## -## All comparisons are case insensitive. +## Examples: +## @c Set example in small font to prevent overfull line +## +## @smallexample +## @group +## validatestring ("r", @{"red", "green", "blue"@}) +## @result{} "red" +## +## validatestring ("b", @{"red", "green", "blue", "black"@}) +## @result{} error: validatestring: multiple unique matches were found for 'b': +## blue, black +## @end group +## @end smallexample +## ## @seealso{strcmp, strcmpi} ## @end deftypefn @@ -44,55 +63,40 @@ print_usage (); endif - ## set the defaults - funcname = ""; - varname = ""; position = 0; - ## set the actual values - if (! isempty (varargin)) - if (isnumeric (varargin{end})) - position = varargin{end}; - varargin(end) = []; - endif + ## Process input arguments + if (! isempty (varargin) && isnumeric (varargin{end})) + position = varargin{end}; + varargin(end) = []; endif - funcnameset = false; - varnameset = false; - for i = 1:numel (varargin) - if (ischar (varargin{i})) - if (varnameset) - error ("validatestring: invalid number of character inputs: %d", - numel (varargin)); - elseif (funcnameset) - varname = varargin{i}; - varnameset = true; - else - funcname = varargin{i}; - funcnameset = true; - endif - endif - endfor + + funcname = varname = ""; + char_idx = cellfun ("isclass", varargin, "char"); + n_chararg = sum (char_idx); + if (n_chararg > 2) + error ("validatestring: invalid number of character inputs (3)"); + elseif (n_chararg == 2) + [funcname, varname] = deal (varargin{char_idx}); + elseif (n_chararg == 1) + funcname = varargin{char_idx}; + endif ## Check the inputs if (! ischar (str)) error ("validatestring: STR must be a character string"); - elseif (rows (str) != 1) - error ("validatestring: STR must have only one row"); + elseif (! isrow (str)) + error ("validatestring: STR must be a single row vector"); elseif (! iscellstr (strarray)) error ("validatestring: STRARRAY must be a cellstr"); - elseif (! ischar (funcname)) - error ("validatestring: FUNCNAME must be a character string"); - elseif (! isempty (funcname) && (rows (funcname) != 1)) - error ("validatestring: FUNCNAME must be exactly one row"); - elseif (! ischar (varname)) - error ("validatestring: VARNAME must be a character string"); - elseif (! isempty (varname) && (rows (varname) != 1)) - error ("validatestring: VARNAME must be exactly one row"); + elseif (! isempty (funcname) && ! isrow (funcname)) + error ("validatestring: FUNCNAME must be a single row vector"); + elseif (! isempty (varname) && ! isrow (varname)) + error ("validatestring: VARNAME must be a single row vector"); elseif (position < 0) error ("validatestring: POSITION must be >= 0"); endif - ## make the part of the error that will use funcname, varname, and - ## position + ## Make static part of error string that uses funcname, varname, and position errstr = ""; if (! isempty (funcname)) errstr = sprintf ("Function: %s ", funcname); @@ -109,35 +113,51 @@ matches = strncmpi (str, strarray(:), numel (str)); nmatches = sum (matches); - if (nmatches == 1) + if (nmatches == 0) + error ("validatestring: %s'%s' does not match any of\n%s", errstr, str, + sprintf ("%s, ", strarray{:})(1:end-2)); + elseif (nmatches == 1) str = strarray{matches}; - elseif (nmatches == 0) - error ("validatestring: %s%s does not match any of\n%s", errstr, str, - sprintf ("%s, ", strarray{:})(1:end-1)); else - ## are the matches a substring of each other, if so, choose the - ## shortest. If not, raise an error. + ## Are the matches substrings of each other? + ## If true, choose the shortest. If not, raise an error. match_idx = find (matches); - match_l = cellfun (@length, strarray(match_idx)); - longest_idx = find (match_l == max (match_l), 1); - shortest_idx = find (match_l == min (match_l), 1); - longest = strarray(match_idx)(longest_idx); - for i = 1:numel(match_idx) - currentmatch = strarray(match_idx(i)); - if (! strncmpi (longest, currentmatch, length(currentmatch))) - error ("validatestring: %smultiple unique matches were found for %s:\n%s", - errstr, sprintf ("%s, ", strarray(match_idx))(1:end-2)); - endif - endfor - str = strarray{shortest_idx}; + match_len = cellfun ("length", strarray(match_idx)); + [min_len, min_idx] = min (match_len); + short_str = strarray{match_idx(min_idx)}; + submatch = strncmpi (short_str, strarray(match_idx), min_len); + if (all (submatch)) + str = short_str; + else + error ("validatestring: %smultiple unique matches were found for '%s':\n%s", + errstr, str, sprintf ("%s, ", strarray{match_idx})(1:end-2)); + endif endif endfunction -## Tests + %!shared strarray %! strarray = {"octave" "Oct" "octopus" "octaves"}; %!assert (validatestring ("octave", strarray), "octave") %!assert (validatestring ("oct", strarray), "Oct") -%!assert (validatestring ("octave", strarray), "octave") -%!assert (validatestring ("octav", strarray), "octave") +%!assert (validatestring ("octa", strarray), "octave") +%! strarray = {"abc1" "def" "abc2"}; +%!assert (validatestring ("d", strarray), "def") +%!error <'xyz' does not match any> validatestring ("xyz", strarray) +%!error <Function: DUMMY_TEST> validatestring ("xyz", strarray, "DUMMY_TEST") +%!error <Function: DUMMY_TEST Variable: DUMMY_VAR:> validatestring ("xyz", strarray, "DUMMY_TEST", "DUMMY_VAR") +%!error <Function: DUMMY_TEST Variable: DUMMY_VAR Argument position 5> validatestring ("xyz", strarray, "DUMMY_TEST", "DUMMY_VAR", 5) +%!error <multiple unique matches were found for 'abc'> validatestring ("abc", strarray) + +%% Test input validation +%!error validatestring ("xyz") +%!error validatestring ("xyz", {"xyz"}, "3", "4", 5, 6) +%!error <invalid number of character inputs> validatestring ("xyz", {"xyz"}, "3", "4", "5") +%!error <STR must be a character string> validatestring (1, {"xyz"}, "3", "4", 5) +%!error <STR must be a single row vector> validatestring ("xyz".', {"xyz"}, "3", "4", 5) +%!error <STRARRAY must be a cellstr> validatestring ("xyz", "xyz", "3", "4", 5) +%!error <FUNCNAME must be a single row vector> validatestring ("xyz", {"xyz"}, "33".', "4", 5) +%!error <VARNAME must be a single row vector> validatestring ("xyz", {"xyz"}, "3", "44".', 5) +%!error <POSITION must be> validatestring ("xyz", {"xyz"}, "3", "4", -5) +
--- a/scripts/testfun/assert.m +++ b/scripts/testfun/assert.m @@ -23,35 +23,33 @@ ## @deftypefnx {Function File} {} assert (@var{observed}, @var{expected}) ## @deftypefnx {Function File} {} assert (@var{observed}, @var{expected}, @var{tol}) ## -## Produces an error if the condition is not met. @code{assert} can be -## called in three different ways. +## Produce an error if the specified condition is not met. @code{assert} can +## be called in three different ways. ## ## @table @code ## @item assert (@var{cond}) ## @itemx assert (@var{cond}, @var{errmsg}, @dots{}) ## @itemx assert (@var{cond}, @var{msg_id}, @var{errmsg}, @dots{}) ## Called with a single argument @var{cond}, @code{assert} produces an -## error if @var{cond} is zero. If called with a single argument a -## generic error message. With more than one argument, the additional -## arguments are passed to the @code{error} function. +## error if @var{cond} is zero. When called with more than one argument the +## additional arguments are passed to the @code{error} function. ## ## @item assert (@var{observed}, @var{expected}) ## Produce an error if observed is not the same as expected. Note that -## observed and expected can be strings, scalars, vectors, matrices, -## lists or structures. +## @var{observed} and @var{expected} can be scalars, vectors, matrices, +## strings, cell arrays, or structures. ## -## @item assert(@var{observed}, @var{expected}, @var{tol}) -## Accept a tolerance when comparing numbers. -## If @var{tol} is positive use it as an absolute tolerance, will produce an -## error if -## @code{abs(@var{observed} - @var{expected}) > abs(@var{tol})}. -## If @var{tol} is negative use it as a relative tolerance, will produce an -## error if -## @code{abs(@var{observed} - @var{expected}) > abs(@var{tol} * -## @var{expected})}. If @var{expected} is zero @var{tol} will always be used as -## an absolute tolerance. +## @item assert (@var{observed}, @var{expected}, @var{tol}) +## Produce an error if observed is not the same as expected but equality +## comparison for numeric data uses a tolerance @var{tol}. +## If @var{tol} is positive then it is an absolute tolerance which will produce +## an error if @code{abs(@var{observed} - @var{expected}) > abs(@var{tol})}. +## If @var{tol} is negative then it is a relative tolerance which will produce +## an error if @code{abs(@var{observed} - @var{expected}) > +## abs(@var{tol} * @var{expected})}. If @var{expected} is zero @var{tol} will +## always be interpreted as an absolute tolerance. ## @end table -## @seealso{test} +## @seealso{test, fail, error} ## @end deftypefn ## FIXME: Output throttling: don't print out the entire 100x100 matrix, @@ -81,11 +79,11 @@ print_usage (); endif - expected = varargin {1}; + expected = varargin{1}; if (nargin < 3) tol = 0; else - tol = varargin {2}; + tol = varargin{2}; endif if (exist ("argn") == 0) @@ -118,16 +116,16 @@ iserror = 1; else try - empty = numel (cond) == 0; - normal = numel (cond) == 1; + #empty = numel (cond) == 0; + empty = isempty (cond); + normal = (numel (cond) == 1); for [v, k] = cond if (! isfield (expected, k)) error (); endif if (empty) - v = cell (1, 0); - endif - if (normal) + v = {}; + elseif (normal) v = {v}; else v = v(:)'; @@ -147,7 +145,7 @@ else if (nargin < 3) ## Without explicit tolerance, be more strict. - if (! strcmp(class (cond), class (expected))) + if (! strcmp (class (cond), class (expected))) iserror = 1; coda = cstrcat ("Class ", class (cond), " != ", class (expected)); elseif (isnumeric (cond)) @@ -189,8 +187,8 @@ coda = "Infs don't match"; else ## Check normal values. - A = A(finite (A)); - B = B(finite (B)); + A = A(isfinite (A)); + B = B(isfinite (B)); if (tol == 0) err = any (A != B); errtype = "values do not match"; @@ -235,62 +233,56 @@ msg = cstrcat (msg, "\n", coda); endif error ("%s", msg); - ## disp (msg); - ## error ("assertion failed"); endif + endfunction -## empty -%!assert([]) -%!assert(zeros(3,0),zeros(3,0)) -%!error assert(zeros(3,0),zeros(0,2)) -%!error assert(zeros(3,0),[]) -%!fail("assert(zeros(2,0,2),zeros(2,0))", "Dimensions don't match") + +## empty input +%!assert ([]) +%!assert (zeros (3,0), zeros (3,0)) +%!error assert (zeros (3,0), zeros (0,2)) +%!error assert (zeros (3,0), []) +%!error <Dimensions don't match> assert (zeros (2,0,2), zeros (2,0)) ## conditions -%!assert(isempty([])) -%!assert(1) -%!error assert(0) -%!assert(ones(3,1)) -%!assert(ones(1,3)) -%!assert(ones(3,4)) -%!error assert([1,0,1]) -%!error assert([1;1;0]) -%!error assert([1,0;1,1]) +%!assert (isempty ([])) +%!assert (1) +%!error assert (0) +%!assert (ones(3,1)) +%!assert (ones(1,3)) +%!assert (ones(3,4)) +%!error assert ([1,0,1]) +%!error assert ([1;1;0]) +%!error assert ([1,0;1,1]) + +## scalars +%!error assert (3, [3,3; 3,3]) +%!error assert ([3,3; 3,3], 3) +%!assert (3, 3) +%!assert (3+eps, 3, eps) +%!assert (3, 3+eps, eps) +%!error assert (3+2*eps, 3, eps) +%!error assert (3, 3+2*eps, eps) ## vectors -%!assert([1,2,3],[1,2,3]); -%!assert([1;2;3],[1;2;3]); -%!error assert([2;2;3],[1;2;3]); -%!error assert([1,2,3],[1;2;3]); -%!error assert([1,2],[1,2,3]); -%!error assert([1;2;3],[1;2]); -%!assert([1,2;3,4],[1,2;3,4]); -%!error assert([1,4;3,4],[1,2;3,4]) -%!error assert([1,3;2,4;3,5],[1,2;3,4]) - -## exceptional values -%!assert([NaN, NA, Inf, -Inf, 1+eps, eps],[NaN, NA, Inf, -Inf, 1, 0],eps) -%!error assert(NaN, 1) -%!error assert(NA, 1) -%!error assert(-Inf, Inf) +%!assert ([1,2,3],[1,2,3]); +%!assert ([1;2;3],[1;2;3]); +%!error assert ([2;2;3],[1;2;3]); +%!error assert ([1,2,3],[1;2;3]); +%!error assert ([1,2],[1,2,3]); +%!error assert ([1;2;3],[1;2]); +%!assert ([1,2;3,4],[1,2;3,4]); +%!error assert ([1,4;3,4],[1,2;3,4]) +%!error assert ([1,3;2,4;3,5],[1,2;3,4]) -## scalars -%!error assert(3, [3,3; 3,3]) -%!error assert([3,3; 3,3], 3) -%!assert(3, 3); -%!assert(3+eps, 3, eps); -%!assert(3, 3+eps, eps); -%!error assert(3+2*eps, 3, eps); -%!error assert(3, 3+2*eps, eps); - -## must give a little space for floating point errors on relative -%!assert(100+100*eps, 100, -2*eps); -%!assert(100, 100+100*eps, -2*eps); -%!error assert(100+300*eps, 100, -2*eps); -%!error assert(100, 100+300*eps, -2*eps); -%!error assert(3, [3,3]); -%!error assert(3,4); +## must give a small tolerance for floating point errors on relative +%!assert (100+100*eps, 100, -2*eps) +%!assert (100, 100+100*eps, -2*eps) +%!error assert (100+300*eps, 100, -2*eps) +%!error assert (100, 100+300*eps, -2*eps) +%!error assert (3, [3,3]) +%!error assert (3, 4) ## test relative vs. absolute tolerances %!test assert (0.1+eps, 0.1, 2*eps); # accept absolute @@ -298,22 +290,48 @@ %!test assert (100+100*eps, 100, -2*eps); # accept relative %!error assert (100+100*eps, 100, 2*eps); # fail absolute +## exceptional values +%!assert ([NaN, NA, Inf, -Inf, 1+eps, eps], [NaN, NA, Inf, -Inf, 1, 0], eps) +%!error assert (NaN, 1) +%!error assert (NA, 1) +%!error assert (-Inf, Inf) + +## strings +%!assert ("dog", "dog") +%!error assert ("dog", "cat") +%!error assert ("dog", 3) +%!error assert (3, "dog") + ## structures %!shared x,y %! x.a = 1; x.b=[2, 2]; %! y.a = 1; y.b=[2, 2]; -%!assert (x,y) +%!assert (x, y) %!test y.b=3; -%!error assert (x,y) -%!error assert (3, x); -%!error assert (x, 3); +%!error assert (x, y) +%!error assert (3, x) +%!error assert (x, 3) +%!test +%! # Empty structures +%! x = resize (x, 0, 1); +%! y = resize (y, 0, 1); +%! assert (x, y); -## check usage statements +## cell arrays +%!test +%! x = {[3], [1,2,3]; 100+100*eps, "dog"}; +%! y = x; +%! assert (x, y); +%! y = x; y(1,1) = [2]; +%! fail ("assert (x, y)"); +%! y = x; y(1,2) = [0, 2, 3]; +%! fail ("assert (x, y)"); +%! y = x; y(2,1) = 101; +%! fail ("assert (x, y)"); +%! y = x; y(2,2) = "cat"; +%! fail ("assert (x, y)"); + +%% Test input validation %!error assert -%!error assert(1,2,3,4,5) +%!error assert (1,2,3,4) -## strings -%!assert("dog","dog") -%!error assert("dog","cat") -%!error assert("dog",3); -%!error assert(3,"dog");
--- a/scripts/testfun/demo.m +++ b/scripts/testfun/demo.m @@ -17,35 +17,39 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Command} {} demo @var{name} @var{n} +## @deftypefn {Command} {} demo @var{name} +## @deftypefnx {Command} {} demo @var{name} @var{n} +## @deftypefnx {Function File} {} demo ('@var{name}') ## @deftypefnx {Function File} {} demo ('@var{name}', @var{n}) ## -## Runs any examples associated with the function '@var{name}'. +## Run example code block @var{n} associated with the function @var{name}. +## If @var{n} is not specified, all examples are run. +## ## Examples are stored in the script file, or in a file with the same -## name but no extension somewhere on your path. To keep them separate -## from the usual script code, all lines are prefixed by @code{%!}. Each -## example is introduced by the keyword 'demo' flush left to the prefix, -## with no intervening spaces. The remainder of the example can contain -## arbitrary Octave code. For example: +## name but no extension located on Octave's load path. To keep examples +## separate from regular script code, all lines are prefixed by @code{%!}. Each +## example must also be introduced by the keyword 'demo' flush left to the +## prefix with no intervening spaces. The remainder of the example can +## contain arbitrary Octave code. For example: ## ## @example ## @group -## %!demo -## %! t=0:0.01:2*pi; x = sin(t); -## %! plot(t,x) -## %! %------------------------------------------------- -## %! % the figure window shows one cycle of a sine wave +## %!demo +## %! t=0:0.01:2*pi; x = sin(t); +## %! plot (t,x) +## %! %------------------------------------------------- +## %! % the figure window shows one cycle of a sine wave ## @end group ## @end example ## ## Note that the code is displayed before it is executed, so a simple -## comment at the end suffices. It is generally not necessary to use -## disp or printf within the demo. +## comment at the end suffices for labeling what is being shown. It is +## generally not necessary to use @code{disp} or @code{printf} within the demo. ## ## Demos are run in a function environment with no access to external -## variables. This means that all demos in your function must use -## separate initialization code. Alternatively, you can combine your -## demos into one huge demo, with the code: +## variables. This means that every demo must have separate initialization +## code. Alternatively, all demos can be combined into a single large demo +## with the code ## ## @example ## %! input("Press <enter> to continue: ","s"); @@ -53,11 +57,13 @@ ## ## @noindent ## between the sections, but this is discouraged. Other techniques -## include using multiple plots by saying figure between each, or -## using subplot to put multiple plots in the same window. +## to avoid multiple initialization blocks include using multiple plots +## with a new @code{figure} command between each plot, or using @code{subplot} +## to put multiple plots in the same window. ## -## Also, since demo evaluates inside a function context, you cannot -## define new functions inside a demo. Instead you will have to +## Also, because demo evaluates within a function context, you cannot +## define new functions inside a demo. If you must have function blocks, +## rather than just anonymous functions or inline functions, you will have to ## use @code{eval(example('function',n))} to see them. Because eval only ## evaluates one line, or one statement if the statement crosses ## multiple lines, you must wrap your demo in "if 1 <demo stuff> endif" @@ -73,6 +79,7 @@ ## %! endif ## @end group ## @end example +## ## @seealso{test, example} ## @end deftypefn @@ -88,20 +95,19 @@ if (nargin < 2) n = 0; - elseif (strcmp ("char", class (n))) + elseif (ischar (n)) n = str2double (n); - endif + endif [code, idx] = test (name, "grabdemo"); - if (length (idx) == 0) - warning ("demo not available for %s", name); + if (isempty (idx)) + warning ("no demo available for %s", name); return; elseif (n >= length (idx)) warning ("only %d demos available for %s", length (idx) - 1, name); return; endif - if (n > 0) doidx = n; else @@ -116,14 +122,22 @@ ## Process each demo without failing try block = code(idx(doidx(i)):idx(doidx(i)+1)-1); - ## Use an environment without variables - eval (cstrcat ("function __demo__()\n", block, "\nendfunction")); - ## Display the code that will be executed before executing it - printf ("%s example %d:%s\n\n", name, doidx(i), block); - __demo__; + ## FIXME: need to check for embedded test functions, which cause + ## segfaults, until issues with subfunctions in functions are resolved. + embed_func = regexp (block, '^\s*function ', 'once', 'lineanchors'); + if (isempty (embed_func)) + ## Use an environment without variables + eval (cstrcat ("function __demo__()\n", block, "\nendfunction")); + ## Display the code that will be executed before executing it + printf ("%s example %d:%s\n\n", name, doidx(i), block); + __demo__; + else + error (["Functions embedded in %!demo blocks are not allowed.\n", ... + "Use the %!function/%!endfunction syntax instead to define shared functions for testing.\n"]); + endif catch ## Let the programmer know which demo failed. - printf ("%s example %d: failed\n%s\n", name, doidx(i), __error_text__); + printf ("%s example %d: failed\n%s\n", name, doidx(i), lasterr ()); end_try_catch clear __demo__; endfor @@ -132,6 +146,9 @@ %!demo %! t=0:0.01:2*pi; x = sin(t); -%! plot(t,x) +%! plot (t,x) %! %------------------------------------------------- %! % the figure window shows one cycle of a sine wave + +%!error demo (); +%!error demo (1, 2, 3);
--- a/scripts/testfun/example.m +++ b/scripts/testfun/example.m @@ -17,16 +17,18 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Command} {} example @var{name} @var{n} +## @deftypefn {Command} {} example @var{name} +## @deftypefnx {Command} {} example @var{name} @var{n} +## @deftypefnx {Function File} {} example ('@var{name}') ## @deftypefnx {Function File} {} example ('@var{name}', @var{n}) -## @deftypefnx {Function File} {[@var{x}, @var{idx}] =} example ('@var{name}', @var{n}) +## @deftypefnx {Function File} {[@var{s}, @var{idx}] =} example (@dots{}) ## -## Display the code for example @var{n} associated with the function -## '@var{name}', but do not run it. If @var{n} is not given, all examples +## Display the code for example @var{n} associated with the function +## '@var{name}', but do not run it. If @var{n} is not specified, all examples ## are displayed. ## -## Called with output arguments, the examples are returned in the form of -## a string @var{x}, with @var{idx} indicating the ending position of the +## When called with output arguments, the examples are returned in the form of +## a string @var{s}, with @var{idx} indicating the ending position of the ## various examples. ## ## See @code{demo} for a complete explanation. @@ -41,9 +43,9 @@ if (nargin < 2) n = 0; - elseif (strcmp ("char", class (n))) + elseif (ischar (n)) n = str2double (n); - endif + endif [code, idx] = test (name, "grabdemo"); if (nargout > 0) @@ -65,34 +67,38 @@ else doidx = 1:length(idx)-1; endif - if (length (idx) == 0) - warning ("example not available for %s", name); + if (isempty (idx)) + warning ("no example available for %s", name); + return; elseif (n >= length(idx)) warning ("only %d examples available for %s", length(idx)-1, name); - doidx = []; + return; endif for i = 1:length (doidx) - block = code (idx(doidx(i)):idx(doidx(i)+1)-1); + block = code(idx(doidx(i)):idx(doidx(i)+1)-1); printf ("%s example %d:%s\n\n", name, doidx(i), block); endfor endif endfunction + %!## warning: don't modify the demos without modifying the tests! %!demo -%! example('example'); +%! example ('example'); %!demo -%! t=0:0.01:2*pi; x=sin(t); -%! plot(t,x) +%! t=0:0.01:2*pi; x = sin(t); +%! plot (t,x) -%!assert (example('example',1), "\n example('example');"); +%!assert (example('example',1), "\n example ('example');"); %!test -%! [code, idx] = example('example'); +%! [code, idx] = example ('example'); %! assert (code, ... -%! "\n example('example');\n t=0:0.01:2*pi; x=sin(t);\n plot(t,x)") -%! assert (idx, [1, 22, 59]); +%! "\n example ('example');\n t=0:0.01:2*pi; x = sin(t);\n plot (t,x)") +%! assert (idx, [1, 23, 63]); -%!error example; -%!error example('example',3,5) +%% Test input validation +%!error example +%!error example ('example', 3, 5) +
--- a/scripts/testfun/fail.m +++ b/scripts/testfun/fail.m @@ -20,7 +20,8 @@ ## public domain. ## -*- texinfo -*- -## @deftypefn {Function File} {} fail (@var{code}, @var{pattern}) +## @deftypefn {Function File} {} fail (@var{code}) +## @deftypefnx {Function File} {} fail (@var{code}, @var{pattern}) ## @deftypefnx {Function File} {} fail (@var{code}, 'warning', @var{pattern}) ## ## Return true if @var{code} fails with an error message matching @@ -45,7 +46,7 @@ ## Called with three arguments, the behavior is similar to ## @code{fail(@var{code}, @var{pattern})}, but produces an error if no ## warning is given during code execution or if the code fails. -## +## @seealso{assert} ## @end deftypefn ## Author: Paul Kienzle <pkienzle@users.sf.net> @@ -128,15 +129,16 @@ endfunction -%!fail ('[1,2]*[2,3]','nonconformant') -%!fail ("fail('[1,2]*[2;3]','nonconformant')","expected error <nonconformant> but got none") -%!fail ("fail('[1,2]*[2,3]','usage:')","expected error <usage:>\nbut got.*nonconformant") -%!fail ("warning('test warning')",'warning','test warning'); + +%!fail ('[1,2]*[2,3]', 'nonconformant') +%!fail ("fail('[1,2]*[2;3]', 'nonconformant')", "expected error <nonconformant> but got none") +%!fail ("fail('[1,2]*[2,3]','usage:')", "expected error <usage:>\nbut got.*nonconformant") +%!fail ("warning('test warning')", 'warning','test warning'); -%!# fail ("warning('next test')",'warning','next test'); ## only allowed one warning test?!? +##% !fail ("warning('next test')",'warning','next test'); ## only allowed one warning test?!? -## Comment out the following tests if you don't want to see what -## errors look like -% !fail ('a*[2;3]', 'nonconformant') -% !fail ('a*[2,3]', 'usage:') -% !fail ("warning('warning failure')", 'warning', 'success') +%% Test that fail() itself will generate an error +%!error fail ("1"); +%!error <undefined> fail ('a*[2;3]', 'nonconformant') +%!error <expected error> fail ('a*[2,3]', 'usage:') +%!error <warning failure> fail ("warning('warning failure')", 'warning', 'success')
--- a/scripts/testfun/rundemos.m +++ b/scripts/testfun/rundemos.m @@ -17,7 +17,12 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} rundemos (@var{directory}) +## @deftypefn {Function File} {} rundemos () +## @deftypefnx {Function File} {} rundemos (@var{directory}) +## Execute built-in demos for all function files in the specified directory. +## If no directory is specified, operate on all directories in Octave's +## search path for functions. +## @seealso{runtests, path} ## @end deftypefn ## Author: jwe @@ -30,6 +35,7 @@ if (is_absolute_filename (directory)) dirs = {directory}; else + directory = regexprep (directory, ['\',filesep(),'$'], ""); fullname = find_dir_in_path (directory); if (! isempty (fullname)) dirs = {fullname}; @@ -56,7 +62,11 @@ if (length (f) > 2 && strcmp (f((end-1):end), ".m")) f = fullfile (directory, f); if (has_demos (f)) - demo (f); + try + demo (f); + catch + printf ("error: %s\n\n", lasterror().message) + end_try_catch if (i != numel (flist)) input ("Press <enter> to continue: ", "s"); endif @@ -75,3 +85,5 @@ retval = findstr (str, "%!demo"); endif endfunction + +%!error rundemos ("foo", 1);
--- a/scripts/testfun/runtests.m +++ b/scripts/testfun/runtests.m @@ -17,8 +17,12 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} runtests (@var{directory}) +## @deftypefn {Function File} {} runtests () +## @deftypefnx {Function File} {} runtests (@var{directory}) ## Execute built-in tests for all function files in the specified directory. +## If no directory is specified, operate on all directories in Octave's +## search path for functions. +## @seealso{rundemos, path} ## @end deftypefn ## Author: jwe @@ -31,6 +35,7 @@ if (is_absolute_filename (directory)) dirs = {directory}; else + directory = regexprep (directory, ['\',filesep(),'$'], ""); fullname = find_dir_in_path (directory); if (! isempty (fullname)) dirs = {fullname};
--- a/scripts/testfun/speed.m +++ b/scripts/testfun/speed.m @@ -25,14 +25,15 @@ ## each @var{n}, an initialization expression (@var{init}) is computed to ## create any data needed for the test. If a second expression (@var{f2}) is ## given then the execution times of the two expressions are compared. When -## called without output arguments the results are displayed graphically. +## called without output arguments the results are printed to stdout and +## displayed graphically. ## ## @table @code ## @item @var{f} -## The expression to evaluate. +## The code expression to evaluate. ## ## @item @var{max_n} -## The maximum test length to run. Default value is 100. Alternatively, +## The maximum test length to run. The default value is 100. Alternatively, ## use @code{[min_n, max_n]} or specify the @var{n} exactly with ## @code{[n1, n2, @dots{}, nk]}. ## @@ -59,7 +60,7 @@ ## is a structure with fields @code{a} and @code{p}. ## ## @item @var{n} -## The values @var{n} for which the expression was calculated AND +## The values @var{n} for which the expression was calculated @strong{AND} ## the execution time was greater than zero. ## ## @item @var{T_f} @@ -67,7 +68,7 @@ ## ## @item @var{T_f2} ## The nonzero execution times recorded for the expression @var{f2} in seconds. -## If required, the mean time ratio is simply @code{mean (T_f./T_f2)}. +## If required, the mean time ratio is simply @code{mean (T_f ./ T_f2)}. ## ## @end table ## @@ -115,8 +116,8 @@ ## ## @example ## @group -## speed ("v = sum (x)", "", [10000, 100000], ... -## "v = 0; for i = 1:length (x), v += x(i); end") +## speed ("sum (x)", "", [10000, 100000], ... +## "v = 0; for i = 1:length (x), v += x(i); endfor") ## @end group ## @end example ## @@ -127,47 +128,37 @@ ## ## @example ## @group -## speed ("v = xcorr (x, n)", "x = rand (128, 1);", 100, -## "v2 = xcorr_orig (x, n)", -100*eps) -## speed ("v = xcorr (x, 15)", "x = rand (20+n, 1);", 100, -## "v2 = xcorr_orig (x, n)", -100*eps) +## speed ("xcorr (x, n)", "x = rand (128, 1);", 100, +## "xcorr_orig (x, n)", -100*eps) +## speed ("xcorr (x, 15)", "x = rand (20+n, 1);", 100, +## "xcorr_orig (x, n)", -100*eps) ## @end group ## @end example ## ## Assuming one of the two versions is in xcorr_orig, this ## would compare their speed and their output values. Note that the -## FFT version is not exact, so we specify an acceptable tolerance on -## the comparison @code{100*eps}, and that the errors should be computed -## relatively, as @code{abs ((@var{x} - @var{y}) ./ @var{y})} rather than -## absolutely as @code{abs (@var{x} - @var{y})}. +## FFT version is not exact, so one must specify an acceptable tolerance on +## the comparison @code{100*eps}. In this case, the comparison should be +## computed relatively, as @code{abs ((@var{x} - @var{y}) ./ @var{y})} rather +## than absolutely as @code{abs (@var{x} - @var{y})}. ## -## Type @code{example('speed')} to see some real examples. Note that for -## obscure reasons, examples 1 and 2 can not be run directly using -## @code{demo('speed')}. Instead use, @code{eval ( example('speed', 1) )} -## or @code{eval ( example('speed', 2) )}. +## Type @kbd{example ("speed")} to see some real examples or +## @kbd{demo ("speed")} to run them. ## @end deftypefn ## FIXME: consider two dimensional speedup surfaces for functions like kron. -function [__order, __test_n, __tnew, __torig] = speed (__f1, __init, __max_n, __f2, __tol) +function [__order, __test_n, __tnew, __torig] = speed (__f1, __init, __max_n = 100, __f2 = "", __tol = eps) if (nargin < 1 || nargin > 6) print_usage (); endif if (nargin < 2 || isempty (__init)) - __init = "x = randn(n, 1);"; - endif - - if (nargin < 3 || isempty (__max_n)) - __max_n = 100; + __init = "x = randn (n, 1)"; endif - if (nargin < 4) - __f2 = []; - endif - - if (nargin < 5 || isempty (__tol)) - __tol = eps; + if (isempty (__max_n)) + __max_n = 100; endif __numtests = 15; @@ -178,11 +169,12 @@ assert (__max_n > __min_n); __test_n = logspace (0, log10 (__max_n), __numtests); elseif (length (__max_n) == 2) - __min_n = __max_n(1); - __max_n = __max_n(2); + [__min_n, __max_n] = deal (__max_n(1), __max_n(2)); assert (__min_n >= 1); + assert (__max_n > __min_n); __test_n = logspace (log10 (__min_n), log10 (__max_n), __numtests); else + assert (all (__max_n > 0)); __test_n = __max_n; endif ## Force n to be an integer. @@ -191,83 +183,116 @@ __torig = __tnew = zeros (size (__test_n)); - disp (cstrcat ("testing ", __f1, "\ninit: ", __init)); + ## Print and plot the data if no output is requested. + do_display = (nargout == 0); + + if (do_display) + disp (cstrcat ("testing ", __f1, "\ninit: ", __init)); + endif + + ## Add semicolon closure to all code fragments in case user has not done so. + __init = cstrcat (__init, ";"); + __f1 = cstrcat (__f1, ";"); + if (! isempty (__f2)) + __f2 = cstrcat (__f2, ";"); + endif ## Make sure the functions are freshly loaded by evaluating them at ## test_n(1); first have to initialize the args though. n = 1; k = 0; - eval (cstrcat (__init, ";")); + eval (__init); + eval (__f1); if (! isempty (__f2)) - eval (cstrcat (__f2, ";")); + eval (__f2); endif - eval (cstrcat (__f1, ";")); ## Run the tests. for k = 1:length (__test_n) n = __test_n(k); - eval (cstrcat (__init, ";")); + eval (__init); - printf ("n%i = %i ",k, n); - fflush (stdout); - eval (cstrcat ("__t = time();", __f1, "; __v1=ans; __t = time()-__t;")); + if (do_display) + printf ("n%i = %i ", k, n); + fflush (stdout); + endif + + eval (cstrcat ("__t = time();", __f1, "__v1=ans; __t = time()-__t;")); if (__t < 0.25) - eval (cstrcat ("__t2 = time();", __f1, "; __t2 = time()-__t2;")); - eval (cstrcat ("__t3 = time();", __f1, "; __t3 = time()-__t3;")); + eval (cstrcat ("__t2 = time();", __f1, "__t2 = time()-__t2;")); + eval (cstrcat ("__t3 = time();", __f1, "__t3 = time()-__t3;")); __t = min ([__t, __t2, __t3]); endif __tnew(k) = __t; if (! isempty (__f2)) - eval (cstrcat ("__t = time();", __f2, "; __v2=ans; __t = time()-__t;")); + eval (cstrcat ("__t = time();", __f2, "__v2=ans; __t = time()-__t;")); if (__t < 0.25) - eval (cstrcat ("__t2 = time();", __f2, "; __t2 = time()-__t2;")); - eval (cstrcat ("__t3 = time();", __f2, "; __t3 = time()-__t3;")); + eval (cstrcat ("__t2 = time();", __f2, "__t2 = time()-__t2;")); + eval (cstrcat ("__t3 = time();", __f2, "__t3 = time()-__t3;")); + __t = min ([__t, __t2, __t3]); endif __torig(k) = __t; if (! isinf(__tol)) assert (__v1, __v2, __tol); endif endif + endfor ## Drop times of zero. - if (! isempty (__f2)) - zidx = (__tnew < 100*eps | __torig < 100*eps); + if (isempty (__f2)) + zidx = (__tnew < 100*eps); + __test_n(zidx) = []; + __tnew(zidx) = []; + else + zidx = (__tnew < 100*eps | __torig < 100*eps); __test_n(zidx) = []; __tnew(zidx) = []; __torig(zidx) = []; - else - zidx = (__tnew < 100*eps); - __test_n(zidx) = []; - __tnew(zidx) = []; + endif + + if (isempty (__test_n)) + error (["speed: All running times were zero.\n", + "error: speed: Choose larger MAX_N or do more work per function evaluation"]); endif ## Approximate time complexity and return it if requested. - tailidx = ceil(length(__test_n)/2):length(__test_n); + tailidx = ceil (length (__test_n)/2):length (__test_n); p = polyfit (log (__test_n(tailidx)), log (__tnew(tailidx)), 1); if (nargout > 0) __order.p = p(1); __order.a = exp (p(2)); endif - ## Plot the data if no output is requested. - doplot = (nargout == 0); - - if (doplot) + if (do_display) figure; + ## Strip semicolon added to code fragments before displaying + __init(end) = ""; + __f1(end) = ""; + if (! isempty (__f2)) + __f2(end) = ""; + endif endif - if (doplot && ! isempty (__f2)) + if (do_display && isempty (__f2)) + + loglog (__test_n, __tnew*1000, "*-g;execution time;"); + xlabel ("test length"); + ylabel ("best execution time (ms)"); + title ({__f1, cstrcat("init: ", __init)}); + + elseif (do_display) + subplot (1, 2, 1); semilogx (__test_n, __torig./__tnew, - cstrcat ("-*r;", strrep (__f1, ";", "."), "/", - strrep (__f2, ";", "."), ";"), + cstrcat ("-*r;", strrep (__f1, ";", "."), " / ", + strrep (__f2, ";", "."), ";"), __test_n, __tnew./__torig, - cstrcat ("-*g;", strrep (__f2, ";", "."), "/", - strrep (__f1, ";", "."), ";")); + cstrcat ("-*g;", strrep (__f2, ";", "."), " / ", + strrep (__f1, ";", "."), ";")); + title ("Speedup Ratio"); xlabel ("test length"); - title (__f1); ylabel ("speedup ratio"); subplot (1, 2, 2); @@ -275,31 +300,32 @@ cstrcat ("*-g;", strrep (__f1, ";", "."), ";"), __test_n, __torig*1000, cstrcat ("*-r;", strrep (__f2,";","."), ";")); - + title ({"Execution Times", cstrcat("init: ", __init)}); xlabel ("test length"); ylabel ("best execution time (ms)"); - title (cstrcat ("init: ", __init)); ratio = mean (__torig ./ __tnew); printf ("\n\nMean runtime ratio = %.3g for '%s' vs '%s'\n", ratio, __f2, __f1); - elseif (doplot) - - loglog (__test_n, __tnew*1000, "*-g;execution time;"); - xlabel ("test length"); - ylabel ("best execution time (ms)"); - title (cstrcat (__f1, " init: ", __init)); - endif - if (doplot) + if (do_display) ## Plot time complexity approximation (using milliseconds). - order = sprintf ("O(n^%g)", round (10*p(1))/10); + figure; # Open second plot window + + order = round (10*p(1))/10; + if (order >= 0.1) + order = sprintf ("O(n^%g)", order); + else + order = "O(1)"; + endif v = polyval (p, log (__test_n(tailidx))); loglog (__test_n(tailidx), exp(v)*1000, sprintf ("b;%s;", order)); + title ({"Time Complexity", __f1}); + xlabel ("test length"); ## Get base time to 1 digit of accuracy. dt = exp (p(2)); @@ -323,58 +349,96 @@ endfunction -%!demo if 1 -%! function x = build_orig(n) -%! ## extend the target vector on the fly -%! for i=0:n-1, x([1:10]+i*10) = 1:10; endfor -%! endfunction -%! function x = build(n) -%! ## preallocate the target vector -%! x = zeros(1, n*10); -%! try -%! if (prefer_column_vectors), x = x.'; endif -%! catch -%! end -%! for i=0:n-1, x([1:10]+i*10) = 1:10; endfor -%! endfunction + +%% FIXME: Demos with declared functions do not work. See bug #31815. +%% A workaround has been hacked by not declaring the functions +%% but using eval to create them in the proper context. +%% Unfortunately, we can't remove them from the user's workspace +%% because of another bug (#34497). +%!demo +%! fstr_build_orig = cstrcat ( +%! "function x = build_orig (n)\n", +%! " ## extend the target vector on the fly\n", +%! " for i=0:n-1, x([1:100]+i*100) = 1:100; endfor\n", +%! "endfunction"); +%! fstr_build = cstrcat ( +%! "function x = build (n)\n", +%! " ## preallocate the target vector\n", +%! " x = zeros (1, n*100);\n", +%! " for i=0:n-1, x([1:100]+i*100) = 1:100; endfor\n", +%! "endfunction"); %! -%! disp("-----------------------"); -%! type build_orig; -%! disp("-----------------------"); -%! type build; -%! disp("-----------------------"); +%! disp ("-----------------------"); +%! disp (fstr_build_orig); +%! disp ("-----------------------"); +%! disp (fstr_build); +%! disp ("-----------------------"); %! -%! disp("Preallocated vector test.\nThis takes a little while..."); -%! speed('build(n)', '', 1000, 'build_orig(n)'); -%! clear build build_orig -%! disp("Note how much faster it is to pre-allocate a vector."); -%! disp("Notice the peak speedup ratio."); -%! endif +%! ## Eval functions strings to create them in the current context +%! eval (fstr_build_orig); +%! eval (fstr_build); +%! +%! disp ("Preallocated vector test.\nThis takes a little while..."); +%! speed("build (n)", "", 1000, "build_orig (n)"); +%! clear -f build build_orig +%! disp ("Note how much faster it is to pre-allocate a vector."); +%! disp ("Notice the peak speedup ratio."); -%!demo if 1 -%! function x = build_orig(n) -%! for i=0:n-1, x([1:10]+i*10) = 1:10; endfor -%! endfunction -%! function x = build(n) -%! idx = [1:10]'; -%! x = idx(:,ones(1,n)); -%! x = reshape(x, 1, n*10); -%! try -%! if (prefer_column_vectors), x = x.'; endif -%! catch -%! end -%! endfunction +%!demo +%! fstr_build_orig = cstrcat ( +%! "function x = build_orig (n)\n", +%! " for i=0:n-1, x([1:100]+i*100) = 1:100; endfor\n", +%! "endfunction"); +%! fstr_build = cstrcat ( +%! "function x = build (n)\n", +%! " idx = [1:100]';\n", +%! " x = idx(:,ones(1,n));\n", +%! " x = reshape (x, 1, n*100);\n", +%! "endfunction"); +%! +%! disp ("-----------------------"); +%! disp (fstr_build_orig); +%! disp ("-----------------------"); +%! disp (fstr_build); +%! disp ("-----------------------"); +%! +%! ## Eval functions strings to create them in the current context +%! eval (fstr_build_orig); +%! eval (fstr_build); %! -%! disp("-----------------------"); -%! type build_orig; -%! disp("-----------------------"); -%! type build; -%! disp("-----------------------"); -%! -%! disp("Vectorized test.\nThis takes a little while..."); -%! speed('build(n)', '', 1000, 'build_orig(n)'); -%! clear build build_orig -%! disp("-----------------------"); -%! disp("This time, the for loop is done away with entirely."); -%! disp("Notice how much bigger the speedup is than in example 1."); -%! endif +%! disp ("Vectorized test.\nThis takes a little while..."); +%! speed("build (n)", "", 1000, "build_orig (n)"); +%! clear -f build build_orig +%! disp ("-----------------------"); +%! disp ("This time, the for loop is done away with entirely."); +%! disp ("Notice how much bigger the speedup is than in example 1."); + +%!test +%! [order, n, T_f1, T_f2] = speed ("airy (x)", "x = rand (n, 10)", [100, 1000]); +%! assert (isstruct (order)); +%! assert (size (order), [1, 1]); +%! assert (fieldnames (order), {"p"; "a"}); +%! assert (isnumeric (n)); +%! assert (length (n) > 10); +%! assert (isnumeric (T_f1)); +%! assert (size (T_f1), size (n)); +%! assert (isnumeric (T_f2)); +%! assert (length (T_f2) > 10); + +%% This test is known to fail on operating systems with low resolution timers such as MinGW +%!xtest +%! [order, n, T_f1, T_f2] = speed ("sum (x)", "", [100, 1000], "v = 0; for i = 1:length (x), v += x(i); endfor"); +%! assert (isstruct (order)); +%! assert (size (order), [1, 1]); +%! assert (fieldnames (order), {"p"; "a"}); +%! assert (isnumeric (n)); +%! assert (length (n) > 10); +%! assert (isnumeric (T_f1)); +%! assert (size (T_f1), size (n)); +%! assert (isnumeric (T_f2)); +%! assert (length (T_f2) > 10); + +%% Test input validation +%!error speed (); +%!error speed (1, 2, 3, 4, 5, 6, 7); +
--- a/scripts/testfun/test.m +++ b/scripts/testfun/test.m @@ -132,7 +132,7 @@ __rundemo = 0; __verbose = 0; __demo_code = ""; - __demo_idx = 1; + __demo_idx = []; elseif (strcmp (__flag, "explain")) fprintf (__fid, "# %s new test file\n", __signal_file); fprintf (__fid, "# %s no tests in file\n", __signal_empty); @@ -286,7 +286,7 @@ input ("Press <enter> to continue: ", "s"); catch __success = 0; - __msg = sprintf ("%sdemo failed\n%s", __signal_fail, __error_text__); + __msg = sprintf ("%sdemo failed\n%s", __signal_fail, lasterr ()); end_try_catch clear __test__; @@ -359,11 +359,19 @@ catch __success = 0; __msg = sprintf ("%stest failed: syntax error\n%s", - __signal_fail, __error_text__); + __signal_fail, lasterr ()); end_try_catch endif __code = ""; +### ENDFUNCTION + + elseif (strcmp (__type, "endfunction")) + ## endfunction simply declares the end of a previous function block. + ## There is no processing to be done here, just skip to next block. + __istest = 0; + __code = ""; + ### ASSERT/FAIL elseif (strcmp (__type, "assert") || strcmp (__type, "fail")) @@ -389,7 +397,7 @@ catch __success = 0; __msg = sprintf ("%stest failed: syntax error\n%s", - __signal_fail, __error_text__); + __signal_fail, lasterr ()); end_try_catch if (__success) @@ -483,18 +491,26 @@ ## evaluate code for test, shared, and assert. if (! isempty(__code)) try - eval (sprintf ("function %s__test__(%s)\n%s\nendfunction", - __shared_r,__shared, __code)); - eval (sprintf ("%s__test__(%s);", __shared_r, __shared)); + ## FIXME: need to check for embedded test functions, which cause + ## segfaults, until issues with subfunctions in functions are resolved. + embed_func = regexp (__code, '^\s*function ', 'once', 'lineanchors'); + if (isempty (embed_func)) + eval (sprintf ("function %s__test__(%s)\n%s\nendfunction", + __shared_r,__shared, __code)); + eval (sprintf ("%s__test__(%s);", __shared_r, __shared)); + else + error (["Functions embedded in %!test blocks are not allowed.\n", ... + "Use the %!function/%!endfunction syntax instead to define shared functions for testing.\n"]); + endif catch if (strcmp (__type, "xtest")) - __msg = sprintf ("%sknown failure\n%s", __signal_fail, __error_text__); + __msg = sprintf ("%sknown failure\n%s", __signal_fail, lasterr ()); __xfail++; else - __msg = sprintf ("%stest failed\n%s", __signal_fail, __error_text__); + __msg = sprintf ("%stest failed\n%s", __signal_fail, lasterr ()); __success = 0; endif - if (isempty (__error_text__)) + if (isempty (lasterr ())) error ("empty error text, probably Ctrl-C --- aborting"); endif end_try_catch @@ -669,13 +685,14 @@ %!xtest error("This test is known to fail") ### example from toeplitz -%!shared msg -%! msg="expecting vector arguments"; -%!fail ('toeplitz([])', msg); -%!fail ('toeplitz([1,2],[])', msg); -%!fail ('toeplitz([1,2;3,4])', msg); -%!fail ('toeplitz([1,2],[1,2;3,4])', msg); -%!fail ('toeplitz ([1,2;3,4],[1,2])', msg); +%!shared msg1,msg2 +%! msg1="C must be a vector"; +%! msg2="C and R must be vectors"; +%!fail ('toeplitz([])', msg1); +%!fail ('toeplitz([1,2;3,4])', msg1); +%!fail ('toeplitz([1,2],[])', msg2); +%!fail ('toeplitz([1,2],[1,2;3,4])', msg2); +%!fail ('toeplitz ([1,2;3,4],[1,2])', msg2); % !fail ('toeplitz','usage: toeplitz'); # usage doesn't generate an error % !fail ('toeplitz(1, 2, 3)', 'usage: toeplitz'); %!test assert (toeplitz ([1,2,3], [1,4]), [1,4; 2,1; 3,2]); @@ -761,16 +778,19 @@ %!function x = __test_a(y) %! x = 2*y; +%!endfunction %!assert(__test_a(2),4); # Test a test function %!function __test_a (y) %! x = 2*y; +%!endfunction %!test %! __test_a(2); # Test a test function with no return value %!function [x,z] = __test_a (y) %! x = 2*y; %! z = 3*y; +%!endfunction %!test # Test a test function with multiple returns %! [x,z] = __test_a(3); %! assert(x,6);
--- a/scripts/time/addtodate.m +++ b/scripts/time/addtodate.m @@ -18,32 +18,33 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{d} =} addtodate (@var{d}, @var{q}, @var{f}) -## Add @var{q} amount of time (with units @var{f}) to the datenum, @var{d}. +## Add @var{q} amount of time (with units @var{f}) to the serial datenum, +## @var{d}. ## -## @var{f} must be one of "year", "month", "day", "hour", "minute", or -## "second". -## @seealso{datenum, datevec} +## @var{f} must be one of "year", "month", "day", "hour", "minute", "second", +## or "millisecond". +## @seealso{datenum, datevec, etime} ## @end deftypefn ## Author: Bill Denney <bill@denney.ws> function d = addtodate (d, q, f) + persistent mult = struct ("day", 1, "hour", 1/24, "minute", 1/1440, ... + "second", 1/86400, "millisecond", 1/86400000); + if (nargin != 3) print_usage (); - elseif (! (ischar (f) && rows (f) == 1)) - ## FIXME: enhance the function so that it works with cellstrs of the - ## same size as the output. - error ("addtodate: F must be a single row character string"); + elseif (! (ischar (f) && isrow (f))) + error ("addtodate: F must be a single character string"); endif - if (numel (d) == 1 && numel (q) > 1) - ## expand d to the size of q if d only has one element to make - ## addition later eaiser. - d = d.*ones (size (q)); + if (isscalar (d) && ! isscalar (q)) + ## expand d to size of q to make later addition easier. + d = repmat (d, size (q)); endif - ## in case the user gives f as a plural, remove the s + ## in case the user gives f as a plural, remove the 's' if ("s" == f(end)) f(end) = []; endif @@ -65,15 +66,15 @@ else d = reshape (dnew, size (q)); endif - elseif (any (strcmpi ({"day" "hour" "minute" "second"}, f))) - mult = struct ("day", 1, "hour", 1/24, "minute", 1/1440, "second", 1/86400); - d += q.*mult.(f); + elseif (any (strcmpi ({"day" "hour" "minute" "second", "millisecond"}, f))) + d += q .* mult.(f); else error ("addtodate: Invalid time unit: %s", f); endif endfunction + ## tests %!shared d %! d = datenum (2008, 1, 1); @@ -84,6 +85,7 @@ %!assert (addtodate (d, 0, "hour"), d) %!assert (addtodate (d, 0, "minute"), d) %!assert (addtodate (d, 0, "second"), d) +%!assert (addtodate (d, 0, "millisecond"), d) ## Add one of each ## leap year %!assert (addtodate (d, 1, "year"), d+366) @@ -92,6 +94,7 @@ %!assert (addtodate (d, 1, "hour"), d+1/24) %!assert (addtodate (d, 1, "minute"), d+1/1440) %!assert (addtodate (d, 1, "second"), d+1/86400) +%!assert (addtodate (d, 1, "millisecond"), d+1/86400000) ## substract one of each %!assert (addtodate (d, -1, "year"), d-365) %!assert (addtodate (d, -1, "month"), d-31) @@ -99,6 +102,7 @@ %!assert (addtodate (d, -1, "hour"), d-1/24) %!assert (addtodate (d, -1, "minute"), d-1/1440) %!assert (addtodate (d, -1, "second"), d-1/86400) +%!assert (addtodate (d, -1, "millisecond"), d-1/86400000) ## rollover %!assert (addtodate (d, 12, "month"), d+366) %!assert (addtodate (d, 13, "month"), d+366+31) @@ -109,3 +113,13 @@ %!assert (addtodate (d, [1 13], "month"), [d+31 d+366+31]) %!assert (addtodate ([d;d+1], 1, "month"), [d+31;d+1+31]) %!assert (addtodate ([d d+1], 1, "month"), [d+31 d+1+31]) + +%% Test input validation +%!error addtodate () +%!error addtodate (1) +%!error addtodate (1,2) +%!error addtodate (1,2,3,4) +%!error <F must be a single character string> addtodate (1,2,3) +%!error <F must be a single character string> addtodate (1,2,"month"') +%!error <Invalid time unit> addtodate (1,2,"abc") +
--- a/scripts/time/asctime.m +++ b/scripts/time/asctime.m @@ -18,36 +18,37 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} asctime (@var{tm_struct}) -## Convert a time structure to a string using the following five-field -## format: Thu Mar 28 08:40:14 1996. For example: +## Convert a time structure to a string using the following +## format: "ddd mmm mm HH:MM:SS yyyy". For example: ## ## @example ## @group ## asctime (localtime (time ())) -## @result{} "Mon Feb 17 01:15:06 1997\n" +## @result{} "Mon Feb 17 01:15:06 1997" ## @end group ## @end example ## ## This is equivalent to @code{ctime (time ())}. +## @seealso{ctime, localtime, time} ## @end deftypefn ## Author: jwe function retval = asctime (tm_struct) - if (nargin == 1) - retval = strftime ("%a %b %d %H:%M:%S %Y\n", tm_struct); - else + if (nargin != 1) print_usage (); endif + retval = strftime ("%a %b %d %H:%M:%S %Y\n", tm_struct); + endfunction + %!test %! t = time (); %! assert(strcmp (asctime (localtime (t)), ctime (t))); %!error asctime (); - %!error asctime (1, 2);
--- a/scripts/time/calendar.m +++ b/scripts/time/calendar.m @@ -17,22 +17,21 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} calendar (@dots{}) -## @deftypefnx {Function File} {@var{c} =} calendar () +## @deftypefn {Function File} {@var{c} =} calendar () ## @deftypefnx {Function File} {@var{c} =} calendar (@var{d}) ## @deftypefnx {Function File} {@var{c} =} calendar (@var{y}, @var{m}) -## If called with no arguments, return the current monthly calendar in -## a 6x7 matrix. +## @deftypefnx {Function File} {} calendar (@dots{}) +## Return the current monthly calendar in a 6x7 matrix. ## ## If @var{d} is specified, return the calendar for the month containing -## the day @var{d}, which must be a serial date number or a date string. +## the date @var{d}, which must be a serial date number or a date string. ## ## If @var{y} and @var{m} are specified, return the calendar for year @var{y} ## and month @var{m}. ## ## If no output arguments are specified, print the calendar on the screen ## instead of returning a matrix. -## @seealso{datenum} +## @seealso{datenum, datestr} ## @end deftypefn ## Author: pkienzle <pkienzle@users.sf.net> @@ -72,13 +71,10 @@ str = sprintf (" %2d %2d %2d %2d %2d %2d %2d\n", c); ## Print an asterisk before the specified date - if (! isempty (d) && d >= 1 && d <= ndays) + if (! isempty (d)) pos = weekday (dayone) + d - 1; - idx = 6 * (pos - 1) + floor (pos / 7) + 1; - while (str(idx) == " ") - ++idx; - endwhile - str(--idx) = "*"; + idx = 6*pos + fix (pos / 7.1) - ifelse (d < 10, 1, 2); + str(idx) = "*"; endif ## Display the calendar. @@ -91,11 +87,18 @@ endfunction -# tests -%!assert((calendar(2000,2))'(2:31),[0:29]); -%!assert((calendar(1957,10))'(2:33),[0:31]); -# demos + +## demos %!demo +%! ## Calendar for current month %! calendar () %!demo %! calendar (1957, 10) + +## tests +%!assert ((calendar(2000,2))'(2:31), [0:29]) +%!assert ((calendar(1957,10))'(2:33), [0:31]) + +%% Test input validation +%!error calendar (1,2,3) +
--- a/scripts/time/clock.m +++ b/scripts/time/clock.m @@ -18,18 +18,23 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} clock () -## Return a vector containing the current year, month (1-12), day (1-31), -## hour (0-23), minute (0-59) and second (0-61). For example: +## Return the current local date and time as a date vector. The date vector +## contains the following fields: current year, month (1-12), day (1-31), +## hour (0-23), minute (0-59), and second (0-61). The seconds field has +## a fractional part after the decimal point for extended accuracy. +## +## For example: ## ## @example ## @group -## clock () +## fix (clock ()) ## @result{} [ 1993, 8, 20, 4, 56, 1 ] ## @end group ## @end example ## ## The function clock is more accurate on systems that have the ## @code{gettimeofday} function. +## @seealso{now, date, datevec} ## @end deftypefn ## Author: jwe
--- a/scripts/time/ctime.m +++ b/scripts/time/ctime.m @@ -26,28 +26,29 @@ ## @example ## @group ## ctime (time ()) -## @result{} "Mon Feb 17 01:15:06 1997\n" +## @result{} "Mon Feb 17 01:15:06 1997" ## @end group ## @end example +## @seealso{asctime, time, localtime} ## @end deftypefn ## Author: jwe function retval = ctime (t) - if (nargin == 1) - retval = asctime (localtime (t)); - else + if (nargin != 1) print_usage (); endif + retval = asctime (localtime (t)); + endfunction + %!test %! t = time (); %! assert(strcmp (asctime (localtime (t)), ctime (t))); %!error ctime (); - %!error ctime (1, 2);
--- a/scripts/time/date.m +++ b/scripts/time/date.m @@ -18,15 +18,17 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} date () -## Return the date as a character string in the form DD-MMM-YY@. For -## example: +## Return the current date as a character string in the form DD-MMM-YYYY@. +## +## For example: ## ## @example ## @group ## date () -## @result{} "20-Aug-93" +## @result{} "20-Aug-1993" ## @end group ## @end example +## @seealso{now, clock, datestr, localtime} ## @end deftypefn ## Author: jwe
--- a/scripts/time/datenum.m +++ b/scripts/time/datenum.m @@ -17,16 +17,32 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} datenum (@var{year}, @var{month}, @var{day}) -## @deftypefnx {Function File} {} datenum (@var{year}, @var{month}, @var{day}, @var{hour}) -## @deftypefnx {Function File} {} datenum (@var{year}, @var{month}, @var{day}, @var{hour}, @var{minute}) -## @deftypefnx {Function File} {} datenum (@var{year}, @var{month}, @var{day}, @var{hour}, @var{minute}, @var{second}) -## @deftypefnx {Function File} {} datenum (@code{"date"}) -## @deftypefnx {Function File} {} datenum (@code{"date"}, @var{p}) -## Returns the specified local time as a day number, with Jan 1, 0000 -## being day 1. By this reckoning, Jan 1, 1970 is day number 719529. -## The fractional portion, @var{p}, corresponds to the portion of the -## specified day. +## @deftypefn {Function File} {@var{days} =} datenum (@var{datevec}) +## @deftypefnx {Function File} {@var{days} =} datenum (@var{year}, @var{month}, @var{day}) +## @deftypefnx {Function File} {@var{days} =} datenum (@var{year}, @var{month}, @var{day}, @var{hour}) +## @deftypefnx {Function File} {@var{days} =} datenum (@var{year}, @var{month}, @var{day}, @var{hour}, @var{minute}) +## @deftypefnx {Function File} {@var{days} =} datenum (@var{year}, @var{month}, @var{day}, @var{hour}, @var{minute}, @var{second}) +## @deftypefnx {Function File} {@var{days} =} datenum ("datestr") +## @deftypefnx {Function File} {@var{days} =} datenum ("datestr", @var{p}) +## @deftypefnx {Function File} {[@var{days}, @var{secs}] =} datenum (@dots{}) +## Return the date/time input as a serial day number, with Jan 1, 0000 +## defined as day 1. +## +## The integer part, @code{floor (@var{days})} counts the number of +## complete days in the date input. +## +## The fractional part, @code{rem (@var{days}, 1)} corresponds to the time +## on the given day. +## +## The input may be a date vector (see @code{datevec}), +## datestr (see @code{datestr}), or directly specified as input. +## +## When processing input datestrings, @var{p} is the year at the start of the +## century to which two-digit years will be referenced. If not specified, it +## defaults to the current year minus 50. +## +## The optional output @var{secs} holds the time on the specified day with +## greater precision than @var{days}. ## ## Notes: ## @@ -50,50 +66,45 @@ ## Days can be fractional. ## @end itemize ## -## @strong{Warning:} this function does not attempt to handle Julian +## @strong{Caution:} this function does not attempt to handle Julian ## calendars so dates before Octave 15, 1582 are wrong by as much -## as eleven days. Also be aware that only Roman Catholic countries +## as eleven days. Also, be aware that only Roman Catholic countries ## adopted the calendar in 1582. It took until 1924 for it to be ## adopted everywhere. See the Wikipedia entry on the Gregorian ## calendar for more details. ## ## @strong{Warning:} leap seconds are ignored. A table of leap seconds ## is available on the Wikipedia entry for leap seconds. -## @seealso{date, clock, now, datestr, datevec, calendar, weekday} +## @seealso{datestr, datevec, now, clock, date} ## @end deftypefn ## Algorithm: Peter Baum (http://vsg.cape.com/~pbaum/date/date0.htm) ## Author: pkienzle <pkienzle@users.sf.net> -function [days, secs] = datenum (year, month, day, hour, minute, second) +function [days, secs] = datenum (year, month = [], day = [], hour = 0, minute = 0, second = 0) ## Days until start of month assuming year starts March 1. persistent monthstart = [306; 337; 0; 31; 61; 92; 122; 153; 184; 214; 245; 275]; - if (nargin == 0 || (nargin > 2 && ischar (year)) || nargin > 6) + if (nargin == 0 || nargin > 6 || + (nargin > 2 && (ischar (year) || iscellstr (year)))) print_usage (); endif - if (ischar (year)) - if (nargin < 2) - month = []; - endif + + if (ischar (year) || iscellstr (year)) [year, month, day, hour, minute, second] = datevec (year, month); else - if (nargin < 6) second = 0; endif - if (nargin < 5) minute = 0; endif - if (nargin < 4) hour = 0; endif if (nargin == 1) nc = columns (year); if (nc > 6 || nc < 3) error ("datenum: expected date vector containing [YEAR, MONTH, DAY, HOUR, MINUTE, SECOND]"); endif - second = minute = hour = 0; if (nc >= 6) second = year(:,6); endif if (nc >= 5) minute = year(:,5); endif - if (nc >= 4) hour = year(:,4); endif - day = year(:,3); + if (nc >= 4) hour = year(:,4); endif + day = year(:,3); month = year(:,2); - year = year(:,1); + year = year(:,1); endif endif @@ -120,30 +131,32 @@ day += 365*year + floor (year/4) - floor (year/100) + floor (year/400); ## Add fraction representing current second of the day. - days = day + (hour+(minute+second/60)/60)/24; + days = day + (hour + (minute + second/60)/60)/24; ## Output seconds if asked so that etime can be more accurate - secs = 86400*day + hour*3600 + minute*60 + second; + if (isargout (2)) + secs = day*86400 + hour*3600 + minute*60 + second; + endif endfunction + %!shared part %! part = 0.514623842592593; -%!assert(datenum(2001,5,19), 730990) -%!assert(datenum([1417,6,12]), 517712) -%!assert(datenum([2001,5,19;1417,6,12]), [730990;517712]) -%!assert(datenum(2001,5,19,12,21,3.5), 730990+part, eps) -%!assert(datenum([1417,6,12,12,21,3.5]), 517712+part, eps) +%!assert (datenum (2001,5,19), 730990) +%!assert (datenum ([1417,6,12]), 517712) +%!assert (datenum ([2001,5,19;1417,6,12]), [730990;517712]) +%!assert (datenum (2001,5,19,12,21,3.5), 730990+part, eps) +%!assert (datenum ([1417,6,12,12,21,3.5]), 517712+part, eps) ## Test vector inputs %!test %! t = [2001,5,19,12,21,3.5; 1417,6,12,12,21,3.5]; %! n = [730990; 517712] + part; -%! assert(datenum(t), n, 2*eps); -## Make sure that the vectors can have either orientation -%!test -%! t = [2001,5,19,12,21,3.5; 1417,6,12,12,21,3.5]'; -%! n = [730990 517712] + part; -%! assert(datenum(t(1,:), t(2,:), t(3,:), t(4,:), t(5,:), t(6,:)), n, 2*eps); +%! assert (datenum (t), n, 2*eps); +%! ## Check that vectors can have either orientation +%! t = t'; +%! n = n'; +%! assert (datenum (t(1,:), t(2,:), t(3,:), t(4,:), t(5,:), t(6,:)), n, 2*eps); ## Test mixed vectors and scalars %!assert (datenum([2008;2009], 1, 1), [datenum(2008, 1, 1);datenum(2009, 1, 1)]); @@ -159,3 +172,14 @@ %!assert (datenum([2008 2009], [1 2], 1), [datenum(2008, 1, 1) datenum(2009, 2, 1)]); %!assert (datenum([2008 2009], 1, [1 2]), [datenum(2008, 1, 1) datenum(2009, 1, 2)]); %!assert (datenum(2008, [1 2], [1 2]), [datenum(2008, 1, 1) datenum(2008, 2, 2)]); +## Test string and cellstr inputs +%!assert (datenum ("5/19/2001"), 730990) +%!assert (datenum ({"5/19/2001"}), 730990) +%!assert (datenum (char ("5/19/2001", "6/6/1944")), [730990; 710189]) +%!assert (datenum ({"5/19/2001", "6/6/1944"}), [730990; 710189]) + +%% Test input validation +%!error datenum () +%!error datenum (1,2,3,4,5,6,7) +%!error datenum ([1, 2]) +%!error datenum ([1,2,3,4,5,6,7])
--- a/scripts/time/datestr.m +++ b/scripts/time/datestr.m @@ -89,6 +89,8 @@ ## @item @tab and not padded with zeros otherwise @tab 9:00 AM ## @item MM @tab Minute of hour (padded with zeros) @tab 10:05 ## @item SS @tab Second of minute (padded with zeros) @tab 10:05:03 +## @item FFF @tab Milliseconds of second (padded with zeros) @tab 10:05:03.012 +## @item AM @tab Use 12-hour time format @tab 11:30 AM ## @item PM @tab Use 12-hour time format @tab 11:30 PM ## @end multitable ## @@ -98,10 +100,10 @@ ## ## If @var{p} is nor specified, it defaults to the current year minus 50. ## -## If a matrix or cell array of dates is given, a vector of date strings is -## returned. +## If a matrix or cell array of dates is given, a column vector of date strings +## is returned. ## -## @seealso{datenum, datevec, date, clock, now, datetick} +## @seealso{datenum, datevec, date, now, clock} ## @end deftypefn ## FIXME: parse arbitrary code strings. @@ -126,22 +128,21 @@ ## Created: 10 October 2001 (CVS) ## Adapted-By: William Poetra Yoga Hadisoeseno <williampoetra@gmail.com> -function retval = datestr (date, f, p) +function retval = datestr (date, f = [], p = []) - persistent dateform names_mmmm names_mmm names_m names_dddd names_ddd names_d; + persistent dateform names_mmmm names_m names_d; if (isempty (dateform)) - dateform = cell (32, 1); - dateform{1} = "dd-mmm-yyyy HH:MM:SS"; - dateform{2} = "dd-mmm-yyyy"; - dateform{3} = "mm/dd/yy"; - dateform{4} = "mmm"; - dateform{5} = "m"; - dateform{6} = "mm"; - dateform{7} = "mm/dd"; - dateform{8} = "dd"; - dateform{9} = "ddd"; + dateform{1} = "dd-mmm-yyyy HH:MM:SS"; + dateform{2} = "dd-mmm-yyyy"; + dateform{3} = "mm/dd/yy"; + dateform{4} = "mmm"; + dateform{5} = "m"; + dateform{6} = "mm"; + dateform{7} = "mm/dd"; + dateform{8} = "dd"; + dateform{9} = "ddd"; dateform{10} = "d"; dateform{11} = "yyyy"; dateform{12} = "yy"; @@ -154,68 +155,50 @@ dateform{19} = "QQ"; dateform{20} = "dd/mm"; dateform{21} = "dd/mm/yy"; - dateform{22} = "mmm.dd.yyyy HH:MM:SS"; - dateform{23} = "mmm.dd.yyyy"; + dateform{22} = "mmm.dd,yyyy HH:MM:SS"; + dateform{23} = "mmm.dd,yyyy"; dateform{24} = "mm/dd/yyyy"; dateform{25} = "dd/mm/yyyy"; dateform{26} = "yy/mm/dd"; dateform{27} = "yyyy/mm/dd"; dateform{28} = "QQ-YYYY"; dateform{29} = "mmmyyyy"; - dateform{30} = "yyyymmdd"; + dateform{30} = "yyyy-mm-dd"; dateform{31} = "yyyymmddTHHMMSS"; dateform{32} = "yyyy-mm-dd HH:MM:SS"; - names_m = {"J"; "F"; "M"; "A"; "M"; "J"; "J"; "A"; "S"; "O"; "N"; "D"}; - - names_d = {"S"; "M"; "T"; "W"; "T"; "F"; "S"}; - + names_m = {"J", "F", "M", "A", "M", "J", "J", "A", "S", "O", "N", "D"}; + names_d = {"S", "M", "T", "W", "T", "F", "S"}; endif if (nargin < 1 || nargin > 3) print_usage (); endif - if (nargin < 2) - f = []; - endif - if (nargin < 3) - p = []; - endif - - if (ischar (date)) - t = date; - date = cell (1); - date{1} = t; - endif - - ## Guess, so we might be wrong. - if (iscell (date) || columns (date) != 6) + ## Guess input type. We might be wrong. + if (ischar (date) || iscellstr (date) || columns (date) != 6) v = datevec (date, p); else v = []; if (columns (date) == 6) ## Make sure that the input really is a datevec. maxdatevec = [Inf, 12, 31, 23, 59, 60]; - for i = 1:numel (maxdatevec) - if (any (date(:,i) > maxdatevec(i)) - || (i != 6 && any (floor (date(:,i)) != date(:,i)))) - v = datevec (date, p); - break; - endif - endfor + if (any (max (date, 1) > maxdatevec) || + any (date(:,1:5) != floor (date(:,1:5)))) + v = datevec (date, p); + endif endif if (isempty (v)) v = date; endif endif - for i = 1:(rows (v)) + retval = []; + for i = 1 : rows (v) - if (isempty (f) || f == -1) + if (isempty (f)) if (v(i,4:6) == 0) f = 1; - ## elseif (v(i,1:3) == [0, 1, 1]) elseif (v(i,1:3) == [-1, 12, 31]) f = 16; else @@ -230,7 +213,8 @@ endif df_orig = df; - df = regexprep (df, '[AP]M', "%p"); + df = strrep (df, 'AM', "%p"); + df = strrep (df, 'PM', "%p"); if (strcmp (df, df_orig)) ## PM not set. df = strrep (df, "HH", "%H"); @@ -266,9 +250,11 @@ df = strrep (df, "MM", "%M"); - df = strrep (df, "SS", "%S"); + df = regexprep (df, '[Ss][Ss]', "%S"); - df = regexprep (df, '[Qq][Qq]', sprintf ("Q%d", fix ((v(i,2) + 2) / 3))); + df = strrep (df, "FFF", sprintf ("%03d", 1000 * (v(i,6) - fix (v(i,6))))); + + df = strrep (df, 'QQ', sprintf ("Q%d", fix ((v(i,2) + 2) / 3))); vi = v(i,:); tm.year = vi(1) - 1900; @@ -278,7 +264,7 @@ tm.min = vi(5); sec = vi(6); tm.sec = fix (sec); - tm.usec = fix (rem (sec, 1) * 1e6); + tm.usec = fix ((sec - tm.sec) * 1e6); tm.wday = wday - 1; ## FIXME -- Do we need YDAY and DST? How should they be computed? ## We don't want to use "localtime (mktime (tm))" because that @@ -288,61 +274,64 @@ str = strftime (df, tm); - if (i == 1) - retval = str; - else - retval = [retval; str]; - endif + retval = [retval; str]; endfor endfunction -# simple tests + +## demos +%!demo +%! ## Current date and time in default format +%! datestr (now ()) +%!demo +%! ## Current date (integer portion of datenum) +%! datestr (fix (now ())) +%!demo +%! ## Current time (fractional portion of datenum) +%! datestr (rem (now (), 1)) + %!shared testtime %! testtime = [2005.0000, 12.0000, 18.0000, 2.0000, 33.0000, 17.3822]; -%!assert(datestr(testtime,0),"18-Dec-2005 02:33:17"); -%!assert(datestr(testtime,1),"18-Dec-2005"); -%!assert(datestr(testtime,2),"12/18/05"); -%!assert(datestr(testtime,3),"Dec"); -%!assert(datestr(testtime,4),"D"); -%!assert(datestr(testtime,5),"12"); -%!assert(datestr(testtime,6),"12/18"); -%!assert(datestr(testtime,7),"18"); -%!assert(datestr(testtime,8),"Sun"); -%!assert(datestr(testtime,9),"S"); -%!assert(datestr(testtime,10),"2005"); -%!assert(datestr(testtime,11),"05"); -%!assert(datestr(testtime,12),"Dec05"); -%!assert(datestr(testtime,13),"02:33:17"); -%!assert(datestr(testtime,14)," 2:33:17 AM"); -%!assert(datestr(testtime,15),"02:33"); -%!assert(datestr(testtime,16)," 2:33 AM"); -%!assert(datestr(testtime,17),"Q4-05"); -%!assert(datestr(testtime,18),"Q4"); -%!assert(datestr(testtime,19),"18/12"); -%!assert(datestr(testtime,20),"18/12/05"); -%!assert(datestr(testtime,21),"Dec.18.2005 02:33:17"); -%!assert(datestr(testtime,22),"Dec.18.2005"); -%!assert(datestr(testtime,23),"12/18/2005"); -%!assert(datestr(testtime,24),"18/12/2005"); -%!assert(datestr(testtime,25),"05/12/18"); -%!assert(datestr(testtime,26),"2005/12/18"); -%!assert(datestr(testtime,27),"Q4-2005"); -%!assert(datestr(testtime,28),"Dec2005"); -%!assert(datestr(testtime,29),"20051218"); -%!assert(datestr(testtime,30),"20051218T023317"); -%!assert(datestr(testtime,31),"2005-12-18 02:33:17"); -%!assert(datestr(testtime+[0 0 3 0 0 0],"dddd"),"Wednesday") -## avoid the bug where someone happens to give a vector of datenums that -## happens to be 6 wide -%!assert(datestr(733452.933:733457.933), ["14-Feb-2008 22:23:31";"15-Feb-2008 22:23:31";"16-Feb-2008 22:23:31";"17-Feb-2008 22:23:31";"18-Feb-2008 22:23:31";"19-Feb-2008 22:23:31"]) -%!assert (datestr ([1944, 6, 6, 6, 30, 0], 0), "06-Jun-1944 06:30:00"); +%!assert (datestr (testtime,0), "18-Dec-2005 02:33:17") +%!assert (datestr (testtime,1), "18-Dec-2005") +%!assert (datestr (testtime,2), "12/18/05") +%!assert (datestr (testtime,3), "Dec") +%!assert (datestr (testtime,4), "D") +%!assert (datestr (testtime,5), "12") +%!assert (datestr (testtime,6), "12/18") +%!assert (datestr (testtime,7), "18") +%!assert (datestr (testtime,8), "Sun") +%!assert (datestr (testtime,9), "S") +%!assert (datestr (testtime,10), "2005") +%!assert (datestr (testtime,11), "05") +%!assert (datestr (testtime,12), "Dec05") +%!assert (datestr (testtime,13), "02:33:17") +%!assert (datestr (testtime,14), " 2:33:17 AM") +%!assert (datestr (testtime,15), "02:33") +%!assert (datestr (testtime,16), " 2:33 AM") +%!assert (datestr (testtime,17), "Q4-05") +%!assert (datestr (testtime,18), "Q4") +%!assert (datestr (testtime,19), "18/12") +%!assert (datestr (testtime,20), "18/12/05") +%!assert (datestr (testtime,21), "Dec.18,2005 02:33:17") +%!assert (datestr (testtime,22), "Dec.18,2005") +%!assert (datestr (testtime,23), "12/18/2005") +%!assert (datestr (testtime,24), "18/12/2005") +%!assert (datestr (testtime,25), "05/12/18") +%!assert (datestr (testtime,26), "2005/12/18") +%!assert (datestr (testtime,27), "Q4-2005") +%!assert (datestr (testtime,28), "Dec2005") +%!assert (datestr (testtime,29), "2005-12-18") +%!assert (datestr (testtime,30), "20051218T023317") +%!assert (datestr (testtime,31), "2005-12-18 02:33:17") +%!assert (datestr (testtime+[0 0 3 0 0 0], "dddd"), "Wednesday") +## Test possible bug where input is a vector of datenums that is exactly 6 wide +%!assert (datestr ([1944, 6, 6, 6, 30, 0], 0), "06-Jun-1944 06:30:00") +## Test fractional millisecond time extension +%!assert (datestr (testtime, "HH:MM:SS:FFF"), "02:33:17:382") -# demos -%!demo -%! datestr (now ()) -%!demo -%! datestr (rem (now (), 1)) -%!demo -%! datestr (floor (now ())) +%% Test input validation +%!error datestr () +%!error datestr (1, 2, 3, 4)
--- a/scripts/time/datetick.m +++ b/scripts/time/datetick.m @@ -23,7 +23,7 @@ ## @deftypefnx {Function File} {} datetick (@dots{}, "keeplimits") ## @deftypefnx {Function File} {} datetick (@dots{}, "keepticks") ## @deftypefnx {Function File} {} datetick (@dots{ax}, @dots{}) -## Adds date formatted tick labels to an axis. The axis the apply the +## Add date formatted tick labels to an axis. The axis the apply the ## ticks to is determined by @var{axis} that can take the values "x", ## "y" or "z". The default value is "x". The formatting of the labels is ## determined by the variable @var{form}, that can either be a string in @@ -67,6 +67,9 @@ %! datetick(2,'keepticks') %! set(ax,'ytick',12:16) +## Remove from test statistics. No real tests possible. +%!assert (1) + function __datetick__ (varargin) keeplimits = false;
--- a/scripts/time/datevec.m +++ b/scripts/time/datevec.m @@ -31,10 +31,10 @@ ## @var{f} is the format string used to interpret date strings ## (see @code{datestr}). ## -## @var{p} is the year at the start of the century in which two-digit years -## are to be interpreted in. If not specified, it defaults to the current -## year minus 50. -## @seealso{datenum, datestr, date, clock, now} +## @var{p} is the year at the start of the century to which two-digit years +## will be referenced. If not specified, it defaults to the current year +## minus 50. +## @seealso{datenum, datestr, clock, now, date} ## @end deftypefn ## Algorithm: Peter Baum (http://vsg.cape.com/~pbaum/date/date0.htm) @@ -46,13 +46,15 @@ ## The function __date_str2vec__ is based on datesplit by Bill Denney. -function [y, m, d, h, mi, s] = datevec (date, varargin) +function [y, m, d, h, mi, s] = datevec (date, f = [], p = []) persistent std_formats nfmt; if (isempty (std_formats)) std_formats = cell (); nfmt = 0; + ## These formats are specified by Matlab to be parsed + ## The '# XX' refers to the datestr numerical format code std_formats{++nfmt} = "dd-mmm-yyyy HH:MM:SS"; # 0 std_formats{++nfmt} = "dd-mmm-yyyy"; # 1 std_formats{++nfmt} = "mm/dd/yy"; # 2 @@ -62,6 +64,8 @@ std_formats{++nfmt} = "HH:MM"; # 15 std_formats{++nfmt} = "HH:MM PM"; # 16 std_formats{++nfmt} = "mm/dd/yyyy"; # 23 + + ## These are other formats that Octave tries std_formats{++nfmt} = "mmm-dd-yyyy HH:MM:SS"; std_formats{++nfmt} = "mmm-dd-yyyy"; std_formats{++nfmt} = "dd mmm yyyy HH:MM:SS"; @@ -72,8 +76,6 @@ std_formats{++nfmt} = "dd.mmm.yyyy"; std_formats{++nfmt} = "mmm.dd.yyyy HH:MM:SS"; std_formats{++nfmt} = "mmm.dd.yyyy"; - - ## Custom formats. std_formats{++nfmt} = "mmmyy"; # 12 std_formats{++nfmt} = "mm/dd/yyyy HH:MM"; endif @@ -82,22 +84,14 @@ print_usage (); endif - switch (nargin) - case 1 + if (ischar (date)) + date = cellstr (date); + endif + + if (isnumeric (f)) + p = f; f = []; - p = []; - case 2 - if (ischar (varargin{1})) - f = varargin{1}; - p = []; - else - f = []; - p = varargin{1}; - endif - case 3 - f = varargin{1}; - p = varargin{2}; - endswitch + endif if (isempty (f)) f = -1; @@ -107,10 +101,6 @@ p = (localtime (time ())).year + 1900 - 50; endif - if (ischar (date)) - date = cellstr (date); - endif - if (iscell (date)) nd = numel (date); @@ -132,7 +122,7 @@ endif endfor else - ## Decipher the format string just once for sake of speed. + ## Decipher the format string just once for speed. [f, rY, ry, fy, fm, fd, fh, fmi, fs] = __date_vfmt2sfmt__ (f); for k = 1:nd [found y(k) m(k) d(k) h(k) mi(k) s(k)] = __date_str2vec__ (date{k}, p, f, rY, ry, fy, fm, fd, fh, fmi, fs); @@ -142,7 +132,7 @@ endfor endif - else + else # datenum input date = date(:); @@ -187,38 +177,7 @@ function [f, rY, ry, fy, fm, fd, fh, fmi, fs] = __date_vfmt2sfmt__ (f) ## Play safe with percent signs. - f = strrep(f, "%", "%%"); - - ## Dates to lowercase (note: we cannot convert MM to mm). - f = strrep (f, "YYYY", "yyyy"); - f = strrep (f, "YY", "yy"); - f = strrep (f, "QQ", "qq"); - f = strrep (f, "MMMM", "mmmm"); - f = strrep (f, "MMM", "mmm"); - f = strrep (f, "DDDD", "dddd"); - f = strrep (f, "DDD", "ddd"); - f = strrep (f, "DD", "dd"); - ## Times to uppercase (also cannot convert mm to MM). - f = strrep (f, "hh", "HH"); - f = strrep (f, "ss", "SS"); - f = strrep (f, "pm", "PM"); - f = strrep (f, "am", "AM"); - - ## Right now, the format string may only contain these tokens: - ## - ## yyyy 4 digit year - ## yy 2 digit year - ## mmmm month name, full - ## mmm month name, abbreviated - ## mm month number - ## dddd weekday name, full - ## ddd weekday name, abbreviated - ## dd date - ## HH hour - ## MM minutes - ## SS seconds - ## PM AM/PM - ## AM AM/PM + f = strrep (f, "%", "%%"); if (! isempty (strfind (f, "PM")) || ! isempty (strfind (f, "AM"))) ampm = true; @@ -227,14 +186,14 @@ endif ## Date part. - f = strrep (f, "yyyy", "%Y"); - f = strrep (f, "yy", "%y"); + f = regexprep (f, '[Yy][Yy][Yy][Yy]', "%Y"); + f = regexprep (f, '[Yy][Yy]', "%y"); f = strrep (f, "mmmm", "%B"); f = strrep (f, "mmm", "%b"); f = strrep (f, "mm", "%m"); - f = strrep (f, "dddd", "%A"); - f = strrep (f, "ddd", "%a"); - f = strrep (f, "dd", "%d"); + f = regexprep (f, '[Dd][Dd][Dd][Dd]', "%A"); + f = regexprep (f, '[Dd][Dd][Dd]', "%a"); + f = regexprep (f, '[Dd][Dd]', "%d"); ## Time part. if (ampm) @@ -245,7 +204,7 @@ f = strrep (f, "HH", "%H"); endif f = strrep (f, "MM", "%M"); - f = strrep (f, "SS", "%S"); + f = regexprep (f, '[Ss][Ss]', "%S"); rY = rindex (f, "%Y"); ry = rindex (f, "%y"); @@ -263,12 +222,25 @@ function [found, y, m, d, h, mi, s] = __date_str2vec__ (ds, p, f, rY, ry, fy, fm, fd, fh, fmi, fs) - [tm, nc] = strptime (ds, f); - - if (nc == size (ds, 2) + 1) + idx = strfind (f, "FFF"); + if (! isempty (idx)) + ## Kludge to handle FFF millisecond format since strptime does not + f(idx:idx+2) = []; + [~, nc] = strptime (ds, f); + if (nc > 0) + msec = ds(nc:min(nc+2, end)); + f = [f(1:idx-1) msec f(idx:end)]; + [tm, nc] = strptime (ds, f); + tm.usec = 1000 * str2double (msec); + endif + else + [tm, nc] = strptime (ds, f); + endif + + if (nc == columns (ds) + 1) + found = true; y = tm.year + 1900; m = tm.mon + 1; d = tm.mday; h = tm.hour; mi = tm.min; s = tm.sec + tm.usec / 1e6; - found = true; if (rY < ry) if (y > 1999) y -= 2000; @@ -289,7 +261,6 @@ tmp = localtime (time ()); y = tmp.year + 1900; elseif (fy && fm && ! fd) - tmp = localtime (time ()); d = 1; endif if (! fh && ! fmi && ! fs) @@ -304,23 +275,30 @@ endfunction + +%!demo +%! ## Current date and time +%! datevec (now ()) + %!shared nowvec %! nowvec = datevec (now); # Some tests could fail around midnight! -# tests for standard formats: 0, 1, 2, 6, 13, 14, 15, 16, 23 -%!assert(datevec("07-Sep-2000 15:38:09"),[2000,9,7,15,38,9]); -%!assert(datevec("07-Sep-2000"),[2000,9,7,0,0,0]); -%!assert(datevec("09/07/00"),[2000,9,7,0,0,0]); -%!assert(datevec("09/13"),[nowvec(1),9,13,0,0,0]); -%!assert(datevec("15:38:09"),[nowvec(1:3),15,38,9]); -%!assert(datevec("3:38:09 PM"),[nowvec(1:3),15,38,9]); -%!assert(datevec("15:38"),[nowvec(1:3),15,38,0]); -%!assert(datevec("03:38 PM"),[nowvec(1:3),15,38,0]); -%!assert(datevec("03/13/1962"),[1962,3,13,0,0,0]); -# other tests -%!assert(all(datenum(datevec([-1e4:1e4]))==[-1e4:1e4]')) +%!# tests for standard formats: 0, 1, 2, 6, 13, 14, 15, 16, 23 +%!assert (datevec ("07-Sep-2000 15:38:09"), [2000,9,7,15,38,9]) +%!assert (datevec ("07-Sep-2000"), [2000,9,7,0,0,0]) +%!assert (datevec ("09/07/00"), [2000,9,7,0,0,0]) +%!assert (datevec ("09/13"), [nowvec(1),9,13,0,0,0]) +%!assert (datevec ("15:38:09"), [nowvec(1:3),15,38,9]) +%!assert (datevec ("3:38:09 PM"), [nowvec(1:3),15,38,9]) +%!assert (datevec ("15:38"), [nowvec(1:3),15,38,0]) +%!assert (datevec ("03:38 PM"), [nowvec(1:3),15,38,0]) +%!assert (datevec ("03/13/1962"), [1962,3,13,0,0,0]) + +%% Test millisecond format FFF +%!assert (datevec ("15:38:21.25", "HH:MM:SS.FFF"), [nowvec(1:3),15,38,21.025]) + +# Other tests +%!assert (datenum (datevec ([-1e4:1e4])), [-1e4:1e4]') %!test %! t = linspace (-2e5, 2e5, 10993); %! assert (all (abs (datenum (datevec (t)) - t') < 1e-5)); -# demos -%!demo -%! datevec (now ()) +
--- a/scripts/time/eomday.m +++ b/scripts/time/eomday.m @@ -19,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{e} =} eomday (@var{y}, @var{m}) ## Return the last day of the month @var{m} for the year @var{y}. -## @seealso{datenum, datevec, weekday} +## @seealso{weekday, datenum, datevec, is_leap_year, calendar} ## @end deftypefn ## Author: pkienzle <pkienzle@users.sf.net> @@ -38,20 +38,28 @@ endfunction + +%!demo +%! ## Find leap years in the 20th century +%! y = 1900:1999; +%! e = eomday (y, repmat (2, [1, 100])); +%! y(find (e == 29)) + # tests -%!assert(eomday([-4:4],2),[29,28,28,28,29,28,28,28,29]) -%!assert(eomday([-901,901],2),[28,28]) -%!assert(eomday([-100,100],2),[28,28]) -%!assert(eomday([-900,900],2),[28,28]) -%!assert(eomday([-400,400],2),[29,29]) -%!assert(eomday([-800,800],2),[29,29]) -%!assert(eomday(2001,1:12),[31,28,31,30,31,30,31,31,30,31,30,31]) -%!assert(eomday(1:3,1:3),[31,28,31]) -%!assert(eomday(1:2000,2)',datevec(datenum(1:2000,3,0))(:,3)) -%!assert([1900:1999](find(eomday(1900:1999,2*ones(1,100))==29)),[1904,1908,1912,1916,1920,1924,1928,1932,1936,1940,1944,1948,1952,1956,1960,1964,1968,1972,1976,1980,1984,1988,1992,1996]) -%!assert(eomday([2004;2005], [2;2]), [29;28]) -# demos -%!demo -%! y = 1900:1999; -%! e = eomday (y, 2 * ones (1, 100)); -%! y (find (e == 29)) +%!assert (eomday ([-4:4],2), [29,28,28,28,29,28,28,28,29]) +%!assert (eomday ([-901,901],2), [28,28]) +%!assert (eomday ([-100,100],2), [28,28]) +%!assert (eomday ([-900,900],2), [28,28]) +%!assert (eomday ([-400,400],2), [29,29]) +%!assert (eomday ([-800,800],2), [29,29]) +%!assert (eomday (2001,1:12), [31,28,31,30,31,30,31,31,30,31,30,31]) +%!assert (eomday (1:3,1:3), [31,28,31]) +%!assert (eomday (1:2000,2)', datevec(datenum(1:2000,3,0))(:,3)) +%!assert ([1900:1999](find(eomday(1900:1999,2*ones(1,100))==29)), [1904,1908,1912,1916,1920,1924,1928,1932,1936,1940,1944,1948,1952,1956,1960,1964,1968,1972,1976,1980,1984,1988,1992,1996]) +%!assert (eomday ([2004;2005], [2;2]), [29;28]) + +%% Test input validation +%!error eomday () +%!error eomday (1) +%!error eomday (1,2,3) +
--- a/scripts/time/etime.m +++ b/scripts/time/etime.m @@ -32,7 +32,7 @@ ## @noindent ## will set the variable @code{elapsed_time} to the number of seconds since ## the variable @code{t0} was set. -## @seealso{tic, toc, clock, cputime} +## @seealso{tic, toc, clock, cputime, addtodate} ## @end deftypefn ## Author: jwe @@ -50,14 +50,15 @@ endfunction -%!assert(etime([1900,12,31,23,59,59],[1901,1,1,0,0,0]),-1) -%!assert(etime([1900,2,28,23,59,59],[1900,3,1,0,0,0]),-1) -%!assert(etime([2000,2,28,23,59,59],[2000,3,1,0,0,0]),-86401) -%!assert(etime([1996,2,28,23,59,59],[1996,3,1,0,0,0]),-86401) + +%!assert (etime ([1900,12,31,23,59,59],[1901,1,1,0,0,0]),-1) +%!assert (etime ([1900,2,28,23,59,59],[1900,3,1,0,0,0]),-1) +%!assert (etime ([2000,2,28,23,59,59],[2000,3,1,0,0,0]),-86401) +%!assert (etime ([1996,2,28,23,59,59],[1996,3,1,0,0,0]),-86401) %!test -%! t1 = [1900,12,31,23,59,59; 1900,2,28,23,59,59]; -%! t2 = [1901,1,1,0,0,0; 1900,3,1,0,0,0]; -%! assert(etime(t2, t1), [1;1]); +%! t1 = [1900,12,31,23,59,59; 1900,2,28,23,59,59]; +%! t2 = [1901,1,1,0,0,0; 1900,3,1,0,0,0]; +%! assert(etime(t2, t1), [1;1]); %!test %! t1 = [1993, 8, 20, 4, 56, 1]; @@ -66,10 +67,13 @@ %! t4 = [1993, 8, 20, 4, 57, 1]; %! t5 = [1993, 8, 20, 4, 56, 14]; %! -%! assert((etime (t2, t1) == 86400 && etime (t3, t1) == 3600 -%! && etime (t4, t1) == 60 && etime (t5, t1) == 13)); +%! assert (etime (t2, t1), 86400); +%! assert (etime (t3, t1), 3600); +%! assert (etime (t4, t1), 60); +%! assert (etime (t5, t1), 13); +%% Test input validation %!error etime (); - +%!error etime (1); %!error etime (1, 2, 3);
--- a/scripts/time/is_leap_year.m +++ b/scripts/time/is_leap_year.m @@ -19,8 +19,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} is_leap_year () ## @deftypefnx {Function File} {} is_leap_year (@var{year}) -## Return true if the given year is a leap year and false otherwise. If no -## year is provided, @code{is_leap_year} will use the current year. +## Return true if @var{year} is a leap year and false otherwise. If no +## year is specified, @code{is_leap_year} uses the current year. ## For example: ## ## @example @@ -29,6 +29,7 @@ ## @result{} 1 ## @end group ## @end example +## @seealso{weekday, eomday, calendar} ## @end deftypefn ## Author: jwe @@ -41,17 +42,19 @@ if (nargin == 0) t = clock (); - year = t (1); + year = t(1); endif - retval = ((rem (year, 4) == 0 & rem (year, 100) != 0) ... - | rem (year, 400) == 0); + retval = (rem (year, 4) == 0 & rem (year, 100) != 0) | (rem (year, 400) == 0); endfunction -%!assert((is_leap_year (2000) == 1 && is_leap_year (1976) == 1 -%! && is_leap_year (1000) == 0 && is_leap_year (1800) == 0 -%! && is_leap_year (1600) == 1)); + +%!assert (is_leap_year (2000), true) +%!assert (is_leap_year (1976), true) +%!assert (is_leap_year (1000), false) +%!assert (is_leap_year (1800), false) +%!assert (is_leap_year (1600), true) %!error is_leap_year (1, 2);
--- a/scripts/time/now.m +++ b/scripts/time/now.m @@ -18,16 +18,14 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {t =} now () -## Returns the current local time as the number of days since Jan 1, 0000. -## By this reckoning, Jan 1, 1970 is day number 719529. +## Return the current local date/time as a serial day number +## (see @code{datenum}). ## -## The integral part, @code{floor (now)} corresponds to 00:00:00 today. +## The integral part, @code{floor (now)} corresponds to the number of days +## between today and Jan 1, 0000. ## ## The fractional part, @code{rem (now, 1)} corresponds to the current -## time on Jan 1, 0000. -## -## The returned value is also called a "serial date number" -## (see @code{datenum}). +## time. ## @seealso{clock, date, datenum} ## @end deftypefn @@ -37,6 +35,10 @@ function t = now () + if (nargin != 0) + print_usage (); + endif + t = datenum (clock ()); ## The following doesn't work (e.g., one hour off on 2005-10-04): @@ -50,3 +52,10 @@ ## changing by an hour the offset from CUT for part of the year. endfunction + + +%!assert (isnumeric (now ())); +%!assert (now () > 0); +%!assert (now () <= now ()); + +%!error now (1);
--- a/scripts/time/weekday.m +++ b/scripts/time/weekday.m @@ -19,49 +19,58 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {[@var{n}, @var{s}] =} weekday (@var{d}) ## @deftypefnx {Function File} {[@var{n}, @var{s}] =} weekday (@var{d}, @var{format}) -## Return the day of week as a number in @var{n} and a string in @var{s}, -## for example @code{[1, "Sun"]}, @code{[2, "Mon"]}, @dots{}, or -## @code{[7, "Sat"]}. +## Return the day of the week as a number in @var{n} and as a string in @var{s}. +## The days of the week are numbered 1--7 with the first day being Sunday. ## ## @var{d} is a serial date number or a date string. ## -## If the string @var{format} is given and is @code{"long"}, @var{s} will -## contain the full name of the weekday; otherwise (or if @var{format} is -## @code{"short"}), @var{s} will contain the abbreviated name of the weekday. -## @seealso{datenum, datevec, eomday} +## If the string @var{format} is not present or is equal to "short" then +## @var{s} will contain the abbreviated name of the weekday. If @var{format} +## is "long" then @var{s} will contain the full name. +## +## Table of return values based on @var{format}: +## +## @multitable @columnfractions .06 .13 .16 +## @headitem @var{n} @tab "short" @tab "long" +## @item 1 @tab Sun @tab Sunday +## @item 2 @tab Mon @tab Monday +## @item 3 @tab Tue @tab Tuesday +## @item 4 @tab Wed @tab Wednesday +## @item 5 @tab Thu @tab Thursday +## @item 6 @tab Fri @tab Friday +## @item 7 @tab Sat @tab Saturday +## @end multitable +## +## @seealso{eomday, is_leap_year, calendar, datenum, datevec} ## @end deftypefn ## Author: pkienzle <pkienzle@users.sf.net> ## Created: 10 October 2001 (CVS) ## Adapted-By: William Poetra Yoga Hadisoeseno <williampoetra@gmail.com> -function [d, s] = weekday (d, format) +function [d, s] = weekday (d, format = "short") if (nargin < 1 || nargin > 2) print_usage (); endif - if (nargin < 2) - format = "short"; - endif - - if (iscell (d) || isnumeric (d)) + if (iscellstr (d) || isnumeric (d)) endsize = size (d); elseif (ischar (d)) - endsize = [size(d, 1), 1]; + endsize = [rows(d), 1]; endif - if (ischar (d) || iscell (d)) + if (ischar (d) || iscellstr (d)) ## Make sure the date is numeric d = datenum (d); endif ## Find the offset from a known Sunday (2008-Jan-6), mod 7. - d = floor (reshape (mod(d - 733048, 7), endsize)); + d = floor (reshape (mod (d - 733048, 7), endsize)); ## Make Saturdays a 7 and not a 0. d(!d) = 7; - if (nargout > 1) + if (isargout (2)) if (strcmpi (format, "long")) - names = {"Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" + names = {"Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" ... "Friday" "Saturday"}; else names = {"Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"}; @@ -71,35 +80,45 @@ endfunction -# tests -%!assert(weekday(728647),2) -## Test vector inputs for both directions -%!assert(weekday([728647 728648]), [2 3]) -%!assert(weekday([728647;728648]), [2;3]) -## Test a full week before our reference day -%!assert(weekday('19-Dec-1994'),2) -%!assert(weekday('20-Dec-1994'),3) -%!assert(weekday('21-Dec-1994'),4) -%!assert(weekday('22-Dec-1994'),5) -%!assert(weekday('23-Dec-1994'),6) -%!assert(weekday('24-Dec-1994'),7) -%!assert(weekday('25-Dec-1994'),1) -## Test our reference day -%!assert(weekday('6-Jan-2008'),1) -## Test a full week after our reference day -%!assert(weekday('1-Feb-2008'),6) -%!assert(weekday('2-Feb-2008'),7) -%!assert(weekday('3-Feb-2008'),1) -%!assert(weekday('4-Feb-2008'),2) -%!assert(weekday('5-Feb-2008'),3) -%!assert(weekday('6-Feb-2008'),4) -%!assert(weekday('7-Feb-2008'),5) -## Test fractional dates -%!assert(weekday(728647.1),2) -# demos + %!demo +%! ## Current weekday %! [n, s] = weekday (now ()) %!demo +%! ## Weekday from datenum input %! [n, s] = weekday (728647) %!demo -%! [n, s] = weekday ('19-Dec-1994') +%! ## Weekday of new millennium from datestr input +%! [n, s] = weekday ('1-Jan-2000') + +# tests +%!assert (weekday (728647), 2) +## Test vector inputs for both directions +%!assert (weekday ([728647 728648]), [2 3]) +%!assert (weekday ([728647;728648]), [2;3]) +## Test a full week before our reference day +%!assert (weekday ("19-Dec-1994"), 2) +%!assert (weekday ("20-Dec-1994"), 3) +%!assert (weekday ("21-Dec-1994"), 4) +%!assert (weekday ("22-Dec-1994"), 5) +%!assert (weekday ("23-Dec-1994"), 6) +%!assert (weekday ("24-Dec-1994"), 7) +%!assert (weekday ("25-Dec-1994"), 1) +## Test our reference day +%!assert (weekday ("6-Jan-2008"), 1) +## Test a full week after our reference day +%!assert (weekday ("1-Feb-2008"), 6) +%!assert (weekday ("2-Feb-2008"), 7) +%!assert (weekday ("3-Feb-2008"), 1) +%!assert (weekday ("4-Feb-2008"), 2) +%!assert (weekday ("5-Feb-2008"), 3) +%!assert (weekday ("6-Feb-2008"), 4) +%!assert (weekday ("7-Feb-2008"), 5) +## Test fractional dates +%!assert (weekday (728647.1), 2) +## Test "long" option +%!test +%! [n, s] = weekday ("25-Dec-1994", "long"); +%! assert (n, 1); +%! assert (s, "Sunday"); +
--- a/src/DLD-FUNCTIONS/__contourc__.cc +++ b/src/DLD-FUNCTIONS/__contourc__.cc @@ -333,3 +333,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__delaunayn__.cc +++ b/src/DLD-FUNCTIONS/__delaunayn__.cc @@ -50,30 +50,26 @@ #include "error.h" #include "oct-obj.h" -#ifdef HAVE_QHULL -extern "C" { -#include <qhull/qhull_a.h> -} - -#ifdef NEED_QHULL_VERSION +#if defined (HAVE_QHULL) +# include "oct-qhull.h" +# if defined (NEED_QHULL_VERSION) char qh_version[] = "__delaunayn__.oct 2007-08-21"; -#endif +# endif #endif DEFUN_DLD (__delaunayn__, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{T} =} __delaunayn__ (@var{P})\n\ -@deftypefnx {Loadable Function} {@var{T} =} __delaunayn__ (@var{P}, @var{opt})\n\ +@deftypefn {Loadable Function} {@var{T} =} __delaunayn__ (@var{pts})\n\ +@deftypefnx {Loadable Function} {@var{T} =} __delaunayn__ (@var{pts}, @var{options})\n\ Undocumented internal function.\n\ @end deftypefn") { octave_value_list retval; -#ifdef HAVE_QHULL +#if defined (HAVE_QHULL) retval(0) = 0.0; - std::string options = ""; int nargin = args.length (); if (nargin < 1 || nargin > 2) @@ -86,67 +82,52 @@ const octave_idx_type dim = p.columns (); const octave_idx_type n = p.rows (); - // default options + // Default options + std::string options; if (dim <= 3) - options = "Qt Qbb Qc"; + options = "Qt Qbb Qc Qz"; else options = "Qt Qbb Qc Qx"; - if (nargin == 2) { - if (args(1).is_empty ()) - { - // keep default options - } - else if (args(1).is_string ()) - { - // option string is directly provided + if (args(1).is_string ()) options = args(1).string_value (); - } - else if (args(1).is_cell ()) - { - options = ""; - - Cell c = args(1).cell_value (); - for (octave_idx_type i = 0; i < c.numel (); i++) - { + else if (args(1).is_empty ()) + ; // Use default options + else if (args(1).is_cellstr ()) + { + options = ""; + Array<std::string> tmp = args(1).cellstr_value (); - if (! c.elem(i).is_string ()) - { - error ("__delaunayn__: all options must be strings"); - return retval; - } - - options = options + c.elem(i).string_value () + " "; - } - } - else - { - error ("__delaunayn__: OPT argument must be a string, cell array of strings, or empty"); - return retval; - } + for (octave_idx_type i = 0; i < tmp.numel (); i++) + options += tmp(i) + " "; + } + else + { + error ("__delaunayn__: OPTIONS argument must be a string, cell array of strings, or empty"); + return retval; + } } - //octave_stdout << "options " << options << std::endl; - if (n > dim + 1) { p = p.transpose (); double *pt_array = p.fortran_vec (); boolT ismalloc = false; - OCTAVE_LOCAL_BUFFER (char, flags, 250); + // Qhull flags argument is not const char* + OCTAVE_LOCAL_BUFFER (char, flags, 9 + options.length()); sprintf (flags, "qhull d %s", options.c_str ()); - // If you want some debugging information replace the 0 pointer - // with stdout or some other file open for writing. - + // Replace the 0 pointer with stdout for debugging information FILE *outfile = 0; FILE *errfile = stderr; - - if (! qh_new_qhull (dim, n, pt_array, ismalloc, flags, outfile, errfile)) + + int exitcode = qh_new_qhull (dim, n, pt_array, + ismalloc, flags, outfile, errfile); + if (! exitcode) { // triangulate non-simplicial facets qh_triangulate (); @@ -160,54 +141,48 @@ if (! facet->upperdelaunay) nf++; - // Double check + // Double check. Non-simplicial facets will cause segfault below if (! facet->simplicial) { error ("__delaunayn__: Qhull returned non-simplicial facets -- try delaunayn with different options"); + exitcode = 1; break; } } - Matrix simpl (nf, dim+1); - - FORALLfacets + if (! exitcode) { - if (! facet->upperdelaunay) - { - octave_idx_type j = 0; + Matrix simpl (nf, dim+1); - FOREACHvertex_ (facet->vertices) + FORALLfacets + { + if (! facet->upperdelaunay) { - // if delaunayn crashes, enable this check -#if 0 - if (j > dim) - { - error ("__delaunayn__: internal error. Qhull returned non-simplicial facets"); - return retval; - } -#endif + octave_idx_type j = 0; - simpl(i, j++) = 1 + qh_pointid(vertex->point); + FOREACHvertex_ (facet->vertices) + { + simpl(i, j++) = 1 + qh_pointid(vertex->point); + } + i++; } - i++; } - } - - retval(0) = simpl; - // free long memory - qh_freeqhull (! qh_ALL); - - // free short memory and memory allocator - int curlong, totlong; - qh_memfreeshort (&curlong, &totlong); - - if (curlong || totlong) - warning ("__delaunay__: did not free %d bytes of long memory (%d pieces)", - totlong, curlong); + retval(0) = simpl; + } } else error ("__delaunayn__: qhull failed"); + + // Free memory from Qhull + qh_freeqhull (! qh_ALL); + + int curlong, totlong; + qh_memfreeshort (&curlong, &totlong); + + if (curlong || totlong) + warning ("__delaunay__: did not free %d bytes of long memory (%d pieces)", + totlong, curlong); } else if (n == dim + 1) { @@ -226,3 +201,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__dispatch__.cc +++ b/src/DLD-FUNCTIONS/__dispatch__.cc @@ -129,3 +129,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__dsearchn__.cc +++ b/src/DLD-FUNCTIONS/__dsearchn__.cc @@ -108,3 +108,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__fltk_uigetfile__.cc +++ b/src/DLD-FUNCTIONS/__fltk_uigetfile__.cc @@ -26,8 +26,12 @@ #if defined (HAVE_FLTK) +#ifdef WIN32 +#define WIN32_LEAN_AND_MEAN +#endif + #include <FL/Fl.H> -#include <Fl/Fl_File_Chooser.H> +#include <FL/Fl_File_Chooser.H> // FLTK headers may include X11/X.h which defines Complex, and that // conflicts with Octave's Complex typedef. We don't need the X11 @@ -130,4 +134,11 @@ return retval; } +/* + +## No test needed for internal helper function. +%!assert (1) + +*/ + #endif
--- a/src/DLD-FUNCTIONS/__glpk__.cc +++ b/src/DLD-FUNCTIONS/__glpk__.cc @@ -854,3 +854,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__init_fltk__.cc +++ b/src/DLD-FUNCTIONS/__init_fltk__.cc @@ -29,10 +29,15 @@ */ +// PKG_ADD: register_graphics_toolkit ("fltk"); + #ifdef HAVE_CONFIG_H #include <config.h> #endif +#include "defun-dld.h" +#include "error.h" + #if defined (HAVE_FLTK) #include <map> @@ -40,11 +45,15 @@ #include <sstream> #include <iostream> +#ifdef WIN32 +#define WIN32_LEAN_AND_MEAN +#endif + #include <FL/Fl.H> #include <FL/Fl_Box.H> #include <FL/Fl_Button.H> #include <FL/Fl_Choice.H> -#include <Fl/Fl_File_Chooser.H> +#include <FL/Fl_File_Chooser.H> #include <FL/Fl_Gl_Window.H> #include <FL/Fl_Menu_Bar.H> #include <FL/Fl_Menu_Button.H> @@ -63,8 +72,6 @@ #include "cmd-edit.h" #include "lo-ieee.h" -#include "defun-dld.h" -#include "error.h" #include "file-ops.h" #include "gl-render.h" #include "gl2ps-renderer.h" @@ -130,6 +137,19 @@ redraw (); } + bool renumber (double new_number) + { + bool retval = false; + + if (number != new_number) + { + number = new_number; + retval = true; + } + + return retval; + } + private: double number; opengl_renderer renderer; @@ -259,7 +279,7 @@ int n = 0; for (int t = 0; t < len; t++ ) { - const Fl_Menu_Item *m = static_cast<const Fl_Menu_Item*>(&(menubar->menu ()[t])); + const Fl_Menu_Item *m = static_cast<const Fl_Menu_Item*> (&(menubar->menu ()[t])); if ((m->label () != NULL) && m->visible ()) n++; } @@ -282,7 +302,7 @@ return menubar->visible (); } - int find_index_by_name (std::string findname) + int find_index_by_name (const std::string& findname) { // This function is derived from Greg Ercolano's function // int GetIndexByName(...), see: @@ -293,7 +313,7 @@ std::string menupath; for (int t = 0; t < menubar->size (); t++ ) { - Fl_Menu_Item *m = const_cast<Fl_Menu_Item*>(&(menubar->menu ()[t])); + Fl_Menu_Item *m = const_cast<Fl_Menu_Item*> (&(menubar->menu ()[t])); if (m->submenu ()) { // item has submenu @@ -354,7 +374,7 @@ { graphics_object kidgo = gh_manager::get_object (uimenu_childs (ii)); - if (kidgo.valid_object() && kidgo.isa ("uimenu")) + if (kidgo.valid_object () && kidgo.isa ("uimenu")) { uimenu_childs(k) = uimenu_childs(ii); pos(k++) = @@ -374,7 +394,7 @@ return retval; } - void delete_entry(uimenu::properties& uimenup) + void delete_entry (uimenu::properties& uimenup) { std::string fltk_label = uimenup.get_fltk_label (); int idx = find_index_by_name (fltk_label.c_str ()); @@ -388,7 +408,7 @@ std::string fltk_label = uimenup.get_fltk_label (); if (!fltk_label.empty ()) { - Fl_Menu_Item* item = const_cast<Fl_Menu_Item*>(menubar->find_item (fltk_label.c_str ())); + Fl_Menu_Item* item = const_cast<Fl_Menu_Item*> (menubar->find_item (fltk_label.c_str ())); if (item != NULL) { std::string acc = uimenup.get_accelerator (); @@ -406,14 +426,14 @@ std::string fltk_label = uimenup.get_fltk_label (); if (!fltk_label.empty ()) { - Fl_Menu_Item* item = const_cast<Fl_Menu_Item*>(menubar->find_item (fltk_label.c_str ())); + Fl_Menu_Item* item = const_cast<Fl_Menu_Item*> (menubar->find_item (fltk_label.c_str ())); if (item != NULL) { if (!uimenup.get_callback ().is_empty ()) - item->callback(static_cast<Fl_Callback*>(script_cb), //callback - static_cast<void*>(&uimenup)); //callback data + item->callback (static_cast<Fl_Callback*> (script_cb), + static_cast<void*> (&uimenup)); else - item->callback(NULL, static_cast<void*>(0)); + item->callback (NULL, static_cast<void*> (0)); } } } @@ -423,7 +443,7 @@ std::string fltk_label = uimenup.get_fltk_label (); if (!fltk_label.empty ()) { - Fl_Menu_Item* item = const_cast<Fl_Menu_Item*>(menubar->find_item (fltk_label.c_str ())); + Fl_Menu_Item* item = const_cast<Fl_Menu_Item*> (menubar->find_item (fltk_label.c_str ())); if (item != NULL) { if (uimenup.is_enable ()) @@ -439,18 +459,21 @@ std::string fltk_label = uimenup.get_fltk_label (); if (!fltk_label.empty ()) { - Fl_Menu_Item* item = const_cast<Fl_Menu_Item*>(menubar->find_item (fltk_label.c_str ())); + Fl_Menu_Item* item = const_cast<Fl_Menu_Item*> (menubar->find_item (fltk_label.c_str ())); if (item != NULL) { Matrix rgb = uimenup.get_foregroundcolor_rgb (); - item->labelcolor(fl_rgb_color(static_cast<uchar>(floor (rgb(0)*255)), - static_cast<uchar>(floor (rgb(1)*255)), - static_cast<uchar>(floor (rgb(2)*255)))); + + uchar r = static_cast<uchar> (gnulib::floor (rgb (0) * 255)); + uchar g = static_cast<uchar> (gnulib::floor (rgb (1) * 255)); + uchar b = static_cast<uchar> (gnulib::floor (rgb (2) * 255)); + + item->labelcolor (fl_rgb_color (r, g, b)); } } } - void update_seperator (uimenu::properties& uimenup) + void update_seperator (const uimenu::properties& uimenup) { // Matlab places the separator before the current // menu entry, while fltk places it after. So we need to find @@ -459,17 +482,17 @@ if (!fltk_label.empty ()) { int itemflags = 0, idx; - int curr_idx = find_index_by_name(fltk_label.c_str ()); + int curr_idx = find_index_by_name (fltk_label.c_str ()); for (idx = curr_idx - 1; idx >= 0; idx--) { - Fl_Menu_Item* item = const_cast<Fl_Menu_Item*>(&menubar->menu () [idx]); + Fl_Menu_Item* item = const_cast<Fl_Menu_Item*> (&menubar->menu () [idx]); itemflags = item->flags; if (item->label () != NULL) break; } - if ((idx >= 0) && (idx < menubar->size ())) + if (idx >= 0 && idx < menubar->size ()) { if (uimenup.is_separator ()) { @@ -487,7 +510,8 @@ std::string fltk_label = uimenup.get_fltk_label (); if (!fltk_label.empty ()) { - Fl_Menu_Item* item = const_cast<Fl_Menu_Item*>(menubar->find_item (fltk_label.c_str ())); + Fl_Menu_Item* item + = const_cast<Fl_Menu_Item*> (menubar->find_item (fltk_label.c_str ())); if (item != NULL) { if (uimenup.is_visible ()) @@ -508,7 +532,8 @@ bool item_added = false; do { - const Fl_Menu_Item* item = menubar->find_item(fltk_label.c_str ()); + const Fl_Menu_Item* item + = menubar->find_item (fltk_label.c_str ()); if (item == NULL) { @@ -517,9 +542,9 @@ int flags = 0; if (len > 0) flags = FL_SUBMENU; - if ((len == 0) && (uimenup.is_checked ())) + if (len == 0 && uimenup.is_checked ()) flags += FL_MENU_TOGGLE + FL_MENU_VALUE; - menubar->add(fltk_label.c_str (), 0, 0, 0, flags); + menubar->add (fltk_label.c_str (), 0, 0, 0, flags); item_added = true; } else @@ -532,9 +557,9 @@ if (len > 0) { std::string valstr = fltk_label.substr (idx1 + 1, len - 1); - fltk_label.erase(idx1, len + 1); + fltk_label.erase (idx1, len + 1); val = atoi (valstr.c_str ()); - if ((val > 0) && (val < 99)) + if (val > 0 && val < 99) val++; } std::ostringstream valstream; @@ -566,7 +591,7 @@ graphics_object kgo = gh_manager::get_object (kids (len - (ii + 1))); if (kgo.valid_object ()) { - uimenu::properties& kprop = dynamic_cast<uimenu::properties&>(kgo.get_properties ()); + uimenu::properties& kprop = dynamic_cast<uimenu::properties&> (kgo.get_properties ()); add_to_menu (kprop); } } @@ -583,7 +608,7 @@ if (kgo.valid_object ()) { - uimenu::properties& kprop = dynamic_cast<uimenu::properties&>(kgo.get_properties ()); + uimenu::properties& kprop = dynamic_cast<uimenu::properties&> (kgo.get_properties ()); add_to_menu (kprop); } } @@ -603,18 +628,18 @@ if (kgo.valid_object ()) { - uimenu::properties kprop = dynamic_cast<uimenu::properties&>(kgo.get_properties ()); + uimenu::properties kprop = dynamic_cast<uimenu::properties&> (kgo.get_properties ()); remove_from_menu (kprop); } } - if (type.compare("uimenu") == 0) - delete_entry(dynamic_cast<uimenu::properties&>(prop)); - else if (type.compare("figure") == 0) + if (type.compare ("uimenu") == 0) + delete_entry (dynamic_cast<uimenu::properties&> (prop)); + else if (type.compare ("figure") == 0) menubar->clear (); } - ~fltk_uimenu() + ~fltk_uimenu (void) { delete menubar; } @@ -637,7 +662,8 @@ plot_window (int xx, int yy, int ww, int hh, figure::properties& xfp) : Fl_Window (xx, yy, ww, hh, "octave"), window_label (), shift (0), ndim (2), fp (xfp), canvas (0), autoscale (0), togglegrid (0), - panzoom (0), rotate (0), help (0), status (0) + panzoom (0), rotate (0), help (0), status (0), + ax_obj (), pos_x (0), pos_y (0) { callback (window_close, static_cast<void*> (this)); size_range (4*status_h, 2*status_h); @@ -645,81 +671,63 @@ begin (); { - uimenu = new - fltk_uimenu(0, 0, ww, menu_h); + canvas = new OpenGL_fltk (0, 0, ww, hh - status_h, number ()); + + uimenu = new fltk_uimenu (0, 0, ww, menu_h); uimenu->hide (); - canvas = new - OpenGL_fltk (0, 0, ww , hh - status_h, number ()); - - bottom = new - Fl_Box (0, - hh - status_h, - ww, - status_h); + bottom = new Fl_Box (0, hh - status_h, ww, status_h); bottom->box(FL_FLAT_BOX); ndim = calc_dimensions (gh_manager::get_object (fp.get___myhandle__ ())); - autoscale = new - Fl_Button (0, - hh - status_h, - status_h, - status_h, - "A"); + autoscale = new Fl_Button (0, hh - status_h, status_h, status_h, "A"); autoscale->callback (button_callback, static_cast<void*> (this)); autoscale->tooltip ("Autoscale"); - togglegrid = new - Fl_Button (status_h, - hh - status_h, - status_h, - status_h, - "G"); + togglegrid = new Fl_Button (status_h, hh - status_h, status_h, + status_h, "G"); togglegrid->callback (button_callback, static_cast<void*> (this)); togglegrid->tooltip ("Toggle Grid"); - panzoom = new - Fl_Button (2 * status_h, - hh - status_h, - status_h, - status_h, - "P"); + panzoom = new Fl_Button (2 * status_h, hh - status_h, status_h, + status_h, "P"); panzoom->callback (button_callback, static_cast<void*> (this)); panzoom->tooltip ("Mouse Pan/Zoom"); - rotate = new - Fl_Button (3 * status_h, - hh - status_h, - status_h, - status_h, - "R"); + rotate = new Fl_Button (3 * status_h, hh - status_h, status_h, + status_h, "R"); rotate->callback (button_callback, static_cast<void*> (this)); rotate->tooltip ("Mouse Rotate"); if (ndim == 2) rotate->deactivate (); - help = new - Fl_Button (4 * status_h, - hh - status_h, - status_h, - status_h, - "?"); + help = new Fl_Button (4 * status_h, hh - status_h, status_h, + status_h, "?"); help->callback (button_callback, static_cast<void*> (this)); help->tooltip ("Help"); - status = new - Fl_Output (5 * status_h, - hh - status_h, - ww > 2*status_h ? ww - status_h : 0, - status_h, ""); + status = new Fl_Output (5 * status_h, hh - status_h, + ww > 2*status_h ? ww - status_h : 0, + status_h, ""); status->textcolor (FL_BLACK); status->color (FL_GRAY); status->textfont (FL_COURIER); status->textsize (10); status->box (FL_ENGRAVED_BOX); + + // This allows us to have a valid OpenGL context right away. + canvas->mode (FL_DEPTH | FL_DOUBLE ); + if (fp.is_visible ()) + { + show (); + if (fp.get_currentaxes ().ok()) + show_canvas (); + else + hide_canvas (); + } } end (); @@ -737,21 +745,6 @@ show_menubar (); else hide_menubar (); - - begin (); - { - // This allows us to have a valid OpenGL context right away. - canvas->mode (FL_DEPTH | FL_DOUBLE ); - if (fp.is_visible ()) - { - show (); - if (fp.get_currentaxes ().ok()) - show_canvas (); - else - hide_canvas (); - } - } - end (); } ~plot_window (void) @@ -760,14 +753,21 @@ status->hide (); uimenu->hide (); this->hide (); - delete canvas; - delete status; - delete uimenu; } - // FIXME -- this could change. double number (void) { return fp.get___myhandle__ ().value (); } + void renumber (double new_number) + { + if (canvas) + { + if (canvas->renumber (new_number)) + mark_modified (); + } + else + error ("unable to renumber figure"); + } + void print (const std::string& cmd, const std::string& term) { canvas->print (cmd, term); @@ -804,7 +804,7 @@ } } - void uimenu_update(graphics_handle gh, int id) + void uimenu_update (const graphics_handle& gh, int id) { graphics_object uimenu_obj = gh_manager::get_object (gh); @@ -812,58 +812,70 @@ { uimenu::properties& uimenup = dynamic_cast<uimenu::properties&> (uimenu_obj.get_properties ()); - std::string fltk_label = uimenup.get_fltk_label(); - graphics_object fig = uimenu_obj.get_ancestor("figure"); + std::string fltk_label = uimenup.get_fltk_label (); + graphics_object fig = uimenu_obj.get_ancestor ("figure"); figure::properties& figp = dynamic_cast<figure::properties&> (fig.get_properties ()); - switch(id) + switch (id) { - case base_properties::ID_BEINGDELETED: - uimenu->remove_from_menu (uimenup); - break; - case base_properties::ID_VISIBLE: - uimenu->update_visible (uimenup); - break; - case uimenu::properties::ID_ACCELERATOR: - uimenu->update_accelerator (uimenup); - break; - case uimenu::properties::ID_CALLBACK: - uimenu->update_callback (uimenup); - break; - case uimenu::properties::ID_CHECKED: - uimenu->add_to_menu (figp);//rebuilding entire menu - break; - case uimenu::properties::ID_ENABLE: - uimenu->update_enable (uimenup); - break; - case uimenu::properties::ID_FOREGROUNDCOLOR: - uimenu->update_foregroundcolor (uimenup); - break; - case uimenu::properties::ID_LABEL: - uimenu->add_to_menu (figp);//rebuilding entire menu - break; - case uimenu::properties::ID_POSITION: - uimenu->add_to_menu (figp);//rebuilding entire menu - break; - case uimenu::properties::ID_SEPARATOR: - uimenu->update_seperator (uimenup); - break; + case base_properties::ID_BEINGDELETED: + uimenu->remove_from_menu (uimenup); + break; + + case base_properties::ID_VISIBLE: + uimenu->update_visible (uimenup); + break; + + case uimenu::properties::ID_ACCELERATOR: + uimenu->update_accelerator (uimenup); + break; + + case uimenu::properties::ID_CALLBACK: + uimenu->update_callback (uimenup); + break; + + case uimenu::properties::ID_CHECKED: + uimenu->add_to_menu (figp);//rebuilding entire menu + break; + + case uimenu::properties::ID_ENABLE: + uimenu->update_enable (uimenup); + break; + + case uimenu::properties::ID_FOREGROUNDCOLOR: + uimenu->update_foregroundcolor (uimenup); + break; + + case uimenu::properties::ID_LABEL: + uimenu->add_to_menu (figp);//rebuilding entire menu + break; + + case uimenu::properties::ID_POSITION: + uimenu->add_to_menu (figp);//rebuilding entire menu + break; + + case uimenu::properties::ID_SEPARATOR: + uimenu->update_seperator (uimenup); + break; } - if (uimenu->items_to_show ()) - show_menubar (); - else - hide_menubar (); + if (uimenu->items_to_show ()) + show_menubar (); + else + hide_menubar (); - mark_modified(); + mark_modified(); } } void show_canvas (void) { - canvas->show (); - canvas->make_current (); + if (fp.is_visible ()) + { + canvas->show (); + canvas->make_current (); + } } void hide_canvas (void) @@ -879,7 +891,7 @@ if (ndim == 3) rotate->activate (); - else if ((ndim == 2) && (gui_mode == rotate_zoom)) + else if (ndim == 2 && gui_mode == rotate_zoom) { rotate->deactivate (); gui_mode = pan_zoom; @@ -960,6 +972,9 @@ Fl_Button* rotate; Fl_Button* help; Fl_Output* status; + graphics_object ax_obj; + int pos_x; + int pos_y; void axis_auto (void) { @@ -980,14 +995,14 @@ mark_modified (); } - void pixel2pos - (graphics_handle ax, int px, int py, double& xx, double& yy) const + void pixel2pos (const graphics_handle& ax, int px, int py, double& xx, + double& yy) const { pixel2pos ( gh_manager::get_object (ax), px, py, xx, yy); } - void pixel2pos - (graphics_object ax, int px, int py, double& xx, double& yy) const + void pixel2pos (graphics_object ax, int px, int py, double& xx, + double& yy) const { if (ax && ax.isa ("axes")) { @@ -1027,7 +1042,7 @@ return fp.get_currentaxes (); } - void pixel2status (graphics_handle ax, int px0, int py0, + void pixel2status (const graphics_handle& ax, int px0, int py0, int px1 = -1, int py1 = -1) { pixel2status (gh_manager::get_object (ax), px0, py0, px1, py1); @@ -1062,7 +1077,7 @@ cbuf.precision (4); cbuf.width (6); Matrix v (1,2,0); - v = ap.get("view").matrix_value(); + v = ap.get ("view").matrix_value (); cbuf << "[azimuth: " << v(0) << ", elevation: " << v(1) << "]"; status->value (cbuf.str ().c_str ()); @@ -1159,23 +1174,20 @@ void draw (void) { Matrix pos = fp.get_position ().matrix_value (); - Fl_Window::resize (pos(0), pos(1) , pos(2), pos(3) + status_h + menu_h); + Fl_Window::resize (pos(0), pos(1), pos(2), pos(3) + status_h + menu_h); return Fl_Window::draw (); } int handle (int event) { - static int px0,py0; - static graphics_object ax0; - graphics_handle gh; graphics_object fig = gh_manager::get_object (fp.get___myhandle__ ()); int retval = Fl_Window::handle (event); // We only handle events which are in the canvas area. - if (!Fl::event_inside(canvas)) + if (!Fl::event_inside (canvas)) return retval; if (!fp.is_beingdeleted ()) @@ -1244,17 +1256,17 @@ break; case FL_PUSH: - px0 = Fl::event_x (); - py0 = Fl::event_y (); + pos_x = Fl::event_x (); + pos_y = Fl::event_y (); set_currentpoint (Fl::event_x (), Fl::event_y ()); - gh = pixel2axes_or_ca (px0, py0); + gh = pixel2axes_or_ca (pos_x, pos_y); if (gh.ok ()) { - ax0 = gh_manager::get_object (gh); - set_axes_currentpoint (ax0, px0, py0); + ax_obj = gh_manager::get_object (gh); + set_axes_currentpoint (ax_obj, pos_x, pos_y); } fp.execute_windowbuttondownfcn (); @@ -1273,42 +1285,44 @@ if (Fl::event_button () == 1) { - if (ax0 && ax0.isa ("axes")) + if (ax_obj && ax_obj.isa ("axes")) { if (gui_mode == pan_zoom) - pixel2status (ax0, px0, py0, Fl::event_x (), Fl::event_y ()); + pixel2status (ax_obj, pos_x, pos_y, + Fl::event_x (), Fl::event_y ()); else - view2status (ax0); + view2status (ax_obj); axes::properties& ap = - dynamic_cast<axes::properties&> (ax0.get_properties ()); + dynamic_cast<axes::properties&> (ax_obj.get_properties ()); double x0, y0, x1, y1; Matrix pos = fp.get_position ().matrix_value (); - pixel2pos (ax0, px0, py0, x0, y0); - pixel2pos (ax0, Fl::event_x (), Fl::event_y (), x1, y1); + pixel2pos (ax_obj, pos_x, pos_y, x0, y0); + pixel2pos (ax_obj, Fl::event_x (), Fl::event_y (), x1, y1); if (gui_mode == pan_zoom) ap.translate_view (x0 - x1, y0 - y1); else if (gui_mode == rotate_zoom) { double daz, del; - daz = (Fl::event_x () - px0) / pos(2) * 360; - del = (Fl::event_y () - py0) / pos(3) * 360; + daz = (Fl::event_x () - pos_x) / pos(2) * 360; + del = (Fl::event_y () - pos_y) / pos(3) * 360; ap.rotate_view (del, daz); } - px0 = Fl::event_x (); - py0 = Fl::event_y (); + pos_x = Fl::event_x (); + pos_y = Fl::event_y (); mark_modified (); } return 1; } else if (Fl::event_button () == 3) { - pixel2status (ax0, px0, py0, Fl::event_x (), Fl::event_y ()); + pixel2status (ax_obj, pos_x, pos_y, + Fl::event_x (), Fl::event_y ()); Matrix zoom_box (1,4,0); - zoom_box (0) = px0; - zoom_box (1) = py0; + zoom_box (0) = pos_x; + zoom_box (1) = pos_y; zoom_box (2) = Fl::event_x (); zoom_box (3) = Fl::event_y (); canvas->set_zoom_box (zoom_box); @@ -1353,13 +1367,13 @@ { if ( Fl::event_clicks () == 1) { - if (ax0 && ax0.isa ("axes")) + if (ax_obj && ax_obj.isa ("axes")) { axes::properties& ap = - dynamic_cast<axes::properties&> (ax0.get_properties ()); - ap.set_xlimmode("auto"); - ap.set_ylimmode("auto"); - ap.set_zlimmode("auto"); + dynamic_cast<axes::properties&> (ax_obj.get_properties ()); + ap.set_xlimmode ("auto"); + ap.set_ylimmode ("auto"); + ap.set_zlimmode ("auto"); mark_modified (); } } @@ -1371,12 +1385,13 @@ { canvas->zoom (false); double x0,y0,x1,y1; - if (ax0 && ax0.isa ("axes")) + if (ax_obj && ax_obj.isa ("axes")) { axes::properties& ap = - dynamic_cast<axes::properties&> (ax0.get_properties ()); - pixel2pos (ax0, px0, py0, x0, y0); - pixel2pos (ax0, Fl::event_x (), Fl::event_y (), x1, y1); + dynamic_cast<axes::properties&> (ax_obj.get_properties ()); + pixel2pos (ax_obj, pos_x, pos_y, x0, y0); + pixel2pos (ax_obj, Fl::event_x (), Fl::event_y (), + x1, y1); Matrix xl (1,2,0); Matrix yl (1,2,0); if (x0 < x1) @@ -1456,18 +1471,25 @@ instance->do_delete_window (idx); } - static void delete_window (std::string idx_str) + static void delete_window (const std::string& idx_str) { delete_window (str2idx (idx_str)); } + static void renumber_figure (const std::string& idx_str, double new_number) + { + if (instance_ok ()) + instance->do_renumber_figure (str2idx (idx_str), new_number); + } + static void toggle_window_visibility (int idx, bool is_visible) { if (instance_ok ()) instance->do_toggle_window_visibility (idx, is_visible); } - static void toggle_window_visibility (std::string idx_str, bool is_visible) + static void toggle_window_visibility (const std::string& idx_str, + bool is_visible) { toggle_window_visibility (str2idx (idx_str), is_visible); } @@ -1489,7 +1511,7 @@ instance->do_set_name (idx); } - static void set_name (std::string idx_str) + static void set_name (const std::string& idx_str) { set_name (str2idx (idx_str)); } @@ -1504,22 +1526,25 @@ return get_size (hnd2idx (gh)); } - static void print (const graphics_handle& gh , const std::string& cmd, const std::string& term) + static void print (const graphics_handle& gh, const std::string& cmd, + const std::string& term) { if (instance_ok ()) - instance->do_print (hnd2idx(gh), cmd, term); + instance->do_print (hnd2idx (gh), cmd, term); } - static void uimenu_update (const graphics_handle& figh, const graphics_handle& uimenuh, const int id) + static void uimenu_update (const graphics_handle& figh, + const graphics_handle& uimenuh, int id) { if (instance_ok ()) - instance->do_uimenu_update (hnd2idx(figh), uimenuh, id); + instance->do_uimenu_update (hnd2idx (figh), uimenuh, id); } - static void update_canvas (const graphics_handle& gh, const graphics_handle& ca) + static void update_canvas (const graphics_handle& gh, + const graphics_handle& ca) { if (instance_ok ()) - instance->do_update_canvas (hnd2idx(gh), ca); + instance->do_update_canvas (hnd2idx (gh), ca); } static void toggle_menubar_visibility (int fig_idx, bool menubar_is_figure) @@ -1528,7 +1553,8 @@ instance->do_toggle_menubar_visibility (fig_idx, menubar_is_figure); } - static void toggle_menubar_visibility (std::string fig_idx_str, bool menubar_is_figure) + static void toggle_menubar_visibility (const std::string& fig_idx_str, + bool menubar_is_figure) { toggle_menubar_visibility (str2idx (fig_idx_str), menubar_is_figure); } @@ -1562,31 +1588,47 @@ void do_new_window (figure::properties& fp) { - int x, y, w, h; + int idx = figprops2idx (fp); - int idx = figprops2idx (fp); if (idx >= 0 && windows.find (idx) == windows.end ()) { - default_size (x, y, w, h); - idx2figprops (curr_index , fp); + Matrix pos = fp.get_boundingbox (true); + + int x = pos(0); + int y = pos(1); + int w = pos(2); + int h = pos(3); + + idx2figprops (curr_index, fp); + windows[curr_index++] = new plot_window (x, y, w, h, fp); } } void do_delete_window (int idx) { - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) { delete win->second; windows.erase (win); } } + void do_renumber_figure (int idx, double new_number) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->renumber (new_number); + } + void do_toggle_window_visibility (int idx, bool is_visible) { - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) { if (is_visible) win->second->show (); @@ -1599,8 +1641,9 @@ void do_toggle_menubar_visibility (int fig_idx, bool menubar_is_figure) { - wm_iterator win; - if ((win = windows.find (fig_idx)) != windows.end ()) + wm_iterator win = windows.find (fig_idx); + + if (win != windows.end ()) { if (menubar_is_figure) win->second->show_menubar (); @@ -1613,28 +1656,27 @@ void do_mark_modified (int idx) { - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) - { - win->second->mark_modified (); - } + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->mark_modified (); } void do_set_name (int idx) { - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) - { - win->second->set_name (); - } + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->set_name (); } Matrix do_get_size (int idx) { Matrix sz (1, 2, 0.0); - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) { sz(0) = win->second->w (); sz(1) = win->second->h (); @@ -1645,26 +1687,25 @@ void do_print (int idx, const std::string& cmd, const std::string& term) { - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) - { - win->second->print (cmd, term); - } + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->print (cmd, term); } - void do_uimenu_update (int idx, graphics_handle gh, int id) + void do_uimenu_update (int idx, const graphics_handle& gh, int id) { - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) - { - win->second->uimenu_update (gh, id); - } + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->uimenu_update (gh, id); } - void do_update_canvas (int idx, graphics_handle ca) + void do_update_canvas (int idx, const graphics_handle& ca) { - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) { if (ca.ok ()) win->second->show_canvas (); @@ -1673,17 +1714,7 @@ } } - - // FIXME -- default size should be configurable. - void default_size (int& x, int& y, int& w, int& h) - { - x = 0; - y = 0; - w = 640; - h = 480; - } - - static int str2idx (const caseless_str clstr) + static int str2idx (const caseless_str& clstr) { int ind; if (clstr.find (fltk_idx_header,0) == 0) @@ -1717,7 +1748,7 @@ return -1; } - static int hnd2idx (const double h) + static int hnd2idx (double h) { graphics_object fobj = gh_manager::get_object (h); if (fobj && fobj.isa ("figure")) @@ -1726,7 +1757,7 @@ dynamic_cast<figure::properties&> (fobj.get_properties ()); return figprops2idx (fp); } - error ("figure_manager: H is not a figure"); + error ("figure_manager: H (= %g) is not a figure", h); return -1; } @@ -1741,12 +1772,12 @@ std::string figure_manager::fltk_idx_header="fltk index="; int figure_manager::curr_index = 1; -static bool toolkit_registered = false; +static bool toolkit_loaded = false; static int __fltk_redraw__ (void) { - if (toolkit_registered) + if (toolkit_loaded) { // We scan all figures and add those which use FLTK. graphics_object obj = gh_manager::get_object (0); @@ -1787,6 +1818,9 @@ bool is_valid (void) const { return true; } + bool initialize (const graphics_object& go) + { return go.isa ("figure"); } + void finalize (const graphics_object& go) { if (go.isa ("figure")) @@ -1798,7 +1832,7 @@ } } - void uimenu_set_fltk_label(graphics_object uimenu_obj) + void uimenu_set_fltk_label (graphics_object uimenu_obj) { if (uimenu_obj.valid_object ()) { @@ -1808,14 +1842,14 @@ graphics_object go = gh_manager::get_object (uimenu_obj.get_parent ()); if (go.isa ("uimenu")) fltk_label = dynamic_cast<const uimenu::properties&> (go.get_properties ()).get_fltk_label () - + "/" - + fltk_label; + + "/" + + fltk_label; else if (go.isa ("figure")) ; else - error("unexpected parent object\n"); + error ("unexpected parent object\n"); - uimenup.set_fltk_label(fltk_label); + uimenup.set_fltk_label (fltk_label); } } @@ -1832,19 +1866,34 @@ switch (id) { - case base_properties::ID_VISIBLE: - figure_manager::toggle_window_visibility (ov.string_value (), fp.is_visible ()); - break; - case figure::properties::ID_MENUBAR: - figure_manager::toggle_menubar_visibility (ov.string_value (), fp.menubar_is("figure")); - break; - case figure::properties::ID_NAME: - case figure::properties::ID_CURRENTAXES: - figure_manager::update_canvas (go.get_handle (), fp.get_currentaxes ()); - break; - case figure::properties::ID_NUMBERTITLE: - figure_manager::set_name (ov.string_value ()); - break; + case base_properties::ID_VISIBLE: + figure_manager::toggle_window_visibility + (ov.string_value (), fp.is_visible ()); + break; + + case figure::properties::ID_MENUBAR: + figure_manager::toggle_menubar_visibility + (ov.string_value (), fp.menubar_is ("figure")); + break; + + case figure::properties::ID_CURRENTAXES: + figure_manager::update_canvas + (go.get_handle (), fp.get_currentaxes ()); + break; + + case figure::properties::ID_NAME: + case figure::properties::ID_NUMBERTITLE: + figure_manager::set_name (ov.string_value ()); + break; + + case figure::properties::ID_INTEGERHANDLE: + { + std::string tmp = ov.string_value (); + graphics_handle gh = fp.get___myhandle__ (); + figure_manager::renumber_figure (tmp, gh.value ()); + figure_manager::set_name (tmp); + } + break; } } } @@ -1892,31 +1941,42 @@ sz(1) = Fl::h (); return sz; } + + void close (void) + { + if (toolkit_loaded) + { + munlock ("__init_fltk__"); + + figure_manager::close_all (); + gtk_manager::unload_toolkit (FLTK_GRAPHICS_TOOLKIT_NAME); + toolkit_loaded = false; + + octave_value_list args; + args(0) = "__fltk_redraw__"; + feval ("remove_input_event_hook", args, 0); + + // FIXME ??? + Fl::wait (fltk_maxtime); + } + } }; // Initialize the fltk graphics toolkit. DEFUN_DLD (__init_fltk__, , , "") { - static bool remove_fltk_registered = false; - - if (! toolkit_registered) + if (! toolkit_loaded) { mlock (); - graphics_toolkit::register_toolkit (new fltk_graphics_toolkit); - toolkit_registered = true; + graphics_toolkit tk (new fltk_graphics_toolkit ()); + gtk_manager::load_toolkit (tk); + toolkit_loaded = true; octave_value_list args; args(0) = "__fltk_redraw__"; feval ("add_input_event_hook", args, 0); - - if (! remove_fltk_registered) - { - octave_add_atexit_function ("__remove_fltk__"); - - remove_fltk_registered = true; - } } octave_value retval; @@ -1930,30 +1990,6 @@ return octave_value (); } -// Delete the fltk graphics toolkit. - -DEFUN_DLD (__remove_fltk__, , , "") -{ - if (toolkit_registered) - { - munlock ("__init_fltk__"); - - figure_manager::close_all (); - graphics_toolkit::unregister_toolkit (FLTK_GRAPHICS_TOOLKIT_NAME); - toolkit_registered = false; - - octave_value_list args; - args(0) = "__fltk_redraw__"; - feval ("remove_input_event_hook", args, 0); - - // FIXME ??? - Fl::wait (fltk_maxtime); - } - - octave_value retval; - return retval; -} - DEFUN_DLD (__fltk_maxtime__, args, ,"") { octave_value retval = fltk_maxtime; @@ -1969,13 +2005,14 @@ return retval; } -/* FIXME: This function should be abstracted and made potentially available - to all graphics toolkits. This suggests putting it in graphics.cc - as is done for drawnow() and having the master mouse_wheel_zoom - function call fltk_mouse_wheel_zoom. The same should be done for - gui_mode and fltk_gui_mode. For now (2011.01.30), just - changing function names and docstrings. -*/ +#endif + +// FIXME -- This function should be abstracted and made potentially +// available to all graphics toolkits. This suggests putting it in +// graphics.cc as is done for drawnow() and having the master +// mouse_wheel_zoom function call fltk_mouse_wheel_zoom. The same +// should be done for gui_mode and fltk_gui_mode. For now (2011.01.30), +// just changing function names and docstrings. DEFUN_DLD (mouse_wheel_zoom, args, , "-*- texinfo -*-\n\ @@ -1987,6 +2024,7 @@ @seealso{gui_mode}\n\ @end deftypefn") { +#if defined (HAVE_FLTK) octave_value retval = wheel_zoom_speed; if (args.length () == 1) @@ -1998,6 +2036,10 @@ } return retval; +#else + error ("mouse_wheel_zoom: not available without OpenGL and FLTK libraries"); + return octave_value (); +#endif } DEFUN_DLD (gui_mode, args, , @@ -2021,6 +2063,7 @@ @seealso{mouse_wheel_zoom}\n\ @end deftypefn") { +#if defined (HAVE_FLTK) caseless_str mode_str; if (gui_mode == pan_zoom) @@ -2030,7 +2073,6 @@ else mode_str = "none"; - bool failed = false; if (args.length () == 1) @@ -2055,9 +2097,10 @@ if (failed) error ("MODE must be one of the strings: \"2D\", \"3D\", or \"none\""); - - return octave_value(mode_str); + return octave_value (mode_str); +#else + error ("mouse_wheel_zoom: not available without OpenGL and FLTK libraries"); + return octave_value (); +#endif } - -#endif
new file mode 100644 --- /dev/null +++ b/src/DLD-FUNCTIONS/__init_gnuplot__.cc @@ -0,0 +1,193 @@ +/* + +Copyright (C) 2007-2011 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/>. + +*/ + +/* + +To initialize: + + graphics_toolkit ("gnuplot"); + plot (randn (1e3, 1)); + +*/ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include "defun-dld.h" +#include "error.h" +#include "graphics.h" +#include "parse.h" +#include "variables.h" + +// PKG_ADD: register_graphics_toolkit ("gnuplot"); + +static bool toolkit_loaded = false; + +class gnuplot_graphics_toolkit : public base_graphics_toolkit +{ +public: + gnuplot_graphics_toolkit (void) + : base_graphics_toolkit ("gnuplot") { } + + ~gnuplot_graphics_toolkit (void) { } + + bool is_valid (void) const { return true; } + + bool initialize (const graphics_object& go) + { + return go.isa ("figure"); + } + + void finalize (const graphics_object& go) + { + if (go.isa ("figure")) + { + const figure::properties& props = + dynamic_cast<const figure::properties&> (go.get_properties ()); + + send_quit (props.get___plot_stream__ ()); + } + } + + void update (const graphics_object& go, int id) + { + if (go.isa ("figure")) + { + graphics_object obj (go); + + figure::properties& props = + dynamic_cast<figure::properties&> (obj.get_properties ()); + + switch (id) + { + case base_properties::ID_VISIBLE: + if (! props.is_visible ()) + { + send_quit (props.get___plot_stream__ ()); + props.set___plot_stream__ (Matrix ()); + props.set___enhanced__ (false); + } + break; + } + } + } + + void redraw_figure (const graphics_object& go) const + { + octave_value_list args; + args(0) = go.get_handle ().as_octave_value (); + feval ("__gnuplot_drawnow__", args); + } + + void print_figure (const graphics_object& go, const std::string& term, + const std::string& file, bool mono, + const std::string& debug_file) const + { + octave_value_list args; + if (! debug_file.empty ()) + args(4) = debug_file; + args(3) = mono; + args(2) = file; + args(1) = term; + args(0) = go.get_handle ().as_octave_value (); + feval ("__gnuplot_drawnow__", args); + } + + Matrix get_canvas_size (const graphics_handle&) const + { + Matrix sz (1, 2, 0.0); + return sz; + } + + double get_screen_resolution (void) const + { return 72.0; } + + Matrix get_screen_size (void) const + { return Matrix (1, 2, 0.0); } + + void close (void) + { + if (toolkit_loaded) + { + munlock ("__init_gnuplot__"); + + gtk_manager::unload_toolkit ("gnuplot"); + + toolkit_loaded = false; + } + } + +private: + + void send_quit (const octave_value& pstream) const + { + if (! pstream.is_empty ()) + { + octave_value_list args; + Matrix fids = pstream.matrix_value (); + + if (! error_state) + { + args(1) = "\nquit;\n"; + args(0) = fids(0); + feval ("fputs", args); + + args.resize (1); + feval ("fflush", args); + feval ("pclose", args); + + if (fids.numel () > 1) + { + args(0) = fids(1); + feval ("pclose", args); + + if (fids.numel () > 2) + { + args(0) = fids(2); + feval ("waitpid", args); + } + } + } + } + } +}; + +// Initialize the fltk graphics toolkit. + +DEFUN_DLD (__init_gnuplot__, , , "") +{ + octave_value retval; + + if (! toolkit_loaded) + { + mlock (); + + graphics_toolkit tk (new gnuplot_graphics_toolkit ()); + gtk_manager::load_toolkit (tk); + + toolkit_loaded = true; + } + + return retval; +} +
--- a/src/DLD-FUNCTIONS/__lin_interpn__.cc +++ b/src/DLD-FUNCTIONS/__lin_interpn__.cc @@ -355,3 +355,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__magick_read__.cc +++ b/src/DLD-FUNCTIONS/__magick_read__.cc @@ -531,6 +531,13 @@ return output; } +/* + +## No test needed for internal helper function. +%!assert (1) + +*/ + #ifdef HAVE_MAGICK static void @@ -663,8 +670,7 @@ octave_idx_type rows = m.rows (); octave_idx_type columns = m.columns (); - // FIXME -- maybe simply using bit shifting would be better? - unsigned int div_factor = pow (2.0, static_cast<int> (bitdepth)) - 1; + unsigned int div_factor = (1 << bitdepth) - 1; for (unsigned int ii = 0; ii < nframes; ii++) { @@ -753,7 +759,7 @@ } im.quantizeColorSpace (Magick::GRAYColorspace); - im.quantizeColors (pow (2, bitdepth)); + im.quantizeColors (1 << bitdepth); im.quantize (); } @@ -917,6 +923,13 @@ return retval; } +/* + +## No test needed for internal helper function. +%!assert (1) + +*/ + #ifdef HAVE_MAGICK template<class T> @@ -1135,6 +1148,13 @@ return retval; } +/* + +## No test needed for internal helper function. +%!assert (1) + +*/ + #undef GET_PARAM // Determine the file formats supported by GraphicsMagick. This is @@ -1194,3 +1214,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__pchip_deriv__.cc +++ b/src/DLD-FUNCTIONS/__pchip_deriv__.cc @@ -147,3 +147,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__qp__.cc +++ b/src/DLD-FUNCTIONS/__qp__.cc @@ -528,3 +528,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__voronoi__.cc +++ b/src/DLD-FUNCTIONS/__voronoi__.cc @@ -36,6 +36,8 @@ #include <cstdio> +#include <list> + #include "lo-ieee.h" #include "Cell.h" @@ -43,150 +45,213 @@ #include "error.h" #include "oct-obj.h" -#ifdef HAVE_QHULL -extern "C" { -#include <qhull/qhull_a.h> -} - -#ifdef NEED_QHULL_VERSION +#if defined (HAVE_QHULL) +# include "oct-qhull.h" +# if defined (NEED_QHULL_VERSION) char qh_version[] = "__voronoi__.oct 2007-07-24"; -#endif +# endif #endif DEFUN_DLD (__voronoi__, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{tri} =} __voronoi__ (@var{point})\n\ -@deftypefnx {Loadable Function} {@var{tri} =} __voronoi__ (@var{point}, @var{options})\n\ +@deftypefn {Loadable Function} {@var{C}, @var{F} =} __voronoi__ (@var{caller}, @var{pts})\n\ +@deftypefnx {Loadable Function} {@var{C}, @var{F} =} __voronoi__ (@var{caller}, @var{pts}, @var{options})\n\ +@deftypefnx {Loadable Function} {@var{C}, @var{F}, @var{Inf_Pts} =} __voronoi__ (@dots{})\n\ Undocumented internal function.\n\ @end deftypefn") { octave_value_list retval; -#ifdef HAVE_QHULL + std::string caller = args(0).string_value (); + +#if defined (HAVE_QHULL) retval(0) = 0.0; int nargin = args.length (); - if (nargin < 1 || nargin > 2) + if (nargin < 2 || nargin > 3) { print_usage (); return retval; } - const char *options; + Matrix points = args(1).matrix_value (); + const octave_idx_type dim = points.columns (); + const octave_idx_type num_points = points.rows (); + + points = points.transpose (); - if (nargin == 2) + std::string options; + + if (dim <= 4) + options = " Qbb"; + else + options = " Qbb Qx"; + + if (nargin == 3) { - if (! args (1).is_string ()) + octave_value opt_arg = args(2); + + if (opt_arg.is_string ()) + options = " " + opt_arg.string_value (); + else if (opt_arg.is_empty ()) + ; // Use default options. + else if (opt_arg.is_cellstr ()) { - error ("__voronoi__: OPTIONS argument must be a string"); + options = ""; + + Array<std::string> tmp = opt_arg.cellstr_value (); + + for (octave_idx_type i = 0; i < tmp.numel (); i++) + options += " " + tmp(i); + } + else + { + error ("%s: OPTIONS must be a string, cell array of strings, or empty", + caller.c_str ()); return retval; } - - options = args (1).string_value().c_str (); } - else - options = ""; - - Matrix p (args(0).matrix_value ()); - - const octave_idx_type dim = p.columns (); - const octave_idx_type np = p.rows (); - p = p.transpose (); - - double *pt_array = p.fortran_vec (); - - //double pt_array[dim * np]; - //for (int i = 0; i < np; i++) - // { - // for (int j = 0; j < dim; j++) - // { - // pt_array[j+i*dim] = p(i,j); - // } - // } boolT ismalloc = false; - OCTAVE_LOCAL_BUFFER (char, flags, 250); - - // hmm lot's of options for qhull here - sprintf (flags, "qhull v Fv T0 %s", options); - - // If you want some debugging information replace the 0 pointer - // with stdout or some other file open for writing. - + // Replace the 0 pointer with stdout for debugging information FILE *outfile = 0; FILE *errfile = stderr; - if (! qh_new_qhull (dim, np, pt_array, ismalloc, flags, outfile, errfile)) + // qh_new_qhull command and points arguments are not const... + + std::string cmd = "qhull v" + options; + + OCTAVE_LOCAL_BUFFER (char, cmd_str, cmd.length () + 1); + + strcpy (cmd_str, cmd.c_str ()); + + int exitcode = qh_new_qhull (dim, num_points, points.fortran_vec (), + ismalloc, cmd_str, outfile, errfile); + if (! exitcode) { + // Calling findgood_all provides the number of Voronoi vertices + // (sets qh num_good). + + qh_findgood_all (qh facet_list); + + octave_idx_type num_voronoi_regions + = qh num_vertices - qh_setsize (qh del_vertices); + + octave_idx_type num_voronoi_vertices = qh num_good; + + // Find the voronoi centers for all facets. + + qh_setvoronoi_all (); + facetT *facet; vertexT *vertex; + octave_idx_type k; - octave_idx_type i = 0, n = 1, k = 0, m = 0, fidx = 0, j = 0, r = 0; - OCTAVE_LOCAL_BUFFER (octave_idx_type, ni, np); + // Find the number of Voronoi vertices for each Voronoi cell and + // store them in NI so we can use them later to set the dimensions + // of the RowVector objects used to collect them. + + FORALLfacets + { + facet->seen = false; + } + + OCTAVE_LOCAL_BUFFER (octave_idx_type, ni, num_voronoi_regions); + for (octave_idx_type i = 0; i < num_voronoi_regions; i++) + ni[i] = 0; + + k = 0; + + FORALLvertices + { + if (qh hull_dim == 3) + qh_order_vertexneighbors (vertex); + + bool infinity_seen = false; + + facetT *neighbor, **neighborp; - for (i = 0; i < np; i++) - ni[i] = 0; - qh_setvoronoi_all (); - bool infinity_seen = false; - facetT *neighbor, **neighborp; - coordT *voronoi_vertex; + FOREACHneighbor_ (vertex) + { + if (neighbor->upperdelaunay) + { + if (! infinity_seen) + { + infinity_seen = true; + ni[k]++; + } + } + else + { + neighbor->seen = true; + ni[k]++; + } + } + + k++; + } + + // If Qhull finds fewer regions than points, we will pad the end + // of the at_inf and C arrays so that they always contain at least + // as many elements as the given points array. + + // FIXME -- is it possible (or does it make sense) for + // num_voronoi_regions to ever be larger than num_points? + + octave_idx_type nr = (num_points > num_voronoi_regions + ? num_points : num_voronoi_regions); + + boolMatrix at_inf (nr, 1, false); + + // The list of Voronoi vertices. The first element is always + // Inf. + Matrix F (num_voronoi_vertices+1, dim); + + for (octave_idx_type d = 0; d < dim; d++) + F(0,d) = octave_Inf; + + // The cell array of vectors of indices into F that represent the + // vertices of the Voronoi regions (cells). + + Cell C (nr, 1); + + // Now loop through the list of vertices again and store the + // coordinates of the Voronoi vertices and the lists of indices + // for the cells. FORALLfacets { facet->seen = false; } + octave_idx_type i = 0; + k = 0; + FORALLvertices { if (qh hull_dim == 3) qh_order_vertexneighbors (vertex); - infinity_seen = false; + + bool infinity_seen = false; - FOREACHneighbor_ (vertex) - { - if (! neighbor->upperdelaunay) - { - if (! neighbor->seen) - { - n++; - neighbor->seen = true; - } - ni[k]++; - } - else if (! infinity_seen) - { - infinity_seen = true; - ni[k]++; - } - } - k++; - } + octave_idx_type idx = qh_pointid (vertex->point); + + octave_idx_type num_vertices = ni[k++]; - Matrix v (n, dim); - for (octave_idx_type d = 0; d < dim; d++) - v(0,d) = octave_Inf; - - boolMatrix AtInf (np, 1); - for (i = 0; i < np; i++) - AtInf(i) = false; - octave_value_list F (np, octave_value ()); - k = 0; - i = 0; + // Qhull seems to sometimes produces regions with a single + // vertex. Is that a bug? How can a region have just one + // vertex? Let's skip it. - FORALLfacets - { - facet->seen = false; - } + if (num_vertices == 1) + continue; - FORALLvertices - { - if (qh hull_dim == 3) - qh_order_vertexneighbors(vertex); - infinity_seen = false; - RowVector facet_list (ni[k++]); - m = 0; + RowVector facet_list (num_vertices); + + octave_idx_type m = 0; + + facetT *neighbor, **neighborp; FOREACHneighbor_(vertex) { @@ -196,55 +261,55 @@ { infinity_seen = true; facet_list(m++) = 1; - AtInf(j) = true; + at_inf(idx) = true; } } else { if (! neighbor->seen) { - voronoi_vertex = neighbor->center; - fidx = neighbor->id; i++; for (octave_idx_type d = 0; d < dim; d++) - { - v(i,d) = *(voronoi_vertex++); - } + F(i,d) = neighbor->center[d]; + neighbor->seen = true; neighbor->visitid = i; } + facet_list(m++) = neighbor->visitid + 1; } } - F(r++) = facet_list; - j++; + + C(idx) = facet_list; } - Cell C(r, 1); - for (i = 0; i < r; i++) - C.elem (i) = F(i); - - retval(0) = v; + retval(2) = at_inf; retval(1) = C; - AtInf.resize (r, 1); - retval(2) = AtInf; - - // free long memory - qh_freeqhull (! qh_ALL); - - // free short memory and memory allocator - int curlong, totlong; - qh_memfreeshort (&curlong, &totlong); - - if (curlong || totlong) - warning ("__voronoi__: did not free %d bytes of long memory (%d pieces)", totlong, curlong); + retval(0) = F; } else - error ("__voronoi__: qhull failed"); + error ("%s: qhull failed", caller.c_str ()); + + // Free memory from Qhull + qh_freeqhull (! qh_ALL); + + int curlong, totlong; + qh_memfreeshort (&curlong, &totlong); + + if (curlong || totlong) + warning ("%s: qhull did not free %d bytes of long memory (%d pieces)", + caller.c_str (), totlong, curlong); #else - error ("__voronoi__: not available in this version of Octave"); + error ("%s: not available in this version of Octave", caller.c_str ()); #endif return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/amd.cc +++ b/src/DLD-FUNCTIONS/amd.cc @@ -55,7 +55,7 @@ @deftypefn {Loadable Function} {@var{p} =} amd (@var{S})\n\ @deftypefnx {Loadable Function} {@var{p} =} amd (@var{S}, @var{opts})\n\ \n\ -Returns the approximate minimum degree permutation of a matrix. This\n\ +Return the approximate minimum degree permutation of a matrix. This\n\ permutation such that the Cholesky@tie{}factorization of @code{@var{S}\n\ (@var{p}, @var{p})} tends to be sparser than the Cholesky@tie{}factorization\n\ of @var{S} itself. @code{amd} is typically faster than @code{symamd} but\n\
--- a/src/DLD-FUNCTIONS/balance.cc +++ b/src/DLD-FUNCTIONS/balance.cc @@ -61,10 +61,10 @@ equilibration to be computed without round-off. Results of eigenvalue\n\ calculation are typically improved by balancing first.\n\ \n\ -If two output values are requested, @code{balance} returns \n\ -the diagonal @var{D} and the permutation @var{P} separately as vectors. \n\ -In this case, @code{@var{DD} = eye(n)(:,@var{P}) * diag (@var{D})}, where n\n\ -@t{n} is the matrix size. \n\ +If two output values are requested, @code{balance} returns\n\ +the diagonal @var{D} and the permutation @var{P} separately as vectors.\n\ +In this case, @code{@var{DD} = eye(n)(:,@var{P}) * diag (@var{D})}, where\n\ +@math{n} is the matrix size.\n\ \n\ If four output values are requested, compute @code{@var{AA} =\n\ @var{CC}*@var{A}*@var{DD}} and @code{@var{BB} = @var{CC}*@var{B}*@var{DD}},\n\ @@ -169,8 +169,8 @@ else { retval(2) = result.balanced_matrix (); + retval(1) = result.permuting_vector (); retval(0) = result.scaling_vector (); - retval(1) = result.permuting_vector (); } } @@ -188,8 +188,8 @@ else { retval(2) = result.balanced_matrix (); + retval(1) = result.permuting_vector (); retval(0) = result.scaling_vector (); - retval(1) = result.permuting_vector (); } } } @@ -209,8 +209,8 @@ else { retval(2) = result.balanced_matrix (); + retval(1) = result.permuting_vector (); retval(0) = result.scaling_vector (); - retval(1) = result.permuting_vector (); } } else @@ -227,8 +227,8 @@ else { retval(2) = result.balanced_matrix (); + retval(1) = result.permuting_vector (); retval(0) = result.scaling_vector (); - retval(1) = result.permuting_vector (); } } }
--- a/src/DLD-FUNCTIONS/besselj.cc +++ b/src/DLD-FUNCTIONS/besselj.cc @@ -387,7 +387,7 @@ \n\ @table @code\n\ @item besselj\n\ -Bessel functions of the first kind. If the argument @var{opt} is supplied, \n\ +Bessel functions of the first kind. If the argument @var{opt} is supplied,\n\ the result is multiplied by @code{exp(-abs(imag(@var{x})))}.\n\ \n\ @item bessely\n\
--- a/src/DLD-FUNCTIONS/betainc.cc +++ b/src/DLD-FUNCTIONS/betainc.cc @@ -35,10 +35,10 @@ DEFUN_DLD (betainc, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} betainc (@var{x}, @var{a}, @var{b})\n\ -Return the incomplete Beta function,\n\ +Return the regularized incomplete Beta function,\n\ @tex\n\ $$\n\ - \\beta (x, a, b) = B (a, b)^{-1} \\int_0^x t^{(a-z)} (1-t)^{(b-1)} dt.\n\ + I (x, a, b) = {1 \\over {B (a, b)}} \\int_0^x t^{(a-z)} (1-t)^{(b-1)} dt.\n\ $$\n\ @end tex\n\ @ifnottex\n\ @@ -46,17 +46,18 @@ \n\ @smallexample\n\ @group\n\ - x\n\ - /\n\ -betainc (x, a, b) = beta (a, b)^(-1) | t^(a-1) (1-t)^(b-1) dt.\n\ - /\n\ - t=0\n\ +@c spacing appears odd here, but is correct after Makeinfo\n\ + x\n\ + 1 /\n\ +betainc (x, a, b) = ----------- | t^(a-1) (1-t)^(b-1) dt.\n\ + beta (a, b) /\n\ + t=0\n\ @end group\n\ @end smallexample\n\ \n\ @end ifnottex\n\ \n\ -If x has more than one component, both @var{a} and @var{b} must be\n\ +If @var{x} has more than one component, both @var{a} and @var{b} must be\n\ scalars. If @var{x} is a scalar, @var{a} and @var{b} must be of\n\ compatible dimensions.\n\ @end deftypefn") @@ -321,12 +322,12 @@ %! assert(v3, v4, sqrt(eps ('single'))); %% test/octave.test/arith/betainc-2.m -%!error <Invalid call to betainc.*> betainc(); +%!error <Invalid call to betainc> betainc(); %% test/octave.test/arith/betainc-3.m -%!error <Invalid call to betainc.*> betainc(1); +%!error <Invalid call to betainc> betainc(1); %% test/octave.test/arith/betainc-4.m -%!error <Invalid call to betainc.*> betainc(1,2); +%!error <Invalid call to betainc> betainc(1,2); */
--- a/src/DLD-FUNCTIONS/bsxfun.cc +++ b/src/DLD-FUNCTIONS/bsxfun.cc @@ -312,14 +312,18 @@ DEFUN_DLD (bsxfun, args, , "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} bsxfun (@var{f}, @var{A}, @var{B})\n\ -Apply a binary function @var{f} element-by-element to two matrix arguments\n\ -@var{A} and @var{B}. The function @var{f} must be capable of accepting\n\ -two column-vector arguments of equal length, or one column vector\n\ -argument and a scalar.\n\ +The binary singleton expansion function applier performs broadcasting,\n\ +that is, applies a binary function @var{f} element-by-element to two\n\ +array arguments @var{A} and @var{B}, and expands as necessary\n\ +singleton dimensions in either input argument. @var{f} is a function\n\ +handle, inline function, or string containing the name of the function\n\ +to evaluate. The function @var{f} must be capable of accepting two\n\ +column-vector arguments of equal length, or one column vector argument\n\ +and a scalar.\n\ \n\ The dimensions of @var{A} and @var{B} must be equal or singleton. The\n\ -singleton dimensions of the matrices will be expanded to the same\n\ -dimensionality as the other matrix.\n\ +singleton dimensions of the arrays will be expanded to the same\n\ +dimensionality as the other array.\n\ @seealso{arrayfun, cellfun}\n\ @end deftypefn") { @@ -765,4 +769,45 @@ %!assert (bsxfun (@max, a, b), max (aa, bb)); %!assert (bsxfun (@and, a > 0, b > 0), (aa > 0) & (bb > 0)); %!assert (bsxfun (@or, a > 0, b > 0), (aa > 0) | (bb > 0)); + +%% Test automatic bsxfun +% +%!test +%! funs = {@plus, @minus, @times, @rdivide, @ldivide, @power, @max, @min, \ +%! @rem, @mod, @atan2, @hypot, @eq, @ne, @lt, @le, @gt, @ge, \ +%! @and, @or, @xor }; +%! +%! float_types = {@single, @double}; +%! int_types = {@int8, @int16, @int32, @int64, \ +%! @uint8, @uint16, @uint32, @uint64}; +%! +%! x = rand (3)*10-5; +%! y = rand (3,1)*10-5; +%! +%! for i=1:length (funs) +%! for j = 1:length(float_types) +%! for k = 1:length(int_types) +%! +%! fun = funs{i}; +%! f_type = float_types{j}; +%! i_type = int_types{k}; +%! +%! assert (bsxfun (fun, f_type (x), i_type (y)), \ +%! fun (f_type(x), i_type (y))); +%! assert (bsxfun (fun, f_type (y), i_type (x)), \ +%! fun (f_type(y), i_type (x))); +%! +%! assert (bsxfun (fun, i_type (x), i_type (y)), \ +%! fun (i_type (x), i_type (y))); +%! assert (bsxfun (fun, i_type (y), i_type (x)), \ +%! fun (i_type (y), i_type (x))); +%! +%! assert (bsxfun (fun, f_type (x), f_type (y)), \ +%! fun (f_type (x), f_type (y))); +%! assert (bsxfun (fun, f_type(y), f_type(x)), \ +%! fun (f_type (y), f_type (x))); +%! endfor +%! endfor +%! endfor +%! */
--- a/src/DLD-FUNCTIONS/ccolamd.cc +++ b/src/DLD-FUNCTIONS/ccolamd.cc @@ -453,7 +453,7 @@ } } - octave_idx_type n_row, n_col, nnz; + octave_idx_type n_row, n_col; octave_idx_type *ridx, *cidx; SparseMatrix sm; SparseComplexMatrix scm; @@ -465,7 +465,6 @@ scm = args(0).sparse_complex_matrix_value (); n_row = scm.rows (); n_col = scm.cols (); - nnz = scm.nnz (); ridx = scm.xridx (); cidx = scm.xcidx (); } @@ -474,7 +473,6 @@ sm = args(0).sparse_matrix_value (); n_row = sm.rows (); n_col = sm.cols (); - nnz = sm.nnz (); ridx = sm.xridx (); cidx = sm.xcidx (); } @@ -488,7 +486,6 @@ n_row = sm.rows (); n_col = sm.cols (); - nnz = sm.nnz (); ridx = sm.xridx (); cidx = sm.xcidx (); }
--- a/src/DLD-FUNCTIONS/cellfun.cc +++ b/src/DLD-FUNCTIONS/cellfun.cc @@ -1,6 +1,7 @@ /* Copyright (C) 2005-2011 Mohamed Kamoun +Copyright (C) 2006-2011 Bill Denney Copyright (C) 2009 Jaroslav Hajek Copyright (C) 2010 VZLU Prague @@ -31,6 +32,7 @@ #include <list> #include <memory> +#include "caseless-str.h" #include "lo-mappers.h" #include "oct-locbuf.h" @@ -44,6 +46,7 @@ #include "gripes.h" #include "utils.h" +#include "ov-class.h" #include "ov-scalar.h" #include "ov-float.h" #include "ov-complex.h" @@ -58,6 +61,8 @@ #include "ov-uint32.h" #include "ov-uint64.h" +#include "ov-fcn-handle.h" + static octave_value_list get_output_list (octave_idx_type count, octave_idx_type nargout, const octave_value_list& inputlist, @@ -74,11 +79,16 @@ msg.assign ("identifier", last_error_id ()); msg.assign ("message", last_error_message ()); msg.assign ("index", static_cast<double> (count + static_cast<octave_idx_type>(1))); + octave_value_list errlist = inputlist; errlist.prepend (msg); + buffer_error_messages--; + error_state = 0; + tmp = error_handler.do_multi_index_op (nargout, errlist); + buffer_error_messages++; if (error_state) @@ -91,6 +101,154 @@ return tmp; } +static octave_value_list +try_cellfun_internal_ops (const octave_value_list& args, int nargin) +{ + octave_value_list retval; + + std::string name = args(0).string_value (); + + const Cell f_args = args(1).cell_value (); + + octave_idx_type k = f_args.numel (); + + if (name == "isempty") + { + boolNDArray result (f_args.dims ()); + for (octave_idx_type count = 0; count < k; count++) + result(count) = f_args.elem(count).is_empty (); + retval(0) = result; + } + else if (name == "islogical") + { + boolNDArray result (f_args.dims ()); + for (octave_idx_type count= 0; count < k; count++) + result(count) = f_args.elem(count).is_bool_type (); + retval(0) = result; + } + else if (name == "isreal") + { + boolNDArray result (f_args.dims ()); + for (octave_idx_type count= 0; count < k; count++) + result(count) = f_args.elem(count).is_real_type (); + retval(0) = result; + } + else if (name == "length") + { + NDArray result (f_args.dims ()); + for (octave_idx_type count= 0; count < k; count++) + result(count) = static_cast<double> (f_args.elem(count).length ()); + retval(0) = result; + } + else if (name == "ndims") + { + NDArray result (f_args.dims ()); + for (octave_idx_type count = 0; count < k; count++) + result(count) = static_cast<double> (f_args.elem(count).ndims ()); + retval(0) = result; + } + else if (name == "prodofsize" || name == "numel") + { + NDArray result (f_args.dims ()); + for (octave_idx_type count = 0; count < k; count++) + result(count) = static_cast<double> (f_args.elem(count).numel ()); + retval(0) = result; + } + else if (name == "size") + { + if (nargin == 3) + { + int d = args(2).nint_value () - 1; + + if (d < 0) + error ("cellfun: K must be a positive integer"); + + if (! error_state) + { + NDArray result (f_args.dims ()); + for (octave_idx_type count = 0; count < k; count++) + { + dim_vector dv = f_args.elem(count).dims (); + if (d < dv.length ()) + result(count) = static_cast<double> (dv(d)); + else + result(count) = 1.0; + } + retval(0) = result; + } + } + else + error ("cellfun: not enough arguments for \"size\""); + } + else if (name == "isclass") + { + if (nargin == 3) + { + std::string class_name = args(2).string_value(); + boolNDArray result (f_args.dims ()); + for (octave_idx_type count = 0; count < k; count++) + result(count) = (f_args.elem(count).class_name() == class_name); + + retval(0) = result; + } + else + error ("cellfun: not enough arguments for \"isclass\""); + } + + return retval; +} + +static void +get_mapper_fun_options (const octave_value_list& args, int& nargin, + bool& uniform_output, octave_value& error_handler) +{ + while (nargin > 3 && args(nargin-2).is_string ()) + { + caseless_str arg = args(nargin-2).string_value (); + + size_t compare_len = std::max (arg.length (), static_cast<size_t> (2)); + + if (arg.compare ("uniformoutput", compare_len)) + uniform_output = args(nargin-1).bool_value(); + else if (arg.compare ("errorhandler", compare_len)) + { + if (args(nargin-1).is_function_handle () + || args(nargin-1).is_inline_function ()) + { + error_handler = args(nargin-1); + } + else if (args(nargin-1).is_string ()) + { + std::string err_name = args(nargin-1).string_value (); + + error_handler = symbol_table::find_function (err_name); + + if (error_handler.is_undefined ()) + { + error ("cellfun: invalid function NAME: %s", + err_name.c_str ()); + break; + } + } + else + { + error ("cellfun: invalid value for 'ErrorHandler' function"); + break; + } + } + else + { + error ("cellfun: unrecognized parameter %s", + arg.c_str()); + break; + } + + nargin -= 2; + } + + nargin -= 1; +} + DEFUN_DLD (cellfun, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} cellfun (@var{name}, @var{C})\n\ @@ -122,8 +280,10 @@ @item ndims\n\ Return the number of dimensions of each element.\n\ \n\ -@item prodofsize\n\ -Return the product of dimensions of each element.\n\ +@item numel\n\ +@itemx prodofsize\n\ +Return the number of elements contained within each cell element. The\n\ +number is the product of the dimensions of the object at each cell element.\n\ \n\ @item size\n\ Return the size along the @var{k}-th dimension.\n\ @@ -142,7 +302,7 @@ \n\ @example\n\ @group\n\ -cellfun (@@atan2, @{1, 0@}, @{0, 1@})\n\ +cellfun (\"atan2\", @{1, 0@}, @{0, 1@})\n\ @result{}ans = [1.57080 0.00000]\n\ @end group\n\ @end example\n\ @@ -159,7 +319,7 @@ endfunction\n\ [aa, bb] = cellfun(@@twoouts, @{1, 2, 3@})\n\ @result{}\n\ - aa = \n\ + aa =\n\ 1 2 3\n\ bb =\n\ 1 4 9\n\ @@ -177,7 +337,7 @@ \n\ @example\n\ @group\n\ -cellfun (\"tolower(x)\", @{\"Foo\", \"Bar\", \"FooBar\"@},\n\ +cellfun (\"tolower\", @{\"Foo\", \"Bar\", \"FooBar\"@},\n\ \"UniformOutput\",false)\n\ @result{} ans = @{\"foo\", \"bar\", \"foobar\"@}\n\ @end group\n\ @@ -200,11 +360,26 @@ @example\n\ @group\n\ function y = foo (s, x), y = NaN; endfunction\n\ -cellfun (@@factorial, @{-1,2@},'ErrorHandler',@@foo)\n\ +cellfun (\"factorial\", @{-1,2@}, 'ErrorHandler', @@foo)\n\ @result{} ans = [NaN 2]\n\ @end group\n\ @end example\n\ \n\ +Use @code{cellfun} intelligently. The @code{cellfun} function is a\n\ +useful tool for avoiding loops. It is often used with anonymous\n\ +function handles; however, calling an anonymous function involves an\n\ +overhead quite comparable to the overhead of an m-file function.\n\ +Passing a handle to a built-in function is faster, because the\n\ +interpreter is not involved in the internal loop. For example:\n\ +\n\ +@example\n\ +@group\n\ +a = @{@dots{}@}\n\ +v = cellfun (@@(x) det(x), a); # compute determinants\n\ +v = cellfun (@@det, a); # faster\n\ +@end group\n\ +@end example\n\ +\n\ @seealso{arrayfun, structfun, spfun}\n\ @end deftypefn") { @@ -230,172 +405,92 @@ if (func.is_string ()) { - const Cell f_args = args(1).cell_value (); + retval = try_cellfun_internal_ops (args, nargin); - octave_idx_type k = f_args.numel (); - - std::string name = func.string_value (); + if (error_state || ! retval.empty ()) + return retval; - if (name == "isempty") - { - boolNDArray result (f_args.dims ()); - for (octave_idx_type count = 0; count < k ; count++) - result(count) = f_args.elem(count).is_empty (); - retval(0) = result; - } - else if (name == "islogical") - { - boolNDArray result (f_args.dims ()); - for (octave_idx_type count= 0; count < k ; count++) - result(count) = f_args.elem(count).is_bool_type (); - retval(0) = result; - } - else if (name == "isreal") - { - boolNDArray result (f_args.dims ()); - for (octave_idx_type count= 0; count < k ; count++) - result(count) = f_args.elem(count).is_real_type (); - retval(0) = result; - } - else if (name == "length") - { - NDArray result (f_args.dims ()); - for (octave_idx_type count= 0; count < k ; count++) - result(count) = static_cast<double> (f_args.elem(count).length ()); - retval(0) = result; - } - else if (name == "ndims") - { - NDArray result (f_args.dims ()); - for (octave_idx_type count = 0; count < k ; count++) - result(count) = static_cast<double> (f_args.elem(count).ndims ()); - retval(0) = result; - } - else if (name == "prodofsize" || name == "numel") + // See if we can convert the string into a function. + + std::string name = args(0).string_value (); + + if (! valid_identifier (name)) { - NDArray result (f_args.dims ()); - for (octave_idx_type count = 0; count < k ; count++) - result(count) = static_cast<double> (f_args.elem(count).numel ()); - retval(0) = result; - } - else if (name == "size") - { - if (nargin == 3) - { - int d = args(2).nint_value () - 1; - - if (d < 0) - error ("cellfun: K must be a positive integer"); + std::string fcn_name = unique_symbol_name ("__cellfun_fcn_"); + std::string fname = "function y = " + fcn_name + "(x) y = "; - if (! error_state) - { - NDArray result (f_args.dims ()); - for (octave_idx_type count = 0; count < k ; count++) - { - dim_vector dv = f_args.elem(count).dims (); - if (d < dv.length ()) - result(count) = static_cast<double> (dv(d)); - else - result(count) = 1.0; - } - retval(0) = result; - } - } - else - error ("cellfun: not enough arguments for \"size\""); - } - else if (name == "isclass") - { - if (nargin == 3) - { - std::string class_name = args(2).string_value(); - boolNDArray result (f_args.dims ()); - for (octave_idx_type count = 0; count < k ; count++) - result(count) = (f_args.elem(count).class_name() == class_name); + octave_function *ptr_func + = extract_function (args(0), "cellfun", fcn_name, + fname, "; endfunction"); - retval(0) = result; - } - else - error ("cellfun: not enough arguments for \"isclass\""); + if (ptr_func && ! error_state) + func = octave_value (ptr_func, true); } else { - if (! valid_identifier (name)) - { + func = symbol_table::find_function (name); - std::string fcn_name = unique_symbol_name ("__cellfun_fcn_"); - std::string fname = "function y = "; - fname.append (fcn_name); - fname.append ("(x) y = "); - octave_function *ptr_func = extract_function (args(0), "cellfun", - fcn_name, fname, "; endfunction"); - if (ptr_func && ! error_state) - func = octave_value (ptr_func, true); - } - else - { - func = symbol_table::find_function (name); - if (func.is_undefined ()) - error ("cellfun: invalid function NAME: %s", name.c_str ()); - } + if (func.is_undefined ()) + error ("cellfun: invalid function NAME: %s", name.c_str ()); } + + if (error_state || ! retval.empty ()) + return retval; } - if (error_state || ! retval.empty ()) - return retval; - if (func.is_function_handle () || func.is_inline_function () || func.is_function ()) { - unwind_protect frame; - frame.protect_var (buffer_error_messages); + + // The following is an optimisation because the symbol table can + // give a more specific function class, so this can result in + // fewer polymorphic function calls as the function gets called + // for each value of the array. + { + if (func.is_function_handle ()) + { + octave_fcn_handle* f = func.fcn_handle_value (); + + // Overloaded function handles need to check the type of the + // arguments for each element of the array, so they cannot + // be optimised this way. + if (f -> is_overloaded ()) + goto nevermind; + } + + std::string name = func.function_value () -> name (); + octave_value f = symbol_table::find_function (name); + + if (f.is_defined ()) + { + //Except for these two which are special cases... + if (name != "size" && name != "class") + { + //Try first the optimised code path for built-in functions + octave_value_list tmp_args = args; + tmp_args(0) = name; + retval = try_cellfun_internal_ops (tmp_args, nargin); + if (error_state || ! retval.empty ()) + return retval; + } + + //Okay, we tried, doesn't work, let's do the best we can + //instead and avoid polymorphic calls for each element of + //the array. + func = f; + } + } + nevermind: bool uniform_output = true; octave_value error_handler; - while (nargin > 3 && args(nargin-2).is_string()) - { - std::string arg = args(nargin-2).string_value(); - - std::transform (arg.begin (), arg.end (), - arg.begin (), tolower); + get_mapper_fun_options (args, nargin, uniform_output, error_handler); - if (arg == "uniformoutput") - uniform_output = args(nargin-1).bool_value(); - else if (arg == "errorhandler") - { - if (args(nargin-1).is_function_handle () || - args(nargin-1).is_inline_function ()) - { - error_handler = args(nargin-1); - } - else if (args(nargin-1).is_string ()) - { - std::string err_name = args(nargin-1).string_value (); - error_handler = symbol_table::find_function (err_name); - if (error_handler.is_undefined ()) - { - error ("cellfun: invalid function NAME: %s", err_name.c_str ()); - break; - } - } - else - { - error ("cellfun: invalid value for 'ErrorHandler' function"); - break; - } - } - else - { - error ("cellfun: unrecognized parameter %s", - arg.c_str()); - break; - } + if (error_state) + return octave_value_list (); - nargin -= 2; - } - - nargin -= 1; + // Extract cell arguments. octave_value_list inputlist (nargin, octave_value ()); @@ -409,8 +504,8 @@ dim_vector fdims (1, 1); - if (error_state) - return octave_value_list (); + // Collect arguments. Pre-fill scalar elements of inputlist + // array. for (int j = 0; j < nargin; j++) { @@ -444,9 +539,14 @@ } } + unwind_protect frame; + frame.protect_var (buffer_error_messages); + if (error_handler.is_defined ()) buffer_error_messages++; + // Apply functions. + if (uniform_output) { std::list<octave_value_list> idx_list (1); @@ -455,7 +555,7 @@ OCTAVE_LOCAL_BUFFER (octave_value, retv, nargout1); - for (octave_idx_type count = 0; count < k ; count++) + for (octave_idx_type count = 0; count < k; count++) { for (int j = 0; j < nargin; j++) { @@ -463,59 +563,71 @@ inputlist.xelem (j) = cinputs[j](count); } - const octave_value_list tmp = get_output_list (count, nargout, inputlist, - func, error_handler); + const octave_value_list tmp + = get_output_list (count, nargout, inputlist, func, + error_handler); if (error_state) return retval; - if (tmp.length () < nargout1) + if (nargout > 0 && tmp.length () < nargout) { - if (tmp.length () < nargout) - { - error ("cellfun: too many output arguments"); - return octave_value_list (); - } - else - nargout1 = 0; + error ("cellfun: function returned fewer than nargout values"); + return retval; } - if (count == 0) + if (nargout > 0 + || (nargout == 0 + && tmp.length () > 0 && tmp(0).is_defined ())) { - for (int j = 0; j < nargout1; j++) - { - octave_value val = tmp(j); + int num_to_copy = tmp.length (); + + if (num_to_copy > nargout1) + num_to_copy = nargout1; - if (val.numel () == 1) - retv[j] = val.resize (fdims); - else + if (count == 0) + { + for (int j = 0; j < num_to_copy; j++) { - error ("cellfun: all values must be scalars when UniformOutput = true"); - break; + if (tmp(j).is_defined ()) + { + octave_value val = tmp(j); + + if (val.numel () == 1) + retv[j] = val.resize (fdims); + else + { + error ("cellfun: all values must be scalars when UniformOutput = true"); + break; + } + } } } - } - else - { - for (int j = 0; j < nargout1; j++) + else { - octave_value val = tmp(j); - - if (! retv[j].fast_elem_insert (count, val)) + for (int j = 0; j < num_to_copy; j++) { - if (val.numel () == 1) + if (tmp(j).is_defined ()) { - idx_list.front ()(0) = count + 1.0; - retv[j].assign (octave_value::op_asn_eq, - idx_type, idx_list, val); + octave_value val = tmp(j); + + if (! retv[j].fast_elem_insert (count, val)) + { + if (val.numel () == 1) + { + idx_list.front ()(0) = count + 1.0; + retv[j].assign (octave_value::op_asn_eq, + idx_type, idx_list, val); - if (error_state) - break; - } - else - { - error ("cellfun: all values must be scalars when UniformOutput = true"); - break; + if (error_state) + break; + } + else + { + error ("cellfun: all values must be scalars when UniformOutput = true"); + break; + } + } } } } @@ -526,6 +638,7 @@ } retval.resize (nargout1); + for (int j = 0; j < nargout1; j++) { if (nargout > 0 && retv[j].is_undefined ()) @@ -537,10 +650,13 @@ else { OCTAVE_LOCAL_BUFFER (Cell, results, nargout1); + for (int j = 0; j < nargout1; j++) - results[j].resize (fdims); + results[j].resize (fdims, Matrix ()); - for (octave_idx_type count = 0; count < k ; count++) + bool have_some_output = false; + + for (octave_idx_type count = 0; count < k; count++) { for (int j = 0; j < nargin; j++) { @@ -548,31 +664,43 @@ inputlist.xelem (j) = cinputs[j](count); } - const octave_value_list tmp = get_output_list (count, nargout, inputlist, - func, error_handler); + const octave_value_list tmp + = get_output_list (count, nargout, inputlist, func, + error_handler); if (error_state) return retval; - if (tmp.length () < nargout1) + if (nargout > 0 && tmp.length () < nargout) { - if (tmp.length () < nargout) - { - error ("cellfun: too many output arguments"); - return octave_value_list (); - } - else - nargout1 = 0; + error ("cellfun: function returned fewer than nargout values"); + return retval; } + if (nargout > 0 + || (nargout == 0 + && tmp.length () > 0 && tmp(0).is_defined ())) + { + int num_to_copy = tmp.length (); + + if (num_to_copy > nargout1) + num_to_copy = nargout1; + + if (num_to_copy > 0) + have_some_output = true; + + for (int j = 0; j < num_to_copy; j++) + results[j](count) = tmp(j); + } + } + + if (have_some_output || fdims.any_zero ()) + { + retval.resize (nargout1); for (int j = 0; j < nargout1; j++) - results[j](count) = tmp(j); + retval(j) = results[j]; } - - retval.resize(nargout1); - for (int j = 0; j < nargout1; j++) - retval(j) = results[j]; } } else @@ -583,6 +711,35 @@ /* +%!function r = __f11 (x) +%! global __cellfun_test_num_outputs__ +%! __cellfun_test_num_outputs__ = nargout; +%! r = x; +%!endfunction + +%!function __f01 (x) +%! global __cellfun_test_num_outputs__ +%! __cellfun_test_num_outputs__ = nargout; +%!endfunction + +%!test +%! global __cellfun_test_num_outputs__ +%! cellfun (@__f11, {1}); +%! assert (__cellfun_test_num_outputs__, 0) +%! x = cellfun (@__f11, {1}); +%! assert (__cellfun_test_num_outputs__, 1) + +%!test +%! global __cellfun_test_num_outputs__ +%! cellfun (@__f01, {1}); +%! assert (__cellfun_test_num_outputs__, 0) + +%!error x = cellfun (@__f01, {1, 2}); + +%!test +%! assert (cellfun (@__f11, {1, 2}), [1, 2]) +%! assert (cellfun (@__f11, {1, 2}, 'uniformoutput', false), {1, 2}) + %!test %! [a,b] = cellfun (@(x) x, cell (2, 0)); %! assert (a, zeros (2, 0)); @@ -594,9 +751,9 @@ %! assert (b, cell (2, 0)); %% Test function to check the "Errorhandler" option -%!function [z] = cellfunerror (S, varargin) -%! z = S; -%! endfunction +%!function [z] = __cellfunerror (S, varargin) +%! z = S; +%!endfunction %% First input argument can be a string, an inline function, %% a function_handle or an anonymous function @@ -673,7 +830,7 @@ %! assert (isequal (C, {true, []; [], true})); %!test %! A = cellfun (@(x,y) cell2str (x,y), {true}, {true}, \ -%! "ErrorHandler", @cellfunerror); +%! "ErrorHandler", @__cellfunerror); %! assert (isfield (A, "identifier"), true); %! assert (isfield (A, "message"), true); %! assert (isfield (A, "index"), true); @@ -681,7 +838,7 @@ %! assert (A.index, 1); %!test %% Overwriting setting of "UniformOutput" true %! A = cellfun (@(x,y) cell2str (x,y), {true}, {true}, \ -%! "UniformOutput", true, "ErrorHandler", @cellfunerror); +%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); %! assert (isfield (A, "identifier"), true); %! assert (isfield (A, "message"), true); %! assert (isfield (A, "index"), true); @@ -707,7 +864,7 @@ %! assert (isequal (C, {10, 11; [], 12})); %!test %! A = cellfun (@(x,y) cell2str(x,y), {1.1, 4}, {3.1, 6}, \ -%! "ErrorHandler", @cellfunerror); +%! "ErrorHandler", @__cellfunerror); %! B = isfield (A(1), "message") && isfield (A(1), "index"); %! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); %! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); @@ -716,7 +873,7 @@ %! assert ([A(1).index, A(2).index], [1, 2]); %!test %% Overwriting setting of "UniformOutput" true %! A = cellfun (@(x,y) cell2str(x,y), {1.1, 4}, {3.1, 6}, \ -%! "UniformOutput", true, "ErrorHandler", @cellfunerror); +%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); %! B = isfield (A(1), "message") && isfield (A(1), "index"); %! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); %! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); @@ -735,7 +892,7 @@ %! assert (A, {"abc", "def"}); %!test %! A = cellfun (@(x,y) cell2str(x,y), {"a", "d"}, {"c", "f"}, \ -%! "ErrorHandler", @cellfunerror); +%! "ErrorHandler", @__cellfunerror); %! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); %! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); %! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); @@ -743,7 +900,7 @@ %! assert ([A(1).index, A(2).index], [1, 2]); %!test %% Overwriting setting of "UniformOutput" true %! A = cellfun (@(x,y) cell2str(x,y), {"a", "d"}, {"c", "f"}, \ -%! "UniformOutput", true, "ErrorHandler", @cellfunerror); +%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); %! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); %! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); %! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); @@ -769,7 +926,7 @@ %! assert (A, {true, false}); %!test %! A = cellfun (@(x,y) mat2str(x,y), {{1.1}, {4.2}}, {{3.1}, {2}}, \ -%! "ErrorHandler", @cellfunerror); +%! "ErrorHandler", @__cellfunerror); %! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); %! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); %! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); @@ -777,7 +934,7 @@ %! assert ([A(1).index, A(2).index], [1, 2]); %!test %% Overwriting setting of "UniformOutput" true %! A = cellfun (@(x,y) mat2str(x,y), {{1.1}, {4.2}}, {{3.1}, {2}}, \ -%! "UniformOutput", true, "ErrorHandler", @cellfunerror); +%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); %! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); %! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); %! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); @@ -802,7 +959,7 @@ %!test %! a = struct ("a", 1, "b", 2); b = struct ("a", 1, "b", 3); %! A = cellfun (@(x,y) cell2str (x.a, y.a), {a}, {b}, \ -%! "ErrorHandler", @cellfunerror); +%! "ErrorHandler", @__cellfunerror); %! assert (isfield (A, "identifier"), true); %! assert (isfield (A, "message"), true); %! assert (isfield (A, "index"), true); @@ -811,7 +968,7 @@ %!test %% Overwriting setting of "UniformOutput" true %! a = struct ("a", 1, "b", 2); b = struct ("a", 1, "b", 3); %! A = cellfun (@(x,y) cell2str (x.a, y.a), {a}, {b}, \ -%! "UniformOutput", true, "ErrorHandler", @cellfunerror); +%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); %! assert (isfield (A, "identifier"), true); %! assert (isfield (A, "message"), true); %! assert (isfield (A, "index"), true); @@ -852,6 +1009,643 @@ */ +// Arrayfun was originally a .m file written by Bill Denney and Jaroslav +// Hajek. It was converted to C++ by jwe so that it could properly +// handle the nargout = 0 case. + +DEFUN_DLD (arrayfun, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Function File} {} arrayfun (@var{func}, @var{A})\n\ +@deftypefnx {Function File} {@var{x} =} arrayfun (@var{func}, @var{A})\n\ +@deftypefnx {Function File} {@var{x} =} arrayfun (@var{func}, @var{A}, @var{b}, @dots{})\n\ +@deftypefnx {Function File} {[@var{x}, @var{y}, @dots{}] =} arrayfun (@var{func}, @var{A}, @dots{})\n\ +@deftypefnx {Function File} {} arrayfun (@dots{}, \"UniformOutput\", @var{val})\n\ +@deftypefnx {Function File} {} arrayfun (@dots{}, \"ErrorHandler\", @var{errfunc})\n\ +\n\ +Execute a function on each element of an array. This is useful for\n\ +functions that do not accept array arguments. If the function does\n\ +accept array arguments it is better to call the function directly.\n\ +\n\ +The first input argument @var{func} can be a string, a function\n\ +handle, an inline function, or an anonymous function. The input\n\ +argument @var{A} can be a logic array, a numeric array, a string\n\ +array, a structure array, or a cell array. By a call of the function\n\ +@command{arrayfun} all elements of @var{A} are passed on to the named\n\ +function @var{func} individually.\n\ +\n\ +The named function can also take more than two input arguments, with\n\ +the input arguments given as third input argument @var{b}, fourth\n\ +input argument @var{c}, @dots{} If given more than one array input\n\ +argument then all input arguments must have the same sizes, for\n\ +example:\n\ +\n\ +@example\n\ +@group\n\ +arrayfun (@@atan2, [1, 0], [0, 1])\n\ +@result{} ans = [1.5708 0.0000]\n\ +@end group\n\ +@end example\n\ +\n\ +If the parameter @var{val} after a further string input argument\n\ +\"UniformOutput\" is set @code{true} (the default), then the named\n\ +function @var{func} must return a single element which then will be\n\ +concatenated into the return value and is of type matrix. Otherwise,\n\ +if that parameter is set to @code{false}, then the outputs are\n\ +concatenated in a cell array. For example:\n\ +\n\ +@example\n\ +@group\n\ +arrayfun (@@(x,y) x:y, \"abc\", \"def\", \"UniformOutput\", false)\n\ +@result{} ans =\n\ + @{\n\ + [1,1] = abcd\n\ + [1,2] = bcde\n\ + [1,3] = cdef\n\ + @}\n\ +@end group\n\ +@end example\n\ +\n\ +If more than one output arguments are given then the named function\n\ +must return the number of return values that also are expected, for\n\ +example:\n\ +\n\ +@example\n\ +@group\n\ +[A, B, C] = arrayfun (@@find, [10; 0], \"UniformOutput\", false)\n\ +@result{}\n\ +A =\n\ +@{\n\ + [1,1] = 1\n\ + [2,1] = [](0x0)\n\ +@}\n\ +B =\n\ +@{\n\ + [1,1] = 1\n\ + [2,1] = [](0x0)\n\ +@}\n\ +C =\n\ +@{\n\ + [1,1] = 10\n\ + [2,1] = [](0x0)\n\ +@}\n\ +@end group\n\ +@end example\n\ +\n\ +If the parameter @var{errfunc} after a further string input argument\n\ +\"ErrorHandler\" is another string, a function handle, an inline\n\ +function, or an anonymous function, then @var{errfunc} defines a\n\ +function to call in the case that @var{func} generates an error.\n\ +The definition of the function must be of the form\n\ +\n\ +@example\n\ +function [@dots{}] = errfunc (@var{s}, @dots{})\n\ +@end example\n\ +\n\ +@noindent\n\ +where there is an additional input argument to @var{errfunc}\n\ +relative to @var{func}, given by @var{s}. This is a structure with\n\ +the elements \"identifier\", \"message\", and \"index\" giving,\n\ +respectively, the error identifier, the error message, and the index of\n\ +the array elements that caused the error. The size of the output\n\ +argument of @var{errfunc} must have the same size as the output\n\ +argument of @var{func}, otherwise a real error is thrown. For\n\ +example:\n\ +\n\ +@example\n\ +@group\n\ +function y = ferr (s, x), y = \"MyString\"; endfunction\n\ +arrayfun (@@str2num, [1234],\n\ + \"UniformOutput\", false, \"ErrorHandler\", @@ferr)\n\ +@result{} ans =\n\ + @{\n\ + [1,1] = MyString\n\ + @}\n\ +@end group\n\ +@end example\n\ +\n\ +@seealso{spfun, cellfun, structfun}\n\ +@end deftypefn") +{ + octave_value_list retval; + int nargin = args.length (); + int nargout1 = (nargout < 1 ? 1 : nargout); + + if (nargin < 2) + { + error ("arrayfun: function requires at least 2 arguments"); + print_usage (); + return retval; + } + + octave_value func = args(0); + bool symbol_table_lookup = false; + + if (func.is_string ()) + { + // See if we can convert the string into a function. + + std::string name = args(0).string_value (); + + if (! valid_identifier (name)) + { + std::string fcn_name = unique_symbol_name ("__arrayfun_fcn_"); + std::string fname = "function y = " + fcn_name + "(x) y = "; + + octave_function *ptr_func + = extract_function (args(0), "arrayfun", fcn_name, + fname, "; endfunction"); + + if (ptr_func && ! error_state) + func = octave_value (ptr_func, true); + } + else + { + func = symbol_table::find_function (name); + + if (func.is_undefined ()) + error ("arrayfun: invalid function NAME: %s", name.c_str ()); + + symbol_table_lookup = true; + } + + if (error_state) + return retval; + } + + if (func.is_function_handle () || func.is_inline_function () + || func.is_function ()) + { + // The following is an optimisation because the symbol table can + // give a more specific function class, so this can result in + // fewer polymorphic function calls as the function gets called + // for each value of the array. + + if (! symbol_table_lookup ) + { + if (func.is_function_handle ()) + { + octave_fcn_handle* f = func.fcn_handle_value (); + + // Overloaded function handles need to check the type of + // the arguments for each element of the array, so they + // cannot be optimised this way. + + if (f -> is_overloaded ()) + goto nevermind; + } + octave_value f = symbol_table::find_function (func.function_value () + -> name ()); + if (f.is_defined ()) + func = f; + } + + nevermind: + + bool uniform_output = true; + octave_value error_handler; + + get_mapper_fun_options (args, nargin, uniform_output, error_handler); + + if (error_state) + return octave_value_list (); + + octave_value_list inputlist (nargin, octave_value ()); + + OCTAVE_LOCAL_BUFFER (octave_value, inputs, nargin); + OCTAVE_LOCAL_BUFFER (bool, mask, nargin); + + octave_idx_type k = 1; + + dim_vector fdims (1, 1); + + // Collect arguments. Pre-fill scalar elements of inputlist + // array. + + for (int j = 0; j < nargin; j++) + { + inputs[j] = args(j+1); + mask[j] = inputs[j].numel () != 1; + + if (! mask[j]) + inputlist(j) = inputs[j]; + } + + for (int j = 0; j < nargin; j++) + { + if (mask[j]) + { + fdims = inputs[j].dims (); + k = inputs[j].numel (); + + for (int i = j+1; i < nargin; i++) + { + if (mask[i] && inputs[i].dims () != fdims) + { + error ("arrayfun: dimensions mismatch"); + return retval; + } + } + break; + } + } + + + unwind_protect frame; + frame.protect_var (buffer_error_messages); + + if (error_handler.is_defined ()) + buffer_error_messages++; + + // Apply functions. + + if (uniform_output) + { + std::list<octave_value_list> idx_list (1); + idx_list.front ().resize (1); + std::string idx_type = "("; + + OCTAVE_LOCAL_BUFFER (octave_value, retv, nargout1); + + for (octave_idx_type count = 0; count < k; count++) + { + idx_list.front ()(0) = count + 1.0; + + for (int j = 0; j < nargin; j++) + { + if (mask[j]) + inputlist.xelem (j) = inputs[j].do_index_op (idx_list); + + if (error_state) + return retval; + } + + const octave_value_list tmp + = get_output_list (count, nargout, inputlist, func, + error_handler); + + if (error_state) + return retval; + + if (nargout > 0 && tmp.length () < nargout) + { + error ("arrayfun: function returned fewer than nargout values"); + return retval; + } + + if (nargout > 0 + || (nargout == 0 + && tmp.length () > 0 && tmp(0).is_defined ())) + { + int num_to_copy = tmp.length (); + + if (num_to_copy > nargout1) + num_to_copy = nargout1; + + if (count == 0) + { + for (int j = 0; j < num_to_copy; j++) + { + if (tmp(j).is_defined ()) + { + octave_value val = tmp(j); + + if (val.numel () == 1) + retv[j] = val.resize (fdims); + else + { + error ("arrayfun: all values must be scalars when UniformOutput = true"); + break; + } + } + } + } + else + { + for (int j = 0; j < num_to_copy; j++) + { + if (tmp(j).is_defined ()) + { + octave_value val = tmp(j); + + if (! retv[j].fast_elem_insert (count, val)) + { + if (val.numel () == 1) + { + idx_list.front ()(0) = count + 1.0; + retv[j].assign (octave_value::op_asn_eq, + idx_type, idx_list, val); + + if (error_state) + break; + } + else + { + error ("arrayfun: all values must be scalars when UniformOutput = true"); + break; + } + } + } + } + } + } + + if (error_state) + break; + } + + retval.resize (nargout1); + + for (int j = 0; j < nargout1; j++) + { + if (nargout > 0 && retv[j].is_undefined ()) + retval(j) = NDArray (fdims); + else + retval(j) = retv[j]; + } + } + else + { + std::list<octave_value_list> idx_list (1); + idx_list.front ().resize (1); + std::string idx_type = "("; + + OCTAVE_LOCAL_BUFFER (Cell, results, nargout1); + + for (int j = 0; j < nargout1; j++) + results[j].resize (fdims, Matrix ()); + + bool have_some_output = false; + + for (octave_idx_type count = 0; count < k; count++) + { + idx_list.front ()(0) = count + 1.0; + + for (int j = 0; j < nargin; j++) + { + if (mask[j]) + inputlist.xelem (j) = inputs[j].do_index_op (idx_list); + + if (error_state) + return retval; + } + + const octave_value_list tmp + = get_output_list (count, nargout, inputlist, func, + error_handler); + + if (error_state) + return retval; + + if (nargout > 0 && tmp.length () < nargout) + { + error ("arrayfun: function returned fewer than nargout values"); + return retval; + } + + if (nargout > 0 + || (nargout == 0 + && tmp.length () > 0 && tmp(0).is_defined ())) + { + int num_to_copy = tmp.length (); + + if (num_to_copy > nargout1) + num_to_copy = nargout1; + + if (num_to_copy > 0) + have_some_output = true; + + for (int j = 0; j < num_to_copy; j++) + results[j](count) = tmp(j); + } + } + + if (have_some_output || fdims.any_zero ()) + { + retval.resize (nargout1); + + for (int j = 0; j < nargout1; j++) + retval(j) = results[j]; + } + } + } + else + error ("arrayfun: argument NAME must be a string or function handle"); + + return retval; +} + +/* +%!function r = __f11 (x) +%! global __arrayfun_test_num_outputs__ +%! __arrayfun_test_num_outputs__ = nargout; +%! r = x; +%!endfunction + +%!function __f01 (x) +%! global __arrayfun_test_num_outputs__ +%! __arrayfun_test_num_outputs__ = nargout; +%!endfunction + +%!test +%! global __arrayfun_test_num_outputs__ +%! arrayfun (@__f11, {1}); +%! assert (__arrayfun_test_num_outputs__, 0) +%! x = arrayfun (@__f11, {1}); +%! assert (__arrayfun_test_num_outputs__, 1) + +%!test +%! global __arrayfun_test_num_outputs__ +%! arrayfun (@__f01, {1}); +%! assert (__arrayfun_test_num_outputs__, 0) + +%!error x = arrayfun (@__f01, [1, 2]); + +%!test +%! assert (arrayfun (@__f11, [1, 2]), [1, 2]) +%! assert (arrayfun (@__f11, [1, 2], 'uniformoutput', false), {1, 2}); +%! assert (arrayfun (@__f11, {1, 2}), {1, 2}) +%! assert (arrayfun (@__f11, {1, 2}, 'uniformoutput', false), {{1}, {2}}); + +%!assert (arrayfun (@ones, 1, [2,3], 'uniformoutput', false), {[1,1], [1,1,1]}); + +%% Test function to check the "Errorhandler" option +%!function [z] = __arrayfunerror (S, varargin) +%! z = S; +%!endfunction +%% First input argument can be a string, an inline function, a +%% function_handle or an anonymous function +%!test +%! arrayfun (@isequal, [false, true], [true, true]); %% No output argument +%!error +%! arrayfun (@isequal); %% One or less input arguments +%!test +%! A = arrayfun ("isequal", [false, true], [true, true]); +%! assert (A, [false, true]); +%!test +%! A = arrayfun (inline ("(x == y)", "x", "y"), [false, true], [true, true]); +%! assert (A, [false, true]); +%!test +%! A = arrayfun (@isequal, [false, true], [true, true]); +%! assert (A, [false, true]); +%!test +%! A = arrayfun (@(x,y) isequal(x,y), [false, true], [true, true]); +%! assert (A, [false, true]); + +%% Number of input and output arguments may be greater than one +%#!test +%! A = arrayfun (@(x) islogical (x), false); +%! assert (A, true); +%!test +%! A = arrayfun (@(x,y,z) x + y + z, [1, 1, 1], [2, 2, 2], [3, 4, 5]); +%! assert (A, [6, 7, 8], 1e-16); +%!test %% Two input arguments of different types +%! A = arrayfun (@(x,y) islogical (x) && ischar (y), false, "a"); +%! assert (A, true); +%!test %% Pass another variable to the anonymous function +%! y = true; A = arrayfun (@(x) islogical (x && y), false); +%! assert (A, true); +%!test %% Three ouptut arguments of different type +%! [A, B, C] = arrayfun (@find, [10, 11; 0, 12], "UniformOutput", false); +%! assert (isequal (A, {true, true; [], true})); +%! assert (isequal (B, {true, true; [], true})); +%! assert (isequal (C, {10, 11; [], 12})); + +%% Input arguments can be of type logical +%!test +%! A = arrayfun (@(x,y) x == y, [false, true], [true, true]); +%! assert (A, [false, true]); +%!test +%! A = arrayfun (@(x,y) x == y, [false; true], [true; true], "UniformOutput", true); +%! assert (A, [false; true]); +%!test +%! A = arrayfun (@(x) x, [false, true, false, true], "UniformOutput", false); +%! assert (A, {false, true, false, true}); +%!test %% Three ouptut arguments of same type +%! [A, B, C] = arrayfun (@find, [true, false; false, true], "UniformOutput", false); +%! assert (isequal (A, {true, []; [], true})); +%! assert (isequal (B, {true, []; [], true})); +%! assert (isequal (C, {true, []; [], true})); +%!test +%! A = arrayfun (@(x,y) array2str (x,y), true, true, "ErrorHandler", @__arrayfunerror); +%! assert (isfield (A, "identifier"), true); +%! assert (isfield (A, "message"), true); +%! assert (isfield (A, "index"), true); +%! assert (isempty (A.message), false); +%! assert (A.index, 1); +%!test %% Overwriting setting of "UniformOutput" true +%! A = arrayfun (@(x,y) array2str (x,y), true, true, \ +%! "UniformOutput", true, "ErrorHandler", @__arrayfunerror); +%! assert (isfield (A, "identifier"), true); +%! assert (isfield (A, "message"), true); +%! assert (isfield (A, "index"), true); +%! assert (isempty (A.message), false); +%! assert (A.index, 1); + +%% Input arguments can be of type numeric +%!test +%! A = arrayfun (@(x,y) x>y, [1.1, 4.2], [3.1, 2+3*i]); +%! assert (A, [false, true]); +%!test +%! A = arrayfun (@(x,y) x>y, [1.1, 4.2; 2, 4], [3.1, 2; 2, 4+2*i], "UniformOutput", true); +%! assert (A, [false, true; false, false]); +%!test +%! A = arrayfun (@(x,y) x:y, [1.1, 4], [3.1, 6], "UniformOutput", false); +%! assert (isequal (A{1}, [1.1, 2.1, 3.1])); +%! assert (isequal (A{2}, [4, 5, 6])); +%!test %% Three ouptut arguments of different type +%! [A, B, C] = arrayfun (@find, [10, 11; 0, 12], "UniformOutput", false); +%! assert (isequal (A, {true, true; [], true})); +%! assert (isequal (B, {true, true; [], true})); +%! assert (isequal (C, {10, 11; [], 12})); +%!test +%! A = arrayfun (@(x,y) array2str(x,y), {1.1, 4}, {3.1, 6}, "ErrorHandler", @__arrayfunerror); +%! B = isfield (A(1), "message") && isfield (A(1), "index"); +%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); +%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); +%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); +%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); +%! assert ([A(1).index, A(2).index], [1, 2]); +%!test %% Overwriting setting of "UniformOutput" true +%! A = arrayfun (@(x,y) array2str(x,y), {1.1, 4}, {3.1, 6}, \ +%! "UniformOutput", true, "ErrorHandler", @__arrayfunerror); +%! B = isfield (A(1), "message") && isfield (A(1), "index"); +%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); +%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); +%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); +%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); +%! assert ([A(1).index, A(2).index], [1, 2]); + +%% Input arguments can be of type character or strings +%!test +%! A = arrayfun (@(x,y) x>y, ["ad", "c", "ghi"], ["cc", "d", "fgh"]); +%! assert (A, [false, true, false, true, true, true]); +%!test +%! A = arrayfun (@(x,y) x>y, ["a"; "f"], ["c"; "d"], "UniformOutput", true); +%! assert (A, [false; true]); +%!test +%! A = arrayfun (@(x,y) x:y, ["a", "d"], ["c", "f"], "UniformOutput", false); +%! assert (A, {"abc", "def"}); +%! %#!test +%! A = arrayfun (@(x,y) cell2str(x,y), ["a", "d"], ["c", "f"], "ErrorHandler", @__arrayfunerror); +%! B = isfield (A(1), "identifier") && isfield (A(1), "message") && isfield (A(1), "index"); +%! assert (B, true); + +%% Input arguments can be of type structure +%!test +%! a = struct ("a", 1.1, "b", 4.2); b = struct ("a", 3.1, "b", 2); +%! A = arrayfun (@(x,y) (x.a < y.a) && (x.b > y.b), a, b); +%! assert (A, true); +%!test +%! a = struct ("a", 1.1, "b", 4.2); b = struct ("a", 3.1, "b", 2); +%! A = arrayfun (@(x,y) (x.a < y.a) && (x.b > y.b), a, b, "UniformOutput", true); +%! assert (A, true); +%!test +%! a = struct ("a", 1.1, "b", 4.2); b = struct ("a", 3.1, "b", 2); +%! A = arrayfun (@(x,y) x.a:y.a, a, b, "UniformOutput", false); +%! assert (isequal (A, {[1.1, 2.1, 3.1]})); +%!test +%! A = arrayfun (@(x) mat2str(x), "a", "ErrorHandler", @__arrayfunerror); +%! assert (isfield (A, "identifier"), true); +%! assert (isfield (A, "message"), true); +%! assert (isfield (A, "index"), true); +%! assert (isempty (A.message), false); +%! assert (A.index, 1); +%!test %% Overwriting setting of "UniformOutput" true +%! A = arrayfun (@(x) mat2str(x), "a", "UniformOutput", true, \ +%! "ErrorHandler", @__arrayfunerror); +%! assert (isfield (A, "identifier"), true); +%! assert (isfield (A, "message"), true); +%! assert (isfield (A, "index"), true); +%! assert (isempty (A.message), false); +%! assert (A.index, 1); + +%% Input arguments can be of type cell array +%!test +%! A = arrayfun (@(x,y) x{1} < y{1}, {1.1, 4.2}, {3.1, 2}); +%! assert (A, [true, false]); +%!test +%! A = arrayfun (@(x,y) x{1} < y{1}, {1.1; 4.2}, {3.1; 2}, "UniformOutput", true); +%! assert (A, [true; false]); +%!test +%! A = arrayfun (@(x,y) x{1} < y{1}, {1.1, 4.2}, {3.1, 2}, "UniformOutput", false); +%! assert (A, {true, false}); +%!test +%! A = arrayfun (@(x,y) num2str(x,y), {1.1, 4.2}, {3.1, 2}, "ErrorHandler", @__arrayfunerror); +%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); +%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); +%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); +%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); +%! assert ([A(1).index, A(2).index], [1, 2]); +%!test +%! A = arrayfun (@(x,y) num2str(x,y), {1.1, 4.2}, {3.1, 2}, \ +%! "UniformOutput", true, "ErrorHandler", @__arrayfunerror); +%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); +%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); +%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); +%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); +%! assert ([A(1).index, A(2).index], [1, 2]); +*/ + static void do_num2cell_helper (const dim_vector& dv, const Array<int>& dimv, @@ -945,6 +1739,66 @@ } } +// FIXME -- this is a mess, but if a size method for the object exists, +// we have to call it to get the size of the object instead of using the +// internal dims method. + +static dim_vector +get_object_dims (octave_value& obj) +{ + dim_vector retval; + + Matrix m = obj.size (); + + int n = m.numel (); + + retval.resize (n); + + for (int i = 0; i < n; i++) + retval(i) = m(i); + + return retval; +} + +static Cell +do_object2cell (const octave_value& obj, const Array<int>& dimv) +{ + Cell retval; + + // FIXME -- this copy is only needed because the octave_value::size + // method is not const. + octave_value array = obj; + + if (dimv.is_empty ()) + { + dim_vector dv = get_object_dims (array); + + if (! error_state) + { + retval.resize (dv); + + octave_value_list idx (1); + + for (octave_idx_type i = 0; i < dv.numel (); i++) + { + octave_quit (); + + idx(0) = double (i+1); + + retval.xelem(i) = array.single_subsref ("(", idx); + + if (error_state) + break; + } + } + } + else + { + error ("num2cell (A, dim) not implemented for class objects"); + } + + return retval; +} DEFUN_DLD (num2cell, args, , "-*- texinfo -*-\n\ @@ -1034,10 +1888,14 @@ retval = do_num2cell (array.array_value (), dimv); } } + else if (array.is_object ()) + retval = do_object2cell (array, dimv); else if (array.is_map ()) retval = do_num2cell (array.map_value (), dimv); else if (array.is_cell ()) retval = do_num2cell (array.cell_value (), dimv); + else if (array.is_object ()) + retval = do_num2cell (array.cell_value (), dimv); else gripe_wrong_type_arg ("num2cell", array); } @@ -1464,6 +2322,7 @@ \n\ The position of the index is determined by @var{dim}. If not specified,\n\ slicing is done along the first non-singleton dimension.\n\ +@seealso{cell2mat, cellindexmat, cellfun}\n\ @end deftypefn") { octave_value retval; @@ -1577,7 +2436,7 @@ endfor\n\ @end group\n\ @end example\n\ -@seealso{cellfun, cellslices}\n\ +@seealso{cellslices, cellfun}\n\ @end deftypefn") { octave_value retval;
--- a/src/DLD-FUNCTIONS/chol.cc +++ b/src/DLD-FUNCTIONS/chol.cc @@ -61,12 +61,13 @@ } DEFUN_DLD (chol, args, nargout, - "-*- texinfo -*-\n\ +"-*- texinfo -*-\n\ @deftypefn {Loadable Function} {@var{R} =} chol (@var{A})\n\ @deftypefnx {Loadable Function} {[@var{R}, @var{p}] =} chol (@var{A})\n\ @deftypefnx {Loadable Function} {[@var{R}, @var{p}, @var{Q}] =} chol (@var{S})\n\ @deftypefnx {Loadable Function} {[@var{R}, @var{p}, @var{Q}] =} chol (@var{S}, 'vector')\n\ @deftypefnx {Loadable Function} {[@var{L}, @dots{}] =} chol (@dots{}, 'lower')\n\ +@deftypefnx {Loadable Function} {[@var{L}, @dots{}] =} chol (@dots{}, 'upper')\n\ @cindex Cholesky factorization\n\ Compute the Cholesky@tie{}factor, @var{R}, of the symmetric positive definite\n\ matrix @var{A}, where\n\ @@ -128,6 +129,10 @@ \n\ @end ifnottex\n\ \n\ +For full matrices, if the 'lower' flag is set only the lower triangular part\n\ +of the matrix is used for the factorization, otherwise the upper triangular\n\ +part is used.\n\ +\n\ In general the lower triangular factorization is significantly faster for\n\ sparse matrices.\n\ @seealso{cholinv, chol2inv}\n\ @@ -155,6 +160,10 @@ if (tmp.compare ("vector") == 0) vecout = true; else if (tmp.compare ("lower") == 0) + // FIXME currently the option "lower" is handled by transposing the + // matrix, factorizing it with the lapack function DPOTRF ('U', ...) + // and finally transposing the factor. It would be more efficient to use + // DPOTRF ('L', ...) in this case. LLt = true; else if (tmp.compare ("upper") == 0) LLt = false; @@ -251,7 +260,13 @@ if (! error_state) { octave_idx_type info; - FloatCHOL fact (m, info); + + FloatCHOL fact; + if (LLt) + fact = FloatCHOL (m.transpose (), info); + else + fact = FloatCHOL (m, info); + if (nargout == 2 || info == 0) { retval(1) = info; @@ -271,7 +286,13 @@ if (! error_state) { octave_idx_type info; - FloatComplexCHOL fact (m, info); + + FloatComplexCHOL fact; + if (LLt) + fact = FloatComplexCHOL (m.transpose (), info); + else + fact = FloatComplexCHOL (m, info); + if (nargout == 2 || info == 0) { retval(1) = info; @@ -296,7 +317,13 @@ if (! error_state) { octave_idx_type info; - CHOL fact (m, info); + + CHOL fact; + if (LLt) + fact = CHOL (m.transpose (), info); + else + fact = CHOL (m, info); + if (nargout == 2 || info == 0) { retval(1) = info; @@ -316,7 +343,13 @@ if (! error_state) { octave_idx_type info; - ComplexCHOL fact (m, info); + + ComplexCHOL fact; + if (LLt) + fact = ComplexCHOL (m.transpose (), info); + else + fact = ComplexCHOL (m, info); + if (nargout == 2 || info == 0) { retval(1) = info; @@ -344,8 +377,8 @@ %!error chol ([1, 2; 3, 4]); %!error chol ([1, 2; 3, 4; 5, 6]); -%!error <Invalid call to chol.*> chol (); -%!error <unexpected second or third input.*> chol (1, 2); +%!error <Invalid call to chol> chol (); +%!error <unexpected second or third input> chol (1, 2); */ @@ -993,6 +1026,78 @@ %! assert(norm(triu(R1)-R1,Inf) == 0) %! assert(norm(A1(p,p) - single(Ac),Inf) < 2e1*eps('single')) %! + +%!test +%! cu = chol (triu (A), 'upper'); +%! cl = chol (tril (A), 'lower'); +%! assert (cu, cl', eps) +%! +%!test +%! cca = chol (Ac); +%! +%! ccal = chol (Ac, 'lower'); +%! ccal2 = chol (tril (Ac), 'lower'); +%! +%! ccau = chol (Ac, 'upper'); +%! ccau2 = chol (triu (Ac), 'upper'); +%! +%! assert (cca'*cca, Ac, eps) +%! assert (ccau'*ccau, Ac, eps) +%! assert (ccau2'*ccau2, Ac, eps) +%! +%! assert (cca, ccal', eps) +%! assert (cca, ccau, eps) +%! assert (cca, ccal2', eps) +%! assert (cca, ccau2, eps) +%! +%!test +%! cca = chol (single (Ac)); +%! +%! ccal = chol (single (Ac), 'lower'); +%! ccal2 = chol (tril (single (Ac)), 'lower'); +%! +%! ccau = chol (single (Ac), 'upper'); +%! ccau2 = chol (triu (single (Ac)), 'upper'); +%! +%! assert (cca'*cca, single (Ac), eps ('single')) +%! assert (ccau'*ccau, single (Ac), eps ('single')) +%! assert (ccau2'*ccau2, single (Ac), eps ('single')) +%! +%! assert (cca, ccal', eps ('single')) +%! assert (cca, ccau, eps ('single')) +%! assert (cca, ccal2', eps ('single')) +%! assert (cca, ccau2, eps ('single')) + +%!test +%! a = [12, 2, 3, 4; +%! 2, 14, 5, 3; +%! 3, 5, 16, 6; +%! 4, 3, 6, 16]; +%! +%! b = [0, 1, 2, 3; +%! -1, 0, 1, 2; +%! -2, -1, 0, 1; +%! -3, -2, -1, 0]; +%! +%! ca = a + i*b; +%! +%! cca = chol (ca); +%! +%! ccal = chol (ca, 'lower'); +%! ccal2 = chol (tril (ca), 'lower'); +%! +%! ccau = chol (ca, 'upper'); +%! ccau2 = chol (triu (ca), 'upper'); +%! +%! assert (cca'*cca, ca, 16*eps) +%! assert (ccau'*ccau, ca, 16*eps) +%! assert (ccau2'*ccau2, ca, 16*eps) +%! +%! assert (cca, ccal', 16*eps) +%! assert (cca, ccau, 16*eps) +%! assert (cca, ccal2', 16*eps) +%! assert (cca, ccau2, 16*eps) + */ DEFUN_DLD (choldelete, args, ,
--- a/src/DLD-FUNCTIONS/colamd.cc +++ b/src/DLD-FUNCTIONS/colamd.cc @@ -232,7 +232,7 @@ @code{@var{knobs}(2)} are < 0, respectively. If @code{@var{knobs}(3)} is\n\ nonzero, @var{stats} and @var{knobs} are printed. The default is\n\ @code{@var{knobs} = [10 10 0]}. Note that @var{knobs} differs from earlier\n\ -versions of colamd\n\ +versions of colamd.\n\ \n\ @var{stats} is an optional 20-element output vector that provides data\n\ about the ordering and the validity of the input matrix @var{S}. Ordering\n\ @@ -459,7 +459,7 @@ vector p such that @code{@var{S}(@var{p}, @var{p})} tends to have a\n\ sparser Cholesky@tie{}factor than @var{S}. Sometimes @code{symamd} works\n\ well for symmetric indefinite matrices too. The matrix @var{S} is assumed\n\ -to be symmetric; only the strictly lower triangular part is referenced. \n\ +to be symmetric; only the strictly lower triangular part is referenced.\n\ @var{S} must be square.\n\ \n\ @var{knobs} is an optional one- to two-element input vector. If @var{S} is\n\ @@ -467,7 +467,7 @@ @code{max(16,@var{knobs}(1)*sqrt(n))} entries are removed prior to ordering,\n\ and ordered last in the output permutation @var{p}. No rows/columns are\n\ removed if @code{@var{knobs}(1) < 0}. If @code{@var{knobs} (2)} is nonzero,\n\ -@code{stats} and @var{knobs} are printed. The default is @code{@var{knobs} \n\ +@code{stats} and @var{knobs} are printed. The default is @code{@var{knobs}\n\ = [10 0]}. Note that @var{knobs} differs from earlier versions of symamd.\n\ \n\ @var{stats} is an optional 20-element output vector that provides data\n\ @@ -544,7 +544,7 @@ octave_stdout << "symamd: dense row/col fraction: " << knobs [COLAMD_DENSE_ROW] << std::endl; - octave_idx_type n_row, n_col, nnz; + octave_idx_type n_row, n_col; octave_idx_type *ridx, *cidx; SparseMatrix sm; SparseComplexMatrix scm; @@ -556,7 +556,6 @@ scm = args(0).sparse_complex_matrix_value (); n_row = scm.rows (); n_col = scm.cols (); - nnz = scm.nnz (); ridx = scm.xridx (); cidx = scm.xcidx (); } @@ -565,7 +564,6 @@ sm = args(0).sparse_matrix_value (); n_row = sm.rows (); n_col = sm.cols (); - nnz = sm.nnz (); ridx = sm.xridx (); cidx = sm.xcidx (); } @@ -579,7 +577,6 @@ n_row = sm.rows (); n_col = sm.cols (); - nnz = sm.nnz (); ridx = sm.xridx (); cidx = sm.xcidx (); } @@ -650,7 +647,7 @@ @deftypefnx {Loadable Function} {@var{p} =} etree (@var{S}, @var{typ})\n\ @deftypefnx {Loadable Function} {[@var{p}, @var{q}] =} etree (@var{S}, @var{typ})\n\ \n\ -Returns the elimination tree for the matrix @var{S}. By default @var{S}\n\ +Return the elimination tree for the matrix @var{S}. By default @var{S}\n\ is assumed to be symmetric and the symmetric elimination tree is\n\ returned. The argument @var{typ} controls whether a symmetric or\n\ column elimination tree is returned. Valid values of @var{typ} are\n\ @@ -668,7 +665,7 @@ print_usage (); else { - octave_idx_type n_row, n_col, nnz; + octave_idx_type n_row, n_col; octave_idx_type *ridx, *cidx; bool is_sym = true; SparseMatrix sm; @@ -681,7 +678,6 @@ scm = args(0).sparse_complex_matrix_value (); n_row = scm.rows (); n_col = scm.cols (); - nnz = scm.nnz (); ridx = scm.xridx (); cidx = scm.xcidx (); } @@ -690,7 +686,6 @@ sm = args(0).sparse_matrix_value (); n_row = sm.rows (); n_col = sm.cols (); - nnz = sm.nnz (); ridx = sm.xridx (); cidx = sm.xcidx (); }
--- a/src/DLD-FUNCTIONS/config-module.awk +++ b/src/DLD-FUNCTIONS/config-module.awk @@ -1,14 +1,23 @@ BEGIN { + FS = "|"; + nfiles = 0; + print "## DO NOT EDIT -- generated from module-files by config-module.awk"; print "" print "EXTRA_DIST += \\" print " DLD-FUNCTIONS/config-module.sh \\" print " DLD-FUNCTIONS/config-module.awk \\" - print " DLD-FUNCTIONS/module-files" + print " DLD-FUNCTIONS/module-files \\" + print " DLD-FUNCTIONS/oct-qhull.h" print "" - nfiles = 0; -} { - files[++nfiles] = $1; +} +/^#.*/ { next; } +{ + nfiles++; + files[nfiles] = $1; + cppflags[nfiles] = $2; + ldflags[nfiles] = $3; + libraries[nfiles] = $4; } END { sep = " \\\n"; print "DLD_FUNCTIONS_SRC = \\"; @@ -22,9 +31,9 @@ sep = " \\\n"; print "DLD_FUNCTIONS_LIBS = $(DLD_FUNCTIONS_SRC:.cc=.la)"; print ""; - print "octlib_LTLIBRARIES += $(DLD_FUNCTIONS_LIBS)"; + print "if AMCOND_ENABLE_DYNAMIC_LINKING"; print ""; - print "if AMCOND_ENABLE_DYNAMIC_LINKING"; + print "octlib_LTLIBRARIES += $(DLD_FUNCTIONS_LIBS)"; print ""; print "## Use stamp files to avoid problems with checking timestamps"; print "## of symbolic links"; @@ -41,18 +50,28 @@ print "\t touch $(@F)"; print ""; } + print "else"; + print ""; + print "noinst_LTLIBRARIES = $(DLD_FUNCTIONS_LIBS)"; + print ""; print "endif"; - print ""; for (i = 1; i <= nfiles; i++) { basename = files[i]; sub (/\.cc$/, "", basename); + print ""; printf ("DLD_FUNCTIONS_%s_la_SOURCES = DLD-FUNCTIONS/%s\n", basename, files[i]); - printf ("DLD_FUNCTIONS_%s_la_LDFLAGS = @NO_UNDEFINED_LDFLAG@ -module\n", - basename); - printf ("DLD_FUNCTIONS_%s_la_LIBADD = $(OCT_LINK_DEPS)\n", basename); + if (cppflags[i]) + { + printf ("DLD-FUNCTIONS/%s.df: CPPFLAGS += %s\n", + basename, cppflags[i]); + printf ("DLD_FUNCTIONS_%s_la_CPPFLAGS = $(AM_CPPFLAGS) %s\n", + basename, cppflags[i]); + } + printf ("DLD_FUNCTIONS_%s_la_LDFLAGS = -avoid-version -module $(NO_UNDEFINED_LDFLAG) %s $(OCT_LINK_OPTS)\n", + basename, ldflags[i]); + printf ("DLD_FUNCTIONS_%s_la_LIBADD = liboctinterp.la ../liboctave/liboctave.la ../libcruft/libcruft.la %s $(OCT_LINK_DEPS)\n", + basename, libraries[i]); } - print ""; - }
--- a/src/DLD-FUNCTIONS/config-module.sh +++ b/src/DLD-FUNCTIONS/config-module.sh @@ -10,8 +10,10 @@ top_srcdir="../.." fi +move_if_change="$top_srcdir/build-aux/move-if-change" + dld_dir=$top_srcdir/src/DLD-FUNCTIONS $AWK -f $dld_dir/config-module.awk < $dld_dir/module-files > $dld_dir/module.mk-t -$top_srcdir/move-if-change $dld_dir/module.mk-t $dld_dir/module.mk +$move_if_change $dld_dir/module.mk-t $dld_dir/module.mk
--- a/src/DLD-FUNCTIONS/conv2.cc +++ b/src/DLD-FUNCTIONS/conv2.cc @@ -262,7 +262,6 @@ octave_value tmp; int nargin = args.length (); std::string shape = "full"; //default - bool separable = false; convn_type ct; if (nargin < 2 || nargin > 3) @@ -274,8 +273,6 @@ { if (args(2).is_string ()) shape = args(2).string_value (); - else - separable = true; } if (shape == "full")
--- a/src/DLD-FUNCTIONS/convhulln.cc +++ b/src/DLD-FUNCTIONS/convhulln.cc @@ -41,36 +41,48 @@ #include "oct-obj.h" #include "parse.h" -#ifdef HAVE_QHULL -extern "C" { -#include <qhull/qhull_a.h> -} - -# ifdef NEED_QHULL_VERSION +#if defined (HAVE_QHULL) +# include "oct-qhull.h" +# if defined (NEED_QHULL_VERSION) char qh_version[] = "convhulln.oct 2007-07-24"; # endif -#endif /* HAVE_QHULL */ +#endif DEFUN_DLD (convhulln, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{h} =} convhulln (@var{p})\n\ -@deftypefnx {Loadable Function} {@var{h} =} convhulln (@var{p}, @var{opt})\n\ +@deftypefn {Loadable Function} {@var{h} =} convhulln (@var{pts})\n\ +@deftypefnx {Loadable Function} {@var{h} =} convhulln (@var{pts}, @var{options})\n\ @deftypefnx {Loadable Function} {[@var{h}, @var{v}] =} convhulln (@dots{})\n\ -Return an index vector to the points of the enclosing convex hull.\n\ -The input matrix of size [n, dim] contains n points of dimension dim.\n\n\ -If a second optional argument is given, it must be a string or cell array\n\ -of strings containing options for the underlying qhull command. (See\n\ -the Qhull documentation for the available options.) The default options\n\ -are \"s Qci Tcv\".\n\ -If the second output @var{v} is requested the volume of the convex hull is\n\ -calculated.\n\n\ -@seealso{convhull, delaunayn}\n\ +Compute the convex hull of the set of points @var{pts} which is a matrix\n\ +of size [n, dim] containing n points in a space of dimension dim.\n\ +The hull @var{h} is an index vector into the set of points and specifies\n\ +which points form the enclosing hull.\n\ +\n\ +An optional second argument, which must be a string or cell array of strings,\n\ +contains options passed to the underlying qhull command.\n\ +See the documentation for the Qhull library for details\n\ +@url{http://www.qhull.org/html/qh-quick.htm#options}.\n\ +The default options depend on the dimension of the input:\n\ +\n\ +@itemize\n\ +@item 2D, 3D, 4D: @var{options} = @code{@{\"Qt\"@}}\n\ +\n\ +@item 5D and higher: @var{options} = @code{@{\"Qt\", \"Qx\"@}}\n\ +@end itemize\n\ +\n\ +If @var{options} is not present or @code{[]} then the default arguments are\n\ +used. Otherwise, @var{options} replaces the default argument list.\n\ +To append user options to the defaults it is necessary to repeat the\n\ +default arguments in @var{options}. Use a null string to pass no arguments.\n\ +\n\ +If the second output @var{v} is requested the volume of the enclosing\n\ +convex hull is calculated.\n\n\ +@seealso{convhull, delaunayn, voronoin}\n\ @end deftypefn") { octave_value_list retval; -#ifdef HAVE_QHULL - std::string options; +#if defined (HAVE_QHULL) int nargin = args.length (); if (nargin < 1 || nargin > 2) @@ -79,110 +91,128 @@ return retval; } + Matrix points (args(0).matrix_value ()); + const octave_idx_type dim = points.columns (); + const octave_idx_type num_points = points.rows (); + + points = points.transpose (); + + std::string options; + + if (dim <= 4) + options = " Qt"; + else + options = " Qt Qx"; + if (nargin == 2) { - if (args (1).is_string ()) - options = args(1).string_value (); - else if (args(1).is_cell ()) + if (args(1).is_string ()) + options = " " + args(1).string_value (); + else if (args(1).is_empty ()) + ; // Use default options. + else if (args(1).is_cellstr ()) { - Cell c = args(1).cell_value (); options = ""; - for (octave_idx_type i = 0; i < c.numel (); i++) - { - if (! c.elem(i).is_string ()) - { - error ("convhulln: OPT must be a string or cell array of strings"); - return retval; - } + + Array<std::string> tmp = args(1).cellstr_value (); - options = options + c.elem(i).string_value() + " "; - } + for (octave_idx_type i = 0; i < tmp.numel (); i++) + options += " " + tmp(i); } else { - error ("convhulln: OPT must be a string or cell array of strings"); + error ("convhulln: OPTIONS must be a string, cell array of strings, or empty"); return retval; } - } - else - // turn on some consistency checks - options = "s Qci Tcv"; + } - Matrix p (args(0).matrix_value ()); + boolT ismalloc = false; - const octave_idx_type dim = p.columns (); - const octave_idx_type n = p.rows (); - p = p.transpose (); - - double *pt_array = p.fortran_vec (); + // Replace the 0 pointer with stdout for debugging information. + FILE *outfile = 0; + FILE *errfile = stderr; + + // qh_new_qhull command and points arguments are not const... - boolT ismalloc = False; - - std::ostringstream buf; + std::string cmd = "qhull" + options; - buf << "qhull QJ " << options; - - std::string buf_string = buf.str (); + OCTAVE_LOCAL_BUFFER (char, cmd_str, cmd.length () + 1); - // FIXME -- we can't just pass buf_string.c_str () to qh_new_qhull - // because the argument is not declared const. Ugh. Unless - // qh_new_qhull really needs to modify this argument, someone should - // fix QHULL. + strcpy (cmd_str, cmd.c_str ()); - OCTAVE_LOCAL_BUFFER (char, flags, buf_string.length () + 1); - - strcpy (flags, buf_string.c_str ()); - - if (! qh_new_qhull (dim, n, pt_array, ismalloc, flags, 0, stderr)) + int exitcode = qh_new_qhull (dim, num_points, points.fortran_vec (), + ismalloc, cmd_str, outfile, errfile); + if (! exitcode) { - // If you want some debugging information replace the NULL - // pointer with stdout + bool nonsimp_seen = false; - vertexT *vertex, **vertexp; + octave_idx_type nf = qh num_facets; + + Matrix idx (nf, dim + 1); + facetT *facet; - setT *vertices; - unsigned int nf = qh num_facets; - Matrix idx (nf, dim); + octave_idx_type i = 0; - octave_idx_type j, i = 0; FORALLfacets { - j = 0; - if (! facet->simplicial) - // should never happen with QJ - error ("convhulln: non-simplicial facet"); + octave_idx_type j = 0; + + if (! nonsimp_seen && ! facet->simplicial) + { + nonsimp_seen = true; + + if (cmd.find ("QJ") != std::string::npos) + { + // Should never happen with QJ. + error ("convhulln: qhull failed: option 'QJ' returned non-simplicial facet"); + return retval; + } + } if (dim == 3) { - vertices = qh_facet3vertex (facet); + setT *vertices = qh_facet3vertex (facet); + + vertexT *vertex, **vertexp; + FOREACHvertex_ (vertices) idx(i, j++) = 1 + qh_pointid(vertex->point); + qh_settempfree (&vertices); } else { if (facet->toporient ^ qh_ORIENTclock) { + vertexT *vertex, **vertexp; + FOREACHvertex_ (facet->vertices) idx(i, j++) = 1 + qh_pointid(vertex->point); } else { + vertexT *vertex, **vertexp; + FOREACHvertexreverse12_ (facet->vertices) idx(i, j++) = 1 + qh_pointid(vertex->point); } } if (j < dim) - // likewise but less fatal - warning ("facet %d only has %d vertices", i, j); + warning ("convhulln: facet %d only has %d vertices", i, j); + i++; } + // Remove extra dimension if all facets were simplicial. + + if (! nonsimp_seen) + idx.resize (nf, dim, 0.0); + if (nargout == 2) - // calculate volume of convex hull - // taken from qhull src/geom2.c { + // Calculate volume of convex hull, taken from qhull src/geom2.c. + realT area; realT dist; @@ -213,19 +243,21 @@ retval(1) = octave_value (qh totvol); } - retval(0) = octave_value (idx); + retval(0) = idx; } + else + error ("convhulln: qhull failed"); - // free long memory + // Free memory from Qhull qh_freeqhull (! qh_ALL); - // free short memory and memory allocator int curlong, totlong; qh_memfreeshort (&curlong, &totlong); if (curlong || totlong) warning ("convhulln: did not free %d bytes of long memory (%d pieces)", - totlong, curlong); + totlong, curlong); + #else error ("convhulln: not available in this version of Octave"); #endif @@ -236,10 +268,23 @@ /* %!testif HAVE_QHULL %! cube = [0 0 0;1 0 0;1 1 0;0 1 0;0 0 1;1 0 1;1 1 1;0 1 1]; -%! [h, v] = convhulln(cube,'Pp'); +%! [h, v] = convhulln (cube); +%! assert (size (h), [6 4]); +%! h = sortrows (sort (h, 2), [1:4]); +%! assert (h, [1 2 3 4; 1 2 5 6; 1 4 5 8; 2 3 6 7; 3 4 7 8; 5 6 7 8]); +%! assert (v, 1, 10*eps); + +%!testif HAVE_QHULL +%! cube = [0 0 0;1 0 0;1 1 0;0 1 0;0 0 1;1 0 1;1 1 1;0 1 1]; +%! [h, v] = convhulln (cube, "QJ"); +%! assert (size (h), [12 3]); +%! assert (sortrows (sort (h, 2), [1:3]), [1 2 4; 1 2 5; 1 4 5; 2 3 4; 2 3 6; 2 5 6; 3 4 8; 3 6 7; 3 7 8; 4 5 8; 5 6 8; 6 7 8]); %! assert (v, 1.0, 1e6*eps); + %!testif HAVE_QHULL %! tetrahedron = [1 1 1;-1 -1 1;-1 1 -1;1 -1 -1]; -%! [h, v] = convhulln(tetrahedron,'Pp'); -%! assert (v, 8/3, 1e6*eps); +%! [h, v] = convhulln (tetrahedron); +%! h = sortrows (sort (h, 2), [1 2 3]); +%! assert (h, [1 2 3;1 2 4; 1 3 4; 2 3 4]); +%! assert (v, 8/3, 10*eps); */
--- a/src/DLD-FUNCTIONS/dassl.cc +++ b/src/DLD-FUNCTIONS/dassl.cc @@ -500,8 +500,11 @@ %% %% y1(t) = cos(t) %% y2(t) = sin(t) -%!function res = f (x, xdot, t) + +%!function res = __f (x, xdot, t) %! res = [xdot(1)+x(2); xdot(2)-x(1)]; +%!endfunction + %!test %! %! x0 = [1; 0]; @@ -511,7 +514,7 @@ %! tol = 100 * dassl_options ("relative tolerance"); %! %! -%! [x, xdot] = dassl ("f", x0, xdot0, t); +%! [x, xdot] = dassl ("__f", x0, xdot0, t); %! %! y = [cos(t), sin(t)]; %! @@ -537,8 +540,11 @@ %% %% x1(t) = exp(-10*t) %% x2(t) = 1 - x(1) -%!function res = f (x, xdot, t) + +%!function res = __f (x, xdot, t) %! res = [xdot(1)+10*x(1); x(1)+x(2)-1]; +%!endfunction + %!test %! %! x0 = [1; 0]; @@ -548,7 +554,7 @@ %! tol = 500 * dassl_options ("relative tolerance"); %! %! -%! [x, xdot] = dassl ("f", x0, xdot0, t); +%! [x, xdot] = dassl ("__f", x0, xdot0, t); %! %! y = [exp(-10*t), 1-exp(-10*t)]; %! @@ -558,6 +564,6 @@ %! dassl_options ("absolute tolerance", eps); %! assert(dassl_options ("absolute tolerance") == eps); -%!error <Invalid call to dassl_options.*> dassl_options ("foo", 1, 2); +%!error <Invalid call to dassl_options> dassl_options ("foo", 1, 2); */
--- a/src/DLD-FUNCTIONS/det.cc +++ b/src/DLD-FUNCTIONS/det.cc @@ -248,8 +248,8 @@ %!assert(det ([1, 2; 3, 4]), -2, 10 * eps); %!assert(det (single([1, 2; 3, 4])), single(-2), 10 * eps ('single')); -%!error <Invalid call to det.*> det (); -%!error <Invalid call to det.*> det (1, 2); +%!error <Invalid call to det> det (); +%!error <Invalid call to det> det (1, 2); %!error det ([1, 2; 3, 4; 5, 6]); */
--- a/src/DLD-FUNCTIONS/dmperm.cc +++ b/src/DLD-FUNCTIONS/dmperm.cc @@ -191,7 +191,7 @@ DEFUN_DLD (sprank, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {@var{p} =} sprank (@var{S})\n\ -@cindex Structural Rank\n\ +@cindex structural rank\n\ \n\ Calculate the structural rank of the sparse matrix @var{S}. Note that\n\ only the structure of the matrix is used in this calculation based on\n\
--- a/src/DLD-FUNCTIONS/dot.cc +++ b/src/DLD-FUNCTIONS/dot.cc @@ -107,7 +107,7 @@ "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} dot (@var{x}, @var{y}, @var{dim})\n\ Compute the dot product of two vectors. If @var{x} and @var{y}\n\ -are matrices, calculate the dot products along the first \n\ +are matrices, calculate the dot products along the first\n\ non-singleton dimension. If the optional argument @var{dim} is\n\ given, calculate the dot products along this dimension.\n\ \n\ @@ -116,7 +116,7 @@ but avoids forming a temporary array and is faster. When @var{X} and\n\ @var{Y} are column vectors, the result is equivalent to\n\ @code{@var{X}' * @var{Y}}.\n\ -@seealso{cross}\n\ +@seealso{cross, divergence}\n\ @end deftypefn") { octave_value retval; @@ -238,21 +238,32 @@ /* +%! assert(dot ([1, 2], [2, 3]), 11); + +%!test +%! x = [2, 1; 2, 1]; +%! y = [-0.5, 2; 0.5, -2]; +%! assert(dot (x, y), [0 0]); + +%!test +%! x = [ 1+i, 3-i; 1-i, 3-i]; +%! assert(dot (x, x), [4, 20]); + */ DEFUN_DLD (blkmm, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} blkmm (@var{x}, @var{y})\n\ +@deftypefn {Loadable Function} {} blkmm (@var{A}, @var{B})\n\ Compute products of matrix blocks. The blocks are given as\n\ -2-dimensional subarrays of the arrays @var{x}, @var{y}.\n\ -The size of @var{x} must have the form @code{[m,k,@dots{}]} and\n\ -size of @var{y} must be @code{[k,n,@dots{}]}. The result is\n\ +2-dimensional subarrays of the arrays @var{A}, @var{B}.\n\ +The size of @var{A} must have the form @code{[m,k,@dots{}]} and\n\ +size of @var{B} must be @code{[k,n,@dots{}]}. The result is\n\ then of size @code{[m,n,@dots{}]} and is computed as follows:\n\ \n\ @example\n\ @group\n\ - for i = 1:prod (size (@var{x})(3:end))\n\ - @var{z}(:,:,i) = @var{x}(:,:,i) * @var{y}(:,:,i)\n\ + for i = 1:prod (size (@var{A})(3:end))\n\ + @var{C}(:,:,i) = @var{A}(:,:,i) * @var{B}(:,:,i)\n\ endfor\n\ @end group\n\ @end example\n\ @@ -335,12 +346,23 @@ } } else - error ("blkmm: X and Y dimensions don't match: (%s) and (%s)", + error ("blkmm: A and B dimensions don't match: (%s) and (%s)", dimx.str ().c_str (), dimy.str ().c_str ()); } else - error ("blkmm: X and Y must be numeric"); + error ("blkmm: A and B must be numeric"); return retval; } + +/* + +%!test +%! x(:,:,1) = [1 2; 3 4]; +%! x(:,:,2) = [1 1; 1 1]; +%! z(:,:,1) = [7 10; 15 22]; +%! z(:,:,2) = [2 2; 2 2]; +%! assert(blkmm (x,x),z); + +*/
--- a/src/DLD-FUNCTIONS/eig.cc +++ b/src/DLD-FUNCTIONS/eig.cc @@ -39,11 +39,12 @@ @deftypefnx {Loadable Function} {@var{lambda} =} eig (@var{A}, @var{B})\n\ @deftypefnx {Loadable Function} {[@var{V}, @var{lambda}] =} eig (@var{A})\n\ @deftypefnx {Loadable Function} {[@var{V}, @var{lambda}] =} eig (@var{A}, @var{B})\n\ -The eigenvalues (and eigenvectors) of a matrix are computed in a several\n\ -step process which begins with a Hessenberg decomposition, followed by a\n\ -Schur@tie{}decomposition, from which the eigenvalues are apparent. The\n\ -eigenvectors, when desired, are computed by further manipulations of the\n\ -Schur@tie{}decomposition.\n\ +Compute the eigenvalues and eigenvectors of a matrix.\n\ +\n\ +Eigenvalues are computed in a several step process which begins with a\n\ +Hessenberg decomposition, followed by a Schur@tie{}decomposition, from which\n\ +the eigenvalues are apparent. The eigenvectors, when desired, are computed\n\ +by further manipulations of the Schur@tie{}decomposition.\n\ \n\ The eigenvalues returned by @code{eig} are not ordered.\n\ @seealso{eigs, svd}\n\ @@ -324,8 +325,8 @@ %! assert(A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps)); %! assert(A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps)); -%!error <Invalid call to eig.*> eig (); -%!error <Invalid call to eig.*> eig ([1, 2; 3, 4], [4, 3; 2, 1], 1); +%!error <Invalid call to eig> eig (); +%!error <Invalid call to eig> eig ([1, 2; 3, 4], [4, 3; 2, 1], 1); %!error eig ([1, 2; 3, 4], 2); %!error eig ([1, 2; 3, 4; 5, 6]); %!error eig ("abcd");
--- a/src/DLD-FUNCTIONS/eigs.cc +++ b/src/DLD-FUNCTIONS/eigs.cc @@ -260,7 +260,7 @@ @end table\n\ It is also possible to represent @var{A} by a function denoted @var{af}.\n\ @var{af} must be followed by a scalar argument @var{n} defining the length\n\ -of the vector argument accepted by @var{af}. @var{af} can be \n\ +of the vector argument accepted by @var{af}. @var{af} can be\n\ a function handle, an inline function, or a string. When @var{af} is a\n\ string it holds the name of the function to use.\n\ \n\ @@ -323,6 +323,7 @@ bool a_is_complex = false; bool b_is_complex = false; bool symmetric = false; + bool sym_tested = false; bool cholB = false; bool a_is_sparse = false; ColumnVector permB; @@ -334,7 +335,6 @@ ColumnVector resid; ComplexColumnVector cresid; octave_idx_type info = 1; - char bmat = 'I'; warned_imaginary = false; @@ -399,7 +399,8 @@ else acm = (args(0).complex_matrix_value()); a_is_complex = true; - symmetric = false; // ARAPACK doesn't special case complex symmetric + symmetric = false; // ARPACK doesn't special case complex symmetric + sym_tested = true; } else { @@ -407,19 +408,17 @@ { asmm = (args(0).sparse_matrix_value()); a_is_sparse = true; - symmetric = asmm.is_symmetric(); } else { amm = (args(0).matrix_value()); - symmetric = amm.is_symmetric(); } } } // Note hold off reading B till later to avoid issues of double - // copies of the matrix if B is full/real while A is complex.. + // copies of the matrix if B is full/real while A is complex. if (!error_state && nargin > 1 + arg_offset && !(args(1 + arg_offset).is_real_scalar ())) { @@ -427,7 +426,6 @@ { b_arg = 1+arg_offset; have_b = true; - bmat = 'G'; b_is_complex = true; arg_offset++; } @@ -435,7 +433,6 @@ { b_arg = 1+arg_offset; have_b = true; - bmat = 'G'; arg_offset++; } } @@ -481,10 +478,13 @@ { octave_value tmp; - // issym is ignored if A is not a function + // issym is ignored for complex matrix inputs tmp = map.getfield ("issym"); - if (tmp.is_defined () && have_a_fun) - symmetric = tmp.double_value () != 0.; + if (tmp.is_defined () && !sym_tested) + { + symmetric = tmp.double_value () != 0.; + sym_tested = true; + } // isreal is ignored if A is not a function tmp = map.getfield ("isreal"); @@ -543,6 +543,15 @@ return retval; } + // Test undeclared (no issym) matrix inputs for symmetry + if (!sym_tested && !have_a_fun) + { + if (a_is_sparse) + symmetric = asmm.is_symmetric(); + else + symmetric = amm.is_symmetric(); + } + if (have_b) { if (a_is_complex || b_is_complex)
--- a/src/DLD-FUNCTIONS/fftw.cc +++ b/src/DLD-FUNCTIONS/fftw.cc @@ -58,7 +58,7 @@ \n\ @example\n\ fftw ('dwisdom', @var{wisdom})\n\ -@end example \n\ +@end example\n\ \n\ If @var{wisdom} is an empty matrix, then the wisdom used is cleared.\n\ \n\
--- a/src/DLD-FUNCTIONS/filter.cc +++ b/src/DLD-FUNCTIONS/filter.cc @@ -64,6 +64,10 @@ octave_idx_type ab_len = a_len > b_len ? a_len : b_len; + // FIXME: The two lines below should be unecessary because + // this template is called with a and b as column vectors + // already. However the a.resize line is currently (2011/04/26) + // necessary to stop bug #33164. b.resize (dim_vector (ab_len, 1), 0.0); if (a_len > 1) a.resize (dim_vector (ab_len, 1), 0.0); @@ -100,16 +104,17 @@ return y; } - octave_idx_type si_dim = 0; - for (octave_idx_type i = 0; i < x_dims.length (); i++) + for (octave_idx_type i = 1; i < dim; i++) { - if (i == dim) - continue; - - if (x_dims(i) == 1) - continue; - - if (si_dims(++si_dim) != x_dims(i)) + if (si_dims(i) != x_dims(i-1)) + { + error ("filter: dimensionality of SI and X must agree"); + return y; + } + } + for (octave_idx_type i = dim+1; i < x_dims.length (); i++) + { + if (si_dims(i) != x_dims(i)) { error ("filter: dimensionality of SI and X must agree"); return y; @@ -452,18 +457,9 @@ } else { - dim_vector si_dims = args (3).dims (); - bool si_is_vector = true; - for (int i = 0; i < si_dims.length (); i++) - if (si_dims(i) != 1 && si_dims(i) < si_dims.numel ()) - { - si_is_vector = false; - break; - } - si = args(3).float_complex_array_value (); - if (si_is_vector) + if (si.is_vector () && x.is_vector ()) si = si.reshape (dim_vector (si.numel (), 1)); } @@ -509,18 +505,9 @@ } else { - dim_vector si_dims = args (3).dims (); - bool si_is_vector = true; - for (int i = 0; i < si_dims.length (); i++) - if (si_dims(i) != 1 && si_dims(i) < si_dims.numel ()) - { - si_is_vector = false; - break; - } - si = args(3).complex_array_value (); - if (si_is_vector) + if (si.is_vector () && x.is_vector ()) si = si.reshape (dim_vector (si.numel (), 1)); } @@ -569,18 +556,9 @@ } else { - dim_vector si_dims = args (3).dims (); - bool si_is_vector = true; - for (int i = 0; i < si_dims.length (); i++) - if (si_dims(i) != 1 && si_dims(i) < si_dims.numel ()) - { - si_is_vector = false; - break; - } - si = args(3).float_array_value (); - if (si_is_vector) + if (si.is_vector () && x.is_vector ()) si = si.reshape (dim_vector (si.numel (), 1)); } @@ -626,18 +604,9 @@ } else { - dim_vector si_dims = args (3).dims (); - bool si_is_vector = true; - for (int i = 0; i < si_dims.length (); i++) - if (si_dims(i) != 1 && si_dims(i) < si_dims.numel ()) - { - si_is_vector = false; - break; - } - si = args(3).array_value (); - if (si_is_vector) + if (si.is_vector () && x.is_vector ()) si = si.reshape (dim_vector (si.numel (), 1)); } @@ -694,58 +663,71 @@ %!test %! a = [1 1]; %! b = [1 1]; -%! x = zeros(1,10); x(1) = 1; -%! assert(all(filter(b, [1], x ) == [1 1 0 0 0 0 0 0 0 0] )) -%! assert(all(filter(b, [1], x.') == [1 1 0 0 0 0 0 0 0 0].')) -%! assert(all(filter(b.', [1], x ) == [1 1 0 0 0 0 0 0 0 0] )) -%! assert(all(filter(b.', [1], x.') == [1 1 0 0 0 0 0 0 0 0].')) -%! assert(all(filter([1], a, x ) == [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1] )) -%! assert(all(filter([1], a, x.') == [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1].')) -%! assert(all(filter([1], a.', x ) == [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1] )) -%! assert(all(filter([1], a.', x.') == [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1].')) -%! assert(all(filter(b, a, x ) == [1 0 0 0 0 0 0 0 0 0] )) -%! assert(all(filter(b.', a, x ) == [1 0 0 0 0 0 0 0 0 0] )) -%! assert(all(filter(b, a.', x ) == [1 0 0 0 0 0 0 0 0 0] )) -%! assert(all(filter(b.', a, x ) == [1 0 0 0 0 0 0 0 0 0] )) -%! assert(all(filter(b, a, x.') == [1 0 0 0 0 0 0 0 0 0].')) -%! assert(all(filter(b.', a, x.') == [1 0 0 0 0 0 0 0 0 0].')) -%! assert(all(filter(b, a.', x.') == [1 0 0 0 0 0 0 0 0 0].')) -%! assert(all(filter(b.', a, x.') == [1 0 0 0 0 0 0 0 0 0].')) +%! x = zeros (1,10); x(1) = 1; +%! assert(filter(b, [1], x ), [1 1 0 0 0 0 0 0 0 0]); +%! assert(filter(b, [1], x.'), [1 1 0 0 0 0 0 0 0 0].'); +%! assert(filter(b.', [1], x ), [1 1 0 0 0 0 0 0 0 0] ); +%! assert(filter(b.', [1], x.'), [1 1 0 0 0 0 0 0 0 0].'); +%! assert(filter([1], a, x ), [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1] ); +%! assert(filter([1], a, x.'), [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1].'); +%! assert(filter([1], a.', x ), [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1] ); +%! assert(filter([1], a.', x.'), [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1].'); +%! assert(filter(b, a, x ), [1 0 0 0 0 0 0 0 0 0] ); +%! assert(filter(b.', a, x ), [1 0 0 0 0 0 0 0 0 0] ); +%! assert(filter(b, a.', x ), [1 0 0 0 0 0 0 0 0 0] ); +%! assert(filter(b.', a, x ), [1 0 0 0 0 0 0 0 0 0] ); +%! assert(filter(b, a, x.'), [1 0 0 0 0 0 0 0 0 0].'); +%! assert(filter(b.', a, x.'), [1 0 0 0 0 0 0 0 0 0].'); +%! assert(filter(b, a.', x.'), [1 0 0 0 0 0 0 0 0 0].'); +%! assert(filter(b.', a, x.'), [1 0 0 0 0 0 0 0 0 0].'); %! %!test %! r = sqrt(1/2)*(1+i); %! a = a*r; %! b = b*r; -%! assert(all(filter(b, [1], x ) == r*[1 1 0 0 0 0 0 0 0 0] )) -%! assert(all(filter(b, [1], r*x ) == r*r*[1 1 0 0 0 0 0 0 0 0] )) -%! assert(all(filter(b, [1], x.' ) == r*[1 1 0 0 0 0 0 0 0 0].' )) -%! assert(all(filter(b, a, x ) == [1 0 0 0 0 0 0 0 0 0] )) -%! assert(all(filter(b, a, r*x ) == r*[1 0 0 0 0 0 0 0 0 0] )) +%! assert(filter(b, [1], x ), r*[1 1 0 0 0 0 0 0 0 0] ); +%! assert(filter(b, [1], r*x ), r*r*[1 1 0 0 0 0 0 0 0 0] ); +%! assert(filter(b, [1], x.' ), r*[1 1 0 0 0 0 0 0 0 0].' ); +%! assert(filter(b, a, x ), [1 0 0 0 0 0 0 0 0 0] ); +%! assert(filter(b, a, r*x ), r*[1 0 0 0 0 0 0 0 0 0] ); %! %!shared a, b, x, y, so %!test -%! a = [1,1]; b=[1,1]; -%! x = zeros(1,10); x(1) = 1; -%! [y, so] = filter(b, [1], x, [-1]); -%! assert(all(y == [0 1 0 0 0 0 0 0 0 0])) -%! assert(so,0) +%! a = [1,1]; b = [1,1]; +%! x = zeros (1,10); x(1) = 1; +%! [y, so] = filter (b, [1], x, [-1]); +%! assert(y, [0 1 0 0 0 0 0 0 0 0]); +%! assert(so,0); %! %!test -%! x = zeros(10,3); x(1,1)=-1; x(1,2)=1; -%! y0 = zeros(10,3); y0(1:2,1)=-1; y0(1:2,2)=1; -%! y = filter(b,[1],x); -%! assert(all(all(y==y0))) +%! x = zeros (10,3); x(1,1)=-1; x(1,2)=1; +%! y0 = zeros (10,3); y0(1:2,1)=-1; y0(1:2,2)=1; +%! y = filter (b, [1], x); +%! assert(y,y0); %! %!test %! a = [1,1]; b=[1,1]; -%! x = zeros(4,4,2); x(1,1:4,1) = +1; x(1,1:4,2) = -1; -%! y0 = zeros(4,4,2); y0(1:2,1:4,1) = +1; y0(1:2,1:4,2) = -1; -%! y = filter(b, [1], x); -%! assert(all(all(all(y==y0)))) +%! x = zeros (4,4,2); x(1,1:4,1) = +1; x(1,1:4,2) = -1; +%! y0 = zeros (4,4,2); y0(1:2,1:4,1) = +1; y0(1:2,1:4,2) = -1; +%! y = filter (b, [1], x); +%! assert(y, y0); %! -%!assert(filter(1,ones(10,1)/10,[]), []) -%!assert(filter(1,ones(10,1)/10,zeros(0,10)), zeros(0,10)) - -%% Should put some tests of the "DIM" parameter in here. +%!assert(filter (1, ones(10,1)/10, []), []); +%!assert(filter (1, ones(10,1)/10, zeros(0,10)), zeros(0,10)); +%!assert(filter (1, ones(10,1)/10, single (1:5)), repmat (single (10), 1, 5)); +%% Test using initial conditions +%!assert(filter([1, 1, 1], [1, 1], [1 2], [1, 1]), [2 2]); +%!assert(filter([1, 1, 1], [1, 1], [1 2], [1, 1]'), [2 2]); +%!assert(filter([1, 3], [1], [1 2; 3 4; 5 6], [4, 5]), [5 7; 6 10; 14 18]); +%!error (filter([1, 3], [1], [1 2; 3 4; 5 6], [4, 5]')); +%!assert(filter([1, 3, 2], [1], [1 2; 3 4; 5 6], [1 0 0; 1 0 0], 2), [2 6; 3 13; 5 21]); +%% Test of DIM parameter +%!test +%! x = ones (2, 1, 3, 4); +%! x(1,1,:,:) = [1 2 3 4; 5 6 7 8; 9 10 11 12]; +%! y0 = [1 1 6 2 15 3 2 1 8 2 18 3 3 1 10 2 21 3 4 1 12 2 24 3]; +%! y0 = reshape (y0, size (x)); +%! y = filter([1 1 1], 1, x, [], 3); +%! assert (y, y0); */
--- a/src/DLD-FUNCTIONS/find.cc +++ b/src/DLD-FUNCTIONS/find.cc @@ -232,26 +232,23 @@ octave_value_list retval ((nargout == 0 ? 1 : nargout), Matrix ()); octave_idx_type nc = v.cols(); - octave_idx_type start_nc, end_nc, count; + octave_idx_type start_nc, count; // Determine the range to search. if (n_to_find < 0 || n_to_find >= nc) { start_nc = 0; - end_nc = nc; n_to_find = nc; count = nc; } else if (direction > 0) { start_nc = 0; - end_nc = n_to_find; count = n_to_find; } else { start_nc = nc - n_to_find; - end_nc = nc; count = n_to_find; } @@ -341,11 +338,11 @@ @deftypefnx {Loadable Function} {@var{idx} =} find (@var{x}, @var{n})\n\ @deftypefnx {Loadable Function} {@var{idx} =} find (@var{x}, @var{n}, @var{direction})\n\ @deftypefnx {Loadable Function} {[i, j] =} find (@dots{})\n\ -@deftypefnx {Loadable Function} {[i, j, v]] =} find (@dots{})\n\ +@deftypefnx {Loadable Function} {[i, j, v] =} find (@dots{})\n\ Return a vector of indices of nonzero elements of a matrix, as a row if\n\ -@var{x} is a row or as a column otherwise. To obtain a single index for\n\ -each matrix element, Octave pretends that the columns of a matrix form one\n\ -long vector (like Fortran arrays are stored). For example:\n\ +@var{x} is a row vector or as a column otherwise. To obtain a single index\n\ +for each matrix element, Octave pretends that the columns of a matrix form\n\ +one long vector (like Fortran arrays are stored). For example:\n\ \n\ @example\n\ @group\n\ @@ -390,9 +387,9 @@ \n\ @example\n\ @group\n\ -sz = size(a);\n\ +sz = size (a);\n\ [i, j, v] = find (a);\n\ -b = sparse(i, j, v, sz(1), sz(2));\n\ +b = sparse (i, j, v, sz(1), sz(2));\n\ @end group\n\ @end example\n\ @seealso{nonzeros}\n\ @@ -416,7 +413,7 @@ if (error_state || (val < 0 || (! xisinf (val) && val != xround (val)))) { - error ("find: N must be a nonnegative integer"); + error ("find: N must be a non-negative integer"); return retval; } else if (! xisinf (val)) @@ -620,6 +617,6 @@ %!assert (find ([2 0 1 0 5 0], Inf), [1, 3, 5]) %!assert (find ([2 0 1 0 5 0], Inf, "last"), [1, 3, 5]) -%!error <Invalid call to find.*> find (); +%!error <Invalid call to find> find (); */
--- a/src/DLD-FUNCTIONS/gcd.cc +++ b/src/DLD-FUNCTIONS/gcd.cc @@ -522,7 +522,7 @@ %!assert(gcd (uint64(200), uint64(300), uint64(50), uint64(35)), uint64(5)) %!assert(gcd (18-i, -29+3i), -3-4i) -%!error <Invalid call to gcd.*> gcd (); +%!error <Invalid call to gcd> gcd (); %!test %! s.a = 1;
--- a/src/DLD-FUNCTIONS/getgrent.cc +++ b/src/DLD-FUNCTIONS/getgrent.cc @@ -80,8 +80,8 @@ { std::string msg; + retval(1) = msg; retval(0) = mk_gr_map (octave_group::getgrent (msg)); - retval(1) = msg; } else print_usage (); @@ -116,8 +116,8 @@ std::string msg; + retval(1) = msg; retval(0) = mk_gr_map (octave_group::getgrgid (gid, msg)); - retval(1) = msg; } else error ("getgrgid: GID must be an integer"); @@ -152,8 +152,8 @@ { std::string msg; + retval(1) = msg; retval(0) = mk_gr_map (octave_group::getgrnam (s.c_str (), msg)); - retval(1) = msg; } } else @@ -179,8 +179,8 @@ { std::string msg; + retval(1) = msg; retval(0) = static_cast<double> (octave_group::setgrent (msg)); - retval(1) = msg; } else print_usage (); @@ -205,8 +205,8 @@ { std::string msg; + retval(1) = msg; retval(0) = static_cast<double> (octave_group::endgrent (msg)); - retval(1) = msg; } else print_usage ();
--- a/src/DLD-FUNCTIONS/getpwent.cc +++ b/src/DLD-FUNCTIONS/getpwent.cc @@ -84,8 +84,8 @@ { std::string msg; + retval(1) = msg; retval(0) = mk_pw_map (octave_passwd::getpwent (msg)); - retval(1) = msg; } else print_usage (); @@ -120,8 +120,8 @@ std::string msg; + retval(1) = msg; retval(0) = mk_pw_map (octave_passwd::getpwuid (uid, msg)); - retval(1) = msg; } else error ("getpwuid: UID must be an integer"); @@ -156,8 +156,8 @@ { std::string msg; + retval(1) = msg; retval(0) = mk_pw_map (octave_passwd::getpwnam (s, msg)); - retval(1) = msg; } } else @@ -183,8 +183,8 @@ { std::string msg; + retval(1) = msg; retval(0) = static_cast<double> (octave_passwd::setpwent (msg)); - retval(1) = msg; } else print_usage (); @@ -209,8 +209,8 @@ { std::string msg; + retval(1) = msg; retval(0) = static_cast<double> (octave_passwd::endpwent (msg)); - retval(1) = msg; } else print_usage ();
--- a/src/DLD-FUNCTIONS/givens.cc +++ b/src/DLD-FUNCTIONS/givens.cc @@ -203,3 +203,13 @@ return retval; } + +/* + +%!assert (givens (1,1), [1, 1; -1, 1]/sqrt(2), 2*eps); +%!assert (givens (1,0), eye(2)); +%!assert (givens (0,1), [0, 1; -1 0]); +%!error givens(1); +%!error givens() + +*/
--- a/src/DLD-FUNCTIONS/hess.cc +++ b/src/DLD-FUNCTIONS/hess.cc @@ -37,8 +37,8 @@ DEFUN_DLD (hess, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{h} =} hess (@var{A})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{h}] =} hess (@var{A})\n\ +@deftypefn {Loadable Function} {@var{H} =} hess (@var{A})\n\ +@deftypefnx {Loadable Function} {[@var{P}, @var{H}] =} hess (@var{A})\n\ @cindex Hessenberg decomposition\n\ Compute the Hessenberg decomposition of the matrix @var{A}.\n\ \n\ @@ -51,8 +51,8 @@ is upper Hessenberg ($H_{i,j} = 0, \\forall i \\ge j+1$).\n\ @end tex\n\ @ifnottex\n\ -@code{@var{P} * @var{H} * @var{P}' = @var{A}} where @var{p} is a square\n\ -unitary matrix (@code{@var{p}' * @var{p} = I}, using complex-conjugate\n\ +@code{@var{P} * @var{H} * @var{P}' = @var{A}} where @var{P} is a square\n\ +unitary matrix (@code{@var{P}' * @var{P} = I}, using complex-conjugate\n\ transposition) and @var{H} is upper Hessenberg\n\ (@code{@var{H}(i, j) = 0 forall i >= j+1)}.\n\ @end ifnottex\n\ @@ -184,8 +184,8 @@ %! [p, h] = hess (a); %! assert(p * h * p', a, sqrt(eps ('single'))); -%!error <Invalid call to hess.*> hess (); -%!error <Invalid call to hess.*> hess ([1, 2; 3, 4], 2); +%!error <Invalid call to hess> hess (); +%!error <Invalid call to hess> hess ([1, 2; 3, 4], 2); %!error hess ([1, 2; 3, 4; 5, 6]); */
--- a/src/DLD-FUNCTIONS/hex2num.cc +++ b/src/DLD-FUNCTIONS/hex2num.cc @@ -76,6 +76,8 @@ double dval; } num; + num.ival = 0; + for (octave_idx_type j = 0; j < nc; j++) { unsigned char ch = cmat.elem (i, j);
--- a/src/DLD-FUNCTIONS/inv.cc +++ b/src/DLD-FUNCTIONS/inv.cc @@ -38,7 +38,7 @@ DEFUN_DLD (inv, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{x} =} inv (@var{A})\n\ +@deftypefn {Loadable Function} {@var{x} =} inv (@var{A})\n\ @deftypefnx {Loadable Function} {[@var{x}, @var{rcond}] =} inv (@var{A})\n\ Compute the inverse of the square matrix @var{A}. Return an estimate\n\ of the reciprocal condition number if requested, otherwise warn of an\n\ @@ -228,8 +228,8 @@ %!assert(inv ([1, 2; 3, 4]), [-2, 1; 1.5, -0.5], sqrt (eps)) %!assert(inv (single([1, 2; 3, 4])), single([-2, 1; 1.5, -0.5]), sqrt (eps ('single'))) -%!error <Invalid call to inv.*> inv (); -%!error <Invalid call to inv.*> inv ([1, 2; 3, 4], 2); +%!error <Invalid call to inv> inv (); +%!error <Invalid call to inv> inv ([1, 2; 3, 4], 2); %!error inv ([1, 2; 3, 4; 5, 6]); */ @@ -240,9 +240,11 @@ DEFUN_DLD (inverse, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{x} =} inverse (@var{A})\n\ +@deftypefn {Loadable Function} {@var{x} =} inverse (@var{A})\n\ @deftypefnx {Loadable Function} {[@var{x}, @var{rcond}] =} inverse (@var{A})\n\ -This in an alias for @code{inv}.\n\ +Compute the inverse of the square matrix @var{A}.\n\ +\n\ +This is an alias for @code{inv}.\n\ @seealso{inv}\n\ @end deftypefn") {
--- a/src/DLD-FUNCTIONS/kron.cc +++ b/src/DLD-FUNCTIONS/kron.cc @@ -172,12 +172,77 @@ return octave_value (kron (am, bm)); } -#define ALL_TYPES(AMT, BMT) \ - } while (0) \ +octave_value +dispatch_kron (const octave_value& a, const octave_value& b) +{ + octave_value retval; + if (a.is_perm_matrix () && b.is_perm_matrix ()) + retval = do_kron<PermMatrix, PermMatrix> (a, b); + else if (a.is_diag_matrix ()) + { + if (b.is_diag_matrix () && a.rows () == a.columns () + && b.rows () == b.columns ()) + { + octave_value_list tmp; + tmp(0) = a.diag (); + tmp(1) = b.diag (); + tmp = dispatch_kron (tmp, 1); + if (tmp.length () == 1) + retval = tmp(0).diag (); + } + else if (a.is_single_type () || b.is_single_type ()) + { + if (a.is_complex_type ()) + retval = do_kron<FloatComplexDiagMatrix, FloatComplexMatrix> (a, b); + else if (b.is_complex_type ()) + retval = do_kron<FloatDiagMatrix, FloatComplexMatrix> (a, b); + else + retval = do_kron<FloatDiagMatrix, FloatMatrix> (a, b); + } + else + { + if (a.is_complex_type ()) + retval = do_kron<ComplexDiagMatrix, ComplexMatrix> (a, b); + else if (b.is_complex_type ()) + retval = do_kron<DiagMatrix, ComplexMatrix> (a, b); + else + retval = do_kron<DiagMatrix, Matrix> (a, b); + } + } + else if (a.is_sparse_type () || b.is_sparse_type ()) + { + if (a.is_complex_type () || b.is_complex_type ()) + retval = do_kron<SparseComplexMatrix, SparseComplexMatrix> (a, b); + else + retval = do_kron<SparseMatrix, SparseMatrix> (a, b); + } + else if (a.is_single_type () || b.is_single_type ()) + { + if (a.is_complex_type ()) + retval = do_kron<FloatComplexMatrix, FloatComplexMatrix> (a, b); + else if (b.is_complex_type ()) + retval = do_kron<FloatMatrix, FloatComplexMatrix> (a, b); + else + retval = do_kron<FloatMatrix, FloatMatrix> (a, b); + } + else + { + if (a.is_complex_type ()) + retval = do_kron<ComplexMatrix, ComplexMatrix> (a, b); + else if (b.is_complex_type ()) + retval = do_kron<Matrix, ComplexMatrix> (a, b); + else + retval = do_kron<Matrix, Matrix> (a, b); + } + return retval; +} + DEFUN_DLD (kron, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} kron (@var{A}, @var{B})\n\ -Form the Kronecker product of two matrices, defined block by block as\n\ +@deftypefn {Loadable Function} {} kron (@var{A}, @var{B})\n\ +@deftypefnx {Loadable Function} {} kron (@var{A1}, @var{A2}, @dots{})\n\ +Form the Kronecker product of two or more matrices, defined block by \n\ +block as\n\ \n\ @example\n\ x = [a(i, j) b]\n\ @@ -193,74 +258,48 @@ 1 2 3 4\n\ @end group\n\ @end example\n\ +\n\ +If there are more than two input arguments @var{A1}, @var{A2}, @dots{}, \n\ +@var{An} the Kronecker product is computed as\n\ +\n\ +@example\n\ +kron (kron (@var{A1}, @var{A2}), @dots{}, @var{An})\n\ +@end example\n\ +\n\ +@noindent\n\ +Since the Kronecker product is associative, this is well-defined.\n\ @end deftypefn") { octave_value retval; int nargin = args.length (); - if (nargin == 2) + if (nargin >= 2) { octave_value a = args(0), b = args(1); - if (a.is_perm_matrix () && b.is_perm_matrix ()) - retval = do_kron<PermMatrix, PermMatrix> (a, b); - else if (a.is_diag_matrix ()) - { - if (b.is_diag_matrix () && a.rows () == a.columns () - && b.rows () == b.columns ()) - { - octave_value_list tmp; - tmp(0) = a.diag (); - tmp(1) = b.diag (); - tmp = Fkron (tmp, 1); - if (tmp.length () == 1) - retval = tmp(0).diag (); - } - else if (a.is_single_type () || b.is_single_type ()) - { - if (a.is_complex_type ()) - return do_kron<FloatComplexDiagMatrix, FloatComplexMatrix> (a, b); - else if (b.is_complex_type ()) - return do_kron<FloatDiagMatrix, FloatComplexMatrix> (a, b); - else - return do_kron<FloatDiagMatrix, FloatMatrix> (a, b); - } - else - { - if (a.is_complex_type ()) - return do_kron<ComplexDiagMatrix, ComplexMatrix> (a, b); - else if (b.is_complex_type ()) - return do_kron<DiagMatrix, ComplexMatrix> (a, b); - else - return do_kron<DiagMatrix, Matrix> (a, b); - } - } - else if (a.is_sparse_type () || b.is_sparse_type ()) - { - if (args(0).is_complex_type () || args(1).is_complex_type ()) - return do_kron<SparseComplexMatrix, SparseComplexMatrix> (a, b); - else - return do_kron<SparseMatrix, SparseMatrix> (a, b); - } - else if (a.is_single_type () || b.is_single_type ()) - { - if (a.is_complex_type ()) - return do_kron<FloatComplexMatrix, FloatComplexMatrix> (a, b); - else if (b.is_complex_type ()) - return do_kron<FloatMatrix, FloatComplexMatrix> (a, b); - else - return do_kron<FloatMatrix, FloatMatrix> (a, b); - } - else - { - if (a.is_complex_type ()) - return do_kron<ComplexMatrix, ComplexMatrix> (a, b); - else if (b.is_complex_type ()) - return do_kron<Matrix, ComplexMatrix> (a, b); - else - return do_kron<Matrix, Matrix> (a, b); - } + retval = dispatch_kron (a, b); + for (octave_idx_type i = 2; i < nargin; i++) + retval = dispatch_kron (retval, args(i)); } + else + print_usage (); return retval; } + + +/* + +%!test +%! x = ones(2); +%! assert( kron (x, x), ones (4)); + +%!shared x, y, z +%! x = [1, 2]; +%! y = [-1, -2]; +%! z = [1, 2, 3, 4; 1, 2, 3, 4; 1, 2, 3, 4]; +%!assert (kron (1:4, ones (3, 1)), z) +%!assert (kron (x, y, z), kron (kron (x, y), z)) +%!assert (kron (x, y, z), kron (x, kron (y, z))) + +*/
--- a/src/DLD-FUNCTIONS/lookup.cc +++ b/src/DLD-FUNCTIONS/lookup.cc @@ -188,13 +188,14 @@ DEFUN_DLD (lookup, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{idx} =} lookup (@var{table}, @var{y}, @var{opt})\n\ +@deftypefn {Loadable Function} {@var{idx} =} lookup (@var{table}, @var{y})\n\ +@deftypefnx {Loadable Function} {@var{idx} =} lookup (@var{table}, @var{y}, @var{opt})\n\ Lookup values in a sorted table. Usually used as a prelude to\n\ interpolation.\n\ \n\ If table is increasing and @code{idx = lookup (table, y)}, then\n\ @code{table(idx(i)) <= y(i) < table(idx(i+1))} for all @code{y(i)}\n\ -within the table. If @code{y(i) < table (1)} then\n\ +within the table. If @code{y(i) < table(1)} then\n\ @code{idx(i)} is 0. If @code{y(i) >= table(end)} or @code{isnan (y(i))} then\n\ @code{idx(i)} is @code{n}.\n\ \n\ @@ -211,7 +212,7 @@ (or @var{y} can be a single string). In this case, string lookup\n\ is performed using lexicographical comparison.\n\ \n\ -If @var{opts} is specified, it shall be a string with letters indicating\n\ +If @var{opts} is specified, it must be a string with letters indicating\n\ additional options.\n\ \n\ @table @code\n\
--- a/src/DLD-FUNCTIONS/lsode.cc +++ b/src/DLD-FUNCTIONS/lsode.cc @@ -492,7 +492,7 @@ %% %% y1(t) = cos(t) %% y2(t) = sin(t) -%!function xdot = f (x, t) +%!function xdot = __f (x, t) %! xdot = [-x(2); x(1)]; %!test %! @@ -503,13 +503,13 @@ %! tol = 500 * lsode_options ("relative tolerance"); %! %! -%! x = lsode ("f", x0, t); +%! x = lsode ("__f", x0, t); %! %! y = [cos(t), sin(t)]; %! %! assert(all (all (abs (x - y) < tol))); -%!function xdotdot = f (x, t) +%!function xdotdot = __f (x, t) %! xdotdot = [x(2); -x(1)]; %!test %! @@ -517,13 +517,13 @@ %! t = [0; 2*pi]; %! tol = 100 * dassl_options ("relative tolerance"); %! -%! x = lsode ("f", x0, t); +%! x = lsode ("__f", x0, t); %! %! y = [1, 0; 1, 0]; %! %! assert(all (all (abs (x - y) < tol))); -%!function xdot = f (x, t) +%!function xdot = __f (x, t) %! xdot = x; %!test %! @@ -531,7 +531,7 @@ %! t = [0; 1]; %! tol = 100 * dassl_options ("relative tolerance"); %! -%! x = lsode ("f", x0, t); +%! x = lsode ("__f", x0, t); %! %! y = [1; e]; %! @@ -541,6 +541,6 @@ %! lsode_options ("absolute tolerance", eps); %! assert(lsode_options ("absolute tolerance") == eps); -%!error <Invalid call to lsode_options.*> lsode_options ("foo", 1, 2); +%!error <Invalid call to lsode_options> lsode_options ("foo", 1, 2); */
--- a/src/DLD-FUNCTIONS/lu.cc +++ b/src/DLD-FUNCTIONS/lu.cc @@ -580,7 +580,7 @@ %! assert(u, single([5, 6; 0, 4/5]), sqrt (eps('single'))); %! assert(p(:,:), single([0, 0, 1; 1, 0, 0; 0 1 0]), sqrt (eps('single'))); -%!error <Invalid call to lu.*> lu (); +%!error <Invalid call to lu> lu (); %!error lu ([1, 2; 3, 4], 2); */ @@ -616,7 +616,7 @@ @end example\n\ \n\ @noindent\n\ -then a factorization of @code{@var{A}+@var{x}*@var{y}.'} can be obtained\n\ +then a factorization of @xcode{@var{A}+@var{x}*@var{y}.'} can be obtained\n\ either as\n\ \n\ @example\n\
--- a/src/DLD-FUNCTIONS/luinc.cc +++ b/src/DLD-FUNCTIONS/luinc.cc @@ -110,7 +110,7 @@ bool udiag = false; Matrix thresh; double droptol = -1.; - bool vecout; + bool vecout = false; if (args(1).is_string ()) { @@ -236,7 +236,7 @@ if (vecout) retval(2) = fact.Pr_vec (); else - retval(2) = fact.Pr (); + retval(2) = fact.Pr_mat (); retval(1) = octave_value (fact.U (), MatrixType (MatrixType::Upper)); retval(0) = octave_value (fact.L (), @@ -260,8 +260,8 @@ } else { - retval(3) = fact.Pc (); - retval(2) = fact.Pr (); + retval(3) = fact.Pc_mat (); + retval(2) = fact.Pr_mat (); } retval(1) = octave_value (fact.U (), MatrixType (MatrixType::Upper)); @@ -319,7 +319,7 @@ if (vecout) retval(2) = fact.Pr_vec (); else - retval(2) = fact.Pr (); + retval(2) = fact.Pr_mat (); retval(1) = octave_value (fact.U (), MatrixType (MatrixType::Upper)); retval(0) = octave_value (fact.L (), @@ -343,8 +343,8 @@ } else { - retval(3) = fact.Pc (); - retval(2) = fact.Pr (); + retval(3) = fact.Pc_mat (); + retval(2) = fact.Pr_mat (); } retval(1) = octave_value (fact.U (), MatrixType (MatrixType::Upper));
--- a/src/DLD-FUNCTIONS/matrix_type.cc +++ b/src/DLD-FUNCTIONS/matrix_type.cc @@ -45,7 +45,7 @@ @deftypefnx {Loadable Function} {@var{A} =} matrix_type (@var{A}, 'lower', @var{perm})\n\ @deftypefnx {Loadable Function} {@var{A} =} matrix_type (@var{A}, 'banded', @var{nl}, @var{nu})\n\ Identify the matrix type or mark a matrix as a particular type. This allows\n\ -more rapid solutions of linear equations involving @var{A} to be performed. \n\ +more rapid solutions of linear equations involving @var{A} to be performed.\n\ Called with a single argument, @code{matrix_type} returns the type of the\n\ matrix and caches it for future use. Called with more than one argument,\n\ @code{matrix_type} allows the type of the matrix to be defined.\n\ @@ -99,7 +99,7 @@ \n\ Note that the matrix type will be discovered automatically on the first\n\ attempt to solve a linear equation involving @var{A}. Therefore\n\ -@code{matrix_type} is only useful to give Octave hints of the matrix type. \n\ +@code{matrix_type} is only useful to give Octave hints of the matrix type.\n\ Incorrectly defining the matrix type will result in incorrect results from\n\ solutions of linear equations; it is entirely @strong{the responsibility of\n\ the user} to correctly identify the matrix type.\n\
--- a/src/DLD-FUNCTIONS/max.cc +++ b/src/DLD-FUNCTIONS/max.cc @@ -178,7 +178,7 @@ } if (! args(1).is_empty ()) - warning ("%s: second argument is ignored"); + warning ("%s: second argument is ignored", func); } switch (arg.builtin_type ()) @@ -309,11 +309,13 @@ "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} min (@var{x})\n\ @deftypefnx {Loadable Function} {} min (@var{x}, @var{y})\n\ +@deftypefnx {Loadable Function} {} min (@var{x}, [], @var{dim})\n\ @deftypefnx {Loadable Function} {} min (@var{x}, @var{y}, @var{dim})\n\ @deftypefnx {Loadable Function} {[@var{w}, @var{iw}] =} min (@var{x})\n\ For a vector argument, return the minimum value. For a matrix\n\ argument, return the minimum value from each column, as a row\n\ -vector, or over the dimension @var{dim} if defined. For two matrices\n\ +vector, or over the dimension @var{dim} if defined, in which case @var{y} \n\ +should be set to the empty matrix (it's ignored otherwise). For two matrices\n\ (or a matrix and scalar), return the pair-wise minimum.\n\ Thus,\n\ \n\ @@ -365,10 +367,10 @@ %!assert(all (min ([4, i; -2, 2]) == [-2, i])); %% test/octave.test/arith/min-3.m -%!error <Invalid call to min.*> min (); +%!error <Invalid call to min> min (); %% test/octave.test/arith/min-4.m -%!error <Invalid call to min.*> min (1, 2, 3, 4); +%!error <Invalid call to min> min (1, 2, 3, 4); %!test %! x = reshape (1:8,[2,2,2]); @@ -386,11 +388,13 @@ "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} max (@var{x})\n\ @deftypefnx {Loadable Function} {} max (@var{x}, @var{y})\n\ +@deftypefnx {Loadable Function} {} max (@var{x}, [], @var{dim})\n\ @deftypefnx {Loadable Function} {} max (@var{x}, @var{y}, @var{dim})\n\ @deftypefnx {Loadable Function} {[@var{w}, @var{iw}] =} max (@var{x})\n\ For a vector argument, return the maximum value. For a matrix\n\ argument, return the maximum value from each column, as a row\n\ -vector, or over the dimension @var{dim} if defined. For two matrices\n\ +vector, or over the dimension @var{dim} if defined, in which case @var{y} \n\ +should be set to the empty matrix (it's ignored otherwise). For two matrices\n\ (or a matrix and scalar), return the pair-wise maximum.\n\ Thus,\n\ \n\ @@ -442,10 +446,10 @@ %!assert(all (max ([4, i 4.999; -2, 2, 3+4i]) == [4, 2, 3+4i])); %% test/octave.test/arith/max-3.m -%!error <Invalid call to max.*> max (); +%!error <Invalid call to max> max (); %% test/octave.test/arith/max-4.m -%!error <Invalid call to max.*> max (1, 2, 3, 4); +%!error <Invalid call to max> max (1, 2, 3, 4); %!test %! x = reshape (1:8,[2,2,2]);
new file mode 100644 --- /dev/null +++ b/src/DLD-FUNCTIONS/mgorth.cc @@ -0,0 +1,154 @@ +/* + +Copyright (C) 2009-2011 Carlo de Falco +Copyright (C) 2010 VZLU Prague + +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/>. + +*/ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include "oct-norm.h" +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" + +template <class ColumnVector, class Matrix, class RowVector> +static void +do_mgorth (ColumnVector& x, const Matrix& V, RowVector& h) +{ + octave_idx_type Vc = V.columns (); + h = RowVector (Vc + 1); + for (octave_idx_type j = 0; j < Vc; j++) + { + ColumnVector Vcj = V.column (j); + h(j) = RowVector (Vcj.hermitian ()) * x; + x -= h(j) * Vcj; + } + + h(Vc) = xnorm (x); + if (real (h(Vc)) > 0) + x = x / h(Vc); +} + +DEFUN_DLD (mgorth, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{y}, @var{h}] =} mgorth (@var{x}, @var{v})\n\ +Orthogonalize a given column vector @var{x} with respect to a given\n\ +orthonormal basis @var{v} using a modified Gram-Schmidt orthogonalization. \n\ +On exit, @var{y} is a unit vector such that:\n\ +\n\ +@example\n\ +@group\n\ + norm (@var{y}) = 1\n\ + @var{v}' * @var{y} = 0\n\ + @var{x} = @var{h}*[@var{v}, @var{y}]\n\ +@end group\n\ +@end example\n\ +\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length(); + + if (nargin != 2 || nargout > 2) + { + print_usage (); + return retval; + } + + octave_value arg_x = args(0); + octave_value arg_v = args(1); + + if (arg_v.ndims () != 2 || arg_x.ndims () != 2 || arg_x.columns () != 1 + || arg_v.rows () != arg_x.rows ()) + { + error ("mgorth: V should me a matrix, and X a column vector with" + " the same number of rows as V."); + return retval; + } + + if (! arg_x.is_numeric_type () && ! arg_v.is_numeric_type ()) + { + error ("mgorth: X and V must be numeric"); + } + + bool iscomplex = (arg_x.is_complex_type () || arg_v.is_complex_type ()); + if (arg_x.is_single_type () || arg_v.is_single_type ()) + { + if (iscomplex) + { + FloatComplexColumnVector x = arg_x.float_complex_column_vector_value (); + FloatComplexMatrix V = arg_v.float_complex_matrix_value (); + FloatComplexRowVector h; + do_mgorth (x, V, h); + retval(1) = h; + retval(0) = x; + } + else + { + FloatColumnVector x = arg_x.float_column_vector_value (); + FloatMatrix V = arg_v.float_matrix_value (); + FloatRowVector h; + do_mgorth (x, V, h); + retval(1) = h; + retval(0) = x; + } + } + else + { + if (iscomplex) + { + ComplexColumnVector x = arg_x.complex_column_vector_value (); + ComplexMatrix V = arg_v.complex_matrix_value (); + ComplexRowVector h; + do_mgorth (x, V, h); + retval(1) = h; + retval(0) = x; + } + else + { + ColumnVector x = arg_x.column_vector_value (); + Matrix V = arg_v.matrix_value (); + RowVector h; + do_mgorth (x, V, h); + retval(1) = h; + retval(0) = x; + } + } + + return retval; +} + +/* + +%!test +%! for ii=1:100; assert (abs (mgorth (randn (5, 1), eye (5, 4))), [0 0 0 0 1]', eps); endfor + +%!test +%! a = hilb (5); +%! a(:, 1) /= norm (a(:, 1)); +%! for ii = 1:5 +%! a(:, ii) = mgorth (a(:, ii), a(:, 1:ii-1)); +%! endfor +%! assert (a' * a, eye (5), 1e10); + +*/
--- a/src/DLD-FUNCTIONS/module-files +++ b/src/DLD-FUNCTIONS/module-files @@ -1,40 +1,42 @@ +# FILE|CPPFLAGS|LDFLAGS|LIBRARIES __contourc__.cc -__delaunayn__.cc +__delaunayn__.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) __dispatch__.cc __dsearchn__.cc -__fltk_uigetfile__.cc -__glpk__.cc -__init_fltk__.cc +__fltk_uigetfile__.cc|$(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS)|$(GRAPHICS_LDFLAGS) $(FT2_LDFLAGS)|$(GRAPHICS_LIBS) $(FT2_LIBS) +__glpk__.cc|$(GLPK_CPPFLAGS)|$(GLPK_LDFLAGS)|$(GLPK_LIBS) +__init_fltk__.cc|$(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS)|$(GRAPHICS_LDFLAGS) $(FT2_LDFLAGS)|$(GRAPHICS_LIBS) $(FT2_LIBS) +__init_gnuplot__.cc __lin_interpn__.cc -__magick_read__.cc +__magick_read__.cc|$(MAGICK_CPPFLAGS)|$(MAGICK_LDFLAGS)|$(MAGICK_LIBS) __pchip_deriv__.cc __qp__.cc -__voronoi__.cc -amd.cc +__voronoi__.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) +amd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) balance.cc besselj.cc betainc.cc bsxfun.cc -ccolamd.cc +ccolamd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) cellfun.cc -chol.cc -colamd.cc +chol.cc|$(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS)|$(QRUPDATE_LDFLAGS) $(SPARSE_XLDFLAGS)|$(QRUPDATE_LIBS) $(SPARSE_XLIBS) +colamd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) colloc.cc conv2.cc -convhulln.cc +convhulln.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) daspk.cc dasrt.cc dassl.cc det.cc dlmread.cc -dmperm.cc +dmperm.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) dot.cc eig.cc -eigs.cc -fft.cc -fft2.cc -fftn.cc -fftw.cc +eigs.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) $(LAPACK_LIBS) $(BLAS_LIBS) +fft.cc|$(FFTW_XCPPFLAGS)|$(FFTW_XLDFLAGS)|$(FFTW_XLIBS) +fft2.cc|$(FFTW_XCPPFLAGS)|$(FFTW_XLDFLAGS)|$(FFTW_XLIBS) +fftn.cc|$(FFTW_XCPPFLAGS)|$(FFTW_XLDFLAGS)|$(FFTW_XLIBS) +fftw.cc|$(FFTW_XCPPFLAGS)|$(FFTW_XLDFLAGS)|$(FFTW_XLIBS) filter.cc find.cc gammainc.cc @@ -54,15 +56,16 @@ matrix_type.cc max.cc md5sum.cc -onCleanup.cc +mgorth.cc +nproc.cc pinv.cc -qr.cc +qr.cc|$(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS)|$(QRUPDATE_LDFLAGS) $(SPARSE_XLDFLAGS)|$(QRUPDATE_LIBS) $(SPARSE_XLIBS) quad.cc quadcc.cc -qz.cc +qz.cc|||$(LAPACK_LIBS) $(BLAS_LIBS) rand.cc rcond.cc -regexp.cc +regexp.cc|$(REGEX_CPPFLAGS)|$(REGEX_LDFLAGS)|$(REGEX_LIBS) schur.cc spparms.cc sqrtm.cc @@ -71,10 +74,10 @@ sub2ind.cc svd.cc syl.cc -symbfact.cc -symrcm.cc +symbfact.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) +symrcm.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) time.cc tril.cc tsearch.cc typecast.cc -urlwrite.cc +urlwrite.cc|$(CURL_CPPFLAGS)|$(CURL_LDFLAGS)|$(CURL_LIBS)
new file mode 100644 --- /dev/null +++ b/src/DLD-FUNCTIONS/nproc.cc @@ -0,0 +1,91 @@ +/* + +Copyright (C) 2011 Iain Murray + +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/>. + +*/ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include "defun-dld.h" +#include "nproc.h" + +DEFUN_DLD (nproc, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} nproc ()\n\ +@deftypefnx {Loadable Function} {} nproc (@var{query})\n\ +Return the current number of available processors.\n\ +\n\ +If called with the optional argument @var{query}, modify how processors\n\ +are counted as follows:\n\ +@table @code\n\ +@item all\n\ +total number of processors.\n\ +\n\ +@item current\n\ +processors available to the current process.\n\ +\n\ +@item overridable\n\ +likewise, but overridable through the @w{@env{OMP_NUM_THREADS}} environment\n\ +variable.\n\ +@end table\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if ((nargin != 0 && nargin != 1) || (nargout != 0 && nargout != 1)) + { + print_usage (); + return retval; + } + + nproc_query query = NPROC_CURRENT; + if (nargin == 1) + { + std::string arg = args(0).string_value (); + + std::transform (arg.begin (), arg.end (), arg.begin (), tolower); + + if (arg == "all") + query = NPROC_ALL; + else if (arg == "current") + query = NPROC_CURRENT; + else if (arg == "overridable") + query = NPROC_CURRENT_OVERRIDABLE; + else + { + error ("nproc: invalid value for QUERY"); + return retval; + } + } + + retval = num_processors (query); + + return retval; +} + +/* + +%% Must always report at least 1 cpu available +%!assert (nproc () >= 1); + +*/
new file mode 100644 --- /dev/null +++ b/src/DLD-FUNCTIONS/oct-qhull.h @@ -0,0 +1,54 @@ +/* + +Copyright (C) 2011 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/>. + +*/ + +#if !defined (octave_oct_qhull_h) +#define octave_oct_qhull_h 1 + +#include <cstdio> + +extern "C" { + +#if defined (HAVE_QHULL_LIBQHULL_H) || defined (HAVE_QHULL_QHULL_H) +# if defined (HAVE_QHULL_LIBQHULL_H) +# include <qhull/libqhull.h> +# else +# include <qhull/qhull.h> +# endif +# include <qhull/qset.h> +# include <qhull/geom.h> +# include <qhull/poly.h> +# include <qhull/io.h> +#elif defined (HAVE_LIBQHULL_H) || defined (HAVE_QHULL_H) +# if defined (HAVE_LIBQHULL_H) +# include <libqhull.h> +# else +# include <qhull.h> +# endif +# include <qset.h> +# include <geom.h> +# include <poly.h> +# include <io.h> +#endif + +} + +#endif
deleted file mode 100644 --- a/src/DLD-FUNCTIONS/onCleanup.cc +++ /dev/null @@ -1,276 +0,0 @@ -/* - -Copyright (C) 2010-2011 VZLU Prague - -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/>. - -*/ - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include "defun-dld.h" -#include "ov-base.h" -#include "ov.h" -#include "ov-fcn.h" -#include "ov-usr-fcn.h" -#include "pt-misc.h" -#include "toplev.h" - -static void gripe_internal (void) -{ - error ("onCleanup: internal error: cloning nonempty object"); -} - -class octave_oncleanup : public octave_base_value, octave_auto_shlib -{ -public: - octave_oncleanup (void) : fcn () { } - octave_oncleanup (const octave_value& fcn); - - octave_base_value *clone (void) const - { - if (fcn.is_defined ()) - gripe_internal (); - return empty_clone (); - } - - octave_base_value *empty_clone (void) const { return new octave_oncleanup (); } - - ~octave_oncleanup (void); - - bool is_defined (void) const { return true; } - - bool is_object (void) const { return true; } // do we want this? - - octave_map map_value (void) const - { return scalar_map_value (); } - - octave_scalar_map scalar_map_value (void) const; - - dim_vector dims (void) const { static dim_vector dv (1, 1); return dv; } - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - -private: - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA - -protected: - - octave_value fcn; - -}; - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_oncleanup, "onCleanup", "onCleanup"); - -octave_oncleanup::octave_oncleanup (const octave_value& f) - : fcn (f) -{ - if (f.is_function_handle ()) - { - octave_function *fptr = f.function_value (true); - if (fptr) - { - octave_user_function *uptr = dynamic_cast<octave_user_function *> (fptr); - if (uptr != 0) - { - tree_parameter_list *pl = uptr->parameter_list (); - if (pl != 0 && pl->length () > 0) - warning ("onCleanup: cleanup action takes parameters"); - } - } - else - error ("onCleanup: no default dispatch for function handle"); - } - else - { - fcn = octave_value (); - error ("onCleanup: argument must be a function handle"); - } -} - -octave_oncleanup::~octave_oncleanup (void) -{ - if (fcn.is_undefined ()) - return; - - unwind_protect frame; - - // Clear interrupts. - frame.protect_var (octave_interrupt_state); - octave_interrupt_state = 0; - - // Disallow quit(). - frame.protect_var (quit_allowed); - quit_allowed = false; - - // Clear errors. - frame.protect_var (error_state); - error_state = 0; - - try - { - // Run the actual code. - fcn.do_multi_index_op (0, octave_value_list ()); - } - catch (octave_interrupt_exception) - { - // Swallow the interrupt. - warning ("onCleanup: interrupt occured in cleanup action"); - } - catch (std::bad_alloc) - { - // Swallow the exception. - warning ("onCleanup: out of memory occured in cleanup action"); - } - catch (...) // Yes, the black hole. We're in a d-tor. - { - // This shouldn't happen, in theory. - error ("onCleanup: internal error: unhandled exception in cleanup action"); - } - - // We don't want to ignore errors that occur in the cleanup code, so - // if an error is encountered there, leave error_state alone. - // Otherwise, set it back to what it was before. - if (error_state) - { - frame.discard_top (); - octave_call_stack::backtrace_error_message (); - } -} - -octave_scalar_map -octave_oncleanup::scalar_map_value (void) const -{ - octave_scalar_map retval; - retval.setfield ("task", fcn); - return retval; -} - -static void -warn_save_load (void) -{ - warning ("onCleanup: load and save not supported"); -} - -bool -octave_oncleanup::save_ascii (std::ostream& /* os */) -{ - warn_save_load (); - return true; -} - -bool -octave_oncleanup::load_ascii (std::istream& /* is */) -{ - warn_save_load (); - return true; -} - -bool -octave_oncleanup::save_binary (std::ostream& /* os */, bool& /* save_as_floats */) -{ - warn_save_load (); - return true; -} - - -bool -octave_oncleanup::load_binary (std::istream& /* is */, bool /* swap */, - oct_mach_info::float_format /* fmt */) -{ - warn_save_load (); - return true; -} - -#if defined (HAVE_HDF5) -bool -octave_oncleanup::save_hdf5 (hid_t /* loc_id */, const char * /* name */, - bool /* save_as_floats */) -{ - warn_save_load (); - return true; -} - -bool -octave_oncleanup::load_hdf5 (hid_t /* loc_id */, const char * /* name */) -{ - warn_save_load (); - return true; -} -#endif - -void -octave_oncleanup::print (std::ostream& os, bool pr_as_read_syntax) const -{ - print_raw (os, pr_as_read_syntax); - newline (os); -} - -void -octave_oncleanup::print_raw (std::ostream& os, bool pr_as_read_syntax) const -{ - os << "onCleanup ("; - if (fcn.is_defined ()) - fcn.print_raw (os, pr_as_read_syntax); - os << ")"; -} - -DEFUN_DLD (onCleanup, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{c} =} onCleanup (@var{action})\n\ -Create a special object that executes a given function upon destruction.\n\ -If the object is copied to multiple variables (or cell or struct array\n\ -elements) or returned from a function, @var{action} will be executed after\n\ -clearing the last copy of the object. Note that if multiple local onCleanup\n\ -variables are created, the order in which they are called is unspecified.\n\ -@seealso{unwind_protect}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - if (octave_oncleanup::static_type_id () < 0) - octave_oncleanup::register_type (); - - retval = new octave_oncleanup (args(0)); - } - else - print_usage (); - - return retval; -}
--- a/src/DLD-FUNCTIONS/pinv.cc +++ b/src/DLD-FUNCTIONS/pinv.cc @@ -41,9 +41,9 @@ @deftypefn {Loadable Function} {} pinv (@var{x})\n\ @deftypefnx {Loadable Function} {} pinv (@var{x}, @var{tol})\n\ Return the pseudoinverse of @var{x}. Singular values less than\n\ -@var{tol} are ignored. \n\ +@var{tol} are ignored.\n\ \n\ -If the second argument is omitted, it is assumed that\n\ +If the second argument is omitted, it is taken to be\n\ \n\ @example\n\ tol = max (size (@var{x})) * sigma_max (@var{x}) * eps,\n\ @@ -169,3 +169,23 @@ return retval; } + +/* +%!shared a, b, tol, hitol, d, u, x, y +%! a = reshape (rand*[1:16], 4, 4); ## Rank 2 matrix +%! b = pinv (a); +%! tol = 1e-14; +%! hitol = 15*sqrt(eps); +%! d = diag ([rand, rand, hitol, hitol]); +%! u = rand (4); ## Could be singular by freak accident +%! x = inv (u)*d*u; +%! y = pinv (x, sqrt(eps)); +%!assert(a*b*a, a, tol); +%!assert(b*a*b, b, tol); +%!assert((b*a)', b*a, tol); +%!assert((a*b)', a*b, tol); +%!assert(x*y*x, x, -hitol); +%!assert(y*x*y, y, -hitol); +%!assert((x*y)', x*y, hitol); +%!assert((y*x)', y*x, hitol); +*/
--- a/src/DLD-FUNCTIONS/qr.cc +++ b/src/DLD-FUNCTIONS/qr.cc @@ -76,6 +76,8 @@ "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {[@var{Q}, @var{R}, @var{P}] =} qr (@var{A})\n\ @deftypefnx {Loadable Function} {[@var{Q}, @var{R}, @var{P}] =} qr (@var{A}, '0')\n\ +@deftypefnx {Loadable Function} {[@var{C}, @var{R}] =} qr (@var{A}, @var{B})\n\ +@deftypefnx {Loadable Function} {[@var{C}, @var{R}] =} qr (@var{A}, @var{B}, '0')\n\ @cindex QR factorization\n\ Compute the QR@tie{}factorization of @var{A}, using standard @sc{lapack}\n\ subroutines. For example, given the matrix @code{@var{A} = [1, 2; 3, 4]},\n\ @@ -150,7 +152,7 @@ \n\ @example\n\ @group\n\ -@var{Q} = \n\ +@var{Q} =\n\ \n\ -0.44721 -0.89443\n\ -0.89443 0.44721\n\ @@ -188,7 +190,7 @@ \n\ @example\n\ @group\n\ -[@var{C},@var{R}] = spqr (@var{A},@var{B})\n\ +[@var{C}, @var{R}] = qr (@var{A}, @var{B})\n\ x = @var{R} \\ @var{C}\n\ @end group\n\ @end example\n\ @@ -495,10 +497,10 @@ %! assert (q * r, a * p, sqrt (eps)); %! assert (qe * re, a(:, pe), sqrt (eps)); -%!error <Invalid call to qr.*> qr (); -%!error <Invalid call to qr.*> qr ([1, 2; 3, 4], 0, 2); +%!error <Invalid call to qr> qr (); +%!error <Invalid call to qr> qr ([1, 2; 3, 4], 0, 2); -%!function retval = testqr (q, r, a, p) +%!function retval = __testqr (q, r, a, p) %! tol = 100*eps (class(q)); %! retval = 0; %! if (nargin == 3) @@ -516,6 +518,8 @@ %! retval = (retval && n2 < tol); %! endif %! endif +%!endfunction + %!test %! %! t = ones (24, 1); @@ -523,41 +527,41 @@ %! %! if false # eliminate big matrix tests %! a = rand(5000,20); -%! [q,r]=qr(a,0); t(j++) = testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = testqr(q,r,a',p); +%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); +%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); +%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); +%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); %! %! a = a+1i*eps; -%! [q,r]=qr(a,0); t(j++) = testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = testqr(q,r,a',p); +%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); +%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); +%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); +%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); %! endif %! %! a = [ ones(1,15); sqrt(eps)*eye(15) ]; -%! [q,r]=qr(a); t(j++) = testqr(q,r,a); -%! [q,r]=qr(a'); t(j++) = testqr(q,r,a'); -%! [q,r,p]=qr(a); t(j++) = testqr(q,r,a,p); -%! [q,r,p]=qr(a'); t(j++) = testqr(q,r,a',p); +%! [q,r]=qr(a); t(j++) = __testqr(q,r,a); +%! [q,r]=qr(a'); t(j++) = __testqr(q,r,a'); +%! [q,r,p]=qr(a); t(j++) = __testqr(q,r,a,p); +%! [q,r,p]=qr(a'); t(j++) = __testqr(q,r,a',p); %! %! a = a+1i*eps; -%! [q,r]=qr(a); t(j++) = testqr(q,r,a); -%! [q,r]=qr(a'); t(j++) = testqr(q,r,a'); -%! [q,r,p]=qr(a); t(j++) = testqr(q,r,a,p); -%! [q,r,p]=qr(a'); t(j++) = testqr(q,r,a',p); +%! [q,r]=qr(a); t(j++) = __testqr(q,r,a); +%! [q,r]=qr(a'); t(j++) = __testqr(q,r,a'); +%! [q,r,p]=qr(a); t(j++) = __testqr(q,r,a,p); +%! [q,r,p]=qr(a'); t(j++) = __testqr(q,r,a',p); %! %! a = [ ones(1,15); sqrt(eps)*eye(15) ]; -%! [q,r]=qr(a,0); t(j++) = testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = testqr(q,r,a',p); +%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); +%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); +%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); +%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); %! %! a = a+1i*eps; -%! [q,r]=qr(a,0); t(j++) = testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = testqr(q,r,a',p); +%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); +%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); +%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); +%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); %! %! a = [ %! 611 196 -192 407 -8 -52 -49 29 @@ -613,8 +617,8 @@ %! assert (q * r, a * p, sqrt (eps('single'))); %! assert (qe * re, a(:, pe), sqrt (eps('single'))); -%!error <Invalid call to qr.*> qr (); -%!error <Invalid call to qr.*> qr ([1, 2; 3, 4], 0, 2); +%!error <Invalid call to qr> qr (); +%!error <Invalid call to qr> qr ([1, 2; 3, 4], 0, 2); %!test %! @@ -623,41 +627,41 @@ %! %! if false # eliminate big matrix tests %! a = rand(5000,20); -%! [q,r]=qr(a,0); t(j++) = testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = testqr(q,r,a',p); +%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); +%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); +%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); +%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); %! %! a = a+1i*eps('single'); -%! [q,r]=qr(a,0); t(j++) = testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = testqr(q,r,a',p); +%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); +%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); +%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); +%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); %! endif %! %! a = [ ones(1,15); sqrt(eps('single'))*eye(15) ]; -%! [q,r]=qr(a); t(j++) = testqr(q,r,a); -%! [q,r]=qr(a'); t(j++) = testqr(q,r,a'); -%! [q,r,p]=qr(a); t(j++) = testqr(q,r,a,p); -%! [q,r,p]=qr(a'); t(j++) = testqr(q,r,a',p); +%! [q,r]=qr(a); t(j++) = __testqr(q,r,a); +%! [q,r]=qr(a'); t(j++) = __testqr(q,r,a'); +%! [q,r,p]=qr(a); t(j++) = __testqr(q,r,a,p); +%! [q,r,p]=qr(a'); t(j++) = __testqr(q,r,a',p); %! %! a = a+1i*eps('single'); -%! [q,r]=qr(a); t(j++) = testqr(q,r,a); -%! [q,r]=qr(a'); t(j++) = testqr(q,r,a'); -%! [q,r,p]=qr(a); t(j++) = testqr(q,r,a,p); -%! [q,r,p]=qr(a'); t(j++) = testqr(q,r,a',p); +%! [q,r]=qr(a); t(j++) = __testqr(q,r,a); +%! [q,r]=qr(a'); t(j++) = __testqr(q,r,a'); +%! [q,r,p]=qr(a); t(j++) = __testqr(q,r,a,p); +%! [q,r,p]=qr(a'); t(j++) = __testqr(q,r,a',p); %! %! a = [ ones(1,15); sqrt(eps('single'))*eye(15) ]; -%! [q,r]=qr(a,0); t(j++) = testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = testqr(q,r,a',p); +%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); +%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); +%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); +%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); %! %! a = a+1i*eps('single'); -%! [q,r]=qr(a,0); t(j++) = testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = testqr(q,r,a',p); +%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); +%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); +%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); +%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); %! %! a = [ %! 611 196 -192 407 -8 -52 -49 29 @@ -1172,7 +1176,7 @@ @var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization of\n\ @w{[A(:,1:j-1) A(:,j+1:n)]}, i.e., @var{A} with one column deleted\n\ (if @var{orient} is \"col\"), or the QR@tie{}factorization of\n\ -@w{[A(1:j-1,:);A(:,j+1:n)]}, i.e., @var{A} with one row deleted (if\n\ +@w{[A(1:j-1,:);A(j+1:n,:)]}, i.e., @var{A} with one row deleted (if\n \ @var{orient} is \"row\").\n\ \n\ The default value of @var{orient} is \"col\".\n\
--- a/src/DLD-FUNCTIONS/quad.cc +++ b/src/DLD-FUNCTIONS/quad.cc @@ -174,36 +174,31 @@ DEFUN_DLD (quad, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{v} =} quad (@var{f}, @var{a}, @var{b})\n\ -@deftypefnx {Loadable Function} {@var{v} =} quad (@var{f}, @var{a}, @var{b}, @var{tol})\n\ -@deftypefnx {Loadable Function} {@var{v} =} quad (@var{f}, @var{a}, @var{b}, @var{tol}, @var{sing})\n\ -@deftypefnx {Loadable Function} {[@var{v}, @var{ier}, @var{nfun}, @var{err}] =} quad (@dots{})\n\ -Integrate a nonlinear function of one variable using @sc{quadpack}.\n\ -The first argument is the name of the function, the function handle, or\n\ -the inline function to call to compute the value of the integrand. It\n\ -must have the form\n\ +@deftypefn {Loadable Function} {@var{q} =} quad (@var{f}, @var{a}, @var{b})\n\ +@deftypefnx {Loadable Function} {@var{q} =} quad (@var{f}, @var{a}, @var{b}, @var{tol})\n\ +@deftypefnx {Loadable Function} {@var{q} =} quad (@var{f}, @var{a}, @var{b}, @var{tol}, @var{sing})\n\ +@deftypefnx {Loadable Function} {[@var{q}, @var{ier}, @var{nfun}, @var{err}] =} quad (@dots{})\n\ +Numerically evaluate the integral of @var{f} from @var{a} to @var{b} using\n\ +Fortran routines from @w{@sc{quadpack}}. @var{f} is a function handle,\n\ +inline function, or a string containing the name of the function to\n\ +evaluate. The function must have the form @code{y = f (x)} where @var{y} and\n\ +@var{x} are scalars.\n\ \n\ -@example\n\ -y = f (x)\n\ -@end example\n\ -\n\ -@noindent\n\ -where @var{y} and @var{x} are scalars.\n\ -\n\ -The second and third arguments are limits of integration. Either or\n\ -both may be infinite.\n\ +@var{a} and @var{b} are the lower and upper limits of integration. Either\n\ +or both may be infinite.\n\ \n\ The optional argument @var{tol} is a vector that specifies the desired\n\ accuracy of the result. The first element of the vector is the desired\n\ absolute tolerance, and the second element is the desired relative\n\ tolerance. To choose a relative test only, set the absolute\n\ tolerance to zero. To choose an absolute test only, set the relative\n\ -tolerance to zero.\n\ +tolerance to zero. Both tolerances default to @code{sqrt(eps)} or\n\ +approximately @math{1.5e^{-8}}.\n\ \n\ The optional argument @var{sing} is a vector of values at which the\n\ integrand is known to be singular.\n\ \n\ -The result of the integration is returned in @var{v}. @var{ier}\n\ +The result of the integration is returned in @var{q}. @var{ier}\n\ contains an integer error code (0 indicates a successful integration).\n\ @var{nfun} indicates the number of function evaluations that were\n\ made, and @var{err} contains an estimate of the error in the\n\ @@ -212,8 +207,9 @@ The function @code{quad_options} can set other optional\n\ parameters for @code{quad}.\n\ \n\ -Note: because @code{quad} is written in Fortran it\n\ -cannot be called recursively.\n\ +Note: because @code{quad} is written in Fortran it cannot be called\n\ +recursively. This prevents its use in integrating over more than one\n\ +variable by routines @code{dblquad} and @code{triplequad}.\n\ @seealso{quad_options, quadv, quadl, quadgk, quadcc, trapz, dblquad, triplequad}\n\ @end deftypefn") { @@ -478,34 +474,38 @@ /* -%!function y = f (x) +%!function y = __f (x) %! y = x + 1; +%!endfunction + %!test -%! [v, ier, nfun, err] = quad ("f", 0, 5); +%! [v, ier, nfun, err] = quad ("__f", 0, 5); %! assert(ier == 0 && abs (v - 17.5) < sqrt (eps) && nfun > 0 && %! err < sqrt (eps)) %!test -%! [v, ier, nfun, err] = quad ("f", single(0), single(5)); +%! [v, ier, nfun, err] = quad ("__f", single(0), single(5)); %! assert(ier == 0 && abs (v - 17.5) < sqrt (eps ("single")) && nfun > 0 && %! err < sqrt (eps ("single"))) -%!function y = f (x) +%!function y = __f (x) %! y = x .* sin (1 ./ x) .* sqrt (abs (1 - x)); +%!endfunction + %!test -%! [v, ier, nfun, err] = quad ("f", 0.001, 3); +%! [v, ier, nfun, err] = quad ("__f", 0.001, 3); %! assert((ier == 0 || ier == 1) && abs (v - 1.98194120273598) < sqrt (eps) && nfun > 0); %!test -%! [v, ier, nfun, err] = quad ("f", single(0.001), single(3)); +%! [v, ier, nfun, err] = quad ("__f", single(0.001), single(3)); %! assert((ier == 0 || ier == 1) && abs (v - 1.98194120273598) < sqrt (eps ("single")) && nfun > 0); -%!error <Invalid call to quad.*> quad (); +%!error <Invalid call to quad> quad (); -%!error <Invalid call to quad.*> quad ("f", 1, 2, 3, 4, 5); +%!error <Invalid call to quad> quad ("__f", 1, 2, 3, 4, 5); %!test %! quad_options ("absolute tolerance", eps); %! assert(quad_options ("absolute tolerance") == eps); -%!error <Invalid call to quad_options.*> quad_options (1, 2, 3); +%!error <Invalid call to quad_options> quad_options (1, 2, 3); */
--- a/src/DLD-FUNCTIONS/quadcc.cc +++ b/src/DLD-FUNCTIONS/quadcc.cc @@ -50,8 +50,7 @@ int depth, rdepth, ndiv; } cquad_ival; -/* Some constants and matrices that we'll need. - */ +/* Some constants and matrices that we'll need. */ static const double xi[33] = { -1., -0.99518472667219688624, -0.98078528040323044912, @@ -1473,79 +1472,77 @@ } - -/* The actual integration routine. - */ +/* The actual integration routine. */ DEFUN_DLD (quadcc, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Function File} {[@var{int}, @var{err}, @var{nr_points}] =} quadcc (@var{f}, @var{a}, @var{b}, @var{tol})\n\ -@deftypefnx {Function File} {[@var{int}, @var{err}, @var{nr_points}] =} quadcc (@var{f}, @var{a}, @var{b}, @var{tol}, @var{sing})\n\ -Numerically evaluates an integral using the doubly-adaptive\n\ -quadrature described by P. Gonnet in @cite{Increasing the\n\ -Reliability of Adaptive Quadrature Using Explicit Interpolants},\n\ -ACM Transactions on Mathematical Software, in Press, 2010.\n\ -The algorithm uses Clenshaw-Curtis quadrature rules of increasing\n\ -degree in each interval and bisects the interval if either the\n\ -function does not appear to be smooth or a rule of maximum\n\ -degree has been reached. The error estimate is computed from the\n\ -L2-norm of the difference between two successive interpolations\n\ -of the integrand over the nodes of the respective quadrature rules.\n\ -\n\ -For example,\n\ +@deftypefn {Function File} {@var{q} =} quadcc (@var{f}, @var{a}, @var{b})\n\ +@deftypefnx {Function File} {@var{q} =} quadcc (@var{f}, @var{a}, @var{b}, @var{tol})\n\ +@deftypefnx {Function File} {@var{q} =} quadcc (@var{f}, @var{a}, @var{b}, @var{tol}, @var{sing})\n\ +@deftypefnx {Function File} {[@var{q}, @var{err}, @var{nr_points}] =} quadcc (@dots{})\n\ +Numerically evaluate the integral of @var{f} from @var{a} to @var{b}\n\ +using the doubly-adaptive Clenshaw-Curtis quadrature described by P. Gonnet\n\ +in @cite{Increasing the Reliability of Adaptive Quadrature Using Explicit\n\ +Interpolants}.\n\ +@var{f} is a function handle, inline function, or string\n\ +containing the name of the function to evaluate.\n\ +The function @var{f} must be vectorized and must return a vector of output\n\ +values if given a vector of input values. For example,\n\ \n\ @example\n\ - int = quadcc (f, a, b, 1.0e-6);\n\ + f = @@(x) x .* sin (1./x) .* sqrt (abs (1 - x));\n\ @end example\n\ \n\ @noindent\n\ -computes the integral of a function @var{f} in the interval\n\ -[@var{a}, @var{b}] to the relative precision of six\n\ -decimal digits.\n\ -The integrand @var{f} should accept a vector argument and return a vector\n\ -result containing the integrand evaluated at each element of the\n\ -argument, for example:\n\ +which uses the element-by-element `dot' form for all operators.\n\ +\n\ +@var{a} and @var{b} are the lower and upper limits of integration. Either\n\ +or both limits may be infinite. @code{quadcc} handles an inifinite limit\n\ +by substituting the variable of integration with @code{x=tan(pi/2*u)}.\n\ \n\ -@example\n\ - f = @@(x) x .* sin (1 ./ x) .* sqrt (abs (1 - x));\n\ -@end example\n\ +The optional argument @var{tol} defines the relative tolerance used to stop\n\ +the integration procedure. The default value is @math{1e^{-6}}.\n\ \n\ -If the integrand has known singularities or discontinuities\n\ -in any of its derivatives inside the interval,\n\ -as does the above example at x=1, these can be specified in\n\ -the additional argument @var{sing} as follows\n\ +The optional argument @var{sing} contains a list of points where the\n\ +integrand has known singularities, or discontinuities\n\ +in any of its derivatives, inside the integration interval.\n\ +For the example above, which has a discontinuity at x=1, the call to\n\ +@code{quadcc} would be as follows\n\ \n\ @example\n\ int = quadcc (f, a, b, 1.0e-6, [ 1 ]);\n\ @end example\n\ \n\ -The two additional output variables @var{err} and @var{nr_points}\n\ -return an estimate of the absolute integration error and\n\ -the number of points at which the integrand was evaluated\n\ -respectively.\n\ +The result of the integration is returned in @var{q}.\n\ +@var{err} is an estimate of the absolute integration error and\n\ +@var{nr_points} is the number of points at which the integrand was evaluated.\n\ If the adaptive integration did not converge, the value of\n\ -@var{err} will be larger than the requested tolerance. It is\n\ -therefore recommended to verify this value for difficult\n\ -integrands.\n\ -\n\ -If either @var{a} or @var{b} are @code{+/-Inf}, @code{quadcc}\n\ -integrates @var{f} by substituting the variable of integration\n\ -with @code{x=tan(pi/2*u)}.\n\ +@var{err} will be larger than the requested tolerance. Therefore, it is\n\ +recommended to verify this value for difficult integrands.\n\ \n\ @code{quadcc} is capable of dealing with non-numeric\n\ -values of the integrand such as @code{NaN}, @code{Inf}\n\ -or @code{-Inf}, as in the above example at x=0.\n\ -If the integral diverges and @code{quadcc} detects this, \n\ -a warning is issued and @code{Inf} or @code{-Inf} is returned.\n\ +values of the integrand such as @code{NaN} or @code{Inf}.\n\ +If the integral diverges, and @code{quadcc} detects this,\n\ +then a warning is issued and @code{Inf} or @code{-Inf} is returned.\n\ +\n\ +Note: @code{quadcc} is a general purpose quadrature algorithm\n\ +and, as such, may be less efficient for a smooth or otherwise\n\ +well-behaved integrand than other methods such as @code{quadgk}.\n\ \n\ -Note that @code{quadcc} is a general purpose quadrature algorithm\n\ -and as such may be less efficient for smooth or otherwise\n\ -well-behaved integrand than other methods such as\n\ -@code{quadgk} or @code{trapz}.\n\ +The algorithm uses Clenshaw-Curtis quadrature rules of increasing\n\ +degree in each interval and bisects the interval if either the\n\ +function does not appear to be smooth or a rule of maximum\n\ +degree has been reached. The error estimate is computed from the\n\ +L2-norm of the difference between two successive interpolations\n\ +of the integrand over the nodes of the respective quadrature rules.\n\ \n\ +Reference: P. Gonnet, @cite{Increasing the Reliability of Adaptive\n\ +Quadrature Using Explicit Interpolants}, ACM Transactions on\n\ +Mathematical Software, Vol. 37, Issue 3, Article No. 3, 2010.\n\ @seealso{quad, quadv, quadl, quadgk, trapz, dblquad, triplequad}\n\ @end deftypefn") { + octave_value_list retval; /* Some constants that we will need. */ static const int n[4] = { 4, 8, 16, 32 }; @@ -1564,15 +1561,15 @@ double a, b, tol, iivals[cquad_heapsize], *sing; /* Variables needed for transforming the integrand. */ - int wrap = 0; + bool wrap = false; double xw; /* Stuff we will need to call the integrand. */ - octave_value_list fargs, retval; + octave_value_list fargs, fvals; /* Actual variables (as opposed to constants above). */ double m, h, ml, hl, mr, hr, temp; - double igral, err, igral_final, err_final, err_excess; + double igral, err, igral_final, err_final; int nivals, neval = 0; int i, j, d, split, t; int nnans, nans[33]; @@ -1581,48 +1578,49 @@ /* Parse the input arguments. */ - if (nargin < 1) + if (nargin < 3) { - error - ("quadcc: first argument (integrand) of type function handle required"); - return octave_value_list (); + print_usage (); + return retval; } + + if (args(0).is_function_handle () || args(0).is_inline_function ()) + fcn = args(0).function_value (); else { - if (args (0).is_function_handle () || args (0).is_inline_function ()) - fcn = args (0).function_value (); - else - { - error ("quadcc: first argument (integrand) must be a function handle or an inline function"); - return octave_value_list(); - } + std::string fcn_name = unique_symbol_name ("__quadcc_fcn_"); + std::string fname = "function y = "; + fname.append (fcn_name); + fname.append ("(x) y = "); + fcn = extract_function (args(0), "quadcc", fcn_name, fname, + "; endfunction"); } - if (nargin < 2 || !args (1).is_real_scalar ()) + if (!args(1).is_real_scalar ()) { - error ("quadcc: second argument (left interval edge) must be a single real scalar"); - return octave_value_list (); + error ("quadcc: lower limit of integration (A) must be a single real scalar"); + return retval; } else - a = args (1).double_value (); + a = args(1).double_value (); - if (nargin < 3 || !args (2).is_real_scalar ()) + if (!args(2).is_real_scalar ()) { - error ("quadcc: third argument (right interval edge) must be a single real scalar"); - return octave_value_list (); + error ("quadcc: upper limit of integration (B) must be a single real scalar"); + return retval; } else - b = args (2).double_value (); + b = args(2).double_value (); - if (nargin < 4) + if (nargin < 4 || args(3).is_empty ()) tol = 1.0e-6; - else if (!args (3).is_real_scalar ()) + else if (!args(3).is_real_scalar () || args(3).double_value () <= 0) { - error ("quadcc: fourth argument (tolerance) must be a single real scalar"); - return octave_value_list (); + error ("quadcc: tolerance (TOL) must be a single real scalar > 0"); + return retval; } else - tol = args (3).double_value (); + tol = args(3).double_value (); if (nargin < 5) { @@ -1630,20 +1628,21 @@ iivals[0] = a; iivals[1] = b; } - else if (!(args (4).is_real_scalar () || args (4).is_real_matrix ())) + else if (!(args(4).is_real_scalar () || args(4).is_real_matrix ())) { - error ("quadcc: fifth argument (singularities) must be a vector of real values"); - return octave_value_list (); + error ("quadcc: list of singularities (SING) must be a vector of real values"); + return retval; } else { - nivals = 1 + args (4).length (); - if ( nivals > cquad_heapsize ) { - error ("quadcc: maximum number of singular points is limited to %i", - cquad_heapsize-1); - return octave_value_list(); + nivals = 1 + args(4).length (); + if (nivals > cquad_heapsize) + { + error ("quadcc: maximum number of singular points is limited to %i", + cquad_heapsize-1); + return retval; } - sing = args (4).array_value ().fortran_vec (); + sing = args(4).array_value ().fortran_vec (); iivals[0] = a; for (i = 0; i < nivals - 2; i++) iivals[i + 1] = sing[i]; @@ -1653,7 +1652,7 @@ /* If a or b are +/-Inf, transform the integral. */ if (xisinf (a) || xisinf (b)) { - wrap = 1; + wrap = true; for (i = 0; i <= nivals; i++) if (xisinf (iivals[i])) iivals[i] = copysign (1.0, iivals[i]); @@ -1689,19 +1688,18 @@ for (i = 0; i <= n[3]; i++) ex (i) = m + xi[i] * h; } - fargs (0) = ex; - retval = feval (fcn, fargs, 1); - if (retval.length () != 1 || !retval (0).is_real_matrix ()) + fargs(0) = ex; + fvals = feval (fcn, fargs, 1); + if (fvals.length () != 1 || !fvals(0).is_real_matrix ()) { - error - ("quadcc: integrand must return a single, real-valued vector"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector"); + return retval; } - Matrix effex = retval (0).matrix_value (); + Matrix effex = fvals(0).matrix_value (); if (effex.length () != ex.length ()) { - error ("quadcc: integrand must return a single, real-valued vector of the same size as the input"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector of the same size as the input"); + return retval; } for (i = 0; i <= n[3]; i++) { @@ -1768,7 +1766,6 @@ /* Initialize some global values. */ igral_final = 0.0; err_final = 0.0; - err_excess = 0.0; /* Main loop. */ @@ -1810,18 +1807,18 @@ for (i = 0; i < n[d] / 2; i++) ex (i) = m + xi[(2 * i + 1) * skip[d]] * h; } - fargs (0) = ex; - retval = feval (fcn, fargs, 1); - if (retval.length () != 1 || !retval (0).is_real_matrix ()) + fargs(0) = ex; + fvals = feval (fcn, fargs, 1); + if (fvals.length () != 1 || !fvals(0).is_real_matrix ()) { - error ("quadcc: integrand must return a single, real-valued vector"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector"); + return retval; } - Matrix effex = retval (0).matrix_value (); + Matrix effex = fvals(0).matrix_value (); if (effex.length () != ex.length ()) { - error ("quadcc: integrand must return a single, real-valued vector of the same size as the input"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector of the same size as the input"); + return retval; } neval += effex.length (); for (i = 0; i < n[d] / 2; i++) @@ -1958,18 +1955,18 @@ for (i = 0; i < n[0] - 1; i++) ex (i) = ml + xi[(i + 1) * skip[0]] * hl; } - fargs (0) = ex; - retval = feval (fcn, fargs, 1); - if (retval.length () != 1 || !retval (0).is_real_matrix ()) + fargs(0) = ex; + fvals = feval (fcn, fargs, 1); + if (fvals.length () != 1 || !fvals(0).is_real_matrix ()) { - error ("quadcc: integrand must return a single, real-valued vector"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector"); + return retval; } - Matrix effex = retval (0).matrix_value (); + Matrix effex = fvals(0).matrix_value (); if (effex.length () != ex.length ()) { - error ("quadcc: integrand must return a single, real-valued vector of the same size as the input"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector of the same size as the input"); + return retval; } neval += effex.length (); for (i = 0; i < n[0] - 1; i++) @@ -2054,18 +2051,18 @@ for (i = 0; i < n[0] - 1; i++) ex (i) = mr + xi[(i + 1) * skip[0]] * hr; } - fargs (0) = ex; - retval = feval (fcn, fargs, 1); - if (retval.length () != 1 || !retval (0).is_real_matrix ()) + fargs(0) = ex; + fvals = feval (fcn, fargs, 1); + if (fvals.length () != 1 || !fvals(0).is_real_matrix ()) { - error ("quadcc: integrand must return a single, real-valued vector"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector"); + return retval; } - Matrix effex = retval (0).matrix_value (); + Matrix effex = fvals(0).matrix_value (); if (effex.length () != ex.length ()) { - error ("quadcc: integrand must return a single, real-valued vector of the same size as the input"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector of the same size as the input"); + return retval; } neval += effex.length (); for (i = 0; i < n[0] - 1; i++) @@ -2235,11 +2232,39 @@ } */ /* Clean up and present the results. */ - retval (0) = igral; + if (nargout > 2) + retval(2) = neval; if (nargout > 1) - retval (1) = err; - if (nargout > 2) - retval (2) = neval; + retval(1) = err; + retval(0) = igral; /* All is well that ends well. */ return retval; } + + +/* + +%!assert (quadcc(@sin,-pi,pi), 0, 1e-6) +%!assert (quadcc(inline('sin'),-pi,pi), 0, 1e-6) +%!assert (quadcc('sin',-pi,pi), 0, 1e-6) + +%!assert (quadcc(@sin,-pi,0), -2, 1e-6) +%!assert (quadcc(@sin,0,pi), 2, 1e-6) +%!assert (quadcc(@(x) 1./sqrt(x), 0, 1), 2, 1e-6) +%!assert (quadcc(@(x) 1./(sqrt(x).*(x+1)), 0, Inf), pi, 1e-6) + +%!assert (quadcc (@(x) exp(-x .^ 2), -Inf, Inf), sqrt(pi), 1e-6) +%!assert (quadcc (@(x) exp(-x .^ 2), -Inf, 0), sqrt(pi)/2, 1e-6) + +%% Test input validation +%!error (quadcc ()) +%!error (quadcc (@sin)) +%!error (quadcc (@sin, 0)) +%!error (quadcc (@sin, ones(2), pi)) +%!error (quadcc (@sin, -i, pi)) +%!error (quadcc (@sin, 0, ones(2))) +%!error (quadcc (@sin, 0, i)) +%!error (quadcc (@sin, 0, pi, 0)) +%!error (quadcc (@sin, 0, pi, 1e-6, [ i ])) + +*/
--- a/src/DLD-FUNCTIONS/qz.cc +++ b/src/DLD-FUNCTIONS/qz.cc @@ -287,6 +287,9 @@ return (fabs (p) >= 1 ? 1 : -1); } + +//FIXME: Matlab does not produce lambda as the first output argument. +// Compatibility problem? DEFUN_DLD (qz, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {@var{lambda} =} qz (@var{A}, @var{B})\n\ @@ -307,7 +310,7 @@ \n\ @item @code{[AA, BB, Q, Z, V, W, @var{lambda}] = qz (@var{A}, @var{B})}\n\ \n\ -Computes QZ@tie{}decomposition, generalized eigenvectors, and \n\ +Computes QZ@tie{}decomposition, generalized eigenvectors, and\n\ generalized eigenvalues of @math{(A - s B)}\n\ @tex\n\ $$ AV = BV{ \\rm diag }(\\lambda) $$\n\ @@ -343,13 +346,13 @@ of the revised pencil contains all eigenvalues that satisfy:\n\ @table @asis\n\ @item \"N\"\n\ -= unordered (default) \n\ += unordered (default)\n\ \n\ @item \"S\"\n\ -= small: leading block has all |lambda| @leq{} 1 \n\ += small: leading block has all |lambda| @leq{} 1\n\ \n\ @item \"B\"\n\ -= big: leading block has all |lambda| @geq{} 1 \n\ += big: leading block has all |lambda| @geq{} 1\n\ \n\ @item \"-\"\n\ = negative real part: leading block has all eigenvalues\n\ @@ -1236,3 +1239,30 @@ return retval; } + +/* +%!shared a, b, c +%! a = [1 2; 0 3]; +%! b = [1 0; 0 0]; +%! c = [0 1; 0 0]; +%!assert(qz (a,b), 1); +%!assert(isempty (qz (a,c))); + +%% Exaple 7.7.3 in Golub & Van Loan +%!test +%! a = [ 10 1 2; +%! 1 2 -1; +%! 1 1 2]; +%! b = reshape(1:9,3,3); +%! [aa, bb, q, z, v, w, lambda] = qz (a, b); +%! sz = length(lambda); +%! observed = (b * v * diag ([lambda;0])) (:, 1:sz); +%! assert ( (a*v) (:, 1:sz), observed, norm (observed) * 1e-14); +%! observed = (diag ([lambda;0]) * w' * b) (1:sz, :); +%! assert ( (w'*a) (1:sz, :) , observed, norm (observed) * 1e-13); +%! assert (q * a * z, aa, norm (aa) * 1e-14); +%! assert (q * b * z, bb, norm (bb) * 1e-14); + +%% FIXME: Still need a test for third form of calling qz + +*/
--- a/src/DLD-FUNCTIONS/rand.cc +++ b/src/DLD-FUNCTIONS/rand.cc @@ -26,7 +26,11 @@ #endif #include <ctime> - +#if defined (HAVE_UNORDERED_MAP) +#include <unordered_map> +#elif defined (HAVE_TR1_UNORDERED_MAP) +#include <tr1/unordered_map> +#endif #include <string> #include "f77-fcn.h" @@ -177,20 +181,17 @@ octave_idx_type base = NINTbig (r.base ()); octave_idx_type incr = NINTbig (r.inc ()); - octave_idx_type lim = NINTbig (r.limit ()); - if (base < 0 || lim < 0) - error ("%s: all dimensions must be positive", fcn); - else + for (octave_idx_type i = 0; i < n; i++) { - for (octave_idx_type i = 0; i < n; i++) - { - dims(i) = base; - base += incr; - } + //Negative dimensions are treated as zero for Matlab + //compatibility + dims(i) = base >= 0 ? base : 0; + base += incr; + } - goto gen_matrix; - } + goto gen_matrix; + } else error ("%s: all elements of range must be integers", @@ -208,15 +209,10 @@ for (octave_idx_type i = 0; i < len; i++) { + //Negative dimensions are treated as zero for Matlab + //compatibility octave_idx_type elt = iv(i); - - if (elt < 0) - { - error ("%s: all dimensions must be positive", fcn); - goto done; - } - - dims(i) = iv(i); + dims(i) = elt >=0 ? elt : 0; } goto gen_matrix; @@ -278,13 +274,14 @@ for (int i = 0; i < nargin; i++) { - dims(i) = args(idx+i).int_value (); - + octave_idx_type elt = args(idx+i).int_value (); if (error_state) { error ("%s: expecting integer arguments", fcn); goto done; } + //Negative is zero for Matlab compatibility + dims(i) = elt >= 0 ? elt : 0; } goto gen_matrix; @@ -326,8 +323,9 @@ DEFUN_DLD (rand, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} rand (@var{x})\n\ -@deftypefnx {Loadable Function} {} rand (@var{n}, @var{m})\n\ +@deftypefn {Loadable Function} {} rand (@var{n})\n\ +@deftypefnx {Loadable Function} {} rand (@var{n}, @var{m}, @dots{})\n\ +@deftypefnx {Loadable Function} {} rand ([@var{n} @var{m} @dots{}])\n\ @deftypefnx {Loadable Function} {@var{v} =} rand (\"state\")\n\ @deftypefnx {Loadable Function} {} rand (\"state\", @var{v})\n\ @deftypefnx {Loadable Function} {} rand (\"state\", \"reset\")\n\ @@ -359,13 +357,13 @@ value of @var{v}, not @var{v} itself.\n\ \n\ By default, the generator is initialized from @code{/dev/urandom} if it is\n\ -available, otherwise from CPU time, wall clock time and the current\n\ +available, otherwise from CPU time, wall clock time, and the current\n\ fraction of a second.\n\ \n\ To compute the pseudo-random sequence, @code{rand} uses the Mersenne\n\ Twister with a period of @math{2^{19937}-1} (See M. Matsumoto and\n\ T. Nishimura,\n\ -@cite{Mersenne Twister: A 623-dimensionally equidistributed uniform \n\ +@cite{Mersenne Twister: A 623-dimensionally equidistributed uniform\n\ pseudorandom number generator}, ACM Trans. on\n\ Modeling and Computer Simulation Vol. 8, No. 1, pp. 3-30, January 1998,\n\ @url{http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/emt.html}).\n\ @@ -490,8 +488,9 @@ DEFUN_DLD (randn, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} randn (@var{x})\n\ -@deftypefnx {Loadable Function} {} randn (@var{n}, @var{m})\n\ +@deftypefn {Loadable Function} {} randn (@var{n})\n\ +@deftypefnx {Loadable Function} {} randn (@var{n}, @var{m}, @dots{})\n\ +@deftypefnx {Loadable Function} {} randn ([@var{n} @var{m} @dots{}])\n\ @deftypefnx {Loadable Function} {@var{v} =} randn (\"state\")\n\ @deftypefnx {Loadable Function} {} randn (\"state\", @var{v})\n\ @deftypefnx {Loadable Function} {} randn (\"state\", \"reset\")\n\ @@ -555,8 +554,9 @@ DEFUN_DLD (rande, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} rande (@var{x})\n\ -@deftypefnx {Loadable Function} {} rande (@var{n}, @var{m})\n\ +@deftypefn {Loadable Function} {} rande (@var{n})\n\ +@deftypefnx {Loadable Function} {} rande (@var{n}, @var{m}, @dots{})\n\ +@deftypefnx {Loadable Function} {} rande ([@var{n} @var{m} @dots{}])\n\ @deftypefnx {Loadable Function} {@var{v} =} rande (\"state\")\n\ @deftypefnx {Loadable Function} {} rande (\"state\", @var{v})\n\ @deftypefnx {Loadable Function} {} rande (\"state\", \"reset\")\n\ @@ -621,8 +621,9 @@ DEFUN_DLD (randg, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} randg (@var{a}, @var{x})\n\ -@deftypefnx {Loadable Function} {} randg (@var{a}, @var{n}, @var{m})\n\ +@deftypefn {Loadable Function} {} randg (@var{n})\n\ +@deftypefnx {Loadable Function} {} randg (@var{n}, @var{m}, @dots{})\n\ +@deftypefnx {Loadable Function} {} randg ([@var{n} @var{m} @dots{}])\n\ @deftypefnx {Loadable Function} {@var{v} =} randg (\"state\")\n\ @deftypefnx {Loadable Function} {} randg (\"state\", @var{v})\n\ @deftypefnx {Loadable Function} {} randg (\"state\", \"reset\")\n\ @@ -663,7 +664,7 @@ r = 2 * randg (df / 2)\n\ @end example\n\ \n\ -@item @code{t(df)} for @code{0 < df < inf} (use randn if df is infinite)\n\ +@item @code{t (df)} for @code{0 < df < inf} (use randn if df is infinite)\n\ \n\ @example\n\ r = randn () / sqrt (2 * randg (df / 2) / df)\n\ @@ -877,8 +878,9 @@ DEFUN_DLD (randp, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} randp (@var{l}, @var{x})\n\ -@deftypefnx {Loadable Function} {} randp (@var{l}, @var{n}, @var{m})\n\ +@deftypefn {Loadable Function} {} randp (@var{l}, @var{n})\n\ +@deftypefnx {Loadable Function} {} randp (@var{l}, @var{n}, @var{m}, @dots{})\n\ +@deftypefnx {Loadable Function} {} randp (@var{l}, [@var{n} @var{m} @dots{}])\n\ @deftypefnx {Loadable Function} {@var{v} =} randp (\"state\")\n\ @deftypefnx {Loadable Function} {} randp (\"state\", @var{v})\n\ @deftypefnx {Loadable Function} {} randp (\"state\", \"reset\")\n\ @@ -1021,13 +1023,21 @@ @deftypefn {Loadable Function} {} randperm (@var{n})\n\ @deftypefnx {Loadable Function} {} randperm (@var{n}, @var{m})\n\ Return a row vector containing a random permutation of @code{1:@var{n}}.\n\ -If @var{m} is supplied, return @var{m} permutations,\n\ -one in each row of an @nospell{NxM} matrix. The complexity is O(M*N) in both\n\ -time and memory. The randomization is performed using rand().\n\ -All permutations are equally likely.\n\ +If @var{m} is supplied, return @var{m} unique entries, sampled without\n\ +replacement from @code{1:@var{n}}. The complexity is O(@var{n}) in\n\ +memory and O(@var{m}) in time, unless @var{m} < @var{n}/5, in which case\n\ +O(@var{m}) memory is used as well. The randomization is performed using\n\ +rand(). All permutations are equally likely.\n\ @seealso{perms}\n\ @end deftypefn") { + +#ifdef USE_UNORDERED_MAP_WITH_TR1 +using std::tr1::unordered_map; +#else +using std::unordered_map; +#endif + int nargin = args.length (); octave_value retval; @@ -1035,54 +1045,75 @@ { octave_idx_type n, m; + n = args(0).idx_type_value (true); + if (nargin == 2) m = args(1).idx_type_value (true); else - m = 1; - - n = args(0).idx_type_value (true); + m = n; if (m < 0 || n < 0) error ("randperm: M and N must be non-negative"); + if (m > n) + error ("randperm: M must be less than or equal to N"); + + // Quick and dirty heuristic to decide if we allocate or not the + // whole vector for tracking the truncated shuffle. + bool short_shuffle = m < n/5 && m < 1e5; + if (! error_state) { // Generate random numbers. - NDArray r = octave_rand::nd_array (dim_vector (m, n)); - - // Create transposed to allow faster access. - Array<octave_idx_type> idx (dim_vector (n, m)); - + NDArray r = octave_rand::nd_array (dim_vector (1, m)); double *rvec = r.fortran_vec (); + octave_idx_type idx_len = short_shuffle ? m : n; + Array<octave_idx_type> idx (dim_vector (1, idx_len)); octave_idx_type *ivec = idx.fortran_vec (); - // Perform the Knuth shuffle. - for (octave_idx_type j = 0; j < m; j++) + for (octave_idx_type i = 0; i < idx_len; i++) + ivec[i] = i; + + if (short_shuffle) { - for (octave_idx_type i = 0; i < n; i++) - ivec[i] = i; + unordered_map<octave_idx_type, octave_idx_type> map (m); + + // Perform the Knuth shuffle only keeping track of moved + // entries in the map + for (octave_idx_type i = 0; i < m; i++) + { + octave_idx_type k = i + + gnulib::floor (rvec[i] * (n - i)); - for (octave_idx_type i = 0; i < n; i++) + if (map.find(k) == map.end()) + { + map[k] = ivec[i]; + ivec[i] = k; + } + else + std::swap (ivec[i], map[k]); + + } + } + else + { + + // Perform the Knuth shuffle of the first m entries + for (octave_idx_type i = 0; i < m; i++) { - octave_idx_type k = i + gnulib::floor (rvec[i] * (n - i)); + octave_idx_type k = i + + gnulib::floor (rvec[i] * (n - i)); std::swap (ivec[i], ivec[k]); } - - ivec += n; - rvec += n; } - // Transpose. - idx = idx.transpose (); + // Convert to doubles, reusing r. + for (octave_idx_type i = 0; i < m; i++) + rvec[i] = ivec[i] + 1; - // Re-fetch the pointers. - ivec = idx.fortran_vec (); - rvec = r.fortran_vec (); - - // Convert to doubles, reusing r. - for (octave_idx_type i = 0, l = m*n; i < l; i++) - rvec[i] = ivec[i] + 1; + if (m < n) + idx.resize (dim_vector (1, m)); // Now create an array object with a cached idx_vector. retval = new octave_matrix (r, idx_vector (idx)); @@ -1095,6 +1126,6 @@ } /* -%!assert(sort(randperm(20)),1:20) -%!assert(sort(randperm(20,50),2),repmat(1:20,50,1)) +%!assert(sort (randperm (20)),1:20) +%!assert(length (randperm (20,10)), 10) */
--- a/src/DLD-FUNCTIONS/rcond.cc +++ b/src/DLD-FUNCTIONS/rcond.cc @@ -85,3 +85,12 @@ return retval; } + +/* + +%!assert( rcond (eye (2)), 1) +%!assert( rcond (ones (2)), 0) +%!assert( rcond ([1 1; 2 1]), 1/9) +%!assert( rcond (magic (4)), 0, eps) + +*/
--- a/src/DLD-FUNCTIONS/regexp.cc +++ b/src/DLD-FUNCTIONS/regexp.cc @@ -25,471 +25,106 @@ #include <config.h> #endif -#include <algorithm> +#include <list> #include <sstream> -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "utils.h" - -#include "Cell.h" -#include "oct-map.h" -#include "str-vec.h" -#include "quit.h" -#include "parse.h" -#include "oct-locbuf.h" - #include <pcre.h> -// Define the maximum number of retries for a pattern that -// possibly results in an infinite recursion. -#define PCRE_MATCHLIMIT_MAX 10 - -// The regexp is constructed as a linked list to avoid resizing the -// return values in arrays at each new match. - -// FIXME don't bother collecting and composing return values the user -// doesn't want. - -class regexp_elem -{ -public: - regexp_elem (const string_vector& _named_token, const Cell& _t, - const std::string& _m, const Matrix& _te, double _s, - double _e) : - named_token (_named_token), t (_t), m (_m), te (_te), s (_s), e (_e) { } - - regexp_elem (const regexp_elem &a) : named_token (a.named_token), t (a.t), - m (a.m), te (a.te), s (a.s), e (a.e) - { } - - string_vector named_token; - Cell t; - std::string m; - Matrix te; - double s; - double e; -}; - -typedef std::list<regexp_elem>::const_iterator const_iterator; - -#define MAXLOOKBEHIND 10 -static bool lookbehind_warned = false; +#include "base-list.h" +#include "oct-locbuf.h" +#include "quit.h" +#include "regexp.h" +#include "str-vec.h" -static int -octregexp_list (const octave_value_list &args, const std::string &nm, - bool case_insensitive, std::list<regexp_elem> &lst, - string_vector &named, int &nopts, bool &once) -{ - int sz = 0; - - int nargin = args.length(); - bool lineanchors = false; - bool dotexceptnewline = false; - bool freespacing = false; - - nopts = nargin - 2; - once = false; +#include "defun-dld.h" +#include "Cell.h" +#include "error.h" +#include "gripes.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "utils.h" - std::string buffer = args(0).string_value (); - size_t max_length = (buffer.length () > MAXLOOKBEHIND ? - MAXLOOKBEHIND: buffer.length ()); - - if (error_state) - { - gripe_wrong_type_arg (nm.c_str(), args(0)); - return 0; - } +static void +parse_options (regexp::opts& options, const octave_value_list& args, + const std::string& who, int skip, bool& extra_args) +{ + int nargin = args.length (); - std::string pattern = args(1).string_value (); - if (error_state) + extra_args = false; + + for (int i = skip; i < nargin; i++) { - gripe_wrong_type_arg (nm.c_str(), args(1)); - return 0; - } + std::string str = args(i).string_value (); - for (int i = 2; i < nargin; i++) - { - std::string str = args(i).string_value(); if (error_state) { - error ("%s: optional arguments must be strings", nm.c_str()); + error ("%s: optional arguments must be character strings", + who.c_str ()); break; } - std::transform (str.begin (), str.end (), str.begin (), tolower); - if (str.find("once", 0) == 0) - { - once = true; - nopts--; - } - else if (str.find("matchcase", 0) == 0) - { - case_insensitive = false; - nopts--; - } - else if (str.find("ignorecase", 0) == 0) - { - case_insensitive = true; - nopts--; - } - else if (str.find("dotall", 0) == 0) - { - dotexceptnewline = false; - nopts--; - } - else if (str.find("stringanchors", 0) == 0) - { - lineanchors = false; - nopts--; - } - else if (str.find("literalspacing", 0) == 0) - { - freespacing = false; - nopts--; - } - // Only accept these options with pcre - else if (str.find("dotexceptnewline", 0) == 0) - { - dotexceptnewline = true; - nopts--; - } - else if (str.find("lineanchors", 0) == 0) - { - lineanchors = true; - nopts--; - } - else if (str.find("freespacing", 0) == 0) - { - freespacing = true; - nopts--; - } - else if (str.find("start", 0) && str.find("end", 0) && - str.find("tokenextents", 0) && str.find("match", 0) && - str.find("tokens", 0) && str.find("names", 0)) - error ("%s: unrecognized option", nm.c_str()); - } - - if (!error_state) - { - Cell t; - std::string m; - double s, e; - - // named tokens "(?<name>...)" are only treated with PCRE not regex. - - size_t pos = 0; - size_t new_pos; - int nnames = 0; - int inames = 0; - std::ostringstream buf; - Array<int> named_idx; - - while ((new_pos = pattern.find ("(?",pos)) != std::string::npos) - { - if (pattern.at (new_pos + 2) == '<' && - !(pattern.at (new_pos + 3) == '=' || - pattern.at (new_pos + 3) == '!')) - { - // The syntax of named tokens in pcre is "(?P<name>...)" while - // we need a syntax "(?<name>...)", so fix that here. Also an - // expression like - // "(?<first>\w+)\s+(?<last>\w+)|(?<last>\w+),\s+(?<first>\w+)" - // should be perfectly legal, while pcre does not allow the same - // named token name on both sides of the alternative. Also fix - // that here by replacing name tokens by dummy names, and dealing - // with the dummy names later. - - size_t tmp_pos = pattern.find_first_of ('>',new_pos); - - if (tmp_pos == std::string::npos) - { - error ("regexp: syntax error in pattern"); - break; - } - - std::string tmp_name = - pattern.substr(new_pos+3,tmp_pos-new_pos-3); - bool found = false; - - for (int i = 0; i < nnames; i++) - if (named(i) == tmp_name) - { - named_idx.resize (dim_vector (inames+1, 1)); - named_idx(inames) = i; - found = true; - break; - } - if (! found) - { - named_idx.resize (dim_vector (inames+1, 1)); - named_idx(inames) = nnames; - named.append(tmp_name); - nnames++; - } - - if (new_pos - pos > 0) - buf << pattern.substr(pos,new_pos-pos); - if (inames < 10) - buf << "(?P<n00" << inames++; - else if (inames < 100) - buf << "(?P<n0" << inames++; - else - buf << "(?P<n" << inames++; - pos = tmp_pos; - } - else if (pattern.at (new_pos + 2) == '<') - { - // Find lookbehind operators of arbitrary length (ie like - // "(?<=[a-z]*)") and replace with a maximum length operator - // as PCRE can not yet handle arbitrary length lookahead - // operators. Use the string length as the maximum length to - // avoid issues. - - int brackets = 1; - size_t tmp_pos1 = new_pos + 2; - size_t tmp_pos2 = tmp_pos1; - while (tmp_pos1 <= pattern.length () && brackets > 0) - { - char ch = pattern.at (tmp_pos1); - if (ch == '(') - brackets++; - else if (ch == ')') - { - if (brackets > 1) - tmp_pos2 = tmp_pos1; - - brackets--; - } - tmp_pos1++; - } - - if (brackets != 0) - { - buf << pattern.substr (pos, new_pos - pos) << "(?"; - pos = new_pos + 2; - } - else - { - size_t tmp_pos3 = pattern.find_first_of ("*+", tmp_pos2); - if (tmp_pos3 != std::string::npos && tmp_pos3 < tmp_pos1) - { - if (!lookbehind_warned) - { - lookbehind_warned = true; - warning ("%s: arbitrary length lookbehind patterns are only supported up to length %d", nm.c_str(), MAXLOOKBEHIND); - } - - buf << pattern.substr (pos, new_pos - pos) << "("; - - size_t i; - if (pattern.at (tmp_pos3) == '*') - i = 0; - else - i = 1; - - for (; i < max_length + 1; i++) - { - buf << pattern.substr(new_pos, tmp_pos3 - new_pos) - << "{" << i << "}"; - buf << pattern.substr(tmp_pos3 + 1, - tmp_pos1 - tmp_pos3 - 1); - if (i != max_length) - buf << "|"; - } - buf << ")"; - } - else - buf << pattern.substr (pos, tmp_pos1 - pos); - pos = tmp_pos1; - } - } - else - { - buf << pattern.substr (pos, new_pos - pos) << "(?"; - pos = new_pos + 2; - } - - } + std::transform (str.begin (), str.end (), str.begin (), tolower); - buf << pattern.substr(pos); - - if (error_state) - return 0; - - // Compile expression - pcre *re; - const char *err; - int erroffset; - std::string buf_str = buf.str (); - re = pcre_compile (buf_str.c_str (), - (case_insensitive ? PCRE_CASELESS : 0) | - (dotexceptnewline ? 0 : PCRE_DOTALL) | - (lineanchors ? PCRE_MULTILINE : 0) | - (freespacing ? PCRE_EXTENDED : 0), - &err, &erroffset, 0); - - if (re == 0) - { - error("%s: %s at position %d of expression", nm.c_str(), - err, erroffset); - return 0; - } - - int subpatterns; - int namecount; - int nameentrysize; - char *nametable; - int idx = 0; - - pcre_fullinfo(re, 0, PCRE_INFO_CAPTURECOUNT, &subpatterns); - pcre_fullinfo(re, 0, PCRE_INFO_NAMECOUNT, &namecount); - pcre_fullinfo(re, 0, PCRE_INFO_NAMEENTRYSIZE, &nameentrysize); - pcre_fullinfo(re, 0, PCRE_INFO_NAMETABLE, &nametable); - - OCTAVE_LOCAL_BUFFER(int, ovector, (subpatterns+1)*3); - OCTAVE_LOCAL_BUFFER(int, nidx, namecount); - - for (int i = 0; i < namecount; i++) - { - // Index of subpattern in first two bytes MSB first of name. - // Extract index. - nidx[i] = (static_cast<int>(nametable[i*nameentrysize])) << 8 | - static_cast<int>(nametable[i*nameentrysize+1]); - } - - while(true) - { - OCTAVE_QUIT; - - int matches = pcre_exec(re, 0, buffer.c_str(), - buffer.length(), idx, - (idx ? PCRE_NOTBOL : 0), - ovector, (subpatterns+1)*3); - - if (matches == PCRE_ERROR_MATCHLIMIT) - { - // try harder; start with default value for MATCH_LIMIT and increase it - warning ("your pattern caused PCRE to hit its MATCH_LIMIT; trying harder now, but this will be slow"); - pcre_extra pe; - pcre_config(PCRE_CONFIG_MATCH_LIMIT, static_cast <void *> (&pe.match_limit)); - pe.flags = PCRE_EXTRA_MATCH_LIMIT; - - int i = 0; - while (matches == PCRE_ERROR_MATCHLIMIT && - i++ < PCRE_MATCHLIMIT_MAX) - { - OCTAVE_QUIT; - - pe.match_limit *= 10; - matches = pcre_exec(re, &pe, buffer.c_str(), - buffer.length(), idx, - (idx ? PCRE_NOTBOL : 0), - ovector, (subpatterns+1)*3); - } - } - - if (matches < 0 && matches != PCRE_ERROR_NOMATCH) - { - error ("%s: internal error calling pcre_exec; error code from pcre_exec is %i", - nm.c_str(), matches); - pcre_free(re); - return 0; - } - else if (matches == PCRE_ERROR_NOMATCH) - break; - else if (ovector[1] <= ovector[0]) - { - // FIXME: Zero sized match!! Is this the right thing to do? - idx = ovector[0] + 1; - continue; - } - else - { - int pos_match = 0; - Matrix te(matches-1,2); - for (int i = 1; i < matches; i++) - if (ovector[2*i] >= 0 && ovector[2*i+1] > 0) - if (i == 1 || ovector[2*i] != ovector[2*i-2] - || ovector[2*i-1] != ovector[2*i+1]) - { - if (ovector[2*i] >= 0 && ovector[2*i+1] > 0) - { - te(pos_match,0) = double (ovector[2*i]+1); - te(pos_match++,1) = double (ovector[2*i+1]); - } - } - te.resize(pos_match,2); - s = double (ovector[0]+1); - e = double (ovector[1]); - - const char **listptr; - int status = pcre_get_substring_list(buffer.c_str(), ovector, - matches, &listptr); - - if (status == PCRE_ERROR_NOMEMORY) - { - error("%s: cannot allocate memory in pcre_get_substring_list", - nm.c_str()); - pcre_free(re); - return 0; - } - - Cell cell_t (dim_vector(1,pos_match)); - string_vector named_tokens(nnames); - int pos_offset = 0; - pos_match = 0; - for (int i = 1; i < matches; i++) - if (ovector[2*i] >= 0 && ovector[2*i+1] > 0) - { - if (i == 1 || ovector[2*i] != ovector[2*i-2] - || ovector[2*i-1] != ovector[2*i+1]) - { - if (namecount > 0) - named_tokens(named_idx(i-pos_offset-1)) = - std::string(*(listptr+nidx[i-pos_offset-1])); - cell_t(pos_match++) = - std::string(*(listptr+i)); - } - else - pos_offset++; - } - - m = std::string(*listptr); - t = cell_t; - - pcre_free_substring_list(listptr); - - regexp_elem new_elem (named_tokens, t, m, te, s, e); - lst.push_back (new_elem); - idx = ovector[1]; - sz++; - - if (once || idx >= buffer.length ()) - break; - - } - } - - pcre_free(re); + if (str.find ("once", 0) == 0) + options.once (true); + else if (str.find ("matchcase", 0) == 0) + options.case_insensitive (false); + else if (str.find ("ignorecase", 0) == 0) + options.case_insensitive (true); + else if (str.find ("dotall", 0) == 0) + options.dotexceptnewline (false); + else if (str.find ("stringanchors", 0) == 0) + options.lineanchors (false); + else if (str.find ("literalspacing", 0) == 0) + options.freespacing (false); + else if (str.find ("dotexceptnewline", 0) == 0) + options.dotexceptnewline (true); + else if (str.find ("lineanchors", 0) == 0) + options.lineanchors (true); + else if (str.find ("freespacing", 0) == 0) + options.freespacing (true); + else if (str.find ("start", 0) == 0 + || str.find ("end", 0) == 0 + || str.find ("tokenextents", 0) == 0 + || str.find ("match", 0) == 0 + || str.find ("tokens", 0) == 0 + || str.find ("names", 0) == 0 + || str.find ("split", 0) == 0) + extra_args = true; + else + error ("%s: unrecognized option", who.c_str ()); } - - return sz; } static octave_value_list -octregexp (const octave_value_list &args, int nargout, const std::string &nm, - bool case_insensitive) +octregexp (const octave_value_list &args, int nargout, + const std::string &who, bool case_insensitive = false) { octave_value_list retval; - int nargin = args.length(); - std::list<regexp_elem> lst; - string_vector named; - int nopts; - bool once; - int sz = octregexp_list (args, nm, case_insensitive, lst, named, nopts, once); + + int nargin = args.length (); + + // Make sure we have string, pattern + const std::string buffer = args(0).string_value (); + if (error_state) + return retval; + + const std::string pattern = args(1).string_value (); + if (error_state) + return retval; + + regexp::opts options; + options.case_insensitive (case_insensitive); + bool extra_options = false; + parse_options (options, args, who, 2, extra_options); + if (error_state) + return retval; + + regexp::match_data rx_lst = regexp_match (pattern, buffer, options, who); + + string_vector named_pats = rx_lst.named_patterns (); + + size_t sz = rx_lst.size (); if (! error_state) { @@ -498,97 +133,111 @@ octave_idx_type i = 0; octave_scalar_map nmap; + retval.resize (7); + if (sz == 1) { - for (int j = 0; j < named.length(); j++) - nmap.assign (named(j), lst.begin()->named_token(j)); + string_vector named_tokens = rx_lst.begin()->named_tokens (); + + for (int j = 0; j < named_pats.length (); j++) + nmap.assign (named_pats(j), named_tokens(j)); + retval(5) = nmap; } else { - for (int j = 0; j < named.length (); j++) + for (int j = 0; j < named_pats.length (); j++) { + Cell tmp (dim_vector (1, sz)); + i = 0; - Cell tmp(dim_vector (1, sz)); - for (const_iterator p = lst.begin(); p != lst.end(); p++) - tmp(i++) = p->named_token(j); - nmap.assign (named(j), octave_value (tmp)); + for (regexp::match_data::const_iterator p = rx_lst.begin (); + p != rx_lst.end (); p++) + { + string_vector named_tokens = p->named_tokens (); + + tmp(i++) = named_tokens(j); + } + + nmap.assign (named_pats(j), octave_value (tmp)); } + retval(5) = nmap; } - if (once) - retval(4) = sz ? lst.front ().t : Cell(); - else - { - Cell t (dim_vector(1, sz)); - i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) - t(i++) = p->t; - retval(4) = t; - } - - if (once) - retval(3) = sz ? lst.front ().m : std::string(); - else + if (options.once ()) { - Cell m (dim_vector(1, sz)); - i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) - m(i++) = p->m; - retval(3) = m; - } + regexp::match_data::const_iterator p = rx_lst.begin (); + + retval(4) = sz ? p->tokens () : Cell (); + retval(3) = sz ? p->match_string () : std::string (); + retval(2) = sz ? p->token_extents () : Matrix (); + + if (sz) + { + double start = p->start (); + double end = p->end (); - if (once) - retval(2) = sz ? lst.front ().te : Matrix(); - else - { - Cell te (dim_vector(1, sz)); - i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) - te(i++) = p->te; - retval(2) = te; - } + Cell split (dim_vector (1, 2)); + split(0) = buffer.substr (0, start-1); + split(1) = buffer.substr (end); - if (once) - { - if (sz) - retval(1) = lst.front ().e; + retval(6) = split; + retval(1) = end; + retval(0) = start; + } else - retval(1) = Matrix(); + { + retval(6) = buffer; + retval(1) = Matrix (); + retval(0) = Matrix (); + } } else { - NDArray e (dim_vector(1, sz)); - i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) - e(i++) = p->e; - retval(1) = e; - } - - if (once) - { - if (sz) - retval(0) = lst.front ().s; - else - retval(0) = Matrix(); - } - else - { - NDArray s (dim_vector(1, sz)); + Cell tokens (dim_vector (1, sz)); + Cell match_string (dim_vector (1, sz)); + Cell token_extents (dim_vector (1, sz)); + NDArray end (dim_vector (1, sz)); + NDArray start (dim_vector (1, sz)); + Cell split (dim_vector (1, sz+1)); + size_t sp_start = 0; i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) - s(i++) = p->s; - retval(0) = s; + for (regexp::match_data::const_iterator p = rx_lst.begin (); + p != rx_lst.end (); p++) + { + double s = p->start (); + double e = p->end (); + + string_vector tmp = p->tokens (); + tokens(i) = Cell (dim_vector (1, tmp.length ()), tmp); + match_string(i) = p->match_string (); + token_extents(i) = p->token_extents (); + end(i) = e; + start(i) = s; + split(i) = buffer.substr (sp_start, s-sp_start-1); + sp_start = e; + i++; + } + + split(i) = buffer.substr (sp_start); + + retval(6) = split; + retval(4) = tokens; + retval(3) = match_string; + retval(2) = token_extents; + retval(1) = end; + retval(0) = start; } // Alter the order of the output arguments - if (nopts > 0) + + if (extra_options) { int n = 0; octave_value_list new_retval; - new_retval.resize(nargout); + new_retval.resize (nargout); OCTAVE_LOCAL_BUFFER (int, arg_used, 6); for (int j = 0; j < 6; j++) @@ -597,31 +246,33 @@ for (int j = 2; j < nargin; j++) { int k = 0; - std::string str = args(j).string_value(); + std::string str = args(j).string_value (); std::transform (str.begin (), str.end (), str.begin (), tolower); - if (str.find("once", 0) == 0 - || str.find("stringanchors", 0) == 0 - || str.find("lineanchors", 0) == 0 - || str.find("matchcase", 0) == 0 - || str.find("ignorecase", 0) == 0 - || str.find("dotall", 0) == 0 - || str.find("dotexceptnewline", 0) == 0 - || str.find("literalspacing", 0) == 0 - || str.find("freespacing", 0) == 0 - ) + + if (str.find ("once", 0) == 0 + || str.find ("stringanchors", 0) == 0 + || str.find ("lineanchors", 0) == 0 + || str.find ("matchcase", 0) == 0 + || str.find ("ignorecase", 0) == 0 + || str.find ("dotall", 0) == 0 + || str.find ("dotexceptnewline", 0) == 0 + || str.find ("literalspacing", 0) == 0 + || str.find ("freespacing", 0) == 0) continue; - else if (str.find("start", 0) == 0) + else if (str.find ("start", 0) == 0) k = 0; - else if (str.find("end", 0) == 0) + else if (str.find ("end", 0) == 0) k = 1; - else if (str.find("tokenextents", 0) == 0) + else if (str.find ("tokenextents", 0) == 0) k = 2; - else if (str.find("match", 0) == 0) + else if (str.find ("match", 0) == 0) k = 3; - else if (str.find("tokens", 0) == 0) + else if (str.find ("tokens", 0) == 0) k = 4; - else if (str.find("names", 0) == 0) + else if (str.find ("names", 0) == 0) k = 5; + else if (str.find ("split", 0) == 0) + k = 6; new_retval(n++) = retval(k); arg_used[k] = true; @@ -648,31 +299,31 @@ } static octave_value_list -octcellregexp (const octave_value_list &args, int nargout, const std::string &nm, - bool case_insensitive) +octcellregexp (const octave_value_list &args, int nargout, + const std::string &who, bool case_insensitive = false) { octave_value_list retval; - if (args(0).is_cell()) + if (args(0).is_cell ()) { OCTAVE_LOCAL_BUFFER (Cell, newretval, nargout); octave_value_list new_args = args; - Cell cellstr = args(0).cell_value(); - if (args(1).is_cell()) + Cell cellstr = args(0).cell_value (); + if (args(1).is_cell ()) { - Cell cellpat = args(1).cell_value(); + Cell cellpat = args(1).cell_value (); - if (cellpat.numel() == 1) + if (cellpat.numel () == 1) { for (int j = 0; j < nargout; j++) - newretval[j].resize(cellstr.dims()); + newretval[j].resize (cellstr.dims ()); new_args(1) = cellpat(0); for (octave_idx_type i = 0; i < cellstr.numel (); i++) { new_args(0) = cellstr(i); - octave_value_list tmp = octregexp (new_args, nargout, nm, + octave_value_list tmp = octregexp (new_args, nargout, who, case_insensitive); if (error_state) @@ -682,17 +333,17 @@ newretval[j](i) = tmp(j); } } - else if (cellstr.numel() == 1) + else if (cellstr.numel () == 1) { for (int j = 0; j < nargout; j++) - newretval[j].resize(cellpat.dims()); + newretval[j].resize (cellpat.dims ()); new_args(0) = cellstr(0); for (octave_idx_type i = 0; i < cellpat.numel (); i++) { new_args(1) = cellpat(i); - octave_value_list tmp = octregexp (new_args, nargout, nm, + octave_value_list tmp = octregexp (new_args, nargout, who, case_insensitive); if (error_state) @@ -702,22 +353,22 @@ newretval[j](i) = tmp(j); } } - else if (cellstr.numel() == cellpat.numel()) + else if (cellstr.numel () == cellpat.numel ()) { - if (cellstr.dims() != cellpat.dims()) - error ("%s: Inconsistent cell array dimensions", nm.c_str()); + if (cellstr.dims () != cellpat.dims ()) + error ("%s: inconsistent cell array dimensions", who.c_str ()); else { for (int j = 0; j < nargout; j++) - newretval[j].resize(cellstr.dims()); + newretval[j].resize (cellstr.dims ()); for (octave_idx_type i = 0; i < cellstr.numel (); i++) { new_args(0) = cellstr(i); new_args(1) = cellpat(i); - octave_value_list tmp = octregexp (new_args, nargout, nm, + octave_value_list tmp = octregexp (new_args, nargout, who, case_insensitive); if (error_state) @@ -734,12 +385,13 @@ else { for (int j = 0; j < nargout; j++) - newretval[j].resize(cellstr.dims()); + newretval[j].resize (cellstr.dims ()); for (octave_idx_type i = 0; i < cellstr.numel (); i++) { new_args(0) = cellstr(i); - octave_value_list tmp = octregexp (new_args, nargout, nm, case_insensitive); + octave_value_list tmp = octregexp (new_args, nargout, who, + case_insensitive); if (error_state) break; @@ -753,19 +405,20 @@ for (int j = 0; j < nargout; j++) retval(j) = octave_value (newretval[j]); } - else if (args(1).is_cell()) + else if (args(1).is_cell ()) { OCTAVE_LOCAL_BUFFER (Cell, newretval, nargout); octave_value_list new_args = args; - Cell cellpat = args(1).cell_value(); + Cell cellpat = args(1).cell_value (); for (int j = 0; j < nargout; j++) - newretval[j].resize(cellpat.dims()); + newretval[j].resize(cellpat.dims ()); for (octave_idx_type i = 0; i < cellpat.numel (); i++) { new_args(1) = cellpat(i); - octave_value_list tmp = octregexp (new_args, nargout, nm, case_insensitive); + octave_value_list tmp = octregexp (new_args, nargout, who, + case_insensitive); if (error_state) break; @@ -775,11 +428,13 @@ } if (!error_state) - for (int j = 0; j < nargout; j++) - retval(j) = octave_value (newretval[j]); + { + for (int j = 0; j < nargout; j++) + retval(j) = octave_value (newretval[j]); + } } else - retval = octregexp (args, nargout, nm, case_insensitive); + retval = octregexp (args, nargout, who, case_insensitive); return retval; @@ -904,6 +559,9 @@ A structure containing the text of each matched named token, with the name\n\ being used as the fieldname. A named token is denoted by\n\ @code{(?<name>@dots{})}.\n\ +\n\ +@item sp\n\ +A cell array of the text not returned by match.\n\ @end table\n\ \n\ Particular output arguments, or the order of the output arguments, can be\n\ @@ -918,6 +576,7 @@ @item @tab 'match' @tab @var{m} @tab\n\ @item @tab 'tokens' @tab @var{t} @tab\n\ @item @tab 'names' @tab @var{nm} @tab\n\ +@item @tab 'split' @tab @var{sp} @tab\n\ @end multitable\n\ \n\ Additional arguments are summarized below.\n\ @@ -937,7 +596,7 @@ Alternatively, use (?i) in the pattern.\n\ \n\ @item stringanchors\n\ -Match the anchor characters at the beginning and end of the string. \n\ +Match the anchor characters at the beginning and end of the string.\n\ (default)\n\ \n\ Alternatively, use (?-m) in the pattern.\n\ @@ -975,14 +634,15 @@ @end deftypefn") { octave_value_list retval; - int nargin = args.length(); + + int nargin = args.length (); if (nargin < 2) print_usage (); - else if (args(0).is_cell() || args(1).is_cell()) - retval = octcellregexp (args, nargout, "regexp", false); + else if (args(0).is_cell () || args(1).is_cell ()) + retval = octcellregexp (args, nargout, "regexp"); else - retval = octregexp (args, nargout, "regexp", false); + retval = octregexp (args, nargout, "regexp"); return retval; } @@ -1002,6 +662,8 @@ ## seg-fault test %!assert(regexp("abcde","."),[1,2,3,4,5]) +## Infinite loop test +%!assert (isempty (regexp("abcde", ""))) ## Check that anchoring of pattern works correctly %!assert(regexp('abcabc','^abc'),1); @@ -1156,6 +818,45 @@ %! assert(regexp("qit",'q(?=u*)','match'), {'q'}) %! assert(regexp('thingamabob','(?<=a)b'), 9) +## Tests for split option. +%!shared str +%! str = "foo bar foo"; +%!test +%! [a, b] = regexp (str, "f..", "match", "split"); +%! assert (a, {"foo", "foo"}); +%! assert (b, {"", " bar ", ""}); +%!test +%! [a, b] = regexp (str, "f..", "match", "split", "once"); +%! assert (a, "foo"); +%! assert (b, {"", " bar foo"}); +%!test +%! [a, b] = regexp (str, "fx.", "match", "split"); +%! assert (a, cell (1, 0)); +%! assert (b, {"foo bar foo"}); +%!test +%! [a, b] = regexp (str, "fx.", "match", "split", "once"); +%! assert (a, ""); +%! assert (b, "foo bar foo") + +%!shared str +%! str = "foo bar"; +%!test +%! [a, b] = regexp (str, "f..", "match", "split"); +%! assert (a, {"foo"}); +%! assert (b, {"", " bar"}); +%!test +%! [a, b] = regexp (str, "b..", "match", "split"); +%! assert (a, {"bar"}); +%! assert (b, {"foo ", ""}); +%!test +%! [a, b] = regexp (str, "x", "match", "split"); +%! assert (a, cell (1, 0)); +%! assert (b, {"foo bar"}); +%!test +%! [a, b] = regexp (str, "[o]+", "match", "split"); +%! assert (a, {"oo"}); +%! assert (b, {"f", " bar"}); + */ DEFUN_DLD (regexpi, args, nargout, @@ -1171,11 +872,12 @@ @end deftypefn") { octave_value_list retval; - int nargin = args.length(); + + int nargin = args.length (); if (nargin < 2) print_usage (); - else if (args(0).is_cell() || args(1).is_cell()) + else if (args(0).is_cell () || args(1).is_cell ()) retval = octcellregexp (args, nargout, "regexpi", true); else retval = octregexp (args, nargout, "regexpi", true); @@ -1318,193 +1020,49 @@ static octave_value -octregexprep (const octave_value_list &args, const std::string &nm) +octregexprep (const octave_value_list &args, const std::string &who) { octave_value retval; - int nargin = args.length(); - // Make sure we have string,pattern,replacement + int nargin = args.length (); + + // Make sure we have string, pattern, replacement const std::string buffer = args(0).string_value (); - if (error_state) return retval; + if (error_state) + return retval; + const std::string pattern = args(1).string_value (); - if (error_state) return retval; + if (error_state) + return retval; + const std::string replacement = args(2).string_value (); - if (error_state) return retval; + if (error_state) + return retval; // Pack options excluding 'tokenize' and various output // reordering strings into regexp arg list - octave_value_list regexpargs(nargin-1,octave_value()); - regexpargs(0) = args(0); - regexpargs(1) = args(1); - int len=2; + octave_value_list regexpargs (nargin-3, octave_value ()); + + int len = 0; for (int i = 3; i < nargin; i++) { - const std::string opt = args(i).string_value(); + const std::string opt = args(i).string_value (); if (opt != "tokenize" && opt != "start" && opt != "end" && opt != "tokenextents" && opt != "match" && opt != "tokens" - && opt != "names" && opt != "warnings") + && opt != "names" && opt != "split" && opt != "warnings") { regexpargs(len++) = args(i); } } - regexpargs.resize(len); - - // Identify replacement tokens; build a vector of group numbers in - // the replacement string so that we can quickly calculate the size - // of the replacement. - int tokens = 0; - for (size_t i=1; i < replacement.size(); i++) - { - if (replacement[i-1]=='$' && isdigit(replacement[i])) - { - tokens++, i++; - } - } - std::vector<int> token(tokens); - int kk = 0; - for (size_t i = 1; i < replacement.size(); i++) - { - if (replacement[i-1]=='$' && isdigit(replacement[i])) - { - token[kk++] = replacement[i]-'0'; - i++; - } - } - - // Perform replacement - std::string rep; - if (tokens > 0) - { - std::list<regexp_elem> lst; - string_vector named; - int nopts; - bool once; - int sz = octregexp_list (regexpargs, nm , false, lst, named, nopts, once); - - if (error_state) - return retval; - if (sz == 0) - { - retval = args(0); - return retval; - } - - // Determine replacement length - const size_t replen = replacement.size() - 2*tokens; - int delta = 0; - const_iterator p = lst.begin(); - for (int i = 0; i < sz; i++) - { - OCTAVE_QUIT; - - const Matrix pairs(p->te); - size_t pairlen = 0; - for (int j = 0; j < tokens; j++) - { - if (token[j] == 0) - pairlen += static_cast<size_t>(p->e - p->s) + 1; - else if (token[j] <= pairs.rows()) - pairlen += static_cast<size_t>(pairs(token[j]-1,1) - - pairs(token[j]-1,0)) + 1; - } - delta += static_cast<int>(replen + pairlen) - - static_cast<int>(p->e - p->s + 1); - p++; - } - - // Build replacement string - rep.reserve(buffer.size()+delta); - size_t from = 0; - p = lst.begin(); - for (int i=0; i < sz; i++) - { - OCTAVE_QUIT; + regexpargs.resize (len); - const Matrix pairs(p->te); - rep.append(&buffer[from], static_cast<size_t>(p->s - 1) - from); - from = static_cast<size_t>(p->e - 1) + 1; - for (size_t j = 1; j < replacement.size(); j++) - { - if (replacement[j-1]=='$' && isdigit(replacement[j])) - { - int k = replacement[j]-'0'; - if (k == 0) - { - // replace with entire match - rep.append(&buffer[static_cast<size_t>(p->e - 1)], - static_cast<size_t>(p->e - p->s) + 1); - } - else if (k <= pairs.rows()) - { - // replace with group capture - rep.append(&buffer[static_cast<size_t>(pairs(k-1,0)-1)], - static_cast<size_t>(pairs(k-1,1) - - pairs(k-1,0))+1); - } - else - { - // replace with nothing - } - j++; - } - else - { - rep.append(1,replacement[j-1]); - } - if (j+1 == replacement.size()) - { - rep.append(1,replacement[j]); - } - } - p++; - } - rep.append(&buffer[from],buffer.size()-from); - } - else - { - std::list<regexp_elem> lst; - string_vector named; - int nopts; - bool once; - int sz = octregexp_list (regexpargs, nm, false, lst, named, nopts, once); + regexp::opts options; + bool extra_args = false; + parse_options (options, regexpargs, who, 0, extra_args); + if (error_state) + return retval; - if (error_state) - return retval; - if (sz == 0) - { - retval = args(0); - return retval; - } - - // Determine replacement length - const size_t replen = replacement.size(); - int delta = 0; - const_iterator p = lst.begin(); - for (int i = 0; i < sz; i++) - { - OCTAVE_QUIT; - delta += static_cast<int>(replen) - - static_cast<int>(p->e - p->s + 1); - p++; - } - - // Build replacement string - rep.reserve(buffer.size()+delta); - size_t from = 0; - p = lst.begin(); - for (int i=0; i < sz; i++) - { - OCTAVE_QUIT; - rep.append(&buffer[from], static_cast<size_t>(p->s - 1) - from); - from = static_cast<size_t>(p->e - 1) + 1; - rep.append(replacement); - p++; - } - rep.append(&buffer[from],buffer.size()-from); - } - - retval = rep; - return retval; + return regexp_replace (pattern, buffer, replacement, options, who); } DEFUN_DLD (regexprep, args, , @@ -1541,7 +1099,7 @@ @end deftypefn") { octave_value_list retval; - int nargin = args.length(); + int nargin = args.length (); if (nargin < 3) { @@ -1549,56 +1107,57 @@ return retval; } - if (args(0).is_cell() || args(1).is_cell() || args(2).is_cell()) + if (args(0).is_cell () || args(1).is_cell () || args(2).is_cell ()) { Cell str; Cell pat; Cell rep; dim_vector dv0; - dim_vector dv1(1,1); + dim_vector dv1 (1, 1); - if (args(0).is_cell()) - str = args(0).cell_value(); + if (args(0).is_cell ()) + str = args(0).cell_value (); else str = Cell (args(0)); - if (args(1).is_cell()) - pat = args(1).cell_value(); + if (args(1).is_cell ()) + pat = args(1).cell_value (); else pat = Cell (args(1)); - if (args(2).is_cell()) - rep = args(2).cell_value(); + if (args(2).is_cell ()) + rep = args(2).cell_value (); else rep = Cell (args(2)); - dv0 = str.dims(); - if (pat.numel() != 1) + dv0 = str.dims (); + if (pat.numel () != 1) { - dv1 = pat.dims(); - if (rep.numel() != 1 && dv1 != rep.dims()) - error ("regexprep: Inconsistent cell array dimensions"); + dv1 = pat.dims (); + if (rep.numel () != 1 && dv1 != rep.dims ()) + error ("regexprep: inconsistent cell array dimensions"); } - else if (rep.numel() != 1) - dv1 = rep.dims(); + else if (rep.numel () != 1) + dv1 = rep.dims (); if (!error_state) { Cell ret (dv0); octave_value_list new_args = args; - for (octave_idx_type i = 0; i < dv0.numel(); i++) + for (octave_idx_type i = 0; i < dv0.numel (); i++) { new_args(0) = str(i); if (pat.numel() == 1) new_args(1) = pat(0); if (rep.numel() == 1) new_args(2) = rep(0); - for (octave_idx_type j = 0; j < dv1.numel(); j++) + + for (octave_idx_type j = 0; j < dv1.numel (); j++) { - if (pat.numel() != 1) + if (pat.numel () != 1) new_args(1) = pat(j); - if (rep.numel() != 1) + if (rep.numel () != 1) new_args(2) = rep(j); new_args(0) = octregexprep (new_args, "regexprep"); @@ -1613,7 +1172,8 @@ } if (!error_state) - retval = octave_value (ret); + retval = args(0).is_cell () + ? octave_value (ret) : octave_value (ret(0)); } } else @@ -1669,7 +1229,7 @@ %!assert(regexprep("abc","(b)","$1.."),"ab..c"); ## Test cell array arguments -%!assert(regexprep("abc",{"b","a"},"?"),{"??c"}) +%!assert(regexprep("abc",{"b","a"},"?"),"??c") %!assert(regexprep({"abc","cba"},"b","?"),{"a?c","c?a"}) %!assert(regexprep({"abc","cba"},{"b","a"},{"?","!"}),{"!?c","c?!"})
--- a/src/DLD-FUNCTIONS/schur.cc +++ b/src/DLD-FUNCTIONS/schur.cc @@ -60,170 +60,70 @@ DEFUN_DLD (schur, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {@var{S} =} schur (@var{A})\n\ +@deftypefnx {Loadable Function} {@var{S} =} schur (@var{A}, \"real\")\n\ @deftypefnx {Loadable Function} {@var{S} =} schur (@var{A}, \"complex\")\n\ -@deftypefnx {Loadable Function} {[@var{U}, @var{S}] =} schur (@var{A}, @var{opt})\n\ +@deftypefnx {Loadable Function} {@var{S} =} schur (@var{A}, @var{opt})\n\ +@deftypefnx {Loadable Function} {[@var{U}, @var{S}] =} schur (@var{A}, @dots{})\n\ @cindex Schur decomposition\n\ -The Schur@tie{}decomposition is used to compute eigenvalues of a\n\ -square matrix, and has applications in the solution of algebraic\n\ -Riccati equations in control (see @code{are} and @code{dare}).\n\ -@code{schur} always returns\n\ +Compute the Schur@tie{}decomposition of @var{A}\n\ @tex\n\ -$S = U^T A U$\n\ +$$\n\ + S = U^T A U\n\ +$$\n\ @end tex\n\ @ifnottex\n\ +\n\ +@example\n\ @code{@var{S} = @var{U}' * @var{A} * @var{U}}\n\ +@end example\n\ +\n\ @end ifnottex\n\ -where\n\ -@tex\n\ -$U$\n\ -@end tex\n\ -@ifnottex\n\ -@var{U}\n\ -@end ifnottex\n\ - is a unitary matrix\n\ +where @var{U} is a unitary matrix\n\ @tex\n\ ($U^T U$ is identity)\n\ @end tex\n\ @ifnottex\n\ (@code{@var{U}'* @var{U}} is identity)\n\ @end ifnottex\n\ -and\n\ -@tex\n\ -$S$\n\ -@end tex\n\ -@ifnottex\n\ -@var{S}\n\ -@end ifnottex\n\ -is upper triangular. The eigenvalues of\n\ -@tex\n\ -$A$ (and $S$)\n\ -@end tex\n\ -@ifnottex\n\ -@var{A} (and @var{S})\n\ -@end ifnottex\n\ -are the diagonal elements of\n\ -@tex\n\ -$S$.\n\ -@end tex\n\ -@ifnottex\n\ -@var{S}.\n\ -@end ifnottex\n\ -If the matrix\n\ -@tex\n\ -$A$\n\ -@end tex\n\ -@ifnottex\n\ -@var{A}\n\ -@end ifnottex\n\ +and @var{S} is upper triangular. The eigenvalues of @var{A} (and @var{S})\n\ +are the diagonal elements of @var{S}. If the matrix @var{A}\n\ is real, then the real Schur@tie{}decomposition is computed, in which the\n\ -matrix\n\ -@tex\n\ -$U$\n\ -@end tex\n\ -@ifnottex\n\ -@var{U}\n\ -@end ifnottex\n\ -is orthogonal and\n\ -@tex\n\ -$S$\n\ -@end tex\n\ -@ifnottex\n\ -@var{S}\n\ -@end ifnottex\n\ -is block upper triangular\n\ +matrix @var{U} is orthogonal and @var{S} is block upper triangular\n\ with blocks of size at most\n\ @tex\n\ -$2\\times 2$\n\ +$2 \\times 2$\n\ @end tex\n\ @ifnottex\n\ @code{2 x 2}\n\ @end ifnottex\n\ -along the diagonal. The diagonal elements of\n\ -@tex\n\ -$S$\n\ -@end tex\n\ -@ifnottex\n\ -@var{S}\n\ -@end ifnottex\n\ +along the diagonal. The diagonal elements of @var{S}\n\ (or the eigenvalues of the\n\ @tex\n\ -$2\\times 2$\n\ +$2 \\times 2$\n\ @end tex\n\ @ifnottex\n\ @code{2 x 2}\n\ @end ifnottex\n\ -blocks, when\n\ -appropriate) are the eigenvalues of\n\ -@tex\n\ -$A$\n\ -@end tex\n\ -@ifnottex\n\ -@var{A}\n\ -@end ifnottex\n\ -and\n\ -@tex\n\ -$S$.\n\ -@end tex\n\ -@ifnottex\n\ -@var{S}.\n\ -@end ifnottex\n\ +blocks, when appropriate) are the eigenvalues of @var{A} and @var{S}.\n\ \n\ -A complex decomposition may be forced by passing \"complex\" as @var{opt}.\n\ +The default for real matrices is a real Schur@tie{}decomposition.\n\ +A complex decomposition may be forced by passing the flag \"complex\".\n\ \n\ The eigenvalues are optionally ordered along the diagonal according to\n\ the value of @var{opt}. @code{@var{opt} = \"a\"} indicates that all\n\ eigenvalues with negative real parts should be moved to the leading\n\ -block of\n\ -@tex\n\ -$S$\n\ -@end tex\n\ -@ifnottex\n\ -@var{S}\n\ -@end ifnottex\n\ +block of @var{S}\n\ (used in @code{are}), @code{@var{opt} = \"d\"} indicates that all eigenvalues\n\ -with magnitude less than one should be moved to the leading block of\n\ -@tex\n\ -$S$\n\ -@end tex\n\ -@ifnottex\n\ -@var{S}\n\ -@end ifnottex\n\ +with magnitude less than one should be moved to the leading block of @var{S}\n\ (used in @code{dare}), and @code{@var{opt} = \"u\"}, the default, indicates\n\ -that no ordering of eigenvalues should occur. The leading\n\ -@tex\n\ -$k$\n\ -@end tex\n\ -@ifnottex\n\ -@var{k}\n\ -@end ifnottex\n\ -columns of\n\ -@tex\n\ -$U$\n\ -@end tex\n\ -@ifnottex\n\ -@var{U}\n\ -@end ifnottex\n\ -always span the\n\ -@tex\n\ -$A$-invariant\n\ -@end tex\n\ -@ifnottex\n\ -@var{A}-invariant\n\ -@end ifnottex\n\ -subspace corresponding to the\n\ -@tex\n\ -$k$\n\ -@end tex\n\ -@ifnottex\n\ -@var{k}\n\ -@end ifnottex\n\ -leading eigenvalues of\n\ -@tex\n\ -$S$.\n\ -@end tex\n\ -@ifnottex\n\ -@var{S}.\n\ -@end ifnottex\n\ +that no ordering of eigenvalues should occur. The leading @var{k}\n\ +columns of @var{U} always span the @var{A}-invariant\n\ +subspace corresponding to the @var{k} leading eigenvalues of @var{S}.\n\ +\n\ +The Schur@tie{}decomposition is used to compute eigenvalues of a\n\ +square matrix, and has applications in the solution of algebraic\n\ +Riccati equations in control (see @code{are} and @code{dare}).\n\ +@seealso{rsf2csf}\n\ @end deftypefn") { octave_value_list retval; @@ -253,7 +153,11 @@ bool force_complex = false; - if (ord == "complex") + if (ord == "real") + { + ord = std::string (); + } + else if (ord == "complex") { force_complex = true; ord = std::string (); @@ -385,7 +289,7 @@ %!test %! fail("schur ([1, 2; 3, 4], 2)","warning"); -%!error <Invalid call to schur.*> schur (); +%!error <Invalid call to schur> schur (); %!error schur ([1, 2, 3; 4, 5, 6]); */ @@ -396,10 +300,16 @@ Convert a real, upper quasi-triangular Schur@tie{}form @var{TR} to a complex,\n\ upper triangular Schur@tie{}form @var{T}.\n\ \n\ -Note that the following relations hold: \n\ +Note that the following relations hold:\n\ \n\ -@code{@var{UR} * @var{TR} * @var{UR}' = @var{U} * @var{T} * @var{U}'} and\n\ +@tex\n\ +$UR \\cdot TR \\cdot {UR}^T = U T U^{\\dagger}$ and\n\ +$U^{\\dagger} U$ is the identity matrix I.\n\ +@end tex\n\ +@ifnottex\n\ +@xcode{@var{UR} * @var{TR} * @var{UR}' = @var{U} * @var{T} * @var{U}'} and\n\ @code{@var{U}' * @var{U}} is the identity matrix I.\n\ +@end ifnottex\n\ \n\ Note also that @var{U} and @var{T} are not unique.\n\ @seealso{schur}\n\
--- a/src/DLD-FUNCTIONS/spparms.cc +++ b/src/DLD-FUNCTIONS/spparms.cc @@ -113,8 +113,8 @@ retval(0) = octave_sparse_params::get_vals (); else if (nargout == 2) { + retval (1) = octave_sparse_params::get_vals (); retval (0) = octave_sparse_params::get_keys (); - retval (1) = octave_sparse_params::get_vals (); } else error ("spparms: too many output arguments"); @@ -136,7 +136,7 @@ { double val = octave_sparse_params::get_key (str); if (xisnan (val)) - error ("spparams: KEY not recognized"); + error ("spparms: KEY not recognized"); else retval (0) = val; } @@ -148,7 +148,7 @@ if (error_state) error ("spparms: input must be a string or a vector"); else if (vals.numel () > OCTAVE_SPARSE_CONTROLS_SIZE) - error ("spparams: too many elements in vector VALS"); + error ("spparms: too many elements in vector VALS"); else octave_sparse_params::set_vals (vals); } @@ -176,3 +176,33 @@ return retval; } + +/* + +%!test +%! old_vals = spparms (); # save state +%! spparms ("defaults"); +%! vals = spparms (); +%! assert (vals, [0 1 1 0 3 3 0.5 1.0 1.0 0.1 0.5 1.0 0.001]'); +%! [keys, vals] = spparms (); +%! assert (rows (keys), 13); +%! assert (keys(2,:), "ths_rel"); +%! assert (vals, [0 1 1 0 3 3 0.5 1.0 1.0 0.1 0.5 1.0 0.001]'); +%! spparms ([3 2 1]); +%! assert (spparms ()(1:3), [3, 2, 1]'); +%! assert (spparms ("ths_rel"), 2); +%! spparms ("exact_d", 5); +%! assert (spparms ("exact_d"), 5); +%! spparms (old_vals); # restore state + +%% Test input validation +%!error (spparms (1, 2, 3)) +%!error ([x, y, z] = spparms ()) +%!error (spparms ("UNKNOWN_KEY")) +%!error (spparms ({1, 2, 3})) +%!error (spparms (ones (14, 1))) +%!error (spparms (1, 1)) +%!error (spparms ("ths_rel", "hello")) +%!error (spparms ("UNKNOWN_KEY", 1)) + +*/
--- a/src/DLD-FUNCTIONS/sqrtm.cc +++ b/src/DLD-FUNCTIONS/sqrtm.cc @@ -49,22 +49,20 @@ bool singular = false; - /* - * the following code is equivalent to this triple loop: - * - * n = rows (T); - * for j = 1:n - * T(j,j) = sqrt (T(j,j)); - * for i = j-1:-1:1 - * T(i,j) /= (T(i,i) + T(j,j)); - * k = 1:i-1; - * T(k,j) -= T(k,i) * T(i,j); - * endfor - * endfor - * - * this is an in-place, cache-aligned variant of the code - * given in Higham's paper. - */ + // The following code is equivalent to this triple loop: + // + // n = rows (T); + // for j = 1:n + // T(j,j) = sqrt (T(j,j)); + // for i = j-1:-1:1 + // T(i,j) /= (T(i,i) + T(j,j)); + // k = 1:i-1; + // T(k,j) -= T(k,i) * T(i,j); + // endfor + // endfor + // + // this is an in-place, cache-aligned variant of the code + // given in Higham's paper. const octave_idx_type n = T.rows (); element_type *Tp = T.fortran_vec (); @@ -117,38 +115,32 @@ { case MatrixType::Upper: case MatrixType::Diagonal: - { - if (! x.diag ().any_element_is_negative ()) - { - // Do it in real arithmetic. - sqrtm_utri_inplace (x); - retval = x; - retval.matrix_type (mt); - } - else - iscomplex = true; - - break; - } - case MatrixType::Lower: + if (! x.diag ().any_element_is_negative ()) { - if (! x.diag ().any_element_is_negative ()) - { - x = x.transpose (); - sqrtm_utri_inplace (x); - retval = x.transpose (); - retval.matrix_type (mt); - } - else - iscomplex = true; + // Do it in real arithmetic. + sqrtm_utri_inplace (x); + retval = x; + retval.matrix_type (mt); + } + else + iscomplex = true; + break; - break; + case MatrixType::Lower: + if (! x.diag ().any_element_is_negative ()) + { + x = x.transpose (); + sqrtm_utri_inplace (x); + retval = x.transpose (); + retval.matrix_type (mt); } + else + iscomplex = true; + break; + default: - { - iscomplex = true; - break; - } + iscomplex = true; + break; } if (iscomplex) @@ -166,46 +158,41 @@ { case MatrixType::Upper: case MatrixType::Diagonal: - { - sqrtm_utri_inplace (x); - retval = x; - retval.matrix_type (mt); + sqrtm_utri_inplace (x); + retval = x; + retval.matrix_type (mt); + break; - break; - } case MatrixType::Lower: - { - x = x.transpose (); - sqrtm_utri_inplace (x); - retval = x.transpose (); - retval.matrix_type (mt); + x = x.transpose (); + sqrtm_utri_inplace (x); + retval = x.transpose (); + retval.matrix_type (mt); + break; - break; - } default: - { - ComplexMatrix u; + { + ComplexMatrix u; - do - { - ComplexSCHUR schur (x, std::string (), true); - x = schur.schur_matrix (); - u = schur.unitary_matrix (); - } - while (0); // schur no longer needed. + do + { + ComplexSCHUR schur (x, std::string (), true); + x = schur.schur_matrix (); + u = schur.unitary_matrix (); + } + while (0); // schur no longer needed. - sqrtm_utri_inplace (x); + sqrtm_utri_inplace (x); - x = u * x; // original x no longer needed. - ComplexMatrix res = xgemm (x, u, blas_no_trans, blas_conj_trans); + x = u * x; // original x no longer needed. + ComplexMatrix res = xgemm (x, u, blas_no_trans, blas_conj_trans); - if (cutoff > 0 && xnorm (imag (res), one) <= cutoff) - retval = real (res); - else - retval = res; - - break; - } + if (cutoff > 0 && xnorm (imag (res), one) <= cutoff) + retval = real (res); + else + retval = res; + } + break; } } @@ -214,7 +201,8 @@ DEFUN_DLD (sqrtm, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{result}, @var{error_estimate}] =} sqrtm (@var{A})\n\ +@deftypefn {Loadable Function} {@var{s} =} sqrtm (@var{A})\n\ +@deftypefnx {Loadable Function} {[@var{s}, @var{error_estimate}] =} sqrtm (@var{A})\n\ Compute the matrix square root of the square matrix @var{A}.\n\ \n\ Ref: N.J. Higham. @cite{A New sqrtm for @sc{matlab}}. Numerical\n\ @@ -244,23 +232,24 @@ return retval; } - if (arg.is_diag_matrix ()) - { - // sqrtm of a diagonal matrix is just sqrt. - retval(0) = arg.sqrt (); - } - else if (arg.is_single_type ()) + if (nargout > 1) { - retval(0) = do_sqrtm<FloatMatrix, FloatComplexMatrix, FloatComplexSCHUR> (arg); + retval.resize (1, 2); + retval(2) = -1.0; } + + if (arg.is_diag_matrix ()) + // sqrtm of a diagonal matrix is just sqrt. + retval(0) = arg.sqrt (); + else if (arg.is_single_type ()) + retval(0) = do_sqrtm<FloatMatrix, FloatComplexMatrix, FloatComplexSCHUR> (arg); else if (arg.is_numeric_type ()) - { - retval(0) = do_sqrtm<Matrix, ComplexMatrix, ComplexSCHUR> (arg); - } + retval(0) = do_sqrtm<Matrix, ComplexMatrix, ComplexSCHUR> (arg); if (nargout > 1 && ! error_state) { // This corresponds to generic code + // // norm (s*s - x, "fro") / norm (x, "fro"); octave_value s = retval(0); @@ -269,3 +258,22 @@ return retval; } + +/* + +%!assert (sqrtm (2*ones (2)), ones (2), 3*eps) + +## The following two tests are from the reference in the docstring above. + +%!test +%! x = [0 1; 0 0]; +%! assert (any (isnan (sqrtm (x))(:) )) + +%!test +%! x = eye (4); x(2,2) = x(3,3) = 2^-26; x(1,4) = 1; +%! z = eye (4); z(2,2) = z(3,3) = 2^-13; z(1,4) = 0.5; +%! [y, err] = sqrtm(x); +%! assert (y, z) +%! assert (err, 0) ## Yes, this one has to hold exactly + +*/
--- a/src/DLD-FUNCTIONS/str2double.cc +++ b/src/DLD-FUNCTIONS/str2double.cc @@ -46,6 +46,14 @@ single_num (std::istringstream& is, double& num) { char c = is.peek (); + + // Skip spaces. + while (isspace (c)) + { + is.get (); + c = is.peek (); + } + if (c == 'I') { // It's infinity. @@ -54,7 +62,7 @@ if (c1 == 'n' && c2 == 'f') { num = octave_Inf; - is.peek (); // Sets eof bit. + is.peek (); // May sets EOF bit. } else is.setstate (std::ios::failbit); // indicate that read has failed. @@ -67,7 +75,7 @@ if (c1 == 'A') { num = octave_NA; - is.peek (); // Sets eof bit. + is.peek (); // May set EOF bit. } else { @@ -75,7 +83,7 @@ if (c1 == 'a' && c2 == 'N') { num = octave_NaN; - is.peek (); // Sets eof bit. + is.peek (); // May set EOF bit. } else is.setstate (std::ios::failbit); // indicate that read has failed. @@ -93,6 +101,14 @@ have_sign = imag = false; char c = is.peek (); + + // Skip leading spaces. + while (isspace (c)) + { + is.get (); + c = is.peek (); + } + bool negative = false; // Accept leading sign. @@ -104,17 +120,34 @@ have_sign = true; } + // Skip spaces after sign. + while (isspace (c)) + { + is.get (); + c = is.peek (); + } + // It's i*num or just i. if (is_imag_unit (c)) { - c = is.get (); imag = true; - char cn = is.peek (); - if (cn == '*') + is.get (); + c = is.peek (); + + // Skip spaces after imaginary unit. + while (isspace (c)) + { + is.get (); + c = is.peek (); + } + + if (c == '*') { // Multiplier follows, we extract it as a number. is.get (); single_num (is, num); + if (is.good ()) + c = is.peek (); } else num = 1.0; @@ -126,14 +159,31 @@ if (is.good ()) { c = is.peek (); + + // Skip spaces after number. + while (isspace (c)) + { + is.get (); + c = is.peek (); + } + if (c == '*') { is.get (); - c = is.get (); + c = is.peek (); + + // Skip spaces after operator. + while (isspace (c)) + { + is.get (); + c = is.peek (); + } + if (is_imag_unit (c)) { imag = true; - is.peek (); + is.get (); + c = is.peek (); } else is.setstate (std::ios::failbit); // indicate that read has failed. @@ -142,11 +192,21 @@ { imag = true; is.get (); - is.peek (); + c = is.peek (); } } } + if (is.good ()) + { + // Skip trailing spaces. + while (isspace (c)) + { + is.get (); + c = is.peek (); + } + } + if (negative) num = -num; @@ -181,14 +241,12 @@ std::string str = str_arg; + // FIXME -- removing all commas does too much... std::string::iterator se = str.end (); - - // Remove commas (thousand separators) and spaces. se = std::remove (str.begin (), se, ','); - se = std::remove (str.begin (), se, ' '); str.erase (se, str.end ()); + std::istringstream is (str); - std::istringstream is (str); double num; bool i1, i2, s1, s2; @@ -244,38 +302,49 @@ case each element is converted and an array of the same dimensions is\n\ returned.\n\ \n\ -@code{str2double} can replace @code{str2num}, and it avoids the use of\n\ -@code{eval} on unknown data.\n\ +@code{str2double} returns NaN for elements of @var{s} which cannot be\n\ +converted.\n\ +\n\ +@code{str2double} can replace @code{str2num}, and it avoids the security\n\ +risk of using @code{eval} on unknown data.\n\ @seealso{str2num}\n\ @end deftypefn") { octave_value retval; - if (args.length () == 1) + if (args.length () != 1) + print_usage (); + else if (args(0).is_string ()) { - if (args(0).is_string ()) + if (args(0).rows () == 1 && args(0).ndims () == 2) { - if (args(0).rows () == 1 && args(0).ndims () == 2) - { - retval = str2double1 (args(0).string_value ()); - } - else - { - const string_vector sv = args(0).all_strings (); - if (! error_state) - retval = sv.map<Complex> (str2double1); - } - } - else if (args(0).is_cellstr ()) - { - Array<std::string> sa = args(0).cellstr_value (); - retval = sa.map<Complex> (str2double1); + retval = str2double1 (args(0).string_value ()); } else - gripe_wrong_type_arg ("str2double", args(0)); + { + const string_vector sv = args(0).all_strings (); + if (! error_state) + retval = sv.map<Complex> (str2double1); + } + } + else if (args(0).is_cell ()) + { + const Cell cell = args(0).cell_value (); + + if (! error_state) + { + ComplexNDArray output (cell.dims (), octave_NaN); + for (octave_idx_type i = 0; i < cell.numel (); i++) + { + if (cell(i).is_string ()) + output(i) = str2double1 (cell(i).string_value ()); + } + retval = output; + } } else - print_usage (); + retval = NDArray (args(0).dims (), octave_NaN); + return retval; } @@ -284,6 +353,8 @@ %!assert (str2double ("1"), 1) %!assert (str2double ("-.1e-5"), -1e-6) +%!assert (str2double (char ("1", "2 3", "4i")), [1; NaN; 4i]); +%!assert (str2double ("-.1e-5"), -1e-6) %!assert (str2double ("1,222.5"), 1222.5) %!assert (str2double ("i"), i) %!assert (str2double ("2j"), 2i) @@ -293,6 +364,8 @@ %!assert (str2double ("1e-3 + i*.25"), 1e-3 + 0.25i) %!assert (str2double (["2 + j";"1.25e-3";"-05"]), [2+i; 1.25e-3; -5]) %!assert (str2double ({"2 + j","1.25e-3","-05"}), [2+i, 1.25e-3, -5]) +%!assert (str2double (1), NaN) +%!assert (str2double ("1 2 3 4"), NaN) %!assert (str2double ("Hello World"), NaN) %!assert (str2double ("NaN"), NaN) %!assert (str2double ("NA"), NA) @@ -302,5 +375,8 @@ %!assert (str2double ("NaN + Inf*i"), complex (NaN, Inf)) %!assert (str2double ("Inf - Inf*i"), complex (Inf, -Inf)) %!assert (str2double ("-i*NaN - Inf"), complex (-Inf, -NaN)) +%!assert (str2double ({"abc", "4i"}), [NaN + 0i, 4i]) +%!assert (str2double ({2, "4i"}), [NaN + 0i, 4i]) +%!assert (str2double (zeros(3,1,2)), NaN (3,1,2)) */
--- a/src/DLD-FUNCTIONS/strfind.cc +++ b/src/DLD-FUNCTIONS/strfind.cc @@ -50,7 +50,7 @@ const char *x = needle.data (); octave_idx_type m = needle.numel (); - for (octave_idx_type i = 0; i < UCHAR_MAX; i++) + for (octave_idx_type i = 0; i < TABSIZE; i++) table[i] = m + 1; for (octave_idx_type i = 0; i < m; i++) table[ORD(x[i])] = m - i; @@ -203,7 +203,7 @@ if (argpat.is_string ()) { Array<char> needle = argpat.char_array_value (); - OCTAVE_LOCAL_BUFFER (octave_idx_type, table, UCHAR_MAX); + OCTAVE_LOCAL_BUFFER (octave_idx_type, table, TABSIZE); qs_preprocess (needle, table); if (argstr.is_string ()) @@ -367,7 +367,7 @@ const Array<char> pat = argpat.char_array_value (); const Array<char> rep = argrep.char_array_value (); - OCTAVE_LOCAL_BUFFER (octave_idx_type, table, UCHAR_MAX); + OCTAVE_LOCAL_BUFFER (octave_idx_type, table, TABSIZE); qs_preprocess (pat, table); if (argstr.is_string ())
--- a/src/DLD-FUNCTIONS/sub2ind.cc +++ b/src/DLD-FUNCTIONS/sub2ind.cc @@ -125,9 +125,9 @@ /* # Test input validation -%!error <sub2ind: dimension vector .*> sub2ind([10 10.5], 1, 1); -%!error <subscript indices .*> sub2ind([10 10], 1.5, 1); -%!error <subscript indices .*> sub2ind([10 10], 1, 1.5); +%!error <sub2ind: dimension vector > sub2ind([10 10.5], 1, 1); +%!error <subscript indices > sub2ind([10 10], 1.5, 1); +%!error <subscript indices > sub2ind([10 10], 1, 1.5); # Test evaluation %!shared s1, s2, s3, in @@ -140,9 +140,9 @@ # Test low index %!assert (sub2ind([10 10 10], 1, 1, 1), 1); -%!error <subscript indices .*> sub2ind([10 10 10], 0, 1, 1); -%!error <subscript indices .*> sub2ind([10 10 10], 1, 0, 1); -%!error <subscript indices .*> sub2ind([10 10 10], 1, 1, 0); +%!error <subscript indices > sub2ind([10 10 10], 0, 1, 1); +%!error <subscript indices > sub2ind([10 10 10], 1, 0, 1); +%!error <subscript indices > sub2ind([10 10 10], 1, 1, 0); # Test high index %!assert (sub2ind([10 10 10], 10, 10, 10), 1000);
--- a/src/DLD-FUNCTIONS/svd.cc +++ b/src/DLD-FUNCTIONS/svd.cc @@ -48,7 +48,7 @@ Compute the singular value decomposition of @var{A}\n\ @tex\n\ $$\n\ - A = U S V^H\n\ + A = U S V^{\\dagger}\n\ $$\n\ @end tex\n\ @ifnottex\n\ @@ -398,18 +398,24 @@ %! assert (size (s), [0, 0]); %! assert (size (v), [0, 0]); -%!error <Invalid call to svd.*> svd (); -%!error <Invalid call to svd.*> svd ([1, 2; 4, 5], 2, 3); -%!error <Invalid call to svd.*> [u, v] = svd ([1, 2; 3, 4]); +%!error <Invalid call to svd> svd (); +%!error <Invalid call to svd> svd ([1, 2; 4, 5], 2, 3); +%!error <Invalid call to svd> [u, v] = svd ([1, 2; 3, 4]); */ DEFUN_DLD (svd_driver, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{old} =} svd_driver (@var{new})\n\ -Set or query the underlying @sc{lapack} driver used by @code{svd}.\n\ +@deftypefn {Loadable Function} {@var{val} =} svd_driver ()\n\ +@deftypefnx {Loadable Function} {@var{old_val} =} svd_driver (@var{new_val})\n\ +@deftypefnx {Loadable Function} {} svd_driver (@var{new_val}, \"local\")\n\ +Query or set the underlying @sc{lapack} driver used by @code{svd}.\n\ Currently recognized values are \"gesvd\" and \"gesdd\". The default\n\ is \"gesvd\".\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{svd}\n\ @end deftypefn") {
--- a/src/DLD-FUNCTIONS/syl.cc +++ b/src/DLD-FUNCTIONS/syl.cc @@ -213,8 +213,8 @@ %!assert(syl ([1, 2; 3, 4], [5, 6; 7, 8], [9, 10; 11, 12]), [-1/2, -2/3; -2/3, -1/2], sqrt (eps)); %!assert(syl (single([1, 2; 3, 4]), single([5, 6; 7, 8]), single([9, 10; 11, 12])), single([-1/2, -2/3; -2/3, -1/2]), sqrt (eps('single'))); -%!error <Invalid call to syl.*> syl (); -%!error <Invalid call to syl.*> syl (1, 2, 3, 4); +%!error <Invalid call to syl> syl (); +%!error <Invalid call to syl> syl (1, 2, 3, 4); %!error syl ([1, 2; 3, 4], [1, 2, 3; 4, 5, 6], [4, 3]); */
--- a/src/DLD-FUNCTIONS/symbfact.cc +++ b/src/DLD-FUNCTIONS/symbfact.cc @@ -63,10 +63,10 @@ Factorize @code{@var{S}' * @var{S}}.\n\ \n\ @item row\n\ -Factorize @code{@var{S} * @var{S}'}.\n\ +Factorize @xcode{@var{S} * @var{S}'}.\n\ \n\ @item lo\n\ -Factorize @code{@var{S}'}\n\ +Factorize @xcode{@var{S}'}\n\ @end table\n\ \n\ @item mode\n\
--- a/src/DLD-FUNCTIONS/time.cc +++ b/src/DLD-FUNCTIONS/time.cc @@ -131,7 +131,7 @@ "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {@var{tm_struct} =} gmtime (@var{t})\n\ Given a value returned from @code{time}, or any non-negative integer,\n\ -return a time structure corresponding to CUT (Coordinated Universal Time). \n\ +return a time structure corresponding to CUT (Coordinated Universal Time).\n\ For example:\n\ \n\ @example\n\ @@ -186,9 +186,9 @@ %! && isfield (ts, "isdst") %! && isfield (ts, "yday"))); -%!error <Invalid call to gmtime.*> gmtime (); +%!error <Invalid call to gmtime> gmtime (); -%!error <Invalid call to gmtime.*> gmtime (1, 2); +%!error <Invalid call to gmtime> gmtime (1, 2); */ @@ -250,9 +250,9 @@ %! && isfield (ts, "isdst") %! && isfield (ts, "yday"))); -%!error <Invalid call to localtime.*> localtime (); +%!error <Invalid call to localtime> localtime (); -%!error <Invalid call to localtime.*> localtime (1, 2); +%!error <Invalid call to localtime> localtime (1, 2); */ @@ -301,9 +301,9 @@ %! t = time (); %! assert(fix (mktime (localtime (t))) == fix (t)); -%!error <Invalid call to mktime.*> mktime (); +%!error <Invalid call to mktime> mktime (); -%!error <Invalid call to mktime.*> mktime (1, 2, 3); +%!error <Invalid call to mktime> mktime (1, 2, 3); %% These tests fail on systems with mktime functions of limited %% intelligence: @@ -340,13 +340,13 @@ Literal character fields:\n\ \n\ @table @code\n\ -@item %\n\ +@item %%\n\ % character.\n\ \n\ -@item n\n\ +@item %n\n\ Newline character.\n\ \n\ -@item t\n\ +@item %t\n\ Tab character.\n\ @end table\n\ \n\ @@ -505,9 +505,9 @@ %! && ischar (strftime ("%c%C%d%e%D%h%j", localtime (time ()))) %! && ischar (strftime ("%m%U%w%W%x%y%Y", localtime (time ()))))); -%!error <Invalid call to strftime.*> strftime (); +%!error <Invalid call to strftime> strftime (); -%!error <Invalid call to strftime.*> strftime ("foo", localtime (time ()), 1); +%!error <Invalid call to strftime> strftime ("foo", localtime (time ()), 1); */
--- a/src/DLD-FUNCTIONS/tril.cc +++ b/src/DLD-FUNCTIONS/tril.cc @@ -389,7 +389,7 @@ If the option \"pack\" is given as third argument, the extracted elements\n\ are not inserted into a matrix, but rather stacked column-wise one above\n\ other.\n\ -@seealso{triu, diag}\n\ +@seealso{diag}\n\ @end deftypefn") { return do_trilu ("tril", args); @@ -400,7 +400,7 @@ @deftypefn {Function File} {} triu (@var{A})\n\ @deftypefnx {Function File} {} triu (@var{A}, @var{k})\n\ @deftypefnx {Function File} {} triu (@var{A}, @var{k}, @var{pack})\n\ -@xref{tril}.\n\ +See the documentation for the @code{tril} function (@pxref{tril}).\n\ @end deftypefn") { return do_trilu ("triu", args);
--- a/src/DLD-FUNCTIONS/typecast.cc +++ b/src/DLD-FUNCTIONS/typecast.cc @@ -118,7 +118,7 @@ consecutive pairs of real numbers. The sizes of integer types are given by\n\ their bit counts. Both logical and char are typically one byte wide;\n\ however, this is not guaranteed by C++. If your system is IEEE conformant,\n\ -single and double should be 4 bytes and 8 bytes wide, respectively. \n\ +single and double should be 4 bytes and 8 bytes wide, respectively.\n\ \"logical\" is not allowed for @var{class}. If the input is a row vector,\n\ the return value is a row vector, otherwise it is a column vector. If the\n\ bit length of @var{x} is not divisible by that of @var{class}, an error\n\ @@ -382,7 +382,7 @@ DEFUN_DLD (bitunpack, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{y} =} bitpack (@var{x})\n\ +@deftypefn {Loadable Function} {@var{y} =} bitunpack (@var{x})\n\ Return an array @var{y} corresponding to the raw bit patterns of\n\ @var{x}. @var{x} must belong to one of the built-in numeric classes:\n\ \n\
--- a/src/DLD-FUNCTIONS/urlwrite.cc +++ b/src/DLD-FUNCTIONS/urlwrite.cc @@ -46,13 +46,13 @@ #include "ov-cell.h" #include "pager.h" #include "oct-map.h" +#include "oct-refcount.h" #include "unwind-prot.h" #ifdef HAVE_CURL #include <curl/curl.h> #include <curl/curlver.h> -#include <curl/types.h> #include <curl/easy.h> static int @@ -113,11 +113,11 @@ { BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CURLcode res = curl_easy_perform (curl); - if (res != CURLE_OK) + errnum = curl_easy_perform (curl); + if (errnum != CURLE_OK) { if (curlerror) - error ("%s", curl_easy_strerror (res)); + error ("%s", curl_easy_strerror (errnum)); } else retval = true; @@ -142,10 +142,11 @@ return !ascii; } - size_t count; + octave_refcount<size_t> count; std::string host; bool valid; bool ascii; + mutable CURLcode errnum; private: CURL *curl; @@ -251,11 +252,7 @@ std::string lasterror (void) const { - CURLcode errnum; - - curl_easy_getinfo (rep->handle(), CURLINFO_OS_ERRNO, &errnum); - - return std::string (curl_easy_strerror (errnum)); + return std::string (curl_easy_strerror (rep->errnum)); } void set_ostream (std::ostream& os) const @@ -690,7 +687,7 @@ \n\ @example\n\ @group\n\ -urlwrite (\"ftp://ftp.octave.org/pub/octave/README\", \n\ +urlwrite (\"ftp://ftp.octave.org/pub/octave/README\",\n\ \"README.txt\");\n\ @end group\n\ @end example\n\ @@ -809,8 +806,8 @@ frame.add_fcn (cleanup_urlwrite, filename); - bool res; - curl_handle curl = curl_handle (url, method, param, ofile, res); + bool ok; + curl_handle curl = curl_handle (url, method, param, ofile, ok); ofile.close (); @@ -821,7 +818,7 @@ if (nargout > 0) { - if (res) + if (ok) { retval(2) = std::string (); retval(1) = true; @@ -835,7 +832,7 @@ } } - if (nargout < 2 && res) + if (nargout < 2 && ! ok) error ("urlwrite: curl: %s", curl.lasterror ().c_str ()); #else @@ -943,18 +940,18 @@ std::ostringstream buf; - bool res; - curl_handle curl = curl_handle (url, method, param, buf, res); + bool ok; + curl_handle curl = curl_handle (url, method, param, buf, ok); if (nargout > 0) { + // Return empty string if no error occured. + retval(2) = ok ? "" : curl.lasterror (); + retval(1) = ok; retval(0) = buf.str (); - retval(1) = res; - // Return empty string if no error occured. - retval(2) = res ? "" : curl.lasterror (); } - if (nargout < 2 && !res) + if (nargout < 2 && ! ok) error ("urlread: curl: %s", curl.lasterror().c_str()); #else
--- a/src/Makefile.am +++ b/src/Makefile.am @@ -3,38 +3,64 @@ # Copyright (C) 1993-2011 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/>. -include $(top_srcdir)/common.mk - -octlib_LTLIBRARIES = \ - liboctinterp.la +include $(top_srcdir)/build-aux/common.mk AM_CPPFLAGS = \ @CPPFLAGS@ -I../libgnu -I$(top_srcdir)/libgnu \ -I$(top_srcdir)/libcruft/misc \ -I../liboctave -I$(top_srcdir)/liboctave \ - -I. -I$(srcdir) + -I. -I$(srcdir) AUTOMAKE_OPTIONS = subdir-objects -## Order matters here. Leave builtins.cc last, because it depends on +octlib_LTLIBRARIES = liboctinterp.la + +if AMCOND_BUILD_COMPILED_AUX_PROGRAMS +bin_PROGRAMS = \ + mkoctfile \ + octave \ + octave-config + +mkoctfile_SOURCES = +nodist_mkoctfile_SOURCES = mkoctfile.cc +mkoctfile_LDADD = ../libgnu/libgnu.la $(LIBS) + +octave_config_SOURCES = +nodist_octave_config_SOURCES = octave-config.cc +octave_config_LDADD = ../libgnu/libgnu.la $(LIBS) + +BUILT_SOURCES_EXTRA = \ + mkoctfile.cc \ + octave-config.cc +else +bin_PROGRAMS = \ + octave + +bin_SCRIPTS = \ + mkoctfile \ + octave-config +endif + +## Order matters here. Leave builtins.cc last, because it depends on ## $(DEF_FILES), and building those requires all the sources ## (except builtins.cc) to be available. BUILT_SOURCES = \ + $(BUILT_SOURCES_EXTRA) \ defaults.h \ graphics.h \ graphics-props.cc \ @@ -52,9 +78,8 @@ oct-gperf.h \ oct-parse.h -## FIXME -- These files don't need to be distributed. Some of them -## do need to be installed. So we need to add them to a list somewhere -## so that happens correctly. +## Files that are created during build process and installed, +## BUT not distributed in tarball. BUILT_NODISTFILES = \ defaults.h \ graphics.h \ @@ -65,11 +90,10 @@ version.h \ $(OPT_HANDLERS) \ $(OPT_INC) \ - $(DEF_FILES) \ + $(ALL_DEF_FILES) \ builtins.cc EXTRA_DIST = \ - ChangeLog \ Makefile.in \ defaults.h.in \ DOCSTRINGS \ @@ -82,23 +106,18 @@ mkbuiltins \ mkdefs \ mkgendoc \ + mkoctfile.cc.in \ + mkoctfile.in \ mkops \ mxarray.h.in \ oct-conf.h.in \ oct-errno.cc.in \ + octave-config.cc.in \ + octave-config.in \ octave.gperf \ version.h.in \ $(BUILT_DISTFILES) -DLL_CDEFS = @OCTINTERP_DLL_DEFS@ -DLL_CXXDEFS = @OCTINTERP_DLL_DEFS@ - -.cc.df: - $(CXXCPP) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ - $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) \ - -DMAKE_BUILTINS $< | $(srcdir)/mkdefs $(srcdir) $< > $@-t - mv $@-t $@ - OPT_HANDLERS = \ DASPK-opts.cc \ DASRT-opts.cc \ @@ -106,13 +125,6 @@ LSODE-opts.cc \ Quad-opts.cc -OPT_IN = \ - ../liboctave/DASPK-opts.in \ - ../liboctave/DASRT-opts.in \ - ../liboctave/DASSL-opts.in \ - ../liboctave/LSODE-opts.in \ - ../liboctave/Quad-opts.in - OPT_INC = \ ../liboctave/DASPK-opts.h \ ../liboctave/DASRT-opts.h \ @@ -167,6 +179,7 @@ ov-lazy-idx.h \ ov-mex-fcn.h \ ov-null-mat.h \ + ov-oncleanup.h \ ov-perm.h \ ov-range.h \ ov-re-diag.h \ @@ -218,13 +231,12 @@ octinclude_HEADERS = \ Cell.h \ - base-list.h \ builtins.h \ c-file-ptr-stream.h \ comment-list.h \ cutils.h \ + data.h \ debug.h \ - defaults.h \ defun-dld.h \ defun-int.h \ defun.h \ @@ -236,7 +248,6 @@ gl-render.h \ gl2ps.h \ gl2ps-renderer.h \ - graphics.h \ graphics-props.cc \ gripes.h \ help.h \ @@ -254,8 +265,6 @@ ls-utils.h \ mex.h \ mexproto.h \ - mxarray.h \ - oct-conf.h \ oct-errno.h \ oct-fstrm.h \ oct-gperf.h \ @@ -277,6 +286,7 @@ parse.h \ pr-output.h \ procstream.h \ + profiler.h \ sighandlers.h \ siglist.h \ sparse-xdiv.h \ @@ -290,7 +300,6 @@ unwind-prot.h \ utils.h \ variables.h \ - version.h \ xdiv.h \ xnorm.h \ xpow.h \ @@ -299,6 +308,13 @@ $(OV_SPARSE_INCLUDES) \ $(PT_INCLUDES) +nodist_octinclude_HEADERS = \ + defaults.h \ + graphics.h \ + oct-conf.h \ + mxarray.h \ + version.h + OV_INTTYPE_SRC = \ ov-int16.cc \ ov-int32.cc \ @@ -341,6 +357,7 @@ ov-lazy-idx.cc \ ov-mex-fcn.cc \ ov-null-mat.cc \ + ov-oncleanup.cc \ ov-perm.cc \ ov-range.cc \ ov-re-diag.cc \ @@ -432,6 +449,7 @@ pager.cc \ pr-output.cc \ procstream.cc \ + profiler.cc \ sighandlers.cc \ siglist.c \ sparse.cc \ @@ -464,120 +482,18 @@ include TEMPLATE-INST/module.mk if AMCOND_ENABLE_DYNAMIC_LINKING - DLD_DYNAMIC_SRC = $(DLD_FUNCTIONS_SRC) - DLD_STATIC_SRC = OCT_FILES = $(DLD_FUNCTIONS_LIBS:.la=.oct) OCT_STAMP_FILES = $(subst DLD-FUNCTIONS/,DLD-FUNCTIONS/$(am__leading_dot),$(DLD_FUNCTIONS_LIBS:.la=.oct-stamp)) else - DLD_DYNAMIC_SRC = - DLD_STATIC_SRC = $(DLD_FUNCTIONS_SRC) OCT_FILES = OCT_STAMP_FILES = endif liboctinterp_la_SOURCES = \ $(DIST_SRC) \ - $(DLD_STATIC_SRC) \ $(OPERATORS_SRC) \ $(TEMPLATE_INST_SRC) -DLD_DYNAMIC_DEF_FILES = $(DLD_DYNAMIC_SRC:.cc=.df) -DLD_STATIC_DEF_FILES = $(DLD_STATIC_SRC:.cc=.df) - -SRC_DEF_FILES := $(shell $(srcdir)/find-defun-files.sh "$(srcdir)" $(DIST_SRC)) - -## builtins.cc depends on $(DEF_FILES), so DEF_FILES should only include -## .df files that correspond to sources included in liboctave. -DEF_FILES = $(SRC_DEF_FILES) $(DLD_STATIC_DEF_FILES) - -ALL_DEF_FILES = $(DEF_FILES) $(DLD_DYNAMIC_DEF_FILES) - -$(DEF_FILES) $(DYNAMIC_DLD_DEF_FILES): mkdefs Makefile - -$(DEF_FILES): $(OPT_HANDLERS) $(OPT_INC) - -if AMCOND_ENABLE_DYNAMIC_LINKING - OCTAVE_LIBS = \ - ./liboctinterp.la \ - ../liboctave/liboctave.la \ - ../libcruft/libcruft.la \ - ../libcruft/libranlib.la \ - ../libgnu/libgnu.la \ - $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) \ - $(QRUPDATE_LDFLAGS) $(QRUPDATE_LIBS) \ - $(FFTW_XLDFLAGS) $(FFTW_XLIBS) \ - $(LAPACK_LIBS) $(BLAS_LIBS) \ - $(GRAPHICS_LDFLAGS) $(GRAPHICS_LIBS) \ - $(FT2_LDFLAGS) $(FT2_LIBS) \ - $(HDF5_LDFLAGS) $(HDF5_LIBS) $(Z_LDFLAGS) $(Z_LIBS) \ - $(OPENGL_LIBS) $(X11_LIBS) $(CARBON_LIBS) \ - $(READLINE_LIBS) $(TERM_LIBS) \ - $(LIBGLOB) \ - $(REGEX_LDFLAGS) $(REGEX_LIBS) \ - $(LAPACK_LIBS) $(BLAS_LIBS) \ - $(DL_LIBS) $(PTHREAD_LIBS) \ - $(LIBS) \ - $(FLIBS) -else - ## FIXME -- this list is probably not complete now. It may not even - ## be possible to build a statically linked copy of Octave that is - ## fully functional. - OCTAVE_LIBS = \ - ./liboctinterp.la \ - ../liboctave/liboctave.la \ - ../libcruft/libcruft.la \ - ../libcruft/libranlib.la \ - ../libgnu/libgnu.la \ - $(FFTW_XLDFLAGS) $(FFTW_XLIBS) - $(QHULL_LDFLAGS) $(QHULL_LIBS) \ - $(QRUPDATE_LDFLAGS) $(QRUPDATE_LIBS) \ - $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) \ - $(REGEX_LDFLAGS) $(REGEX_LIBS) \ - $(CURL_LDFLAGS) $(CURL_LIBS) \ - $(GLPK_LDFLAGS) $(GLPK_LIBS) \ - $(MAGICK_LDFLAGS) $(MAGICK_LIBS) \ - $(GRAPHICS_LDFLAGS) $(GRAPHICS_LIBS) \ - $(FT2_LDFLAGS) $(FT2_LIBS) \ - $(HDF5_LDFLAGS) $(HDF5_LIBS) $(Z_LDFLAGS) $(Z_LIBS) \ - $(OPENGL_LIBS) $(X11_LIBS) $(CARBON_LIBS) \ - $(READLINE_LIBS) $(TERM_LIBS) \ - $(LIBGLOB) \ - $(LAPACK_LIBS) $(BLAS_LIBS) \ - $(DL_LIBS) $(PTHREAD_LIBS) \ - $(LIBS) \ - $(FLIBS) -endif - -OCTINTERP_LINK_DEPS = \ - $(RLD_FLAG) \ - ../liboctave/liboctave.la \ - ../libcruft/libcruft.la \ - ../libcruft/libranlib.la \ - ../libgnu/libgnu.la \ - $(FFTW_XLDFLAGS) $(FFTW_XLIBS) \ - $(FT2_LDFLAGS) $(FT2_LIBS) \ - $(HDF5_LDFLAGS) $(HDF5_LIBS) $(Z_LDFLAGS) $(Z_LIBS) \ - $(OPENGL_LIBS) $(X11_LIBS) $(CARBON_LIBS) \ - $(READLINE_LIBS) $(TERM_LIBS) \ - $(LIBGLOB) \ - $(LAPACK_LIBS) $(BLAS_LIBS) \ - $(LIBS) \ - $(FLIBS) - -liboctinterp_la_LIBADD = $(OCTINTERP_LINK_DEPS) - -OCT_LINK_DEPS = \ - $(RLD_FLAG) $(LDFLAGS) \ - ./liboctinterp.la \ - ../liboctave/liboctave.la \ - ../libcruft/libcruft.la \ - ../libcruft/libranlib.la \ - ../libgnu/libgnu.la - -bin_PROGRAMS = octave - -octave_SOURCES = main.c - nodist_liboctinterp_la_SOURCES = \ builtins.cc \ defaults.h \ @@ -591,45 +507,94 @@ liboctinterp_la_CPPFLAGS = @OCTINTERP_DLL_DEFS@ $(AM_CPPFLAGS) -liboctinterp_la_LDFLAGS = -release $(version) $(NO_UNDEFINED_LDFLAG) \ - -bindir $(bindir) +include link-deps.mk + +liboctinterp_la_LIBADD = \ + ../liboctave/liboctave.la \ + ../libcruft/libcruft.la \ + $(LIBOCTINTERP_LINK_DEPS) + +# Increment these as needed and according to the rules in the libtool manual: +liboctinterp_current = 0 +liboctinterp_revision = 0 +liboctinterp_age = 0 + +liboctinterp_version_info = $(liboctinterp_current):$(liboctinterp_revision):$(liboctinterp_age) -CLEANFILES = \ - DLD-FUNCTIONS/PKG_ADD \ - doc-files \ - gendoc.cc \ - gendoc$(BUILD_EXEEXT) \ - graphics-props.cc \ - oct-parse.output \ - $(BUILT_NODISTFILES) +liboctinterp_la_LDFLAGS = \ + -version-info $(liboctinterp_version_info) \ + $(NO_UNDEFINED_LDFLAG) \ + -bindir $(bindir) \ + $(LIBOCTINTERP_LINK_OPTS) + +display.df display.lo: CPPFLAGS += $(X11_FLAGS) + +octave_SOURCES = main.c -DISTCLEANFILES = \ - .DOCSTRINGS \ - DOCSTRINGS \ - $(OCT_FILES) \ - $(OCT_STAMP_FILES) +octave_LDADD = \ + liboctinterp.la \ + ../liboctave/liboctave.la \ + ../libcruft/libcruft.la \ + $(OCTAVE_LINK_DEPS) + +octave_LDFLAGS = \ + $(NO_UNDEFINED_LDFLAG) \ + $(OCTAVE_LINK_OPTS) + +## Section for defining and creating DEF_FILES +SRC_DEF_FILES := $(shell $(srcdir)/find-defun-files.sh "$(srcdir)" $(DIST_SRC)) + +DLD_FUNCTIONS_DEF_FILES = $(DLD_FUNCTIONS_SRC:.cc=.df) -MAINTAINERCLEANFILES = \ - $(BUILT_DISTFILES) +## builtins.cc depends on $(DEF_FILES), so DEF_FILES should only include +## .df files that correspond to sources included in liboctave. +if AMCOND_ENABLE_DYNAMIC_LINKING + DEF_FILES = $(SRC_DEF_FILES) +else + DEF_FILES = $(SRC_DEF_FILES) $(DLD_FUNCTIONS_DEF_FILES) +endif -octave_LDADD = $(OCTAVE_LIBS) +ALL_DEF_FILES = $(SRC_DEF_FILES) $(DLD_FUNCTIONS_DEF_FILES) + +$(SRC_DEF_FILES): mkdefs Makefile -all-local: $(OCT_STAMP_FILES) DLD-FUNCTIONS/PKG_ADD .DOCSTRINGS +$(DEF_FILES): $(OPT_HANDLERS) $(OPT_INC) + +DLL_CDEFS = @OCTINTERP_DLL_DEFS@ +DLL_CXXDEFS = @OCTINTERP_DLL_DEFS@ -lex.lo lex.o oct-parse.lo oct-parse.o: \ - AM_CXXFLAGS := $(filter-out -Wold-style-cast, $(AM_CXXFLAGS)) +## Rule to build a DEF file from a .cc file +%.df: %.cc + $(CXXCPP) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) \ + -DMAKE_BUILTINS $< | $(srcdir)/mkdefs $(srcdir) $< > $@-t + mv $@-t $@ -__fltk_uigetfile__.lo __fltk_uigetfile__.o: \ - AM_CXXFLAGS := $(filter-out $(DLL_CXXDEFS), $(AM_CXXFLAGS) $(GRAPHICS_CFLAGS)) +## Special rules: +## Mostly for sources which must be built before rest of compilation. -__init_fltk__.lo __init_fltk__.o: \ - AM_CXXFLAGS := $(filter-out $(DLL_CXXDEFS), $(AM_CXXFLAGS) $(GRAPHICS_CFLAGS)) +## defaults.h and oct-conf.h must depend on Makefile. Calling configure +## may change default/config values. However, calling configure will also +## regenerate the Makefiles from Makefile.am and trigger the rules below. +defaults.h: defaults.h.in Makefile + @$(do_subst_default_vals) + +graphics.h: graphics.h.in genprops.awk Makefile + $(AWK) -f $(srcdir)/genprops.awk $< > $@-t + mv $@-t $@ -# XERBLA = ../libcruft/blas-xtra/xerbla.o +oct-conf.h: oct-conf.h.in Makefile + @$(do_subst_config_vals) -builtins.cc: $(DEF_FILES) mkbuiltins - $(srcdir)/mkbuiltins $(DEF_FILES) > $@-t +## Don't use a pipeline to process gperf output since if gperf +## is missing but sed is not, the exit status of the pipeline +## will still be success and we will end up creating an empty +## oct-gperf.h file. +oct-gperf.h: octave.gperf + $(GPERF) -t -C -D -G -L C++ -Z octave_kw_hash $< > $@-t1 + $(SED) 's,lookup\[,gperf_lookup[,' < $@-t1 > $@-t mv $@-t $@ + rm -f $@-t1 mxarray.h: mxarray.h.in Makefile $(SED) < $< \ @@ -645,18 +610,52 @@ -e "s|%OCTAVE_VERSION%|\"${OCTAVE_VERSION}\"|" > $@-t mv $@-t $@ -graphics.h: graphics.h.in genprops.awk Makefile - $(AWK) -f $(srcdir)/genprops.awk $< > $@-t +builtins.cc: $(DEF_FILES) mkbuiltins + $(srcdir)/mkbuiltins $(DEF_FILES) > $@-t mv $@-t $@ graphics-props.cc: graphics.h.in genprops.awk Makefile $(AWK) -v emit_graphics_props=1 -f $(srcdir)/genprops.awk $< > $@-t mv $@-t $@ -DLD-FUNCTIONS/PKG_ADD: $(DLD_DYNAMIC_DEF_FILES) mk-pkg-add - $(srcdir)/mk-pkg-add $(DLD_DYNAMIC_DEF_FILES) > $@-t +ops.cc: $(OPERATORS_SRC) mkops + $(srcdir)/mkops $(OPERATORS_SRC) > $@-t + mv $@-t $@ + +oct-errno.cc: oct-errno.cc.in Makefile + if test -n "$(PERL)"; then \ + $(srcdir)/mk-errno-list --perl "$(PERL)" < $< > $@-t; \ + elif test -n "$(PYTHON)"; then \ + $(srcdir)/mk-errno-list --python "$(PYTHON)" < $< > $@-t; \ + else \ + $(SED) '/@SYSDEP_ERRNO_LIST@/D' $< > $@-t; \ + fi + mv $@-t $@ + +$(OPT_HANDLERS) : %.cc : $(top_srcdir)/liboctave/%.in $(top_srcdir)/build-aux/mk-opts.pl + $(PERL) $(top_srcdir)/build-aux/mk-opts.pl --opt-handler-fcns $< > $@-t mv $@-t $@ +$(OPT_INC) : %.h : %.in + $(MAKE) -C $(@D) $(@F) + +if AMCOND_ENABLE_DYNAMIC_LINKING +DLD_FUNCTIONS_PKG_ADD_FILE = DLD-FUNCTIONS/PKG_ADD + +DLD-FUNCTIONS/PKG_ADD: $(DLD_FUNCTIONS_DEF_FILES) mk-pkg-add + $(srcdir)/mk-pkg-add $(DLD_FUNCTIONS_DEF_FILES) > $@-t + mv $@-t $@ +endif + +lex.lo lex.o oct-parse.lo oct-parse.o: \ + AM_CXXFLAGS := $(filter-out -Wold-style-cast, $(AM_CXXFLAGS)) + +__fltk_uigetfile__.lo __fltk_uigetfile__.o: \ + AM_CXXFLAGS := $(filter-out $(DLL_CXXDEFS), $(AM_CXXFLAGS) $(GRAPHICS_CFLAGS)) + +__init_fltk__.lo __init_fltk__.o: \ + AM_CXXFLAGS := $(filter-out $(DLL_CXXDEFS), $(AM_CXXFLAGS) $(GRAPHICS_CFLAGS)) + .DOCSTRINGS: gendoc$(BUILD_EXEEXT) if [ "x$(srcdir)" != "x." ] && [ -f $(srcdir)/DOCSTRINGS ] && [ ! -f DOCSTRINGS ]; then \ cp $(srcdir)/DOCSTRINGS DOCSTRINGS; \ @@ -664,7 +663,7 @@ fi @echo "creating .DOCSTRINGS from .cc source files" @./gendoc > $@ - $(top_srcdir)/move-if-change $@ DOCSTRINGS + $(top_srcdir)/build-aux/move-if-change $@ DOCSTRINGS touch $@ doc-files: $(ALL_DEF_FILES) @@ -678,9 +677,23 @@ gendoc$(BUILD_EXEEXT): gendoc.cc $(BUILD_CXX) $(BUILD_CXXFLAGS) -o $@ $^ $(BUILD_LDFLAGS) -ops.cc: $(OPERATORS_SRC) mkops - $(srcdir)/mkops $(OPERATORS_SRC) > $@-t - mv $@-t $@ +all-local: $(OCT_STAMP_FILES) $(DLD_FUNCTIONS_PKG_ADD_FILE) .DOCSTRINGS + +if AMCOND_BUILD_COMPILED_AUX_PROGRAMS +octave-config.cc: octave-config.cc.in Makefile + @$(do_subst_default_vals) + +mkoctfile.cc: mkoctfile.cc.in Makefile + @$(do_subst_config_vals) +else +octave-config: octave-config.in Makefile + @$(do_subst_default_vals) + chmod a+rx $@ + +mkoctfile: mkoctfile.in Makefile + @$(do_subst_config_vals) + chmod a+rx $@ +endif install-exec-hook: make-version-links @@ -690,19 +703,35 @@ make-version-links: cd $(DESTDIR)$(bindir) && \ - mv octave$(EXEEXT) octave-$(version)$(EXEEXT) && \ - $(LN_S) octave-$(version)$(EXEEXT) octave$(EXEEXT) -.PHONY: make-version-links + for f in $(basename $(bin_PROGRAMS)); do \ + mv $$f$(EXEEXT) $$f-$(version)$(EXEEXT) && \ + $(LN_S) $$f-$(version)$(EXEEXT) $$f$(EXEEXT); \ + done +if ! AMCOND_BUILD_COMPILED_AUX_PROGRAMS + cd $(DESTDIR)$(bindir) && \ + for f in $(basename $(bin_SCRIPTS)); do \ + mv $$f $$f-$(version) && \ + $(LN_S) $$f-$(version) $$f; \ + done +endif remove-version-links: - rm -f $(DESTDIR)$(bindir)/octave-$(version)$(EXEEXT) -.PHONY: remove-version-links + for f in $(basename $(bin_PROGRAMS)); do \ + rm -f $(DESTDIR)$(bindir)/$$f-$(version)$(EXEEXT); \ + done +if ! AMCOND_BUILD_COMPILED_AUX_PROGRAMS + for f in $(basename $(bin_SCRIPTS)); do \ + rm -f $(DESTDIR)$(bindir)/$$f-$(version); \ + done +endif + +.PHONY: make-version-links remove-version-links if AMCOND_ENABLE_DYNAMIC_LINKING install-oct: - $(top_srcdir)/mkinstalldirs $(DESTDIR)$(octfiledir) - if [ -n "`cat DLD-FUNCTIONS/PKG_ADD`" ]; then \ - $(INSTALL_DATA) DLD-FUNCTIONS/PKG_ADD $(DESTDIR)$(octfiledir)/PKG_ADD; \ + $(top_srcdir)/build-aux/mkinstalldirs $(DESTDIR)$(octfiledir) + if [ -n "`cat $(DLD_FUNCTIONS_PKG_ADD_FILE)`" ]; then \ + $(INSTALL_DATA) $(DLD_FUNCTIONS_PKG_ADD_FILE) $(DESTDIR)$(octfiledir)/PKG_ADD; \ fi cd $(DESTDIR)$(octlibdir) && \ for ltlib in $(DLD_FUNCTIONS_LIBS); do \ @@ -728,144 +757,21 @@ endif .PHONY: install-oct uninstall-oct -# Special rules -- these files need special things to be defined. - -$(OPT_HANDLERS) : %.cc : $(top_srcdir)/liboctave/%.in $(top_srcdir)/mk-opts.pl - $(PERL) $(top_srcdir)/mk-opts.pl --opt-handler-fcns $< > $@-t - mv $@-t $@ - -## We require Bison. -#parse.cc : parse.y -# @echo "expect 14 shift/reduce conflicts" -# $(YACC) $(YFLAGS) --output=$@ --defines=y.tab.h $< - -#lex.cc : lex.l -# $(LEX) $(LFLAGS) $< > $(@F)-t -# @mv $(@F)-t $@ - - -$(OPT_INC) : %.h : %.in - $(MAKE) -C $(@D) $@ - -## defaults.h and oct-conf.h must depend on Makefile. Calling configure -## may change default/config values. However, calling configure will also -## regenerate the Makefiles from Makefile.am and trigger the rules below. - -defaults.h: defaults.h.in Makefile - @$(do_subst_default_vals) - -oct-conf.h: oct-conf.h.in Makefile - @$(do_subst_config_vals) - -oct-errno.cc: oct-errno.cc.in Makefile - if test -n "$(PERL)"; then \ - $(srcdir)/mk-errno-list --perl "$(PERL)" < $< > $@-t; \ - elif test -n "$(PYTHON)"; then \ - $(srcdir)/mk-errno-list --python "$(PYTHON)" < $< > $@-t; \ - else \ - $(SED) '/@SYSDEP_ERRNO_LIST@/D' $< > $@-t; \ - fi - mv $@-t $@ - -## Don't use a pipeline to process gperf output since if gperf -## is missing but sed is not, the exit status of the pipeline -## will still be success and we will end up creating an empty -## oct-gperf.h file. -oct-gperf.h: octave.gperf - $(GPERF) -t -C -D -G -L C++ -Z octave_kw_hash $< > $@-t1 - $(SED) 's,lookup\[,gperf_lookup[,' < $@-t1 > $@-t - mv $@-t $@ - rm -f $@-t1 - -display.df display.lo: CPPFLAGS += $(X11_FLAGS) - -DLD-FUNCTIONS/__magick_read__.df: CPPFLAGS += $(MAGICK_CPPFLAGS) -DLD_FUNCTIONS___magick_read___la_CPPFLAGS = $(AM_CPPFLAGS) $(MAGICK_CPPFLAGS) -DLD_FUNCTIONS___magick_read___la_LIBADD += $(MAGICK_LDFLAGS) $(MAGICK_LIBS) - -DLD-FUNCTIONS/convhulln.df: CPPFLAGS += $(QHULL_CPPFLAGS) -DLD_FUNCTIONS_convhulln_la_CPPFLAGS = $(AM_CPPFLAGS) $(QHULL_CPPFLAGS) -DLD_FUNCTIONS_convhulln_la_LIBADD += $(QHULL_LDFLAGS) $(QHULL_LIBS) - -DLD-FUNCTIONS/__delaunayn__.df: CPPFLAGS += $(QHULL_CPPFLAGS) -DLD_FUNCTIONS___delaunayn___la_CPPFLAGS = $(AM_CPPFLAGS) $(QHULL_CPPFLAGS) -DLD_FUNCTIONS___delaunayn___la_LIBADD += $(QHULL_LDFLAGS) $(QHULL_LIBS) - -DLD-FUNCTIONS/__voronoi__.df: CPPFLAGS += $(QHULL_CPPFLAGS) -DLD_FUNCTIONS___voronoi___la_CPPFLAGS = $(AM_CPPFLAGS) $(QHULL_CPPFLAGS) -DLD_FUNCTIONS___voronoi___la_LIBADD += $(QHULL_LDFLAGS) $(QHULL_LIBS) - -DLD-FUNCTIONS/eigs.df: CPPFLAGS += $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_eigs_la_CPPFLAGS = $(AM_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_eigs_la_LIBADD += $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) $(LAPACK_LIBS) $(BLAS_LIBS) +CLEANFILES = \ + $(bin_SCRIPTS) \ + $(DLD_FUNCTIONS_PKG_ADD_FILE) \ + doc-files \ + gendoc.cc \ + gendoc$(BUILD_EXEEXT) \ + graphics-props.cc \ + oct-parse.output -#DLD-FUNCTIONS/qz.df DLD-FUNCTIONS/qz.lo: -DLD_FUNCTIONS_qz_la_LIBADD += $(LAPACK_LIBS) $(BLAS_LIBS) - -DLD-FUNCTIONS/qr.df: CPPFLAGS += $(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_qr_la_CPPFLAGS = $(AM_CPPFLAGS) $(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_qr_la_LIBADD += $(QRUPDATE_LDFLAGS) $(QRUPDATE_LIBS) $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/chol.df: CPPFLAGS += $(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_chol_la_CPPFLAGS = $(AM_CPPFLAGS) $(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_chol_la_LIBADD += $(QRUPDATE_LDFLAGS) $(QRUPDATE_LIBS) $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/regexp.df: CPPFLAGS += $(REGEX_CPPFLAGS) -DLD_FUNCTIONS_regexp_la_CPPFLAGS = $(AM_CPPFLAGS) $(REGEX_CPPFLAGS) -DLD_FUNCTIONS_regexp_la_LIBADD += $(REGEX_LDFLAGS) $(REGEX_LIBS) - -DLD-FUNCTIONS/urlwrite.df: CPPFLAGS += $(CURL_CPPFLAGS) -DLD_FUNCTIONS_urlwrite_la_CPPFLAGS = $(AM_CPPFLAGS) $(CURL_CPPFLAGS) -DLD_FUNCTIONS_urlwrite_la_LIBADD += $(CURL_LDFLAGS) $(CURL_LIBS) - -DLD-FUNCTIONS/__fltk_uigetfile__.df: CPPFLAGS += $(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS) -DLD_FUNCTIONS___fltk_uigetfile___la_CPPFLAGS = $(AM_CPPFLAGS) $(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS) -DLD_FUNCTIONS___fltk_uigetfile___la_LIBADD += $(GRAPHICS_LDFLAGS) $(GRAPHICS_LIBS) $(FT2_LDFLAGS) $(FT2_LIBS) - -DLD-FUNCTIONS/__glpk__.df: CPPFLAGS += $(GLPK_CPPFLAGS) -DLD_FUNCTIONS___glpk___la_CPPFLAGS = $(AM_CPPFLAGS) $(GLPK_CPPFLAGS) -DLD_FUNCTIONS___glpk___la_LIBADD += $(GLPK_LDFLAGS) $(GLPK_LIBS) - -DLD-FUNCTIONS/__init_fltk__.df: CPPFLAGS += $(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS) -DLD_FUNCTIONS___init_fltk___la_CPPFLAGS = $(AM_CPPFLAGS) $(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS) -DLD_FUNCTIONS___init_fltk___la_LIBADD += $(GRAPHICS_LDFLAGS) $(GRAPHICS_LIBS) $(FT2_LDFLAGS) $(FT2_LIBS) - -DLD-FUNCTIONS/amd.df: CPPFLAGS += $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_amd_la_CPPFLAGS = $(AM_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_amd_la_LIBADD += $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) +DISTCLEANFILES = \ + .DOCSTRINGS \ + DOCSTRINGS \ + $(BUILT_NODISTFILES) \ + $(OCT_FILES) \ + $(OCT_STAMP_FILES) -DLD-FUNCTIONS/colamd.df: CPPFLAGS += $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_colamd_la_CPPFLAGS = $(AM_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_colamd_la_LIBADD += $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/ccolamd.df: CPPFLAGS += $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_ccolamd_la_CPPFLAGS = $(AM_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_ccolamd_la_LIBADD += $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/symbfact.df: CPPFLAGS += $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_symbfact_la_CPPFLAGS = $(AM_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_symbfact_la_LIBADD += $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/dmperm.df: CPPFLAGS += $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_dmperm_la_CPPFLAGS = $(AM_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_dmperm_la_LIBADD += $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/symrcm.df: CPPFLAGS += $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_symrcm_la_CPPFLAGS = $(AM_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_symrcm_la_LIBADD += $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/fft.df: CPPFLAGS += $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fft_la_CPPFLAGS = $(AM_CPPFLAGS) $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fft_la_LIBADD += $(FFTW_XLDFLAGS) $(FFTW_XLIBS) - -DLD-FUNCTIONS/fft2.df: CPPFLAGS += $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fft2_la_CPPFLAGS = $(AM_CPPFLAGS) $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fft2_la_LIBADD += $(FFTW_XLDFLAGS) $(FFTW_XLIBS) - -DLD-FUNCTIONS/fftn.df: CPPFLAGS += $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fftn_la_CPPFLAGS = $(AM_CPPFLAGS) $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fftn_la_LIBADD += $(FFTW_XLDFLAGS) $(FFTW_XLIBS) - -DLD-FUNCTIONS/fftw.df: CPPFLAGS += $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fftw_la_CPPFLAGS = $(AM_CPPFLAGS) $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fftw_la_LIBADD += $(FFTW_XLDFLAGS) $(FFTW_XLIBS) +MAINTAINERCLEANFILES = \ + $(BUILT_DISTFILES)
--- a/src/OPERATORS/op-cell.cc +++ b/src/OPERATORS/op-cell.cc @@ -51,36 +51,6 @@ DEFCATOP_FN (c_c, cell, cell, concat) -static octave_value -oct_catop_cell_matrix (octave_base_value& a1, const octave_base_value& a2, - const Array<octave_idx_type>&) -{ - octave_value retval; - CAST_BINOP_ARGS (const octave_cell&, const octave_matrix&); - NDArray tmp = v2.array_value (); - dim_vector dv = tmp.dims (); - if (dv.all_zero ()) - retval = octave_value (v1.cell_value ()); - else - error ("invalid concatenation of cell array with matrix"); - return retval; -} - -static octave_value -oct_catop_matrix_cell (octave_base_value& a1, const octave_base_value& a2, - const Array<octave_idx_type>&) -{ - octave_value retval; - CAST_BINOP_ARGS (const octave_matrix&, const octave_cell&); - NDArray tmp = v1.array_value (); - dim_vector dv = tmp.dims (); - if (dv.all_zero ()) - retval = octave_value (v2.cell_value ()); - else - error ("invalid concatenation of cell array with matrix"); - return retval; -} - DEFASSIGNANYOP_FN (assign, cell, assign); DEFNULLASSIGNOP_FN (null_assign, cell, delete_elements) @@ -93,9 +63,6 @@ INSTALL_CATOP (octave_cell, octave_cell, c_c); - INSTALL_CATOP (octave_cell, octave_matrix, cell_matrix); - INSTALL_CATOP (octave_matrix, octave_cell, matrix_cell); - INSTALL_ASSIGNANYOP (op_asn_eq, octave_cell, assign); INSTALL_ASSIGNOP (op_asn_eq, octave_cell, octave_null_matrix, null_assign);
--- a/src/OPERATORS/op-fcm-fcm.cc +++ b/src/OPERATORS/op-fcm-fcm.cc @@ -214,7 +214,9 @@ DEFNDASSIGNOP_FN (assign, float_complex_matrix, float_complex_matrix, float_complex_array, assign) -DEFNDASSIGNOP_FN (dbl_assign, float_complex_matrix, complex_matrix, +DEFNDASSIGNOP_FN (dbl_clx_assign, float_complex_matrix, complex_matrix, + float_complex_array, assign) +DEFNDASSIGNOP_FN (dbl_assign, float_complex_matrix, matrix, float_complex_array, assign) DEFNULLASSIGNOP_FN (null_assign, float_complex_matrix, delete_elements) @@ -308,7 +310,9 @@ INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, octave_float_complex_matrix, assign); INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, - octave_complex_matrix, dbl_assign); + octave_complex_matrix, dbl_clx_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, + octave_matrix, dbl_assign); INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, octave_null_matrix, null_assign);
--- a/src/OPERATORS/op-int.h +++ b/src/OPERATORS/op-int.h @@ -21,6 +21,7 @@ */ #include "quit.h" +#include "bsxfun.h" #define DEFINTBINOP_OP(name, t1, t2, op, t3) \ BINOPDECL (name, a1, a2) \ @@ -703,8 +704,15 @@ dim_vector b_dims = b.dims (); \ if (a_dims != b_dims) \ { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ } \ T1 ## NDArray result (a_dims); \ for (int i = 0; i < a.length (); i++) \ @@ -722,8 +730,15 @@ dim_vector b_dims = b.dims (); \ if (a_dims != b_dims) \ { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ } \ T1 ## NDArray result (a_dims); \ for (int i = 0; i < a.length (); i++) \ @@ -741,8 +756,15 @@ dim_vector b_dims = b.dims (); \ if (a_dims != b_dims) \ { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ } \ T2 ## NDArray result (a_dims); \ for (int i = 0; i < a.length (); i++) \ @@ -760,8 +782,15 @@ dim_vector b_dims = b.dims (); \ if (a_dims != b_dims) \ { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ } \ T1 ## NDArray result (a_dims); \ for (int i = 0; i < a.length (); i++) \ @@ -779,8 +808,15 @@ dim_vector b_dims = b.dims (); \ if (a_dims != b_dims) \ { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ } \ T2 ## NDArray result (a_dims); \ for (int i = 0; i < a.length (); i++) \
--- a/src/OPERATORS/op-m-s.cc +++ b/src/OPERATORS/op-m-s.cc @@ -29,6 +29,7 @@ #include "ov.h" #include "ov-re-mat.h" #include "ov-flt-re-mat.h" +#include "ov-flt-cx-mat.h" #include "ov-scalar.h" #include "ov-typeinfo.h" #include "ops.h" @@ -106,6 +107,7 @@ DEFNDASSIGNOP_FN (assign, matrix, scalar, scalar, assign) DEFNDASSIGNOP_FN (sgl_assign, float_matrix, scalar, float_scalar, assign) +DEFNDASSIGNOP_FN (clx_sgl_assign, float_complex_matrix, scalar, float_complex, assign) DEFNDASSIGNOP_OP (assign_add, matrix, scalar, scalar, +=) DEFNDASSIGNOP_OP (assign_sub, matrix, scalar, scalar, -=) @@ -144,6 +146,7 @@ INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_scalar, assign); INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_scalar, sgl_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, octave_scalar, clx_sgl_assign); INSTALL_ASSIGNOP (op_add_eq, octave_matrix, octave_scalar, assign_add); INSTALL_ASSIGNOP (op_sub_eq, octave_matrix, octave_scalar, assign_sub);
--- a/src/OPERATORS/op-pm-sm.cc +++ b/src/OPERATORS/op-pm-sm.cc @@ -32,6 +32,49 @@ #include "ov-perm.h" #include "ov-re-sparse.h" +#include "ov-bool-sparse.h" + +// Unary permutation ops, some cast to sparse + +//Avoid casting to a full matrix +DEFUNOP_OP (uplus, perm_matrix, /* no-op */) + +// Not calling standard CAST_UNOP_ARG for these next two because a +// dynamic_cast would fail. +DEFUNOP (not, perm_matrix) +{ + // Obviously negation of a permutation matrix destroys sparsity + return octave_value ( ! a.bool_array_value ()); +} + +DEFUNOP (uminus, perm_matrix) +{ + return octave_value ( - a.sparse_matrix_value ()); +} + +// Most other logical operations cast to SparseBoolMatrix +DEFBINOP (eq_pm, perm_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); + return v1.sparse_bool_matrix_value () == v2.sparse_bool_matrix_value (); +} +DEFBINOP (ne_pm, perm_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); + return v1.sparse_bool_matrix_value () != v2.sparse_bool_matrix_value (); +} +DEFBINOP (el_and_pm, perm_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); + return mx_el_and(v1.sparse_bool_matrix_value (), + v2.sparse_bool_matrix_value ()); +} +DEFBINOP (el_or_pm, perm_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); + return mx_el_or(v1.sparse_bool_matrix_value (), + v2.sparse_bool_matrix_value ()); +} // permutation matrix by sparse matrix ops @@ -86,6 +129,11 @@ void install_pm_sm_ops (void) { + INSTALL_UNOP (op_not, octave_perm_matrix, not); + INSTALL_UNOP (op_uplus, octave_perm_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_perm_matrix, uminus); + + INSTALL_BINOP (op_mul, octave_perm_matrix, octave_sparse_matrix, mul_pm_sm); INSTALL_BINOP (op_ldiv, octave_perm_matrix, octave_sparse_matrix, @@ -94,4 +142,9 @@ mul_sm_pm); INSTALL_BINOP (op_div, octave_sparse_matrix, octave_perm_matrix, div_sm_pm); + + INSTALL_BINOP (op_eq, octave_perm_matrix, octave_perm_matrix, eq_pm); + INSTALL_BINOP (op_ne, octave_perm_matrix, octave_perm_matrix, ne_pm); + INSTALL_BINOP (op_el_and, octave_perm_matrix, octave_perm_matrix, el_and_pm); + INSTALL_BINOP (op_el_or, octave_perm_matrix, octave_perm_matrix, el_or_pm); }
--- a/src/OPERATORS/op-sbm-b.cc +++ b/src/OPERATORS/op-sbm-b.cc @@ -30,6 +30,14 @@ #include "ov.h" #include "ov-typeinfo.h" #include "ov-bool.h" +#include "ov-int8.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-uint8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" #include "ov-scalar.h" #include "ops.h" @@ -77,6 +85,24 @@ return octave_value (); } +static octave_value +oct_assignop_conv_and_assign (octave_base_value& a1, + const octave_value_list& idx, + const octave_base_value& a2) +{ + octave_sparse_bool_matrix& v1 = dynamic_cast<octave_sparse_bool_matrix&> (a1); + + // FIXME -- perhaps add a warning for this conversion if the values + // are not all 0 or 1? + + SparseBoolMatrix v2 (1, 1, a2.bool_value ()); + + if (! error_state) + v1.assign (idx, v2); + + return octave_value (); +} + void install_sbm_b_ops (void) { @@ -91,4 +117,25 @@ INSTALL_CATOP (octave_sparse_matrix, octave_bool, sm_b); INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_bool, assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_scalar, + conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int8_scalar, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int16_scalar, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int32_scalar, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int64_scalar, + conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint8_scalar, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint16_scalar, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint32_scalar, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint64_scalar, + conv_and_assign); }
--- a/src/OPERATORS/op-sbm-bm.cc +++ b/src/OPERATORS/op-sbm-bm.cc @@ -31,9 +31,19 @@ #include "ov-typeinfo.h" #include "ov-bool-mat.h" #include "boolMatrix.h" +#include "ov-int8.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-uint8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-range.h" #include "ov-scalar.h" +#include "ov-str-mat.h" #include "ops.h" - +#include "ov-null-mat.h" #include "ov-re-sparse.h" #include "ov-bool-sparse.h" #include "smx-bm-sbm.h" @@ -79,6 +89,26 @@ return octave_value (); } +DEFNULLASSIGNOP_FN (null_assign, sparse_bool_matrix, delete_elements) + +static octave_value +oct_assignop_conv_and_assign (octave_base_value& a1, + const octave_value_list& idx, + const octave_base_value& a2) +{ + octave_sparse_bool_matrix& v1 = dynamic_cast<octave_sparse_bool_matrix&> (a1); + + // FIXME -- perhaps add a warning for this conversion if the values + // are not all 0 or 1? + + SparseBoolMatrix v2 (a2.bool_array_value ()); + + if (! error_state) + v1.assign (idx, v2); + + return octave_value (); +} + void install_sbm_bm_ops (void) { @@ -96,4 +126,42 @@ INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_bool_matrix, assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_matrix, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, + octave_char_matrix_str, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, + octave_char_matrix_sq_str, conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_range, + conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_sparse_matrix, + conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int8_matrix, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int16_matrix, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int32_matrix, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int64_matrix, + conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint8_matrix, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint16_matrix, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint32_matrix, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint64_matrix, + conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_null_matrix, + null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_null_str, + null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_null_sq_str, + null_assign); }
--- a/src/OPERATORS/op-struct.cc +++ b/src/OPERATORS/op-struct.cc @@ -34,7 +34,7 @@ // struct ops. -DEFUNOP (transpose, cell) +DEFUNOP (transpose, struct) { CAST_UNOP_ARG (const octave_struct&); @@ -47,7 +47,17 @@ return octave_value (v.map_value().transpose ()); } -DEFNDCATOP_FN (struct_struct, struct, struct, map, map, concat) +DEFUNOP (scalar_transpose, scalar_struct) +{ + CAST_UNOP_ARG (const octave_scalar_struct&); + + return octave_value (v.scalar_map_value ()); +} + +DEFNDCATOP_FN (s_s_concat, struct, struct, map, map, concat) +DEFNDCATOP_FN (s_ss_concat, struct, scalar_struct, map, map, concat) +DEFNDCATOP_FN (ss_s_concat, scalar_struct, struct, map, map, concat) +DEFNDCATOP_FN (ss_ss_concat, scalar_struct, scalar_struct, map, map, concat) static octave_value oct_catop_struct_matrix (octave_base_value& a1, const octave_base_value& a2, @@ -85,7 +95,14 @@ INSTALL_UNOP (op_transpose, octave_struct, transpose); INSTALL_UNOP (op_hermitian, octave_struct, transpose); - INSTALL_CATOP (octave_struct, octave_struct, struct_struct); + INSTALL_UNOP (op_transpose, octave_scalar_struct, scalar_transpose); + INSTALL_UNOP (op_hermitian, octave_scalar_struct, scalar_transpose); + + INSTALL_CATOP (octave_struct, octave_struct, s_s_concat); + INSTALL_CATOP (octave_struct, octave_scalar_struct, s_ss_concat) + INSTALL_CATOP (octave_scalar_struct, octave_struct, ss_s_concat) + INSTALL_CATOP (octave_scalar_struct, octave_scalar_struct, ss_ss_concat) + INSTALL_CATOP (octave_struct, octave_matrix, struct_matrix); INSTALL_CATOP (octave_matrix, octave_struct, matrix_struct); }
--- a/src/bitfcns.cc +++ b/src/bitfcns.cc @@ -410,10 +410,10 @@ @deftypefn {Built-in Function} {} bitshift (@var{a}, @var{k})\n\ @deftypefnx {Built-in Function} {} bitshift (@var{a}, @var{k}, @var{n})\n\ Return a @var{k} bit shift of @var{n}-digit unsigned\n\ -integers in @var{a}. A positive @var{k} leads to a left shift.\n\ +integers in @var{a}. A positive @var{k} leads to a left shift;\n\ A negative value to a right shift. If @var{n} is omitted it defaults\n\ to log2(bitmax)+1.\n\ -@var{n} must be in the range [1,log2(bitmax)+1] usually [1,33]\n\ +@var{n} must be in the range [1,log2(bitmax)+1] usually [1,33].\n\ \n\ @example\n\ @group\n\ @@ -428,8 +428,8 @@ bitshift (10, [-2, -1, 0, 1, 2])\n\ @result{} 2 5 10 20 40\n\ @c FIXME -- restore this example when third arg is allowed to be an array.\n\ -@c \n\ -@c \n\ +@c\n\ +@c\n\ @c bitshift ([1, 10], 2, [3,4])\n\ @c @result{} 4 8\n\ @end group\n\ @@ -518,7 +518,7 @@ @deftypefnx {Built-in Function} {} bitmax (\"double\")\n\ @deftypefnx {Built-in Function} {} bitmax (\"single\")\n\ Return the largest integer that can be represented within a floating point\n\ -value. The default class is \"double\", but \"single\" is a valid option. \n\ +value. The default class is \"double\", but \"single\" is a valid option.\n\ On IEEE-754 compatible systems, @code{bitmax} is @w{@math{2^{53} - 1}}.\n\ @end deftypefn") {
--- a/src/c-file-ptr-stream.cc +++ b/src/c-file-ptr-stream.cc @@ -68,7 +68,7 @@ { if (f) { - int_type c = fgetc (f); + int_type c = gnulib::fgetc (f); if (! bump #if defined (CXX_ISO_COMPLIANT_LIBRARY) @@ -112,7 +112,7 @@ c_file_ptr_buf::xsgetn (char *s, std::streamsize n) { if (f) - return fread (s, 1, n, f); + return gnulib::fread (s, 1, n, f); else return 0; } @@ -173,7 +173,7 @@ int c_file_ptr_buf::flush (void) { - return f ? fflush (f) : EOF; + return f ? gnulib::fflush (f) : EOF; } int @@ -193,6 +193,18 @@ } int +c_file_ptr_buf::seek (long offset, int origin) +{ + return f ? gnulib::fseek (f, offset, origin) : -1; +} + +long +c_file_ptr_buf::tell (void) +{ + return f ? gnulib::ftell (f) : -1; +} + +int c_file_ptr_buf::file_close (FILE *f) { return gnulib::fclose (f);
--- a/src/c-file-ptr-stream.h +++ b/src/c-file-ptr-stream.h @@ -74,10 +74,9 @@ int file_number () const { return f ? fileno (f) : -1; } - int seek (long offset, int origin) - { return f ? fseek (f, offset, origin) : -1; } + int seek (long offset, int origin); - long tell (void) { return f ? ftell (f) : -1; } + long tell (void); void clear (void) { if (f) clearerr (f); }
--- a/src/comment-list.cc +++ b/src/comment-list.cc @@ -25,6 +25,7 @@ #endif #include "lo-utils.h" +#include "singleton-cleanup.h" #include "comment-list.h" #include "error.h" @@ -52,7 +53,12 @@ bool retval = true; if (! instance) - instance = new octave_comment_buffer (); + { + instance = new octave_comment_buffer (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) {
--- a/src/comment-list.h +++ b/src/comment-list.h @@ -105,6 +105,8 @@ octave_comment_buffer (void) : comment_list (new octave_comment_list ()) { } + ~octave_comment_buffer (void) { delete comment_list; } + static bool instance_ok (void); static void append @@ -122,6 +124,8 @@ octave_comment_list *comment_list; static octave_comment_buffer *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } }; #endif
--- a/src/data.cc +++ b/src/data.cc @@ -53,6 +53,7 @@ #include "oct-map.h" #include "oct-obj.h" #include "ov.h" +#include "ov-class.h" #include "ov-float.h" #include "ov-complex.h" #include "ov-flt-complex.h" @@ -106,10 +107,25 @@ DEFUN (all, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} all (@var{x}, @var{dim})\n\ -The function @code{all} behaves like the function @code{any}, except\n\ -that it returns true only if all the elements of a vector, or all the\n\ -elements along dimension @var{dim} of a matrix, are nonzero.\n\ +@deftypefn {Built-in Function} {} all (@var{x})\n\ +@deftypefnx {Built-in Function} {} all (@var{x}, @var{dim})\n\ +For a vector argument, return true (logical 1) if all elements of the vector\n\ +are nonzero.\n\ +\n\ +For a matrix argument, return a row vector of logical ones and\n\ +zeros with each element indicating whether all of the elements of the\n\ +corresponding column of the matrix are nonzero. For example:\n\ +\n\ +@example\n\ +@group\n\ +all ([2, 3; 1, 0]))\n\ + @result{} [ 1, 0 ]\n\ +@end group\n\ +@end example\n\ +\n\ +If the optional argument @var{dim} is supplied, work along dimension\n\ +@var{dim}.\n\ +@seealso{any}\n\ @end deftypefn") { ANY_ALL (all); @@ -133,18 +149,19 @@ %! && all (x, 1) == [0, 1, 1] %! && all (x, 2) == [0; 1; 1])); -%!error <Invalid call to all.*> all (); -%!error <Invalid call to all.*> all (1, 2, 3); +%!error <Invalid call to all> all (); +%!error <Invalid call to all> all (1, 2, 3); */ DEFUN (any, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} any (@var{x}, @var{dim})\n\ -For a vector argument, return 1 if any element of the vector is\n\ -nonzero.\n\ -\n\ -For a matrix argument, return a row vector of ones and\n\ +@deftypefn {Built-in Function} {} any (@var{x})\n\ +@deftypefnx {Built-in Function} {} any (@var{x}, @var{dim})\n\ +For a vector argument, return true (logical 1) if any element of the vector\n\ +is nonzero.\n\ +\n\ +For a matrix argument, return a row vector of logical ones and\n\ zeros with each element indicating whether any of the elements of the\n\ corresponding column of the matrix are nonzero. For example:\n\ \n\ @@ -164,6 +181,7 @@ @result{} [ 1; 1 ]\n\ @end group\n\ @end example\n\ +@seealso{all}\n\ @end deftypefn") { ANY_ALL (any); @@ -187,8 +205,8 @@ %! && any (x, 1) == [0, 0, 1] %! && any (x, 2) == [0; 0; 1])); -%!error <Invalid call to any.*> any (); -%!error <Invalid call to any.*> any (1, 2, 3); +%!error <Invalid call to any> any (); +%!error <Invalid call to any> any (1, 2, 3); */ @@ -275,8 +293,8 @@ %! x = single([1, 3, 1, 1, 1, 1, 3, 1]); %! assert(atan2 (y, x), v, sqrt (eps('single'))); -%!error <Invalid call to atan2.*> atan2 (); -%!error <Invalid call to atan2.*> atan2 (1, 2, 3); +%!error <Invalid call to atan2> atan2 (); +%!error <Invalid call to atan2> atan2 (1, 2, 3); */ @@ -501,7 +519,7 @@ "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} rem (@var{x}, @var{y})\n\ @deftypefnx {Mapping Function} {} fmod (@var{x}, @var{y})\n\ -Return the remainder of the division @code{@var{x} / @var{y}}, computed \n\ +Return the remainder of the division @code{@var{x} / @var{y}}, computed\n\ using the expression\n\ \n\ @example\n\ @@ -571,7 +589,7 @@ { FloatNDArray a0 = args(0).float_array_value (); FloatNDArray a1 = args(1).float_array_value (); - retval = binmap<float> (a0, a1, xrem, "rem"); + retval = binmap<float> (a0, a1, xrem<float>, "rem"); } } else @@ -585,13 +603,13 @@ { SparseMatrix m0 = args(0).sparse_matrix_value (); SparseMatrix m1 = args(1).sparse_matrix_value (); - retval = binmap<double> (m0, m1, xrem, "rem"); + retval = binmap<double> (m0, m1, xrem<double>, "rem"); } else { NDArray a0 = args(0).array_value (); NDArray a1 = args(1).array_value (); - retval = binmap<double> (a0, a1, xrem, "rem"); + retval = binmap<double> (a0, a1, xrem<double>, "rem"); } } } @@ -704,7 +722,7 @@ { FloatNDArray a0 = args(0).float_array_value (); FloatNDArray a1 = args(1).float_array_value (); - retval = binmap<float> (a0, a1, xmod, "mod"); + retval = binmap<float> (a0, a1, xmod<float>, "mod"); } } else @@ -718,13 +736,13 @@ { SparseMatrix m0 = args(0).sparse_matrix_value (); SparseMatrix m1 = args(1).sparse_matrix_value (); - retval = binmap<double> (m0, m1, xmod, "mod"); + retval = binmap<double> (m0, m1, xmod<double>, "mod"); } else { NDArray a0 = args(0).array_value (); NDArray a1 = args(1).array_value (); - retval = binmap<double> (a0, a1, xmod, "mod"); + retval = binmap<double> (a0, a1, xmod<double>, "mod"); } } } @@ -1061,7 +1079,7 @@ %!assert (cumprod (single([i, 2+i, -3+2i, 4])), single([i, -1+2i, -1-8i, -4-32i])); %!assert (cumprod (single([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single([1, 2, 3; i, 4i, 9i; -1+i, -8+8i, -27+27i])); -%!error <Invalid call to cumprod.*> cumprod (); +%!error <Invalid call to cumprod> cumprod (); %!assert (cumprod ([2, 3; 4, 5], 1), [2, 3; 8, 15]); %!assert (cumprod ([2, 3; 4, 5], 2), [2, 6; 4, 20]); @@ -1076,12 +1094,13 @@ @deftypefn {Built-in Function} {} cumsum (@var{x})\n\ @deftypefnx {Built-in Function} {} cumsum (@var{x}, @var{dim})\n\ @deftypefnx {Built-in Function} {} cumsum (@dots{}, 'native')\n\ +@deftypefnx {Built-in Function} {} cumsum (@dots{}, 'double')\n\ +@deftypefnx {Built-in Function} {} cumsum (@dots{}, 'extra')\n\ Cumulative sum of elements along dimension @var{dim}. If @var{dim}\n\ is omitted, it defaults to the first non-singleton dimension.\n\ \n\ -The \"native\" argument implies the summation is performed in native type.\n\ - See @code{sum} for a complete description and example of the use of\n\ -\"native\".\n\ +See @code{sum} for an explanation of the optional parameters 'native',\n\ +'double', and 'extra'.\n\ @seealso{sum, cumprod}\n\ @end deftypefn") { @@ -1211,7 +1230,7 @@ %!assert (cumsum (single([i, 2+i, -3+2i, 4])), single([i, 2+2i, -1+4i, 3+4i])); %!assert (cumsum (single([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single([1, 2, 3; 1+i, 2+2i, 3+3i; 2+2i, 4+4i, 6+6i])); -%!error <Invalid call to cumsum.*> cumsum (); +%!error <Invalid call to cumsum> cumsum (); %!assert (cumsum ([1, 2; 3, 4], 1), [1, 2; 4, 6]); %!assert (cumsum ([1, 2; 3, 4], 2), [1, 3; 3, 7]); @@ -1223,7 +1242,11 @@ DEFUN (diag, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} diag (@var{v}, @var{k})\n\ +@deftypefn {Built-in Function} {@var{M} =} diag (@var{v})\n\ +@deftypefnx {Built-in Function} {@var{M} =} diag (@var{v}, @var{k})\n\ +@deftypefnx {Built-in Function} {@var{M} =} diag (@var{v}, @var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {@var{v} =} diag (@var{M})\n\ +@deftypefnx {Built-in Function} {@var{v} =} diag (@var{M}, @var{k})\n\ Return a diagonal matrix with vector @var{v} on diagonal @var{k}. The\n\ second argument is optional. If it is positive, the vector is placed on\n\ the @var{k}-th super-diagonal. If it is negative, it is placed on the\n\ @@ -1241,6 +1264,10 @@ @end example\n\ \n\ @noindent\n\ +The 3-input form returns a diagonal matrix with vector @var{v} on the main\n\ +diagonal and the resulting matrix being of size @var{m} rows x @var{n}\n\ +columns.\n\ +\n\ Given a matrix argument, instead of a vector, @code{diag} extracts the\n\ @var{k}-th diagonal of the matrix.\n\ @end deftypefn") @@ -1291,6 +1318,8 @@ %!assert(diag ([1, 0, 0; 0, 2, 0; 0, 0, 3]), [1; 2; 3]); %!assert(diag ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0], 1), [1; 2; 3]); %!assert(diag ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0], -1), [1; 2; 3]); +%!assert(diag (ones(1, 0), 2), zeros (2)); +%!assert(diag (1:3, 4, 2), [1, 0; 0, 2; 0, 0; 0, 0]); %!assert(full (diag (single([1; 2; 3]))), single([1, 0, 0; 0, 2, 0; 0, 0, 3])); %!assert(diag (single([1; 2; 3]), 1), single([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0])); @@ -1312,7 +1341,11 @@ %!assert(diag (int8([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]), 1), int8([1; 2; 3])); %!assert(diag (int8([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]), -1), int8([1; 2; 3])); -%!error <Invalid call to diag.*> diag (); +%% Test input validation +%!error <Invalid call to diag> diag (); +%!error <Invalid call to diag> diag (1,2,3,4); +%!error diag (ones (2), 3, 3); +%!error diag (1:3, -4, 3); */ @@ -1340,7 +1373,7 @@ %!assert (prod (single([i, 2+i, -3+2i, 4])), single(-4 - 32i)); %!assert (prod (single([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single([-1+i, -8+8i, -27+27i])); -%!error <Invalid call to prod.*> prod (); +%!error <Invalid call to prod> prod (); %!assert (prod ([1, 2; 3, 4], 1), [3, 8]); %!assert (prod ([1, 2; 3, 4], 2), [2; 12]); @@ -1495,10 +1528,136 @@ } static octave_value -do_cat (const octave_value_list& args, int dim, std::string fname) +attempt_type_conversion (const octave_value& ov, std::string dtype) +{ + octave_value retval; + + // First try to find function in the class of OV that can convert to + // the dispatch type dtype. It will have the name of the dispatch + // type. + + std::string cname = ov.class_name (); + + octave_value fcn = symbol_table::find_method (dtype, cname); + + if (fcn.is_defined ()) + { + octave_value_list result + = fcn.do_multi_index_op (1, octave_value_list (1, ov)); + + if (! error_state && result.length () > 0) + retval = result(0); + else + error ("conversion from %s to %s failed", dtype.c_str (), + cname.c_str ()); + } + else + { + // No conversion function available. Try the constructor for the + // dispatch type. + + fcn = symbol_table::find_method (dtype, dtype); + + if (fcn.is_defined ()) + { + octave_value_list result + = fcn.do_multi_index_op (1, octave_value_list (1, ov)); + + if (! error_state && result.length () > 0) + retval = result(0); + else + error ("%s constructor failed for %s argument", dtype.c_str (), + cname.c_str ()); + } + else + error ("no constructor for %s!", dtype.c_str ()); + } + + return retval; +} + +octave_value +do_class_concat (const octave_value_list& ovl, std::string cattype, int dim) { octave_value retval; + // Get dominant type for list + + std::string dtype = get_dispatch_type (ovl); + + octave_value fcn = symbol_table::find_method (cattype, dtype); + + if (fcn.is_defined ()) + { + // Have method for dominant type, so call it and let it handle + // conversions. + + octave_value_list tmp2 = fcn.do_multi_index_op (1, ovl); + + if (! error_state) + { + if (tmp2.length () > 0) + retval = tmp2(0); + else + { + error ("%s/%s method did not return a value", + dtype.c_str (), cattype.c_str ()); + goto done; + } + } + else + goto done; + } + else + { + // No method for dominant type, so attempt type conversions for + // all elements that are not of the dominant type, then do the + // default operation for octave_class values. + + octave_idx_type j = 0; + octave_idx_type len = ovl.length (); + octave_value_list tmp (len, octave_value ()); + for (octave_idx_type k = 0; k < len; k++) + { + octave_value elt = ovl(k); + + std::string t1_type = elt.class_name (); + + if (t1_type == dtype) + tmp(j++) = elt; + else if (elt.is_object () || ! elt.is_empty ()) + { + tmp(j++) = attempt_type_conversion (elt, dtype); + + if (error_state) + goto done; + } + } + + tmp.resize (j); + + octave_map m = do_single_type_concat_map (tmp, dim); + + std::string cname = tmp(0).class_name (); + std::list<std::string> parents = tmp(0).parent_class_name_list (); + + retval = octave_value (new octave_class (m, cname, parents)); + } + + done: + return retval; +} + +static octave_value +do_cat (const octave_value_list& xargs, int dim, std::string fname) +{ + octave_value retval; + + // We may need to convert elements of the list to cells, so make a + // copy. This should be efficient, it is done mostly by incrementing + // reference counts. + octave_value_list args = xargs; + int n_args = args.length (); if (n_args == 0) @@ -1507,18 +1666,28 @@ retval = args(0); else if (n_args > 1) { - - std::string result_type = args(0).class_name (); - - bool all_sq_strings_p = args(0).is_sq_string (); - bool all_dq_strings_p = args(0).is_dq_string (); - bool all_real_p = args(0).is_real_type (); - bool any_sparse_p = args(0).is_sparse_type(); - - for (int i = 1; i < args.length (); i++) + std::string result_type; + + bool all_sq_strings_p = true; + bool all_dq_strings_p = true; + bool all_real_p = true; + bool all_cmplx_p = true; + bool any_sparse_p = false; + bool any_cell_p = false; + bool any_class_p = false; + + bool first_elem_is_struct = false; + + for (int i = 0; i < n_args; i++) { - result_type = - get_concat_class (result_type, args(i).class_name ()); + if (i == 0) + { + result_type = args(i).class_name (); + + first_elem_is_struct = args(i).is_map (); + } + else + result_type = get_concat_class (result_type, args(i).class_name ()); if (all_sq_strings_p && ! args(i).is_sq_string ()) all_sq_strings_p = false; @@ -1526,11 +1695,30 @@ all_dq_strings_p = false; if (all_real_p && ! args(i).is_real_type ()) all_real_p = false; + if (all_cmplx_p && ! (args(i).is_complex_type () || args(i).is_real_type ())) + all_cmplx_p = false; if (!any_sparse_p && args(i).is_sparse_type ()) any_sparse_p = true; + if (!any_cell_p && args(i).is_cell ()) + any_cell_p = true; + if (!any_class_p && args(i).is_object ()) + any_class_p = true; } - if (result_type == "double") + if (any_cell_p && ! any_class_p && ! first_elem_is_struct) + { + for (int i = 0; i < n_args; i++) + { + if (! args(i).is_cell ()) + args(i) = Cell (args(i)); + } + } + + if (any_class_p) + { + retval = do_class_concat (args, fname, dim); + } + else if (result_type == "double") { if (any_sparse_p) { @@ -1671,29 +1859,240 @@ DEFUN (horzcat, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} horzcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ -Return the horizontal concatenation of N-d array objects, @var{array1},\n\ +Return the horizontal concatenation of N-D array objects, @var{array1},\n\ @var{array2}, @dots{}, @var{arrayN} along dimension 2.\n\ +\n\ +Arrays may also be concatenated horizontally using the syntax for creating\n\ +new matrices. For example:\n\ +\n\ +@example\n\ +@var{hcat} = [ @var{array1}, @var{array2}, @dots{} ];\n\ +@end example\n\ @seealso{cat, vertcat}\n\ @end deftypefn") { return do_cat (args, -2, "horzcat"); } +/* +%% test concatenation with all zero matrices +%!assert(horzcat ('', 65*ones(1,10)), 'AAAAAAAAAA'); +%!assert(horzcat (65*ones(1,10), ''), 'AAAAAAAAAA'); + +%!assert (class (horzcat (int64(1), int64(1))), 'int64') +%!assert (class (horzcat (int64(1), int32(1))), 'int64') +%!assert (class (horzcat (int64(1), int16(1))), 'int64') +%!assert (class (horzcat (int64(1), int8(1))), 'int64') +%!assert (class (horzcat (int64(1), uint64(1))), 'int64') +%!assert (class (horzcat (int64(1), uint32(1))), 'int64') +%!assert (class (horzcat (int64(1), uint16(1))), 'int64') +%!assert (class (horzcat (int64(1), uint8(1))), 'int64') +%!assert (class (horzcat (int64(1), single(1))), 'int64') +%!assert (class (horzcat (int64(1), double(1))), 'int64') +%!assert (class (horzcat (int64(1), cell(1))), 'cell') +%!assert (class (horzcat (int64(1), true)), 'int64') +%!assert (class (horzcat (int64(1), 'a')), 'char') + +%!assert (class (horzcat (int32(1), int64(1))), 'int32') +%!assert (class (horzcat (int32(1), int32(1))), 'int32') +%!assert (class (horzcat (int32(1), int16(1))), 'int32') +%!assert (class (horzcat (int32(1), int8(1))), 'int32') +%!assert (class (horzcat (int32(1), uint64(1))), 'int32') +%!assert (class (horzcat (int32(1), uint32(1))), 'int32') +%!assert (class (horzcat (int32(1), uint16(1))), 'int32') +%!assert (class (horzcat (int32(1), uint8(1))), 'int32') +%!assert (class (horzcat (int32(1), single(1))), 'int32') +%!assert (class (horzcat (int32(1), double(1))), 'int32') +%!assert (class (horzcat (int32(1), cell(1))), 'cell') +%!assert (class (horzcat (int32(1), true)), 'int32') +%!assert (class (horzcat (int32(1), 'a')), 'char') + +%!assert (class (horzcat (int16(1), int64(1))), 'int16') +%!assert (class (horzcat (int16(1), int32(1))), 'int16') +%!assert (class (horzcat (int16(1), int16(1))), 'int16') +%!assert (class (horzcat (int16(1), int8(1))), 'int16') +%!assert (class (horzcat (int16(1), uint64(1))), 'int16') +%!assert (class (horzcat (int16(1), uint32(1))), 'int16') +%!assert (class (horzcat (int16(1), uint16(1))), 'int16') +%!assert (class (horzcat (int16(1), uint8(1))), 'int16') +%!assert (class (horzcat (int16(1), single(1))), 'int16') +%!assert (class (horzcat (int16(1), double(1))), 'int16') +%!assert (class (horzcat (int16(1), cell(1))), 'cell') +%!assert (class (horzcat (int16(1), true)), 'int16') +%!assert (class (horzcat (int16(1), 'a')), 'char') + +%!assert (class (horzcat (int8(1), int64(1))), 'int8') +%!assert (class (horzcat (int8(1), int32(1))), 'int8') +%!assert (class (horzcat (int8(1), int16(1))), 'int8') +%!assert (class (horzcat (int8(1), int8(1))), 'int8') +%!assert (class (horzcat (int8(1), uint64(1))), 'int8') +%!assert (class (horzcat (int8(1), uint32(1))), 'int8') +%!assert (class (horzcat (int8(1), uint16(1))), 'int8') +%!assert (class (horzcat (int8(1), uint8(1))), 'int8') +%!assert (class (horzcat (int8(1), single(1))), 'int8') +%!assert (class (horzcat (int8(1), double(1))), 'int8') +%!assert (class (horzcat (int8(1), cell(1))), 'cell') +%!assert (class (horzcat (int8(1), true)), 'int8') +%!assert (class (horzcat (int8(1), 'a')), 'char') + +%!assert (class (horzcat (uint64(1), int64(1))), 'uint64') +%!assert (class (horzcat (uint64(1), int32(1))), 'uint64') +%!assert (class (horzcat (uint64(1), int16(1))), 'uint64') +%!assert (class (horzcat (uint64(1), int8(1))), 'uint64') +%!assert (class (horzcat (uint64(1), uint64(1))), 'uint64') +%!assert (class (horzcat (uint64(1), uint32(1))), 'uint64') +%!assert (class (horzcat (uint64(1), uint16(1))), 'uint64') +%!assert (class (horzcat (uint64(1), uint8(1))), 'uint64') +%!assert (class (horzcat (uint64(1), single(1))), 'uint64') +%!assert (class (horzcat (uint64(1), double(1))), 'uint64') +%!assert (class (horzcat (uint64(1), cell(1))), 'cell') +%!assert (class (horzcat (uint64(1), true)), 'uint64') +%!assert (class (horzcat (uint64(1), 'a')), 'char') + +%!assert (class (horzcat (uint32(1), int64(1))), 'uint32') +%!assert (class (horzcat (uint32(1), int32(1))), 'uint32') +%!assert (class (horzcat (uint32(1), int16(1))), 'uint32') +%!assert (class (horzcat (uint32(1), int8(1))), 'uint32') +%!assert (class (horzcat (uint32(1), uint64(1))), 'uint32') +%!assert (class (horzcat (uint32(1), uint32(1))), 'uint32') +%!assert (class (horzcat (uint32(1), uint16(1))), 'uint32') +%!assert (class (horzcat (uint32(1), uint8(1))), 'uint32') +%!assert (class (horzcat (uint32(1), single(1))), 'uint32') +%!assert (class (horzcat (uint32(1), double(1))), 'uint32') +%!assert (class (horzcat (uint32(1), cell(1))), 'cell') +%!assert (class (horzcat (uint32(1), true)), 'uint32') +%!assert (class (horzcat (uint32(1), 'a')), 'char') + +%!assert (class (horzcat (uint16(1), int64(1))), 'uint16') +%!assert (class (horzcat (uint16(1), int32(1))), 'uint16') +%!assert (class (horzcat (uint16(1), int16(1))), 'uint16') +%!assert (class (horzcat (uint16(1), int8(1))), 'uint16') +%!assert (class (horzcat (uint16(1), uint64(1))), 'uint16') +%!assert (class (horzcat (uint16(1), uint32(1))), 'uint16') +%!assert (class (horzcat (uint16(1), uint16(1))), 'uint16') +%!assert (class (horzcat (uint16(1), uint8(1))), 'uint16') +%!assert (class (horzcat (uint16(1), single(1))), 'uint16') +%!assert (class (horzcat (uint16(1), double(1))), 'uint16') +%!assert (class (horzcat (uint16(1), cell(1))), 'cell') +%!assert (class (horzcat (uint16(1), true)), 'uint16') +%!assert (class (horzcat (uint16(1), 'a')), 'char') + +%!assert (class (horzcat (uint8(1), int64(1))), 'uint8') +%!assert (class (horzcat (uint8(1), int32(1))), 'uint8') +%!assert (class (horzcat (uint8(1), int16(1))), 'uint8') +%!assert (class (horzcat (uint8(1), int8(1))), 'uint8') +%!assert (class (horzcat (uint8(1), uint64(1))), 'uint8') +%!assert (class (horzcat (uint8(1), uint32(1))), 'uint8') +%!assert (class (horzcat (uint8(1), uint16(1))), 'uint8') +%!assert (class (horzcat (uint8(1), uint8(1))), 'uint8') +%!assert (class (horzcat (uint8(1), single(1))), 'uint8') +%!assert (class (horzcat (uint8(1), double(1))), 'uint8') +%!assert (class (horzcat (uint8(1), cell(1))), 'cell') +%!assert (class (horzcat (uint8(1), true)), 'uint8') +%!assert (class (horzcat (uint8(1), 'a')), 'char') + +%!assert (class (horzcat (single(1), int64(1))), 'int64') +%!assert (class (horzcat (single(1), int32(1))), 'int32') +%!assert (class (horzcat (single(1), int16(1))), 'int16') +%!assert (class (horzcat (single(1), int8(1))), 'int8') +%!assert (class (horzcat (single(1), uint64(1))), 'uint64') +%!assert (class (horzcat (single(1), uint32(1))), 'uint32') +%!assert (class (horzcat (single(1), uint16(1))), 'uint16') +%!assert (class (horzcat (single(1), uint8(1))), 'uint8') +%!assert (class (horzcat (single(1), single(1))), 'single') +%!assert (class (horzcat (single(1), double(1))), 'single') +%!assert (class (horzcat (single(1), cell(1))), 'cell') +%!assert (class (horzcat (single(1), true)), 'single') +%!assert (class (horzcat (single(1), 'a')), 'char') + +%!assert (class (horzcat (double(1), int64(1))), 'int64') +%!assert (class (horzcat (double(1), int32(1))), 'int32') +%!assert (class (horzcat (double(1), int16(1))), 'int16') +%!assert (class (horzcat (double(1), int8(1))), 'int8') +%!assert (class (horzcat (double(1), uint64(1))), 'uint64') +%!assert (class (horzcat (double(1), uint32(1))), 'uint32') +%!assert (class (horzcat (double(1), uint16(1))), 'uint16') +%!assert (class (horzcat (double(1), uint8(1))), 'uint8') +%!assert (class (horzcat (double(1), single(1))), 'single') +%!assert (class (horzcat (double(1), double(1))), 'double') +%!assert (class (horzcat (double(1), cell(1))), 'cell') +%!assert (class (horzcat (double(1), true)), 'double') +%!assert (class (horzcat (double(1), 'a')), 'char') + +%!assert (class (horzcat (cell(1), int64(1))), 'cell') +%!assert (class (horzcat (cell(1), int32(1))), 'cell') +%!assert (class (horzcat (cell(1), int16(1))), 'cell') +%!assert (class (horzcat (cell(1), int8(1))), 'cell') +%!assert (class (horzcat (cell(1), uint64(1))), 'cell') +%!assert (class (horzcat (cell(1), uint32(1))), 'cell') +%!assert (class (horzcat (cell(1), uint16(1))), 'cell') +%!assert (class (horzcat (cell(1), uint8(1))), 'cell') +%!assert (class (horzcat (cell(1), single(1))), 'cell') +%!assert (class (horzcat (cell(1), double(1))), 'cell') +%!assert (class (horzcat (cell(1), cell(1))), 'cell') +%!assert (class (horzcat (cell(1), true)), 'cell') +%!assert (class (horzcat (cell(1), 'a')), 'cell') + +%!assert (class (horzcat (true, int64(1))), 'int64') +%!assert (class (horzcat (true, int32(1))), 'int32') +%!assert (class (horzcat (true, int16(1))), 'int16') +%!assert (class (horzcat (true, int8(1))), 'int8') +%!assert (class (horzcat (true, uint64(1))), 'uint64') +%!assert (class (horzcat (true, uint32(1))), 'uint32') +%!assert (class (horzcat (true, uint16(1))), 'uint16') +%!assert (class (horzcat (true, uint8(1))), 'uint8') +%!assert (class (horzcat (true, single(1))), 'single') +%!assert (class (horzcat (true, double(1))), 'double') +%!assert (class (horzcat (true, cell(1))), 'cell') +%!assert (class (horzcat (true, true)), 'logical') +%!assert (class (horzcat (true, 'a')), 'char') + +%!assert (class (horzcat ('a', int64(1))), 'char') +%!assert (class (horzcat ('a', int32(1))), 'char') +%!assert (class (horzcat ('a', int16(1))), 'char') +%!assert (class (horzcat ('a', int8(1))), 'char') +%!assert (class (horzcat ('a', int64(1))), 'char') +%!assert (class (horzcat ('a', int32(1))), 'char') +%!assert (class (horzcat ('a', int16(1))), 'char') +%!assert (class (horzcat ('a', int8(1))), 'char') +%!assert (class (horzcat ('a', single(1))), 'char') +%!assert (class (horzcat ('a', double(1))), 'char') +%!assert (class (horzcat ('a', cell(1))), 'cell') +%!assert (class (horzcat ('a', true)), 'char') +%!assert (class (horzcat ('a', 'a')), 'char') + +%!assert (class (horzcat (cell(1), struct('foo', 'bar'))), 'cell') +%!error horzcat (struct('foo', 'bar'), cell(1)); +*/ + DEFUN (vertcat, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} vertcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ -Return the vertical concatenation of N-d array objects, @var{array1},\n\ +Return the vertical concatenation of N-D array objects, @var{array1},\n\ @var{array2}, @dots{}, @var{arrayN} along dimension 1.\n\ +\n\ +Arrays may also be concatenated vertically using the syntax for creating\n\ +new matrices. For example:\n\ +\n\ +@example\n\ +@var{vcat} = [ @var{array1}; @var{array2}; @dots{} ];\n\ +@end example\n\ @seealso{cat, horzcat}\n\ @end deftypefn") { return do_cat (args, -1, "vertcat"); } +/* +%!test +%! c = {'foo'; 'bar'; 'bazoloa'}; +%! assert (vertcat (c, 'a', 'bc', 'def'), {'foo'; 'bar'; 'bazoloa'; 'a'; 'bc'; 'def'}); +*/ + DEFUN (cat, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} cat (@var{dim}, @var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ -Return the concatenation of N-d array objects, @var{array1},\n\ +Return the concatenation of N-D array objects, @var{array1},\n\ @var{array2}, @dots{}, @var{arrayN} along dimension @var{dim}.\n\ \n\ @example\n\ @@ -1701,10 +2100,8 @@ A = ones (2, 2);\n\ B = zeros (2, 2);\n\ cat (2, A, B)\n\ -@result{} ans =\n\ -\n\ - 1 1 0 0\n\ - 1 1 0 0\n\ + @result{} 1 1 0 0\n\ + 1 1 0 0\n\ @end group\n\ @end example\n\ \n\ @@ -1717,23 +2114,23 @@ @end group\n\ @end example\n\ \n\ -@var{dim} can be larger than the dimensions of the N-d array objects\n\ +@var{dim} can be larger than the dimensions of the N-D array objects\n\ and the result will thus have @var{dim} dimensions as the\n\ following example shows:\n\ \n\ @example\n\ @group\n\ -cat (4, ones(2, 2), zeros (2, 2))\n\ -@result{} ans =\n\ -\n\ - ans(:,:,1,1) =\n\ -\n\ - 1 1\n\ - 1 1\n\ -\n\ - ans(:,:,1,2) =\n\ - 0 0\n\ - 0 0\n\ +cat (4, ones (2, 2), zeros (2, 2))\n\ + @result{} ans =\n\ +\n\ + ans(:,:,1,1) =\n\ +\n\ + 1 1\n\ + 1 1\n\ +\n\ + ans(:,:,1,2) =\n\ + 0 0\n\ + 0 0\n\ @end group\n\ @end example\n\ @seealso{horzcat, vertcat}\n\ @@ -1763,7 +2160,7 @@ /* -%!function ret = testcat (t1, t2, tr, cmplx) +%!function ret = __testcat (t1, t2, tr, cmplx) %! assert (cat (1, cast ([], t1), cast([], t2)), cast ([], tr)); %! %! assert (cat (1, cast (1, t1), cast (2, t2)), cast ([1; 2], tr)); @@ -1840,64 +2237,68 @@ %! assert ([cast([1i, 2], t1), cast([3i, 4], t2)], cast ([1i, 2, 3i, 4], tr)); %! endif %! ret = true; - -%!assert (testcat('double', 'double', 'double')); -%!assert (testcat('single', 'double', 'single')); -%!assert (testcat('double', 'single', 'single')); -%!assert (testcat('single', 'single', 'single')); - -%!assert (testcat('double', 'int8', 'int8', false)); -%!assert (testcat('int8', 'double', 'int8', false)); -%!assert (testcat('single', 'int8', 'int8', false)); -%!assert (testcat('int8', 'single', 'int8', false)); -%!assert (testcat('int8', 'int8', 'int8', false)); -%!assert (testcat('double', 'int16', 'int16', false)); -%!assert (testcat('int16', 'double', 'int16', false)); -%!assert (testcat('single', 'int16', 'int16', false)); -%!assert (testcat('int16', 'single', 'int16', false)); -%!assert (testcat('int16', 'int16', 'int16', false)); -%!assert (testcat('double', 'int32', 'int32', false)); -%!assert (testcat('int32', 'double', 'int32', false)); -%!assert (testcat('single', 'int32', 'int32', false)); -%!assert (testcat('int32', 'single', 'int32', false)); -%!assert (testcat('int32', 'int32', 'int32', false)); -%!assert (testcat('double', 'int64', 'int64', false)); -%!assert (testcat('int64', 'double', 'int64', false)); -%!assert (testcat('single', 'int64', 'int64', false)); -%!assert (testcat('int64', 'single', 'int64', false)); -%!assert (testcat('int64', 'int64', 'int64', false)); - -%!assert (testcat('double', 'uint8', 'uint8', false)); -%!assert (testcat('uint8', 'double', 'uint8', false)); -%!assert (testcat('single', 'uint8', 'uint8', false)); -%!assert (testcat('uint8', 'single', 'uint8', false)); -%!assert (testcat('uint8', 'uint8', 'uint8', false)); -%!assert (testcat('double', 'uint16', 'uint16', false)); -%!assert (testcat('uint16', 'double', 'uint16', false)); -%!assert (testcat('single', 'uint16', 'uint16', false)); -%!assert (testcat('uint16', 'single', 'uint16', false)); -%!assert (testcat('uint16', 'uint16', 'uint16', false)); -%!assert (testcat('double', 'uint32', 'uint32', false)); -%!assert (testcat('uint32', 'double', 'uint32', false)); -%!assert (testcat('single', 'uint32', 'uint32', false)); -%!assert (testcat('uint32', 'single', 'uint32', false)); -%!assert (testcat('uint32', 'uint32', 'uint32', false)); -%!assert (testcat('double', 'uint64', 'uint64', false)); -%!assert (testcat('uint64', 'double', 'uint64', false)); -%!assert (testcat('single', 'uint64', 'uint64', false)); -%!assert (testcat('uint64', 'single', 'uint64', false)); -%!assert (testcat('uint64', 'uint64', 'uint64', false)); - -%!assert (cat (3, [], [1,2;3,4]), [1,2;3,4]); -%!assert (cat (3, [1,2;3,4], []), [1,2;3,4]); -%!assert (cat (3, [], [1,2;3,4], []), [1,2;3,4]); -%!assert (cat (3, [], [], []), zeros (0, 0, 3)); - -%!assert (cat (3, [], [], 1, 2), cat (3, 1, 2)); -%!assert (cat (3, [], [], [1,2;3,4]), [1,2;3,4]); -%!assert (cat (4, [], [], [1,2;3,4]), [1,2;3,4]); -%!error <dimension mismatch> cat (3, cat (3, [], []), [1,2;3,4]); -%!error <dimension mismatch> cat (3, zeros (0, 0, 2), [1,2;3,4]); +%!endfunction + +%!assert (__testcat('double', 'double', 'double')) +%!assert (__testcat('single', 'double', 'single')) +%!assert (__testcat('double', 'single', 'single')) +%!assert (__testcat('single', 'single', 'single')) + +%!assert (__testcat('double', 'int8', 'int8', false)) +%!assert (__testcat('int8', 'double', 'int8', false)) +%!assert (__testcat('single', 'int8', 'int8', false)) +%!assert (__testcat('int8', 'single', 'int8', false)) +%!assert (__testcat('int8', 'int8', 'int8', false)) +%!assert (__testcat('double', 'int16', 'int16', false)) +%!assert (__testcat('int16', 'double', 'int16', false)) +%!assert (__testcat('single', 'int16', 'int16', false)) +%!assert (__testcat('int16', 'single', 'int16', false)) +%!assert (__testcat('int16', 'int16', 'int16', false)) +%!assert (__testcat('double', 'int32', 'int32', false)) +%!assert (__testcat('int32', 'double', 'int32', false)) +%!assert (__testcat('single', 'int32', 'int32', false)) +%!assert (__testcat('int32', 'single', 'int32', false)) +%!assert (__testcat('int32', 'int32', 'int32', false)) +%!assert (__testcat('double', 'int64', 'int64', false)) +%!assert (__testcat('int64', 'double', 'int64', false)) +%!assert (__testcat('single', 'int64', 'int64', false)) +%!assert (__testcat('int64', 'single', 'int64', false)) +%!assert (__testcat('int64', 'int64', 'int64', false)) + +%!assert (__testcat('double', 'uint8', 'uint8', false)) +%!assert (__testcat('uint8', 'double', 'uint8', false)) +%!assert (__testcat('single', 'uint8', 'uint8', false)) +%!assert (__testcat('uint8', 'single', 'uint8', false)) +%!assert (__testcat('uint8', 'uint8', 'uint8', false)) +%!assert (__testcat('double', 'uint16', 'uint16', false)) +%!assert (__testcat('uint16', 'double', 'uint16', false)) +%!assert (__testcat('single', 'uint16', 'uint16', false)) +%!assert (__testcat('uint16', 'single', 'uint16', false)) +%!assert (__testcat('uint16', 'uint16', 'uint16', false)) +%!assert (__testcat('double', 'uint32', 'uint32', false)) +%!assert (__testcat('uint32', 'double', 'uint32', false)) +%!assert (__testcat('single', 'uint32', 'uint32', false)) +%!assert (__testcat('uint32', 'single', 'uint32', false)) +%!assert (__testcat('uint32', 'uint32', 'uint32', false)) +%!assert (__testcat('double', 'uint64', 'uint64', false)) +%!assert (__testcat('uint64', 'double', 'uint64', false)) +%!assert (__testcat('single', 'uint64', 'uint64', false)) +%!assert (__testcat('uint64', 'single', 'uint64', false)) +%!assert (__testcat('uint64', 'uint64', 'uint64', false)) + +%!assert (cat (3, [], [1,2;3,4]), [1,2;3,4]) +%!assert (cat (3, [1,2;3,4], []), [1,2;3,4]) +%!assert (cat (3, [], [1,2;3,4], []), [1,2;3,4]) +%!assert (cat (3, [], [], []), zeros (0, 0, 3)) + +%!assert (cat (3, [], [], 1, 2), cat (3, 1, 2)) +%!assert (cat (3, [], [], [1,2;3,4]), [1,2;3,4]) +%!assert (cat (4, [], [], [1,2;3,4]), [1,2;3,4]) +%!error <dimension mismatch> cat (3, cat (3, [], []), [1,2;3,4]) +%!error <dimension mismatch> cat (3, zeros (0, 0, 2), [1,2;3,4]) + +%!assert ([zeros(3,2,2); ones(1,2,2)], repmat([0;0;0;1],[1,2,2]) ) +%!assert ([zeros(3,2,2); ones(1,2,2)], vertcat(zeros(3,2,2), ones(1,2,2)) ) */ @@ -1931,10 +2332,10 @@ DEFUN (permute, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} permute (@var{a}, @var{perm})\n\ -Return the generalized transpose for an N-d array object @var{a}.\n\ +@deftypefn {Built-in Function} {} permute (@var{A}, @var{perm})\n\ +Return the generalized transpose for an N-D array object @var{A}.\n\ The permutation vector @var{perm} must contain the elements\n\ -@code{1:ndims(a)} (in any order, but each element must appear just once).\n\ +@code{1:ndims(A)} (in any order, but each element must appear only once).\n\ @seealso{ipermute}\n\ @end deftypefn") { @@ -1943,15 +2344,15 @@ DEFUN (ipermute, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ipermute (@var{a}, @var{iperm})\n\ +@deftypefn {Built-in Function} {} ipermute (@var{A}, @var{iperm})\n\ The inverse of the @code{permute} function. The expression\n\ \n\ @example\n\ -ipermute (permute (a, perm), perm)\n\ +ipermute (permute (A, perm), perm)\n\ @end example\n\ \n\ @noindent\n\ -returns the original array @var{a}.\n\ +returns the original array @var{A}.\n\ @seealso{permute}\n\ @end deftypefn") { @@ -1985,7 +2386,7 @@ \n\ @example\n\ @group\n\ - ndims (ones (4, 1, 2, 1)\n\ + ndims (ones (4, 1, 2, 1))\n\ @result{} 3\n\ @end group\n\ @end example\n\ @@ -2013,6 +2414,19 @@ @var{a}(@var{idx1}, @var{idx2}, @dots{})\n\ @end example\n\ \n\ +Note that the indices do not have to be numerical. For example,\n\ +\n\ +@example\n\ +@group\n\ + @var{a} = 1;\n\ + @var{b} = ones (2, 3);\n\ + numel (@var{a}, @var{b});\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +will return 6, as this is the number of ways to index with @var{b}.\n\ +\n\ This method is also called when an object appears as lvalue with cs-list\n\ indexing, i.e., @code{object@{@dots{}@}} or @code{object(@dots{}).field}.\n\ @seealso{size}\n\ @@ -2039,7 +2453,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} size (@var{a})\n\ @deftypefnx {Built-in Function} {} size (@var{a}, @var{dim})\n\ -Return the number rows and columns of @var{a}.\n\ +Return the number of rows and columns of @var{a}.\n\ \n\ With one input argument and one output argument, the result is returned\n\ in a row vector. If there are multiple output arguments, the number of\n\ @@ -2255,7 +2669,6 @@ @end group\n\ @end example\n\ \n\ - \n\ On the contrary, if 'double' is given, the sum is performed in double\n\ precision even for single precision inputs.\n\ \n\ @@ -2406,7 +2819,7 @@ %!assert(sum (single([i, 2+i, -3+2i, 4])), single(3+4i)); %!assert(sum (single([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single([2+2i, 4+4i, 6+6i])); -%!error <Invalid call to sum.*> sum (); +%!error <Invalid call to sum> sum (); %!assert (sum ([1, 2; 3, 4], 1), [4, 6]); %!assert (sum ([1, 2; 3, 4], 2), [3; 7]); @@ -2481,7 +2894,7 @@ %!assert(sumsq (single([-1; -2; 4i])), single(21)); %!assert(sumsq (single([1, 2, 3; 2, 3, 4; 4i, 6i, 2])), single([21, 49, 29])); -%!error <Invalid call to sumsq.*> sumsq (); +%!error <Invalid call to sumsq> sumsq (); %!assert (sumsq ([1, 2; 3, 4], 1), [10, 20]); %!assert (sumsq ([1, 2; 3, 4], 2), [5; 25]); @@ -2993,8 +3406,8 @@ %! s.a = 1; %! assert(ismatrix (s), false); -%!error <Invalid call to ismatrix.*> ismatrix (); -%!error <Invalid call to ismatrix.*> ismatrix ([1, 2; 3, 4], 2); +%!error <Invalid call to ismatrix> ismatrix (); +%!error <Invalid call to ismatrix> ismatrix ([1, 2; 3, 4], 2); */ @@ -3419,28 +3832,29 @@ DEFUN (ones, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ones (@var{x})\n\ -@deftypefnx {Built-in Function} {} ones (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} ones (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefn {Built-in Function} {} ones (@var{n})\n\ +@deftypefnx {Built-in Function} {} ones (@var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {} ones (@var{m}, @var{n}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} ones ([@var{m} @var{n} @dots{}])\n\ @deftypefnx {Built-in Function} {} ones (@dots{}, @var{class})\n\ Return a matrix or N-dimensional array whose elements are all 1.\n\ -If invoked with a single scalar integer argument, return a square\n\ -matrix of the specified size. If invoked with two or more scalar\n\ +If invoked with a single scalar integer argument @var{n}, return a square\n\ +@nospell{NxN} matrix. If invoked with two or more scalar\n\ integer arguments, or a vector of integer values, return an array with\n\ -given dimensions.\n\ +the given dimensions.\n\ \n\ If you need to create a matrix whose values are all the same, you should\n\ use an expression like\n\ \n\ @example\n\ -val_matrix = val * ones (n, m)\n\ +val_matrix = val * ones (m, n)\n\ @end example\n\ \n\ The optional argument @var{class} specifies the class of the return array\n\ and defaults to double. For example:\n\ \n\ @example\n\ -val = ones (n,m, \"uint8\")\n\ +val = ones (m,n, \"uint8\")\n\ @end example\n\ @seealso{zeros}\n\ @end deftypefn") @@ -3469,21 +3883,22 @@ DEFUN (zeros, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} zeros (@var{x})\n\ -@deftypefnx {Built-in Function} {} zeros (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} zeros (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefn {Built-in Function} {} zeros (@var{n})\n\ +@deftypefnx {Built-in Function} {} zeros (@var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {} zeros (@var{m}, @var{n}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} zeros ([@var{m} @var{n} @dots{}])\n\ @deftypefnx {Built-in Function} {} zeros (@dots{}, @var{class})\n\ Return a matrix or N-dimensional array whose elements are all 0.\n\ If invoked with a single scalar integer argument, return a square\n\ -matrix of the specified size. If invoked with two or more scalar\n\ +@nospell{NxN} matrix. If invoked with two or more scalar\n\ integer arguments, or a vector of integer values, return an array with\n\ -given dimensions.\n\ +the given dimensions.\n\ \n\ The optional argument @var{class} specifies the class of the return array\n\ and defaults to double. For example:\n\ \n\ @example\n\ -val = zeros (n,m, \"uint8\")\n\ +val = zeros (m,n, \"uint8\")\n\ @end example\n\ @seealso{ones}\n\ @end deftypefn") @@ -3884,6 +4299,11 @@ DEFUN (I, args, , "-*- texinfo -*-\n\ +@c List other forms of function in documentation index\n\ +@findex i\n\ +@findex j\n\ +@findex J\n\ +\n\ @deftypefn {Built-in Function} {} I\n\ @deftypefnx {Built-in Function} {} I (@var{n})\n\ @deftypefnx {Built-in Function} {} I (@var{n}, @var{m})\n\ @@ -4099,14 +4519,15 @@ DEFUN (eye, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} eye (@var{x})\n\ -@deftypefnx {Built-in Function} {} eye (@var{n}, @var{m})\n\ +@deftypefn {Built-in Function} {} eye (@var{n})\n\ +@deftypefnx {Built-in Function} {} eye (@var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {} eye ([@var{m} @var{n}])\n\ @deftypefnx {Built-in Function} {} eye (@dots{}, @var{class})\n\ -Return an identity matrix. If invoked with a single scalar argument,\n\ -@code{eye} returns a square matrix with the dimension specified. If you\n\ -supply two scalar arguments, @code{eye} takes them to be the number of\n\ -rows and columns. If given a vector with two elements, @code{eye} uses\n\ -the values of the elements as the number of rows and columns,\n\ +Return an identity matrix. If invoked with a single scalar argument @var{n},\n\ +return a square @nospell{NxN} identity matrix. If\n\ +supplied two scalar arguments (@var{m}, @var{n}), @code{eye} takes them to be\n\ +the number of rows and columns. If given a vector with two elements,\n\ +@code{eye} uses the values of the elements as the number of rows and columns,\n\ respectively. For example:\n\ \n\ @example\n\ @@ -4138,8 +4559,9 @@ @end example\n\ \n\ Calling @code{eye} with no arguments is equivalent to calling it\n\ -with an argument of 1. This odd definition is for compatibility\n\ -with @sc{matlab}.\n\ +with an argument of 1. Any negative dimensions are treated as zero. \n\ +These odd definitions are for compatibility with @sc{matlab}.\n\ +@seealso{speye}\n\ @end deftypefn") { octave_value retval; @@ -4207,7 +4629,7 @@ %!assert (eye(3,'int8'), int8([1, 0, 0; 0, 1, 0; 0, 0, 1])); %!assert (eye(2, 3,'int8'), int8([1, 0, 0; 0, 1, 0])); -%!error <Invalid call to eye.*> eye (1, 2, 3); +%!error <Invalid call to eye> eye (1, 2, 3); */ @@ -4257,20 +4679,21 @@ DEFUN (linspace, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} linspace (@var{base}, @var{limit}, @var{n})\n\ +@deftypefn {Built-in Function} {} linspace (@var{base}, @var{limit})\n\ +@deftypefnx {Built-in Function} {} linspace (@var{base}, @var{limit}, @var{n})\n\ Return a row vector with @var{n} linearly spaced elements between\n\ @var{base} and @var{limit}. If the number of elements is greater than one,\n\ -then the @var{base} and @var{limit} are always included in\n\ +then the endpoints @var{base} and @var{limit} are always included in\n\ the range. If @var{base} is greater than @var{limit}, the elements are\n\ stored in decreasing order. If the number of points is not specified, a\n\ value of 100 is used.\n\ \n\ The @code{linspace} function always returns a row vector if both\n\ -@var{base} and @var{limit} are scalars. If one of them or both are column\n\ +@var{base} and @var{limit} are scalars. If one, or both, of them are column\n\ vectors, @code{linspace} returns a matrix.\n\ \n\ -For compatibility with @sc{matlab}, return the second argument if\n\ -fewer than two values are requested.\n\ +For compatibility with @sc{matlab}, return the second argument (@var{limit})\n\ +if fewer than two values are requested.\n\ @end deftypefn") { octave_value retval; @@ -4329,8 +4752,8 @@ % assert(linspace ([1, 2; 3, 4], 5, 6), linspace (1, 5, 6)); -%!error <Invalid call to linspace.*> linspace (); -%!error <Invalid call to linspace.*> linspace (1, 2, 3, 4); +%!error <Invalid call to linspace> linspace (); +%!error <Invalid call to linspace> linspace (1, 2, 3, 4); %!test %! fail("linspace ([1, 2; 3, 4], 5, 6)","warning"); @@ -4343,8 +4766,8 @@ DEFUN (resize, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} resize (@var{x}, @var{m})\n\ -@deftypefnx {Built-in Function} {} resize (@var{x}, @var{m}, @var{n})\n\ @deftypefnx {Built-in Function} {} resize (@var{x}, @var{m}, @var{n}, @dots{})\n\ +@deftypefnx {Built-in Function} {} resize (@var{x}, [@var{m} @var{n} @dots{}])\n\ Resize @var{x} cutting off elements as necessary.\n\ \n\ In the result, element with certain indices is equal to the corresponding\n\ @@ -4372,11 +4795,12 @@ @noindent\n\ but is performed more efficiently.\n\ \n\ -If only @var{m} is supplied and it is a scalar, the dimension of the\n\ -result is @var{m}-by-@var{m}. If @var{m} is a vector, then the\n\ -dimensions of the result are given by the elements of @var{m}.\n\ -If both @var{m} and @var{n} are scalars, then the dimensions of\n\ -the result are @var{m}-by-@var{n}.\n\ +If only @var{m} is supplied, and it is a scalar, the dimension of the\n\ +result is @var{m}-by-@var{m}.\n\ +If @var{m}, @var{n}, @dots{} are all scalars, then the dimensions of\n\ +the result are @var{m}-by-@var{n}-by-@dots{}.\n\ +If given a vector as input, then the\n\ +dimensions of the result are given by the elements of that vector.\n\ \n\ An object can be resized to more dimensions than it has;\n\ in such case the missing dimensions are assumed to be 1.\n\ @@ -4429,13 +4853,16 @@ DEFUN (reshape, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} reshape (@var{a}, @var{m}, @var{n}, @dots{})\n\ -@deftypefnx {Built-in Function} {} reshape (@var{a}, @var{size})\n\ -Return a matrix with the given dimensions whose elements are taken\n\ -from the matrix @var{a}. The elements of the matrix are accessed in\n\ -column-major order (like Fortran arrays are stored).\n\ -\n\ -For example:\n\ +@deftypefn {Built-in Function} {} reshape (@var{A}, @var{m}, @var{n}, @dots{})\n\ +@deftypefnx {Built-in Function} {} reshape (@var{A}, [@var{m} @var{n} @dots{}])\n\ +@deftypefnx {Built-in Function} {} reshape (@var{A}, @dots{}, [], @dots{})\n\ +@deftypefnx {Built-in Function} {} reshape (@var{A}, @var{size})\n\ +Return a matrix with the specified dimensions (@var{m}, @var{n}, @dots{})\n\ +whose elements are taken from the matrix @var{A}. The elements of the\n\ +matrix are accessed in column-major order (like Fortran arrays are stored).\n\ +\n\ +The following code demonstrates reshaping a 1x4 row vector into a 2x2 square\n\ +matrix.\n\ \n\ @example\n\ @group\n\ @@ -4447,10 +4874,13 @@ \n\ @noindent\n\ Note that the total number of elements in the original\n\ -matrix must match the total number of elements in the new matrix.\n\ -\n\ -A single dimension of the return matrix can be unknown and is flagged\n\ -by an empty argument.\n\ +matrix (@code{prod (size (@var{A}))}) must match the total number of elements\n\ +in the new matrix (@code{prod ([@var{m} @var{n} @dots{}])}).\n\ +\n\ +A single dimension of the return matrix may be left unspecified and Octave\n\ +will determine its size automatically. An empty matrix ([]) is used to flag\n\ +the unspecified dimension.\n\ +@seealso{resize}\n\ @end deftypefn") { octave_value retval; @@ -4556,20 +4986,21 @@ %! s.a = 1; %! fail("reshape (s, 2, 3)"); -%!error <Invalid call to reshape.*> reshape (); +%!error <Invalid call to reshape> reshape (); %!error reshape (1, 2, 3, 4); */ DEFUN (vec, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} @var{v} = vec (@var{x})\n\ -@deftypefnx {Built-in Function} {} @var{v} = vec (@var{x}, @var{dim})\n\ +@deftypefn {Built-in Function} {@var{v} =} vec (@var{x})\n\ +@deftypefnx {Built-in Function} {@var{v} =} vec (@var{x}, @var{dim})\n\ Return the vector obtained by stacking the columns of the matrix @var{x}\n\ one above the other. Without @var{dim} this is equivalent to\n\ @code{@var{x}(:)}. If @var{dim} is supplied, the dimensions of @var{v}\n\ are set to @var{dim} with all elements along the last dimension.\n\ This is equivalent to @code{shiftdim (@var{x}(:), 1-@var{dim})}.\n\ +@seealso{vech}\n\ @end deftypefn") { octave_value retval; @@ -4649,7 +5080,7 @@ DEFUN (full, args, , "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {@var{FM} =} full (@var{SM})\n\ - returns a full storage matrix from a sparse, diagonal, permutation matrix\n\ +Return a full storage matrix from a sparse, diagonal, permutation matrix\n\ or a range.\n\ @seealso{sparse}\n\ @end deftypefn") @@ -4668,51 +5099,51 @@ DEFUN (norm, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} norm (@var{a})\n\ -@deftypefnx {Built-in Function} {} norm (@var{a}, @var{p})\n\ -@deftypefnx {Built-in Function} {} norm (@var{a}, @var{p}, @var{opt})\n\ -Compute the p-norm of the matrix @var{a}. If the second argument is\n\ +@deftypefn {Built-in Function} {} norm (@var{A})\n\ +@deftypefnx {Built-in Function} {} norm (@var{A}, @var{p})\n\ +@deftypefnx {Built-in Function} {} norm (@var{A}, @var{p}, @var{opt})\n\ +Compute the p-norm of the matrix @var{A}. If the second argument is\n\ missing, @code{p = 2} is assumed.\n\ \n\ -If @var{a} is a matrix (or sparse matrix):\n\ +If @var{A} is a matrix (or sparse matrix):\n\ \n\ @table @asis\n\ @item @var{p} = @code{1}\n\ -1-norm, the largest column sum of the absolute values of @var{a}.\n\ +1-norm, the largest column sum of the absolute values of @var{A}.\n\ \n\ @item @var{p} = @code{2}\n\ -Largest singular value of @var{a}.\n\ +Largest singular value of @var{A}.\n\ \n\ @item @var{p} = @code{Inf} or @code{\"inf\"}\n\ @cindex infinity norm\n\ -Infinity norm, the largest row sum of the absolute values of @var{a}.\n\ +Infinity norm, the largest row sum of the absolute values of @var{A}.\n\ \n\ @item @var{p} = @code{\"fro\"}\n\ @cindex Frobenius norm\n\ -Frobenius norm of @var{a}, @code{sqrt (sum (diag (@var{a}' * @var{a})))}.\n\ +Frobenius norm of @var{A}, @code{sqrt (sum (diag (@var{A}' * @var{A})))}.\n\ \n\ @item other @var{p}, @code{@var{p} > 1}\n\ -@cindex general p-norm \n\ +@cindex general p-norm\n\ maximum @code{norm (A*x, p)} such that @code{norm (x, p) == 1}\n\ @end table\n\ \n\ -If @var{a} is a vector or a scalar:\n\ +If @var{A} is a vector or a scalar:\n\ \n\ @table @asis\n\ @item @var{p} = @code{Inf} or @code{\"inf\"}\n\ -@code{max (abs (@var{a}))}.\n\ +@code{max (abs (@var{A}))}.\n\ \n\ @item @var{p} = @code{-Inf}\n\ -@code{min (abs (@var{a}))}.\n\ +@code{min (abs (@var{A}))}.\n\ \n\ @item @var{p} = @code{\"fro\"}\n\ -Frobenius norm of @var{a}, @code{sqrt (sumsq (abs (a)))}.\n\ +Frobenius norm of @var{A}, @code{sqrt (sumsq (abs (A)))}.\n\ \n\ @item @var{p} = 0\n\ Hamming norm - the number of nonzero elements.\n\ \n\ @item other @var{p}, @code{@var{p} > 1}\n\ -p-norm of @var{a}, @code{(sum (abs (@var{a}) .^ @var{p})) ^ (1/@var{p})}.\n\ +p-norm of @var{A}, @code{(sum (abs (@var{A}) .^ @var{p})) ^ (1/@var{p})}.\n\ \n\ @item other @var{p} @code{@var{p} < 1}\n\ the p-pseudonorm defined as above.\n\ @@ -4857,7 +5288,7 @@ @deftypefn {Built-in Function} {} not (@var{x})\n\ Return the logical NOT of @var{x}. This function is equivalent to\n\ @code{! x}.\n\ -@seealso{and, or}\n\ +@seealso{and, or, xor}\n\ @end deftypefn") { return unary_op_defun_body (octave_value::op_not, args); @@ -4866,7 +5297,7 @@ DEFUN (uplus, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} uplus (@var{x})\n\ -This function is equivalent to @w{@code{+ x}}.\n\ +This function and @w{@xcode{+ x}} are equivalent.\n\ @end deftypefn") { return unary_op_defun_body (octave_value::op_uplus, args); @@ -4875,7 +5306,7 @@ DEFUN (uminus, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} uminus (@var{x})\n\ -This function is equivalent to @w{@code{- x}}.\n\ +This function and @w{@xcode{- x}} are equivalent.\n\ @end deftypefn") { return unary_op_defun_body (octave_value::op_uminus, args); @@ -4884,7 +5315,8 @@ DEFUN (transpose, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} transpose (@var{x})\n\ -Return the transpose of @var{x}. This function is equivalent to @code{x.'}.\n\ +Return the transpose of @var{x}.\n\ +This function and @xcode{x.'} are equivalent.\n\ @seealso{ctranspose}\n\ @end deftypefn") { @@ -4916,8 +5348,8 @@ DEFUN (ctranspose, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} ctranspose (@var{x})\n\ -Return the complex conjugate transpose of @var{x}. This function is\n\ -equivalent to @code{x'}.\n\ +Return the complex conjugate transpose of @var{x}.\n\ +This function and @xcode{x'} are equivalent.\n\ @seealso{transpose}\n\ @end deftypefn") { @@ -4993,7 +5425,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} plus (@var{x}, @var{y})\n\ @deftypefnx {Built-in Function} {} plus (@var{x1}, @var{x2}, @dots{})\n\ -This function is equivalent to @w{@code{x + y}}.\n\ +This function and @w{@xcode{x + y}} are equivalent.\n\ If more arguments are given, the summation is applied\n\ cumulatively from left to right:\n\ \n\ @@ -5012,7 +5444,7 @@ DEFUN (minus, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} minus (@var{x}, @var{y})\n\ -This function is equivalent to @w{@code{x - y}}.\n\ +This function and @w{@xcode{x - y}} are equivalent.\n\ @seealso{plus}\n\ @end deftypefn") { @@ -5024,7 +5456,7 @@ @deftypefn {Built-in Function} {} mtimes (@var{x}, @var{y})\n\ @deftypefnx {Built-in Function} {} mtimes (@var{x1}, @var{x2}, @dots{})\n\ Return the matrix multiplication product of inputs.\n\ -This function is equivalent to @w{@code{x * y}}.\n\ +This function and @w{@xcode{x * y}} are equivalent.\n\ If more arguments are given, the multiplication is applied\n\ cumulatively from left to right:\n\ \n\ @@ -5044,7 +5476,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} mrdivide (@var{x}, @var{y})\n\ Return the matrix right division of @var{x} and @var{y}.\n\ -This function is equivalent to @w{@code{x / y}}.\n\ +This function and @w{@xcode{x / y}} are equivalent.\n\ @seealso{mldivide, rdivide}\n\ @end deftypefn") { @@ -5055,7 +5487,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} mpower (@var{x}, @var{y})\n\ Return the matrix power operation of @var{x} raised to the @var{y} power.\n\ -This function is equivalent to @w{@code{x ^ y}}.\n\ +This function and @w{@xcode{x ^ y}} are equivalent.\n\ @seealso{power}\n\ @end deftypefn") { @@ -5066,7 +5498,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} mldivide (@var{x}, @var{y})\n\ Return the matrix left division of @var{x} and @var{y}.\n\ -This function is equivalent to @w{@code{x \\ y}}.\n\ +This function and @w{@xcode{x \\ y}} are equivalent.\n\ @seealso{mrdivide, ldivide}\n\ @end deftypefn") { @@ -5136,7 +5568,7 @@ @deftypefn {Built-in Function} {} times (@var{x}, @var{y})\n\ @deftypefnx {Built-in Function} {} times (@var{x1}, @var{x2}, @dots{})\n\ Return the element-by-element multiplication product of inputs.\n\ -This function is equivalent to @w{@code{x .* y}}.\n\ +This function and @w{@xcode{x .* y}} are equivalent.\n\ If more arguments are given, the multiplication is applied\n\ cumulatively from left to right:\n\ \n\ @@ -5156,7 +5588,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} rdivide (@var{x}, @var{y})\n\ Return the element-by-element right division of @var{x} and @var{y}.\n\ -This function is equivalent to @w{@code{x ./ y}}.\n\ +This function and @w{@xcode{x ./ y}} are equivalent.\n\ @seealso{ldivide, mrdivide}\n\ @end deftypefn") { @@ -5168,7 +5600,7 @@ @deftypefn {Built-in Function} {} power (@var{x}, @var{y})\n\ Return the element-by-element operation of @var{x} raised to the\n\ @var{y} power.\n\ -This function is equivalent to @w{@code{x .^ y}}.\n\ +This function and @w{@xcode{x .^ y}} are equivalent.\n\ @seealso{mpower}\n\ @end deftypefn") { @@ -5179,7 +5611,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} ldivide (@var{x}, @var{y})\n\ Return the element-by-element left division of @var{x} and @var{y}.\n\ -This function is equivalent to @w{@code{x .\\ y}}.\n\ +This function and @w{@xcode{x .\\ y}} are equivalent.\n\ @seealso{rdivide, mldivide}\n\ @end deftypefn") { @@ -5200,7 +5632,7 @@ @end example\n\ \n\ At least one argument is required.\n\ -@seealso{or, not}\n\ +@seealso{or, not, xor}\n\ @end deftypefn") { return binary_assoc_op_defun_body (octave_value::op_el_and, @@ -5221,7 +5653,7 @@ @end example\n\ \n\ At least one argument is required.\n\ -@seealso{and, not}\n\ +@seealso{and, not, xor}\n\ @end deftypefn") { return binary_assoc_op_defun_body (octave_value::op_el_or, @@ -5411,7 +5843,7 @@ @deftypefnx {Loadable Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{mode})\n\ @deftypefnx {Loadable Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim}, @var{mode})\n\ Return a copy of @var{x} with the elements arranged in increasing\n\ -order. For matrices, @code{sort} orders the elements in each column.\n\ +order. For matrices, @code{sort} orders the elements within columns\n\ \n\ For example:\n\ \n\ @@ -5424,6 +5856,11 @@ @end group\n\ @end example\n\ \n\ +If the optional argument @var{dim} is given, then the matrix is sorted\n\ +along the dimension defined by @var{dim}. The optional argument @code{mode}\n\ +defines the order in which the values will be sorted. Valid values of\n\ +@code{mode} are `ascend' or `descend'.\n\ +\n\ The @code{sort} function may also be used to produce a matrix\n\ containing the original row indices of the elements in the sorted\n\ matrix. For example:\n\ @@ -5440,16 +5877,27 @@ @end group\n\ @end example\n\ \n\ -If the optional argument @var{dim} is given, then the matrix is sorted\n\ -along the dimension defined by @var{dim}. The optional argument @code{mode}\n\ -defines the order in which the values will be sorted. Valid values of\n\ -@code{mode} are `ascend' or `descend'.\n\ -\n\ -For equal elements, the indices are such that the equal elements are listed\n\ -in the order that appeared in the original list.\n\ +For equal elements, the indices are such that equal elements are listed\n\ +in the order in which they appeared in the original list.\n\ +\n\ +Sorting of complex entries is done first by magnitude (@code{abs (@var{z})})\n\ +and for any ties by phase angle (@code{angle (z)}). For example:\n\ +\n\ +@example\n\ +@group\n\ +sort ([1+i; 1; 1-i])\n\ + @result{} 1 + 0i\n\ + 1 - 1i\n\ + 1 + 1i\n\ +@end group\n\ +@end example\n\ +\n\ +NaN values are treated as being greater than any other value and are sorted\n\ +to the end of the list.\n\ \n\ The @code{sort} function may also be used to sort strings and cell arrays\n\ -of strings, in which case the dictionary order of the strings is used.\n\ +of strings, in which case ASCII dictionary order (uppercase 'A' precedes\n\ +lowercase 'a') of the strings is used.\n\ \n\ The algorithm used in @code{sort} is optimized for the sorting of partially\n\ ordered lists.\n\ @@ -5532,6 +5980,8 @@ if (return_idx) { + retval.resize (2); + Array<octave_idx_type> sidx; retval (0) = arg.sort (sidx, dim, smode); @@ -5715,8 +6165,8 @@ %! [v, i] = sort (a); %! assert (i, [1, 4, 2, 5, 3]) -%!error <Invalid call to sort.*> sort (); -%!error <Invalid call to sort.*> sort (1, 2, 3, 4); +%!error <Invalid call to sort> sort (); +%!error <Invalid call to sort> sort (1, 2, 3, 4); */ @@ -5799,8 +6249,9 @@ DEFUN (issorted, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} issorted (@var{a}, @var{mode})\n\ -@deftypefnx {Built-in Function} {} issorted (@var{a}, @code{\"rows\"}, @var{mode})\n\ +@deftypefn {Built-in Function} {} issorted (@var{a})\n\ +@deftypefnx {Built-in Function} {} issorted (@var{a}, @var{mode})\n\ +@deftypefnx {Built-in Function} {} issorted (@var{a}, \"rows\", @var{mode})\n\ Return true if the array is sorted according to @var{mode}, which\n\ may be either \"ascending\", \"descending\", or \"either\". By default,\n\ @var{mode} is \"ascending\". NaNs are treated in the same manner as\n\ @@ -5922,7 +6373,8 @@ \n\ nth_element encapsulates the C++ standard library algorithms nth_element and\n\ partial_sort. On average, the complexity of the operation is O(M*log(K)),\n\ -where @code{M = size(@var{x}, @var{dim})} and @code{K = length (@var{n})}.\n\ +where @w{@code{M = size (@var{x}, @var{dim})}} and\n\ +@w{@code{K = length (@var{n})}}.\n\ This function is intended for cases where the ratio K/M is small; otherwise,\n\ it may be better to use @code{sort}.\n\ @seealso{sort, min, max}\n\ @@ -6184,9 +6636,10 @@ if (n < 0) n = idx.extent (0); else if (idx.extent (n) > n) - error ("accumarray: index out of range"); - - dim_vector rdv = vals.dims (); + error ("accumdim: index out of range"); + + dim_vector vals_dim = vals.dims (), rdv = vals_dim; + if (dim < 0) dim = vals.dims ().first_non_singleton (); else if (dim >= rdv.length ()) @@ -6196,7 +6649,11 @@ NDT retval (rdv, T()); + if (idx.length () != vals_dim(dim)) + error ("accumdim: dimension mismatch"); + retval.idx_add_nd (idx, vals, dim); + return retval; } @@ -6324,7 +6781,7 @@ \n\ In the array mask case, both @var{tval} and @var{fval} must be either\n\ scalars or arrays with dimensions equal to @var{mask}. The result is\n\ -constructed as follows: \n\ +constructed as follows:\n\ \n\ @example\n\ @group\n\ @@ -6536,8 +6993,10 @@ DEFUN (diff, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} diff (@var{x}, @var{k}, @var{dim})\n\ -If @var{x} is a vector of length @var{n}, @code{diff (@var{x})} is the\n\ +@deftypefn {Built-in Function} {} diff (@var{x})\n\ +@deftypefnx {Built-in Function} {} diff (@var{x}, @var{k})\n\ +@deftypefnx {Built-in Function} {} diff (@var{x}, @var{k}, @var{dim})\n\ +If @var{x} is a vector of length @math{n}, @code{diff (@var{x})} is the\n\ vector of first differences\n\ @tex\n\ $x_2 - x_1, \\ldots{}, x_n - x_{n-1}$.\n\ @@ -6552,15 +7011,15 @@ The second argument is optional. If supplied, @code{diff (@var{x},\n\ @var{k})}, where @var{k} is a non-negative integer, returns the\n\ @var{k}-th differences. It is possible that @var{k} is larger than\n\ -then first non-singleton dimension of the matrix. In this case,\n\ +the first non-singleton dimension of the matrix. In this case,\n\ @code{diff} continues to take the differences along the next\n\ non-singleton dimension.\n\ \n\ The dimension along which to take the difference can be explicitly\n\ -stated with the optional variable @var{dim}. In this case the \n\ +stated with the optional variable @var{dim}. In this case the\n\ @var{k}-th order differences are calculated along this dimension.\n\ In the case where @var{k} exceeds @code{size (@var{x}, @var{dim})}\n\ -then an empty matrix is returned.\n\ +an empty matrix is returned.\n\ @end deftypefn") { int nargin = args.length ();
new file mode 100644 --- /dev/null +++ b/src/data.h @@ -0,0 +1,34 @@ +/* + +Copyright (C) 2011 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/>. + +*/ + +#if !defined (octave_data_h) +#define octave_data_h 1 + +#include <string> + +class octave_value; +class octave_value_list; + +extern OCTINTERP_API octave_value +do_class_concat (const octave_value_list& ovl, std::string cattype, int dim); + +#endif
--- a/src/debug.cc +++ b/src/debug.cc @@ -32,6 +32,7 @@ #include <string> #include "file-stat.h" +#include "singleton-cleanup.h" #include "defun.h" #include "error.h" @@ -250,6 +251,28 @@ } } +bool +bp_table::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new bp_table (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create breakpoint table!"); + retval = false; + } + + return retval; +} + bp_table::intmap bp_table::do_add_breakpoint (const std::string& fname, const bp_table::intmap& line) @@ -285,7 +308,7 @@ } } else - error ("add_breakpoint: unable to find the function requested\n"); + error ("add_breakpoint: unable to find the requested function\n"); tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; @@ -340,7 +363,7 @@ } } else - error ("remove_breakpoint: unable to find the function requested\n"); + error ("remove_breakpoint: unable to find the requested function\n"); } tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; @@ -380,7 +403,7 @@ } else if (! silent) error ("remove_all_breakpoint_in_file: " - "unable to find the function requested\n"); + "unable to find the requested function\n"); tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; @@ -481,20 +504,31 @@ DEFUN (dbstop, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{rline} =} dbstop (@var{func}, @var{line}, @dots{})\n\ -Set a breakpoint in a function\n\ -@table @code\n\ +@deftypefn {Loadable Function} {@var{rline} =} dbstop (\"@var{func}\")\n\ +@deftypefnx {Loadable Function} {@var{rline} =} dbstop (\"@var{func}\", @var{line}, @dots{})\n\ +Set a breakpoint in function @var{func}.\n\ +\n\ +Arguments are\n\ +\n\ +@table @var\n\ @item func\n\ -String representing the function name. When already in debug\n\ +Function name as a string variable. When already in debug\n\ mode this should be left out and only the line should be given.\n\ \n\ @item line\n\ -Line number you would like the breakpoint to be set on. Multiple\n\ -lines might be given as separate arguments or as a vector.\n\ +Line number where the breakpoint should be set. Multiple\n\ +lines may be given as separate arguments or as a vector.\n\ @end table\n\ \n\ -The rline returned is the real line that the breakpoint was set at.\n\ -@seealso{dbclear, dbstatus, dbstep}\n\ +When called with a single argument @var{func}, the breakpoint\n\ +is set at the first executable line in the named function.\n\ +\n\ +The optional output @var{rline} is the real line number where the\n\ +breakpoint was set. This can differ from specified line if\n\ +the line is not executable. For example, if a breakpoint attempted on a\n\ +blank line then Octave will set the real breakpoint at the\n\ +next executable line.\n\ +@seealso{dbclear, dbstatus, dbstep, debug_on_error, debug_on_warning, debug_on_interrupt}\n\ @end deftypefn") { bp_table::intmap retval; @@ -514,19 +548,26 @@ DEFUN (dbclear, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} dbclear (@var{func}, @var{line}, @dots{})\n\ -Delete a breakpoint in a function\n\ -@table @code\n\ +@deftypefn {Loadable Function} {} dbclear (\"@var{func}\")\n\ +@deftypefnx {Loadable Function} {} dbclear (\"@var{func}\", @var{line}, @dots{})\n\ +Delete a breakpoint in the function @var{func}.\n\ +\n\ +Arguments are\n\ +\n\ +@table @var\n\ @item func\n\ -String representing the function name. When already in debug\n\ +Function name as a string variable. When already in debug\n\ mode this should be left out and only the line should be given.\n\ \n\ @item line\n\ -Line number where you would like to remove the breakpoint. Multiple\n\ -lines might be given as separate arguments or as a vector.\n\ +Line number from which to remove a breakpoint. Multiple\n\ +lines may be given as separate arguments or as a vector.\n\ @end table\n\ -No checking is done to make sure that the line you requested is really\n\ -a breakpoint. If you get the wrong line nothing will happen.\n\ +\n\ +When called without a line number specification all breakpoints\n\ +in the named function are cleared.\n\ +\n\ +If the requested line is not a breakpoint no action is performed.\n\ @seealso{dbstop, dbstatus, dbwhere}\n\ @end deftypefn") { @@ -544,14 +585,31 @@ DEFUN (dbstatus, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {lst =} dbstatus (@var{func})\n\ -Return a vector containing the lines on which a function has \n\ -breakpoints set.\n\ -@table @code\n\ -@item func\n\ -String representing the function name. When already in debug\n\ -mode this should be left out.\n\ +@deftypefn {Loadable Function} {} dbstatus ()\n\ +@deftypefnx {Loadable Function} {@var{brk_list} =} dbstatus ()\n\ +@deftypefnx {Loadable Function} {@var{brk_list} =} dbstatus (\"@var{func}\")\n\ +Report the location of active breakpoints.\n\ +\n\ +When called with no input or output arguments, print the list of\n\ +all functions with breakpoints and the line numbers where those\n\ +breakpoints are set.\n\ +If a function name @var{func} is specified then only report breakpoints\n\ +for the named function.\n\ +\n\ +The optional return argument @var{brk_list} is a struct array with the\n\ +following fields.\n\ +\n\ +@table @asis\n\ +@item name\n\ +The name of the function with a breakpoint.\n\ +\n\ +@item file\n\ +The name of the m-file where the function code is located.\n\ +\n\ +@item line\n\ +A line number, or vector of line numbers, with a breakpoint.\n\ @end table\n\ +\n\ @seealso{dbclear, dbwhere}\n\ @end deftypefn") { @@ -563,7 +621,7 @@ if (nargin != 0 && nargin != 1) { - error ("dbstatus: only zero or one arguements accepted\n"); + error ("dbstatus: only zero or one arguments accepted\n"); return octave_value (); } @@ -640,8 +698,9 @@ DEFUN (dbwhere, , , "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} dbwhere ()\n\ -Show where we are in the code\n\ -@seealso{dbclear, dbstatus, dbstop}\n\ +In debugging mode, report the current file and line number where\n\ +execution is stopped.\n\ +@seealso{dbstatus, dbcont, dbstep, dbup}\n\ @end deftypefn") { octave_value retval; @@ -681,7 +740,7 @@ octave_stdout << " <unknown line>" << std::endl; } else - error ("dbwhere: must be inside of a user function to use dbwhere\n"); + error ("dbwhere: must be inside a user function to use dbwhere\n"); return retval; } @@ -731,9 +790,17 @@ DEFUN (dbtype, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} dbtype ()\n\ -List script file with line numbers.\n\ -@seealso{dbclear, dbstatus, dbstop}\n\ +@deftypefn {Loadable Function} {} dbtype ()\n\ +@deftypefnx {Loadable Function} {} dbtype (\"startl:endl\")\n\ +@deftypefnx {Loadable Function} {} dbtype (\"@var{func}\")\n\ +@deftypefnx {Loadable Function} {} dbtype (\"@var{func}\", \"startl:endl\")\n\ +When in debugging mode and called with no arguments, list the script file\n\ +being debugged with line numbers. An optional range specification,\n\ +specified as a string, can be used to list only a portion of the file.\n\ +\n\ +When called with the name of a function, list that script file\n\ +with line numbers.\n\ +@seealso{dbstatus, dbstop}\n\ @end deftypefn") { octave_value retval; @@ -752,7 +819,7 @@ if (dbg_fcn) do_dbtype (octave_stdout, dbg_fcn->name (), 0, INT_MAX); else - error ("dbtype: must be in a user function to give no arguments to dbtype\n"); + error ("dbtype: must be inside a user function to give no arguments to dbtype\n"); break; case 1: // (dbtype func) || (dbtype start:end) @@ -835,13 +902,8 @@ return retval; } -DEFUN (dbstack, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{stack}, @var{idx}]} dbstack (@var{n})\n\ -Print or return current stack information. With optional argument\n\ -@var{n}, omit the @var{n} innermost stack frames.\n\ -@seealso{dbclear, dbstatus, dbstop}\n\ -@end deftypefn") +static octave_value_list +do_dbstack (const octave_value_list& args, int nargout, std::ostream& os) { octave_value_list retval; @@ -869,7 +931,7 @@ if (n > 0) nskip = n; else - error ("dbstack: expecting N to be a nonnegative integer"); + error ("dbstack: N must be a non-negative integer"); } if (! error_state) @@ -882,7 +944,7 @@ if (nframes_to_display > 0) { - octave_stdout << "stopped in:\n\n"; + os << "stopped in:\n\n"; Cell names = stk.contents ("name"); Cell files = stk.contents ("file"); @@ -908,15 +970,15 @@ if (show_top_level && i == curr_frame) show_top_level = false; - octave_stdout << (i == curr_frame ? " --> " : " ") - << std::setw (max_name_len) << name - << " at line " << line - << " [" << file << "]" - << std::endl; + os << (i == curr_frame ? " --> " : " ") + << std::setw (max_name_len) << name + << " at line " << line + << " [" << file << "]" + << std::endl; } if (show_top_level) - octave_stdout << " --> top level" << std::endl; + os << " --> top level" << std::endl; } } else @@ -929,6 +991,56 @@ return retval; } +// A function that can be easily called from a debugger print the Octave +// stack. This can be useful for finding what line of code the +// interpreter is currently executing when the debugger is stopped in +// some C++ function, for example. + +void +show_octave_dbstack (void) +{ + do_dbstack (octave_value_list (), 0, std::cerr); +} + +DEFUN (dbstack, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} dbstack ()\n\ +@deftypefnx {Loadable Function} {} dbstack (@var{n})\n\ +@deftypefnx {Loadable Function} {[@var{stack}, @var{idx}] =} dbstack (@dots{})\n\ +Display or return current debugging function stack information.\n\ +With optional argument @var{n}, omit the @var{n} innermost stack frames.\n\ +\n\ +The optional return argument @var{stack} is a struct array with the\n\ +following fields:\n\ +\n\ +@table @asis\n\ +@item file\n\ +The name of the m-file where the function code is located.\n\ +\n\ +@item name\n\ +The name of the function with a breakpoint.\n\ +\n\ +@item line\n\ +The line number of an active breakpoint.\n\ +\n\ +@item column\n\ +The column number of the line where the breakpoint begins.\n\ +\n\ +@item scope\n\ +Undocumented.\n\ +\n\ +@item context\n\ +Undocumented.\n\ +@end table\n\ +\n\ +The return argument @var{idx} specifies which element of the @var{stack}\n\ +struct array is currently active.\n\ +@seealso{dbup, dbdown, dbwhere, dbstatus}\n\ +@end deftypefn") +{ + return do_dbstack (args, nargout, octave_stdout); +} + static void do_dbupdown (const octave_value_list& args, const std::string& who) { @@ -964,7 +1076,7 @@ @deftypefnx {Loadable Function} {} dbup (@var{n})\n\ In debugging mode, move up the execution stack @var{n} frames.\n\ If @var{n} is omitted, move up one frame.\n\ -@seealso{dbstack}\n\ +@seealso{dbstack, dbdown}\n\ @end deftypefn") { octave_value retval; @@ -980,7 +1092,7 @@ @deftypefnx {Loadable Function} {} dbdown (@var{n})\n\ In debugging mode, move down the execution stack @var{n} frames.\n\ If @var{n} is omitted, move down one frame.\n\ -@seealso{dbstack}\n\ +@seealso{dbstack, dbup}\n\ @end deftypefn") { octave_value retval; @@ -996,14 +1108,17 @@ @deftypefnx {Command} {} dbstep @var{n}\n\ @deftypefnx {Command} {} dbstep in\n\ @deftypefnx {Command} {} dbstep out\n\ +@deftypefnx {Command} {} dbnext @dots{}\n\ In debugging mode, execute the next @var{n} lines of code.\n\ -If @var{n} is omitted , execute the next single line of code.\n\ -If the next line of code is itself\n\ -defined in terms of an m-file remain in the existing function.\n\ +If @var{n} is omitted, execute the next single line of code.\n\ +If the next line of code is itself defined in terms of an m-file remain in\n\ +the existing function.\n\ \n\ Using @code{dbstep in} will cause execution of the next line to step into\n\ any m-files defined on the next line. Using @code{dbstep out} will cause\n\ execution to continue until the current function returns.\n\ +\n\ +@code{dbnext} is an alias for @code{dbstep}.\n\ @seealso{dbcont, dbquit}\n\ @end deftypefn") { @@ -1049,7 +1164,7 @@ } } else - error ("dbstep: expecting character string as argument"); + error ("dbstep: input argument must be a character string"); } else { @@ -1069,7 +1184,7 @@ DEFUN (dbcont, args, , "-*- texinfo -*-\n\ @deftypefn {Command} {} dbcont\n\ -In debugging mode, quit debugging mode and continue execution.\n\ +Leave command-line debugging mode and continue code execution normally.\n\ @seealso{dbstep, dbquit}\n\ @end deftypefn") { @@ -1093,8 +1208,9 @@ DEFUN (dbquit, args, , "-*- texinfo -*-\n\ @deftypefn {Command} {} dbquit\n\ -In debugging mode, quit debugging mode and return to the top level.\n\ -@seealso{dbstep, dbcont}\n\ +Quit debugging mode immediately without further code execution and\n\ +return to the Octave prompt.\n\ +@seealso{dbcont, dbstep}\n\ @end deftypefn") { if (Vdebugging) @@ -1119,8 +1235,8 @@ DEFUN (isdebugmode, args, , "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} isdebugmode ()\n\ -Return true if debug mode is on, otherwise false.\n\ -@seealso{dbstack, dbclear, dbstop, dbstatus}\n\ +Return true if in debugging mode, otherwise false.\n\ +@seealso{dbwhere, dbstack, dbstatus}\n\ @end deftypefn") { octave_value retval;
--- a/src/debug.h +++ b/src/debug.h @@ -55,21 +55,7 @@ typedef fname_line_map::const_iterator const_fname_line_map_iterator; typedef fname_line_map::iterator fname_line_map_iterator; - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - instance = new bp_table (); - - if (! instance) - { - ::error ("unable to create breakpoint table!"); - retval = false; - } - - return retval; - } + static bool instance_ok (void); // Add a breakpoint at the nearest executable line. static intmap add_breakpoint (const std::string& fname = "", @@ -127,6 +113,8 @@ static bp_table *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + intmap do_add_breakpoint (const std::string& fname, const intmap& lines); int do_remove_breakpoint (const std::string&, const intmap& lines);
--- a/src/defaults.cc +++ b/src/defaults.cc @@ -408,26 +408,47 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} EDITOR ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} EDITOR (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} EDITOR (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the editor to\n\ use with the @code{edit_history} command. The default value is taken from\n\ the environment variable @w{@env{EDITOR}} when Octave starts. If the\n\ environment variable is not initialized, @w{@env{EDITOR}} will be set to\n\ @code{\"emacs\"}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{edit_history}\n\ @end deftypefn") { return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EDITOR); } +/* +%!error (EDITOR (1, 2)); +%!test +%! orig_val = EDITOR (); +%! old_val = EDITOR ("X"); +%! assert (orig_val, old_val); +%! assert (EDITOR (), "X"); +%! EDITOR (orig_val); +%! assert (EDITOR (), orig_val); +*/ + DEFUN (EXEC_PATH, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} EXEC_PATH ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} EXEC_PATH (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} EXEC_PATH (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies a colon separated\n\ list of directories to append to the shell PATH when executing external\n\ programs. The initial value of is taken from the environment variable\n\ @w{@env{OCTAVE_EXEC_PATH}}, but that value can be overridden by\n\ the command line argument @option{--exec-path PATH}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { octave_value retval = SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EXEC_PATH); @@ -438,17 +459,44 @@ return retval; } +/* +%!error (EXEC_PATH (1, 2)); +%!test +%! orig_val = EXEC_PATH (); +%! old_val = EXEC_PATH ("X"); +%! assert (orig_val, old_val); +%! assert (EXEC_PATH (), "X"); +%! EXEC_PATH (orig_val); +%! assert (EXEC_PATH (), orig_val); +*/ + DEFUN (IMAGE_PATH, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} IMAGE_PATH ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} IMAGE_PATH (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} IMAGE_PATH (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies a colon separated\n\ list of directories in which to search for image files.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (IMAGE_PATH); } +/* +%!error (IMAGE_PATH (1, 2)); +%!test +%! orig_val = IMAGE_PATH (); +%! old_val = IMAGE_PATH ("X"); +%! assert (orig_val, old_val); +%! assert (IMAGE_PATH (), "X"); +%! IMAGE_PATH (orig_val); +%! assert (IMAGE_PATH (), orig_val); +*/ + DEFUN (OCTAVE_HOME, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} OCTAVE_HOME ()\n\ @@ -465,6 +513,11 @@ return retval; } +/* +%!error OCTAVE_HOME (1); +%!assert (ischar (OCTAVE_HOME ())); +*/ + DEFUNX ("OCTAVE_VERSION", FOCTAVE_VERSION, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} OCTAVE_VERSION ()\n\ @@ -482,3 +535,8 @@ return retval; } + +/* +%!error OCTAVE_VERSION (1); +%!assert (ischar (OCTAVE_VERSION ())); +*/
--- a/src/dirfns.cc +++ b/src/dirfns.cc @@ -87,7 +87,7 @@ return cd_ok; } -DEFUN (cd, args, , +DEFUN (cd, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Command} {} cd dir\n\ @deftypefnx {Command} {} chdir dir\n\ @@ -127,10 +127,18 @@ } else { - std::string home_dir = octave_env::get_home_directory (); + // Behave like Unixy shells for "cd" by itself, but be Matlab + // compatible if doing "current_dir = cd". - if (home_dir.empty () || ! octave_change_to_directory (home_dir)) - return retval; + if (nargout == 0) + { + std::string home_dir = octave_env::get_home_directory (); + + if (home_dir.empty () || ! octave_change_to_directory (home_dir)) + return retval; + } + else + retval = octave_value (octave_env::get_current_directory ()); } return retval; @@ -179,8 +187,8 @@ if (dir) { string_vector dirlist = dir.read (); + retval(1) = 0.0; retval(0) = Cell (dirlist.sort ()); - retval(1) = 0.0; } else { @@ -283,7 +291,7 @@ DEFUNX ("rmdir", Frmdir, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir})\n\ -@deftypefnx {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir}, @code{\"s\"})\n\ +@deftypefnx {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir}, \"s\")\n\ Remove the directory named @var{dir}.\n\ \n\ If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty\n\ @@ -479,12 +487,10 @@ int status = octave_readlink (symlink, result, msg); - retval(0) = result; - - retval(1) = status; - if (status < 0) retval(2) = msg; + retval(1) = status; + retval(0) = result; } } else @@ -545,7 +551,7 @@ @deftypefn {Built-in Function} {} glob (@var{pattern})\n\ Given an array of pattern strings (as a char array or a cell array) in\n\ @var{pattern}, return a cell array of file names that match any of\n\ -them, or an empty cell array if no patterns match. The pattern strings are \n\ +them, or an empty cell array if no patterns match. The pattern strings are\n\ interpreted as filename globbing patterns (as they are used by Unix shells).\n\ Within a pattern\n\ @table @code\n\ @@ -565,7 +571,7 @@ @example\n\ ls\n\ @result{}\n\ - file1 file2 file3 myfile1 myfile1b \n\ + file1 file2 file3 myfile1 myfile1b\n\ glob (\"*file1\")\n\ @result{}\n\ @{\n\ @@ -686,8 +692,8 @@ \n\ If 'all' is given, the function returns all valid file separators in\n\ the form of a string. The list of file separators is system-dependent.\n\ -It is @samp{/} (forward slash) under UNIX or Mac OS X, @samp{/} and @samp{\\}\n\ -(forward and backward slashes) under Windows.\n\ +It is @samp{/} (forward slash) under UNIX or @w{Mac OS X}, @samp{/} and\n\ +@samp{\\} (forward and backward slashes) under Windows.\n\ @seealso{pathsep}\n\ @end deftypefn") { @@ -764,8 +770,13 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} confirm_recursive_rmdir ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} confirm_recursive_rmdir (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} confirm_recursive_rmdir (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether Octave\n\ will ask for confirmation before recursively removing a directory tree.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (confirm_recursive_rmdir);
--- a/src/display.cc +++ b/src/display.cc @@ -27,13 +27,15 @@ #include <cstdlib> #if defined (OCTAVE_USE_WINDOWS_API) -#include <Windows.h> +#include <windows.h> #elif defined (HAVE_FRAMEWORK_CARBON) #include <Carbon/Carbon.h> #elif defined (HAVE_X_WINDOWS) #include <X11/Xlib.h> #endif +#include "singleton-cleanup.h" + #include "display.h" #include "error.h" @@ -118,6 +120,8 @@ } else warning ("X11 display has no default screen"); + + XCloseDisplay (display); } else warning ("unable to open X11 DISPLAY"); @@ -138,7 +142,12 @@ bool retval = true; if (! instance) - instance = new display_info (query); + { + instance = new display_info (query); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) {
--- a/src/display.h +++ b/src/display.h @@ -73,6 +73,8 @@ static display_info *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + // Height, width, and depth of the display. int ht; int wd;
--- a/src/dynamic-ld.cc +++ b/src/dynamic-ld.cc @@ -27,9 +27,10 @@ #include <iostream> #include <list> +#include "file-stat.h" #include "oct-env.h" #include "oct-time.h" -#include "file-stat.h" +#include "singleton-cleanup.h" #include <defaults.h> @@ -78,6 +79,8 @@ static octave_shlib_list *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + static bool instance_ok (void); // List of libraries we have loaded. @@ -148,7 +151,12 @@ bool retval = true; if (! instance) - instance = new octave_shlib_list (); + { + instance = new octave_shlib_list (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) { @@ -213,6 +221,8 @@ static octave_mex_file_list *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + static bool instance_ok (void); // List of libraries we have loaded. @@ -258,7 +268,12 @@ bool retval = true; if (! instance) - instance = new octave_mex_file_list (); + { + instance = new octave_mex_file_list (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) { @@ -295,7 +310,12 @@ bool retval = true; if (! instance) - instance = new octave_dynamic_loader (); + { + instance = new octave_dynamic_loader (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) {
--- a/src/dynamic-ld.h +++ b/src/dynamic-ld.h @@ -64,6 +64,8 @@ static octave_dynamic_loader *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + static bool instance_ok (void); octave_function *
--- a/src/error.cc +++ b/src/error.cc @@ -119,9 +119,6 @@ // TRUE means warning messages are turned off. bool discard_warning_messages = false; -// The message buffer. -static std::ostringstream *error_message_buffer = 0; - void reset_error_handler (void) { @@ -263,16 +260,7 @@ Vlast_error_stack = initialize_last_error_stack (); } - if (buffer_error_messages) - { - if (error_message_buffer) - msg_string = "error: " + msg_string; - else - error_message_buffer = new std::ostringstream (); - - *error_message_buffer << msg_string; - } - else + if (! buffer_error_messages) { octave_diary << msg_string; os << msg_string; @@ -564,7 +552,8 @@ } // For given warning ID, return 0 if warnings are disabled, 1 if -// enabled, and 2 if this ID should be an error instead of a warning. +// enabled, and 2 if the given ID should be an error instead of a +// warning. int warning_enabled (const std::string& id) @@ -610,8 +599,9 @@ } } + // If "all" is not present, assume warnings are enabled. if (all_state == -1) - panic_impossible (); + all_state = 1; if (all_state == 0) { @@ -1062,10 +1052,18 @@ } else if (nargin == 1 && args(0).is_map ()) { + // empty struct is not an error. return and resume calling function. + if (args(0).is_empty ()) + return retval; + octave_value_list tmp; octave_scalar_map m = args(0).scalar_map_value (); + // empty struct is not an error. return and resume calling function. + if (m.nfields () == 0) + return retval; + if (m.contains ("message")) { octave_value c = m.getfield ("message"); @@ -1097,6 +1095,10 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} warning (@var{template}, @dots{})\n\ @deftypefnx {Built-in Function} {} warning (@var{id}, @var{template}, @dots{})\n\ +@deftypefnx {Built-in Function} {} warning (\"on\", @var{id})\n\ +@deftypefnx {Built-in Function} {} warning (\"off\", @var{id})\n\ +@deftypefnx {Built-in Function} {} warning (\"query\", @var{id})\n\ +@deftypefnx {Built-in Function} {} warning (\"error\", @var{id})\n\ Format the optional arguments under the control of the template string\n\ @var{template} using the same rules as the @code{printf} family of\n\ functions (@pxref{Formatted Output}) and print the resulting message\n\ @@ -1110,14 +1112,19 @@ warnings tagged by @var{id}. The special identifier @samp{\"all\"} may\n\ be used to set the state of all warnings.\n\ \n\ -@deftypefnx {Built-in Function} {} warning (\"on\", @var{id})\n\ -@deftypefnx {Built-in Function} {} warning (\"off\", @var{id})\n\ -@deftypefnx {Built-in Function} {} warning (\"error\", @var{id})\n\ -@deftypefnx {Built-in Function} {} warning (\"query\", @var{id})\n\ -Set or query the state of a particular warning using the identifier\n\ -@var{id}. If the identifier is omitted, a value of @samp{\"all\"} is\n\ -assumed. If you set the state of a warning to @samp{\"error\"}, the\n\ -warning named by @var{id} is handled as if it were an error instead.\n\ +If the first argument is @samp{\"on\"} or @samp{\"off\"}, set the state\n\ +of a particular warning using the identifier @var{id}. If the first\n\ +argument is @samp{\"query\"}, query the state of this warning instead.\n\ +If the identifier is omitted, a value of @samp{\"all\"} is assumed. If\n\ +you set the state of a warning to @samp{\"error\"}, the warning named by\n\ +@var{id} is handled as if it were an error instead. So, for example, the\n\ +following handles all warnings as errors:\n\ +\n\ +@example\n\ +@group\n\ +warning (\"error\");\n\ +@end group\n\ +@end example\n\ @seealso{warning_ids}\n\ @end deftypefn") { @@ -1456,8 +1463,6 @@ disable_warning ("Octave:array-to-scalar"); disable_warning ("Octave:array-to-vector"); - disable_warning ("Octave:empty-list-elements"); - disable_warning ("Octave:fortran-indexing"); disable_warning ("Octave:imag-to-real"); disable_warning ("Octave:matlab-incompatible"); disable_warning ("Octave:missing-semicolon"); @@ -1466,13 +1471,16 @@ disable_warning ("Octave:separator-insert"); disable_warning ("Octave:single-quote-string"); disable_warning ("Octave:str-to-num"); - disable_warning ("Octave:string-concat"); + disable_warning ("Octave:mixed-string-concat"); disable_warning ("Octave:variable-switch-label"); - disable_warning ("Octave:complex-cmp-ops"); // This should be an error unless we are in maximum braindamage mode. + // FIXME: Not quite right. This sets the error state even for braindamage + // mode. Also, this error is not triggered in normal mode because another + // error handler catches it first and gives: + // error: subscript indices must be either positive integers or logicals + set_warning_state ("Octave:noninteger-range-as-index", "error"); - set_warning_state ("Octave:allow-noninteger-ranges-as-indices", "error"); } DEFUN (lasterror, args, , @@ -1480,9 +1488,9 @@ @deftypefn {Built-in Function} {@var{lasterr} =} lasterror ()\n\ @deftypefnx {Built-in Function} {} lasterror (@var{err})\n\ @deftypefnx {Built-in Function} {} lasterror ('reset')\n\ -Query or set the last error message. Called without any arguments\n\ -returns a structure containing the last error message, as well as other\n\ -information related to this error. The elements of this structure are:\n\ +Query or set the last error message structure. When called without\n\ +arguments, return a structure containing the last error message and other\n\ +information related to this error. The elements of the structure are:\n\ \n\ @table @asis\n\ @item 'message'\n\ @@ -1492,9 +1500,9 @@ The message identifier of this error message\n\ \n\ @item 'stack'\n\ -A structure containing information on where the message occurred. This might\n\ -be an empty structure if this in the case where this information cannot\n\ -be obtained. The fields of this structure are:\n\ +A structure containing information on where the message occurred. This may\n\ +be an empty structure if the information cannot\n\ +be obtained. The fields of the structure are:\n\ \n\ @table @asis\n\ @item 'file'\n\ @@ -1511,14 +1519,13 @@ @end table\n\ @end table\n\ \n\ -The @var{err} structure may also be passed to @code{lasterror} to set the\n\ -information about the last error. The only constraint on @var{err} in that\n\ -case is that it is a scalar structure. Any fields of @var{err} that match\n\ -the above are set to the value passed in @var{err}, while other fields are\n\ +The last error structure may be set by passing a scalar structure, @var{err},\n\ +as input. Any fields of @var{err} that match those above are set while any\n\ +unspecified fields are initialized with default values.\n\ +\n\ +If @code{lasterror} is called with the argument 'reset', all fields are\n\ set to their default values.\n\ -\n\ -If @code{lasterror} is called with the argument 'reset', all values take\n\ -their default values.\n\ +@seealso{lasterr}\n\ @end deftypefn") { octave_value retval; @@ -1579,7 +1586,7 @@ if (! error_state && new_err.contains ("stack")) { octave_scalar_map new_err_stack = - new_err.getfield("identifier").scalar_map_value (); + new_err.getfield("stack").scalar_map_value (); if (! error_state && new_err_stack.contains ("file")) { @@ -1636,10 +1643,14 @@ DEFUN (lasterr, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lasterr (@var{msg}, @var{msgid})\n\ -Without any arguments, return the last error message. With one\n\ +@deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lasterr ()\n\ +@deftypefnx {Built-in Function} {} lasterr (@var{msg})\n\ +@deftypefnx {Built-in Function} {} lasterr (@var{msg}, @var{msgid})\n\ +Query or set the last error message. When called without input arguments,\n\ +return the last error message and message identifier. With one\n\ argument, set the last error message to @var{msg}. With two arguments,\n\ also set the last message identifier.\n\ +@seealso{lasterror}\n\ @end deftypefn") { octave_value_list retval; @@ -1681,10 +1692,6 @@ return retval; } -// For backward compatibility. -DEFALIAS (error_text, lasterr); -DEFALIAS (__error_text__, lasterr); - DEFUN (lastwarn, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lastwarn (@var{msg}, @var{msgid})\n\ @@ -1766,8 +1773,13 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} beep_on_error ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} beep_on_error (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} beep_on_error (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether Octave will try\n\ to ring the terminal bell before printing an error message.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (beep_on_error); @@ -1777,10 +1789,15 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} debug_on_error ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} debug_on_error (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} debug_on_error (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether Octave will try\n\ to enter the debugger when an error is encountered. This will also\n\ inhibit printing of the normal traceback message (you will only see\n\ the top-level error message).\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (debug_on_error); @@ -1790,8 +1807,13 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} debug_on_warning ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} debug_on_warning (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} debug_on_warning (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether Octave will try\n\ to enter the debugger when a warning is encountered.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (debug_on_warning);
--- a/src/file-io.cc +++ b/src/file-io.cc @@ -46,6 +46,7 @@ #include <stack> #include <vector> +#include <fcntl.h> #include <sys/types.h> #include <unistd.h> @@ -209,9 +210,11 @@ DEFUN (fclose, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fclose (@var{fid})\n\ +@deftypefn {Built-in Function} {} fclose (@var{fid})\n\ +@deftypefnx {Built-in Function} {} fclose (\"all\")\n\ Close the specified file. If successful, @code{fclose} returns 0,\n\ -otherwise, it returns -1.\n\ +otherwise, it returns -1. The second form of the @code{fclose} call closes\n\ +all open files except @code{stdout}, @code{stderr}, and @code{stdin}.\n\ @seealso{fopen, fseek, ftell}\n\ @end deftypefn") { @@ -345,7 +348,8 @@ DEFUN (fgets, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fgets (@var{fid}, @var{len})\n\ +@deftypefn {Built-in Function} {} fgets (@var{fid})\n\ +@deftypefnx {Built-in Function} {} fgets (@var{fid}, @var{len})\n\ Read characters from a file, stopping after a newline, or EOF,\n\ or @var{len} characters have been read. The characters read, including\n\ the possible trailing newline, are returned as a string.\n\ @@ -491,7 +495,7 @@ { tmode.erase (pos, 1); - FILE *fptr = ::fopen (fname.c_str (), tmode.c_str ()); + FILE *fptr = gnulib::fopen (fname.c_str (), tmode.c_str ()); int fd = fileno (fptr); @@ -506,7 +510,7 @@ else #endif { - FILE *fptr = ::fopen (fname.c_str (), tmode.c_str ()); + FILE *fptr = gnulib::fopen (fname.c_str (), tmode.c_str ()); retval = octave_stdiostream::create (fname, fptr, md, flt_fmt); @@ -663,14 +667,14 @@ if (nargin == 1) { - if (nargout < 2 && args(0).is_string ()) + if (args(0).is_string ()) { // If there is only one argument and it is a string but it // is not the string "all", we assume it is a file to open // with MODE = "r". To open a file called "all", you have // to supply more than one argument. - if (args(0).string_value () == "all") + if (nargout < 2 && args(0).string_value () == "all") return octave_stream_list::open_file_numbers (); } else @@ -730,7 +734,7 @@ freport ()\n\ \n\ @print{} number mode name\n\ - @print{} \n\ + @print{}\n\ @print{} 0 r stdin\n\ @print{} 1 w stdout\n\ @print{} 2 w stderr\n\ @@ -1065,8 +1069,8 @@ DEFUN (fscanf, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}] =} fscanf (@var{fid}, @var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} fscanf (@var{fid}, @var{template}, \"C\")\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} fscanf (@var{fid}, @var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}, @var{errmsg}] =} fscanf (@var{fid}, @var{template}, \"C\")\n\ In the first form, read from @var{fid} according to @var{template},\n\ returning the result in the matrix @var{val}.\n\ \n\ @@ -1099,6 +1103,8 @@ \n\ The number of items successfully read is returned in @var{count}.\n\ \n\ +If an error occurs, @var{errmsg} contains a system-dependent error message.\n\ +\n\ In the second form, read from @var{fid} according to @var{template},\n\ with each conversion specifier in @var{template} corresponding to a\n\ single scalar return value. This form is more `C-like', and also\n\ @@ -1132,8 +1138,9 @@ } else { - retval (1) = 0.0; - retval (0) = Matrix (); + retval(2) = "unknown error"; + retval(1) = 0.0; + retval(0) = Matrix (); if (nargin == 2 || nargin == 3) { @@ -1155,6 +1162,7 @@ if (! error_state) { + retval(2) = os.error (); retval(1) = count; retval(0) = tmp; } @@ -1171,13 +1179,32 @@ return retval; } +static std::string +get_sscanf_data (const octave_value& val) +{ + std::string retval; + + if (val.is_string ()) + { + octave_value tmp = val.reshape (dim_vector (1, val.numel ())); + + retval = tmp.string_value (); + } + else + ::error ("sscanf: argument STRING must be a string"); + + return retval; +} + DEFUN (sscanf, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}] =} sscanf (@var{string}, @var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} sscanf (@var{string}, @var{template}, \"C\")\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}, @var{pos}] =} sscanf (@var{string}, @var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}, @var{errmsg}] =} sscanf (@var{string}, @var{template}, \"C\")\n\ This is like @code{fscanf}, except that the characters are taken from the\n\ string @var{string} instead of from a stream. Reaching the end of the\n\ -string is treated as an end-of-file condition.\n\ +string is treated as an end-of-file condition. In addition to the values\n\ +returned by @code{fscanf}, the index of the next character to be read\n\ +is returned in @var{pos}.\n\ @seealso{fscanf, scanf, sprintf}\n\ @end deftypefn") { @@ -1189,10 +1216,10 @@ if (nargin == 3 && args(2).is_string ()) { - if (args(0).is_string ()) + std::string data = get_sscanf_data (args(0)); + + if (! error_state) { - std::string data = args(0).string_value (); - octave_stream os = octave_istrstream::create (data); if (os.is_valid ()) @@ -1218,10 +1245,10 @@ retval(1) = 0.0; retval(0) = Matrix (); - if (args(0).is_string ()) + std::string data = get_sscanf_data (args(0)); + + if (! error_state) { - std::string data = args(0).string_value (); - octave_stream os = octave_istrstream::create (data); if (os.is_valid ()) @@ -1244,7 +1271,8 @@ // position will clear it. std::string errmsg = os.error (); - retval(3) = os.tell () + 1; + retval(3) + = (os.eof () ? data.length () : os.tell ()) + 1; retval(2) = errmsg; retval(1) = count; retval(0) = tmp; @@ -1257,8 +1285,6 @@ ::error ("%s: unable to create temporary input buffer", who.c_str ()); } - else - ::error ("%s: argument STRING must be a string", who.c_str ()); } else print_usage (); @@ -1269,8 +1295,8 @@ DEFUN (scanf, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}] =} scanf (@var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}]] =} scanf (@var{template}, \"C\")\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} scanf (@var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}, @var{errmsg}]] =} scanf (@var{template}, \"C\")\n\ This is equivalent to calling @code{fscanf} with @var{fid} = @code{stdin}.\n\ \n\ It is currently not useful to call @code{scanf} in interactive\n\ @@ -1919,7 +1945,7 @@ if (nargin == 0) { - FILE *fid = tmpfile (); + FILE *fid = gnulib::tmpfile (); if (fid) { @@ -1956,7 +1982,7 @@ filename unique. The file is then created with mode read/write and\n\ permissions that are system dependent (on GNU/Linux systems, the permissions\n\ will be 0600 for versions of glibc 2.0.7 and later). The file is opened\n\ -with the @w{@code{O_EXCL}} flag.\n\ +in binary mode and with the @w{@code{O_EXCL}} flag.\n\ \n\ If the optional argument @var{delete} is supplied and is true,\n\ the file will be deleted automatically when Octave exits, or when\n\ @@ -1986,7 +2012,7 @@ OCTAVE_LOCAL_BUFFER (char, tmp, tmpl8.size () + 1); strcpy (tmp, tmpl8.c_str ()); - int fd = mkstemp (tmp); + int fd = gnulib::mkostemp (tmp, O_BINARY); if (fd < 0) { @@ -1995,7 +2021,7 @@ } else { - const char *fopen_mode = "w+"; + const char *fopen_mode = "w+b"; FILE *fid = fdopen (fd, fopen_mode);
--- a/src/find-defun-files.sh +++ b/src/find-defun-files.sh @@ -21,6 +21,6 @@ file="$srcdir/$arg" fi if [ "`$EGREP -l "$DEFUN_PATTERN" $file`" ]; then - echo "$file" | $SED 's,.*/,,; s/\.\(cc\|yy\|ll\)$/.df/'; + echo "$file" | $SED 's,.*/,,; s/\.cc$/.df/; s/\.ll$/.df/; s/\.yy$/.df/'; fi done
--- a/src/genprops.awk +++ b/src/genprops.awk @@ -241,6 +241,27 @@ emit_get_accessor(i, "octave_value", "get"); } +## string_array_property + +function emit_get_string_array (i) +{ + printf (" std::string get_%s_string (void) const", name[i]); + + if (emit_get[i] == "definition") + printf (" { return %s.string_value (); }\n", name[i]); + else + printf (";\n"); + + printf (" string_vector get_%s_vector (void) const", name[i]); + + if (emit_get[i] == "definition") + printf (" { return %s.string_vector_value (); }\n", name[i]); + else + printf (";\n"); + + emit_get_accessor(i, "octave_value", "get"); +} + ## common section function emit_common_declarations () @@ -300,8 +321,8 @@ emit_get_accessor(i, "graphics_handle", "handle_value"); else if (type[i] == "string_property") emit_get_accessor(i, "std::string", "string_value"); - else if (type[i] == "string_array_property") - emit_get_accessor(i, "octave_value", "get"); + else if (type[i] == "text_label_property") + emit_get_accessor(i, "octave_value", "get"); else if (type[i] == "double_property") emit_get_accessor(i, "double", "double_value"); else if (type[i] == "double_radio_property") @@ -317,6 +338,8 @@ emit_get_color(i); else if (type[i] == "callback_property") emit_get_callback(i); + else if (type[i] == "string_array_property") + emit_get_string_array(i); else { printf (" %s get_%s (void) const", type[i], name[i]);
--- a/src/gl-render.cc +++ b/src/gl-render.cc @@ -30,6 +30,7 @@ #include <lo-mappers.h> #include "oct-locbuf.h" +#include "oct-refcount.h" #include "gl-render.h" #include "txt-eng.h" #include "txt-eng-ft.h" @@ -544,7 +545,7 @@ }; void -opengl_renderer::draw (const graphics_object& go) +opengl_renderer::draw (const graphics_object& go, bool toplevel) { if (! go.valid_object ()) return; @@ -567,11 +568,20 @@ draw_text (dynamic_cast<const text::properties&> (props)); else if (go.isa ("image")) draw_image (dynamic_cast<const image::properties&> (props)); - else if (go.isa ("uimenu")) - ; + else if (go.isa ("uimenu") || go.isa ("uicontrol") + || go.isa ("uicontextmenu") || go.isa ("uitoolbar") + || go.isa ("uipushtool") || go.isa ("uitoggletool")) + /* SKIP */; + else if (go.isa ("uipanel")) + { + if (toplevel) + draw_uipanel (dynamic_cast<const uipanel::properties&> (props), go); + } else - warning ("opengl_renderer: cannot render object of type `%s'", - props.graphics_object_name ().c_str ()); + { + warning ("opengl_renderer: cannot render object of type `%s'", + props.graphics_object_name ().c_str ()); + } } void @@ -581,13 +591,45 @@ // Initialize OpenGL context + init_gl_context (props.is___enhanced__ (), props.get_color_rgb ()); + + // Draw children + + draw (props.get_all_children (), false); +} + +void +opengl_renderer::draw_uipanel (const uipanel::properties& props, + const graphics_object& go) +{ + graphics_object fig = go.get_ancestor ("figure"); + const figure::properties& figProps = + dynamic_cast<const figure::properties&> (fig.get_properties ()); + + toolkit = figProps.get_toolkit (); + + // Initialize OpenGL context + + init_gl_context (figProps.is___enhanced__ (), + props.get_backgroundcolor_rgb ()); + + // Draw children + + draw (props.get_all_children (), false); +} + +void +opengl_renderer::init_gl_context (bool enhanced, const Matrix& c) +{ + // Initialize OpenGL context + glEnable (GL_DEPTH_TEST); glDepthFunc (GL_LEQUAL); glBlendFunc (GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glAlphaFunc (GL_GREATER, 0.0f); glEnable (GL_NORMALIZE); - if (props.is___enhanced__ ()) + if (enhanced) { glEnable (GL_BLEND); glEnable (GL_LINE_SMOOTH); @@ -600,17 +642,11 @@ // Clear background - Matrix c = props.get_color_rgb (); - if (c.length() >= 3) { glClearColor (c(0), c(1), c(2), 1); glClear (GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); } - - // Draw children - - draw (props.get_all_children ()); } void @@ -665,7 +701,7 @@ double p1, double p1N, double p2, double p2N, double dx, double dy, double dz, - int xyz, bool doubleside) + int xyz, bool mirror) { glBegin (GL_LINES); @@ -679,7 +715,7 @@ { glVertex3d (val, p1, p2); glVertex3d (val, p1+dy, p2+dz); - if (doubleside) + if (mirror) { glVertex3d (val, p1N, p2N); glVertex3d (val, p1N-dy, p2N-dz); @@ -689,7 +725,7 @@ { glVertex3d (p1, val, p2); glVertex3d (p1+dx, val, p2+dz); - if (doubleside) + if (mirror) { glVertex3d (p1N, val, p2N); glVertex3d (p1N-dx, val, p2N-dz); @@ -699,7 +735,7 @@ { glVertex3d (p1, p2, val); glVertex3d (p1+dx, p2+dy, val); - if (doubleside) + if (mirror) { glVertex3d (p1N, p2N, val); glVertex3d (p1N-dx, p2N-dy, val); @@ -849,7 +885,7 @@ double ypTickN = props.get_ypTickN (); double zpTickN = props.get_zpTickN (); - bool plotyy = (props.get_tag () == "plotyy"); + bool plotyy = (props.has_property ("__plotyy_axes__")); // Axes box @@ -966,7 +1002,7 @@ string_vector xticklabels = props.get_xticklabel ().all_strings (); int wmax = 0, hmax = 0; bool tick_along_z = nearhoriz || xisinf (fy); - bool box = props.is_box (); + bool mirror = props.is_box () && xstate != AXE_ANY_DIR; set_color (props.get_xcolor_rgb ()); @@ -982,14 +1018,14 @@ render_tickmarks (xticks, x_min, x_max, ypTick, ypTick, zpTick, zpTickN, 0., 0., signum(zpTick-zpTickN)*fz*xticklen, - 0, (box && xstate != AXE_ANY_DIR)); + 0, mirror); } else { render_tickmarks (xticks, x_min, x_max, ypTick, ypTickN, zpTick, zpTick, 0., signum(ypTick-ypTickN)*fy*xticklen, - 0., 0, (box && xstate != AXE_ANY_DIR)); + 0., 0, mirror); } // tick texts @@ -1021,12 +1057,12 @@ render_tickmarks (xmticks, x_min, x_max, ypTick, ypTick, zpTick, zpTickN, 0., 0., signum(zpTick-zpTickN)*fz*xticklen/2, - 0, (box && xstate != AXE_ANY_DIR)); + 0, mirror); else render_tickmarks (xmticks, x_min, x_max, ypTick, ypTickN, zpTick, zpTick, 0., signum(ypTick-ypTickN)*fy*xticklen/2, - 0., 0, (box && xstate != AXE_ANY_DIR)); + 0., 0, mirror); } gh_manager::get_object (props.get_xlabel ()).set ("visible", "on"); @@ -1073,7 +1109,8 @@ string_vector yticklabels = props.get_yticklabel ().all_strings (); int wmax = 0, hmax = 0; bool tick_along_z = nearhoriz || xisinf (fx); - bool box = props.is_box (); + bool mirror = props.is_box () && ystate != AXE_ANY_DIR + && (! props.has_property ("__plotyy_axes__")); set_color (props.get_ycolor_rgb ()); @@ -1088,12 +1125,12 @@ render_tickmarks (yticks, y_min, y_max, xpTick, xpTick, zpTick, zpTickN, 0., 0., signum(zpTick-zpTickN)*fz*yticklen, - 1, (box && ystate != AXE_ANY_DIR)); + 1, mirror); else render_tickmarks (yticks, y_min, y_max, xpTick, xpTickN, zpTick, zpTick, signum(xPlaneN-xPlane)*fx*yticklen, - 0., 0., 1, (box && ystate != AXE_ANY_DIR)); + 0., 0., 1, mirror); // tick texts if (yticklabels.numel () > 0) @@ -1125,12 +1162,12 @@ render_tickmarks (ymticks, y_min, y_max, xpTick, xpTick, zpTick, zpTickN, 0., 0., signum(zpTick-zpTickN)*fz*yticklen/2, - 1, (box && ystate != AXE_ANY_DIR)); + 1, mirror); else render_tickmarks (ymticks, y_min, y_max, xpTick, xpTickN, zpTick, zpTick, signum(xpTick-xpTickN)*fx*yticklen/2, - 0., 0., 1, (box && ystate != AXE_ANY_DIR)); + 0., 0., 1, mirror); } gh_manager::get_object (props.get_ylabel ()).set ("visible", "on"); @@ -1169,7 +1206,7 @@ Matrix zmticks = xform.zscale (props.get_zmtick ().matrix_value ()); string_vector zticklabels = props.get_zticklabel ().all_strings (); int wmax = 0, hmax = 0; - bool box = props.is_box (); + bool mirror = props.is_box () && zstate != AXE_ANY_DIR; set_color (props.get_zcolor_rgb ()); @@ -1185,7 +1222,7 @@ render_tickmarks (zticks, z_min, z_max, xPlaneN, xPlane, yPlane, yPlane, signum(xPlaneN-xPlane)*fx*zticklen, - 0., 0., 2, (box && zstate != AXE_ANY_DIR)); + 0., 0., 2, mirror); else render_tickmarks (zticks, z_min, z_max, xPlaneN, xPlaneN, yPlane, yPlane, 0., @@ -1198,7 +1235,7 @@ render_tickmarks (zticks, z_min, z_max, xPlaneN, xPlane, yPlaneN, yPlane, 0., signum(yPlaneN-yPlane)*fy*zticklen, - 0., 2, (box && zstate != AXE_ANY_DIR)); + 0., 2, mirror); else render_tickmarks (zticks, z_min, z_max, xPlane, xPlane, yPlaneN, yPlane, @@ -1250,7 +1287,7 @@ render_tickmarks (zmticks, z_min, z_max, xPlaneN, xPlane, yPlane, yPlane, signum(xPlaneN-xPlane)*fx*zticklen/2, - 0., 0., 2, (box && zstate != AXE_ANY_DIR)); + 0., 0., 2, mirror); else render_tickmarks (zmticks, z_min, z_max, xPlaneN, xPlaneN, yPlane, yPlane, 0., @@ -1263,13 +1300,13 @@ render_tickmarks (zmticks, z_min, z_max, xPlane, xPlane, yPlaneN, yPlane, 0., signum(yPlaneN-yPlane)*fy*zticklen/2, - 0., 2, (box && zstate != AXE_ANY_DIR)); + 0., 2, mirror); else render_tickmarks (zmticks, z_min, z_max, xPlane, xPlane, yPlaneN, yPlaneN, signum(xPlane-xPlaneN)*fx*zticklen/2, 0., 0., 2, false); - } + } } gh_manager::get_object (props.get_zlabel ()).set ("visible", "on"); @@ -2373,7 +2410,7 @@ { if (c.numel () == 0) c = props.get_color_data ().matrix_value (); - has_markerfacecolor = ((c.numel () > 0) + has_markerfacecolor = ((c.numel () > 0) && (c.rows () == f.rows ())); } } @@ -2421,10 +2458,10 @@ void opengl_renderer::draw_text (const text::properties& props) { - if (props.get_string ().empty ()) + if (props.get_string ().is_empty ()) return; - const Matrix pos = xform.scale (props.get_data_position ()); + Matrix pos = xform.scale (props.get_data_position ()); const Matrix bbox = props.get_extent_matrix (); // FIXME: handle margin and surrounding box @@ -2432,7 +2469,7 @@ glEnable (GL_BLEND); glEnable (GL_ALPHA_TEST); - glRasterPos3d (pos(0), pos(1), pos(2)); + glRasterPos3d (pos(0), pos(1), pos.numel () > 2 ? pos(2) : 0.0); glBitmap(0, 0, 0, 0, bbox(0), bbox(1), 0); glDrawPixels (bbox(2), bbox(3), GL_RGBA, GL_UNSIGNED_BYTE, props.get_pixels ().data ()); @@ -2448,7 +2485,6 @@ octave_value cdata = props.get_color_data (); dim_vector dv (cdata.dims ()); int h = dv(0), w = dv(1); - bool ok = true; Matrix x = props.get_xdata ().matrix_value (); Matrix y = props.get_ydata ().matrix_value (); @@ -2592,16 +2628,11 @@ draw_pixels (j1-j0, i1-i0, GL_RGB, GL_UNSIGNED_BYTE, a); } else - { - ok = false; - warning ("opengl_texture::draw: invalid image data type (expected double, uint16, or uint8)"); - } + warning ("opengl_texture::draw: invalid image data type (expected double, uint16, or uint8)"); } else - { - ok = false; - warning ("opengl_texture::draw: invalid image size (expected n*m*3 or n*m)"); - } + warning ("opengl_texture::draw: invalid image size (expected n*m*3 or n*m)"); + glPixelZoom (1, 1); } @@ -2857,7 +2888,7 @@ glBegin (GL_POLYGON); for (double ang = 0; ang < (2*M_PI); ang += ang_step) - glVertex2d (sz*cos(ang)/6, sz*sin(ang)/6); + glVertex2d (sz*cos(ang)/3, sz*sin(ang)/3); glEnd (); } break;
--- a/src/gl-render.h +++ b/src/gl-render.h @@ -59,9 +59,9 @@ virtual ~opengl_renderer (void) { } - virtual void draw (const graphics_object& go); + virtual void draw (const graphics_object& go, bool toplevel = true); - virtual void draw (const Matrix& hlist) + virtual void draw (const Matrix& hlist, bool toplevel = false) { int len = hlist.length (); @@ -70,7 +70,7 @@ graphics_object obj = gh_manager::get_object (hlist(i)); if (obj) - draw (obj); + draw (obj, toplevel); } } @@ -86,6 +86,10 @@ virtual void draw_hggroup (const hggroup::properties& props); virtual void draw_text (const text::properties& props); virtual void draw_image (const image::properties& props); + virtual void draw_uipanel (const uipanel::properties& props, + const graphics_object& go); + + virtual void init_gl_context (bool enhanced, const Matrix& backgroundColor); virtual void set_color (const Matrix& c); virtual void set_polygon_offset (bool on, double offset = 0.0);
--- a/src/gl2ps-renderer.cc +++ b/src/gl2ps-renderer.cc @@ -199,7 +199,7 @@ void glps_renderer::draw_text (const text::properties& props) { - if (props.get_string ().empty ()) + if (props.get_string ().is_empty ()) return; set_font (props); @@ -223,9 +223,15 @@ // FIXME: handle margin and surrounding box glRasterPos3d (pos(0), pos(1), pos(2)); - gl2psTextOpt (props.get_string ().c_str (), fontname.c_str (), fontsize, + + octave_value string_prop = props.get_string (); + + string_vector sv = string_prop.all_strings (); + + std::string s = sv.join ("\n"); + + gl2psTextOpt (s.c_str (), fontname.c_str (), fontsize, alignment_to_mode (halign, valign), props.get_rotation ()); - } #endif
--- a/src/gl2ps.c +++ b/src/gl2ps.c @@ -1,6 +1,6 @@ /* * GL2PS, an OpenGL to PostScript Printing Library - * Copyright (C) 1999-2009 C. Geuzaine + * Copyright (C) 1999-2011 C. Geuzaine * * This program is free software; you can redistribute it and/or * modify it under the terms of either: @@ -305,10 +305,12 @@ static void *gl2psRealloc(void *ptr, size_t size) { + void *orig = ptr; if(!size) return NULL; - ptr = realloc(ptr, size); + ptr = realloc(orig, size); if(!ptr){ gl2psMsg(GL2PS_ERROR, "Couldn't reallocate requested memory"); + free(orig); return NULL; } return ptr; @@ -320,12 +322,12 @@ free(ptr); } -static size_t gl2psWriteBigEndian(unsigned long data, size_t bytes) -{ - size_t i; - size_t size = sizeof(unsigned long); +static int gl2psWriteBigEndian(unsigned long data, int bytes) +{ + int i; + int size = sizeof(unsigned long); for(i = 1; i <= bytes; ++i){ - fputc(0xff & (data >> (size-i) * 8), gl2ps->stream); + fputc(0xff & (data >> (size - i) * 8), gl2ps->stream); } return bytes; } @@ -392,10 +394,10 @@ return gl2ps->compress->start; } -static size_t gl2psWriteBigEndianCompress(unsigned long data, size_t bytes) -{ - size_t i; - size_t size = sizeof(unsigned long); +static int gl2psWriteBigEndianCompress(unsigned long data, int bytes) +{ + int i; + int size = sizeof(unsigned long); for(i = 1; i <= bytes; ++i){ *gl2ps->compress->src = (Bytef)(0xff & (data >> (size-i) * 8)); ++gl2ps->compress->src; @@ -441,7 +443,7 @@ return ret; } -static void gl2psPrintGzipHeader() +static void gl2psPrintGzipHeader(void) { #if defined(GL2PS_HAVE_ZLIB) char tmp[10] = {'\x1f', '\x8b', /* magic numbers: 0x1f, 0x8b */ @@ -459,7 +461,7 @@ #endif } -static void gl2psPrintGzipFooter() +static void gl2psPrintGzipFooter(void) { #if defined(GL2PS_HAVE_ZLIB) int n; @@ -789,6 +791,7 @@ static void gl2psUserFlushPNG(png_structp png_ptr) { + (void) png_ptr; /* not used */ } static void gl2psConvertPixmapToPNG(GL2PSimage *pixmap, GL2PSlist *png) @@ -1358,17 +1361,17 @@ (*t2)->verts[0] = quad->verts[0]; (*t2)->verts[1] = quad->verts[2]; (*t2)->verts[2] = quad->verts[3]; - (*t2)->boundary = ((quad->boundary & 4) ? 2 : 0) | ((quad->boundary & 4) ? 2 : 0); + (*t2)->boundary = ((quad->boundary & 4) ? 2 : 0) | ((quad->boundary & 8) ? 4 : 0); } static int gl2psCompareDepth(const void *a, const void *b) { - GL2PSprimitive *q, *w; + const GL2PSprimitive *q, *w; GLfloat dq = 0.0F, dw = 0.0F, diff; int i; - q = *(GL2PSprimitive**)a; - w = *(GL2PSprimitive**)b; + q = *(const GL2PSprimitive* const*)a; + w = *(const GL2PSprimitive* const*)b; for(i = 0; i < q->numverts; i++){ dq += q->verts[i].xyz[2]; @@ -1394,10 +1397,10 @@ static int gl2psTrianglesFirst(const void *a, const void *b) { - GL2PSprimitive *q, *w; - - q = *(GL2PSprimitive**)a; - w = *(GL2PSprimitive**)b; + const GL2PSprimitive *q, *w; + + q = *(const GL2PSprimitive* const*)a; + w = *(const GL2PSprimitive* const*)b; return (q->type < w->type ? 1 : -1); } @@ -1614,7 +1617,7 @@ } } -static void gl2psRescaleAndOffset() +static void gl2psRescaleAndOffset(void) { GL2PSprimitive *prim; GLfloat minZ, maxZ, rangeZ, scaleZ; @@ -3201,7 +3204,7 @@ int i; if(gl2ps->filename && strlen(gl2ps->filename) < 256){ - for(i = strlen(gl2ps->filename)-1; i >= 0; i--){ + for(i = (int)strlen(gl2ps->filename) - 1; i >= 0; i--){ if(gl2ps->filename[i] == '.'){ strncpy(name, gl2ps->filename, i); name[i] = '\0'; @@ -3306,6 +3309,7 @@ static void gl2psPrintTeXBeginViewport(GLint viewport[4]) { + (void) viewport; /* not used */ glRenderMode(GL_FEEDBACK); if(gl2ps->header){ @@ -3409,7 +3413,7 @@ cnt, text->fontsize, x, y, text->str); } else{ - rad = (GLfloat)M_PI * text->angle / 180.0F; + rad = (GLfloat)(M_PI * text->angle / 180.0F); srad = (GLfloat)sin(rad); crad = (GLfloat)cos(rad); gl2ps->streamlength += gl2psPrintf @@ -4170,8 +4174,7 @@ /* Put vertex' edge flag (8bit) and coordinates (32bit) in shader stream */ static int gl2psPrintPDFShaderStreamDataCoord(GL2PSvertex *vertex, - size_t (*action)(unsigned long data, - size_t size), + int (*action)(unsigned long data, int size), GLfloat dx, GLfloat dy, GLfloat xmin, GLfloat ymin) { @@ -4217,8 +4220,7 @@ /* Put vertex' rgb value (8bit for every component) in shader stream */ static int gl2psPrintPDFShaderStreamDataRGB(GL2PSvertex *vertex, - size_t (*action)(unsigned long data, - size_t size)) + int (*action)(unsigned long data, int size)) { int offs = 0; unsigned long imap; @@ -4242,8 +4244,7 @@ /* Put vertex' alpha (8/16bit) in shader stream */ static int gl2psPrintPDFShaderStreamDataAlpha(GL2PSvertex *vertex, - size_t (*action)(unsigned long data, - size_t size), + int (*action)(unsigned long data, int size), int sigbyte) { int offs = 0; @@ -4270,8 +4271,7 @@ static int gl2psPrintPDFShaderStreamData(GL2PStriangle *triangle, GLfloat dx, GLfloat dy, GLfloat xmin, GLfloat ymin, - size_t (*action)(unsigned long data, - size_t size), + int (*action)(unsigned long data, int size), int gray) { int i, offs = 0; @@ -4489,8 +4489,7 @@ /* Similar groups of functions for pixmaps and text */ static int gl2psPrintPDFPixmapStreamData(GL2PSimage *im, - size_t (*action)(unsigned long data, - size_t size), + int (*action)(unsigned long data, int size), int gray) { int x, y, shift; @@ -5031,6 +5030,7 @@ gl2psPrintf("\"/>\n"); gl2psListDelete(png); #else + (void) x; (void) y; (void) pixmap; /* not used */ gl2psMsg(GL2PS_WARNING, "GL2PS must be compiled with PNG support in " "order to embed images in SVG streams"); #endif @@ -5842,7 +5842,8 @@ const void *pixels) { int size, i; - GLfloat pos[4], *piv, zoom_x, zoom_y; + const GLfloat *piv; + GLfloat pos[4], zoom_x, zoom_y; GL2PSprimitive *prim; GLboolean valid; @@ -5894,7 +5895,7 @@ prim->data.image->format = GL_RGB; size = height * width * 3; prim->data.image->pixels = (GLfloat*)gl2psMalloc(size * sizeof(GLfloat)); - piv = (GLfloat*)pixels; + piv = (const GLfloat*)pixels; for(i = 0; i < size; ++i, ++piv){ prim->data.image->pixels[i] = *piv; if(!((i + 1) % 3)) @@ -5939,7 +5940,7 @@ glPassThrough((GLfloat)width); glPassThrough((GLfloat)height); for(i = 0; i < size; i += sizeoffloat){ - float *value = (float*)imagemap; + const float *value = (const float*)imagemap; glPassThrough(*value); imagemap += sizeoffloat; }
--- a/src/gl2ps.h +++ b/src/gl2ps.h @@ -1,6 +1,6 @@ /* * GL2PS, an OpenGL to PostScript Printing Library - * Copyright (C) 1999-2009 C. Geuzaine + * Copyright (C) 1999-2011 C. Geuzaine * * This program is free software; you can redistribute it and/or * modify it under the terms of either: @@ -46,6 +46,7 @@ # pragma warning(disable:4115) # pragma warning(disable:4996) # endif +# define WIN32_LEAN_AND_MEAN # include <windows.h> # if defined(GL2PSDLL) # if defined(GL2PSDLL_EXPORTS) @@ -80,14 +81,14 @@ #define GL2PS_MAJOR_VERSION 1 #define GL2PS_MINOR_VERSION 3 -#define GL2PS_PATCH_VERSION 5 +#define GL2PS_PATCH_VERSION 6 #define GL2PS_EXTRA_VERSION "" #define GL2PS_VERSION (GL2PS_MAJOR_VERSION + \ 0.01 * GL2PS_MINOR_VERSION + \ 0.0001 * GL2PS_PATCH_VERSION) -#define GL2PS_COPYRIGHT "(C) 1999-2009 C. Geuzaine" +#define GL2PS_COPYRIGHT "(C) 1999-2011 C. Geuzaine" /* Output file formats (the values and the ordering are important!) */
--- a/src/graphics.cc +++ b/src/graphics.cc @@ -27,6 +27,7 @@ #include <cctype> #include <cfloat> #include <cstdlib> +#include <ctime> #include <algorithm> #include <list> @@ -35,10 +36,13 @@ #include <string> #include <sstream> +#include "cmd-edit.h" #include "file-ops.h" #include "file-stat.h" - -#include "cmd-edit.h" +#include "oct-locbuf.h" +#include "singleton-cleanup.h" + +#include "cutils.h" #include "defun.h" #include "display.h" #include "error.h" @@ -48,6 +52,7 @@ #include "oct-obj.h" #include "oct-map.h" #include "ov-fcn-handle.h" +#include "pager.h" #include "parse.h" #include "toplev.h" #include "txt-eng-ft.h" @@ -218,10 +223,18 @@ } static Matrix -default_lim (void) +default_lim (bool logscale = false) { Matrix m (1, 2, 0); - m(1) = 1; + + if (logscale) + { + m(0) = 0.1; + m(1) = 1.0; + } + else + m(1) = 1; + return m; } @@ -271,7 +284,8 @@ static Matrix default_axes_ticklength (void) { - Matrix m (1, 2, 0.01); + Matrix m (1, 2, 0.0); + m(0) = 0.01; m(1) = 0.025; return m; } @@ -308,13 +322,108 @@ } static Matrix +default_control_position (void) +{ + Matrix retval (1, 4, 0.0); + + retval(0) = 0; + retval(1) = 0; + retval(2) = 80; + retval(3) = 30; + + return retval; +} + +static Matrix +default_control_sliderstep (void) +{ + Matrix retval (1, 2, 0.0); + + retval(0) = 0.01; + retval(1) = 0.1; + + return retval; +} + +static Matrix +default_panel_position (void) +{ + Matrix retval (1, 4, 0.0); + + retval(0) = 0; + retval(1) = 0; + retval(2) = 0.5; + retval(3) = 0.5; + + return retval; +} + +static double +convert_font_size (double font_size, const caseless_str& from_units, + const caseless_str& to_units, double parent_height = 0) +{ + // Simple case where from_units == to_units + + if (from_units.compare (to_units)) + return font_size; + + // Converts the given fontsize using the following transformation: + // <old_font_size> => points => <new_font_size> + + double points_size = 0; + double res = 0; + + if (from_units.compare ("points")) + points_size = font_size; + else + { + res = xget (0, "screenpixelsperinch").double_value (); + + if (from_units.compare ("pixels")) + points_size = font_size * 72.0 / res; + else if (from_units.compare ("inches")) + points_size = font_size * 72.0; + else if (from_units.compare ("centimeters")) + points_size = font_size * 72.0 / 2.54; + else if (from_units.compare ("normalized")) + points_size = font_size * parent_height * 72.0 / res; + } + + double new_font_size = 0; + + if (to_units.compare ("points")) + new_font_size = points_size; + else + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + if (to_units.compare ("pixels")) + new_font_size = points_size * res / 72.0; + else if (to_units.compare ("inches")) + new_font_size = points_size / 72.0; + else if (to_units.compare ("centimeters")) + new_font_size = points_size * 2.54 / 72.0; + else if (to_units.compare ("normalized")) + { + // Avoid setting font size to (0/0) = NaN + + if (parent_height > 0) + new_font_size = points_size * res / (parent_height * 72.0); + } + } + + return new_font_size; +} + +static Matrix convert_position (const Matrix& pos, const caseless_str& from_units, - const caseless_str& to_units, - const Matrix& parent_dim = Matrix (1, 2, 0.0)) + const caseless_str& to_units, const Matrix& parent_dim) { Matrix retval (1, pos.numel ()); double res = 0; bool is_rectangle = (pos.numel () == 4); + bool is_2d = (pos.numel () == 2); if (from_units.compare ("pixels")) retval = pos; @@ -327,7 +436,7 @@ retval(2) = pos(2) * parent_dim(0); retval(3) = pos(3) * parent_dim(1); } - else + else if (! is_2d) retval(2) = 0; } else if (from_units.compare ("characters")) @@ -350,7 +459,7 @@ retval(2) = 0.5 * pos(2) * f; retval(3) = pos(3) * f; } - else + else if (! is_2d) retval(2) = 0; } } @@ -377,7 +486,7 @@ retval(2) = pos(2) * f; retval(3) = pos(3) * f; } - else + else if (! is_2d) retval(2) = 0; } } @@ -393,7 +502,7 @@ retval(2) /= parent_dim(0); retval(3) /= parent_dim(1); } - else + else if (! is_2d) retval(2) = 0; } else if (to_units.compare ("characters")) @@ -414,7 +523,7 @@ retval(2) = 2 * retval(2) / f; retval(3) = retval(3) / f; } - else + else if (! is_2d) retval(2) = 0; } } @@ -441,12 +550,12 @@ retval(2) /= f; retval(3) /= f; } - else + else if (! is_2d) retval(2) = 0; } } } - else if (! is_rectangle) + else if (! is_rectangle && ! is_2d) retval(2) = 0; return retval; @@ -460,7 +569,7 @@ graphics_object go = gh_manager::get_object (props.get___myhandle__ ()); graphics_object ax = go.get_ancestor ("axes"); - Matrix retval (1, pos.numel (), 0); + Matrix retval; if (ax.valid_object ()) { @@ -479,6 +588,8 @@ v2 = ax_xform.transform (pos(0) + pos(2), pos(1) + pos(3), 0); + retval.resize (1, 4); + retval(0) = v1(0) - ax_bbox(0) + 1; retval(1) = ax_bbox(1) + ax_bbox(3) - v1(1) + 1; retval(2) = v2(0) - v1(0); @@ -488,6 +599,8 @@ { ColumnVector v = ax_xform.transform (pos(0), pos(1), pos(2)); + retval.resize (1, 3); + retval(0) = v(0) - ax_bbox(0) + 1; retval(1) = ax_bbox(1) + ax_bbox(3) - v(1) + 1; retval(2) = 0; @@ -507,6 +620,8 @@ v2 = ax_xform.untransform (retval(0) + retval(2) + ax_bbox(0) - 1, ax_bbox(1) + ax_bbox(3) - (retval(1) + retval(3)) + 1); + retval.resize (1, 4); + retval(0) = v1(0); retval(1) = v1(1); retval(2) = v2(0) - v1(0); @@ -517,6 +632,8 @@ ColumnVector v = ax_xform.untransform (retval(0) + ax_bbox(0) - 1, ax_bbox(1) + ax_bbox(3) - retval(1) + 1); + retval.resize (1, 3); + retval(0) = v(0); retval(1) = v(1); retval(2) = v(2); @@ -657,7 +774,7 @@ template<class T> static void get_array_limits (const Array<T>& m, double& emin, double& emax, - double& eminp) + double& eminp, double& emaxp) { const T *data = m.data (); octave_idx_type n = m.numel (); @@ -677,6 +794,9 @@ if (e > 0 && e < eminp) eminp = e; + + if (e < 0 && e > emaxp) + emaxp = e; } } } @@ -712,8 +832,38 @@ { pfx = name.substr (0, 7); - if (pfx.compare ("surface") || pfx.compare ("hggroup")) + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) offset = 7; + else if (len >= 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len >= 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len >= 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoggletool")) + offset = 12; + else if (len >= 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } } } } @@ -754,27 +904,35 @@ go = new hggroup (h, p); else if (type.compare ("uimenu")) go = new uimenu (h, p); + else if (type.compare ("uicontrol")) + go = new uicontrol (h, p); + else if (type.compare ("uipanel")) + go = new uipanel (h, p); + else if (type.compare ("uicontextmenu")) + go = new uicontextmenu (h, p); + else if (type.compare ("uitoolbar")) + go = new uitoolbar (h, p); + else if (type.compare ("uipushtool")) + go = new uipushtool (h, p); + else if (type.compare ("uitoggletool")) + go = new uitoggletool (h, p); return go; } // --------------------------------------------------------------------- bool -base_property::set (const octave_value& v, bool do_run ) +base_property::set (const octave_value& v, bool do_run, bool do_notify_toolkit) { if (do_set (v)) { // Notify graphics toolkit. - if (id >= 0) + if (id >= 0 && do_notify_toolkit) { graphics_object go = gh_manager::get_object (parent); if (go) - { - graphics_toolkit toolkit = go.get_toolkit (); - if (toolkit) - toolkit.update (go, id); - } + go.update (id); } // run listeners @@ -795,7 +953,7 @@ for (int i = 0; i < l.length (); i++) { - gh_manager::execute_callback (parent, l(i), octave_value ()); + gh_manager::execute_listener (parent, l(i)); if (error_state) break; @@ -922,11 +1080,18 @@ if (! s.empty ()) { - if (radio_val.contains (s)) + std::string match; + + if (radio_val.contains (s, match)) { - if (current_type != radio_t || current_val != s) + if (current_type != radio_t || match != current_val) { - current_val = s; + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; current_type = radio_t; return true; } @@ -986,12 +1151,18 @@ if (val.is_string ()) { std::string s = val.string_value (); - - if (! s.empty () && radio_val.contains (s)) - { - if (current_type != radio_t || s != current_val) + std::string match; + + if (! s.empty () && radio_val.contains (s, match)) + { + if (current_type != radio_t || match != current_val) { - current_val = s; + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; current_type = radio_t; return true; } @@ -1130,31 +1301,31 @@ array_property::get_data_limits (void) { xmin = xminp = octave_Inf; - xmax = -octave_Inf; + xmax = xmaxp = -octave_Inf; if (! data.is_empty ()) { if (data.is_integer_type ()) { if (data.is_int8_type ()) - get_array_limits (data.int8_array_value (), xmin, xmax, xminp); + get_array_limits (data.int8_array_value (), xmin, xmax, xminp, xmaxp); else if (data.is_uint8_type ()) - get_array_limits (data.uint8_array_value (), xmin, xmax, xminp); + get_array_limits (data.uint8_array_value (), xmin, xmax, xminp, xmaxp); else if (data.is_int16_type ()) - get_array_limits (data.int16_array_value (), xmin, xmax, xminp); + get_array_limits (data.int16_array_value (), xmin, xmax, xminp, xmaxp); else if (data.is_uint16_type ()) - get_array_limits (data.uint16_array_value (), xmin, xmax, xminp); + get_array_limits (data.uint16_array_value (), xmin, xmax, xminp, xmaxp); else if (data.is_int32_type ()) - get_array_limits (data.int32_array_value (), xmin, xmax, xminp); + get_array_limits (data.int32_array_value (), xmin, xmax, xminp, xmaxp); else if (data.is_uint32_type ()) - get_array_limits (data.uint32_array_value (), xmin, xmax, xminp); + get_array_limits (data.uint32_array_value (), xmin, xmax, xminp, xmaxp); else if (data.is_int64_type ()) - get_array_limits (data.int64_array_value (), xmin, xmax, xminp); + get_array_limits (data.int64_array_value (), xmin, xmax, xminp, xmaxp); else if (data.is_uint64_type ()) - get_array_limits (data.uint64_array_value (), xmin, xmax, xminp); + get_array_limits (data.uint64_array_value (), xmin, xmax, xminp, xmaxp); } else - get_array_limits (data.array_value (), xmin, xmax, xminp); + get_array_limits (data.array_value (), xmin, xmax, xminp, xmaxp); } } @@ -1266,11 +1437,33 @@ return false; } +// If TRUE, we are executing any callback function, or the functions it +// calls. Used to determine handle visibility inside callback +// functions. +static bool executing_callback = false; + void callback_property::execute (const octave_value& data) const { - if (callback.is_defined () && ! callback.is_empty ()) - gh_manager::execute_callback (get_parent (), callback, data); + unwind_protect frame; + + // We are executing the callback function associated with this + // callback property. When set to true, we avoid recursive calls to + // callback routines. + frame.protect_var (executing); + + // We are executing a callback function, so allow handles that have + // their handlevisibility property set to "callback" to be visible. + frame.protect_var (executing_callback); + + if (! executing) + { + executing = true; + executing_callback = true; + + if (callback.is_defined () && ! callback.is_empty ()) + gh_manager::execute_callback (get_parent (), callback, data); + } } // Used to cache dummy graphics objects from which dynamic @@ -1427,6 +1620,54 @@ return retval; } +static void +finalize_r (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + { + Matrix children = go.get_properties ().get_all_children (); + + for (int k = 0; k < children.numel (); k++) + finalize_r (children(k)); + + go.finalize (); + } +} + +static void +initialize_r (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + { + Matrix children = go.get_properties ().get_all_children (); + + go.initialize (); + + for (int k = 0; k < children.numel (); k++) + initialize_r (children(k)); + } +} + +void +figure::properties::set_toolkit (const graphics_toolkit& b) +{ + if (toolkit) + finalize_r (get___myhandle__ ()); + + toolkit = b; + __graphics_toolkit__ = b.get_name (); + __plot_stream__ = Matrix (); + + if (toolkit) + initialize_r (get___myhandle__ ()); + + mark_modified (); +} + // --------------------------------------------------------------------- void @@ -1459,8 +1700,38 @@ { pfx = name.substr (0, 7); - if (pfx.compare ("surface") || pfx.compare ("hggroup")) + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) offset = 7; + else if (len > 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len > 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len > 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoogletool")) + offset = 12; + else if (len > 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } } } } @@ -1493,6 +1764,16 @@ has_property = hggroup::properties::has_core_property (pname); else if (pfx == "uimenu") has_property = uimenu::properties::has_core_property (pname); + else if (pfx == "uicontrol") + has_property = uicontrol::properties::has_core_property (pname); + else if (pfx == "uipanel") + has_property = uipanel::properties::has_core_property (pname); + else if (pfx == "uicontextmenu") + has_property = uicontextmenu::properties::has_core_property (pname); + else if (pfx == "uitoolbar") + has_property = uitoolbar::properties::has_core_property (pname); + else if (pfx == "uipushtool") + has_property = uipushtool::properties::has_core_property (pname); if (has_property) { @@ -1557,8 +1838,38 @@ { pfx = name.substr (0, 7); - if (pfx.compare ("surface") || pfx.compare ("hggroup")) + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) offset = 7; + else if (len > 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len > 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len > 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoggletool")) + offset = 12; + else if (len > 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } } } } @@ -1810,11 +2121,11 @@ } graphics_handle -gh_manager::get_handle (const std::string& go_name) +gh_manager::do_get_handle (bool integer_figure_handle) { graphics_handle retval; - if (go_name == "figure") + if (integer_figure_handle) { // Figure handles are positive integers corresponding to the // figure number. @@ -1873,9 +2184,7 @@ bp.execute_deletefcn (); // Notify graphics toolkit. - graphics_toolkit toolkit = p->second.get_toolkit (); - if (toolkit) - toolkit.finalize (p->second); + p->second.finalize (); // Note: this will be valid only for first explicitly // deleted object. All its children will then have an @@ -1899,6 +2208,38 @@ } } +void +gh_manager::do_renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh) +{ + iterator p = handle_map.find (old_gh); + + if (p != handle_map.end ()) + { + graphics_object go = p->second; + + handle_map.erase (p); + + handle_map[new_gh] = go; + + if (old_gh.value () < 0) + handle_free_list.insert (std::ceil (old_gh.value ()) + - make_handle_fraction ()); + } + else + error ("graphics_handle::free: invalid object %g", old_gh.value ()); + + for (figure_list_iterator q = figure_list.begin (); + q != figure_list.end (); q++) + { + if (*q == old_gh) + { + *q = new_gh; + break; + } + } +} + gh_manager *gh_manager::instance = 0; static void @@ -1984,6 +2325,114 @@ } static void +delete_graphics_object (const graphics_handle& h) +{ + if (h.ok ()) + { + graphics_object obj = gh_manager::get_object (h); + + // Don't do recursive deleting, due to callbacks + if (! obj.get_properties ().is_beingdeleted ()) + { + graphics_handle parent_h = obj.get_parent (); + + graphics_object parent_obj = + gh_manager::get_object (parent_h); + + // NOTE: free the handle before removing it from its + // parent's children, such that the object's + // state is correct when the deletefcn callback + // is executed + + gh_manager::free (h); + + // A callback function might have already deleted + // the parent + if (parent_obj.valid_object ()) + parent_obj.remove_child (h); + + Vdrawnow_requested = true; + } + } +} + +static void +delete_graphics_object (double val) +{ + delete_graphics_object (gh_manager::lookup (val)); +} + +static void +delete_graphics_objects (const NDArray vals) +{ + for (octave_idx_type i = 0; i < vals.numel (); i++) + delete_graphics_object (vals.elem (i)); +} + +static void +close_figure (const graphics_handle& handle) +{ + octave_value closerequestfcn = xget (handle, "closerequestfcn"); + + OCTAVE_SAFE_CALL (gh_manager::execute_callback, (handle, closerequestfcn)); +} + +static void +force_close_figure (const graphics_handle& handle) +{ + // Remove the deletefcn and closerequestfcn callbacks and delete the + // object directly. + + xset (handle, "deletefcn", Matrix ()); + xset (handle, "closerequestfcn", Matrix ()); + + delete_graphics_object (handle); +} + +void +gh_manager::do_close_all_figures (void) +{ + // FIXME -- should we process or discard pending events? + + event_queue.clear (); + + // Don't use figure_list_iterator because we'll be removing elements + // from the list elsewhere. + + Matrix hlist = do_figure_handle_list (true); + + for (octave_idx_type i = 0; i < hlist.numel (); i++) + { + graphics_handle h = gh_manager::lookup (hlist(i)); + + if (h.ok ()) + close_figure (h); + } + + // They should all be closed now. If not, force them to close. + + hlist = do_figure_handle_list (true); + + for (octave_idx_type i = 0; i < hlist.numel (); i++) + { + graphics_handle h = gh_manager::lookup (hlist(i)); + + if (h.ok ()) + force_close_figure (h); + } + + // None left now, right? + + hlist = do_figure_handle_list (true); + + assert (hlist.numel () == 0); + + // Clear all callback objects from our list. + + callback_objects.clear (); +} + +static void adopt (const graphics_handle& p, const graphics_handle& h) { graphics_object parent_obj = gh_manager::get_object (p); @@ -2011,23 +2460,18 @@ if (val.is_real_scalar () && is_handle (val.double_value ())) retval = true; - else if (val.is_real_matrix ()) - { - if (val.is_string ()) - retval = boolNDArray (val.dims (), false); - else - { - const NDArray handles = val.array_value (); - - if (! error_state) - { - boolNDArray result (handles.dims ()); - - for (octave_idx_type i = 0; i < handles.numel (); i++) - result.xelem (i) = is_handle (handles (i)); - - retval = result; - } + else if (val.is_numeric_type () && val.is_real_type ()) + { + const NDArray handles = val.array_value (); + + if (! error_state) + { + boolNDArray result (handles.dims ()); + + for (octave_idx_type i = 0; i < handles.numel (); i++) + result.xelem (i) = is_handle (handles (i)); + + retval = result; } } @@ -2049,6 +2493,15 @@ obj.get_properties ().execute_createfcn (); } +static void +xinitialize (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + go.initialize (); +} + // --------------------------------------------------------------------- void @@ -2059,12 +2512,12 @@ update (go, id); } -void +bool base_graphics_toolkit::initialize (const graphics_handle& h) { graphics_object go = gh_manager::get_object (h); - initialize (go); + return initialize (go); } void @@ -2074,6 +2527,7 @@ finalize (go); } + // --------------------------------------------------------------------- void @@ -2144,7 +2598,10 @@ { const std::set<std::string>& dynprops = dynamic_property_names (); - return dynprops.find (pname) != dynprops.end (); + if (dynprops.find (pname) != dynprops.end ()) + return true; + else + return all_props.find (pname) != all_props.end (); } void @@ -2245,6 +2702,13 @@ obj.update_axis_limits (axis_type, h); } +bool +base_properties::is_handle_visible (void) const +{ + return (handlevisibility.is ("on") + || (executing_callback && ! handlevisibility.is ("off"))); +} + graphics_toolkit base_properties::get_toolkit (void) const { @@ -2301,130 +2765,6 @@ // --------------------------------------------------------------------- -class gnuplot_toolkit : public base_graphics_toolkit -{ -public: - gnuplot_toolkit (void) - : base_graphics_toolkit ("gnuplot") { } - - ~gnuplot_toolkit (void) { } - - bool is_valid (void) const { return true; } - - void finalize (const graphics_object& go) - { - if (go.isa ("figure")) - { - const figure::properties& props = - dynamic_cast<const figure::properties&> (go.get_properties ()); - - send_quit (props.get___plot_stream__ ()); - } - } - - void update (const graphics_object& go, int id) - { - if (go.isa ("figure")) - { - graphics_object obj (go); - - figure::properties& props = - dynamic_cast<figure::properties&> (obj.get_properties ()); - - switch (id) - { - case base_properties::ID_VISIBLE: - if (! props.is_visible ()) - { - send_quit (props.get___plot_stream__ ()); - props.set___plot_stream__ (Matrix ()); - props.set___enhanced__ (false); - } - break; - } - } - } - - void redraw_figure (const graphics_object& go) const - { - octave_value_list args; - args(0) = go.get_handle ().as_octave_value (); - feval ("__gnuplot_drawnow__", args); - } - - void print_figure (const graphics_object& go, const std::string& term, - const std::string& file, bool mono, - const std::string& debug_file) const - { - octave_value_list args; - if (! debug_file.empty ()) - args(4) = debug_file; - args(3) = mono; - args(2) = file; - args(1) = term; - args(0) = go.get_handle ().as_octave_value (); - feval ("__gnuplot_drawnow__", args); - } - - Matrix get_canvas_size (const graphics_handle&) const - { - Matrix sz (1, 2, 0.0); - return sz; - } - - double get_screen_resolution (void) const - { return 72.0; } - - Matrix get_screen_size (void) const - { return Matrix (1, 2, 0.0); } - -private: - void send_quit (const octave_value& pstream) const - { - if (! pstream.is_empty ()) - { - octave_value_list args; - Matrix fids = pstream.matrix_value (); - - if (! error_state) - { - args(1) = "\nquit;\n"; - args(0) = fids(0); - feval ("fputs", args); - - args.resize (1); - feval ("fflush", args); - feval ("pclose", args); - - if (fids.numel () > 1) - { - args(0) = fids(1); - feval ("pclose", args); - - if (fids.numel () > 2) - { - args(0) = fids(2); - feval ("waitpid", args); - } - } - } - } - } -}; - -graphics_toolkit -graphics_toolkit::default_toolkit (void) -{ - if (available_toolkits.size () == 0) - register_toolkit (new gnuplot_toolkit ()); - - return available_toolkits["gnuplot"]; -} - -std::map<std::string, graphics_toolkit> graphics_toolkit::available_toolkits; - -// --------------------------------------------------------------------- - void base_graphics_object::update_axis_limits (const std::string& axis_type) { @@ -2467,10 +2807,14 @@ unwind_protect frame; + frame.protect_var (error_state); frame.protect_var (discard_error_messages); - frame.protect_var (error_state); + frame.protect_var (Vdebug_on_error); + frame.protect_var (Vdebug_on_warning); discard_error_messages = true; + Vdebug_on_error = false; + Vdebug_on_warning = false; property p = get_properties ().get_property (pa->first); @@ -2575,7 +2919,8 @@ { currentfigure = val; - gh_manager::push_figure (val); + if (val.ok ()) + gh_manager::push_figure (val); } else gripe_set_invalid ("currentfigure"); @@ -2611,6 +2956,50 @@ gripe_set_invalid ("callbackobject"); } +void +figure::properties::set_integerhandle (const octave_value& val) +{ + if (! error_state) + { + if (integerhandle.set (val, true)) + { + bool int_fig_handle = integerhandle.is_on (); + + graphics_object this_go = gh_manager::get_object (__myhandle__); + + graphics_handle old_myhandle = __myhandle__; + + __myhandle__ = gh_manager::get_handle (int_fig_handle); + + gh_manager::renumber_figure (old_myhandle, __myhandle__); + + graphics_object parent_go = gh_manager::get_object (get_parent ()); + + base_properties& props = parent_go.get_properties (); + + props.renumber_child (old_myhandle, __myhandle__); + + Matrix kids = get_children (); + + for (octave_idx_type i = 0; i < kids.numel (); i++) + { + graphics_object kid = gh_manager::get_object (kids(i)); + + kid.get_properties ().renumber_parent (__myhandle__); + } + + graphics_handle cf = gh_manager::current_figure (); + + if (__myhandle__ == cf) + xset (0, "currentfigure", __myhandle__.value ()); + + this_go.update (integerhandle.get_id ()); + + mark_modified (); + } + } +} + // FIXME This should update monitorpositions and pointerlocation, but // as these properties are yet used, and so it doesn't matter that they // aren't set yet. @@ -2761,13 +3150,14 @@ } Matrix -figure::properties::get_boundingbox (bool) const +figure::properties::get_boundingbox (bool internal, const Matrix&) const { Matrix screen_size = screen_size_pixels (); - Matrix pos; - - pos = convert_position (get_position ().matrix_value (), get_units (), - "pixels", screen_size); + Matrix pos = (internal ? + get_position ().matrix_value () : + get_outerposition ().matrix_value ()); + + pos = convert_position (pos, get_units (), "pixels", screen_size); pos(0)--; pos(1)--; @@ -2777,7 +3167,8 @@ } void -figure::properties::set_boundingbox (const Matrix& bb) +figure::properties::set_boundingbox (const Matrix& bb, bool internal, + bool do_notify_toolkit) { Matrix screen_size = screen_size_pixels (); Matrix pos = bb; @@ -2787,18 +3178,56 @@ pos(0)++; pos = convert_position (pos, "pixels", get_units (), screen_size); - set_position (pos); -} - -void -figure::properties::set_position (const octave_value& v) + if (internal) + set_position (pos, do_notify_toolkit); + else + set_outerposition (pos, do_notify_toolkit); +} + +Matrix +figure::properties::map_from_boundingbox (double x, double y) const +{ + Matrix bb = get_boundingbox (true); + Matrix pos (1, 2, 0); + + pos(0) = x; + pos(1) = y; + + pos(1) = bb(3) - pos(1); + pos(0)++; + pos = convert_position (pos, "pixels", get_units (), + bb.extract_n (0, 2, 1, 2)); + + return pos; +} + +Matrix +figure::properties::map_to_boundingbox (double x, double y) const +{ + Matrix bb = get_boundingbox (true); + Matrix pos (1, 2, 0); + + pos(0) = x; + pos(1) = y; + + pos = convert_position (pos, get_units (), "pixels", + bb.extract_n (0, 2, 1, 2)); + pos(0)--; + pos(1) = bb(3) - pos(1); + + return pos; +} + +void +figure::properties::set_position (const octave_value& v, + bool do_notify_toolkit) { if (! error_state) { Matrix old_bb, new_bb; old_bb = get_boundingbox (); - position = v; + position.set (v, true, do_notify_toolkit); new_bb = get_boundingbox (); if (old_bb != new_bb) @@ -2815,6 +3244,19 @@ } void +figure::properties::set_outerposition (const octave_value& v, + bool do_notify_toolkit) +{ + if (! error_state) + { + if (outerposition.set (v, true, do_notify_toolkit)) + { + mark_modified (); + } + } +} + +void figure::properties::set_paperunits (const octave_value& v) { if (! error_state) @@ -3177,6 +3619,7 @@ ticklength.add_constraint (dim_vector (1, 2)); tightinset.add_constraint (dim_vector (1, 4)); looseinset.add_constraint (dim_vector (1, 4)); + update_font (); x_zlim.resize (1, 2); @@ -3268,13 +3711,119 @@ void axes::properties::sync_positions (void) { + Matrix ref_linset = looseinset.get ().matrix_value (); + if (autopos_tag_is ("subplot")) + { + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + if (parent_obj.isa ("figure")) + { + // FIXME: temporarily changed units should be protected + // from interrupts + std::string fig_units = parent_obj.get ("units").string_value (); + parent_obj.set ("units", "pixels"); + + Matrix ref_outbox = outerposition.get ().matrix_value (); + ref_outbox(2) += ref_outbox(0); + ref_outbox(3) += ref_outbox(1); + + // Find those subplots that are left, right, bottom and top aligned + // with the current subplot + Matrix kids = parent_obj.get_properties ().get_children (); + std::vector<octave_value> aligned; + std::vector<bool> l_aligned, b_aligned, r_aligned, t_aligned; + for (octave_idx_type i = 0; i < kids.numel (); i++) + { + graphics_object go = gh_manager::get_object (kids(i)); + if (go.isa ("axes")) + { + axes::properties& props = + dynamic_cast<axes::properties&> (go.get_properties ()); + if (props.autopos_tag_is("subplot")) + { + Matrix outpos = go.get ("outerposition").matrix_value (); + bool l_align=(std::abs (outpos(0)-ref_outbox(0)) < 1e-15); + bool b_align=(std::abs (outpos(1)-ref_outbox(1)) < 1e-15); + bool r_align=(std::abs (outpos(0)+outpos(2)-ref_outbox(2)) < 1e-15); + bool t_align=(std::abs (outpos(1)+outpos(3)-ref_outbox(3)) < 1e-15); + if (l_align || b_align || r_align || t_align) + { + aligned.push_back(kids(i)); + l_aligned.push_back(l_align); + b_aligned.push_back(b_align); + r_aligned.push_back(r_align); + t_aligned.push_back(t_align); + // FIXME: the temporarily deleted tags should be + // protected from interrupts + props.set_autopos_tag ("none"); + } + } + } + } + // Determine a minimum box which aligns the subplots + Matrix ref_box(1, 4, 0.); + ref_box(2) = 1.; + ref_box(3) = 1.; + for (size_t i = 0; i < aligned.size (); i++) + { + graphics_object go = gh_manager::get_object (aligned[i]); + axes::properties& props = + dynamic_cast<axes::properties&> (go.get_properties ()); + Matrix linset = props.get_looseinset ().matrix_value (); + if (l_aligned[i]) + linset(0) = std::min (0., linset(0)-0.01); + if (b_aligned[i]) + linset(1) = std::min (0., linset(1)-0.01); + if (r_aligned[i]) + linset(2) = std::min (0., linset(2)-0.01); + if (t_aligned[i]) + linset(3) = std::min (0., linset(3)-0.01); + props.set_looseinset (linset); + Matrix pos = props.get_position ().matrix_value (); + if (l_aligned[i]) + ref_box(0) = std::max (ref_box(0), pos(0)); + if (b_aligned[i]) + ref_box(1) = std::max (ref_box(1), pos(1)); + if (r_aligned[i]) + ref_box(2) = std::min (ref_box(2), pos(0)+pos(2)); + if (t_aligned[i]) + ref_box(3) = std::min (ref_box(3), pos(1)+pos(3)); + } + // Set common looseinset values for all aligned subplots and + // revert their tag values + for (size_t i = 0; i < aligned.size (); i++) + { + graphics_object go = gh_manager::get_object (aligned[i]); + axes::properties& props = + dynamic_cast<axes::properties&> (go.get_properties ()); + Matrix outpos = props.get_outerposition ().matrix_value (); + Matrix linset = props.get_looseinset ().matrix_value (); + if (l_aligned[i]) + linset(0) = (ref_box(0)-outpos(0))/outpos(2); + if (b_aligned[i]) + linset(1) = (ref_box(1)-outpos(1))/outpos(3); + if (r_aligned[i]) + linset(2) = (outpos(0)+outpos(2)-ref_box(2))/outpos(2); + if (t_aligned[i]) + linset(3) = (outpos(1)+outpos(3)-ref_box(3))/outpos(3); + props.set_looseinset (linset); + props.set_autopos_tag ("subplot"); + } + parent_obj.set ("units", fig_units); + } + } + else + sync_positions (ref_linset); +} + +void +axes::properties::sync_positions (const Matrix& linset) +{ Matrix pos = position.get ().matrix_value (); Matrix outpos = outerposition.get ().matrix_value (); - Matrix lins = looseinset.get ().matrix_value (); - double lratio = lins(0); - double bratio = lins(1); - double wratio = 1-lins(0)-lins(2); - double hratio = 1-lins(1)-lins(3); + double lratio = linset(0); + double bratio = linset(1); + double wratio = 1-linset(0)-linset(2); + double hratio = 1-linset(1)-linset(3); if (activepositionproperty.is ("outerposition")) { pos = outpos; @@ -3291,7 +3840,7 @@ double thrshldy = 0.005*outpos(3); double minsizex = 0.2*outpos(2); double minsizey = 0.2*outpos(3); - bool updatex = true, updatey = true; + bool updatex = true, updatey = true; for (int i = 0; i < 10; i++) { double dt; @@ -3364,7 +3913,7 @@ inset(1) = pos(1)-outpos(1); inset(2) = outpos(0)+outpos(2)-pos(0)-pos(2); inset(3) = outpos(1)+outpos(3)-pos(1)-pos(3); - + tightinset = inset; } @@ -3377,7 +3926,8 @@ if (v.is_string ()) { - val = gh_manager::make_graphics_handle ("text", __myhandle__, false); + val = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); xset (val, "string", v); } @@ -3577,10 +4127,17 @@ delete_children (true); - xlabel = gh_manager::make_graphics_handle ("text", __myhandle__, false); - ylabel = gh_manager::make_graphics_handle ("text", __myhandle__, false); - zlabel = gh_manager::make_graphics_handle ("text", __myhandle__, false); - title = gh_manager::make_graphics_handle ("text", __myhandle__, false); + xlabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + ylabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + zlabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + title = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); xset (xlabel.handle_value (), "handlevisibility", "off"); xset (ylabel.handle_value (), "handlevisibility", "off"); @@ -3650,7 +4207,8 @@ if (! is_beingdeleted ()) { - hp = gh_manager::make_graphics_handle ("text", __myhandle__, false); + hp = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); xset (hp.handle_value (), "handlevisibility", "off"); @@ -4145,8 +4703,6 @@ frame.protect_var (updating_axes_layout); updating_axes_layout = true; - update_ticklengths (); - xySym = (xd*yd*(xPlane-xPlaneN)*(yPlane-yPlaneN) > 0); zSign = (zd*(zPlane-zPlaneN) <= 0); xyzSym = zSign ? xySym : !xySym; @@ -4192,6 +4748,8 @@ Matrix viewmat = get_view ().matrix_value (); nearhoriz = std::abs(viewmat(1)) <= 5; + + update_ticklengths (); } void @@ -4228,15 +4786,22 @@ update_title_position (); } +static bool updating_xlabel_position = false; + void axes::properties::update_xlabel_position (void) { + if (updating_xlabel_position) + return; + text::properties& xlabel_props = reinterpret_cast<text::properties&> (gh_manager::get_object (get_xlabel ()).get_properties ()); - bool is_empty = xlabel_props.get_string ().empty (); - - xlabel_props.set_autopos_tag ("none"); + bool is_empty = xlabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_xlabel_position); + updating_xlabel_position = true; if (! is_empty) { @@ -4310,19 +4875,24 @@ xlabel_props.set_rotationmode ("auto"); } } - - xlabel_props.set_autopos_tag ("xlabel"); -} +} + +static bool updating_ylabel_position = false; void axes::properties::update_ylabel_position (void) { + if (updating_ylabel_position) + return; + text::properties& ylabel_props = reinterpret_cast<text::properties&> (gh_manager::get_object (get_ylabel ()).get_properties ()); - bool is_empty = ylabel_props.get_string ().empty (); - - ylabel_props.set_autopos_tag ("none"); + bool is_empty = ylabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_ylabel_position); + updating_ylabel_position = true; if (! is_empty) { @@ -4396,20 +4966,25 @@ ylabel_props.set_rotationmode ("auto"); } } - - ylabel_props.set_autopos_tag ("ylabel"); -} +} + +static bool updating_zlabel_position = false; void axes::properties::update_zlabel_position (void) { + if (updating_zlabel_position) + return; + text::properties& zlabel_props = reinterpret_cast<text::properties&> (gh_manager::get_object (get_zlabel ()).get_properties ()); bool camAuto = cameraupvectormode_is ("auto"); - bool is_empty = zlabel_props.get_string ().empty (); - - zlabel_props.set_autopos_tag ("none"); + bool is_empty = zlabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_zlabel_position); + updating_zlabel_position = true; if (! is_empty) { @@ -4504,17 +5079,22 @@ zlabel_props.set_rotationmode ("auto"); } } - - zlabel_props.set_autopos_tag ("zlabel"); -} +} + +static bool updating_title_position = false; void axes::properties::update_title_position (void) { + if (updating_title_position) + return; + text::properties& title_props = reinterpret_cast<text::properties&> (gh_manager::get_object (get_title ()).get_properties ()); - title_props.set_autopos_tag ("none"); + unwind_protect frame; + frame.protect_var (updating_title_position); + updating_title_position = true; if (title_props.positionmode_is ("auto")) { @@ -4522,14 +5102,26 @@ // FIXME: bbox should be stored in axes::properties Matrix bbox = get_extent (false); - ColumnVector p = xform.untransform (bbox(0)+bbox(2)/2, (bbox(1)-10), - (x_zlim(0)+x_zlim(1))/2, true); + + ColumnVector p = + graphics_xform::xform_vector (bbox(0)+bbox(2)/2, + bbox(1)-10, + (x_zlim(0)+x_zlim(1))/2); + + if (x2Dtop) + { + Matrix ext (1, 2, 0.0); + ext = get_ticklabel_extents (get_xtick ().matrix_value (), + get_xticklabel ().all_strings (), + get_xlim ().matrix_value ()); + p(1) -= ext(1); + } + + p = xform.untransform (p(0), p(1), p(2), true); title_props.set_position (p.extract_n(0, 3).transpose ()); title_props.set_positionmode ("auto"); } - - title_props.set_autopos_tag ("title"); } void @@ -4571,7 +5163,8 @@ double minval = octave_Inf; double maxval = -octave_Inf; double min_pos = octave_Inf; - get_children_limits (minval, maxval, min_pos, kids, limit_type); + double max_neg = -octave_Inf; + get_children_limits (minval, maxval, min_pos, max_neg, kids, limit_type); if (!xisinf (minval) && !xisnan (minval) && !xisinf (maxval) && !xisnan (maxval)) { @@ -4698,23 +5291,43 @@ } } +void +axes::properties::update_font (void) +{ +#ifdef HAVE_FREETYPE +#ifdef HAVE_FONTCONFIG + text_renderer.set_font (get ("fontname").string_value (), + get ("fontweight").string_value (), + get ("fontangle").string_value (), + get ("fontsize").double_value ()); +#endif +#endif +} + // The INTERNAL flag defines whether position or outerposition is used. Matrix -axes::properties::get_boundingbox (bool internal) const -{ - graphics_object obj = gh_manager::get_object (get_parent ()); - Matrix parent_bb = obj.get_properties ().get_boundingbox (true); +axes::properties::get_boundingbox (bool internal, + const Matrix& parent_pix_size) const +{ Matrix pos = (internal ? get_position ().matrix_value () : get_outerposition ().matrix_value ()); - - pos = convert_position (pos, get_units (), "pixels", - parent_bb.extract_n (0, 2, 1, 2)); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); pos(0)--; pos(1)--; - pos(1) = parent_bb(3) - pos(1) - pos(3); + pos(1) = parent_size(1) - pos(1) - pos(3); return pos; } @@ -4761,7 +5374,7 @@ Matrix text_pos = text_props.get_position ().matrix_value (); text_pos = xform.transform (text_pos(0), text_pos(1), text_pos(2)); - if (text_props.get_string ().empty ()) + if (text_props.get_string ().is_empty ()) { ext(0) = std::min (ext(0), text_pos(0)); ext(1) = std::min (ext(1), text_pos(1)); @@ -4800,7 +5413,7 @@ ext(2) = ext(2)-ext(0); ext(3) = ext(3)-ext(1); - + return ext; } @@ -4847,31 +5460,26 @@ axes::properties::update_fontunits (const caseless_str& old_units) { caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (true).elem (3); double fsz = get_fontsize (); - double pixelsperinch = xget (0, "screenpixelsperinch").double_value(); - double parent_height = get_boundingbox (true).elem (3); - - if (old_units.compare ("normalized")) - fsz = fsz * parent_height * 72 / pixelsperinch; - else if (old_units.compare ("pixels")) - fsz = fsz * 72 / pixelsperinch; - else if (old_units.compare ("inches")) - fsz = fsz * 72; - else if (old_units.compare ("centimeters")) - fsz = fsz * 72 / 2.54; - - if (new_units.compare ("normalized")) - fsz = fsz * pixelsperinch / parent_height / 72; - else if (new_units.compare ("pixels")) - fsz = fsz * pixelsperinch / 72; - else if (new_units.compare ("inches")) - fsz = fsz / 72; - else if (new_units.compare ("centimeters")) - fsz = fsz * 2.54 / 72; + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); set_fontsize (octave_value (fsz)); } +double +axes::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (true).elem(3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + ColumnVector graphics_xform::xform_vector (double x, double y, double z) { @@ -4934,7 +5542,8 @@ // FIXME -- maybe this should go into array_property class? /* static void -check_limit_vals (double& min_val, double& max_val, double& min_pos, +check_limit_vals (double& min_val, double& max_val, + double& min_pos, double& max_neg, const array_property& data) { double val = data.min_val (); @@ -4946,18 +5555,22 @@ val = data.min_pos (); if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) min_pos = val; + val = data.max_neg (); + if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) + max_neg = val; } */ static void -check_limit_vals (double& min_val, double& max_val, double& min_pos, +check_limit_vals (double& min_val, double& max_val, + double& min_pos, double& max_neg, const octave_value& data) { if (data.is_matrix_type ()) { Matrix m = data.matrix_value (); - if (! error_state && m.numel () == 3) + if (! error_state && m.numel () == 4) { double val; @@ -4972,12 +5585,16 @@ val = m(2); if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) min_pos = val; - } - } -} - -// magform(x) Returns (a, b), where x = a * 10^b, a >= 1., and b is -// integral. + + val = m(3); + if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) + max_neg = val; + } + } +} + +// magform(x) Returns (a, b), where x = a * 10^b, abs (a) >= 1., and b is +// integer. static void magform (double x, double& a, int& b) @@ -4989,18 +5606,8 @@ } else { - double l = std::log10 (std::abs (x)); - double r = std::fmod (l, 1.); - a = std::pow (10.0, r); - b = static_cast<int> (l-r); - if (a < 1) - { - a *= 10; - b -= 1; - } - - if (x < 0) - a = -a; + b = static_cast<int> (gnulib::floor (std::log10 (std::abs (x)))); + a = x / std::pow (10.0, b); } } @@ -5046,26 +5653,36 @@ Matrix axes::properties::get_axis_limits (double xmin, double xmax, - double min_pos, bool logscale) + double min_pos, double max_neg, + bool logscale) { Matrix retval; double min_val = xmin; double max_val = xmax; - if (! (xisinf (min_val) || xisinf (max_val))) + if (xisinf (min_val) && min_val > 0 && xisinf (max_val) && max_val < 0) + { + retval = default_lim (logscale); + return retval; + } + else if (! (xisinf (min_val) || xisinf (max_val))) { if (logscale) { - if (xisinf (min_pos)) + if (xisinf (min_pos) && xisinf (max_neg)) { - // warning ("axis: logscale with no positive values to plot"); + // TODO -- max_neg is needed for "loglog ([0 -Inf])" + // This is the only place where max_neg is needed. + // Is there another way? + retval = default_lim (); + retval(0) = pow (10., retval(0)); + retval(1) = pow (10., retval(1)); return retval; } - - if (min_val <= 0) + if ((min_val <= 0 && max_val > 0)) { - warning ("axis: omitting nonpositive data in log plot"); + warning ("axis: omitting non-positive data in log plot"); min_val = min_pos; } // FIXME -- maybe this test should also be relative? @@ -5074,8 +5691,18 @@ min_val *= 0.9; max_val *= 1.1; } - min_val = pow (10, gnulib::floor (log10 (min_val))); - max_val = pow (10, std::ceil (log10 (max_val))); + if (min_val > 0) + { + // Log plots with all positive data + min_val = pow (10, gnulib::floor (log10 (min_val))); + max_val = pow (10, std::ceil (log10 (max_val))); + } + else + { + // Log plots with all negative data + min_val = -pow (10, std::ceil (log10 (-min_val))); + max_val = -pow (10, gnulib::floor (log10 (-max_val))); + } } else { @@ -5092,15 +5719,18 @@ } double tick_sep = calc_tick_sep (min_val , max_val); - min_val = tick_sep * gnulib::floor (min_val / tick_sep); - max_val = tick_sep * std::ceil (max_val / tick_sep); + double min_tick = gnulib::floor (min_val / tick_sep); + double max_tick = std::ceil (max_val / tick_sep); + // Prevent round-off from cropping ticks + min_val = std::min (min_val, tick_sep * min_tick); + max_val = std::max (max_val, tick_sep * max_tick); } } retval.resize (1, 2); + retval(1) = max_val; retval(0) = min_val; - retval(1) = max_val; return retval; } @@ -5118,23 +5748,41 @@ double lo = (lims.get ().matrix_value ()) (0); double hi = (lims.get ().matrix_value ()) (1); + bool is_negative = lo < 0 && hi < 0; + double tmp; // FIXME should this be checked for somewhere else? (i.e. set{x,y,z}lim) if (hi < lo) { - double tmp = hi; + tmp = hi; hi = lo; lo = tmp; } if (is_logscale) { - // FIXME we should check for negtives here - hi = std::log10 (hi); - lo = std::log10 (lo); + if (is_negative) + { + tmp = hi; + hi = std::log10 (-lo); + lo = std::log10 (-tmp); + } + else + { + hi = std::log10 (hi); + lo = std::log10 (lo); + } } double tick_sep = calc_tick_sep (lo , hi); + if (is_logscale && ! (xisinf (hi) || xisinf (lo))) + { + // FIXME - what if (hi-lo) < tick_sep? + // ex: loglog ([1 1.1]) + tick_sep = std::max (tick_sep, 1.); + tick_sep = std::ceil (tick_sep); + } + int i1 = static_cast<int> (gnulib::floor (lo / tick_sep)); int i2 = static_cast<int> (std::ceil (hi / tick_sep)); @@ -5142,8 +5790,8 @@ { // adjust limits to include min and max tics Matrix tmp_lims (1,2); - tmp_lims(0) = tick_sep * i1; - tmp_lims(1) = tick_sep * i2; + tmp_lims(0) = std::min (tick_sep * i1, lo); + tmp_lims(1) = std::max (tick_sep * i2, hi); if (is_logscale) { @@ -5151,6 +5799,12 @@ tmp_lims(1) = std::pow (10.,tmp_lims(1)); if (tmp_lims(0) <= 0) tmp_lims(0) = std::pow (10., lo); + if (is_negative) + { + tmp = tmp_lims(0); + tmp_lims(0) = -tmp_lims(1); + tmp_lims(1) = -tmp; + } } lims = tmp_lims; } @@ -5168,6 +5822,13 @@ if (is_logscale) tmp_ticks (i) = std::pow (10., tmp_ticks (i)); } + if (is_logscale && is_negative) + { + Matrix rev_ticks (1, i2-i1+1); + rev_ticks = -tmp_ticks; + for (int i = 0; i <= i2-i1; i++) + tmp_ticks (i) = rev_ticks (i2-i1-i); + } ticks = tmp_ticks; @@ -5187,17 +5848,55 @@ void axes::properties::calc_ticklabels (const array_property& ticks, - any_property& labels, bool /*logscale*/) + any_property& labels, bool logscale) { Matrix values = ticks.get ().matrix_value (); Cell c (values.dims ()); std::ostringstream os; - for (int i = 0; i < values.numel (); i++) - { - os.str (std::string ()); - os << values(i); - c(i) = os.str (); + if (logscale) + { + double significand; + double exponent; + double exp_max = 0.; + double exp_min = 0.; + + for (int i = 0; i < values.numel (); i++) + { + exp_max = std::max (exp_max, std::log10 (values(i))); + exp_min = std::max (exp_min, std::log10 (values(i))); + } + + for (int i = 0; i < values.numel (); i++) + { + if (values(i) < 0.) + exponent = gnulib::floor (std::log10 (-values(i))); + else + exponent = gnulib::floor (std::log10 (values(i))); + significand = values(i) * std::pow (10., -exponent); + os.str (std::string ()); + os << significand; + if (exponent < 0.) + { + os << "e-"; + exponent = -exponent; + } + else + os << "e+"; + if (exponent < 10. && (exp_max > 9 || exp_min < -9)) + os << "0"; + os << exponent; + c(i) = os.str (); + } + } + else + { + for (int i = 0; i < values.numel (); i++) + { + os.str (std::string ()); + os << values(i); + c(i) = os.str (); + } } labels = c; @@ -5208,14 +5907,7 @@ const string_vector& ticklabels, const Matrix& limits) { -#ifdef HAVE_FREETYPE - //FIXME: text_renderer could be cached - ft_render text_renderer; - text_renderer.set_font (get ("fontname").string_value (), - get ("fontweight").string_value (), - get ("fontangle").string_value (), - get ("fontsize").double_value ()); -#else +#ifndef HAVE_FREETYPE double fontsize = get ("fontsize").double_value (); #endif @@ -5246,7 +5938,8 @@ } void -get_children_limits (double& min_val, double& max_val, double& min_pos, +get_children_limits (double& min_val, double& max_val, + double& min_pos, double& max_neg, const Matrix& kids, char limit_type) { octave_idx_type n = kids.numel (); @@ -5262,7 +5955,7 @@ { octave_value lim = obj.get_xlim (); - check_limit_vals (min_val, max_val, min_pos, lim); + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); } } break; @@ -5276,7 +5969,7 @@ { octave_value lim = obj.get_ylim (); - check_limit_vals (min_val, max_val, min_pos, lim); + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); } } break; @@ -5290,7 +5983,7 @@ { octave_value lim = obj.get_zlim (); - check_limit_vals (min_val, max_val, min_pos, lim); + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); } } break; @@ -5304,7 +5997,7 @@ { octave_value lim = obj.get_clim (); - check_limit_vals (min_val, max_val, min_pos, lim); + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); } } break; @@ -5318,7 +6011,7 @@ { octave_value lim = obj.get_alim (); - check_limit_vals (min_val, max_val, min_pos, lim); + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); } } break; @@ -5342,6 +6035,7 @@ double min_val = octave_Inf; double max_val = -octave_Inf; double min_pos = octave_Inf; + double max_neg = -octave_Inf; char update_type = 0; @@ -5349,7 +6043,7 @@ double val; #define FIX_LIMITS \ - if (limits.numel() == 3) \ + if (limits.numel() == 4) \ { \ val = limits(0); \ if (! (xisinf (val) || xisnan (val))) \ @@ -5360,13 +6054,17 @@ val = limits(2); \ if (! (xisinf (val) || xisnan (val))) \ min_pos = val; \ + val = limits(3); \ + if (! (xisinf (val) || xisnan (val))) \ + max_neg = val; \ } \ else \ { \ - limits.resize(3, 1); \ + limits.resize(4, 1); \ limits(0) = min_val; \ limits(1) = max_val; \ limits(2) = min_pos; \ + limits(3) = max_neg; \ } if (axis_type == "xdata" || axis_type == "xscale" @@ -5378,9 +6076,10 @@ limits = xproperties.get_xlim ().matrix_value (); FIX_LIMITS ; - get_children_limits (min_val, max_val, min_pos, kids, 'x'); - - limits = xproperties.get_axis_limits (min_val, max_val, min_pos, + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, xproperties.xscale_is ("log")); update_type = 'x'; @@ -5395,9 +6094,10 @@ limits = xproperties.get_ylim ().matrix_value (); FIX_LIMITS ; - get_children_limits (min_val, max_val, min_pos, kids, 'y'); - - limits = xproperties.get_axis_limits (min_val, max_val, min_pos, + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, xproperties.yscale_is ("log")); update_type = 'y'; @@ -5412,9 +6112,10 @@ limits = xproperties.get_zlim ().matrix_value (); FIX_LIMITS ; - get_children_limits (min_val, max_val, min_pos, kids, 'z'); - - limits = xproperties.get_axis_limits (min_val, max_val, min_pos, + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, xproperties.zscale_is ("log")); update_type = 'z'; @@ -5429,7 +6130,7 @@ limits = xproperties.get_clim ().matrix_value (); FIX_LIMITS ; - get_children_limits (min_val, max_val, min_pos, kids, 'c'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); if (min_val > max_val) { @@ -5437,7 +6138,10 @@ max_val = 1; } else if (min_val == max_val) - max_val = min_val + 1; + { + max_val = min_val + 1; + min_val -= 1; + } limits.resize (1, 2); @@ -5457,7 +6161,7 @@ limits = xproperties.get_alim ().matrix_value (); FIX_LIMITS ; - get_children_limits (min_val, max_val, min_pos, kids, 'a'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); if (min_val > max_val) { @@ -5533,6 +6237,7 @@ double min_val = octave_Inf; double max_val = -octave_Inf; double min_pos = octave_Inf; + double max_neg = -octave_Inf; char update_type = 0; @@ -5544,9 +6249,10 @@ { if (xproperties.xlimmode_is ("auto")) { - get_children_limits (min_val, max_val, min_pos, kids, 'x'); - - limits = xproperties.get_axis_limits (min_val, max_val, min_pos, + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, xproperties.xscale_is ("log")); update_type = 'x'; @@ -5558,9 +6264,10 @@ { if (xproperties.ylimmode_is ("auto")) { - get_children_limits (min_val, max_val, min_pos, kids, 'y'); - - limits = xproperties.get_axis_limits (min_val, max_val, min_pos, + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, xproperties.yscale_is ("log")); update_type = 'y'; @@ -5572,9 +6279,10 @@ { if (xproperties.zlimmode_is ("auto")) { - get_children_limits (min_val, max_val, min_pos, kids, 'z'); - - limits = xproperties.get_axis_limits (min_val, max_val, min_pos, + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, xproperties.zscale_is ("log")); update_type = 'z'; @@ -5586,7 +6294,7 @@ { if (xproperties.climmode_is ("auto")) { - get_children_limits (min_val, max_val, min_pos, kids, 'c'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); if (min_val > max_val) { @@ -5594,7 +6302,10 @@ max_val = 1; } else if (min_val == max_val) - max_val = min_val + 1; + { + max_val = min_val + 1; + min_val -= 1; + } limits.resize (1, 2); @@ -5611,7 +6322,7 @@ { if (xproperties.alimmode_is ("auto")) { - get_children_limits (min_val, max_val, min_pos, kids, 'a'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); if (min_val > max_val) { @@ -5697,12 +6408,14 @@ double minx = octave_Inf; double maxx = -octave_Inf; double min_pos_x = octave_Inf; - get_children_limits (minx, maxx, min_pos_x, kids, 'x'); + double max_neg_x = -octave_Inf; + get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); double miny = octave_Inf; double maxy = -octave_Inf; double min_pos_y = octave_Inf; - get_children_limits (miny, maxy, min_pos_y, kids, 'y'); + double max_neg_y = -octave_Inf; + get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); // Perform the zooming xlims (0) = x + factor * (xlims (0) - x); @@ -5746,12 +6459,14 @@ double minx = octave_Inf; double maxx = -octave_Inf; double min_pos_x = octave_Inf; - get_children_limits (minx, maxx, min_pos_x, kids, 'x'); + double max_neg_x = -octave_Inf; + get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); double miny = octave_Inf; double maxy = -octave_Inf; double min_pos_y = octave_Inf; - get_children_limits (miny, maxy, min_pos_y, kids, 'y'); + double max_neg_y = -octave_Inf; + get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); xlims (0) += delta_x; xlims (1) += delta_x; @@ -5814,16 +6529,28 @@ ::reset_default_properties (default_properties); } +void +axes::initialize (const graphics_object& go) +{ + base_graphics_object::initialize (go); + + xinitialize (xproperties.get_title ()); + xinitialize (xproperties.get_xlabel ()); + xinitialize (xproperties.get_ylabel ()); + xinitialize (xproperties.get_zlabel ()); +} + // --------------------------------------------------------------------- Matrix line::properties::compute_xlim (void) const { - Matrix m (1, 3); + Matrix m (1, 4); m(0) = xdata.min_val (); m(1) = xdata.max_val (); m(2) = xdata.min_pos (); + m(3) = xdata.max_neg (); return m; } @@ -5831,11 +6558,12 @@ Matrix line::properties::compute_ylim (void) const { - Matrix m (1, 3); + Matrix m (1, 4); m(0) = ydata.min_val (); m(1) = ydata.max_val (); m(2) = ydata.min_pos (); + m(3) = ydata.max_neg (); return m; } @@ -5868,11 +6596,9 @@ } void -text::properties::update_text_extent (void) +text::properties::update_font (void) { #ifdef HAVE_FREETYPE - - // FIXME: font and color should be set only when modified, for efficiency #ifdef HAVE_FONTCONFIG renderer.set_font (get ("fontname").string_value (), get ("fontweight").string_value (), @@ -5880,6 +6606,13 @@ get ("fontsize").double_value ()); #endif renderer.set_color (get_color_rgb ()); +#endif +} + +void +text::properties::update_text_extent (void) +{ +#ifdef HAVE_FREETYPE int halign = 0, valign = 0; @@ -5896,11 +6629,17 @@ valign = 1; Matrix bbox; + // FIXME: string should be parsed only when modified, for efficiency - renderer.text_to_pixels (get_string (), pixels, bbox, + + octave_value string_prop = get_string (); + + string_vector sv = string_prop.all_strings (); + + renderer.text_to_pixels (sv.join ("\n"), pixels, bbox, halign, valign, get_rotation ()); - set_extent (bbox); + #endif if (autopos_tag_is ("xlabel") || autopos_tag_is ("ylabel") || @@ -5945,6 +6684,23 @@ cached_units = get_units (); } +double +text::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + { + graphics_object go (gh_manager::get_object (get___myhandle__ ())); + graphics_object ax (go.get_ancestor ("axes")); + + parent_height = ax.get_properties ().get_boundingbox (true).elem(3); + } + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + // --------------------------------------------------------------------- octave_value @@ -6106,6 +6862,7 @@ double min_val = octave_Inf; double max_val = -octave_Inf; double min_pos = octave_Inf; + double max_neg = -octave_Inf; Matrix limits; double val; @@ -6138,7 +6895,7 @@ update_type = 'a'; } - if (limits.numel() == 3) + if (limits.numel() == 4) { val = limits(0); if (! (xisinf (val) || xisnan (val))) @@ -6149,27 +6906,33 @@ val = limits(2); if (! (xisinf (val) || xisnan (val))) min_pos = val; + val = limits(3); + if (! (xisinf (val) || xisnan (val))) + max_neg = val; } else { - limits.resize(3,1); + limits.resize(4,1); limits(0) = min_val; limits(1) = max_val; limits(2) = min_pos; - } - - get_children_limits (min_val, max_val, min_pos, kids, update_type); + limits(3) = max_neg; + } + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, update_type); unwind_protect frame; frame.protect_var (updating_hggroup_limits); updating_hggroup_limits = true; - if (limits(0) != min_val || limits(1) != max_val || limits(2) != min_pos) + if (limits(0) != min_val || limits(1) != max_val + || limits(2) != min_pos || limits(3) != max_neg) { limits(0) = min_val; limits(1) = max_val; limits(2) = min_pos; + limits(3) = max_neg; switch (update_type) { @@ -6212,36 +6975,37 @@ double min_val = octave_Inf; double max_val = -octave_Inf; double min_pos = octave_Inf; + double max_neg = -octave_Inf; char update_type = 0; if (axis_type == "xlim" || axis_type == "xliminclude") { - get_children_limits (min_val, max_val, min_pos, kids, 'x'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); update_type = 'x'; } else if (axis_type == "ylim" || axis_type == "yliminclude") { - get_children_limits (min_val, max_val, min_pos, kids, 'y'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); update_type = 'y'; } else if (axis_type == "zlim" || axis_type == "zliminclude") { - get_children_limits (min_val, max_val, min_pos, kids, 'z'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); update_type = 'z'; } else if (axis_type == "clim" || axis_type == "climinclude") { - get_children_limits (min_val, max_val, min_pos, kids, 'c'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); update_type = 'c'; } else if (axis_type == "alim" || axis_type == "aliminclude") { - get_children_limits (min_val, max_val, min_pos, kids, 'a'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); update_type = 'a'; } @@ -6251,11 +7015,12 @@ updating_hggroup_limits = true; - Matrix limits (1, 3, 0.0); + Matrix limits (1, 4, 0.0); limits(0) = min_val; limits(1) = max_val; limits(2) = min_pos; + limits(3) = max_neg; switch (update_type) { @@ -6289,6 +7054,301 @@ // --------------------------------------------------------------------- octave_value +uicontrol::properties::get_extent (void) const +{ + Matrix m = extent.get ().matrix_value (); + + graphics_object parent_obj = + gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + return convert_position (m, "pixels", get_units (), parent_size); +} + +void +uicontrol::properties::update_text_extent (void) +{ +#ifdef HAVE_FREETYPE + + text_element *elt; + ft_render text_renderer; + Matrix box; + + // FIXME: parsed content should be cached for efficiency + // FIXME: support multiline text + + elt = text_parser_none ().parse (get_string_string ()); +#ifdef HAVE_FONTCONFIG + text_renderer.set_font (get_fontname (), + get_fontweight (), + get_fontangle (), + get_fontsize ()); +#endif + box = text_renderer.get_extent (elt, 0); + + Matrix ext (1, 4, 0.0); + + // FIXME: also handle left and bottom components + + ext(0) = ext(1) = 1; + ext(2) = box(0); + ext(3) = box(1); + + set_extent (ext); + +#endif +} + +void +uicontrol::properties::update_units (void) +{ + Matrix pos = get_position ().matrix_value (); + + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + pos = convert_position (pos, cached_units, get_units (), parent_size); + set_position (pos); + + cached_units = get_units (); +} + +void +uicontrol::properties::set_style (const octave_value& st) +{ + if (get___object__ ().is_empty()) + style = st; + else + error ("set: cannot change the style of a uicontrol object after creation."); +} + +Matrix +uicontrol::properties::get_boundingbox (bool, + const Matrix& parent_pix_size) const +{ + Matrix pos = get_position ().matrix_value (); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); + + pos(0)--; + pos(1)--; + pos(1) = parent_size(1) - pos(1) - pos(3); + + return pos; +} + +void +uicontrol::properties::set_fontunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_fontunits = get_fontunits (); + if (fontunits.set (v, true)) + { + update_fontunits (old_fontunits); + mark_modified (); + } + } +} + +void +uicontrol::properties::update_fontunits (const caseless_str& old_units) +{ + caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (false).elem (3); + double fsz = get_fontsize (); + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); + + fontsize.set (octave_value (fsz), true); +} + +double +uicontrol::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (false).elem(3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +// --------------------------------------------------------------------- + +Matrix +uipanel::properties::get_boundingbox (bool internal, + const Matrix& parent_pix_size) const +{ + Matrix pos = get_position ().matrix_value (); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); + + pos(0)--; + pos(1)--; + pos(1) = parent_size(1) - pos(1) - pos(3); + + if (internal) + { + double outer_height = pos(3); + + pos(0) = pos(1) = 0; + + if (! bordertype_is ("none")) + { + double bw = get_borderwidth (); + double mul = 1.0; + + if (bordertype_is ("etchedin") || bordertype_is ("etchedout")) + mul = 2.0; + + pos(0) += mul * bw; + pos(1) += mul * bw; + pos(2) -= 2 * mul * bw; + pos(3) -= 2 * mul * bw; + } + + if (! get_title ().empty ()) + { + double fs = get_fontsize (); + + if (! fontunits_is ("pixels")) + { + double res = xget (0, "screenpixelsperinch").double_value (); + + if (fontunits_is ("points")) + fs *= (res / 72.0); + else if (fontunits_is ("inches")) + fs *= res; + else if (fontunits_is ("centimeters")) + fs *= (res / 2.54); + else if (fontunits_is ("normalized")) + fs *= outer_height; + } + + if (titleposition_is ("lefttop") || titleposition_is ("centertop") + || titleposition_is ("righttop")) + pos(1) += (fs / 2); + pos(3) -= (fs / 2); + } + } + + return pos; +} + +void +uipanel::properties::set_units (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_units = get_units (); + if (units.set (v, true)) + { + update_units (old_units); + mark_modified (); + } + } +} + +void +uipanel::properties::update_units (const caseless_str& old_units) +{ + Matrix pos = get_position ().matrix_value (); + + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + pos = convert_position (pos, old_units, get_units (), parent_size); + set_position (pos); +} + +void +uipanel::properties::set_fontunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_fontunits = get_fontunits (); + if (fontunits.set (v, true)) + { + update_fontunits (old_fontunits); + mark_modified (); + } + } +} + +void +uipanel::properties::update_fontunits (const caseless_str& old_units) +{ + caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (false).elem (3); + double fsz = get_fontsize (); + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); + + set_fontsize (octave_value (fsz)); +} + +double +uipanel::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (false).elem(3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +// --------------------------------------------------------------------- + +octave_value +uitoolbar::get_default (const caseless_str& name) const +{ + octave_value retval = default_properties.lookup (name); + + if (retval.is_undefined ()) + { + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (parent); + + retval = parent_obj.get_default (name); + } + + return retval; +} + +void +uitoolbar::reset_default_properties (void) +{ + ::reset_default_properties (default_properties); +} + +// --------------------------------------------------------------------- + +octave_value base_graphics_object::get_default (const caseless_str& name) const { graphics_handle parent = get_parent (); @@ -6310,19 +7370,32 @@ gh_manager::gh_manager (void) : handle_map (), handle_free_list (), next_handle (-1.0 - (rand () + 1.0) / (RAND_MAX + 2.0)), - figure_list (), graphics_lock (), event_queue (), callback_objects () + figure_list (), graphics_lock (), event_queue (), + callback_objects (), event_processing (0) { handle_map[0] = graphics_object (new root_figure ()); // Make sure the default graphics toolkit is registered. - graphics_toolkit::default_toolkit (); + gtk_manager::default_toolkit (); +} + +void +gh_manager::create_instance (void) +{ + instance = new gh_manager (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); } graphics_handle gh_manager::do_make_graphics_handle (const std::string& go_name, - const graphics_handle& p, bool do_createfcn) -{ - graphics_handle h = get_handle (go_name); + const graphics_handle& p, + bool integer_figure_handle, + bool do_createfcn, + bool do_notify_toolkit) +{ + graphics_handle h = get_handle (integer_figure_handle); base_graphics_object *go = 0; @@ -6337,9 +7410,8 @@ go->get_properties ().execute_createfcn (); // Notify graphics toolkit. - graphics_toolkit toolkit = go->get_toolkit (); - if (toolkit) - toolkit.initialize (obj); + if (do_notify_toolkit) + obj.initialize (); } else error ("gh_manager::do_make_graphics_handle: invalid object type `%s'", @@ -6349,7 +7421,7 @@ } graphics_handle -gh_manager::do_make_figure_handle (double val) +gh_manager::do_make_figure_handle (double val, bool do_notify_toolkit) { graphics_handle h = val; @@ -6359,9 +7431,8 @@ handle_map[h] = obj; // Notify graphics toolkit. - graphics_toolkit toolkit = go->get_toolkit (); - if (toolkit) - toolkit.initialize (obj); + if (do_notify_toolkit) + obj.initialize (); return h; } @@ -6396,11 +7467,19 @@ callback_event (const graphics_handle& h, const std::string& name, const octave_value& data = Matrix ()) : base_graphics_event (), handle (h), callback_name (name), - callback_data (data) { } + callback (), callback_data (data) { } + + callback_event (const graphics_handle& h, const octave_value& cb, + const octave_value& data = Matrix ()) + : base_graphics_event (), handle (h), callback_name (), + callback (cb), callback_data (data) { } void execute (void) { - gh_manager::execute_callback (handle, callback_name, callback_data); + if (callback.is_defined ()) + gh_manager::execute_callback (handle, callback, callback_data); + else + gh_manager::execute_callback (handle, callback_name, callback_data); } private: @@ -6412,6 +7491,7 @@ private: graphics_handle handle; std::string callback_name; + octave_value callback; octave_value callback_data; }; @@ -6449,15 +7529,23 @@ { public: set_event (const graphics_handle& h, const std::string& name, - const octave_value& value) + const octave_value& value, bool do_notify_toolkit = true) : base_graphics_event (), handle (h), property_name (name), - property_value (value) { } + property_value (value), notify_toolkit (do_notify_toolkit) { } void execute (void) { - gh_manager::autolock guard; - - xset (handle, property_name, property_value); + gh_manager::auto_lock guard; + + graphics_object go = gh_manager::get_object (handle); + + if (go) + { + property p = go.get_properties ().get_property (property_name); + + if (p.ok ()) + p.set (property_value, true, notify_toolkit); + } } private: @@ -6469,6 +7557,7 @@ graphics_handle handle; std::string property_name; octave_value property_value; + bool notify_toolkit; }; graphics_event @@ -6484,6 +7573,18 @@ } graphics_event +graphics_event::create_callback_event (const graphics_handle& h, + const octave_value& cb, + const octave_value& data) +{ + graphics_event e; + + e.rep = new callback_event (h, cb, data); + + return e; +} + +graphics_event graphics_event::create_function_event (graphics_event::event_fcn fcn, void *data) { @@ -6497,11 +7598,12 @@ graphics_event graphics_event::create_set_event (const graphics_handle& h, const std::string& name, - const octave_value& data) + const octave_value& data, + bool notify_toolkit) { graphics_event e; - e.rep = new set_event (h, name, data); + e.rep = new set_event (h, name, data, notify_toolkit); return e; } @@ -6519,7 +7621,7 @@ void gh_manager::do_restore_gcbo (void) { - gh_manager::autolock guard; + gh_manager::auto_lock guard; callback_objects.pop_front (); @@ -6529,69 +7631,87 @@ } void +gh_manager::do_execute_listener (const graphics_handle& h, + const octave_value& l) +{ + if (octave_thread::is_octave_thread ()) + gh_manager::execute_callback (h, l, octave_value ()); + else + { + gh_manager::auto_lock guard; + + do_post_event (graphics_event::create_callback_event (h, l)); + } +} + +void gh_manager::do_execute_callback (const graphics_handle& h, const octave_value& cb_arg, const octave_value& data) { - octave_value_list args; - octave_function *fcn = 0; - - args(0) = h.as_octave_value (); - if (data.is_defined ()) - args(1) = data; - else - args(1) = Matrix (); - - unwind_protect_safe frame; - frame.add_fcn (gh_manager::restore_gcbo); - - if (true) - { - gh_manager::autolock guard; - - callback_objects.push_front (get_object (h)); - xset_gcbo (h); - } - - BEGIN_INTERRUPT_WITH_EXCEPTIONS; - - // Copy CB because "function_value" method is non-const. - - octave_value cb = cb_arg; - - if (cb.is_function_handle ()) - fcn = cb.function_value (); - else if (cb.is_string ()) - { - int status; - std::string s = cb.string_value (); - - eval_string (s, false, status); - } - else if (cb.is_cell () && cb.length () > 0 - && (cb.rows () == 1 || cb.columns () == 1) - && cb.cell_value ()(0).is_function_handle ()) - { - Cell c = cb.cell_value (); - - fcn = c(0).function_value (); - if (! error_state) - { - for (int i = 1; i < c.length () ; i++) - args(1+i) = c(i); - } - } - else - { - std::string nm = cb.class_name (); - error ("trying to execute non-executable object (class = %s)", - nm.c_str ()); - } - - if (fcn && ! error_state) - feval (fcn, args); - - END_INTERRUPT_WITH_EXCEPTIONS; + if (cb_arg.is_defined () && ! cb_arg.is_empty ()) + { + octave_value_list args; + octave_function *fcn = 0; + + args(0) = h.as_octave_value (); + if (data.is_defined ()) + args(1) = data; + else + args(1) = Matrix (); + + unwind_protect_safe frame; + frame.add_fcn (gh_manager::restore_gcbo); + + if (true) + { + gh_manager::auto_lock guard; + + callback_objects.push_front (get_object (h)); + xset_gcbo (h); + } + + BEGIN_INTERRUPT_WITH_EXCEPTIONS; + + // Copy CB because "function_value" method is non-const. + + octave_value cb = cb_arg; + + if (cb.is_function () || cb.is_function_handle ()) + fcn = cb.function_value (); + else if (cb.is_string ()) + { + int status; + std::string s = cb.string_value (); + + eval_string (s, false, status, 0); + } + else if (cb.is_cell () && cb.length () > 0 + && (cb.rows () == 1 || cb.columns () == 1) + && (cb.cell_value ()(0).is_function () + || cb.cell_value ()(0).is_function_handle ())) + { + Cell c = cb.cell_value (); + + fcn = c(0).function_value (); + if (! error_state) + { + for (int i = 1; i < c.length () ; i++) + args(1+i) = c(i); + } + } + else + { + std::string nm = cb.class_name (); + error ("trying to execute non-executable object (class = %s)", + nm.c_str ()); + } + + if (fcn && ! error_state) + feval (fcn, args); + + END_INTERRUPT_WITH_EXCEPTIONS; + } } void @@ -6606,7 +7726,7 @@ gh_manager::do_post_callback (const graphics_handle& h, const std::string name, const octave_value& data) { - gh_manager::autolock guard; + gh_manager::auto_lock guard; graphics_object go = get_object (h); @@ -6645,24 +7765,27 @@ void gh_manager::do_post_function (graphics_event::event_fcn fcn, void* fcn_data) { - gh_manager::autolock guard; + gh_manager::auto_lock guard; do_post_event (graphics_event::create_function_event (fcn, fcn_data)); } void gh_manager::do_post_set (const graphics_handle& h, const std::string name, - const octave_value& value) -{ - gh_manager::autolock guard; - - do_post_event (graphics_event::create_set_event (h, name, value)); + const octave_value& value, bool notify_toolkit) +{ + gh_manager::auto_lock guard; + + do_post_event (graphics_event::create_set_event (h, name, value, + notify_toolkit)); } int gh_manager::do_process_events (bool force) { graphics_event e; + bool old_Vdrawnow_requested = Vdrawnow_requested; + bool events_executed = false; do { @@ -6694,20 +7817,53 @@ gh_manager::unlock (); if (e.ok ()) - e.execute (); + { + e.execute (); + events_executed = true; + } } while (e.ok ()); gh_manager::lock (); - if (event_queue.empty ()) + if (event_queue.empty () && event_processing == 0) command_editor::remove_event_hook (gh_manager::process_events); gh_manager::unlock (); + if (events_executed) + flush_octave_stdout (); + + if (Vdrawnow_requested && ! old_Vdrawnow_requested) + { + feval ("drawnow"); + + Vdrawnow_requested = false; + } + return 0; } +void +gh_manager::do_enable_event_processing (bool enable) +{ + gh_manager::auto_lock guard; + + if (enable) + { + event_processing++; + + command_editor::add_event_hook (gh_manager::process_events); + } + else + { + event_processing--; + + if (event_queue.empty () && event_processing == 0) + command_editor::remove_event_hook (gh_manager::process_events); + } +} + property_list::plist_map_type root_figure::init_factory_properties (void) { @@ -6722,6 +7878,12 @@ plist_map["surface"] = surface::properties::factory_defaults (); plist_map["hggroup"] = hggroup::properties::factory_defaults (); plist_map["uimenu"] = uimenu::properties::factory_defaults (); + plist_map["uicontrol"] = uicontrol::properties::factory_defaults (); + plist_map["uipanel"] = uipanel::properties::factory_defaults (); + plist_map["uicontextmenu"] = uicontextmenu::properties::factory_defaults (); + plist_map["uitoolbar"] = uitoolbar::properties::factory_defaults (); + plist_map["uipushtool"] = uipushtool::properties::factory_defaults (); + plist_map["uitoggletool"] = uitoggletool::properties::factory_defaults (); return plist_map; } @@ -6738,7 +7900,7 @@ @seealso{isfigure}\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -6750,6 +7912,59 @@ return retval; } +static bool +is_handle_visible (const graphics_handle& h) +{ + return h.ok () && gh_manager::is_handle_visible (h); +} + +static bool +is_handle_visible (double val) +{ + return is_handle_visible (gh_manager::lookup (val)); +} + +static octave_value +is_handle_visible (const octave_value& val) +{ + octave_value retval = false; + + if (val.is_real_scalar () && is_handle_visible (val.double_value ())) + retval = true; + else if (val.is_numeric_type () && val.is_real_type ()) + { + const NDArray handles = val.array_value (); + + if (! error_state) + { + boolNDArray result (handles.dims ()); + + for (octave_idx_type i = 0; i < handles.numel (); i++) + result.xelem (i) = is_handle_visible (handles (i)); + + retval = result; + } + } + + return retval; +} + +DEFUN (__is_handle_visible__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} __is_handle_visible__ (@var{h})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = is_handle_visible (args(0)); + else + print_usage (); + + return retval; +} + DEFUN (reset, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} reset (@var{h}, @var{property})\n\ @@ -6814,7 +8029,7 @@ @end itemize\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -6902,6 +8117,21 @@ return retval; } +static std::string +get_graphics_object_type (const double val) +{ + std::string retval; + + graphics_object obj = gh_manager::get_object (val); + + if (obj) + retval = obj.type (); + else + error ("get: invalid handle (= %g)", val); + + return retval; +} + DEFUN (get, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} get (@var{h}, @var{p})\n\ @@ -6911,7 +8141,7 @@ values or lists respectively.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -6919,41 +8149,116 @@ int nargin = args.length (); + bool use_cell_format = false; + if (nargin == 1 || nargin == 2) { + if (args(0).is_empty()) + { + retval = Matrix (); + return retval; + } + ColumnVector hcv (args(0).vector_value ()); if (! error_state) { octave_idx_type len = hcv.length (); - vals.resize (dim_vector (len, 1)); - - for (octave_idx_type n = 0; n < len; n++) + if (nargin == 1 && len > 1) { - graphics_object obj = gh_manager::get_object (hcv(n)); - - if (obj) + std::string t0 = get_graphics_object_type (hcv(0)); + + if (! error_state) { - if (nargin == 1) - vals(n) = obj.get (); - else + for (octave_idx_type n = 1; n < len; n++) { - caseless_str property = args(1).string_value (); - - if (! error_state) - vals(n) = obj.get (property); - else + std::string t = get_graphics_object_type (hcv(n)); + + if (error_state) + break; + + if (t != t0) { - error ("get: expecting property name as second argument"); + error ("get: vector of handles must all have same type"); break; } } + + } + } + + if (! error_state) + { + if (nargin > 1 && args(1).is_cellstr ()) + { + Array<std::string> plist = args(1).cellstr_value (); + + if (! error_state) + { + octave_idx_type plen = plist.numel (); + + use_cell_format = true; + + vals.resize (dim_vector (len, plen)); + + for (octave_idx_type n = 0; ! error_state && n < len; n++) + { + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + { + for (octave_idx_type m = 0; ! error_state && m < plen; m++) + { + caseless_str property = plist(m); + + vals(n, m) = obj.get (property); + } + } + else + { + error ("get: invalid handle (= %g)", hcv(n)); + break; + } + } + } + else + error ("get: expecting property name or cell array of property names as second argument"); } else { - error ("get: invalid handle (= %g)", hcv(n)); - break; + caseless_str property; + + if (nargin > 1) + { + property = args(1).string_value (); + + if (error_state) + error ("get: expecting property name or cell array of property names as second argument"); + } + + vals.resize (dim_vector (len, 1)); + + if (! error_state) + { + for (octave_idx_type n = 0; ! error_state && n < len; n++) + { + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + { + if (nargin == 1) + vals(n) = obj.get (); + else + vals(n) = obj.get (property); + } + else + { + error ("get: invalid handle (= %g)", hcv(n)); + break; + } + } + } } } } @@ -6965,14 +8270,28 @@ if (! error_state) { - octave_idx_type len = vals.numel (); - - if (len == 0) - retval = Matrix (); - else if (len == 1) - retval = vals(0); + if (use_cell_format) + retval = vals; else - retval = vals; + { + octave_idx_type len = vals.numel (); + + if (len == 0) + retval = Matrix (); + else if (len == 1) + retval = vals(0); + else if (len > 1 && nargin == 1) + { + OCTAVE_LOCAL_BUFFER (octave_scalar_map, tmp, len); + + for (octave_idx_type n = 0; n < len; n++) + tmp[n] = vals(n).scalar_map_value (); + + retval = octave_map::cat (0, len, tmp); + } + else + retval = vals; + } } return retval; @@ -6992,7 +8311,7 @@ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7044,6 +8363,7 @@ static octave_value make_graphics_object (const std::string& go_name, + bool integer_figure_handle, const octave_value_list& args) { octave_value retval; @@ -7083,7 +8403,9 @@ if (parent.ok ()) { graphics_handle h - = gh_manager::make_graphics_handle (go_name, parent, false); + = gh_manager::make_graphics_handle (go_name, parent, + integer_figure_handle, + false, false); if (! error_state) { @@ -7091,6 +8413,7 @@ xset (h, xargs); xcreatefcn (h); + xinitialize (h); retval = h.value (); @@ -7116,7 +8439,7 @@ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7136,21 +8459,63 @@ } else { + bool int_fig_handle = true; + + octave_value_list xargs = args.splice (0, 1); + graphics_handle h = octave_NaN; if (xisnan (val)) - h = gh_manager::make_graphics_handle ("figure", 0, false); + { + caseless_str p ("integerhandle"); + + for (int i = 0; i < xargs.length (); i++) + { + if (xargs(i).is_string () + && p.compare (xargs(i).string_value ())) + { + if (i < (xargs.length () - 1)) + { + std::string pval = xargs(i+1).string_value (); + + if (! error_state) + { + caseless_str on ("on"); + int_fig_handle = on.compare (pval); + xargs = xargs.splice (i, 2); + break; + } + } + } + } + + h = gh_manager::make_graphics_handle ("figure", 0, + int_fig_handle, + false, false); + + if (! int_fig_handle) + { + // We need to intiailize the integerhandle + // property without calling the set_integerhandle + // method, because doing that will generate a new + // handle value... + + graphics_object go = gh_manager::get_object (h); + go.get_properties ().init_integerhandle ("off"); + } + } else if (val > 0 && D_NINT (val) == val) - h = gh_manager::make_figure_handle (val); - else - error ("__go_figure__: invalid figure number"); + h = gh_manager::make_figure_handle (val, false); if (! error_state && h.ok ()) { adopt (0, h); - xset (h, args.splice (0, 1)); + gh_manager::push_figure (h); + + xset (h, xargs); xcreatefcn (h); + xinitialize (h); retval = h.value (); } @@ -7168,12 +8533,12 @@ } #define GO_BODY(TYPE) \ - gh_manager::autolock guard; \ + gh_manager::auto_lock guard; \ \ octave_value retval; \ \ if (args.length () > 0) \ - retval = make_graphics_object (#TYPE, args); \ + retval = make_graphics_object (#TYPE, false, args); \ else \ print_usage (); \ \ @@ -7219,7 +8584,7 @@ object, whether 2 or 3.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7312,13 +8677,67 @@ GO_BODY (uimenu); } +DEFUN (__go_uicontrol__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uicontrol__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uicontrol); +} + +DEFUN (__go_uipanel__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uipanel__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uipanel); +} + +DEFUN (__go_uicontextmenu__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uicontextmenu__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uicontextmenu); +} + +DEFUN (__go_uitoolbar__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uitoolbar__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uitoolbar); +} + +DEFUN (__go_uipushtool__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uipushtool__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uipushtool); +} + +DEFUN (__go_uitoggletool__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uitoggletool__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uitoggletool); +} + DEFUN (__go_delete__, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} __go_delete__ (@var{h})\n\ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value_list retval; @@ -7346,40 +8765,7 @@ } if (! error_state) - { - for (octave_idx_type i = 0; i < vals.numel (); i++) - { - h = gh_manager::lookup (vals.elem (i)); - - if (h.ok ()) - { - graphics_object obj = gh_manager::get_object (h); - - // Don't do recursive deleting, due to callbacks - if (! obj.get_properties ().is_beingdeleted ()) - { - graphics_handle parent_h = obj.get_parent (); - - graphics_object parent_obj = - gh_manager::get_object (parent_h); - - // NOTE: free the handle before removing it from its - // parent's children, such that the object's - // state is correct when the deletefcn callback - // is executed - - gh_manager::free (h); - - // A callback function might have already deleted - // the parent - if (parent_obj.valid_object ()) - parent_obj.remove_child (h); - - Vdrawnow_requested = true; - } - } - } - } + delete_graphics_objects (vals); } else error ("delete: invalid graphics object"); @@ -7396,7 +8782,7 @@ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7444,26 +8830,36 @@ return retval; } -DEFUN (__go_handles__, , , +DEFUN (__go_handles__, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_handles__ ()\n\ +@deftypefn {Built-in Function} {} __go_handles__ (@var{show_hidden})\n\ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; - - return octave_value (gh_manager::handle_list ()); -} - -DEFUN (__go_figure_handles__, , , + gh_manager::auto_lock guard; + + bool show_hidden = false; + + if (args.length () > 0) + show_hidden = args(0).bool_value (); + + return octave_value (gh_manager::handle_list (show_hidden)); +} + +DEFUN (__go_figure_handles__, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_figure_handles__ ()\n\ +@deftypefn {Built-in Function} {} __go_figure_handles__ (@var{show_hidden})\n\ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; - - return octave_value (gh_manager::figure_handle_list ()); + gh_manager::auto_lock guard; + + bool show_hidden = false; + + if (args.length () > 0) + show_hidden = args(0).bool_value (); + + return octave_value (gh_manager::figure_handle_list (show_hidden)); } DEFUN (__go_execute_callback__, args, , @@ -7551,15 +8947,97 @@ return retval; } +gtk_manager *gtk_manager::instance = 0; + +void +gtk_manager::create_instance (void) +{ + instance = new gtk_manager (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); +} + +graphics_toolkit +gtk_manager::do_get_toolkit (void) const +{ + graphics_toolkit retval; + + const_loaded_toolkits_iterator pl = loaded_toolkits.find (dtk); + + if (pl == loaded_toolkits.end ()) + { + const_available_toolkits_iterator pa = available_toolkits.find (dtk); + + if (pa != available_toolkits.end ()) + { + octave_value_list args; + args(0) = dtk; + feval ("graphics_toolkit", args); + + if (! error_state) + pl = loaded_toolkits.find (dtk); + + if (error_state || pl == loaded_toolkits.end ()) + error ("failed to load %s graphics toolkit", dtk.c_str ()); + else + retval = pl->second; + } + else + error ("default graphics toolkit `%s' is not available!", + dtk.c_str ()); + } + else + retval = pl->second; + + return retval; +} + DEFUN (available_graphics_toolkits, , , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} available_graphics_toolkits ()\n\ Return a cell array of registered graphics toolkits.\n\ @end deftypefn") { - gh_manager::autolock guard; - - return octave_value (graphics_toolkit::available_toolkits_list ()); + gh_manager::auto_lock guard; + + return octave_value (gtk_manager::available_toolkits_list ()); +} + +DEFUN (register_graphics_toolkit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} register_graphics_toolkit (@var{toolkit})\n\ +List @var{toolkit} as an available graphics toolkit.\n\ +@end deftypefn") +{ + octave_value retval; + + gh_manager::auto_lock guard; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + gtk_manager::register_toolkit (name); + else + error ("register_graphics_toolkit: expecting character string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (loaded_graphics_toolkits, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} loaded_graphics_toolkits ()\n\ +Return a cell array of the currently loaded graphics toolkits.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + return octave_value (gtk_manager::loaded_toolkits_list ()); } DEFUN (drawnow, args, , @@ -7576,7 +9054,6 @@ @end deftypefn") { static int drawnow_executing = 0; - static bool __go_close_all_registered__ = false; octave_value retval; @@ -7589,16 +9066,9 @@ if (++drawnow_executing <= 1) { - if (! __go_close_all_registered__) - { - octave_add_atexit_function ("__go_close_all__"); - - __go_close_all_registered__ = true; - } - if (args.length () == 0 || args.length () == 1) { - Matrix hlist = gh_manager::figure_handle_list (); + Matrix hlist = gh_manager::figure_handle_list (true); for (int i = 0; ! error_state && i < hlist.length (); i++) { @@ -7764,11 +9234,11 @@ \n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; - if (args.length () == 3) + if (args.length () >= 3 && args.length () <= 4) { double h = args(0).double_value (); @@ -7785,6 +9255,13 @@ graphics_object go = gh_manager::get_object (gh); go.add_property_listener (pname, args(2), POSTSET); + + if (args.length () == 4) + { + caseless_str persistent = args(3).string_value (); + if (persistent.compare ("persistent")) + go.add_property_listener (pname, args(2), PERSISTENT); + } } else error ("addlistener: invalid graphics object (= %g)", @@ -7829,7 +9306,7 @@ \n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7852,7 +9329,16 @@ if (args.length () == 2) go.delete_property_listener (pname, octave_value (), POSTSET); else - go.delete_property_listener (pname, args(2), POSTSET); + { + caseless_str persistent = args(2).string_value (); + if (persistent.compare ("persistent")) + { + go.delete_property_listener (pname, octave_value (), PERSISTENT); + go.delete_property_listener (pname, octave_value (), POSTSET); + } + else + go.delete_property_listener (pname, args(2), POSTSET); + } } else error ("dellistener: invalid graphics object (= %g)", @@ -7940,7 +9426,7 @@ \n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7998,7 +9484,7 @@ get_property_from_handle (double handle, const std::string& property, const std::string& func) { - gh_manager::autolock guard; + gh_manager::auto_lock guard; graphics_object obj = gh_manager::get_object (handle); octave_value retval; @@ -8015,7 +9501,7 @@ set_property_in_handle (double handle, const std::string& property, const octave_value& arg, const std::string& func) { - gh_manager::autolock guard; + gh_manager::auto_lock guard; graphics_object obj = gh_manager::get_object (handle); int ret = false; @@ -8032,3 +9518,392 @@ return ret; } + +static bool +compare_property_values (const octave_value& o1, const octave_value& o2) +{ + octave_value_list args (2); + + args(0) = o1; + args(1) = o2; + + octave_value_list result = feval ("isequal", args, 1); + + if (! error_state && result.length () > 0) + return result(0).bool_value (); + + return false; +} + +static std::map<uint32_t, bool> waitfor_results; + +static void +cleanup_waitfor_id (uint32_t id) +{ + waitfor_results.erase (id); +} + +static void +do_cleanup_waitfor_listener (const octave_value& listener, + listener_mode mode = POSTSET) +{ + Cell c = listener.cell_value (); + + if (c.numel () >= 4) + { + double h = c(2).double_value (); + + if (! error_state) + { + caseless_str pname = c(3).string_value (); + + if (! error_state) + { + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + graphics_object go = gh_manager::get_object (handle); + + if (go.get_properties ().has_property (pname)) + { + go.get_properties () + .delete_listener (pname, listener, mode); + if (mode == POSTSET) + go.get_properties () + .delete_listener (pname, listener, PERSISTENT); + } + } + } + } + } +} + +static void +cleanup_waitfor_postset_listener(const octave_value& listener) +{ do_cleanup_waitfor_listener (listener, POSTSET); } + +static void +cleanup_waitfor_predelete_listener(const octave_value& listener) +{ do_cleanup_waitfor_listener (listener, PREDELETE); } + +static octave_value_list +waitfor_listener (const octave_value_list& args, int) +{ + if (args.length () > 3) + { + uint32_t id = args(2).uint32_scalar_value ().value (); + + if (! error_state) + { + if (args.length () > 5) + { + double h = args(0).double_value (); + + if (! error_state) + { + caseless_str pname = args(4).string_value (); + + if (! error_state) + { + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + graphics_object go = gh_manager::get_object (handle); + octave_value pvalue = go.get (pname); + + if (compare_property_values (pvalue, args(5))) + waitfor_results[id] = true; + } + } + } + } + else + waitfor_results[id] = true; + } + } + + return octave_value_list (); +} + +static octave_value_list +waitfor_del_listener (const octave_value_list& args, int) +{ + if (args.length () > 2) + { + uint32_t id = args(2).uint32_scalar_value ().value (); + + if (! error_state) + waitfor_results[id] = true; + } + + return octave_value_list (); +} + +DEFUN (waitfor, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} waitfor (@var{h})\n\ +@deftypefnx {Built-in Function} {} waitfor (@var{h}, @var{prop})\n\ +@deftypefnx {Built-in Function} {} waitfor (@var{h}, @var{prop}, @var{value})\n\ +@deftypefnx {Built-in Function} {} waitfor (@dots{}, \"timeout\", @var{timeout})\n\ +Suspend the execution of the current program until a condition is\n\ +satisfied on the graphics handle @var{h}. While the program is suspended\n\ +graphics events are still being processed normally, allowing callbacks to\n\ +modify the state of graphics objects. This function is reentrant and can be\n\ +called from a callback, while another @code{waitfor} call is pending at\n\ +top-level.\n\ +\n\ +In the first form, program execution is suspended until the graphics object\n\ +@var{h} is destroyed. If the graphics handle is invalid, the function\n\ +returns immediately.\n\ +\n\ +In the second form, execution is suspended until the graphics object is\n\ +destroyed or the property named @var{prop} is modified. If the graphics\n\ +handle is invalid or the property does not exist, the function returns\n\ +immediately.\n\ +\n\ +In the third form, execution is suspended until the graphics object is\n\ +destroyed or the property named @var{prop} is set to @var{value}. The\n\ +function @code{isequal} is used to compare property values. If the graphics\n\ +handle is invalid, the property does not exist or the property is already\n\ +set to @var{value}, the function returns immediately.\n\ +\n\ +An optional timeout can be specified using the property @code{timeout}.\n\ +This timeout value is the number of seconds to wait for the condition to be\n\ +true. @var{timeout} must be at least 1. If a smaller value is specified, a\n\ +warning is issued and a value of 1 is used instead. If the timeout value is\n\ +not an integer, it is truncated towards 0.\n\ +\n\ +To define a condition on a property named @code{timeout}, use the string\n\ +@code{\\timeout} instead.\n\ +\n\ +In all cases, typing CTRL-C stops program execution immediately.\n\ +@seealso{isequal}\n\ +@end deftypefn") +{ + if (args.length () > 0) + { + double h = args(0).double_value (); + + if (! error_state) + { + caseless_str pname; + + unwind_protect frame; + + static uint32_t id_counter = 0; + uint32_t id = 0; + + int max_arg_index = 0; + int timeout_index = -1; + + int timeout = 0; + + if (args.length () > 1) + { + pname = args(1).string_value (); + if (! error_state + && ! pname.empty () + && ! pname.compare ("timeout")) + { + if (pname.compare ("\\timeout")) + pname = "timeout"; + + static octave_value wf_listener; + + if (! wf_listener.is_defined ()) + wf_listener = + octave_value (new octave_builtin (waitfor_listener, + "waitfor_listener")); + + max_arg_index++; + if (args.length () > 2) + { + if (args(2).is_string ()) + { + caseless_str s = args(2).string_value (); + + if (! error_state) + { + if (s.compare ("timeout")) + timeout_index = 2; + else + max_arg_index++; + } + } + else + max_arg_index++; + } + + Cell listener (1, max_arg_index >= 2 ? 5 : 4); + + id = id_counter++; + frame.add_fcn (cleanup_waitfor_id, id); + waitfor_results[id] = false; + + listener(0) = wf_listener; + listener(1) = octave_uint32 (id); + listener(2) = h; + listener(3) = pname; + + if (max_arg_index >= 2) + listener(4) = args(2); + + octave_value ov_listener (listener); + + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + graphics_object go = gh_manager::get_object (handle); + + if (max_arg_index >= 2 + && compare_property_values (go.get (pname), + args(2))) + waitfor_results[id] = true; + else + { + + frame.add_fcn (cleanup_waitfor_postset_listener, + ov_listener); + go.add_property_listener (pname, ov_listener, + POSTSET); + go.add_property_listener (pname, ov_listener, + PERSISTENT); + + if (go.get_properties () + .has_dynamic_property (pname)) + { + static octave_value wf_del_listener; + + if (! wf_del_listener.is_defined ()) + wf_del_listener = + octave_value (new octave_builtin + (waitfor_del_listener, + "waitfor_del_listener")); + + Cell del_listener (1, 4); + + del_listener(0) = wf_del_listener; + del_listener(1) = octave_uint32 (id); + del_listener(2) = h; + del_listener(3) = pname; + + octave_value ov_del_listener (del_listener); + + frame.add_fcn (cleanup_waitfor_predelete_listener, + ov_del_listener); + go.add_property_listener (pname, ov_del_listener, + PREDELETE); + } + } + } + } + else if (error_state || pname.empty ()) + error ("waitfor: invalid property name, expected a non-empty string value"); + } + + if (! error_state + && timeout_index < 0 + && args.length () > (max_arg_index + 1)) + { + caseless_str s = args(max_arg_index + 1).string_value (); + + if (! error_state) + { + if (s.compare ("timeout")) + timeout_index = max_arg_index + 1; + else + error ("waitfor: invalid parameter `%s'", s.c_str ()); + } + else + error ("waitfor: invalid parameter, expected `timeout'"); + } + + if (! error_state && timeout_index >= 0) + { + if (args.length () > (timeout_index + 1)) + { + timeout = static_cast<int> + (args(timeout_index + 1).scalar_value ()); + + if (! error_state) + { + if (timeout < 1) + { + warning ("waitfor: the timeout value must be >= 1, using 1 instead"); + timeout = 1; + } + } + else + error ("waitfor: invalid timeout value, expected a value >= 1"); + } + else + error ("waitfor: missing timeout value"); + } + + // FIXME: There is still a "hole" in the following loop. The code + // assumes that an object handle is unique, which is a fair + // assumptions, except for figures. If a figure is destroyed + // then recreated with the same figure ID, within the same + // run of event hooks, then the figure destruction won't be + // caught and the loop will not stop. This is an unlikely + // possibility in practice, though. + // + // Using deletefcn callback is also unreliable as it could be + // modified during a callback execution and the waitfor loop + // would not stop. + // + // The only "good" implementation would require object + // listeners, similar to property listeners. + + time_t start = 0; + + if (timeout > 0) + start = time (0); + + while (! error_state) + { + if (true) + { + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + if (! pname.empty () && waitfor_results[id]) + break; + } + else + break; + } + + octave_usleep (100000); + + OCTAVE_QUIT; + + command_editor::run_event_hooks (); + + if (timeout > 0) + { + if (start + timeout < time (0)) + break; + } + } + } + else + error ("waitfor: invalid handle value."); + } + else + print_usage (); + + return octave_value (); +}
--- a/src/graphics.h.in +++ b/src/graphics.h.in @@ -33,6 +33,7 @@ #include <list> #include <map> #include <set> +#include <sstream> #include <string> #include "caseless-str.h" @@ -41,6 +42,7 @@ #include "gripes.h" #include "oct-map.h" #include "oct-mutex.h" +#include "oct-refcount.h" #include "ov.h" #include "txt-eng-ft.h" @@ -220,7 +222,11 @@ { Matrix retval (m.rows (), m.cols ()); - do_scale (m.data (), retval.fortran_vec (), m.numel ()); + if (m.any_element_is_positive ()) + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + else + do_neg_scale (m.data (), retval.fortran_vec (), m.numel ()); + return retval; } @@ -228,7 +234,11 @@ { NDArray retval (m.dims ()); - do_scale (m.data (), retval.fortran_vec (), m.numel ()); + if (m.any_element_is_positive ()) + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + else + do_neg_scale (m.data (), retval.fortran_vec (), m.numel ()); + return retval; } @@ -247,6 +257,12 @@ for (int i = 0; i < n; i++) dest[i] = log10(src[i]); } + + void do_neg_scale (const double *src, double *dest, int n) const + { + for (int i = 0; i < n; i++) + dest[i] = -log10(-src[i]); + } }; class scaler @@ -318,7 +334,7 @@ class property; -enum listener_mode { POSTSET }; +enum listener_mode { POSTSET, PERSISTENT, PREDELETE }; class base_property { @@ -363,7 +379,8 @@ // Sets property value, notifies graphics toolkit. // If do_run is true, runs associated listeners. - bool set (const octave_value& v, bool do_run = true); + OCTINTERP_API bool set (const octave_value& v, bool do_run = true, + bool do_notify_toolkit = true); virtual octave_value get (void) const { @@ -423,7 +440,27 @@ } } else - l.resize (0); + { + if (mode == PERSISTENT) + l.resize (0); + else + { + octave_value_list lnew (0); + octave_value_list& lp = listeners[PERSISTENT]; + for (int i = l.length () - 1; i >= 0 ; i--) + { + for (int j = 0; j < lp.length (); j++) + { + if (l(i).internal_rep () == lp(j).internal_rep ()) + { + lnew.resize (lnew.length () + 1, l(i)); + break; + } + } + } + l = lnew; + } + } } @@ -446,7 +483,7 @@ private: int id; - int count; + octave_refcount<int> count; std::string name; graphics_handle parent; bool hidden; @@ -578,6 +615,8 @@ Cell cell_value (void) const {return Cell (str);} + string_vector string_vector_value (void) const { return str; } + string_array_property& operator = (const octave_value& val) { set (val); @@ -623,6 +662,8 @@ else replace = true; + desired_type = string_t; + if (replace) { str = strings; @@ -652,6 +693,8 @@ } } + desired_type = cell_t; + if (replace) { str = strings; @@ -672,6 +715,178 @@ // --------------------------------------------------------------------- +class text_label_property : public base_property +{ +public: + enum type { char_t, cellstr_t }; + + text_label_property (const std::string& s, const graphics_handle& h, + const std::string& val = "") + : base_property (s, h), value (val), stored_type (char_t) + { } + + text_label_property (const std::string& s, const graphics_handle& h, + const NDArray& nda) + : base_property (s, h), stored_type (char_t) + { + octave_idx_type nel = nda.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + std::ostringstream buf; + buf << nda(i); + value[i] = buf.str (); + } + } + + text_label_property (const std::string& s, const graphics_handle& h, + const Cell& c) + : base_property (s, h), stored_type (cellstr_t) + { + octave_idx_type nel = c.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value tmp = c(i); + + if (tmp.is_string ()) + value[i] = c(i).string_value (); + else + { + double d = c(i).double_value (); + + if (! error_state) + { + std::ostringstream buf; + buf << d; + value[i] = buf.str (); + } + else + break; + } + } + } + + text_label_property (const text_label_property& p) + : base_property (p), value (p.value), stored_type (p.stored_type) + { } + + bool empty (void) const + { + octave_value tmp = get (); + return tmp.is_empty (); + } + + octave_value get (void) const + { + if (stored_type == char_t) + return octave_value (char_value ()); + else + return octave_value (cell_value ()); + } + + std::string string_value (void) const + { + return value.empty () ? std::string () : value[0]; + } + + string_vector string_vector_value (void) const { return value; } + + charMatrix char_value (void) const { return charMatrix (value, ' '); } + + Cell cell_value (void) const {return Cell (value); } + + text_label_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new text_label_property (*this); } + +protected: + + bool do_set (const octave_value& val) + { + if (val.is_string ()) + { + value = val.all_strings (); + + stored_type = char_t; + } + else if (val.is_cell ()) + { + Cell c = val.cell_value (); + + octave_idx_type nel = c.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value tmp = c(i); + + if (tmp.is_string ()) + value[i] = c(i).string_value (); + else + { + double d = c(i).double_value (); + + if (! error_state) + { + std::ostringstream buf; + buf << d; + value[i] = buf.str (); + } + else + return false; + } + } + + stored_type = cellstr_t; + } + else + { + NDArray nda = val.array_value (); + + if (! error_state) + { + octave_idx_type nel = nda.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + std::ostringstream buf; + buf << nda(i); + value[i] = buf.str (); + } + + stored_type = char_t; + } + else + { + error ("set: invalid string property value for \"%s\"", + get_name ().c_str ()); + + return false; + } + } + + return true; + } + +private: + string_vector value; + type stored_type; +}; + +// --------------------------------------------------------------------- + class radio_values { public: @@ -693,11 +908,11 @@ std::string default_value (void) const { return default_val; } - bool validate (const std::string& val) + bool validate (const std::string& val, std::string& match) { bool retval = true; - if (! contains (val)) + if (! contains (val, match)) { error ("invalid value = %s", val.c_str ()); retval = false; @@ -706,9 +921,46 @@ return retval; } - bool contains (const std::string& val) - { - return (possible_vals.find (val) != possible_vals.end ()); + bool contains (const std::string& val, std::string& match) + { + size_t k = 0; + + size_t len = val.length (); + + std::string first_match; + + for (std::set<caseless_str>::const_iterator p = possible_vals.begin (); + p != possible_vals.end (); p++) + { + if (p->compare (val, len)) + { + if (len == p->length ()) + { + // We found a full match (consider the case of val == + // "replace" with possible values "replace" and + // "replacechildren"). Any other matches are + // irrelevant, so set match and return now. + + match = *p; + return true; + } + else + { + if (k == 0) + first_match = *p; + + k++; + } + } + } + + if (k == 1) + { + match = first_match; + return true; + } + else + return false; } std::string values_as_string (void) const; @@ -771,11 +1023,19 @@ if (newval.is_string ()) { std::string s = newval.string_value (); - if (vals.validate (s)) + + std::string match; + + if (vals.validate (s, match)) { - if (s != current_val) + if (match != current_val) { - current_val = s; + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; return true; } } @@ -1095,7 +1355,8 @@ public: array_property (void) : base_property ("", graphics_handle ()), data (Matrix ()), - xmin (), xmax (), xminp (), type_constraints (), size_constraints () + xmin (), xmax (), xminp (), xmaxp (), + type_constraints (), size_constraints () { get_data_limits (); } @@ -1103,7 +1364,8 @@ array_property (const std::string& nm, const graphics_handle& h, const octave_value& m) : base_property (nm, h), data (m), - xmin (), xmax (), xminp (), type_constraints (), size_constraints () + xmin (), xmax (), xminp (), xmaxp (), + type_constraints (), size_constraints () { get_data_limits (); } @@ -1113,7 +1375,7 @@ // copy constraints. array_property (const array_property& p) : base_property (p), data (p.data), - xmin (p.xmin), xmax (p.xmax), xminp (p.xminp), + xmin (p.xmin), xmax (p.xmax), xminp (p.xminp), xmaxp (p.xmaxp), type_constraints (), size_constraints () { } @@ -1128,14 +1390,16 @@ double min_val (void) const { return xmin; } double max_val (void) const { return xmax; } double min_pos (void) const { return xminp; } + double max_neg (void) const { return xmaxp; } Matrix get_limits (void) const { - Matrix m (1, 3); + Matrix m (1, 4); m(0) = min_val (); m(1) = max_val (); m(2) = min_pos (); + m(3) = max_neg (); return m; } @@ -1190,6 +1454,7 @@ double xmin; double xmax; double xminp; + double xmaxp; std::list<std::string> type_constraints; std::list<dim_vector> size_constraints; }; @@ -1451,6 +1716,21 @@ do_delete_children (clear); } + void renumber (graphics_handle old_gh, graphics_handle new_gh) + { + for (children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + { + if (*p == old_gh) + { + *p = new_gh.value (); + return; + } + } + + error ("children_list::renumber: child not found!"); + } + private: typedef std::list<double>::iterator children_list_iterator; typedef std::list<double>::const_iterator const_children_list_iterator; @@ -1567,10 +1847,10 @@ public: callback_property (const std::string& nm, const graphics_handle& h, const octave_value& m) - : base_property (nm, h), callback (m) { } + : base_property (nm, h), callback (m), executing (false) { } callback_property (const callback_property& p) - : base_property (p), callback (p.callback) { } + : base_property (p), callback (p.callback), executing (false) { } octave_value get (void) const { return callback; } @@ -1608,6 +1888,9 @@ private: octave_value callback; + + // If TRUE, we are executing this callback. + mutable bool executing; }; // --------------------------------------------------------------------- @@ -1628,7 +1911,7 @@ ~property (void) { - if (--rep->count <= 0) + if (--rep->count == 0) delete rep; } @@ -1665,8 +1948,9 @@ octave_value get (void) const { return rep->get (); } - bool set (const octave_value& val) - { return rep->set (val); } + bool set (const octave_value& val, bool do_run = true, + bool do_notify_toolkit = true) + { return rep->set (val, do_run, do_notify_toolkit); } std::string values_as_string (void) const { return rep->values_as_string (); } @@ -1682,7 +1966,7 @@ property& operator = (const property& p) { - if (rep && --rep->count <= 0) + if (rep && --rep->count == 0) delete rep; rep = p.rep; @@ -1835,10 +2119,10 @@ // Callback function executed when the given graphics object is // created. This allows the graphics toolkit to do toolkit-specific // initializations for a newly created object. - virtual void initialize (const graphics_object&) - { gripe_invalid ("base_graphics_toolkit::initialize"); } - - void initialize (const graphics_handle&); + virtual bool initialize (const graphics_object&) + { gripe_invalid ("base_graphics_toolkit::initialize"); return false; } + + bool initialize (const graphics_handle&); // Callback function executed just prior to deleting the given // graphics object. This allows the graphics toolkit to perform @@ -1848,9 +2132,13 @@ void finalize (const graphics_handle&); + // Close the graphics toolkit. + virtual void close (void) + { gripe_invalid ("base_graphics_toolkit::close"); } + private: std::string name; - int count; + octave_refcount<int> count; private: void gripe_invalid (const std::string& fname) const @@ -1930,11 +2218,11 @@ { rep->update (h, id); } // Notifies graphics toolkit that new object was created. - void initialize (const graphics_object& go) - { rep->initialize (go); } - - void initialize (const graphics_handle& h) - { rep->initialize (h); } + bool initialize (const graphics_object& go) + { return rep->initialize (go); } + + bool initialize (const graphics_handle& h) + { return rep->initialize (h); } // Notifies graphics toolkit that object was destroyed. // This is called only for explicitly deleted object. Children are @@ -1945,53 +2233,206 @@ void finalize (const graphics_handle& h) { rep->finalize (h); } - OCTINTERP_API static graphics_toolkit default_toolkit (void); - - static void register_toolkit (const graphics_toolkit& b) - { available_toolkits[b.get_name ()] = b; } + // Close the graphics toolkit. + void close (void) { rep->close (); } + +private: + + base_graphics_toolkit *rep; +}; + +class gtk_manager +{ +public: + + static graphics_toolkit get_toolkit (void) + { + return instance_ok () ? instance->do_get_toolkit () : graphics_toolkit (); + } + + static void register_toolkit (const std::string& name) + { + if (instance_ok ()) + instance->do_register_toolkit (name); + } static void unregister_toolkit (const std::string& name) - { available_toolkits.erase (name); } + { + if (instance_ok ()) + instance->do_unregister_toolkit (name); + } + + static void load_toolkit (const graphics_toolkit& tk) + { + if (instance_ok ()) + instance->do_load_toolkit (tk); + } + + static void unload_toolkit (const std::string& name) + { + if (instance_ok ()) + instance->do_unload_toolkit (name); + } static graphics_toolkit find_toolkit (const std::string& name) { - const_available_toolkits_iterator p = available_toolkits.find (name); - - if (p != available_toolkits.end ()) - return p->second; - else - return default_toolkit (); + return instance_ok () + ? instance->do_find_toolkit (name) : graphics_toolkit (); } static Cell available_toolkits_list (void) { + return instance_ok () ? instance->do_available_toolkits_list () : Cell (); + } + + static Cell loaded_toolkits_list (void) + { + return instance_ok () ? instance->do_loaded_toolkits_list () : Cell (); + } + + static void unload_all_toolkits (void) + { + if (instance_ok ()) + instance->do_unload_all_toolkits (); + } + + static std::string default_toolkit (void) + { + return instance_ok () ? instance->do_default_toolkit () : std::string (); + } + +private: + + // FIXME -- default toolkit should be configurable. + + gtk_manager (void) + : dtk ("gnuplot"), available_toolkits (), loaded_toolkits () { } + + ~gtk_manager (void) { } + + static void create_instance (void); + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + create_instance (); + + if (! instance) + { + ::error ("unable to create gh_manager!"); + + retval = false; + } + + return retval; + } + + static void cleanup_instance (void) { delete instance; instance = 0; } + + static gtk_manager *instance; + + // The name of the default toolkit. + std::string dtk; + + // The list of toolkits that we know about. + std::set<std::string> available_toolkits; + + // The list of toolkits we have actually loaded. + std::map<std::string, graphics_toolkit> loaded_toolkits; + + typedef std::set<std::string>::iterator available_toolkits_iterator; + + typedef std::set<std::string>::const_iterator + const_available_toolkits_iterator; + + typedef std::map<std::string, graphics_toolkit>::iterator + loaded_toolkits_iterator; + + typedef std::map<std::string, graphics_toolkit>::const_iterator + const_loaded_toolkits_iterator; + + graphics_toolkit do_get_toolkit (void) const; + + void do_register_toolkit (const std::string& name) + { + available_toolkits.insert (name); + } + + void do_unregister_toolkit (const std::string& name) + { + available_toolkits.erase (name); + } + + void do_load_toolkit (const graphics_toolkit& tk) + { + loaded_toolkits[tk.get_name ()] = tk; + } + + void do_unload_toolkit (const std::string& name) + { + loaded_toolkits.erase (name); + } + + graphics_toolkit do_find_toolkit (const std::string& name) const + { + const_loaded_toolkits_iterator p = loaded_toolkits.find (name); + + if (p != loaded_toolkits.end ()) + return p->second; + else + return graphics_toolkit (); + } + + Cell do_available_toolkits_list (void) const + { Cell m (1 , available_toolkits.size ()); - const_available_toolkits_iterator p; - int i; - - for (i = 0, p = available_toolkits.begin (); - p != available_toolkits.end (); p++, i++) - m(i) = p->first; + + octave_idx_type i = 0; + for (const_available_toolkits_iterator p = available_toolkits.begin (); + p != available_toolkits.end (); p++) + m(i++) = *p; return m; } -private: - base_graphics_toolkit *rep; - - static OCTINTERP_API std::map<std::string, graphics_toolkit> - available_toolkits; - - typedef std::map<std::string, graphics_toolkit>::iterator - available_toolkits_iterator; - - typedef std::map<std::string, graphics_toolkit>::const_iterator - const_available_toolkits_iterator; + Cell do_loaded_toolkits_list (void) const + { + Cell m (1 , loaded_toolkits.size ()); + + octave_idx_type i = 0; + for (const_loaded_toolkits_iterator p = loaded_toolkits.begin (); + p != loaded_toolkits.end (); p++) + m(i++) = p->first; + + return m; + } + + void do_unload_all_toolkits (void) + { + while (! loaded_toolkits.empty ()) + { + loaded_toolkits_iterator p = loaded_toolkits.begin (); + + std::string name = p->first; + + p->second.close (); + + // The toolkit may have unloaded itself. If not, we'll do + // it here. + if (loaded_toolkits.find (name) != loaded_toolkits.end ()) + unload_toolkit (name); + } + } + + std::string do_default_toolkit (void) { return dtk; } }; // --------------------------------------------------------------------- class base_graphics_object; +class graphics_object; class OCTINTERP_API base_properties { @@ -2008,6 +2449,11 @@ void override_defaults (base_graphics_object& obj); + virtual void init_integerhandle (const octave_value&) + { + panic_impossible (); + } + // Look through DEFAULTS for properties with given CLASS_NAME, and // apply them to the current object with set (virtual method). @@ -2060,7 +2506,8 @@ virtual graphics_toolkit get_toolkit (void) const; - virtual Matrix get_boundingbox (bool /*internal*/ = false) const + virtual Matrix get_boundingbox (bool /*internal*/ = false, + const Matrix& /*parent_pix_size*/ = Matrix ()) const { return Matrix (1, 4, 0.0); } virtual void update_boundingbox (void); @@ -2111,6 +2558,16 @@ children.delete_children (clear); } + void renumber_child (graphics_handle old_gh, graphics_handle new_gh) + { + children.renumber (old_gh, new_gh); + } + + void renumber_parent (graphics_handle new_gh) + { + parent = new_gh; + } + static property_list::pval_map_type factory_defaults (void); // FIXME -- these functions should be generated automatically by the @@ -2130,10 +2587,7 @@ virtual bool is_climinclude (void) const { return false; } virtual bool is_aliminclude (void) const { return false; } - bool is_handle_visible (void) const - { - return ! handlevisibility.is ("off"); - } + bool is_handle_visible (void) const; std::set<std::string> dynamic_property_names (void) const; @@ -2204,7 +2658,7 @@ public: friend class graphics_object; - base_graphics_object (void) : count (1) { } + base_graphics_object (void) : count (1), toolkit_flag (false) { } virtual ~base_graphics_object (void) { } @@ -2365,6 +2819,8 @@ virtual bool valid_object (void) const { return false; } + bool valid_toolkit_object (void) const { return toolkit_flag; } + virtual std::string type (void) const { return (valid_object () ? get_properties ().graphics_object_name () @@ -2417,14 +2873,43 @@ } protected: + virtual void initialize (const graphics_object& go) + { + if (! toolkit_flag) + toolkit_flag = get_toolkit ().initialize (go); + } + + virtual void finalize (const graphics_object& go) + { + if (toolkit_flag) + { + get_toolkit ().finalize (go); + toolkit_flag = false; + } + } + + virtual void update (const graphics_object& go, int id) + { + if (toolkit_flag) + get_toolkit ().update (go, id); + } + +protected: // A reference count. - int count; + octave_refcount<int> count; + + // A flag telling whether this object is a valid object + // in the backend context. + bool toolkit_flag; // No copying! - base_graphics_object (const base_graphics_object&); - - base_graphics_object& operator = (const base_graphics_object&); + base_graphics_object (const base_graphics_object&) : count (0) { } + + base_graphics_object& operator = (const base_graphics_object&) + { + return *this; + } }; class OCTINTERP_API graphics_object @@ -2615,6 +3100,12 @@ listener_mode mode = POSTSET) { rep->delete_property_listener (nm, v, mode); } + void initialize (void) { rep->initialize (*this); } + + void finalize (void) { rep->finalize (*this); } + + void update (int id) { rep->update (*this, id); } + void reset_default_properties (void) { rep->reset_default_properties (); } @@ -2676,7 +3167,7 @@ root_figure (void) : xproperties (0, graphics_handle ()), default_properties () { } - ~root_figure (void) { xproperties.delete_children (); } + ~root_figure (void) { } void mark_modified (void) { } @@ -2775,6 +3266,11 @@ class OCTINTERP_API properties : public base_properties { public: + void init_integerhandle (const octave_value& val) + { + integerhandle = val; + } + void remove_child (const graphics_handle& h); void set_visible (const octave_value& val); @@ -2782,20 +3278,12 @@ graphics_toolkit get_toolkit (void) const { if (! toolkit) - toolkit = graphics_toolkit::default_toolkit (); + toolkit = gtk_manager::get_toolkit (); return toolkit; } - void set_toolkit (const graphics_toolkit& b) - { - if (toolkit) - toolkit.finalize (__myhandle__); - toolkit = b; - __graphics_toolkit__ = b.get_name (); - __plot_stream__ = Matrix (); - mark_modified (); - } + void set_toolkit (const graphics_toolkit& b); void set___graphics_toolkit__ (const octave_value& val) { @@ -2804,7 +3292,7 @@ if (val.is_string ()) { std::string nm = val.string_value (); - graphics_toolkit b = graphics_toolkit::find_toolkit (nm); + graphics_toolkit b = gtk_manager::find_toolkit (nm); if (b.get_name () != nm) { error ("set___graphics_toolkit__: invalid graphics toolkit"); @@ -2820,9 +3308,21 @@ } } - Matrix get_boundingbox (bool internal = false) const; - - void set_boundingbox (const Matrix& bb); + void set_position (const octave_value& val, + bool do_notify_toolkit = true); + + void set_outerposition (const octave_value& val, + bool do_notify_toolkit = true); + + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + void set_boundingbox (const Matrix& bb, bool internal = false, + bool do_notify_toolkit = true); + + Matrix map_from_boundingbox (double x, double y) const; + + Matrix map_to_boundingbox (double x, double y) const; void update_units (const caseless_str& old_units); @@ -2849,7 +3349,7 @@ bool_property dockcontrols , "off" bool_property doublebuffer , "on" string_property filename , "" - bool_property integerhandle , "on" + bool_property integerhandle S , "on" bool_property inverthardcopy , "off" callback_property keypressfcn , Matrix () callback_property keyreleasefcn , Matrix () @@ -2857,6 +3357,7 @@ double_property mincolormap , 64 string_property name , "" bool_property numbertitle , "on" + array_property outerposition s , Matrix (1, 4, -1.0) radio_property paperunits Su , "{inches}|centimeters|normalized|points" array_property paperposition , default_figure_paperposition () radio_property paperpositionmode , "auto|{manual}" @@ -2865,7 +3366,7 @@ radio_property pointer , "crosshair|fullcrosshair|{arrow}|ibeam|watch|topl|topr|botl|botr|left|top|right|bottom|circle|cross|fleur|custom|hand" array_property pointershapecdata , Matrix (16, 16, 0) array_property pointershapehotspot , Matrix (1, 2, 0) - array_property position S , default_figure_position () + array_property position s , default_figure_position () radio_property renderer , "{painters}|zbuffer|opengl|none" radio_property renderermode , "{auto}|manual" bool_property resize , "on" @@ -2885,6 +3386,7 @@ radio_property xvisualmode , "{auto}|manual" callback_property buttondownfcn , Matrix () string_property __graphics_toolkit__ s , "gnuplot" + any_property __guidata__ h , Matrix () END_PROPERTIES protected: @@ -2896,6 +3398,7 @@ pointershapecdata.add_constraint (dim_vector (16, 16)); pointershapehotspot.add_constraint (dim_vector (1, 2)); position.add_constraint (dim_vector (1, 4)); + outerposition.add_constraint (dim_vector (1, 4)); } private: @@ -2912,10 +3415,7 @@ xproperties.override_defaults (*this); } - ~figure (void) - { - xproperties.delete_children (); - } + ~figure (void) { } void override_defaults (base_graphics_object& obj) { @@ -3076,9 +3576,12 @@ const scaler& get_y_scaler (void) const { return sy; } const scaler& get_z_scaler (void) const { return sz; } - Matrix get_boundingbox (bool internal = false) const; + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; Matrix get_extent (bool with_text = false, bool only_text_height=false) const; + double get_fontsize_points (double box_pix_height = 0) const; + void update_boundingbox (void) { if (units_is ("normalized")) @@ -3186,6 +3689,11 @@ bool x2Dtop, y2Dright, layer2Dtop; bool xySym, xyzSym, zSign, nearhoriz; +#if HAVE_FREETYPE + // freetype renderer, used for calculation of text (tick labels) size + ft_render text_renderer; +#endif + void set_text_child (handle_property& h, const std::string& who, const octave_value& v); @@ -3213,10 +3721,10 @@ radio_property zlimmode al , "{auto}|manual" radio_property climmode al , "{auto}|manual" radio_property alimmode , "{auto}|manual" - handle_property xlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false) - handle_property ylabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false) - handle_property zlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false) - handle_property title SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false) + handle_property xlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property ylabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property zlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property title SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) bool_property xgrid , "off" bool_property ygrid , "off" bool_property zgrid , "off" @@ -3268,11 +3776,11 @@ radio_property cameraviewanglemode , "{auto}|manual" array_property currentpoint , Matrix (2, 3, 0.0) radio_property drawmode , "{normal}|fast" - radio_property fontangle , "{normal}|italic|oblique" - string_property fontname , OCTAVE_DEFAULT_FONTNAME - double_property fontsize , 10 + radio_property fontangle u , "{normal}|italic|oblique" + string_property fontname u , OCTAVE_DEFAULT_FONTNAME + double_property fontsize u , 10 radio_property fontunits SU , "{points}|normalized|inches|centimeters|pixels" - radio_property fontweight , "{normal}|light|demi|bold" + radio_property fontweight u , "{normal}|light|demi|bold" radio_property gridlinestyle , "-|--|{:}|-.|none" string_array_property linestyleorder , "-" double_property linewidth , 0.5 @@ -3298,6 +3806,8 @@ row_vector_property zmtick h , Matrix () // hidden properties for inset array_property looseinset hu , Matrix (1, 4, 0.0) + // hidden properties for alignment of subplots + radio_property autopos_tag h , "{none}|subplot" END_PROPERTIES protected: @@ -3391,7 +3901,15 @@ calc_ticklabels (ztick, zticklabel, zscale.is ("log")); } + void update_font (void); + void update_fontname (void) { update_font (); } + void update_fontsize (void) { update_font (); } + void update_fontangle (void) { update_font (); } + void update_fontweight (void) { update_font (); } + + void sync_positions (const Matrix& linset); void sync_positions (void); + void update_outerposition (void) { set_activepositionproperty ("outerposition"); @@ -3437,7 +3955,9 @@ Matrix calc_tightbox (const Matrix& init_pos); public: - Matrix get_axis_limits (double xmin, double xmax, double min_pos, bool logscale); + Matrix get_axis_limits (double xmin, double xmax, + double min_pos, double max_neg, + bool logscale); void update_xlim (bool do_clr_zoom = true) { @@ -3496,7 +4016,7 @@ xproperties.update_transform (); } - ~axes (void) { xproperties.delete_children (); } + ~axes (void) { } void override_defaults (base_graphics_object& obj) { @@ -3562,6 +4082,9 @@ void reset_default_properties (void); +protected: + void initialize (const graphics_object& go); + private: property_list default_properties; }; @@ -3630,7 +4153,7 @@ xproperties.override_defaults (*this); } - ~line (void) { xproperties.delete_children (); } + ~line (void) { } base_properties& get_properties (void) { return xproperties; } @@ -3647,11 +4170,13 @@ class OCTINTERP_API properties : public base_properties { public: + double get_fontsize_points (double box_pix_height = 0) const; + // See the genprops.awk script for an explanation of the // properties declarations. BEGIN_PROPERTIES (text) - string_property string u , "" + text_label_property string u , "" radio_property units u , "{data}|pixels|normalized|inches|centimeters|points" array_property position mu , Matrix (1, 3, 0.0) double_property rotation mu , 0 @@ -3692,7 +4217,7 @@ Matrix get_extent_matrix (void) const; const uint8NDArray& get_pixels (void) const { return pixels; } #if HAVE_FREETYPE - // freetype render, used for text rendering + // freetype renderer, used for calculation of text size ft_render renderer; #endif @@ -3702,6 +4227,7 @@ position.add_constraint (dim_vector (1, 2)); position.add_constraint (dim_vector (1, 3)); cached_units = get_units (); + update_font (); } private: @@ -3737,13 +4263,14 @@ void update_horizontalalignmentmode (void) { request_autopos (); } void update_verticalalignmentmode (void) { request_autopos (); } + void update_font (void); void update_string (void) { request_autopos (); update_text_extent (); } void update_rotation (void) { update_text_extent (); } - void update_color (void) { update_text_extent (); } - void update_fontname (void) { update_text_extent (); } - void update_fontsize (void) { update_text_extent (); } - void update_fontangle (void) { update_text_extent (); } - void update_fontweight (void) { update_text_extent (); } + void update_color (void) { update_font (); } + void update_fontname (void) { update_font (); update_text_extent (); } + void update_fontsize (void) { update_font (); update_text_extent (); } + void update_fontangle (void) { update_font (); update_text_extent (); } + void update_fontweight (void) { update_font (); update_text_extent (); } void update_interpreter (void) { update_text_extent (); } void update_horizontalalignment (void) { update_text_extent (); } void update_verticalalignment (void) { update_text_extent (); } @@ -3766,7 +4293,7 @@ xproperties.override_defaults (*this); } - ~text (void) { xproperties.delete_children (); } + ~text (void) { } base_properties& get_properties (void) { return xproperties; } @@ -3890,7 +4417,7 @@ xproperties.override_defaults (*this); } - ~image (void) { xproperties.delete_children (); } + ~image (void) { } base_properties& get_properties (void) { return xproperties; } @@ -3934,7 +4461,7 @@ array_property vertices , Matrix () array_property vertexnormals , Matrix () radio_property normalmode , "{auto}|manual" - color_property facecolor , "{flat}|none|interp" + color_property facecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) radio_property facelighting , "flat|{none}|gouraud|phong" color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) @@ -4008,7 +4535,7 @@ xproperties.override_defaults (*this); } - ~patch (void) { xproperties.delete_children (); } + ~patch (void) { } base_properties& get_properties (void) { return xproperties; } @@ -4050,7 +4577,7 @@ string_property ydatasource , "" string_property zdatasource , "" string_property cdatasource , "" - color_property facecolor , "{flat}|none|interp|texturemap" + color_property facecolor , "{flat}|none|interp" double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) radio_property linestyle , "{-}|--|:|-.|none" @@ -4161,7 +4688,7 @@ xproperties.override_defaults (*this); } - ~surface (void) { xproperties.delete_children (); } + ~surface (void) { } base_properties& get_properties (void) { return xproperties; } @@ -4229,7 +4756,7 @@ xproperties.override_defaults (*this); } - ~hggroup (void) { xproperties.delete_children (); } + ~hggroup (void) { } base_properties& get_properties (void) { return xproperties; } @@ -4266,6 +4793,7 @@ // properties declarations. BEGIN_PROPERTIES (uimenu) + any_property __object__ , Matrix () string_property accelerator , "" callback_property callback , Matrix() bool_property checked , "off" @@ -4292,7 +4820,402 @@ xproperties.override_defaults (*this); } - ~uimenu (void) { xproperties.delete_children (); } + ~uimenu (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uicontextmenu : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uicontextmenu) + any_property __object__ , Matrix () + callback_property callback , Matrix() + array_property position , Matrix (1, 2, 0.0) + END_PROPERTIES + + protected: + void init (void) + { + position.add_constraint (dim_vector (1, 2)); + position.add_constraint (dim_vector (2, 1)); + visible.set (octave_value (true)); + } + }; + +private: + properties xproperties; + +public: + uicontextmenu (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uicontextmenu (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uicontrol : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + double get_fontsize_points (double box_pix_height = 0) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uicontrol) + any_property __object__ , Matrix () + color_property backgroundcolor , color_values (1, 1, 1) + callback_property callback , Matrix () + array_property cdata , Matrix () + bool_property clipping , "on" + radio_property enable , "{on}|inactive|off" + array_property extent rG , Matrix (1, 4, 0.0) + radio_property fontangle u , "{normal}|italic|oblique" + string_property fontname u , OCTAVE_DEFAULT_FONTNAME + double_property fontsize u , 10 + radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" + radio_property fontweight u , "light|{normal}|demi|bold" + color_property foregroundcolor , color_values (0, 0, 0) + radio_property horizontalalignment , "{left}|center|right" + callback_property keypressfcn , Matrix () + double_property listboxtop , 1 + double_property max , 1 + double_property min , 0 + array_property position , default_control_position () + array_property sliderstep , default_control_sliderstep () + string_array_property string u , "" + radio_property style S , "{pushbutton}|togglebutton|radiobutton|checkbox|edit|text|slider|frame|listbox|popupmenu" + string_property tooltipstring , "" + radio_property units u , "normalized|inches|centimeters|points|{pixels}|characters" + row_vector_property value , Matrix (1, 1, 1.0) + radio_property verticalalignment , "top|{middle}|bottom" + END_PROPERTIES + + private: + std::string cached_units; + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + position.add_constraint (dim_vector (1, 4)); + sliderstep.add_constraint (dim_vector (1, 2)); + cached_units = get_units (); + } + + void update_text_extent (void); + + void update_string (void) { update_text_extent (); } + void update_fontname (void) { update_text_extent (); } + void update_fontsize (void) { update_text_extent (); } + void update_fontangle (void) { update_text_extent (); } + void update_fontweight (void) { update_text_extent (); } + void update_fontunits (const caseless_str& old_units); + + void update_units (void); + + }; + +private: + properties xproperties; + +public: + uicontrol (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uicontrol (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uipanel : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + double get_fontsize_points (double box_pix_height = 0) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uipanel) + any_property __object__ , Matrix () + color_property backgroundcolor , color_values (1, 1, 1) + radio_property bordertype , "none|{etchedin}|etchedout|beveledin|beveledout|line" + double_property borderwidth , 1 + radio_property fontangle , "{normal}|italic|oblique" + string_property fontname , OCTAVE_DEFAULT_FONTNAME + double_property fontsize , 10 + radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" + radio_property fontweight , "light|{normal}|demi|bold" + color_property foregroundcolor , color_values (0, 0, 0) + color_property highlightcolor , color_values (1, 1, 1) + array_property position , default_panel_position () + callback_property resizefcn , Matrix () + color_property shadowcolor , color_values (0, 0, 0) + string_property title , "" + radio_property titleposition , "{lefttop}|centertop|righttop|leftbottom|centerbottom|rightbottom" + radio_property units S , "{normalized}|inches|centimeters|points|pixels|characters" + END_PROPERTIES + + protected: + void init (void) + { + position.add_constraint (dim_vector (1, 4)); + } + + void update_units (const caseless_str& old_units); + void update_fontunits (const caseless_str& old_units); + + }; + +private: + properties xproperties; + +public: + uipanel (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uipanel (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uitoolbar : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uitoolbar) + any_property __object__ , Matrix () + END_PROPERTIES + + protected: + void init (void) + { } + }; + +private: + properties xproperties; + +public: + uitoolbar (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p), default_properties () + { + xproperties.override_defaults (*this); + } + + ~uitoolbar (void) { } + + void override_defaults (base_graphics_object& obj) + { + // Allow parent (figure) to override first (properties knows how + // to find the parent object). + xproperties.override_defaults (obj); + + // Now override with our defaults. If the default_properties + // list includes the properties for all defaults (line, + // surface, etc.) then we don't have to know the type of OBJ + // here, we just call its set function and let it decide which + // properties from the list to use. + obj.set_from_list (default_properties); + } + + void set (const caseless_str& name, const octave_value& value) + { + if (name.compare ("default", 7)) + // strip "default", pass rest to function that will + // parse the remainder and add the element to the + // default_properties map. + default_properties.set (name.substr (7), value); + else + xproperties.set (name, value); + } + + octave_value get (const caseless_str& name) const + { + octave_value retval; + + if (name.compare ("default", 7)) + retval = get_default (name.substr (7)); + else + retval = xproperties.get (name); + + return retval; + } + + octave_value get_default (const caseless_str& name) const; + + octave_value get_defaults (void) const + { + return default_properties.as_struct ("default"); + } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + + void reset_default_properties (void); + +private: + property_list default_properties; +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uipushtool : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uipushtool) + any_property __object__ , Matrix () + array_property cdata , Matrix () + callback_property clickedcallback , Matrix() + bool_property enable , "on" + bool_property separator , "off" + string_property tooltipstring , "" + END_PROPERTIES + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + }; + +private: + properties xproperties; + +public: + uipushtool (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uipushtool (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uitoggletool : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uitoggletool) + any_property __object__ , Matrix () + array_property cdata , Matrix () + callback_property clickedcallback , Matrix() + bool_property enable , "on" + callback_property offcallback , Matrix() + callback_property oncallback , Matrix() + bool_property separator , "off" + bool_property state , "off" + string_property tooltipstring , "" + END_PROPERTIES + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + }; + +private: + properties xproperties; + +public: + uitoggletool (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uitoggletool (void) { } base_properties& get_properties (void) { return xproperties; } @@ -4328,7 +5251,7 @@ virtual void execute (void) = 0; private: - int count; + octave_refcount<int> count; }; class @@ -4375,14 +5298,19 @@ create_callback_event (const graphics_handle& h, const std::string& name, const octave_value& data = Matrix ()); + + static graphics_event + create_callback_event (const graphics_handle& h, + const octave_value& cb, + const octave_value& data = Matrix ()); static graphics_event create_function_event (event_fcn fcn, void *data = 0); static graphics_event - create_set_event (const graphics_handle& h, - const std::string& name, - const octave_value& value); + create_set_event (const graphics_handle& h, const std::string& name, + const octave_value& value, + bool notify_toolkit = true); private: base_graphics_event *rep; }; @@ -4395,12 +5323,14 @@ public: + static void create_instance (void); + static bool instance_ok (void) { bool retval = true; if (! instance) - instance = new gh_manager (); + create_instance (); if (! instance) { @@ -4412,12 +5342,27 @@ return retval; } + static void cleanup_instance (void) { delete instance; instance = 0; } + + static graphics_handle get_handle (bool integer_figure_handle) + { + return instance_ok () + ? instance->do_get_handle (integer_figure_handle) : graphics_handle (); + } + static void free (const graphics_handle& h) { if (instance_ok ()) instance->do_free (h); } + static void renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh) + { + if (instance_ok ()) + instance->do_renumber_figure (old_gh, new_gh); + } + static graphics_handle lookup (double val) { return instance_ok () ? instance->do_lookup (val) : graphics_handle (); @@ -4441,17 +5386,24 @@ static graphics_handle make_graphics_handle (const std::string& go_name, - const graphics_handle& parent, bool do_createfcn = true) + const graphics_handle& parent, + bool integer_figure_handle = false, + bool do_createfcn = true, + bool do_notify_toolkit = true) { return instance_ok () - ? instance->do_make_graphics_handle (go_name, parent, do_createfcn) + ? instance->do_make_graphics_handle (go_name, parent, + integer_figure_handle, + do_createfcn, do_notify_toolkit) : graphics_handle (); } - static graphics_handle make_figure_handle (double val) + static graphics_handle make_figure_handle (double val, + bool do_notify_toolkit = true) { return instance_ok () - ? instance->do_make_figure_handle (val) : graphics_handle (); + ? instance->do_make_figure_handle (val, do_notify_toolkit) + : graphics_handle (); } static void push_figure (const graphics_handle& h) @@ -4472,9 +5424,10 @@ ? instance->do_current_figure () : graphics_handle (); } - static Matrix handle_list (void) - { - return instance_ok () ? instance->do_handle_list () : Matrix (); + static Matrix handle_list (bool show_hidden = false) + { + return instance_ok () + ? instance->do_handle_list (show_hidden) : Matrix (); } static void lock (void) @@ -4483,30 +5436,51 @@ instance->do_lock (); } + static bool try_lock (void) + { + if (instance_ok ()) + return instance->do_try_lock (); + else + return false; + } + static void unlock (void) { if (instance_ok ()) instance->do_unlock (); } - - static Matrix figure_handle_list (void) - { - return instance_ok () ? instance->do_figure_handle_list () : Matrix (); + + static Matrix figure_handle_list (bool show_hidden = false) + { + return instance_ok () + ? instance->do_figure_handle_list (show_hidden) : Matrix (); + } + + static void execute_listener (const graphics_handle& h, + const octave_value& l) + { + if (instance_ok ()) + instance->do_execute_listener (h, l); } static void execute_callback (const graphics_handle& h, const std::string& name, const octave_value& data = Matrix ()) { - graphics_object go = get_object (h); - - if (go.valid_object ()) + octave_value cb; + + if (true) { - octave_value cb = go.get (name); - - if (! error_state) - execute_callback (h, cb, data); + gh_manager::auto_lock lock; + + graphics_object go = get_object (h); + + if (go.valid_object ()) + cb = go.get (name); } + + if (! error_state) + execute_callback (h, cb, data); } static void execute_callback (const graphics_handle& h, @@ -4524,19 +5498,18 @@ if (instance_ok ()) instance->do_post_callback (h, name, data); } - + static void post_function (graphics_event::event_fcn fcn, void* data = 0) { if (instance_ok ()) instance->do_post_function (fcn, data); } - static void post_set (const graphics_handle& h, - const std::string& name, - const octave_value& value) + static void post_set (const graphics_handle& h, const std::string& name, + const octave_value& value, bool notify_toolkit = true) { if (instance_ok ()) - instance->do_post_set (h, name, value); + instance->do_post_set (h, name, value, notify_toolkit); } static int process_events (void) @@ -4549,6 +5522,12 @@ return (instance_ok () ? instance->do_process_events (true) : 0); } + static void enable_event_processing (bool enable = true) + { + if (instance_ok ()) + instance->do_enable_event_processing (enable); + } + static bool is_handle_visible (const graphics_handle& h) { bool retval = false; @@ -4561,19 +5540,28 @@ return retval; } + static void close_all_figures (void) + { + if (instance_ok ()) + instance->do_close_all_figures (); + } + public: - class autolock + class auto_lock : public octave_autolock { public: - autolock (void) { lock (); } - - ~autolock (void) { unlock (); } + auto_lock (bool wait = true) + : octave_autolock (instance_ok () + ? instance->graphics_lock + : octave_mutex (), + wait) + { } private: // No copying! - autolock (const autolock&); - autolock& operator = (const autolock&); + auto_lock (const auto_lock&); + auto_lock& operator = (const auto_lock&); }; private: @@ -4611,10 +5599,16 @@ // The stack of callback objects. std::list<graphics_object> callback_objects; - graphics_handle get_handle (const std::string& go_name); + // A flag telling whether event processing must be constantly on. + int event_processing; + + graphics_handle do_get_handle (bool integer_figure_handle); void do_free (const graphics_handle& h); + void do_renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh); + graphics_handle do_lookup (double val) { iterator p = (xisnan (val) ? handle_map.end () : handle_map.find (val)); @@ -4630,33 +5624,48 @@ } graphics_handle do_make_graphics_handle (const std::string& go_name, - const graphics_handle& p, bool do_createfcn); - - graphics_handle do_make_figure_handle (double val); - - Matrix do_handle_list (void) + const graphics_handle& p, + bool integer_figure_handle, + bool do_createfcn, + bool do_notify_toolkit); + + graphics_handle do_make_figure_handle (double val, bool do_notify_toolkit); + + Matrix do_handle_list (bool show_hidden) { Matrix retval (1, handle_map.size ()); + octave_idx_type i = 0; for (const_iterator p = handle_map.begin (); p != handle_map.end (); p++) { graphics_handle h = p->first; - retval(i++) = h.value (); + + if (show_hidden || is_handle_visible (h)) + retval(i++) = h.value (); } + + retval.resize (1, i); + return retval; } - Matrix do_figure_handle_list (void) + Matrix do_figure_handle_list (bool show_hidden) { Matrix retval (1, figure_list.size ()); + octave_idx_type i = 0; for (const_figure_list_iterator p = figure_list.begin (); p != figure_list.end (); p++) { graphics_handle h = *p; - retval(i++) = h.value (); + + if (show_hidden || is_handle_visible (h)) + retval(i++) = h.value (); } + + retval.resize (1, i); + return retval; } @@ -4666,26 +5675,44 @@ graphics_handle do_current_figure (void) const { - return figure_list.empty () ? graphics_handle () : figure_list.front (); + graphics_handle retval; + + for (const_figure_list_iterator p = figure_list.begin (); + p != figure_list.end (); + p++) + { + graphics_handle h = *p; + + if (is_handle_visible (h)) + retval = h; + } + + return retval; } void do_lock (void) { graphics_lock.lock (); } + bool do_try_lock (void) { return graphics_lock.try_lock (); } + void do_unlock (void) { graphics_lock.unlock (); } + void do_execute_listener (const graphics_handle& h, const octave_value& l); + void do_execute_callback (const graphics_handle& h, const octave_value& cb, const octave_value& data); void do_post_callback (const graphics_handle& h, const std::string name, const octave_value& data); - + void do_post_function (graphics_event::event_fcn fcn, void* fcn_data); void do_post_set (const graphics_handle& h, const std::string name, - const octave_value& value); + const octave_value& value, bool notify_toolkit = true); int do_process_events (bool force = false); + void do_close_all_figures (void); + static void restore_gcbo (void) { if (instance_ok ()) @@ -4695,9 +5722,12 @@ void do_restore_gcbo (void); void do_post_event (const graphics_event& e); + + void do_enable_event_processing (bool enable = true); }; -void get_children_limits (double& min_val, double& max_val, double& min_pos, +void get_children_limits (double& min_val, double& max_val, + double& min_pos, double& max_neg, const Matrix& kids, char limit_type); OCTINTERP_API int calc_dimensions (const graphics_object& gh); @@ -4708,4 +5738,6 @@ // This function is NOT equivalent to the scripting language function gca. OCTINTERP_API graphics_handle gca (void); +OCTINTERP_API void close_all_figures (void); + #endif
--- a/src/help.cc +++ b/src/help.cc @@ -99,133 +99,331 @@ return z; } -// FIXME -- The descriptions could easily be in texinfo -- should they? const static pair_type operators[] = { pair_type ("!", - "Logical not operator. See also `~'.\n"), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} !\n\ +Logical 'not' operator.\n\ +@seealso{~, not}\n\ +@end deftypefn"), + + pair_type ("~", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ~\n\ +Logical 'not' operator.\n\ +@seealso{!, not}\n\ +@end deftypefn"), pair_type ("!=", - "Logical not equals operator. See also `~='.\n"), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} !=\n\ +Logical 'not equals' operator.\n\ +@seealso{~=, ne}\n\ +@end deftypefn"), + + pair_type ("~=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ~=\n\ +Logical 'not equals' operator.\n\ +@seealso{!=, ne}\n\ +@end deftypefn"), pair_type ("\"", - "String delimiter.\n"), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} \"\n\ +String delimiter.\n\ +@end deftypefn"), pair_type ("#", - "Begin comment character. See also `%'."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} #\n\ +Begin comment character.\n\ +@seealso{%, #@{}\n\ +@end deftypefn"), pair_type ("%", - "Begin comment charcter. See also `#'."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} %\n\ +Begin comment character.\n\ +@seealso{#, %@{}\n\ +@end deftypefn"), + + pair_type ("#{", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} #@{\n\ +Begin block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{#@{}.\n\ +It is possible to nest block comments.\n\ +@seealso{%@{, #@}, #}\n\ +@end deftypefn"), + + pair_type ("%{", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} %@{\n\ +Begin block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{%@{}.\n\ +It is possible to nest block comments.\n\ +@seealso{#@{, %@}, %}\n\ +@end deftypefn"), + + pair_type ("#}", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} #@}\n\ +Close block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{#@}}.\n\ +It is possible to nest block comments.\n\ +@seealso{%@}, #@{, #}\n\ +@end deftypefn"), + + pair_type ("%}", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} %@}\n\ +Close block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{%@}}.\n\ +It is possible to nest block comments.\n\ +@seealso{#@}, %@{, %}\n\ +@end deftypefn"), + + pair_type ("...", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ...\n\ +Continuation marker. Joins current line with following line.\n\ +@end deftypefn"), pair_type ("&", - "Element by element logical and operator. See also `&&'."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} &\n\ +Element by element logical 'and' operator.\n\ +@seealso{&&, and}\n\ +@end deftypefn"), pair_type ("&&", - "Logical and operator (with short-circuit evaluation). See also `&'."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} &&\n\ +Logical 'and' operator (with short-circuit evaluation).\n\ +@seealso{&, and}\n\ +@end deftypefn"), pair_type ("'", - "Matrix transpose operator. For complex matrices, computes the\n\ -complex conjugate (Hermitian) transpose. See also `.''\n\ + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} '\n\ +Matrix transpose operator. For complex matrices, computes the\n\ +complex conjugate (Hermitian) transpose.\n\ \n\ The single quote character may also be used to delimit strings, but\n\ it is better to use the double quote character, since that is never\n\ -ambiguous"), +ambiguous.\n\ +@seealso{.', transpose}\n\ +@end deftypefn"), pair_type ("(", - "Array index or function argument delimiter."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} (\n\ +Array index or function argument delimiter.\n\ +@end deftypefn"), pair_type (")", - "Array index or function argument delimiter."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} )\n\ +Array index or function argument delimiter.\n\ +@end deftypefn"), pair_type ("*", - "Multiplication operator. See also `.*'"), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} *\n\ +Multiplication operator.\n\ +@seealso{.*, times}\n\ +@end deftypefn"), pair_type ("**", - "Power operator. See also `^', `.**', and `.^'"), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} **\n\ +Power operator.\n\ +@seealso{power, ^, .**, .^}\n\ +@end deftypefn"), + + pair_type ("^", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ^\n\ +Power operator.\n\ +@seealso{power, **, .^, .**}\n\ +@end deftypefn"), pair_type ("+", - "Addition operator."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} +\n\ +Addition operator.\n\ +@seealso{plus}\n\ +@end deftypefn"), pair_type ("++", - "Increment operator. As in C, may be applied as a prefix or postfix\n\ -operator."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ++\n\ +Increment operator. As in C, may be applied as a prefix or postfix\n\ +operator.\n\ +@seealso{--}\n\ +@end deftypefn"), pair_type (",", - "Array index, function argument, or command separator."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ,\n\ +Array index, function argument, or command separator.\n\ +@end deftypefn"), pair_type ("-", - "Subtraction or unary negation operator."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} -\n\ +Subtraction or unary negation operator.\n\ +@seealso{minus}\n\ +@end deftypefn"), pair_type ("--", - "Decrement operator. As in C, may be applied as a prefix or postfix\n\ -operator."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} --\n\ +Decrement operator. As in C, may be applied as a prefix or postfix\n\ +operator.\n\ +@seealso{++}\n\ +@end deftypefn"), pair_type (".'", - "Matrix transpose operator. For complex matrices, computes the\n\ -transpose, *not* the complex conjugate transpose. See also `''."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .'\n\ +Matrix transpose operator. For complex matrices, computes the\n\ +transpose, @emph{not} the complex conjugate transpose.\n\ +@seealso{', transpose}\n\ +@end deftypefn"), pair_type (".*", - "Element by element multiplication operator. See also `*'."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .*\n\ +Element by element multiplication operator.\n\ +@seealso{*, times}\n\ +@end deftypefn"), pair_type (".**", - "Element by element power operator. See also `**', `^', and `.^'."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .*\n\ +Element by element power operator.\n\ +@seealso{**, ^, .^, power}\n\ +@end deftypefn"), + + pair_type (".^", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .^\n\ +Element by element power operator.\n\ +@seealso{.**, ^, **, power}\n\ +@end deftypefn"), pair_type ("./", - "Element by element division operator. See also `/' and `\\'."), - - pair_type (".^", - "Element by element power operator. See also `**', `^', and `.^'."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ./\n\ +Element by element right division operator.\n\ +@seealso{/, .\\, rdivide, mrdivide}\n\ +@end deftypefn"), pair_type ("/", - "Right division. See also `\\' and `./'."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} /\n\ +Right division operator.\n\ +@seealso{./, \\, rdivide, mrdivide}\n\ +@end deftypefn"), + + pair_type (".\\", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .\\\n\ +Element by element left division operator.\n\ +@seealso{\\, ./, rdivide, mrdivide}\n\ +@end deftypefn"), + + pair_type ("\\", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} \\\n\ +Left division operator.\n\ +@seealso{.\\, /, ldivide, mldivide}\n\ +@end deftypefn"), pair_type (":", - "Select entire rows or columns of matrices."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} :\n\ +Select entire rows or columns of matrices.\n\ +@end deftypefn"), pair_type (";", - "Array row or command separator. See also `,'."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ;\n\ +Array row or command separator.\n\ +@seealso{,}\n\ +@end deftypefn"), pair_type ("<", - "Less than operator."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} <\n\ +'Less than' operator.\n\ +@seealso{lt}\n\ +@end deftypefn"), pair_type ("<=", - "Less than or equals operator."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} <=\n\ +'Less than' or 'equals' operator.\n\ +@seealso{le}\n\ +@end deftypefn"), pair_type ("=", - "Assignment operator."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} =\n\ +Assignment operator.\n\ +@end deftypefn"), pair_type ("==", - "Equality test operator."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ==\n\ +Equality test operator.\n\ +@seealso{eq}\n\ +@end deftypefn"), pair_type (">", - "Greater than operator."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} >\n\ +'Greater than' operator.\n\ +@seealso{gt}\n\ +@end deftypefn"), pair_type (">=", - "Greater than or equals operator."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} >=\n\ +'Greater than' or 'equals' operator.\n\ +@seealso{ge}\n\ +@end deftypefn"), pair_type ("[", - "Return list delimiter. See also `]'."), - - pair_type ("\\", - "Left division operator. See also `/' and `./'."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} [\n\ +Return list delimiter.\n\ +@seealso{]}\n\ +@end deftypefn"), pair_type ("]", - "Return list delimiter. See also `['."), - - pair_type ("^", - "Power operator. See also `**', `.^', and `.**.'"), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ]\n\ +Return list delimiter.\n\ +@seealso{[}\n\ +@end deftypefn"), pair_type ("|", - "Element by element logical or operator. See also `||'."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} |\n\ +Element by element logical 'or' operator.\n\ +@seealso{||, or}\n\ +@end deftypefn"), pair_type ("||", - "Logical or operator (with short-circuit evaluation). See also `|'."), - - pair_type ("~", - "Logical not operator. See also `!' and `~'."), - - pair_type ("~=", - "Logical not equals operator. See also `!='."), + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ||\n\ +Logical 'or' (with short-circuit evaluation) operator.\n\ +@seealso{|, or}\n\ +@end deftypefn"), }; const static pair_type keywords[] = @@ -234,7 +432,7 @@ "-*- texinfo -*-\n\ @deftypefn {Keyword} {} break\n\ Exit the innermost enclosing do, while or for loop.\n\ -@seealso{do, while, for, continue}\n\ +@seealso{do, while, for, parfor, continue}\n\ @end deftypefn"), pair_type ("case", @@ -257,7 +455,7 @@ "-*- texinfo -*-\n\ @deftypefn {Keyword} {} continue\n\ Jump to the end of the innermost enclosing do, while or for loop.\n\ -@seealso{do, while, for, break}\n\ +@seealso{do, while, for, parfor, break}\n\ @end deftypefn"), pair_type ("do", @@ -287,7 +485,7 @@ @deftypefn {Keyword} {} end\n\ Mark the end of any @code{for}, @code{if}, @code{do}, @code{while}, or\n\ @code{function} block.\n\ -@seealso{for, if, do, while, function}\n\ +@seealso{for, parfor, if, do, while, function}\n\ @end deftypefn"), pair_type ("end_try_catch", @@ -325,6 +523,13 @@ @seealso{if}\n\ @end deftypefn"), + pair_type ("endparfor", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endparfor\n\ +Mark the end of a parfor loop. See @code{parfor} for an example.\n\ +@seealso{parfor}\n\ +@end deftypefn"), + pair_type ("endswitch", "-*- texinfo -*-\n\ @deftypefn {Keyword} {} endswitch\n\ @@ -351,12 +556,12 @@ endfor\n\ @end group\n\ @end example\n\ -@seealso{do, while}\n\ +@seealso{do, parfor, while}\n\ @end deftypefn"), pair_type ("function", "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} function @var{outputs} = function (@var{input}, @dots{})\n\ +@deftypefn {Keyword} {} function @var{outputs} = function (@var{input}, @dots{})\n\ @deftypefnx {Keyword} {} function {} function (@var{input}, @dots{})\n\ @deftypefnx {Keyword} {} function @var{outputs} = function\n\ Begin a function body with @var{outputs} as results and @var{inputs} as\n\ @@ -382,7 +587,7 @@ pair_type ("if", "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} if (@var{cond}) @dots{} endif\n\ +@deftypefn {Keyword} {} if (@var{cond}) @dots{} endif\n\ @deftypefnx {Keyword} {} if (@var{cond}) @dots{} else @dots{} endif\n\ @deftypefnx {Keyword} {} if (@var{cond}) @dots{} elseif (@var{cond}) @dots{} endif\n\ @deftypefnx {Keyword} {} if (@var{cond}) @dots{} elseif (@var{cond}) @dots{} else @dots{} endif\n\ @@ -410,6 +615,22 @@ @seealso{switch}\n\ @end deftypefn"), + pair_type ("parfor", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} for @var{i} = @var{range}\n\ +@deftypefnx {Keyword} {} for (@var{i} = @var{range}, @var{maxproc})\n\ +Begin a for loop that may execute in parallel.\n\ +\n\ +@example\n\ +@group\n\ +parfor i = 1:10\n\ + i\n\ +endparfor\n\ +@end group\n\ +@end example\n\ +@seealso{for, do, while}\n\ +@end deftypefn"), + pair_type ("persistent", "-*- texinfo -*-\n\ @deftypefn {Keyword} {} persistent @var{var}\n\ @@ -421,13 +642,6 @@ @seealso{global}\n\ @end deftypefn"), - pair_type ("replot", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} replot\n\ -Replot a graphic.\n\ -@seealso{plot}\n\ -@end deftypefn"), - pair_type ("return", "-*- texinfo -*-\n\ @deftypefn {Keyword} {} return\n\ @@ -473,7 +687,7 @@ execution will proceed after the catch block (though it is often\n\ recommended to use the lasterr function to re-throw the error after cleanup\n\ is completed).\n\ -@seealso{catch,unwind_protect}\n\ +@seealso{catch, unwind_protect}\n\ @end deftypefn"), pair_type ("until", @@ -494,7 +708,7 @@ unwind_protect_cleanup block is still executed (in other words, the\n\ unwind_protect_cleanup will be run with or without an error in the\n\ unwind_protect block).\n\ -@seealso{unwind_protect_cleanup,try}\n\ +@seealso{unwind_protect_cleanup, try}\n\ @end deftypefn"), pair_type ("unwind_protect_cleanup", @@ -508,14 +722,14 @@ "-*- texinfo -*-\n\ @deftypefn {Keyword} {} varargin\n\ Pass an arbitrary number of arguments into a function.\n\ -@seealso{varargout, nargin, nargout}\n\ +@seealso{varargout, nargin, isargout, nargout, nthargout}\n\ @end deftypefn"), pair_type ("varargout", "-*- texinfo -*-\n\ @deftypefn {Keyword} {} varargout\n\ Pass an arbitrary number of arguments out of a function.\n\ -@seealso{varargin, nargin, nargout}\n\ +@seealso{varargin, nargin, isargout, nargout, nthargout}\n\ @end deftypefn"), pair_type ("while", @@ -551,6 +765,9 @@ const string_vector bif = symbol_table::built_in_function_names (); const int bif_len = bif.length (); + const string_vector cfl = symbol_table::cmdline_function_names (); + const int cfl_len = cfl.length (); + const string_vector lcl = symbol_table::variable_names (); const int lcl_len = lcl.length (); @@ -560,7 +777,8 @@ const string_vector afl = autoloaded_functions (); const int afl_len = afl.length (); - const int total_len = key_len + bif_len + lcl_len + ffl_len + afl_len; + const int total_len + = key_len + bif_len + cfl_len + lcl_len + ffl_len + afl_len; string_vector list (total_len); @@ -574,6 +792,9 @@ for (i = 0; i < bif_len; i++) list[j++] = bif[i]; + for (i = 0; i < cfl_len; i++) + list[j++] = cfl[i]; + for (i = 0; i < lcl_len; i++) list[j++] = lcl[i]; @@ -719,16 +940,11 @@ DEFUN (get_help_text, args, , "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {[@var{text}, @var{format}] =} get_help_text (@var{name})\n\ -Return the help text of a given function.\n\ +Return the raw help text of function @var{name}.\n\ \n\ -This function returns the raw help text @var{text} and an indication of\n\ -its format for the function @var{name}. The format indication @var{format}\n\ -is a string that can be either @t{\"texinfo\"}, @t{\"html\"}, or\n\ +The raw help text is returned in @var{text} and the format in @var{format}\n\ +The format is a string which is one of @t{\"texinfo\"}, @t{\"html\"}, or\n\ @t{\"plain text\"}.\n\ -\n\ -To convert the help text to other formats, use the @code{makeinfo} function.\n\ -\n\ -@seealso{makeinfo}\n\ @end deftypefn") { octave_value_list retval; @@ -793,16 +1009,11 @@ DEFUN (get_help_text_from_file, args, , "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {[@var{text}, @var{format}] =} get_help_text_from_file (@var{fname})\n\ -Return the help text from the given file.\n\ +Return the raw help text from the file @var{fname}.\n\ \n\ -This function returns the raw help text @var{text} and an indication of\n\ -its format for the function @var{name}. The format indication @var{format}\n\ -is a string that can be either @t{\"texinfo\"}, @t{\"html\"}, or\n\ +The raw help text is returned in @var{text} and the format in @var{format}\n\ +The format is a string which is one of @t{\"texinfo\"}, @t{\"html\"}, or\n\ @t{\"plain text\"}.\n\ -\n\ -To convert the help text to other formats, use the @code{makeinfo} function.\n\ -\n\ -@seealso{makeinfo}\n\ @end deftypefn") { octave_value_list retval; @@ -1050,6 +1261,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} doc_cache_file ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} doc_cache_file (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} doc_cache_file (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the name of the\n\ Octave documentation cache file. A cache file significantly improves\n\ the performance of the @code{lookfor} command. The default value is \n\ @@ -1059,6 +1271,10 @@ The default value may be overridden by the environment variable\n\ @w{@env{OCTAVE_DOC_CACHE_FILE}}, or the command line argument\n\ @samp{--doc-cache-file NAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{lookfor, info_program, doc, help, makeinfo_program}\n\ @end deftypefn") { @@ -1069,6 +1285,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} info_file ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} info_file (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} info_file (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the name of the\n\ Octave info file. The default value is\n\ @file{@var{octave-home}/info/octave.info}, in\n\ @@ -1076,6 +1293,10 @@ The default value may be overridden by the environment variable\n\ @w{@env{OCTAVE_INFO_FILE}}, or the command line argument\n\ @samp{--info-file NAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{info_program, doc, help, makeinfo_program}\n\ @end deftypefn") { @@ -1086,6 +1307,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} info_program ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} info_program (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} info_program (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the name of the\n\ info program to run. The default value is\n\ @file{@var{octave-home}/libexec/octave/@var{version}/exec/@var{arch}/info}\n\ @@ -1095,6 +1317,10 @@ default value may be overridden by the environment variable\n\ @w{@env{OCTAVE_INFO_PROGRAM}}, or the command line argument\n\ @samp{--info-program NAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{info_file, doc, help, makeinfo_program}\n\ @end deftypefn") { @@ -1105,9 +1331,14 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} makeinfo_program ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} makeinfo_program (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} makeinfo_program (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the name of the\n\ program that Octave runs to format help text containing\n\ Texinfo markup commands. The default value is @code{makeinfo}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{info_file, info_program, doc, help}\n\ @end deftypefn") { @@ -1118,9 +1349,14 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} suppress_verbose_help_message ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} suppress_verbose_help_message (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} suppress_verbose_help_message (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether Octave\n\ will add additional help information to the end of the output from\n\ the @code{help} command and usage messages for built-in commands.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (suppress_verbose_help_message);
--- a/src/input.cc +++ b/src/input.cc @@ -213,7 +213,7 @@ FILE *stream = command_editor::get_output_stream (); gnulib::fputs (s.c_str (), stream); - fflush (stream); + gnulib::fflush (stream); } FILE *curr_stream = command_editor::get_input_stream (); @@ -275,6 +275,9 @@ flush_octave_stdout (); + octave_pager_stream::reset (); + octave_diary_stream::reset (); + octave_diary << prompt; retval = interactive_input (prompt); @@ -428,7 +431,7 @@ FILE *instream = 0; if (name.length () > 0) - instream = fopen (name.c_str (), "rb"); + instream = gnulib::fopen (name.c_str (), "rb"); if (! instream && warn) warning ("%s: no such file or directory", name.c_str ()); @@ -686,93 +689,86 @@ frame.protect_var (VPS1); VPS1 = prompt; - if (stdin_is_tty) + if (! (interactive || forced_interactive) + || (reading_fcn_file + || reading_classdef_file + || reading_script_file + || get_input_from_eval_string + || input_from_startup_file + || input_from_command_line_file)) { - if (! (interactive || forced_interactive) - || (reading_fcn_file - || reading_classdef_file - || reading_script_file - || get_input_from_eval_string - || input_from_startup_file - || input_from_command_line_file)) - { - frame.protect_var (forced_interactive); - forced_interactive = true; + frame.protect_var (forced_interactive); + forced_interactive = true; + + frame.protect_var (reading_fcn_file); + reading_fcn_file = false; + + frame.protect_var (reading_classdef_file); + reading_classdef_file = false; + + frame.protect_var (reading_script_file); + reading_script_file = false; - frame.protect_var (reading_fcn_file); - reading_fcn_file = false; + frame.protect_var (input_from_startup_file); + input_from_startup_file = false; + + frame.protect_var (input_from_command_line_file); + input_from_command_line_file = false; - frame.protect_var (reading_classdef_file); - reading_classdef_file = false; + frame.protect_var (get_input_from_eval_string); + get_input_from_eval_string = false; + + YY_BUFFER_STATE old_buf = current_buffer (); + YY_BUFFER_STATE new_buf = create_buffer (get_input_from_stdin ()); + + // FIXME: are these safe? + frame.add_fcn (switch_to_buffer, old_buf); + frame.add_fcn (delete_buffer, new_buf); - frame.protect_var (reading_script_file); - reading_script_file = false; + switch_to_buffer (new_buf); + } + + while (Vdebugging) + { + reset_error_handler (); - frame.protect_var (input_from_startup_file); - input_from_startup_file = false; + reset_parser (); - frame.protect_var (input_from_command_line_file); - input_from_command_line_file = false; + // Save current value of global_command. + frame.protect_var (global_command); + + global_command = 0; - frame.protect_var (get_input_from_eval_string); - get_input_from_eval_string = false; + // Do this with an unwind-protect cleanup function so that the + // forced variables will be unmarked in the event of an interrupt. + symbol_table::scope_id scope = symbol_table::top_scope (); + frame.add_fcn (symbol_table::unmark_forced_variables, scope); - YY_BUFFER_STATE old_buf = current_buffer (); - YY_BUFFER_STATE new_buf = create_buffer (get_input_from_stdin ()); + // This is the same as yyparse in parse.y. + int retval = octave_parse (); - // FIXME: are these safe? - frame.add_fcn (switch_to_buffer, old_buf); - frame.add_fcn (delete_buffer, new_buf); + if (retval == 0 && global_command) + { + unwind_protect inner_frame; - switch_to_buffer (new_buf); + // Use an unwind-protect cleanup function so that the + // global_command list will be deleted in the event of an + // interrupt. + + inner_frame.add_fcn (cleanup_statement_list, &global_command); + + global_command->accept (*current_evaluator); + + if (octave_completion_matches_called) + octave_completion_matches_called = false; } - while (Vdebugging) - { - reset_error_handler (); - - reset_parser (); - - // Save current value of global_command. - frame.protect_var (global_command); - - global_command = 0; - - // Do this with an unwind-protect cleanup function so that the - // forced variables will be unmarked in the event of an interrupt. - symbol_table::scope_id scope = symbol_table::top_scope (); - frame.add_fcn (symbol_table::unmark_forced_variables, scope); - - // This is the same as yyparse in parse.y. - int retval = octave_parse (); - - if (retval == 0 && global_command) - { - global_command->accept (*current_evaluator); + // Unmark forced variables. + // Restore previous value of global_command. + frame.run_top (2); - // FIXME -- To avoid a memory leak, global_command should be - // deleted, I think. But doing that here causes trouble if - // an error occurs while executing a debugging command - // (dbstep, for example). It's not clear to me why that - // happens. - // - // delete global_command; - // - // global_command = 0; - - if (octave_completion_matches_called) - octave_completion_matches_called = false; - } - - // Unmark forced variables. - // Restore previous value of global_command. - frame.run_top (2); - - octave_quit (); - } + octave_quit (); } - else - warning ("invalid attempt to debug script read from stdin"); } // If the user simply hits return, this will produce an empty matrix. @@ -799,6 +795,9 @@ flush_octave_stdout (); + octave_pager_stream::reset (); + octave_diary_stream::reset (); + octave_diary << prompt; std::string input_buf = interactive_input (prompt.c_str (), true); @@ -956,14 +955,11 @@ unwind_protect frame; - // FIXME -- we shouldn't need both the - // command_history object and the - // Vsaving_history variable... + frame.add_fcn (command_history::ignore_entries, + command_history::ignoring_entries ()); + command_history::ignore_entries (false); - frame.add_fcn (command_history::ignore_entries, ! Vsaving_history); - - frame.protect_var (Vsaving_history); frame.protect_var (Vdebugging); frame.add_fcn (octave_call_stack::restore_frame, @@ -975,7 +971,6 @@ // tree_print_code tpc (octave_stdout); // stmt.accept (tpc); - Vsaving_history = true; Vdebugging = true; std::string prompt = "debug> "; @@ -1277,7 +1272,8 @@ DEFUN (add_input_event_hook, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} add_input_event_hook (@var{fcn}, @var{data})\n\ +@deftypefn {Built-in Function} {} add_input_event_hook (@var{fcn})\n\ +@deftypefnx {Built-in Function} {} add_input_event_hook (@var{fcn}, @var{data})\n\ Add the named function @var{fcn} to the list of functions to call\n\ periodically when Octave is waiting for input. The function should\n\ have the form\n\ @@ -1323,7 +1319,7 @@ DEFUN (remove_input_event_hook, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} remove_input_event_hook (@var{fcn})\n\ -Remove the named function @var{fcn} to the list of functions to call\n\ +Remove the named function @var{fcn} from the list of functions to call\n\ periodically when Octave is waiting for input.\n\ @seealso{add_input_event_hook}\n\ @end deftypefn") @@ -1362,6 +1358,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} PS1 ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} PS1 (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PS1 (@var{new_val}, \"local\")\n\ Query or set the primary prompt string. When executing interactively,\n\ Octave displays the primary prompt when it is ready to read a command.\n\ \n\ @@ -1387,6 +1384,10 @@ \n\ @noindent\n\ will give the default Octave prompt a red coloring.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{PS2, PS4}\n\ @end deftypefn") { @@ -1397,12 +1398,17 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} PS2 ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} PS2 (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PS2 (@var{new_val}, \"local\")\n\ Query or set the secondary prompt string. The secondary prompt is\n\ printed when Octave is expecting additional input to complete a\n\ command. For example, if you are typing a @code{for} loop that spans several\n\ lines, Octave will print the secondary prompt at the beginning of\n\ each line after the first. The default value of the secondary prompt\n\ string is @code{\"> \"}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{PS1, PS4}\n\ @end deftypefn") { @@ -1413,10 +1419,15 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} PS4 ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} PS4 (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PS4 (@var{new_val}, \"local\")\n\ Query or set the character string used to prefix output produced\n\ when echoing commands is enabled.\n\ The default value is @code{\"+ \"}.\n\ @xref{Diary and Echo Commands}, for a description of echoing commands.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{echo, echo_executing_commands, PS1, PS2}\n\ @end deftypefn") { @@ -1427,9 +1438,14 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} completion_append_char ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} completion_append_char (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} completion_append_char (@var{new_val}, \"local\")\n\ Query or set the internal character variable that is appended to\n\ successful command-line completion attempts. The default\n\ value is @code{\" \"} (a single space).\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (completion_append_char); @@ -1439,6 +1455,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} echo_executing_commands ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} echo_executing_commands (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} echo_executing_commands (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls the echo state.\n\ It may be the sum of the following values:\n\ \n\ @@ -1458,6 +1475,10 @@ \n\ The value of @code{echo_executing_commands} may be set by the @kbd{echo}\n\ command or the command line option @option{--echo-commands}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (echo_executing_commands); @@ -1508,6 +1529,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} filemarker ()\n\ @deftypefnx {Built-in Function} {} filemarker (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} filemarker (@var{new_val}, \"local\")\n\ Query or set the character used to separate filename from the\n\ the subfunction names contained within the file. This can be used in\n\ a generic manner to interact with subfunctions. For example,\n\ @@ -1528,6 +1550,10 @@ \n\ @noindent\n\ will set a breakpoint at the first line of the subfunction @code{mysubfunc}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { char tmp = Vfilemarker;
--- a/src/lex.h +++ b/src/lex.h @@ -43,6 +43,10 @@ // Delete a buffer. extern OCTINTERP_API void delete_buffer (YY_BUFFER_STATE buf); +extern OCTINTERP_API void clear_all_buffers (void); + +extern OCTINTERP_API void cleanup_parser (void); + // Is the given string a keyword? extern bool is_keyword (const std::string& s); @@ -60,7 +64,8 @@ : bracketflag (0), braceflag (0), looping (0), convert_spaces_to_comma (true), at_beginning_of_statement (true), - defining_func (0), looking_at_function_handle (false), + defining_func (0), looking_at_function_handle (0), + looking_at_anon_fcn_args (true), looking_at_return_list (false), looking_at_parameter_list (false), looking_at_decl_list (false), looking_at_initializer_expression (false), looking_at_matrix_or_assign_lhs (false), looking_at_object_index (), @@ -101,6 +106,9 @@ // Nonzero means we are parsing a function handle. int looking_at_function_handle; + // TRUE means we are parsing an anonymous function argument list. + bool looking_at_anon_fcn_args; + // TRUE means we're parsing the return list for a function. bool looking_at_return_list;
--- a/src/lex.ll +++ b/src/lex.ll @@ -164,13 +164,13 @@ } \ while (0) -#define BIN_OP_RETURN(tok, convert, bos) \ +#define BIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ do \ { \ yylval.tok_val = new token (input_line_number, current_input_column); \ token_stack.push (yylval.tok_val); \ current_input_column += yyleng; \ - lexer_flags.quote_is_transpose = false; \ + lexer_flags.quote_is_transpose = qit; \ lexer_flags.convert_spaces_to_comma = convert; \ lexer_flags.looking_for_object_index = false; \ lexer_flags.at_beginning_of_statement = bos; \ @@ -178,6 +178,21 @@ } \ while (0) +#define XBIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ + do \ + { \ + gripe_matlab_incompatible_operator (yytext); \ + BIN_OP_RETURN_INTERNAL (tok, convert, bos, qit); \ + } \ + while (0) + +#define BIN_OP_RETURN(tok, convert, bos) \ + do \ + { \ + BIN_OP_RETURN_INTERNAL (tok, convert, bos, false); \ + } \ + while (0) + #define XBIN_OP_RETURN(tok, convert, bos) \ do \ { \ @@ -539,6 +554,7 @@ lexer_flags.quote_is_transpose = false; lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; maybe_warn_separator_insert (','); @@ -896,8 +912,8 @@ ".^" { LEXER_DEBUG (".^"); BIN_OP_RETURN (EPOW, false, false); } ".**" { LEXER_DEBUG (".**"); XBIN_OP_RETURN (EPOW, false, false); } ".'" { LEXER_DEBUG (".'"); do_comma_insert_check (); BIN_OP_RETURN (TRANSPOSE, true, false); } -"++" { LEXER_DEBUG ("++"); do_comma_insert_check (); XBIN_OP_RETURN (PLUS_PLUS, true, false); } -"--" { LEXER_DEBUG ("--"); do_comma_insert_check (); XBIN_OP_RETURN (MINUS_MINUS, true, false); } +"++" { LEXER_DEBUG ("++"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (PLUS_PLUS, true, false, true); } +"--" { LEXER_DEBUG ("--"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (MINUS_MINUS, true, false, true); } "<=" { LEXER_DEBUG ("<="); BIN_OP_RETURN (EXPR_LE, false, false); } "==" { LEXER_DEBUG ("=="); BIN_OP_RETURN (EXPR_EQ, false, false); } "~=" { LEXER_DEBUG ("~="); BIN_OP_RETURN (EXPR_NE, false, false); } @@ -961,10 +977,15 @@ lexer_flags.looking_at_object_index.pop_front (); lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma = nesting_level.is_bracket_or_brace (); + lexer_flags.convert_spaces_to_comma + = (nesting_level.is_bracket_or_brace () + && ! lexer_flags.looking_at_anon_fcn_args); lexer_flags.looking_for_object_index = true; lexer_flags.at_beginning_of_statement = false; + if (lexer_flags.looking_at_anon_fcn_args) + lexer_flags.looking_at_anon_fcn_args = false; + do_comma_insert_check (); COUNT_TOK_AND_RETURN (')'); @@ -1120,9 +1141,11 @@ // Only ask for input from stdin if we are expecting interactive // input. - if ((interactive || forced_interactive) + + if (! quitting_gracefully + && (interactive || forced_interactive) && ! (reading_fcn_file - || reading_classdef_file + || reading_classdef_file || reading_script_file || get_input_from_eval_string || input_from_startup_file)) @@ -1395,6 +1418,22 @@ yy_delete_buffer (buf); } +// Delete all buffers from the stack. +void +clear_all_buffers (void) +{ + while (current_buffer ()) + octave_pop_buffer_state (); +} + +void +cleanup_parser (void) +{ + reset_parser (); + + clear_all_buffers (); +} + // Restore a buffer (for unwind-prot). void @@ -1501,6 +1540,11 @@ lexer_flags.at_beginning_of_statement = true; break; + case endparfor_kw: + yylval.tok_val = new token (token::parfor_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + case endswitch_kw: yylval.tok_val = new token (token::switch_end, l, c); lexer_flags.at_beginning_of_statement = true; @@ -1516,6 +1560,11 @@ lexer_flags.at_beginning_of_statement = true; break; + case endenumeration_kw: + yylval.tok_val = new token (token::enumeration_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + case endevents_kw: yylval.tok_val = new token (token::events_end, l, c); lexer_flags.at_beginning_of_statement = true; @@ -1531,7 +1580,9 @@ lexer_flags.at_beginning_of_statement = true; break; + case for_kw: + case parfor_kw: case while_kw: promptflag--; lexer_flags.looping++; @@ -1562,9 +1613,10 @@ return 0; break; - case properties_kw: + case enumeration_kw: + case events_kw: case methods_kw: - case events_kw: + case properties_kw: // 'properties', 'methods' and 'events' are keywords for // classdef blocks. if (! lexer_flags.parsing_classdef) @@ -3353,6 +3405,9 @@ // Not initiallly looking at a function handle. looking_at_function_handle = 0; + // Not initiallly looking at an anonymous function argument list. + looking_at_anon_fcn_args = 0; + // Not parsing a function return, parameter, or declaration list. looking_at_return_list = false; looking_at_parameter_list = false; @@ -3435,6 +3490,14 @@ return retval; } +/* + +%!assert (iskeyword ("for")) +%!assert (iskeyword ("fort"), false) +%!assert (iskeyword ("fft"), false) + +*/ + void prep_lexer_for_script_file (void) {
new file mode 100644 --- /dev/null +++ b/src/link-deps.mk @@ -0,0 +1,38 @@ +include ../liboctave/link-deps.mk + +if AMCOND_ENABLE_DYNAMIC_LINKING + LIBOCTINTERP_LINK_DEPS = +else + LIBOCTINTERP_LINK_DEPS = $(DLD_FUNCTIONS_LIBS) +endif + +LIBOCTINTERP_LINK_DEPS += \ + $(GRAPHICS_LIBS) \ + $(FT2_LIBS) \ + $(HDF5_LIBS) \ + $(Z_LIBS) \ + $(OPENGL_LIBS) \ + $(X11_LIBS) \ + $(CARBON_LIBS) + +LIBOCTINTERP_LINK_OPTS = \ + $(GRAPHICS_LDFLAGS) \ + $(FT2_LDFLAGS) \ + $(HDF5_LDFLAGS) \ + $(Z_LDFLAGS) \ + $(REGEX_LDFLAGS) + +OCT_LINK_DEPS = + +OCT_LINK_OPTS = $(LDFLAGS) + +if AMCOND_LINK_ALL_DEPS + LIBOCTINTERP_LINK_DEPS += $(LIBOCTAVE_LINK_DEPS) + LIBOCTINTERP_LINK_OPTS += $(LIBOCTAVE_LINK_OPTS) + + OCTAVE_LINK_DEPS = $(LIBOCTINTERP_LINK_DEPS) + OCTAVE_LINK_OPTS = $(LIBOCTINTERP_LINK_OPTS) + + OCT_LINK_DEPS += $(LIBOCTINTERP_LINK_DEPS) + OCT_LINK_OPTS += $(LIBOCTINTERP_LINK_OPTS) +endif
--- a/src/load-path.cc +++ b/src/load-path.cc @@ -32,6 +32,7 @@ #include "file-stat.h" #include "oct-env.h" #include "pathsearch.h" +#include "singleton-cleanup.h" #include "defaults.h" #include "defun.h" @@ -290,7 +291,12 @@ bool retval = true; if (! instance) - instance = new load_path (); + { + instance = new load_path (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) { @@ -1956,7 +1962,7 @@ @deftypefn {Built-in Function} {} genpath (@var{dir})\n\ @deftypefnx {Built-in Function} {} genpath (@var{dir}, @var{skip}, @dots{})\n\ Return a path constructed from @var{dir} and all its subdirectories.\n\ -If additional string parameters are given, the resulting path will \n\ +If additional string parameters are given, the resulting path will\n\ exclude directories with those names.\n\ @end deftypefn") { @@ -2037,7 +2043,7 @@ DEFUN (restoredefaultpath, , , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} restoredefaultpath (@dots{})\n\ -Restore Octave's path to it's initial state at startup.\n\ +Restore Octave's path to its initial state at startup.\n\ \n\ @seealso{path, addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ @end deftypefn") @@ -2122,8 +2128,8 @@ @deftypefn {Built-in Function} {} addpath (@var{dir1}, @dots{})\n\ @deftypefnx {Built-in Function} {} addpath (@var{dir1}, @dots{}, @var{option})\n\ Add @var{dir1}, @dots{} to the current function search path. If\n\ -@var{option} is @samp{\"-begin\"} or 0 (the default), prepend the\n\ -directory name to the current path. If @var{option} is @samp{\"-end\"}\n\ +@var{option} is \"-begin\" or 0 (the default), prepend the\n\ +directory name to the current path. If @var{option} is \"-end\"\n\ or 1, append the directory name to the current path.\n\ Directories added to the path must exist.\n\ \n\
--- a/src/load-path.h +++ b/src/load-path.h @@ -443,6 +443,8 @@ static load_path *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + static hook_fcn_ptr add_hook; static hook_fcn_ptr remove_hook;
--- a/src/load-save.cc +++ b/src/load-save.cc @@ -545,6 +545,9 @@ @deftypefnx {Command} {} load options file\n\ @deftypefnx {Command} {} load options file v1 v2 @dots{}\n\ @deftypefnx {Command} {S =} load (\"options\", \"file\", \"v1\", \"v2\", @dots{})\n\ +@deftypefnx {Command} {} load file options\n\ +@deftypefnx {Command} {} load file options v1 v2 @dots{}\n\ +@deftypefnx {Command} {S =} load (\"file\", \"options\", \"v1\", \"v2\", @dots{})\n\ Load the named variables @var{v1}, @var{v2}, @dots{}, from the file\n\ @var{file}. If no variables are specified then all variables found in the\n\ file will be loaded. As with @code{save}, the list of variables to extract\n\ @@ -642,6 +645,16 @@ if (error_state) return retval; + int i = 1; + std::string orig_fname = ""; + + // Function called with Matlab-style ["filename", options] syntax + if (argc > 1 && argv[1].at(0) != '-') + { + orig_fname = argv[1]; + i++; + } + // It isn't necessary to have the default load format stored in a // user preference variable since we can determine the type of file // as we are reading. @@ -651,8 +664,8 @@ bool list_only = false; bool verbose = false; - int i; - for (i = 1; i < argc; i++) + //for (i; i < argc; i++) + for (; i < argc; i++) { if (argv[i] == "-force" || argv[i] == "-f") { @@ -710,19 +723,24 @@ break; } - if (i == argc) + if (orig_fname == "") { - print_usage (); - return retval; + if (i == argc) + { + print_usage (); + return retval; + } + else + orig_fname = argv[i]; } - - std::string orig_fname = argv[i]; + else + i--; oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; bool swap = false; - if (argv[i] == "-") + if (orig_fname == "-") { i++; @@ -747,7 +765,7 @@ } else { - std::string fname = file_ops::tilde_expand (argv[i]); + std::string fname = file_ops::tilde_expand (orig_fname); fname = find_file_to_load (fname, orig_fname); @@ -1441,7 +1459,7 @@ of the scalar structure @var{STRUCT} are saved as if they were variables\n\ with corresponding names.\n\ Valid options for the @code{save} command are listed in the following table.\n\ -Options that modify the output format override the format specified by \n\ +Options that modify the output format override the format specified by\n\ @code{default_save_options}.\n\ \n\ If save is invoked using the functional form\n\ @@ -1455,6 +1473,9 @@ (@var{v1}, @dots{}) must be specified as character strings.\n\ \n\ @table @code\n\ +@item -append\n\ +Append to the destination instead of overwriting.\n\ +\n\ @item -ascii\n\ Save a single matrix in a text file without header or any other information.\n\ \n\ @@ -1522,7 +1543,7 @@ Match the list of characters specified by @var{list}. If the first\n\ character is @code{!} or @code{^}, match all characters except those\n\ specified by @var{list}. For example, the pattern @code{[a-zA-Z]} will\n\ -match all lower and upper case alphabetic characters. \n\ +match all lower and uppercase alphabetic characters.\n\ \n\ Wildcards may also be used in the field name specifications when using\n\ the @option{-struct} modifier (but not in the struct name itself).\n\ @@ -1544,7 +1565,7 @@ @noindent\n\ saves the variable @samp{a} and all variables beginning with @samp{b} to\n\ the file @file{data} in Octave's binary format.\n\ -@seealso{load, default_save_options, dlmread, csvread, fread}\n\ +@seealso{load, default_save_options, save_header_format_string, dlmread, csvread, fread}\n\ @end deftypefn") { octave_value_list retval; @@ -1727,9 +1748,14 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} crash_dumps_octave_core ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} crash_dumps_octave_core (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} crash_dumps_octave_core (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether Octave tries\n\ to save all current variables to the file \"octave-core\" if it\n\ crashes or receives a hangup, terminate or similar signal.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{octave_core_file_limit, octave_core_file_name, octave_core_file_options}\n\ @end deftypefn") { @@ -1740,10 +1766,15 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} default_save_options ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} default_save_options (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} default_save_options (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the default options\n\ for the @code{save} command, and defines the default format.\n\ Typical values include @code{\"-ascii\"}, @code{\"-text -zip\"}.\n\ The default value is @option{-text}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{save}\n\ @end deftypefn") { @@ -1754,6 +1785,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} octave_core_file_limit ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_limit (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} octave_core_file_limit (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the maximum amount\n\ of memory (in kilobytes) of the top-level workspace that Octave will\n\ attempt to save when writing data to the crash dump file (the name of\n\ @@ -1762,6 +1794,10 @@ then @var{octave_core_file_limit} will be approximately the maximum\n\ size of the file. If a text file format is used, then the file could\n\ be much larger than the limit. The default value is -1 (unlimited)\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_options}\n\ @end deftypefn") { @@ -1772,9 +1808,14 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} octave_core_file_name ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_name (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} octave_core_file_name (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the name of the file\n\ used for saving data from the top-level workspace if Octave aborts.\n\ The default value is @code{\"octave-core\"}\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_options}\n\ @end deftypefn") { @@ -1785,11 +1826,16 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} octave_core_file_options ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_options (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} octave_core_file_options (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the options used for\n\ saving the workspace data if Octave aborts. The value of\n\ @code{octave_core_file_options} should follow the same format as the\n\ options for the @code{save} function. The default value is Octave's binary\n\ format.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_limit}\n\ @end deftypefn") { @@ -1800,6 +1846,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} save_header_format_string ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} save_header_format_string (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} save_header_format_string (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the format\n\ string used for the comment line written at the beginning of\n\ text-format data files saved by Octave. The format string is\n\ @@ -1813,6 +1860,10 @@ @smallexample\n\ \"# Created by Octave VERSION, %a %b %d %H:%M:%S %Y %Z <USER@@HOST>\"\n\ @end smallexample\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{strftime, save}\n\ @end deftypefn") {
--- a/src/load-save.h +++ b/src/load-save.h @@ -75,7 +75,7 @@ bool quiet = false); extern octave_value -do_load (std::istream& stream, const std::string& orig_fname, bool force, +do_load (std::istream& stream, const std::string& orig_fname, load_save_format format, oct_mach_info::float_format flt_fmt, bool list_only, bool swap, bool verbose, const string_vector& argv, int argv_idx, int argc, int nargout);
--- a/src/ls-mat5.cc +++ b/src/ls-mat5.cc @@ -1224,22 +1224,32 @@ } else { - octave_class* cls = new octave_class (m, classname); - cls->reconstruct_exemplar (); - - if (! cls->reconstruct_parents ()) - warning ("load: unable to reconstruct object inheritance"); - - tc = cls; - if (load_path::find_method (classname, "loadobj") != - std::string()) + octave_class* cls + = new octave_class (m, classname, + std::list<std::string> ()); + + if (cls->reconstruct_exemplar ()) { - octave_value_list tmp = feval ("loadobj", tc, 1); - - if (! error_state) - tc = tmp(0); - else - goto data_read_error; + + if (! cls->reconstruct_parents ()) + warning ("load: unable to reconstruct object inheritance"); + + tc = cls; + if (load_path::find_method (classname, "loadobj") != + std::string()) + { + octave_value_list tmp = feval ("loadobj", tc, 1); + + if (! error_state) + tc = tmp(0); + else + goto data_read_error; + } + } + else + { + tc = m; + warning ("load: element has been converted to a structure"); } } }
--- a/src/ls-oct-ascii.cc +++ b/src/ls-oct-ascii.cc @@ -419,8 +419,13 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} save_precision ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} save_precision (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} save_precision (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the number of\n\ digits to keep when saving data in text format.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE_WITH_LIMITS (save_precision, -1, INT_MAX);
--- a/src/mappers.cc +++ b/src/mappers.cc @@ -67,23 +67,21 @@ } /* - -%!assert(abs (1), 1); -%!assert(abs (-3.5), 3.5); -%!assert(abs (3+4i), 5); -%!assert(abs (3-4i), 5); -%!assert(abs ([1.1, 3i; 3+4i, -3-4i]), [1.1, 3; 5, 5]); +%!assert (abs (1), 1) +%!assert (abs (-3.5), 3.5) +%!assert (abs (3+4i), 5) +%!assert (abs (3-4i), 5) +%!assert (abs ([1.1, 3i; 3+4i, -3-4i]), [1.1, 3; 5, 5]) -%!assert(abs (single(1)), single(1)); -%!assert(abs (single(-3.5)), single(3.5)); -%!assert(abs (single(3+4i)), single(5)); -%!assert(abs (single(3-4i)), single(5)); -%!assert(abs (single([1.1, 3i; 3+4i, -3-4i])), single([1.1, 3; 5, 5])); +%!assert (abs (single (1)), single (1)) +%!assert (abs (single (-3.5)), single (3.5)) +%!assert (abs (single (3+4i)), single (5)) +%!assert (abs (single (3-4i)), single (5)) +%!assert (abs (single ([1.1, 3i; 3+4i, -3-4i])), single ([1.1, 3; 5, 5])) -%!error abs (); -%!error abs (1, 2); - - */ +%!error abs () +%!error abs (1, 2) +*/ DEFUN (acos, args, , "-*- texinfo -*-\n\ @@ -102,24 +100,22 @@ } /* - -%!test +%!shared rt2, rt3 %! rt2 = sqrt (2); %! rt3 = sqrt (3); -%! v = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! x = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; -%! assert(acos (x), v, sqrt(eps)); %!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! v = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! x = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; +%! v = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! assert (acos (x), v, sqrt (eps)); + +%!test %! x = single ([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); -%! assert(acos (x), v, sqrt(eps('single'))); +%! v = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! assert (acos (x), v, sqrt (eps ('single'))); -%!error acos (); -%!error acos (1, 2); - +%!error acos () +%!error acos (1, 2) */ DEFUN (acosh, args, , @@ -139,20 +135,18 @@ } /* - %!test +%! x = [1, 0, -1, 0]; %! v = [0, pi/2*i, pi*i, pi/2*i]; -%! x = [1, 0, -1, 0]; -%! assert(acosh (x), v, sqrt(eps)); +%! assert (acosh (x), v, sqrt (eps)); %!test -%! v = single([0, pi/2*i, pi*i, pi/2*i]); -%! x = single([1, 0, -1, 0]); -%! assert(acosh (x), v, sqrt (eps('single'))); +%! x = single ([1, 0, -1, 0]); +%! v = single ([0, pi/2*i, pi*i, pi/2*i]); +%! assert (acosh (x), v, sqrt (eps ('single'))); -%!error acosh (); -%!error acosh (1, 2); - +%!error acosh () +%!error acosh (1, 2) */ DEFUN (angle, args, , @@ -203,22 +197,26 @@ } /* - -%!assert(arg (1), 0); -%!assert(arg (i), pi/2); -%!assert(arg (-1), pi); -%!assert(arg (-i), -pi/2); -%!assert(arg ([1, i; -1, -i]), [0, pi/2; pi, -pi/2]); +%!assert (arg (1), 0) +%!assert (arg (i), pi/2) +%!assert (arg (-1), pi) +%!assert (arg (-i), -pi/2) +%!assert (arg ([1, i; -1, -i]), [0, pi/2; pi, -pi/2]) -%!assert(arg (single(1)), single(0)); -%!assert(arg (single(i)), single(pi/2)); -%!assert(arg (single(-1)), single(pi)); -%!assert(arg (single(-i)), single(-pi/2)); -%!assert(arg (single([1, i; -1, -i])), single([0, pi/2; pi, -pi/2]), 2e1*eps('single')); +%!assert (arg (single (1)), single (0)) +%!assert (arg (single (i)), single (pi/2)) +%!test +%! if (ismac ()) +%! ## Avoid failing for a MacOS feature +%! assert (arg (single (-1)), single (pi), 2*eps (single (1))); +%! else +%! assert (arg (single (-1)), single (pi)); +%! endif +%!assert (arg (single (-i)), single (-pi/2)) +%!assert (arg (single ([1, i; -1, -i])), single ([0, pi/2; pi, -pi/2]), 2e1*eps ('single')) -%!error arg (); -%!error arg (1, 2); - +%!error arg () +%!error arg (1, 2) */ DEFUN (asin, args, , @@ -241,11 +239,12 @@ %!test %! rt2 = sqrt (2); %! rt3 = sqrt (3); +%! x = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; %! v = [0, pi/6, pi/4, pi/3, pi/2, pi/3, pi/4, pi/6, 0]; -%! x = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; -%! assert(all (abs (asin (x) - v) < sqrt (eps))); -%!error asin (); -%!error asin (1, 2); +%! assert (all (abs (asin (x) - v) < sqrt (eps))); + +%!error asin () +%!error asin (1, 2) */ DEFUN (asinh, args, , @@ -265,20 +264,18 @@ } /* - %!test %! v = [0, pi/2*i, 0, -pi/2*i]; %! x = [0, i, 0, -i]; -%! assert(asinh (x), v, sqrt (eps)); +%! assert (asinh (x), v, sqrt (eps)); %!test -%! v = single([0, pi/2*i, 0, -pi/2*i]); -%! x = single([0, i, 0, -i]); -%! assert(asinh (x), v, sqrt (eps('single'))); +%! v = single ([0, pi/2*i, 0, -pi/2*i]); +%! x = single ([0, i, 0, -i]); +%! assert (asinh (x), v, sqrt (eps ('single'))); -%!error asinh (); -%!error asinh (1, 2); - +%!error asinh () +%!error asinh (1, 2) */ DEFUN (atan, args, , @@ -298,25 +295,23 @@ } /* - -%!test +%!shared rt2, rt3 %! rt2 = sqrt (2); %! rt3 = sqrt (3); -%! v = [0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]; -%! x = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; -%! assert(atan (x), v, sqrt (eps)); %!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! v = single([0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]); -%! x = single([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); -%! assert(atan (x), v, sqrt (eps('single'))); +%! v = [0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]; +%! x = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; +%! assert (atan (x), v, sqrt (eps)); -%!error atan (); -%!error atan (1, 2); +%!test +%! v = single ([0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]); +%! x = single ([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); +%! assert (atan (x), v, sqrt (eps ('single'))); - */ +%!error atan () +%!error atan (1, 2) +*/ DEFUN (atanh, args, , "-*- texinfo -*-\n\ @@ -335,20 +330,18 @@ } /* - %!test %! v = [0, 0]; %! x = [0, 0]; -%! assert(atanh (x), v, sqrt (eps)); +%! assert (atanh (x), v, sqrt (eps)); %!test -%! v = single([0, 0]); -%! x = single([0, 0]); -%! assert(atanh (x), v, sqrt (eps('single'))); +%! v = single ([0, 0]); +%! x = single ([0, 0]); +%! assert (atanh (x), v, sqrt (eps ('single'))); -%!error atanh (); -%!error atanh (1, 2); - +%!error atanh () +%!error atanh (1, 2) */ DEFUN (cbrt, args, , @@ -370,7 +363,6 @@ } /* - %!assert (cbrt (64), 4) %!assert (cbrt (-125), -5) %!assert (cbrt (0), 0) @@ -380,6 +372,8 @@ %!assert (cbrt (2^300), 2^100) %!assert (cbrt (125*2^300), 5*2^100) +%!error cbrt () +%!error cbrt (1, 2) */ DEFUN (ceil, args, , @@ -408,22 +402,20 @@ } /* +%% double precision +%!assert (ceil ([2, 1.1, -1.1, -1]), [2, 2, -1, -1]) -%% double precision -%!assert(ceil ([2, 1.1, -1.1, -1]), [2, 2, -1, -1]); - -%% compelx double precison -%!assert(ceil ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 2+2i, -1-i, -1-i]); +%% complex double precison +%!assert (ceil ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 2+2i, -1-i, -1-i]) %% single precision -%!assert(ceil (single([2, 1.1, -1.1, -1])), single([2, 2, -1, -1])); +%!assert (ceil (single ([2, 1.1, -1.1, -1])), single ([2, 2, -1, -1])) -%% compelx single preci -%!assert(ceil (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single([2+2i, 2+2i, -1-i, -1-i])); +%% complex single precision +%!assert (ceil (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single ([2+2i, 2+2i, -1-i, -1-i])) -%!error ceil (); -%!error ceil (1, 2); - +%!error ceil () +%!error ceil (1, 2) */ DEFUN (conj, args, , @@ -449,22 +441,20 @@ } /* - -%!assert(conj (1), 1); -%!assert(conj (i), -i) -%!assert(conj (1+i), 1-i) -%!assert(conj (1-i), 1+i) -%!assert(conj ([-1, -i; -1+i, -1-i]), [-1, i; -1-i, -1+i]); +%!assert (conj (1), 1) +%!assert (conj (i), -i) +%!assert (conj (1+i), 1-i) +%!assert (conj (1-i), 1+i) +%!assert (conj ([-1, -i; -1+i, -1-i]), [-1, i; -1-i, -1+i]) -%!assert(conj (single(1)), single(1)); -%!assert(conj (single(i)), single(-i)) -%!assert(conj (single(1+i)), single(1-i)) -%!assert(conj (single(1-i)), single(1+i)) -%!assert(conj (single([-1, -i; -1+i, -1-i])), single([-1, i; -1-i, -1+i])); +%!assert (conj (single (1)), single (1)) +%!assert (conj (single (i)), single (-i)) +%!assert (conj (single (1+i)), single (1-i)) +%!assert (conj (single (1-i)), single (1+i)) +%!assert (conj (single ([-1, -i; -1+i, -1-i])), single ([-1, i; -1-i, -1+i])) -%!error conj (); -%!error conj (1, 2); - +%!error conj () +%!error conj (1, 2) */ DEFUN (cos, args, , @@ -484,25 +474,25 @@ } /* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! v = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; +%! assert (cos (x), v, sqrt (eps)); %!test %! rt2 = sqrt (2); %! rt3 = sqrt (3); -%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! v = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; -%! assert(cos (x), v, sqrt (eps)); +%! x = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! v = single ([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); +%! assert (cos (x), v, sqrt (eps ('single'))); -%!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! x = single([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! v = single([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); -%! assert(cos (x), v, sqrt (eps('single'))); - -%!error cos (); -%!error cos (1, 2); - - */ +%!error cos () +%!error cos (1, 2) +*/ DEFUN (cosh, args, , "-*- texinfo -*-\n\ @@ -521,20 +511,18 @@ } /* - %!test %! x = [0, pi/2*i, pi*i, 3*pi/2*i]; %! v = [1, 0, -1, 0]; -%! assert(cosh (x), v, sqrt (eps)); +%! assert (cosh (x), v, sqrt (eps)); %!test -%! x = single([0, pi/2*i, pi*i, 3*pi/2*i]); -%! v = single([1, 0, -1, 0]); -%! assert(cosh (x), v, sqrt (eps ('single'))); +%! x = single ([0, pi/2*i, pi*i, 3*pi/2*i]); +%! v = single ([1, 0, -1, 0]); +%! assert (cosh (x), v, sqrt (eps ('single'))); -%!error cosh (); -%!error cosh (1, 2); - +%!error cosh () +%!error cosh (1, 2) */ DEFUN (erf, args, , @@ -550,11 +538,12 @@ \n\ @example\n\ @group\n\ - z\n\ - /\n\ +@c spacing appears odd here, but is correct after Makeinfo\n\ + z\n\ + /\n\ erf (z) = (2/sqrt (pi)) | e^(-t^2) dt\n\ - /\n\ - t=0\n\ + /\n\ + t=0\n\ @end group\n\ @end example\n\ \n\ @@ -572,33 +561,32 @@ } /* +%!test +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (erf (a), erf (real (a))); %!test -%! a = -1i*sqrt(-1/(6.4187*6.4187)); -%! assert (erf(a), erf(real(a))); - -%!test -%! x=[0,.5,1]; -%! v=[0, .520499877813047, .842700792949715]; -%! assert(all(abs(erf(x)-v)<1.e-10) && all(abs(erf(-x)+v)<1.e-10) && all(abs(erfc(x)+v-1)<1.e-10) && all(abs(erfinv(v)-x)<1.e-10)); +%! x = [0,.5,1]; +%! v = [0, .520499877813047, .842700792949715]; +%! assert (all (abs (erf (x)-v) < 1.e-10)); +%! assert (all (abs (erf (-x)+v) < 1.e-10)); +%! assert (all (abs (erfc (x)+v-1) < 1.e-10)); +%! assert (all (abs (erfinv (v)-x) < 1.e-10)); %!test -%! a = -1i*sqrt(single (-1/(6.4187*6.4187))); -%! assert (erf(a), erf(real(a))); +%! a = -1i*sqrt (single (-1/(6.4187*6.4187))); +%! assert (erf (a), erf (real (a))); %!test -%! x=single ([0,.5,1]); -%! v=single ([0, .520499877813047, .842700792949715]); -%! assert(all(abs(erf(x)-v)<1.e-6) && all(abs(erf(-x)+v)<1.e-6) && all(abs(erfc(x)+v-1)<1.e-6) && all(abs(erfinv(v)-x)<1.e-6)); +%! x = single ([0,.5,1]); +%! v = single ([0, .520499877813047, .842700792949715]); +%! assert (all (abs (erf (x)-v) < 1.e-6)); +%! assert (all (abs (erf (-x)+v) < 1.e-6)); +%! assert (all (abs (erfc (x)+v-1) < 1.e-6)); +%! assert (all (abs (erfinv (v)-x) < 1.e-6)); -%% test/octave.test/arith/erf-2.m -%!error erf(); - -%% test/octave.test/arith/erf-3.m -%!error erf(1,2); - - - +%!error erf () +%!error erf (1, 2) */ DEFUN (erfinv, args, , @@ -607,7 +595,7 @@ Compute the inverse error function, i.e., @var{y} such that\n\ \n\ @example\n\ - erf(@var{y}) == @var{x}\n\ + erf (@var{y}) == @var{x}\n\ @end example\n\ @seealso{erf, erfc, erfcx}\n\ @end deftypefn") @@ -634,6 +622,9 @@ %% exceptional %!assert (erfinv ([-1, 1, 1.1, -2.1]), [-Inf, Inf, NaN, NaN]) %!error erfinv (1+2i) + +%!error erfinv () +%!error erfinv (1, 2) */ DEFUN (erfc, args, , @@ -644,7 +635,7 @@ $1 - {\\rm erf} (z)$.\n\ @end tex\n\ @ifnottex\n\ -@code{1 - erf (@var{z})}.\n\ +@w{@code{1 - erf (@var{z})}}.\n\ @end ifnottex\n\ @seealso{erfcx, erf, erfinv}\n\ @end deftypefn") @@ -659,11 +650,12 @@ } /* +%!test +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (erfc (a), erfc (real (a))); -%!test -%! a = -1i*sqrt(-1/(6.4187*6.4187)); -%! assert (erfc(a), erfc(real(a))); - +%!error erfc () +%!error erfc (1, 2) */ DEFUN (erfcx, args, , @@ -671,10 +663,16 @@ @deftypefn {Mapping Function} {} erfcx (@var{z})\n\ Compute the scaled complementary error function,\n\ @tex\n\ -$z^2 (1 - {\\rm erf} (z))$.\n\ +$$\n\ + e^{z^2} {\\rm erfc} (z) \\equiv e^{z^2} (1 - {\\rm erf} (z))\n\ +$$\n\ @end tex\n\ @ifnottex\n\ -@code{z^2*(1 - erf (@var{z}))}.\n\ +\n\ +@example\n\ +exp (z^2) * erfc (x)\n\ +@end example\n\ +\n\ @end ifnottex\n\ @seealso{erfc, erf, erfinv}\n\ @end deftypefn") @@ -689,7 +687,10 @@ } /* +%% FIXME: Need a test for erfcx +%!error erfcx () +%!error erfcx (1, 2) */ DEFUN (exp, args, , @@ -717,18 +718,16 @@ } /* - -%!assert(exp ([0, 1, -1, -1000]), [1, e, 1/e, 0], sqrt (eps)); -%!assert(exp (1+i), e * (cos (1) + sin (1) * i), sqrt (eps)); -%!assert(exp (single([0, 1, -1, -1000])), single([1, e, 1/e, 0]), sqrt (eps('single'))); -%!assert(exp (single(1+i)), single (e * (cos (1) + sin (1) * i)), sqrt (eps('single'))); +%!assert (exp ([0, 1, -1, -1000]), [1, e, 1/e, 0], sqrt (eps)) +%!assert (exp (1+i), e * (cos (1) + sin (1) * i), sqrt (eps)) +%!assert (exp (single ([0, 1, -1, -1000])), single ([1, e, 1/e, 0]), sqrt (eps ('single'))) +%!assert (exp (single (1+i)), single (e * (cos (1) + sin (1) * i)), sqrt (eps ('single'))) -%!error exp (); -%!error exp (1, 2); +%!assert (exp ([Inf, -Inf, NaN]), [Inf 0 NaN]) +%!assert (exp (single ([Inf, -Inf, NaN])), single ([Inf 0 NaN])) -%!assert(exp (Inf) == Inf && exp (-Inf) == 0 && isnan (exp (NaN))); -%!assert(exp (Inf ('single')) == Inf('single') && exp (-Inf('single')) == 0 && isnan (exp (NaN('single')))); - +%!error exp () +%!error exp (1, 2) */ DEFUN (expm1, args, , @@ -754,6 +753,16 @@ return retval; } +/* +%!assert (expm1 (2*eps), 2*eps, 1e-29) + +%!assert (expm1 ([Inf, -Inf, NaN]), [Inf -1 NaN]) +%!assert (expm1 (single ([Inf, -Inf, NaN])), single ([Inf -1 NaN])) + +%!error expm1 () +%!error expm1 (1, 2) +*/ + DEFUN (isfinite, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isfinite (@var{x})\n\ @@ -781,16 +790,17 @@ } /* - -%!assert(!(finite (Inf))); -%!assert(!(finite (NaN))); -%!assert(finite (rand(1,10))); +%!assert (!finite (Inf)) +%!assert (!finite (NaN)) +%!assert (finite (rand (1,10))) -%!assert(!(finite (single(Inf)))); -%!assert(!(finite (single(NaN)))); -%!assert(finite (single(rand(1,10)))); +%!assert (!finite (single (Inf))) +%!assert (!finite (single (NaN))) +%!assert (finite (single (rand (1,10)))) - */ +%!error finite () +%!error finite (1, 2) +*/ DEFUN (fix, args, , "-*- texinfo -*-\n\ @@ -818,15 +828,13 @@ } /* +%!assert (fix ([1.1, 1, -1.1, -1]), [1, 1, -1, -1]) +%!assert (fix ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i]), [1+i, 1+i, -1-i, -1-i]) +%!assert (fix (single ([1.1, 1, -1.1, -1])), single ([1, 1, -1, -1])) +%!assert (fix (single ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i])), single ([1+i, 1+i, -1-i, -1-i])) -%!assert(fix ([1.1, 1, -1.1, -1]), [1, 1, -1, -1]); -%!assert(fix ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i]), [1+i, 1+i, -1-i, -1-i]); -%!assert(fix (single([1.1, 1, -1.1, -1])), single([1, 1, -1, -1])); -%!assert(fix (single([1.1+1.1i, 1+i, -1.1-1.1i, -1-i])), single([1+i, 1+i, -1-i, -1-i])); - -%!error fix (); -%!error fix (1, 2); - +%!error fix () +%!error fix (1, 2) */ DEFUN (floor, args, , @@ -855,15 +863,13 @@ } /* +%!assert (floor ([2, 1.1, -1.1, -1]), [2, 1, -2, -1]) +%!assert (floor ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 1+i, -2-2i, -1-i]) +%!assert (floor (single ([2, 1.1, -1.1, -1])), single ([2, 1, -2, -1])) +%!assert (floor (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single ([2+2i, 1+i, -2-2i, -1-i])) -%!assert(floor ([2, 1.1, -1.1, -1]), [2, 1, -2, -1]); -%!assert(floor ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 1+i, -2-2i, -1-i]); -%!assert(floor (single ([2, 1.1, -1.1, -1])), single ([2, 1, -2, -1])); -%!assert(floor (single([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single([2+2i, 1+i, -2-2i, -1-i])); - -%!error floor (); -%!error floor (1, 2); - +%!error floor () +%!error floor (1, 2) */ DEFUN (gamma, args, , @@ -879,11 +885,12 @@ \n\ @example\n\ @group\n\ - infinity\n\ - /\n\ +@c spacing appears odd here, but is correct after Makeinfo\n\ + infinity\n\ + /\n\ gamma (z) = | t^(z-1) exp (-t) dt.\n\ - /\n\ - t=0\n\ + /\n\ + t=0\n\ @end group\n\ @end example\n\ \n\ @@ -901,34 +908,32 @@ } /* - %!test -%! a = -1i*sqrt(-1/(6.4187*6.4187)); -%! assert (gamma(a), gamma(real(a))); +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (gamma (a), gamma (real (a))); %!test %! x = [.5, 1, 1.5, 2, 3, 4, 5]; %! v = [sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]; -%! assert(gamma(x), v, sqrt(eps)) +%! assert (gamma (x), v, sqrt (eps)); %!test -%! a = single(-1i*sqrt(-1/(6.4187*6.4187))); -%! assert (gamma(a), gamma(real(a))); +%! a = single (-1i*sqrt (-1/(6.4187*6.4187))); +%! assert (gamma (a), gamma (real (a))); %!test -%! x = single([.5, 1, 1.5, 2, 3, 4, 5]); -%! v = single([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); -%! assert(gamma(x), v, sqrt(eps('single'))) +%! x = single ([.5, 1, 1.5, 2, 3, 4, 5]); +%! v = single ([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); +%! assert (gamma (x), v, sqrt (eps ('single'))); %!test %! x = [-1, 0, 1, Inf]; %! v = [Inf, Inf, 1, Inf]; -%! assert (gamma(x), v); -%! assert (gamma(single (x)), single (v)); +%! assert (gamma (x), v); +%! assert (gamma (single (x)), single (v)); -%!error gamma(); -%!error gamma(1,2); - +%!error gamma () +%!error gamma (1, 2) */ DEFUN (imag, args, , @@ -948,21 +953,19 @@ } /* - -%!assert(imag (1), 0); -%!assert(imag (i), 1); -%!assert(imag (1+i), 1); -%!assert(imag ([i, 1; 1, i]), full (eye (2))); +%!assert (imag (1), 0) +%!assert (imag (i), 1) +%!assert (imag (1+i), 1) +%!assert (imag ([i, 1; 1, i]), full (eye (2))) -%!assert(imag (single(1)), single(0)); -%!assert(imag (single(i)), single(1)); -%!assert(imag (single(1+i)), single(1)); -%!assert(imag (single([i, 1; 1, i])), full (eye (2,'single'))); +%!assert (imag (single (1)), single (0)) +%!assert (imag (single (i)), single (1)) +%!assert (imag (single (1+i)), single (1)) +%!assert (imag (single ([i, 1; 1, i])), full (eye (2,'single'))) -%!error imag (); -%!error imag (1, 2); - - */ +%!error imag () +%!error imag (1, 2) +*/ DEFUNX ("isalnum", Fisalnum, args, , "-*- texinfo -*-\n\ @@ -982,6 +985,19 @@ return retval; } +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"Z") + 1) = true; +%! result(toascii ("0":"9") + 1) = true; +%! result(toascii ("a":"z") + 1) = true; +%! assert (all (isalnum (charset) == result)); + +%!error isalnum () +%!error isalnum (1, 2) +*/ + DEFUNX ("isalpha", Fisalpha, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isalpha (@var{s})\n\ @@ -1000,6 +1016,18 @@ return retval; } +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"Z") + 1) = true; +%! result(toascii ("a":"z") + 1) = true; +%! assert (all (isalpha (charset) == result)); + +%!error isalpha () +%!error isalpha (1, 2) +*/ + DEFUNX ("isascii", Fisascii, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isascii (@var{s})\n\ @@ -1017,6 +1045,16 @@ return retval; } +/* +%!test +%! charset = char (0:127); +%! result = true (1, 128); +%! assert (all (isascii (charset) == result)); + +%!error isascii () +%!error isascii (1, 2) +*/ + DEFUNX ("iscntrl", Fiscntrl, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} iscntrl (@var{s})\n\ @@ -1034,6 +1072,18 @@ return retval; } +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(1:32) = true; +%! result(128) = true; +%! assert (all (iscntrl (charset) == result)); + +%!error iscntrl () +%!error iscntrl (1, 2) +*/ + DEFUNX ("isdigit", Fisdigit, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isdigit (@var{s})\n\ @@ -1051,6 +1101,17 @@ return retval; } +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("0":"9") + 1) = true; +%! assert (all (isdigit (charset) == result)); + +%!error isdigit () +%!error isdigit (1, 2) +*/ + DEFUN (isinf, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isinf (@var{x})\n\ @@ -1077,20 +1138,21 @@ } /* - -%!assert(isinf (Inf)); -%!assert(!isinf (NaN)); -%!assert(!(isinf (NA))); -%!assert(isinf (rand(1,10)), false(1,10)); -%!assert(isinf([NaN -Inf -1 0 1 Inf NA]), [false, true, false, false, false, true, false]); +%!assert (isinf (Inf)) +%!assert (!isinf (NaN)) +%!assert (!isinf (NA)) +%!assert (isinf (rand(1,10)), false (1,10)) +%!assert (isinf ([NaN -Inf -1 0 1 Inf NA]), [false, true, false, false, false, true, false]) -%!assert(isinf (single(Inf))); -%!assert(!(isinf (single(NaN)))); -%!assert(!(isinf (single(NA)))); -%!assert(isinf (single(rand(1,10))), false(1,10)); -%!assert(isinf(single([NaN -Inf -1 0 1 Inf NA])), [false, true, false, false, false, true, false]); +%!assert (isinf (single (Inf))) +%!assert (!isinf (single (NaN))) +%!assert (!isinf (single (NA))) +%!assert (isinf (single (rand(1,10))), false (1,10)) +%!assert (isinf (single ([NaN -Inf -1 0 1 Inf NA])), [false, true, false, false, false, true, false]) - */ +%!error isinf () +%!error isinf (1, 2) +*/ DEFUNX ("isgraph", Fisgraph, args, , "-*- texinfo -*-\n\ @@ -1110,11 +1172,22 @@ return retval; } +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(34:127) = true; +%! assert (all (isgraph (charset) == result)); + +%!error isgraph () +%!error isgraph (1, 2) +*/ + DEFUNX ("islower", Fislower, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} islower (@var{s})\n\ Return a logical array which is true where the elements of @var{s} are\n\ -lower case letters and false where they are not.\n\ +lowercase letters and false where they are not.\n\ @seealso{isupper, isalpha, isletter, isalnum}\n\ @end deftypefn") { @@ -1127,6 +1200,17 @@ return retval; } +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("a":"z") + 1) = true; +%! assert (all (islower (charset) == result)); + +%!error islower () +%!error islower (1, 2) +*/ + DEFUN (isna, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isna (@var{x})\n\ @@ -1153,20 +1237,21 @@ } /* - -%!assert(!(isna (Inf))); -%!assert(!isna (NaN)); -%!assert(isna (NA)); -%!assert(isna (rand(1,10)), false(1,10)); -%!assert(isna([NaN -Inf -1 0 1 Inf NA]), [false, false, false, false, false, false, true]); +%!assert (!isna (Inf)) +%!assert (!isna (NaN)) +%!assert (isna (NA)) +%!assert (isna (rand(1,10)), false (1,10)) +%!assert (isna ([NaN -Inf -1 0 1 Inf NA]), [false, false, false, false, false, false, true]) -%!assert(!(isna (single(Inf)))); -%!assert(!isna (single(NaN))); -%!assert(isna (single(NA))); -%!assert(isna (single(rand(1,10))), false(1,10)); -%!assert(isna(single([NaN -Inf -1 0 1 Inf NA])), [false, false, false, false, false, false, true]); +%!assert (!isna (single (Inf))) +%!assert (!isna (single (NaN))) +%!assert (isna (single (NA))) +%!assert (isna (single (rand(1,10))), false (1,10)) +%!assert (isna (single ([NaN -Inf -1 0 1 Inf NA])), [false, false, false, false, false, false, true]) - */ +%!error isna () +%!error isna (1, 2) +*/ DEFUN (isnan, args, , "-*- texinfo -*-\n\ @@ -1194,20 +1279,21 @@ } /* - -%!assert(!(isnan (Inf))); -%!assert(isnan (NaN)); -%!assert(isnan (NA)); -%!assert(isnan (rand(1,10)), false(1,10)); -%!assert(isnan([NaN -Inf -1 0 1 Inf NA]), [true, false, false, false, false, false, true]); +%!assert (!isnan (Inf)) +%!assert (isnan (NaN)) +%!assert (isnan (NA)) +%!assert (isnan (rand(1,10)), false (1,10)) +%!assert (isnan ([NaN -Inf -1 0 1 Inf NA]), [true, false, false, false, false, false, true]) -%!assert(!(isnan (single(Inf)))); -%!assert(isnan (single(NaN))); -%!assert(isnan (single(NA))); -%!assert(isnan (single(rand(1,10))), false(1,10)); -%!assert(isnan(single([NaN -Inf -1 0 1 Inf NA])), [true, false, false, false, false, false, true]); +%!assert (!isnan (single (Inf))) +%!assert (isnan (single (NaN))) +%!assert (isnan (single (NA))) +%!assert (isnan (single (rand(1,10))), false (1,10)) +%!assert (isnan (single ([NaN -Inf -1 0 1 Inf NA])), [true, false, false, false, false, false, true]) - */ +%!error isnan () +%!error isnan (1, 2) +*/ DEFUNX ("isprint", Fisprint, args, , "-*- texinfo -*-\n\ @@ -1227,6 +1313,17 @@ return retval; } +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(33:127) = true; +%! assert (all (isprint (charset) == result)); + +%!error isprint () +%!error isprint (1, 2) +*/ + DEFUNX ("ispunct", Fispunct, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} ispunct (@var{s})\n\ @@ -1244,6 +1341,20 @@ return retval; } +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(34:48) = true; +%! result(59:65) = true; +%! result(92:97) = true; +%! result(124:127) = true; +%! assert (all (ispunct (charset) == result)); + +%!error ispunct () +%!error ispunct (1, 2) +*/ + DEFUNX ("isspace", Fisspace, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isspace (@var{s})\n\ @@ -1262,11 +1373,22 @@ return retval; } +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii (" \f\n\r\t\v") + 1) = true; +%! assert (all (isspace (charset) == result)); + +%!error isspace () +%!error isspace (1, 2) +*/ + DEFUNX ("isupper", Fisupper, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isupper (@var{s})\n\ Return a logical array which is true where the elements of @var{s} are\n\ -upper case letters and false where they are not.\n\ +uppercase letters and false where they are not.\n\ @seealso{islower, isalpha, isletter, isalnum}\n\ @end deftypefn") { @@ -1279,6 +1401,17 @@ return retval; } +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"Z") + 1) = true; +%! assert (all (isupper (charset) == result)); + +%!error isupper () +%!error isupper (1, 2) +*/ + DEFUNX ("isxdigit", Fisxdigit, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isxdigit (@var{s})\n\ @@ -1296,6 +1429,19 @@ return retval; } +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"F") + 1) = true; +%! result(toascii ("0":"9") + 1) = true; +%! result(toascii ("a":"f") + 1) = true; +%! assert (all (isxdigit (charset) == result)); + +%!error isxdigit () +%!error isxdigit (1, 2) +*/ + DEFUN (lgamma, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} lgamma (@var{x})\n\ @@ -1314,34 +1460,32 @@ } /* - %!test -%! a = -1i*sqrt(-1/(6.4187*6.4187)); +%! a = -1i*sqrt (-1/(6.4187*6.4187)); %! assert (lgamma(a), lgamma(real(a))); %!test %! x = [.5, 1, 1.5, 2, 3, 4, 5]; %! v = [sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]; -%! assert(lgamma(x), log(v), sqrt(eps)) +%! assert (lgamma(x), log(v), sqrt (eps)) %!test -%! a = single(-1i*sqrt(-1/(6.4187*6.4187))); +%! a = single (-1i*sqrt (-1/(6.4187*6.4187))); %! assert (lgamma(a), lgamma(real(a))); %!test -%! x = single([.5, 1, 1.5, 2, 3, 4, 5]); -%! v = single([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); -%! assert(lgamma(x), log(v), sqrt(eps ('single'))) +%! x = single ([.5, 1, 1.5, 2, 3, 4, 5]); +%! v = single ([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); +%! assert (lgamma(x), log(v), sqrt (eps ('single'))) %!test %! x = [-1, 0, 1, Inf]; %! v = [Inf, Inf, 0, Inf]; %! assert (lgamma(x), v); -%! assert (lgamma(single (x)), single(v)); +%! assert (lgamma(single (x)), single (v)); -%!error lgamma(); -%!error lgamma(1,2); - +%!error lgamma() +%!error lgamma(1,2) */ DEFUN (log, args, , @@ -1369,17 +1513,15 @@ } /* - -%!assert(log ([1, e, e^2]), [0, 1, 2], sqrt (eps)); -%!assert(log ([-0.5, -1.5, -2.5]), log([0.5, 1.5, 2.5]) + pi*1i, sqrt (eps)); +%!assert (log ([1, e, e^2]), [0, 1, 2], sqrt (eps)) +%!assert (log ([-0.5, -1.5, -2.5]), log([0.5, 1.5, 2.5]) + pi*1i, sqrt (eps)) -%!assert(log (single([1, e, e^2])), single([0, 1, 2]), sqrt (eps('single'))); -%!assert(log (single([-0.5, -1.5, -2.5])), single(log([0.5, 1.5, 2.5]) + pi*1i), 4*eps('single')); +%!assert (log (single ([1, e, e^2])), single ([0, 1, 2]), sqrt (eps ('single'))) +%!assert (log (single ([-0.5, -1.5, -2.5])), single (log([0.5, 1.5, 2.5]) + pi*1i), 4*eps ('single')) -%!error log (); -%!error log (1, 2); - - */ +%!error log () +%!error log (1, 2) +*/ DEFUN (log10, args, , "-*- texinfo -*-\n\ @@ -1398,13 +1540,11 @@ } /* - -%!assert(log10 ([0.01, 0.1, 1, 10, 100]), [-2, -1, 0, 1, 2], sqrt (eps)); -%!assert(log10 (single([0.01, 0.1, 1, 10, 100])), single([-2, -1, 0, 1, 2]), sqrt (eps ('single'))); +%!assert (log10 ([0.01, 0.1, 1, 10, 100]), [-2, -1, 0, 1, 2], sqrt (eps)) +%!assert (log10 (single ([0.01, 0.1, 1, 10, 100])), single ([-2, -1, 0, 1, 2]), sqrt (eps ('single'))) -%!error log10 (); -%!error log10 (1, 2); - +%!error log10 () +%!error log10 (1, 2) */ DEFUN (log1p, args, , @@ -1430,6 +1570,14 @@ return retval; } +/* +%!assert (log1p ([0, 2*eps, -2*eps]), [0, 2*eps, -2*eps], 1e-29) +%!assert (log1p (single ([0, 2*eps, -2*eps])), single([0, 2*eps, -2*eps]), 1e-29) + +%!error log1p () +%!error log1p (1, 2) +*/ + DEFUN (real, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} real (@var{z})\n\ @@ -1447,27 +1595,26 @@ } /* - -%!assert(real (1), 1); -%!assert(real (i), 0); -%!assert(real (1+i), 1); -%!assert(real ([1, i; i, 1]), full (eye (2))); +%!assert (real (1), 1) +%!assert (real (i), 0) +%!assert (real (1+i), 1) +%!assert (real ([1, i; i, 1]), full (eye (2))) -%!assert(real (single(1)), single(1)); -%!assert(real (single(i)), single(0)); -%!assert(real (single(1+i)), single(1)); -%!assert(real (single([1, i; i, 1])), full (eye (2,'single'))); +%!assert (real (single (1)), single (1)) +%!assert (real (single (i)), single (0)) +%!assert (real (single (1+i)), single (1)) +%!assert (real (single ([1, i; i, 1])), full (eye (2,'single'))) -%!error real (); -%!error real (1, 2); - +%!error real () +%!error real (1, 2) */ DEFUN (round, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} round (@var{x})\n\ Return the integer nearest to @var{x}. If @var{x} is complex, return\n\ -@code{round (real (@var{x})) + round (imag (@var{x})) * I}.\n\ +@code{round (real (@var{x})) + round (imag (@var{x})) * I}. If there\n\ +are two nearest integers, return the one further away from zero.\n\ \n\ @example\n\ @group\n\ @@ -1475,7 +1622,7 @@ @result{} -3 3\n\ @end group\n\ @end example\n\ -@seealso{ceil, floor, fix}\n\ +@seealso{ceil, floor, fix, roundb}\n\ @end deftypefn") { octave_value retval; @@ -1488,26 +1635,24 @@ } /* - -%!assert(round (1), 1); -%!assert(round (1.1), 1); -%!assert(round (5.5), 6); -%!assert(round (i), i); -%!assert(round (2.5+3.5i), 3+4i); -%!assert(round (-2.6), -3); -%!assert(round ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]); +%!assert (round (1), 1) +%!assert (round (1.1), 1) +%!assert (round (5.5), 6) +%!assert (round (i), i) +%!assert (round (2.5+3.5i), 3+4i) +%!assert (round (-2.6), -3) +%!assert (round ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]) -%!assert(round (single(1)), single(1)); -%!assert(round (single(1.1)), single(1)); -%!assert(round (single(5.5)), single(6)); -%!assert(round (single(i)), single(i)); -%!assert(round (single(2.5+3.5i)), single(3+4i)); -%!assert(round (single(-2.6)), single(-3)); -%!assert(round (single([1.1, -2.4; -3.7, 7.1])), single([1, -2; -4, 7])); +%!assert (round (single (1)), single (1)) +%!assert (round (single (1.1)), single (1)) +%!assert (round (single (5.5)), single (6)) +%!assert (round (single (i)), single (i)) +%!assert (round (single (2.5+3.5i)), single (3+4i)) +%!assert (round (single (-2.6)), single (-3)) +%!assert (round (single ([1.1, -2.4; -3.7, 7.1])), single ([1, -2; -4, 7])) -%!error round (); -%!error round (1, 2); - +%!error round () +%!error round (1, 2) */ DEFUN (roundb, args, , @@ -1528,6 +1673,29 @@ return retval; } +/* +%!assert (roundb (1), 1) +%!assert (roundb (1.1), 1) +%!assert (roundb (1.5), 2) +%!assert (roundb (4.5), 4) +%!assert (roundb (i), i) +%!assert (roundb (2.5+3.5i), 2+4i) +%!assert (roundb (-2.6), -3) +%!assert (roundb ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]) + +%!assert (roundb (single (1)), single (1)) +%!assert (roundb (single (1.1)), single (1)) +%!assert (roundb (single (1.5)), single (2)) +%!assert (roundb (single (4.5)), single (4)) +%!assert (roundb (single (i)), single (i)) +%!assert (roundb (single (2.5+3.5i)), single (2+4i)) +%!assert (roundb (single (-2.6)), single (-3)) +%!assert (roundb (single ([1.1, -2.4; -3.7, 7.1])), single ([1, -2; -4, 7])) + +%!error roundb () +%!error roundb (1, 2) +*/ + DEFUN (sign, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} sign (@var{x})\n\ @@ -1562,20 +1730,18 @@ } /* - -%!assert(sign (-2) , -1); -%!assert(sign (3), 1); -%!assert(sign (0), 0); -%!assert(sign ([1, -pi; e, 0]), [1, -1; 1, 0]); +%!assert (sign (-2) , -1) +%!assert (sign (0), 0) +%!assert (sign (3), 1) +%!assert (sign ([1, -pi; e, 0]), [1, -1; 1, 0]) -%!assert(sign (single(-2)) , single(-1)); -%!assert(sign (single(3)), single(1)); -%!assert(sign (single(0)), single(0)); -%!assert(sign (single([1, -pi; e, 0])), single([1, -1; 1, 0])); +%!assert (sign (single (-2)) , single (-1)) +%!assert (sign (single (0)), single (0)) +%!assert (sign (single (3)), single (1)) +%!assert (sign (single ([1, -pi; e, 0])), single ([1, -1; 1, 0])) -%!error sign (); -%!error sign (1, 2); - +%!error sign () +%!error sign (1, 2) */ DEFUN (sin, args, , @@ -1595,24 +1761,22 @@ } /* - -%!test +%!shared rt2, rt3 %! rt2 = sqrt (2); %! rt3 = sqrt (3); -%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! v = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; -%! assert(sin (x), v, sqrt (eps)); %!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! x = single([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! v = single([0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]); -%! assert(sin (x), v, sqrt (eps('single'))); +%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! v = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; +%! assert (sin (x), v, sqrt (eps)); -%!error sin (); -%!error sin (1, 2); +%!test +%! x = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! v = single ([0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]); +%! assert (sin (x), v, sqrt (eps ('single'))); +%!error sin () +%!error sin (1, 2) */ DEFUN (sinh, args, , @@ -1632,21 +1796,19 @@ } /* - %!test %! x = [0, pi/2*i, pi*i, 3*pi/2*i]; %! v = [0, i, 0, -i]; -%! assert(sinh (x), v, sqrt (eps)); +%! assert (sinh (x), v, sqrt (eps)); %!test -%! x = single([0, pi/2*i, pi*i, 3*pi/2*i]); -%! v = single([0, i, 0, -i]); -%! assert(sinh (x), v, sqrt (eps('single'))); +%! x = single ([0, pi/2*i, pi*i, 3*pi/2*i]); +%! v = single ([0, i, 0, -i]); +%! assert (sinh (x), v, sqrt (eps ('single'))); -%!error sinh (); -%!error sinh (1, 2); - - */ +%!error sinh () +%!error sinh (1, 2) +*/ DEFUN (sqrt, args, , "-*- texinfo -*-\n\ @@ -1667,20 +1829,18 @@ } /* - -%!assert(sqrt (4), 2) -%!assert(sqrt (-1), i) -%!assert(sqrt (1+i), exp (0.5 * log (1+i)), sqrt (eps)); -%!assert(sqrt([4, -4; i, 1-i]), [2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))], sqrt(eps)); +%!assert (sqrt (4), 2) +%!assert (sqrt (-1), i) +%!assert (sqrt (1+i), exp (0.5 * log (1+i)), sqrt (eps)) +%!assert (sqrt ([4, -4; i, 1-i]), [2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))], sqrt (eps)) -%!assert(sqrt (single(4)), single(2)) -%!assert(sqrt (single(-1)), single(i)) -%!assert(sqrt (single(1+i)), single(exp (0.5 * log (1+i))), sqrt (eps('single'))); -%!assert(sqrt(single([4, -4; i, 1-i])), single([2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))]), sqrt(eps('single'))); +%!assert (sqrt (single (4)), single (2)) +%!assert (sqrt (single (-1)), single (i)) +%!assert (sqrt (single (1+i)), single (exp (0.5 * log (1+i))), sqrt (eps ('single'))) +%!assert (sqrt (single ([4, -4; i, 1-i])), single ([2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))]), sqrt (eps ('single'))) -%!error sqrt (); -%!error sqrt (1, 2); - +%!error sqrt () +%!error sqrt (1, 2) */ DEFUN (tan, args, , @@ -1700,24 +1860,22 @@ } /* - -%!test +%!shared rt2, rt3 %! rt2 = sqrt (2); %! rt3 = sqrt (3); -%! x = [0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! v = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; -%! assert(tan (x), v, sqrt (eps)); %!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! x = single([0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! v = single([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); -%! assert(tan (x), v, sqrt (eps('single'))); +%! x = [0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! v = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; +%! assert (tan (x), v, sqrt (eps)); -%!error tan (); -%!error tan (1, 2); +%!test +%! x = single ([0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! v = single ([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); +%! assert (tan (x), v, sqrt (eps ('single'))); +%!error tan () +%!error tan (1, 2) */ DEFUN (tanh, args, , @@ -1737,20 +1895,18 @@ } /* - %!test %! x = [0, pi*i]; %! v = [0, 0]; -%! assert(tanh (x), v, sqrt (eps)); +%! assert (tanh (x), v, sqrt (eps)); %!test -%! x = single([0, pi*i]); -%! v = single([0, 0]); -%! assert(tanh (x), v, sqrt (eps('single'))); +%! x = single ([0, pi*i]); +%! v = single ([0, 0]); +%! assert (tanh (x), v, sqrt (eps ('single'))); -%!error tanh (); -%!error tanh (1, 2); - +%!error tanh () +%!error tanh (1, 2) */ DEFUNX ("toascii", Ftoascii, args, , @@ -1777,12 +1933,24 @@ return retval; } +/* +%!assert (toascii (char (0:127)), 0:127) +%!assert (toascii (" ":"@"), 32:64) +%!assert (toascii ("A":"Z"), 65:90) +%!assert (toascii ("[":"`"), 91:96) +%!assert (toascii ("a":"z"), 97:122) +%!assert (toascii ("{":"~"), 123:126) + +%!error toascii () +%!error toascii (1, 2) +*/ + DEFUNX ("tolower", Ftolower, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} tolower (@var{s})\n\ @deftypefnx {Mapping Function} {} lower (@var{s})\n\ -Return a copy of the string or cell string @var{s}, with each upper-case\n\ -character replaced by the corresponding lower-case one; non-alphabetic\n\ +Return a copy of the string or cell string @var{s}, with each uppercase\n\ +character replaced by the corresponding lowercase one; non-alphabetic\n\ characters are left unchanged. For example:\n\ \n\ @example\n\ @@ -1806,29 +1974,34 @@ DEFALIAS (lower, tolower); /* - -%!error <Invalid call to tolower.*> tolower(); -%!error <Invalid call to tolower.*> lower(); -%!assert(tolower("OCTAVE"), "octave"); -%!assert(tolower("123OCTave!_&"), "123octave!_&"); -%!assert(tolower({"ABC", "DEF", {"GHI", {"JKL"}}}), {"abc", "def", {"ghi", {"jkl"}}}); -%!assert(tolower(["ABC"; "DEF"]), ["abc"; "def"]); -%!assert(tolower({["ABC"; "DEF"]}), {["abc";"def"]}); -%!assert(tolower(68), "d"); -%!assert(tolower({[68, 68; 68, 68]}), {["dd";"dd"]}); +%!assert (tolower("OCTAVE"), "octave") +%!assert (tolower("123OCTave!_&"), "123octave!_&") +%!assert (tolower({"ABC", "DEF", {"GHI", {"JKL"}}}), {"abc", "def", {"ghi", {"jkl"}}}) +%!assert (tolower(["ABC"; "DEF"]), ["abc"; "def"]) +%!assert (tolower({["ABC"; "DEF"]}), {["abc";"def"]}) +%!assert (tolower(68), "d") +%!assert (tolower({[68, 68; 68, 68]}), {["dd";"dd"]}) %!test %! a(3,3,3,3) = "D"; %! assert(tolower(a)(3,3,3,3), "d"); +%!test +%! charset = char (0:127); +%! result = charset; +%! result(toascii ("A":"Z") + 1) = result(toascii ("a":"z") + 1); +%! assert (all (tolower (charset) == result)); + +%!error <Invalid call to tolower> tolower() +%!error <Invalid call to tolower> lower() +%!error tolower (1, 2) */ - DEFUNX ("toupper", Ftoupper, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} toupper (@var{s})\n\ -@deftypefnx {Built-in Function} {} upper (@var{s})\n\ -Return a copy of the string or cell string @var{s}, with each lower-case\n\ -character replaced by the corresponding upper-case one; non-alphabetic\n\ +@deftypefn {Mapping Function} {} toupper (@var{s})\n\ +@deftypefnx {Mapping Function} {} upper (@var{s})\n\ +Return a copy of the string or cell string @var{s}, with each lowercase\n\ +character replaced by the corresponding uppercase one; non-alphabetic\n\ characters are left unchanged. For example:\n\ \n\ @example\n\ @@ -1852,20 +2025,25 @@ DEFALIAS (upper, toupper); /* - -%!error <Invalid call to toupper.*> toupper(); -%!error <Invalid call to toupper.*> upper(); -%!assert(toupper("octave"), "OCTAVE"); -%!assert(toupper("123OCTave!_&"), "123OCTAVE!_&"); -%!assert(toupper({"abc", "def", {"ghi", {"jkl"}}}), {"ABC", "DEF", {"GHI", {"JKL"}}}); -%!assert(toupper(["abc"; "def"]), ["ABC"; "DEF"]); -%!assert(toupper({["abc"; "def"]}), {["ABC";"DEF"]}); -%!assert(toupper(100), "D"); -%!assert(toupper({[100, 100; 100, 100]}), {["DD";"DD"]}); +%!assert (toupper ("octave"), "OCTAVE") +%!assert (toupper ("123OCTave!_&"), "123OCTAVE!_&") +%!assert (toupper ({"abc", "def", {"ghi", {"jkl"}}}), {"ABC", "DEF", {"GHI", {"JKL"}}}) +%!assert (toupper (["abc"; "def"]), ["ABC"; "DEF"]) +%!assert (toupper ({["abc"; "def"]}), {["ABC";"DEF"]}) +%!assert (toupper (100), "D") +%!assert (toupper ({[100, 100; 100, 100]}), {["DD";"DD"]}) %!test %! a(3,3,3,3) = "d"; -%! assert(toupper(a)(3,3,3,3), "D"); +%! assert(toupper (a)(3,3,3,3), "D"); +%!test +%! charset = char (0:127); +%! result = charset; +%! result(toascii ("a":"z") + 1) = result(toascii ("A":"Z") + 1); +%! assert (all (toupper (charset) == result)); +%!error <Invalid call to toupper> toupper() +%!error <Invalid call to toupper> upper() +%!error toupper (1, 2) */ DEFALIAS (gammaln, lgamma);
--- a/src/mex.cc +++ b/src/mex.cc @@ -1274,10 +1274,17 @@ int get_string (char *buf, mwSize buflen) const { - int retval = 1; + int retval = 0; mwSize nel = get_number_of_elements (); + if (! (nel < buflen)) + { + retval = 1; + if (buflen > 0) + nel = buflen-1; + } + if (nel < buflen) { mxChar *ptr = static_cast<mxChar *> (pr);
rename from mkoctfile.cc.in rename to src/mkoctfile.cc.in --- a/mkoctfile.cc.in +++ b/src/mkoctfile.cc.in @@ -219,7 +219,6 @@ vars["DL_LD"] = get_variable ("DL_LD", %OCTAVE_CONF_DL_LD%); vars["DL_LDFLAGS"] = get_variable ("DL_LDFLAGS", %OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS%); - vars["RLD_FLAG"] = get_variable ("RLD_FLAG", %OCTAVE_CONF_RLD_FLAG%); vars["RDYNAMIC_FLAG"] = get_variable ("RDYNAMIC_FLAG", %OCTAVE_CONF_RDYNAMIC_FLAG%); vars["LIBOCTAVE"] = "-loctave"; vars["LIBOCTINTERP"] = "-loctinterp"; @@ -233,6 +232,10 @@ vars["FFTW3F_LIBS"] = get_variable ("FFTW3F_LIBS", %OCTAVE_CONF_FFTW3F_LIBS%); vars["LIBS"] = get_variable ("LIBS", %OCTAVE_CONF_LIBS%); vars["FLIBS"] = get_variable ("FLIBS", %OCTAVE_CONF_FLIBS%); + vars["OCTAVE_LINK_DEPS"] = get_variable ("FLIBS", %OCTAVE_CONF_OCTAVE_LINK_DEPS%); + vars["OCT_LINK_DEPS"] = get_variable ("FLIBS", %OCTAVE_CONF_OCT_LINK_DEPS%); + vars["FLIBS"] = get_variable ("FLIBS", %OCTAVE_CONF_FLIBS%); + vars["LD_CXX"] = get_variable ("LD_CXX", %OCTAVE_CONF_LD_CXX%); vars["LDFLAGS"] = get_variable ("LDFLAGS", %OCTAVE_CONF_LDFLAGS%); vars["LD_STATIC_FLAG"] = get_variable ("LD_STATIC_FLAG", %OCTAVE_CONF_LD_STATIC_FLAG%); @@ -296,25 +299,30 @@ " -p VAR, --print VAR Print configuration variable VAR. Recognized\n" " variables are:\n" "\n" -" ALL_CFLAGS FLIBS\n" -" ALL_CXXFLAGS FPICFLAG\n" -" ALL_FFLAGS INCFLAGS\n" -" ALL_LDFLAGS LAPACK_LIBS\n" -" BLAS_LIBS LDFLAGS\n" -" CC LD_CXX\n" -" CFLAGS LD_STATIC_FLAG\n" -" CPICFLAG LFLAGS\n" -" CPPFLAGS LIBCRUFT\n" -" CXX LIBOCTAVE\n" -" CXXFLAGS LIBOCTINTERP\n" -" CXXPICFLAG LIBS\n" -" DEPEND_EXTRA_SED_PATTERN OCTAVE_LIBS\n" -" DEPEND_FLAGS RDYNAMIC_FLAG\n" -" DL_LD READLINE_LIBS\n" -" DL_LDFLAGS RLD_FLAG\n" -" F77 SED\n" -" FFLAGS XTRA_CFLAGS\n" -" FFTW_LIBS XTRA_CXXFLAGS\n" +" ALL_CFLAGS FLIBS\n" +" ALL_CXXFLAGS FPICFLAG\n" +" ALL_FFLAGS INCFLAGS\n" +" ALL_LDFLAGS LAPACK_LIBS\n" +" BLAS_LIBS LDFLAGS\n" +" CC LD_CXX\n" +" CFLAGS LD_STATIC_FLAG\n" +" CPICFLAG LFLAGS\n" +" CPPFLAGS LIBCRUFT\n" +" CXX LIBOCTAVE\n" +" CXXFLAGS LIBOCTINTERP\n" +" CXXPICFLAG LIBS\n" +" DEPEND_EXTRA_SED_PATTERN OCTAVE_LIBS\n" +" DEPEND_FLAGS OCTAVE_LINK_DEPS\n" +" DL_LD OCTAVE_LINK_OPTS\n" +" DL_LDFLAGS OCT_LINK_DEPS\n" +" EXEEXT OCT_LINK_OPTS\n" +" F77 RDYNAMIC_FLAG\n" +" F77_INTEGER_8_FLAG READLINE_LIBS\n" +" FFLAGS SED\n" +" FFTW3_LDFLAGS XTRA_CFLAGS\n" +" FFTW3_LIBS XTRA_CXXFLAGS\n" +" FFTW3F_LDFLAGS\n" +" FFTW3F_LIBS\n" "\n" " --link-stand-alone Link a stand-alone executable file.\n" "\n" @@ -742,11 +750,10 @@ + vars["ALL_CXXFLAGS"] + " " + vars["RDYNAMIC_FLAG"] + " " + vars["ALL_LDFLAGS"] + " " + pass_on_options + " " + output_option + " " + objfiles + " " + libfiles - + " " + ldflags + " " + vars["LFLAGS"] + " " - + vars["RLD_FLAG"] + " " + vars["OCTAVE_LIBS"] + " " - + vars["LAPACK_LIBS"] + " " + vars["BLAS_LIBS"] + " " - + vars["FFTW_LIBS"] + " " + vars["READLINE_LIBS"] + " " - + vars["LIBS"] + " " + vars["FLIBS"]; + + " " + ldflags + " " + vars["LFLAGS"] + + " -loctinterp -loctave -lcruft " + + " " + vars["OCT_LINK_OPTS"] + + " " + vars["OCTAVE_LINK_DEPS"]; result = run_command (cmd); } else @@ -758,12 +765,11 @@ } else { - string LINK_DEPS = vars["LFLAGS"] + " " + vars["OCTAVE_LIBS"] - + " " + vars["LDFLAGS"] + " " + vars["BLAS_LIBS"] + " " - + vars["FFTW_LIBS"] + " " + vars["LIBS"] + " " + vars["FLIBS"]; string cmd = vars["DL_LD"] + " " + vars["DL_LDFLAGS"] + " " + pass_on_options + " -o " + octfile + " " + objfiles + " " - + libfiles + " " + ldflags + " " + LINK_DEPS; + + libfiles + " " + ldflags + " " + vars["LFLAGS"] + + " -loctinterp -loctave -lcruft " + + vars["OCT_LINK_OPTS"] + " " + vars["OCT_LINK_DEPS"]; result = run_command (cmd); }
rename from mkoctfile.in rename to src/mkoctfile.in --- a/mkoctfile.in +++ b/src/mkoctfile.in @@ -85,7 +85,6 @@ : ${DL_LD=%OCTAVE_CONF_DL_LD%} : ${DL_LDFLAGS=%OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS%} -: ${RLD_FLAG=%OCTAVE_CONF_RLD_FLAG%} : ${RDYNAMIC_FLAG=%OCTAVE_CONF_RDYNAMIC_FLAG%} : ${LIBOCTAVE=-loctave} : ${LIBOCTINTERP=-loctinterp} @@ -99,6 +98,10 @@ : ${FFTW3F_LIBS=%OCTAVE_CONF_FFTW3F_LIBS%} : ${LIBS=%OCTAVE_CONF_LIBS%} : ${FLIBS=%OCTAVE_CONF_FLIBS%} +: ${OCTAVE_LINK_DEPS=%OCTAVE_CONF_OCTAVE_LINK_DEPS%} +: ${OCTAVE_LINK_OPTS=%OCTAVE_CONF_OCTAVE_LINK_OPTS%} +: ${OCT_LINK_DEPS=%OCTAVE_CONF_OCT_LINK_DEPS%} +: ${OCT_LINK_OPTS=%OCTAVE_CONF_OCT_LINK_OPTS%} : ${LD_CXX=%OCTAVE_CONF_LD_CXX%} : ${LDFLAGS=%OCTAVE_CONF_LDFLAGS%} : ${LD_STATIC_FLAG=%OCTAVE_CONF_LD_STATIC_FLAG%} @@ -221,7 +224,7 @@ -s, --strip Strip output file. - --mex Create a MEX file. + --mex Create a MEX file. Set the default output extension to ".mex". -o FILE, --output FILE Output file name. Default extension is .oct @@ -231,28 +234,29 @@ -p VAR, --print VAR Print configuration variable VAR. Recognized variables are: - ALL_CFLAGS FFTW3F_LDFLAGS - ALL_CXXFLAGS FFTW3F_LIBS - ALL_FFLAGS FLIBS - ALL_LDFLAGS FPICFLAG - BLAS_LIBS INCFLAGS - CC LAPACK_LIBS - CFLAGS LDFLAGS - CPICFLAG LD_CXX - CPPFLAGS LD_STATIC_FLAG - CXX LFLAGS - CXXFLAGS LIBCRUFT - CXXPICFLAG LIBOCTAVE - DEPEND_EXTRA_SED_PATTERN LIBOCTINTERP - DEPEND_FLAGS LIBS - DL_LD OCTAVE_LIBS - DL_LDFLAGS RDYNAMIC_FLAG - EXEEXT READLINE_LIBS - F77 RLD_FLAG + ALL_CFLAGS FFTW3F_LIBS + ALL_CXXFLAGS FLIBS + ALL_FFLAGS FPICFLAG + ALL_LDFLAGS INCFLAGS + BLAS_LIBS LAPACK_LIBS + CC LDFLAGS + CFLAGS LD_CXX + CPICFLAG LD_STATIC_FLAG + CPPFLAGS LFLAGS + CXX LIBCRUFT + CXXFLAGS LIBOCTAVE + CXXPICFLAG LIBOCTINTERP + DEPEND_EXTRA_SED_PATTERN LIBS + DEPEND_FLAGS OCTAVE_LIBS + DL_LD OCTAVE_LINK_DEPS + DL_LDFLAGS OCT_LINK_DEPS + EXEEXT RDYNAMIC_FLAG + F77 READLINE_LIBS F77_INTEGER_8_FLAG SED FFLAGS XTRA_CFLAGS FFTW3_LDFLAGS XTRA_CXXFLAGS FFTW3_LIBS + FFTW3F_LDFLAGS -v, --verbose Echo commands as they are executed. @@ -529,7 +533,7 @@ if $link && [ -n "$objfiles" ]; then if $link_stand_alone; then if [ -n "$LD_CXX" ]; then - cmd="$LD_CXX $CPPFLAGS $ALL_CXXFLAGS $RDYNAMIC_FLAG $ALL_LDFLAGS $pass_on_options $output_option $objfiles $libfiles $ldflags $LFLAGS $RLD_FLAG $OCTAVE_LIBS $LAPACK_LIBS $BLAS_LIBS $FFTW_LIBS $READLINE_LIBS $LIBS $FLIBS" + cmd="$LD_CXX $CPPFLAGS $ALL_CXXFLAGS $RDYNAMIC_FLAG $ALL_LDFLAGS $pass_on_options $output_option $objfiles $libfiles $ldflags $LFLAGS -loctinterp -loctave -lcruft $OCTAVE_LINK_OPTS $OCTAVE_LINK_DEPS" $dbg $cmd eval $cmd else @@ -537,8 +541,7 @@ exit 1 fi else - LINK_DEPS="$LFLAGS $OCTAVE_LIBS $LDFLAGS $LAPACK_LIBS $BLAS_LIBS $FFTW_LIBS $LIBS $FLIBS" - cmd="$DL_LD $DL_LDFLAGS $pass_on_options -o $octfile $objfiles $libfiles $ldflags $LINK_DEPS" + cmd="$DL_LD $DL_LDFLAGS $pass_on_options -o $octfile $objfiles $libfiles $ldflags $LFLAGS -loctinterp -loctave -lcruft $OCT_LINK_OPTS $OCT_LINK_DEPS" $dbg $cmd eval $cmd fi
--- a/src/oct-conf.h.in +++ b/src/oct-conf.h.in @@ -376,6 +376,14 @@ #define OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS %OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS% #endif +#ifndef OCTAVE_CONF_OCTAVE_LINK_DEPS +#define OCTAVE_CONF_OCTAVE_LINK_DEPS %OCTAVE_CONF_OCTAVE_LINK_DEPS% +#endif + +#ifndef OCTAVE_CONF_OCTAVE_LINK_OPTS +#define OCTAVE_CONF_OCTAVE_LINK_OPTS %OCTAVE_CONF_OCTAVE_LINK_OPTS% +#endif + #ifndef OCTAVE_CONF_OCTINCLUDEDIR #define OCTAVE_CONF_OCTINCLUDEDIR %OCTAVE_CONF_OCTINCLUDEDIR% #endif @@ -384,6 +392,14 @@ #define OCTAVE_CONF_OCTLIBDIR %OCTAVE_CONF_OCTLIBDIR% #endif +#ifndef OCTAVE_CONF_OCT_LINK_DEPS +#define OCTAVE_CONF_OCT_LINK_DEPS %OCTAVE_CONF_OCT_LINK_DEPS% +#endif + +#ifndef OCTAVE_CONF_OCT_LINK_OPTS +#define OCTAVE_CONF_OCT_LINK_OPTS %OCTAVE_CONF_OCT_LINK_OPTS% +#endif + #ifndef OCTAVE_CONF_OPENGL_LIBS #define OCTAVE_CONF_OPENGL_LIBS %OCTAVE_CONF_OPENGL_LIBS% #endif @@ -440,10 +456,6 @@ #define OCTAVE_CONF_REGEX_LIBS %OCTAVE_CONF_REGEX_LIBS% #endif -#ifndef OCTAVE_CONF_RLD_FLAG -#define OCTAVE_CONF_RLD_FLAG %OCTAVE_CONF_RLD_FLAG% -#endif - #ifndef OCTAVE_CONF_SED #define OCTAVE_CONF_SED %OCTAVE_CONF_SED% #endif
--- a/src/oct-errno.cc.in +++ b/src/oct-errno.cc.in @@ -27,6 +27,8 @@ #include <cerrno> +#include "singleton-cleanup.h" + #include "oct-errno.h" #include "oct-map.h" #include "error.h" @@ -292,7 +294,12 @@ bool retval = true; if (! instance) - instance = new octave_errno (); + { + instance = new octave_errno (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) {
--- a/src/oct-errno.h +++ b/src/oct-errno.h @@ -43,6 +43,8 @@ static bool instance_ok (void); + static void cleanup_instance (void) { delete instance; instance = 0; } + static int lookup (const std::string& name); static octave_scalar_map list (void);
--- a/src/oct-hist.cc +++ b/src/oct-hist.cc @@ -88,9 +88,6 @@ return file; } -// Where history is saved. -static std::string Vhistory_file = default_history_file (); - static int default_history_size (void) { @@ -109,27 +106,6 @@ return size; } -// The number of lines to keep in the history file. -static int Vhistory_size = default_history_size (); - -static std::string -default_history_control (void) -{ - std::string retval; - - std::string env_histcontrol = octave_env::getenv ("OCTAVE_HISTCONTROL"); - - if (! env_histcontrol.empty ()) - { - return env_histcontrol; - } - - return retval; -} - -// The number of lines to keep in the history file. -static std::string Vhistory_control = default_history_control (); - static std::string default_history_timestamp_format (void) { @@ -146,9 +122,6 @@ static std::string Vhistory_timestamp_format_string = default_history_timestamp_format (); -// TRUE if we are saving history. -bool Vsaving_history = true; - // Display, save, or load history. Stolen and modified from bash. // // Arg of -w FILENAME means write file, arg of -r FILENAME @@ -160,6 +133,10 @@ { int numbered_output = 1; + unwind_protect frame; + + frame.add_fcn (command_history::set_file, command_history::file ()); + int i; for (i = 1; i < argc; i++) { @@ -537,8 +514,10 @@ void initialize_history (bool read_history_file) { - command_history::initialize (read_history_file, Vhistory_file, Vhistory_size, - Vhistory_control); + command_history::initialize (read_history_file, + default_history_file (), + default_history_size (), + octave_env::getenv ("OCTAVE_HISTCONTROL")); } void @@ -559,7 +538,7 @@ history list using the editor named by the variable @w{@env{EDITOR}}. The\n\ commands to be edited are first copied to a temporary file. When you\n\ exit the editor, Octave executes the commands that remain in the file.\n\ -It is often more convenient to use @code{edit_history} to define functions \n\ +It is often more convenient to use @code{edit_history} to define functions\n\ rather than attempting to enter them directly on the command line.\n\ By default, the block of commands is executed as soon as you exit the\n\ editor. To avoid executing any commands, simply delete all the lines\n\ @@ -615,7 +594,7 @@ omitted, use the default history file (normally @file{~/.octave_hist}).\n\ \n\ @item -r @var{file}\n\ -Read the file @var{file}, appending its contents to the current \n\ +Read the file @var{file}, appending its contents to the current\n\ history list. If the name is omitted, use the default history file\n\ (normally @file{~/.octave_hist}).\n\ \n\ @@ -691,12 +670,15 @@ @seealso{history_file, history_size, history_timestamp_format_string, saving_history}\n\ @end deftypefn") { - std::string saved_history_control = Vhistory_control; + std::string old_history_control = command_history::histcontrol (); + + std::string tmp = old_history_control; - octave_value retval = SET_INTERNAL_VARIABLE (history_control); + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_control"); - if (Vhistory_control != saved_history_control) - command_history::process_histcontrol (Vhistory_control); + if (tmp != old_history_control) + command_history::process_histcontrol (tmp); return retval; } @@ -711,13 +693,15 @@ @seealso{history_file, history_timestamp_format_string, saving_history}\n\ @end deftypefn") { - int saved_history_size = Vhistory_size; + int old_history_size = command_history::size (); + + int tmp = old_history_size; - octave_value retval - = SET_INTERNAL_VARIABLE_WITH_LIMITS (history_size, -1, INT_MAX); + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_size", -1, INT_MAX); - if (Vhistory_size != saved_history_size) - command_history::set_size (Vhistory_size); + if (tmp != old_history_size) + command_history::set_size (tmp); return retval; } @@ -733,12 +717,15 @@ @seealso{history_size, saving_history, history_timestamp_format_string}\n\ @end deftypefn") { - std::string saved_history_file = Vhistory_file; + std::string old_history_file = command_history::file (); + + std::string tmp = old_history_file; - octave_value retval = SET_INTERNAL_VARIABLE (history_file); + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_file"); - if (Vhistory_file != saved_history_file) - command_history::set_file (Vhistory_file); + if (tmp != old_history_file) + command_history::set_file (tmp); return retval; } @@ -747,6 +734,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} history_timestamp_format_string ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} history_timestamp_format_string (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} history_timestamp_format_string (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the format string\n\ for the comment line that is written to the history file when Octave\n\ exits. The format string is passed to @code{strftime}. The default\n\ @@ -755,6 +743,10 @@ @example\n\ \"# Octave VERSION, %a %b %d %H:%M:%S %Y %Z <USER@@HOST>\"\n\ @end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{strftime, history_file, history_size, saving_history}\n\ @end deftypefn") { @@ -765,14 +757,25 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} saving_history ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} saving_history (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} saving_history (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether commands entered\n\ on the command line are saved in the history file.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{history_control, history_file, history_size, history_timestamp_format_string}\n\ @end deftypefn") { - octave_value retval = SET_INTERNAL_VARIABLE (saving_history); + bool old_saving_history = ! command_history::ignoring_entries (); + + bool tmp = old_saving_history; - command_history::ignore_entries (! Vsaving_history); + octave_value retval = set_internal_variable (tmp, args, nargout, + "saving_history"); + + if (tmp != old_saving_history) + command_history::ignore_entries (! tmp); return retval; }
--- a/src/oct-hist.h +++ b/src/oct-hist.h @@ -35,7 +35,4 @@ // TRUE means input is coming from temporary history file. extern bool input_from_tmp_history_file; -// TRUE if we are saving history. -extern bool Vsaving_history; - #endif
--- a/src/oct-map.cc +++ b/src/oct-map.cc @@ -664,6 +664,7 @@ octave_map::cat (int dim, octave_idx_type n, const octave_scalar_map *map_list) { octave_map retval; + // Allow dim = -1, -2 for compatibility, though it makes no difference here. if (dim == -1 || dim == -2) dim = -dim - 1; @@ -671,7 +672,9 @@ (*current_liboctave_error_handler) ("cat: invalid dimension"); - if (n > 0) + if (n == 1) + retval = map_list[0]; + else if (n > 1) { octave_idx_type idx, nf = 0; for (idx = 0; idx < n; idx++) @@ -726,9 +729,20 @@ octave_map::cat (int dim, octave_idx_type n, const octave_map *map_list) { octave_map retval; - if (n > 0) + + // Allow dim = -1, -2 for compatibility, though it makes no difference here. + if (dim == -1 || dim == -2) + dim = -dim - 1; + else if (dim < 0) + (*current_liboctave_error_handler) + ("cat: invalid dimension"); + + if (n == 1) + retval = map_list[0]; + else if (n > 1) { octave_idx_type idx, nf = 0; + for (idx = 0; idx < n; idx++) { nf = map_list[idx].nfields (); @@ -741,31 +755,45 @@ // Try the fast case. bool all_same = true; - for (octave_idx_type i = 0; i < n; i++) + + if (nf > 0) { - all_same = map_list[idx].xkeys.is_same (map_list[i].xkeys); - if (! all_same) - break; + for (octave_idx_type i = 0; i < n; i++) + { + all_same = map_list[idx].xkeys.is_same (map_list[i].xkeys); + + if (! all_same) + break; + } } - if (all_same) + if (all_same && nf > 0) do_cat (dim, n, map_list, retval); else { - // permute all structures to correct order. - OCTAVE_LOCAL_BUFFER (octave_map, new_map_list, n); + if (nf > 0) + { + // permute all structures to correct order. + OCTAVE_LOCAL_BUFFER (octave_map, new_map_list, n); - permute_to_correct_order (n, nf, idx, map_list, new_map_list); + permute_to_correct_order (n, nf, idx, map_list, new_map_list); - if (nf > 0) - do_cat (dim, n, new_map_list, retval); + do_cat (dim, n, new_map_list, retval); + } else { - // Use dummy arrays. FIXME: Need(?) a better solution. - OCTAVE_LOCAL_BUFFER (Array<char>, dummy, n); - for (octave_idx_type i = 0; i < n; i++) - dummy[i].clear (map_list[i].dimensions); - Array<char>::cat (dim, n, dummy); + dim_vector dv = map_list[0].dimensions; + + for (octave_idx_type i = 1; i < n; i++) + { + if (! dv.concat (map_list[i].dimensions, dim)) + { + error ("dimension mismatch in struct concatenation"); + return retval; + } + } + + retval.dimensions = dv; } } @@ -781,6 +809,18 @@ %! x(1, 1).d = 10; x(4, 6).a = "b"; x(2, 4).f = 27; %! y(1, 6).f = 11; y(1, 6).a = "c"; y(1, 6).d = 33; %! assert (fieldnames ([x; y]), {"d"; "a"; "f"}); + +%!test +%! s = struct (); +%! sr = [s,s]; +%! sc = [s;s]; +%! sm = [s,s;s,s]; +%! assert (nfields (sr), 0); +%! assert (nfields (sc), 0); +%! assert (nfields (sm), 0); +%! assert (size (sr), [1, 2]); +%! assert (size (sc), [2, 1]); +%! assert (size (sm), [2, 2]); */ octave_map
--- a/src/oct-map.h +++ b/src/oct-map.h @@ -53,8 +53,8 @@ static fields_rep *nil_rep (void) { - static fields_rep *nr = new fields_rep (); - return nr; + static fields_rep nr; + return &nr; } public: @@ -73,8 +73,12 @@ { if (rep->count > 1) { - --rep->count; - rep = new fields_rep (*rep); + fields_rep *r = new fields_rep (*rep); + + if (--rep->count == 0) + delete rep; + + rep = r; } }
--- a/src/oct-obj.cc +++ b/src/oct-obj.cc @@ -29,6 +29,10 @@ #include "oct-obj.h" #include "Cell.h" +// We are likely to have a lot of octave_value_list objects to allocate, +// so make the grow_size large. +DEFINE_OCTAVE_ALLOCATOR2(octave_value_list, 1024); + octave_value_list::octave_value_list (const std::list<octave_value_list>& lst) { octave_idx_type n = 0, nel = 0; @@ -59,9 +63,6 @@ } -octave_allocator -octave_value_list::allocator (sizeof (octave_value_list)); - octave_value_list& octave_value_list::prepend (const octave_value& val) {
--- a/src/oct-obj.h +++ b/src/oct-obj.h @@ -66,26 +66,6 @@ ~octave_value_list (void) { } - void *operator new (size_t size) - { return allocator.alloc (size); } - - void operator delete (void *p, size_t size) - { allocator.free (p, size); } - - // FIXME -- without this, I have errors with the stack of - // octave_value_list objects in ov-usr-fcn.h. Why? - void *operator new (size_t size, void *p) - { return ::operator new (size, p); } - - void operator delete (void *p, void *) - { -#if defined (HAVE_PLACEMENT_DELETE) - ::operator delete (p, static_cast<void *> (0)); -#else - ::operator delete (p); -#endif - } - octave_value_list& operator = (const octave_value_list& obj) { if (this != &obj) @@ -167,8 +147,6 @@ private: - static octave_allocator allocator; - Array<octave_value> data; // This list of strings can be used to tag each element of data with @@ -185,6 +163,8 @@ const octave_value& elem (octave_idx_type n) const { return data(n); } + + DECLARE_OCTAVE_ALLOCATOR }; #endif
--- a/src/oct-parse.yy +++ b/src/oct-parse.yy @@ -232,9 +232,10 @@ // Build a for command. static tree_command * -make_for_command (token *for_tok, tree_argument_list *lhs, - tree_expression *expr, tree_statement_list *body, - token *end_tok, octave_comment_list *lc); +make_for_command (int tok_id, token *for_tok, tree_argument_list *lhs, + tree_expression *expr, tree_expression *maxproc, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc); // Build a break command. static tree_command * @@ -439,7 +440,7 @@ %token <tok_val> NAME %token <tok_val> END %token <tok_val> DQ_STRING SQ_STRING -%token <tok_val> FOR WHILE DO UNTIL +%token <tok_val> FOR PARFOR WHILE DO UNTIL %token <tok_val> IF ELSEIF ELSE %token <tok_val> SWITCH CASE OTHERWISE %token <tok_val> BREAK CONTINUE FUNC_RET @@ -447,9 +448,7 @@ %token <tok_val> TRY CATCH %token <tok_val> GLOBAL STATIC %token <tok_val> FCN_HANDLE -%token <tok_val> PROPERTIES -%token <tok_val> METHODS -%token <tok_val> EVENTS +%token <tok_val> PROPERTIES METHODS EVENTS ENUMERATION %token <tok_val> METAQUERY %token <tok_val> SUPERCLASSREF %token <tok_val> GET SET @@ -462,7 +461,7 @@ // Nonterminals we construct. %type <comment_type> stash_comment function_beg classdef_beg -%type <comment_type> properties_beg methods_beg events_beg +%type <comment_type> properties_beg methods_beg events_beg enum_beg %type <sep_type> sep_no_nl opt_sep_no_nl sep opt_sep %type <tree_type> input %type <tree_constant_type> string constant magic_colon @@ -471,7 +470,7 @@ %type <tree_matrix_type> matrix_rows matrix_rows1 %type <tree_cell_type> cell_rows cell_rows1 %type <tree_expression_type> matrix cell -%type <tree_expression_type> primary_expr postfix_expr prefix_expr binary_expr +%type <tree_expression_type> primary_expr oper_expr %type <tree_expression_type> simple_expr colon_expr assign_expr expression %type <tree_identifier_type> identifier fcn_name magic_tilde %type <tree_identifier_type> superclass_identifier meta_identifier @@ -502,6 +501,7 @@ // These types need to be specified. %type <dummy_type> attr %type <dummy_type> class_event +%type <dummy_type> class_enum %type <dummy_type> class_property %type <dummy_type> properties_list %type <dummy_type> properties_block @@ -511,10 +511,11 @@ %type <dummy_type> attr_list %type <dummy_type> events_list %type <dummy_type> events_block +%type <dummy_type> enum_list +%type <dummy_type> enum_block %type <dummy_type> class_body // Precedence and associativity. -%left ';' ',' '\n' %right '=' ADD_EQ SUB_EQ MUL_EQ DIV_EQ LEFTDIV_EQ POW_EQ EMUL_EQ EDIV_EQ ELEFTDIV_EQ EPOW_EQ OR_EQ AND_EQ LSHIFT_EQ RSHIFT_EQ %left EXPR_OR_OR %left EXPR_AND_AND @@ -525,8 +526,9 @@ %left ':' %left '-' '+' EPLUS EMINUS %left '*' '/' LEFTDIV EMUL EDIV ELEFTDIV -%left UNARY PLUS_PLUS MINUS_MINUS EXPR_NOT +%right UNARY EXPR_NOT %left POW EPOW QUOTE TRANSPOSE +%right PLUS_PLUS MINUS_MINUS %left '(' '.' '{' // Where to start. @@ -735,7 +737,10 @@ ; anon_fcn_handle : '@' param_list statement - { $$ = make_anon_fcn_handle ($2, $3); } + { + lexer_flags.quote_is_transpose = false; + $$ = make_anon_fcn_handle ($2, $3); + } ; primary_expr : identifier @@ -796,69 +801,61 @@ { lexer_flags.looking_at_indirect_ref = true; } ; -postfix_expr : primary_expr +oper_expr : primary_expr { $$ = $1; } - | postfix_expr '(' ')' + | oper_expr PLUS_PLUS + { $$ = make_postfix_op (PLUS_PLUS, $1, $2); } + | oper_expr MINUS_MINUS + { $$ = make_postfix_op (MINUS_MINUS, $1, $2); } + | oper_expr '(' ')' { $$ = make_index_expression ($1, 0, '('); } - | postfix_expr '(' arg_list ')' + | oper_expr '(' arg_list ')' { $$ = make_index_expression ($1, $3, '('); } - | postfix_expr '{' '}' + | oper_expr '{' '}' { $$ = make_index_expression ($1, 0, '{'); } - | postfix_expr '{' arg_list '}' + | oper_expr '{' arg_list '}' { $$ = make_index_expression ($1, $3, '{'); } - | postfix_expr PLUS_PLUS - { $$ = make_postfix_op (PLUS_PLUS, $1, $2); } - | postfix_expr MINUS_MINUS - { $$ = make_postfix_op (MINUS_MINUS, $1, $2); } - | postfix_expr QUOTE + | oper_expr QUOTE { $$ = make_postfix_op (QUOTE, $1, $2); } - | postfix_expr TRANSPOSE + | oper_expr TRANSPOSE { $$ = make_postfix_op (TRANSPOSE, $1, $2); } - | postfix_expr indirect_ref_op STRUCT_ELT + | oper_expr indirect_ref_op STRUCT_ELT { $$ = make_indirect_ref ($1, $3->text ()); } - | postfix_expr indirect_ref_op '(' expression ')' + | oper_expr indirect_ref_op '(' expression ')' { $$ = make_indirect_ref ($1, $4); } - ; - -prefix_expr : postfix_expr - { $$ = $1; } - | binary_expr - { $$ = $1; } - | PLUS_PLUS prefix_expr %prec UNARY + | PLUS_PLUS oper_expr %prec UNARY { $$ = make_prefix_op (PLUS_PLUS, $2, $1); } - | MINUS_MINUS prefix_expr %prec UNARY + | MINUS_MINUS oper_expr %prec UNARY { $$ = make_prefix_op (MINUS_MINUS, $2, $1); } - | EXPR_NOT prefix_expr %prec UNARY + | EXPR_NOT oper_expr %prec UNARY { $$ = make_prefix_op (EXPR_NOT, $2, $1); } - | '+' prefix_expr %prec UNARY + | '+' oper_expr %prec UNARY { $$ = make_prefix_op ('+', $2, $1); } - | '-' prefix_expr %prec UNARY + | '-' oper_expr %prec UNARY { $$ = make_prefix_op ('-', $2, $1); } - ; - -binary_expr : prefix_expr POW prefix_expr + | oper_expr POW oper_expr { $$ = make_binary_op (POW, $1, $2, $3); } - | prefix_expr EPOW prefix_expr + | oper_expr EPOW oper_expr { $$ = make_binary_op (EPOW, $1, $2, $3); } - | prefix_expr '+' prefix_expr + | oper_expr '+' oper_expr { $$ = make_binary_op ('+', $1, $2, $3); } - | prefix_expr '-' prefix_expr + | oper_expr '-' oper_expr { $$ = make_binary_op ('-', $1, $2, $3); } - | prefix_expr '*' prefix_expr + | oper_expr '*' oper_expr { $$ = make_binary_op ('*', $1, $2, $3); } - | prefix_expr '/' prefix_expr + | oper_expr '/' oper_expr { $$ = make_binary_op ('/', $1, $2, $3); } - | prefix_expr EPLUS prefix_expr + | oper_expr EPLUS oper_expr { $$ = make_binary_op ('+', $1, $2, $3); } - | prefix_expr EMINUS prefix_expr + | oper_expr EMINUS oper_expr { $$ = make_binary_op ('-', $1, $2, $3); } - | prefix_expr EMUL prefix_expr + | oper_expr EMUL oper_expr { $$ = make_binary_op (EMUL, $1, $2, $3); } - | prefix_expr EDIV prefix_expr + | oper_expr EDIV oper_expr { $$ = make_binary_op (EDIV, $1, $2, $3); } - | prefix_expr LEFTDIV prefix_expr + | oper_expr LEFTDIV oper_expr { $$ = make_binary_op (LEFTDIV, $1, $2, $3); } - | prefix_expr ELEFTDIV prefix_expr + | oper_expr ELEFTDIV oper_expr { $$ = make_binary_op (ELEFTDIV, $1, $2, $3); } ; @@ -866,9 +863,9 @@ { $$ = finish_colon_expression ($1); } ; -colon_expr1 : prefix_expr +colon_expr1 : oper_expr { $$ = new tree_colon_expression ($1); } - | colon_expr1 ':' prefix_expr + | colon_expr1 ':' oper_expr { if (! ($$ = $1->append ($3))) ABORT_PARSE; @@ -1148,12 +1145,26 @@ } | FOR stash_comment assign_lhs '=' expression opt_sep opt_list END { - if (! ($$ = make_for_command ($1, $3, $5, $7, $8, $2))) + if (! ($$ = make_for_command (FOR, $1, $3, $5, 0, + $7, $8, $2))) ABORT_PARSE; } | FOR stash_comment '(' assign_lhs '=' expression ')' opt_sep opt_list END { - if (! ($$ = make_for_command ($1, $4, $6, $9, $10, $2))) + if (! ($$ = make_for_command (FOR, $1, $4, $6, 0, + $9, $10, $2))) + ABORT_PARSE; + } + | PARFOR stash_comment assign_lhs '=' expression opt_sep opt_list END + { + if (! ($$ = make_for_command (PARFOR, $1, $3, $5, + 0, $7, $8, $2))) + ABORT_PARSE; + } + | PARFOR stash_comment '(' assign_lhs '=' expression ',' expression ')' opt_sep opt_list END + { + if (! ($$ = make_for_command (PARFOR, $1, $4, $6, + $8, $11, $12, $2))) ABORT_PARSE; } ; @@ -1238,6 +1249,7 @@ symtab_context.push (symbol_table::current_scope ()); symbol_table::set_scope (symbol_table::alloc_scope ()); lexer_flags.looking_at_function_handle--; + lexer_flags.looking_at_anon_fcn_args = true; } } ; @@ -1479,7 +1491,7 @@ { $$ = 0; } ; -classdef : classdef1 '\n' class_body '\n' stash_comment classdef_end +classdef : classdef1 opt_sep class_body opt_sep stash_comment classdef_end { $$ = 0; } ; @@ -1526,11 +1538,15 @@ { $$ = 0; } | events_block { $$ = 0; } - | class_body '\n' properties_block + | enum_block + { $$ = 0; } + | class_body opt_sep properties_block { $$ = 0; } - | class_body '\n' methods_block + | class_body opt_sep methods_block { $$ = 0; } - | class_body '\n' events_block + | class_body opt_sep events_block + { $$ = 0; } + | class_body opt_sep enum_block { $$ = 0; } ; @@ -1539,14 +1555,14 @@ ; properties_block - : properties_beg opt_attr_list '\n' properties_list '\n' END + : properties_beg opt_attr_list opt_sep properties_list opt_sep END { $$ = 0; } ; properties_list : class_property { $$ = 0; } - | properties_list '\n' class_property + | properties_list opt_sep class_property { $$ = 0; } ; @@ -1560,13 +1576,13 @@ { $$ = 0; } ; -methods_block : methods_beg opt_attr_list '\n' methods_list '\n' END +methods_block : methods_beg opt_attr_list opt_sep methods_list opt_sep END { $$ = 0; } ; methods_list : function { $$ = 0; } - | methods_list '\n' function + | methods_list opt_sep function { $$ = 0; } ; @@ -1574,13 +1590,13 @@ { $$ = 0; } ; -events_block : events_beg opt_attr_list '\n' events_list '\n' END +events_block : events_beg opt_attr_list opt_sep events_list opt_sep END { $$ = 0; } ; events_list : class_event { $$ = 0; } - | events_list '\n' class_event + | events_list opt_sep class_event { $$ = 0; } ; @@ -1588,6 +1604,24 @@ { $$ = 0; } ; +enum_beg : ENUMERATION stash_comment + { $$ = 0; } + ; + +enum_block : enum_beg opt_attr_list opt_sep enum_list opt_sep END + { $$ = 0; } + ; + +enum_list : class_enum + { $$ = 0; } + | enum_list opt_sep class_enum + { $$ = 0; } + ; + +class_enum : identifier '(' expression ')' + { $$ = 0; } + ; + // ============= // Miscellaneous // ============= @@ -1766,6 +1800,10 @@ end_error ("for", ettype, l, c); break; + case token::enumeration_end: + end_error ("enumeration", ettype, l, c); + break; + case token::function_end: end_error ("function", ettype, l, c); break; @@ -1774,6 +1812,10 @@ end_error ("if", ettype, l, c); break; + case token::parfor_end: + end_error ("parfor", ettype, l, c); + break; + case token::try_catch_end: end_error ("try", ettype, l, c); break; @@ -1859,11 +1901,7 @@ octave_value::binary_op op_type = e->op_type (); - if (op1->is_constant () && op2->is_constant () - && (! ((warning_enabled ("Octave:associativity-change") - && (op_type == POW || op_type == EPOW)) - || (warning_enabled ("Octave:precedence-change") - && (op_type == EXPR_OR || op_type == EXPR_OR_OR))))) + if (op1->is_constant () && op2->is_constant ()) { octave_value tmp = e->rvalue1 (); @@ -2079,9 +2117,8 @@ make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt) { // FIXME -- need to get these from the location of the @ symbol. - - int l = -1; - int c = -1; + int l = input_line_number; + int c = current_input_column; tree_parameter_list *ret_list = 0; @@ -2102,40 +2139,13 @@ tree_anon_fcn_handle *retval = new tree_anon_fcn_handle (param_list, ret_list, body, fcn_scope, l, c); + // FIXME: Stash the filename. This does not work and produces + // errors when executed. + //retval->stash_file_name (curr_fcn_file_name); return retval; } -static void -maybe_warn_associativity_change (tree_expression *op) -{ - if (op->paren_count () == 0 && op->is_binary_expression ()) - { - tree_binary_expression *e - = dynamic_cast<tree_binary_expression *> (op); - - octave_value::binary_op op_type = e->op_type (); - - if (op_type == octave_value::op_pow - || op_type == octave_value::op_el_pow) - { - std::string op_str = octave_value::binary_op_as_string (op_type); - - if (curr_fcn_file_full_name.empty ()) - warning_with_id - ("Octave:associativity-change", - "meaning may have changed due to change in associativity for %s operator", - op_str.c_str ()); - else - warning_with_id - ("Octave:associativity-change", - "meaning may have changed due to change in associativity for %s operator near line %d, column %d in file `%s'", - op_str.c_str (), op->line (), op->column (), - curr_fcn_file_full_name.c_str ()); - } - } -} - // Build a binary expression. static tree_expression * @@ -2148,12 +2158,10 @@ { case POW: t = octave_value::op_pow; - maybe_warn_associativity_change (op1); break; case EPOW: t = octave_value::op_el_pow; - maybe_warn_associativity_change (op1); break; case '+': @@ -2226,25 +2234,6 @@ case EXPR_OR: t = octave_value::op_el_or; - if (op2->paren_count () == 0 && op2->is_binary_expression ()) - { - tree_binary_expression *e - = dynamic_cast<tree_binary_expression *> (op2); - - if (e->op_type () == octave_value::op_el_and) - { - if (curr_fcn_file_full_name.empty ()) - warning_with_id - ("Octave:precedence-change", - "meaning may have changed due to change in precedence for & and | operators"); - else - warning_with_id - ("Octave:precedence-change", - "meaning may have changed due to change in precedence for & and | operators near line %d, column %d in file `%s'", - op2->line (), op2->column (), - curr_fcn_file_full_name.c_str ()); - } - } break; default: @@ -2277,16 +2266,6 @@ case EXPR_OR_OR: t = tree_boolean_expression::bool_or; - if (op2->paren_count () == 0 && op2->is_boolean_expression ()) - { - tree_boolean_expression *e - = dynamic_cast<tree_boolean_expression *> (op2); - - if (e->op_type () == tree_boolean_expression::bool_and) - warning_with_id - ("Octave:precedence-change", - "meaning may have changed due to change in precedence for && and || operators"); - } break; default: @@ -2482,13 +2461,16 @@ // Build a for command. static tree_command * -make_for_command (token *for_tok, tree_argument_list *lhs, - tree_expression *expr, tree_statement_list *body, - token *end_tok, octave_comment_list *lc) +make_for_command (int tok_id, token *for_tok, tree_argument_list *lhs, + tree_expression *expr, tree_expression *maxproc, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc) { tree_command *retval = 0; - if (end_token_ok (end_tok, token::for_end)) + bool parfor = tok_id == PARFOR; + + if (end_token_ok (end_tok, parfor ? token::parfor_end : token::for_end)) { octave_comment_list *tc = octave_comment_buffer::get_comment (); @@ -2501,14 +2483,19 @@ { tree_expression *tmp = lhs->remove_front (); - retval = new tree_simple_for_command (tmp, expr, body, - lc, tc, l, c); + retval = new tree_simple_for_command (parfor, tmp, expr, maxproc, + body, lc, tc, l, c); delete lhs; } else - retval = new tree_complex_for_command (lhs, expr, body, - lc, tc, l, c); + { + if (parfor) + yyerror ("invalid syntax for parfor statement"); + else + retval = new tree_complex_for_command (lhs, expr, body, + lc, tc, l, c); + } } return retval; @@ -2908,6 +2895,7 @@ } fcn->stash_function_name (id_name); + fcn->stash_fcn_location (input_line_number, current_input_column); if (! help_buf.empty () && current_function_depth == 1 && ! parsing_subfunctions) @@ -3287,13 +3275,13 @@ static int text_getc (FILE *f) { - int c = getc (f); + int c = gnulib::getc (f); // Convert CRLF into just LF and single CR into LF. if (c == '\r') { - c = getc (f); + c = gnulib::getc (f); if (c != '\n') { @@ -3348,11 +3336,10 @@ break; case '\n': - current_input_column = 0; + current_input_column = 1; break; default: - current_input_column--; reader.ungetc (c); goto done; } @@ -3368,16 +3355,16 @@ { bool status = false; - long pos = ftell (ffile); + long pos = gnulib::ftell (ffile); char buf [10]; - fgets (buf, 10, ffile); + gnulib::fgets (buf, 10, ffile); size_t len = strlen (buf); if (len > 8 && strncmp (buf, "classdef", 8) == 0 && ! (isalnum (buf[8]) || buf[8] == '_')) status = true; - fseek (ffile, pos, SEEK_SET); + gnulib::fseek (ffile, pos, SEEK_SET); return status; } @@ -3428,16 +3415,16 @@ { bool status = false; - long pos = ftell (ffile); + long pos = gnulib::ftell (ffile); char buf [10]; - fgets (buf, 10, ffile); + gnulib::fgets (buf, 10, ffile); size_t len = strlen (buf); if (len > 8 && strncmp (buf, "function", 8) == 0 && ! (isalnum (buf[8]) || buf[8] == '_')) status = true; - fseek (ffile, pos, SEEK_SET); + gnulib::fseek (ffile, pos, SEEK_SET); return status; } @@ -3479,18 +3466,11 @@ parsing_subfunctions = false; endfunction_found = false; - // The next four lines must be in this order. - frame.add_fcn (command_history::ignore_entries, ! Vsaving_history); - - // FIXME -- we shouldn't need both the - // command_history object and the - // Vsaving_history variable... + frame.add_fcn (command_history::ignore_entries, + command_history::ignoring_entries ()); + command_history::ignore_entries (); - frame.protect_var (Vsaving_history); - - Vsaving_history = false; - FILE *ffile = get_input_from_file (ff, 0); frame.add_fcn (safe_fclose, ffile); @@ -3585,7 +3565,11 @@ int status = yyparse (); - delete global_command; + // Use an unwind-protect cleanup function so that the + // global_command list will be deleted in the event of an + // interrupt. + + frame.add_fcn (cleanup_statement_list, &global_command); fcn_ptr = primary_fcn_ptr; @@ -4021,8 +4005,8 @@ DEFUN (mfilename, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} mfilename ()\n\ -@deftypefnx {Built-in Function} {} mfilename (@code{\"fullpath\"})\n\ -@deftypefnx {Built-in Function} {} mfilename (@code{\"fullpathext\"})\n\ +@deftypefnx {Built-in Function} {} mfilename (\"fullpath\")\n\ +@deftypefnx {Built-in Function} {} mfilename (\"fullpathext\")\n\ Return the name of the currently executing file. At the top-level,\n\ return the empty string. Given the argument @code{\"fullpath\"},\n\ include the directory part of the file name, but not the extension.\n\ @@ -4194,7 +4178,9 @@ retval = feval (name, tmp_args, nargout); } } - else if (f_arg.is_function_handle () || f_arg.is_inline_function ()) + else if (f_arg.is_function_handle () + || f_arg.is_anonymous_function () + || f_arg.is_inline_function ()) { const octave_value_list tmp_args = get_feval_args (args); @@ -4223,12 +4209,26 @@ @noindent\n\ calls the function @code{acos} with the argument @samp{-1}.\n\ \n\ -The function @code{feval} is necessary in order to be able to write\n\ -functions that call user-supplied functions, because Octave does not\n\ -have a way to declare a pointer to a function (like C) or to declare a\n\ -special kind of variable that can be used to hold the name of a function\n\ -(like @code{EXTERNAL} in Fortran). Instead, you must refer to functions\n\ -by name, and use @code{feval} to call them.\n\ +The function @code{feval} can also be used with function handles of\n\ +any sort (@pxref{Function Handles}). Historically, @code{feval} was\n\ +the only way to call user-supplied functions in strings, but\n\ +function handles are now preferred due to the cleaner syntax they\n\ +offer. For example,\n\ +\n\ +@example\n\ +@group\n\ +@var{f} = @@exp;\n\ +feval (@var{f}, 1)\n\ + @result{} 2.7183\n\ +@var{f} (1)\n\ + @result{} 2.7183\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +are equivalent ways to call the function referred to by @var{f}. If it\n\ +cannot be predicted beforehand that @var{f} is a function handle or the\n\ +function name in a string, @code{feval} can be used instead.\n\ @end deftypefn") { octave_value_list retval; @@ -4349,6 +4349,14 @@ { if (command_list) { + unwind_protect inner_frame; + + // Use an unwind-protect cleanup function so that the + // global_command list will be deleted in the event of an + // interrupt. + + inner_frame.add_fcn (cleanup_statement_list, &command_list); + tree_statement *stmt = 0; if (command_list->length () == 1 @@ -4385,10 +4393,6 @@ else error ("eval: invalid use of statement list"); - delete command_list; - - command_list = 0; - if (error_state || tree_return_command::returning || tree_break_command::breaking @@ -4432,6 +4436,16 @@ return eval_string (s, silent, parse_status, nargout); } +void +cleanup_statement_list (tree_statement_list **lst) +{ + if (*lst) + { + delete *lst; + *lst = 0; + } +} + DEFUN (eval, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} eval (@var{try}, @var{catch})\n\ @@ -4504,84 +4518,34 @@ /* -%% test/octave.test/eval/eval-1.m -%!#test +%!shared x %! x = 1; -%! assert(eval ("x"),1); - -%% test/octave.test/eval/eval-2.m -%!test -%! x = 1; -%! assert(eval ("x;")); - -%% test/octave.test/eval/eval-3.m + +%!assert (eval ("x"), 1) +%!assert (eval ("x;")) +%!assert (eval ("x;"), 1); + %!test -%! x = 1; -%! assert(eval ("x;"),1); - -%% FIXME -%% Disable this test as adding the ";" is redundant with eval-1 and -%% in any case is a syntax error with assert -%% test/octave.test/eval/eval-4.m -%!#test -%! x = 1; -%! assert(eval ("x");,1); - -%% test/octave.test/eval/eval-5.m +%! y = eval ("x"); +%! assert (y, 1); + +%!test +%! y = eval ("x;"); +%! assert (y, 1); + +%!test +%! eval ("x = 1;") +%! assert (x,1); + %!test %! eval ("flipud = 2;"); -%! assert(flipud,2); - -%% test/octave.test/eval/eval-6.m -%!function y = f () +%! assert (flipud, 2); + +%!function y = __f () %! eval ("flipud = 2;"); %! y = flipud; -%!test -%! assert(f,2); - -%% test/octave.test/eval/eval-7.m -%!#test -%! eval ("x = 1"); -%! assert(x,1); - -%% test/octave.test/eval/eval-8.m -%!test -%! eval ("x = 1;") -%! assert(x,1); - -%% test/octave.test/eval/eval-9.m -%!test -%! eval ("x = 1;"); -%! assert(x,1); - -%% test/octave.test/eval/eval-10.m -%!#test -%! eval ("x = 1") -%! assert(x,1); - -%% test/octave.test/eval/eval-11.m -%!test -%! x = 1; -%! y = eval ("x"); -%! assert(y,1); - -%% test/octave.test/eval/eval-12.m -%!test -%! x = 1; -%! y = eval ("x;"); -%! assert(y,1); - -%% test/octave.test/eval/eval-13.m -%!test -%! x = 1; -%! y = eval ("x;"); -%! assert(y,1); - -%% test/octave.test/eval/eval-14.m -%!test -%! x = 1; -%! y = eval ("x"); -%! assert(y,1); +%!endfunction +%!assert (__f(), 2) */
--- a/src/oct-stream.cc +++ b/src/oct-stream.cc @@ -40,8 +40,9 @@ #include "lo-ieee.h" #include "lo-mappers.h" #include "lo-utils.h" +#include "quit.h" +#include "singleton-cleanup.h" #include "str-vec.h" -#include "quit.h" #include "error.h" #include "gripes.h" @@ -1227,151 +1228,9 @@ if (c1 != EOF) { - if (c1 == 'N') - { - int c2 = is.get (); - - if (c2 != EOF) - { - if (c2 == 'A') - { - int c3 = is.get (); - - if (c3 != EOF) - { - is.putback (c3); - - if (isspace (c3) || ispunct (c3)) - ref = octave_NA; - else - { - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - else - { - is.clear (); - - ref = octave_NA; - } - } - else if (c2 == 'a') - { - int c3 = is.get (); - - if (c3 != EOF) - { - if (c3 == 'N') - { - int c4 = is.get (); - - if (c4 != EOF) - { - is.putback (c4); - - if (isspace (c4) || ispunct (c4)) - ref = octave_NaN; - else - { - is.putback (c3); - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - else - { - is.clear (); - - ref = octave_NaN; - } - } - else - { - is.putback (c3); - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - } - else - { - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - } - else if (c1 == 'I') - { - int c2 = is.get (); - - if (c2 != EOF) - { - if (c2 == 'n') - { - int c3 = is.get (); - - if (c3 != EOF) - { - if (c3 == 'f') - { - int c4 = is.get (); - - if (c4 != EOF) - { - is.putback (c4); - - if (isspace (c4) || ispunct (c4)) - ref = octave_Inf; - else - { - is.putback (c3); - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - else - { - is.clear (); - - ref = octave_Inf; - } - } - else - { - is.putback (c3); - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - else - { - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - } - } - else - { - is.putback (c1); - - is >> ref; - } + is.putback (c1); + + ref = octave_read_value<double> (is); } } break; @@ -1521,7 +1380,9 @@ tmp[n++] = static_cast<char> (c); \ \ if (n > 0 && c == EOF) \ - is.clear () + is.clear (); \ + \ + tmp.resize (n) // For a `%s' format, skip initial whitespace and then read until the // next whitespace character or until WIDTH characters have been read. @@ -2255,7 +2116,7 @@ octave_idx_type len = fmt_list.length (); - retval.resize (nconv+1, Matrix ()); + retval.resize (nconv+2, Matrix ()); const scanf_format_elt *elt = fmt_list.first (); @@ -2285,6 +2146,9 @@ retval(nconv) = num_values; + int err_num; + retval(nconv+1) = error (false, err_num); + if (! quit) { // Pick up any trailing stuff. @@ -3002,38 +2866,60 @@ { clearerr (); + // Find current position so we can return to it if needed. + long orig_pos = rep->tell (); - status = rep->seek (offset, origin); + // Move to end of file. If successful, find the offset of the end. + + status = rep->seek (0, SEEK_END); if (status == 0) { - long save_pos = rep->tell (); - - rep->seek (0, SEEK_END); - - long pos_eof = rep->tell (); - - // I don't think save_pos can be less than zero, but we'll - // check anyway... - - if (save_pos > pos_eof || save_pos < 0) + long eof_pos = rep->tell (); + + if (origin == SEEK_CUR) + { + // Move back to original position, otherwise we will be + // seeking from the end of file which is probably not the + // original location. + + rep->seek (orig_pos, SEEK_SET); + } + + // Attempt to move to desired position; may be outside bounds + // of existing file. + + status = rep->seek (offset, origin); + + if (status == 0) { - // Seek outside bounds of file. Failure should leave - // position unchanged. + // Where are we after moving to desired position? + + long desired_pos = rep->tell (); + + // I don't think save_pos can be less than zero, but we'll + // check anyway... + + if (desired_pos > eof_pos || desired_pos < 0) + { + // Seek outside bounds of file. Failure should leave + // position unchanged. + + rep->seek (orig_pos, SEEK_SET); + + status = -1; + } + } + else + { + // Seeking to the desired position failed. Move back to + // original position and return failure status. rep->seek (orig_pos, SEEK_SET); status = -1; } - else - { - // Is it possible for this to fail? We are just - // returning to a position after the first successful - // seek. - - rep->seek (save_pos, SEEK_SET); - } } } @@ -4031,7 +3917,12 @@ bool retval = true; if (! instance) - instance = new octave_stream_list (); + { + instance = new octave_stream_list (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) { @@ -4290,9 +4181,9 @@ { retval.resize (3); - retval(0) = os.name (); + retval(2) = oct_mach_info::float_format_as_string (os.float_format ()); retval(1) = octave_stream::mode_as_string (os.mode ()); - retval(2) = oct_mach_info::float_format_as_string (os.float_format ()); + retval(0) = os.name (); } else ::error ("invalid file id = %d", fid);
--- a/src/oct-stream.h +++ b/src/oct-stream.h @@ -37,6 +37,7 @@ #include "data-conv.h" #include "lo-utils.h" #include "mach-info.h" +#include "oct-refcount.h" class OCTINTERP_API @@ -427,7 +428,7 @@ private: // A reference count. - octave_idx_type count; + octave_refcount<octave_idx_type> count; // The permission bits for the file. Should be some combination of // std::ios::open_mode bits. @@ -689,6 +690,8 @@ static octave_stream_list *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + int do_insert (octave_stream& os); octave_stream do_lookup (int fid, const std::string& who = std::string ()) const;
rename from octave-config.cc.in rename to src/octave-config.cc.in --- a/octave-config.cc.in +++ b/src/octave-config.cc.in @@ -219,6 +219,6 @@ return 1; } } - + return 0; }
rename from octave-config.in rename to src/octave-config.in --- a/octave-config.in +++ b/src/octave-config.in @@ -19,7 +19,7 @@ ## 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/>. -## +## ## Original version by Rafael Laboissiere <rafael@laboissiere.net> ## distributed as free software in the public domain.
--- a/src/octave.cc +++ b/src/octave.cc @@ -58,6 +58,7 @@ #include "octave.h" #include "oct-hist.h" #include "oct-map.h" +#include "oct-mutex.h" #include "oct-obj.h" #include "ops.h" #include "ov.h" @@ -632,6 +633,8 @@ octave_program_invocation_name = octave_env::get_program_invocation_name (); octave_program_name = octave_env::get_program_name (); + octave_thread::init (); + // The order of these calls is important. The call to // install_defaults must come before install_builtins because // default variable values must be available for the variables to be @@ -865,9 +868,9 @@ load_path::initialize (set_initial_path); - execute_startup_files (); + initialize_history (read_history_file); - initialize_history (read_history_file); + execute_startup_files (); if (! inhibit_startup_message && reading_startup_message_printed) std::cout << std::endl; @@ -898,7 +901,11 @@ execute_command_line_file (argv[last_arg_idx]); if (! persist) - clean_up_and_exit (error_state ? 1 : 0); + { + quitting_gracefully = true; + + clean_up_and_exit (error_state ? 1 : 0); + } } // Avoid counting commands executed from startup files. @@ -937,6 +944,8 @@ if (retval == 1 && ! error_state) retval = 0; + quitting_gracefully = true; + clean_up_and_exit (retval); return 0; @@ -971,6 +980,11 @@ return retval; } +/* +%!error argv (1); +%!assert (iscellstr (argv ())); +*/ + DEFUN (program_invocation_name, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} program_invocation_name ()\n\ @@ -993,6 +1007,11 @@ return retval; } +/* +%!error program_invocation_name (1); +%!assert (ischar (program_invocation_name ())); +*/ + DEFUN (program_name, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} program_name ()\n\ @@ -1010,3 +1029,8 @@ return retval; } + +/* +%!error program_name (1); +%!assert (ischar (program_name ())); +*/
--- a/src/octave.gperf +++ b/src/octave.gperf @@ -38,14 +38,17 @@ end_try_catch_kw, end_unwind_protect_kw, endclassdef_kw, + endenumeration_kw, endevents_kw, endfor_kw, endfunction_kw, endif_kw, endmethods_kw, + endparfor_kw, endproperties_kw, endswitch_kw, endwhile_kw, + enumeration_kw, events_kw, for_kw, function_kw, @@ -56,6 +59,7 @@ magic_line_kw, methods_kw, otherwise_kw, + parfor_kw, properties_kw, return_kw, set_kw, @@ -82,14 +86,17 @@ end_try_catch, END, end_try_catch_kw end_unwind_protect, END, end_unwind_protect_kw endclassdef, END, endclassdef_kw +endenumeration, END, endenumeration_kw endevents, END, endevents_kw endfor, END, endfor_kw endfunction, END, endfunction_kw endif, END, endif_kw endmethods, END, endmethods_kw +endparfor, END, endparfor_kw endproperties, END, endproperties_kw endswitch, END, endswitch_kw endwhile, END, endwhile_kw +enumeration, ENUMERATION, enumeration_kw events, EVENTS, events_kw for, FOR, for_kw function, FCN, function_kw @@ -98,6 +105,7 @@ if, IF, if_kw methods, METHODS, methods_kw otherwise, OTHERWISE, otherwise_kw +parfor, PARFOR, parfor_kw persistent, STATIC, static_kw properties, PROPERTIES, properties_kw return, FUNC_RET, return_kw
--- a/src/ov-base-mat.h +++ b/src/ov-base-mat.h @@ -89,6 +89,9 @@ octave_value do_index_op (const octave_value_list& idx, bool resize_ok = false); + octave_value_list do_multi_index_op (int, const octave_value_list& idx) + { return do_index_op (idx); } + void assign (const octave_value_list& idx, const MT& rhs); void assign (const octave_value_list& idx, typename MT::element_type rhs);
--- a/src/ov-base-scalar.h +++ b/src/ov-base-scalar.h @@ -109,7 +109,10 @@ { return mode ? mode : ASCENDING; } Array<octave_idx_type> sort_rows_idx (sortmode) const - { return Array<octave_idx_type> (dim_vector (1, 0)); } + { + return Array<octave_idx_type> (dim_vector (1, 1), + static_cast<octave_idx_type> (0)); + } sortmode is_sorted_rows (sortmode mode = UNSORTED) const { return mode ? mode : ASCENDING; }
--- a/src/ov-base.cc +++ b/src/ov-base.cc @@ -50,6 +50,7 @@ #include "ov-str-mat.h" #include "ov-fcn-handle.h" #include "parse.h" +#include "pr-output.h" #include "utils.h" #include "variables.h" @@ -419,7 +420,9 @@ { os << name << " ="; newline (os); - newline (os); + if (! Vcompact_format) + newline (os); + retval = true; } @@ -435,7 +438,7 @@ print (output_buf); - if (print_padding && pad_after) + if (print_padding && pad_after && ! Vcompact_format) newline (output_buf); } @@ -1527,24 +1530,42 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} sparse_auto_mutate ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} sparse_auto_mutate (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} sparse_auto_mutate (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether Octave will\n\ -automatically mutate sparse matrices to real matrices to save memory.\n\ +automatically mutate sparse matrices to full matrices to save memory.\n\ For example:\n\ \n\ @example\n\ @group\n\ -s = speye(3);\n\ +s = speye (3);\n\ sparse_auto_mutate (false)\n\ -s (:, 1) = 1;\n\ +s(:, 1) = 1;\n\ typeinfo (s)\n\ @result{} sparse matrix\n\ sparse_auto_mutate (true)\n\ -s (1, :) = 1;\n\ +s(1, :) = 1;\n\ typeinfo (s)\n\ @result{} matrix\n\ @end group\n\ @end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (sparse_auto_mutate); } + +/* + +%!test + s = speye(3); + sparse_auto_mutate (false); + s(:, 1) = 1; + assert (typeinfo (s), "sparse matrix"); + sparse_auto_mutate (true); + s(1, :) = 1; + assert (typeinfo (s), "matrix"); + +*/
--- a/src/ov-base.h +++ b/src/ov-base.h @@ -167,9 +167,9 @@ const std::string t::c_name (c); \ void t::register_type (void) \ { \ - t_id = octave_value_typeinfo::register_type (t::t_name, \ - t::c_name, \ - octave_value (new t ())); \ + static t exemplar; \ + octave_value v (&exemplar, true); \ + t_id = octave_value_typeinfo::register_type (t::t_name, t::c_name, v); \ } // A base value type, so that derived types only have to redefine what @@ -427,6 +427,8 @@ virtual bool is_function_handle (void) const { return false; } + virtual bool is_anonymous_function (void) const { return false; } + virtual bool is_inline_function (void) const { return false; } virtual bool is_function (void) const { return false; }
--- a/src/ov-bool-mat.cc +++ b/src/ov-bool-mat.cc @@ -575,3 +575,15 @@ return retval; } + +/* +%!shared m, s, c +%! m = eye (2) != 0; +%! s = !0; +%! c = {"double", "single", "int8", "int16", "int32", "int64", "uint8", "uint16", "uint32", "uint64", "logical"}; +%!test +%! for i = 1:numel (c) +%! assert (logical (eye (2, c{i})), m) +%! assert (logical (eye (1, c{i})), s) +%! endfor +*/
--- a/src/ov-bool.h +++ b/src/ov-bool.h @@ -119,6 +119,30 @@ uint64_array_value (void) const { return uint64NDArray (dim_vector (1, 1), scalar); } + octave_int8 + int8_scalar_value (void) const { return octave_int8 (scalar); } + + octave_int16 + int16_scalar_value (void) const { return octave_int16 (scalar); } + + octave_int32 + int32_scalar_value (void) const { return octave_int32 (scalar); } + + octave_int64 + int64_scalar_value (void) const { return octave_int64 (scalar); } + + octave_uint8 + uint8_scalar_value (void) const { return octave_uint8 (scalar); } + + octave_uint16 + uint16_scalar_value (void) const { return octave_uint16 (scalar); } + + octave_uint32 + uint32_scalar_value (void) const { return octave_uint32 (scalar); } + + octave_uint64 + uint64_scalar_value (void) const { return octave_uint64 (scalar); } + double double_value (bool = false) const { return scalar; } float float_value (bool = false) const { return scalar; }
--- a/src/ov-builtin.cc +++ b/src/ov-builtin.cc @@ -29,6 +29,7 @@ #include "oct-obj.h" #include "ov-builtin.h" #include "ov.h" +#include "profiler.h" #include "toplev.h" #include "unwind-prot.h" @@ -125,6 +126,8 @@ try { + BEGIN_PROFILER_BLOCK (profiler_name ()) + retval = (*f) (args, nargout); // Do not allow null values to be returned from functions. // FIXME -- perhaps true builtins should be allowed? @@ -137,6 +140,8 @@ // the idiom is very common, so we solve that here. if (retval.length () == 1 && retval.xelem (0).is_undefined ()) retval.clear (); + + END_PROFILER_BLOCK } catch (octave_execution_exception) {
--- a/src/ov-cell.cc +++ b/src/ov-cell.cc @@ -1271,14 +1271,15 @@ DEFUN (cell, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cell (@var{x})\n\ -@deftypefnx {Built-in Function} {} cell (@var{n}, @var{m})\n\ -Create a new cell array object. If invoked with a single scalar\n\ -argument, @code{cell} returns a square cell array with the dimension\n\ -specified. If you supply two scalar arguments, @code{cell} takes\n\ -them to be the number of rows and columns. If given a vector with two\n\ -elements, @code{cell} uses the values of the elements as the number of\n\ -rows and columns, respectively.\n\ +@deftypefn {Built-in Function} {} cell (@var{n})\n\ +@deftypefnx {Built-in Function} {} cell (@var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {} cell (@var{m}, @var{n}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} cell ([@var{m} @var{n} @dots{}])\n\ +Create a new cell array object.\n\ +If invoked with a single scalar integer argument, return a square\n\ +@nospell{NxN} cell array. If invoked with two or more scalar\n\ +integer arguments, or a vector of integer values, return an array with\n\ +the given dimensions.\n\ @end deftypefn") { octave_value retval;
--- a/src/ov-class.cc +++ b/src/ov-class.cc @@ -80,15 +80,120 @@ error ("parents must be objects"); else { - std::string cnm = parent.class_name (); + std::string pcnm = parent.class_name (); - if (find_parent_class (cnm)) + if (find_parent_class (pcnm)) error ("duplicate class in parent tree"); else { - parent_list.push_back (cnm); + parent_list.push_back (pcnm); + + octave_idx_type nel = map.numel (); + octave_idx_type p_nel = parent.numel (); + + if (nel == 0) + { + if (p_nel == 0) + { + // No elements in MAP or the parent class object, + // so just add the field name. + + map.assign (pcnm, Cell (map.dims ())); + } + else if (p_nel == 1) + { + if (map.nfields () == 0) + { + // No elements or fields in MAP, but the + // parent is class object with one element. + // Resize to match size of parent class and + // make the parent a field in MAP. + + map.resize (parent.dims ()); + + map.assign (pcnm, parent); + } + else + { + // No elements in MAP, but we have at least + // one field. So don't resize, just add the + // field name. + + map.assign (pcnm, Cell (map.dims ())); + } + } + else if (map.nfields () == 0) + { + // No elements or fields in MAP and more than one + // element in the parent class object, so we can + // resize MAP to match parent dimsenions, then + // distribute the elements of the parent object to + // the elements of MAP. + + dim_vector parent_dims = parent.dims (); + + map.resize (parent_dims); + + Cell c (parent_dims); + + octave_map pmap = parent.map_value (); - map.assign (cnm, parent); + std::list<std::string> plist + = parent.parent_class_name_list (); + + for (octave_idx_type i = 0; i < p_nel; i++) + c(i) = octave_value (pmap.index(i), pcnm, plist); + + map.assign (pcnm, c); + } + else + error ("class: parent class dimension mismatch"); + } + else if (nel == 1 && p_nel == 1) + { + // Simple assignment. + + map.assign (pcnm, parent); + } + else + { + if (p_nel == 1) + { + // Broadcast the scalar parent class object to + // each element of MAP. + + Cell pcell (map.dims (), parent); + + map.assign (pcnm, pcell); + } + + else if (nel == p_nel) + { + // FIXME -- is there a better way to do this? + + // The parent class object has the same number of + // elements as the map we are using to create the + // new object, so distribute those elements to + // each element of the new object by first + // splitting the elements of the parent class + // object into a cell array with one element per + // cell. Then do the assignment all at once. + + Cell c (parent.dims ()); + + octave_map pmap = parent.map_value (); + + std::list<std::string> plist + = parent.parent_class_name_list (); + + for (octave_idx_type i = 0; i < p_nel; i++) + c(i) = octave_value (pmap.index(i), pcnm, plist); + + map.assign (pcnm, c); + } + else + error ("class: parent class dimension mismatch"); + } } } } @@ -121,12 +226,15 @@ { std::string retval = class_name (); - octave_function *fcn = octave_call_stack::current (); + if (nparents () > 0) + { + octave_function *fcn = octave_call_stack::current (); - // Here we are just looking to see if FCN is a method or constructor - // for any class, not specifically this one. - if (fcn->is_class_method () || fcn->is_class_constructor ()) - retval = fcn->dispatch_class (); + // Here we are just looking to see if FCN is a method or constructor + // for any class, not specifically this one. + if (fcn && (fcn->is_class_method () || fcn->is_class_constructor ())) + retval = fcn->dispatch_class (); + } return retval; } @@ -319,6 +427,17 @@ else error ("@%s/size: invalid return value", class_name ().c_str ()); } + else + { + dim_vector dv = dims (); + + int nd = dv.length (); + + retval.resize (1, nd); + + for (int i = 0; i < nd; i++) + retval(i) = dv(i); + } return retval; } @@ -396,7 +515,7 @@ } else retval(0) = octave_value (map.index (idx.front ()), - class_name ()); + c_name, parent_list); } break; @@ -472,7 +591,8 @@ else { if (type.length () == 1 && type[0] == '(') - retval(0) = octave_value (map.index (idx.front ()), class_name ()); + retval(0) = octave_value (map.index (idx.front ()), c_name, + parent_list); else gripe_invalid_index1 (); } @@ -873,7 +993,7 @@ if (meth.is_defined ()) { octave_value_list args; - args(0) = octave_value (new octave_class (map, c_name)); + args(0) = octave_value (new octave_class (map, c_name, parent_list)); octave_value_list tmp = feval (meth.function_value (), args, 1); @@ -993,6 +1113,35 @@ return retval; } +string_vector +octave_class::all_strings (bool pad) const +{ + string_vector retval; + + octave_value meth = symbol_table::find_method ("char", class_name ()); + + if (meth.is_defined ()) + { + octave_value_list args; + args(0) = octave_value (new octave_class (map, c_name, parent_list)); + + octave_value_list tmp = feval (meth.function_value (), args, 1); + + if (!error_state && tmp.length () >= 1) + { + if (tmp(0).is_string ()) + retval = tmp(0).all_strings (pad); + else + error ("cname/char method did not return a character string"); + } + } + else + error ("no char method defined for class %s", class_name().c_str ()); + + return retval; +} + + void octave_class::print (std::ostream& os, bool) const { @@ -1017,7 +1166,8 @@ indent (os); os << name << " ="; newline (os); - newline (os); + if (! Vcompact_format) + newline (os); return retval; } @@ -1682,6 +1832,7 @@ return (fcn && (fcn->is_class_method () || fcn->is_class_constructor () + || fcn->is_anonymous_function_of_class () || fcn->is_private_function_of_class (class_name ())) && find_parent_class (fcn->dispatch_class ())); } @@ -1803,7 +1954,9 @@ if (! error_state) { if (nargin == 2) - retval = octave_value (new octave_class (m, id)); + retval + = octave_value (new octave_class + (m, id, std::list<std::string> ())); else { octave_value_list parents = args.slice (2, nargin-2);
--- a/src/ov-class.h +++ b/src/ov-class.h @@ -54,18 +54,19 @@ parent_list (), obsolete_copies (0) { } - octave_class (const octave_map& m, const std::string& id) + octave_class (const octave_map& m, const std::string& id, + const std::list<std::string>& plist) : octave_base_value (), map (m), c_name (id), - parent_list (), obsolete_copies (0) + parent_list (plist), obsolete_copies (0) { } + octave_class (const octave_map& m, const std::string& id, + const octave_value_list& parents); + octave_class (const octave_class& s) : octave_base_value (s), map (s.map), c_name (s.c_name), parent_list (s.parent_list), obsolete_copies (0) { } - octave_class (const octave_map& m, const std::string& id, - const octave_value_list& parents); - ~octave_class (void) { } octave_base_value *clone (void) const { return new octave_class (*this); } @@ -74,7 +75,7 @@ octave_base_value *empty_clone (void) const { - return new octave_class (octave_map (map.keys ()), class_name ()); + return new octave_class (octave_map (map.keys ()), c_name, parent_list); } Cell dotref (const octave_value_list& idx); @@ -94,6 +95,12 @@ const std::list<octave_value_list>& idx, int nargout); + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& idx) + { + return subsref ("(", std::list<octave_value_list> (1, idx), nargout); + } + static octave_value numeric_conv (const Cell& val, const std::string& type); @@ -127,10 +134,18 @@ size_t nparents (void) const { return parent_list.size (); } octave_value reshape (const dim_vector& new_dims) const - { return map.reshape (new_dims); } + { + octave_class retval = octave_class (*this); + retval.map = retval.map_value().reshape (new_dims); + return octave_value (new octave_class (retval)); + } octave_value resize (const dim_vector& dv, bool = false) const - { octave_map tmap = map; tmap.resize (dv); return tmap; } + { + octave_class retval = octave_class (*this); + retval.map.resize (dv); + return octave_value (new octave_class (retval)); + } bool is_defined (void) const { return true; } @@ -152,6 +167,8 @@ octave_base_value *unique_parent_class (const std::string&); + string_vector all_strings (bool pad) const; + void print (std::ostream& os, bool pr_as_read_syntax = false) const; void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const;
--- a/src/ov-complex.h +++ b/src/ov-complex.h @@ -79,6 +79,15 @@ octave_value do_index_op (const octave_value_list& idx, bool resize_ok = false); + // Use this to give a more specific error message + idx_vector index_vector (void) const + { + error ( + "attempted to use a complex scalar as an index\n" + " (forgot to initialize i or j?)"); + return idx_vector (); + } + octave_value any (int = 0) const { return (scalar != Complex (0, 0)
--- a/src/ov-cx-sparse.cc +++ b/src/ov-cx-sparse.cc @@ -904,7 +904,7 @@ ARRAY_MAPPER (atan, Complex, ::atan); ARRAY_MAPPER (atanh, Complex, ::atanh); ARRAY_MAPPER (ceil, Complex, ::ceil); - ARRAY_MAPPER (conj, Complex, std::conj); + ARRAY_MAPPER (conj, Complex, std::conj<double>); ARRAY_MAPPER (cos, Complex, std::cos); ARRAY_MAPPER (cosh, Complex, std::cosh); ARRAY_MAPPER (exp, Complex, std::exp);
--- a/src/ov-fcn-handle.cc +++ b/src/ov-fcn-handle.cc @@ -164,7 +164,38 @@ else { str_ov_map::iterator it = overloads.find (dispatch_type); - if (it != overloads.end ()) + + if (it == overloads.end ()) + { + // Try parent classes too. + + std::list<std::string> plist + = symbol_table::parent_classes (dispatch_type); + + std::list<std::string>::const_iterator pit = plist.begin (); + + while (pit != plist.end ()) + { + std::string pname = *pit; + + std::string fnm = fcn_name (); + + octave_value ftmp = symbol_table::find_method (fnm, pname); + + if (ftmp.is_defined ()) + { + set_overload (pname, ftmp); + + out_of_date_check (ftmp, pname, false); + ov_fcn = ftmp; + + break; + } + + pit++; + } + } + else { out_of_date_check (it->second, dispatch_type, false); ov_fcn = it->second; @@ -553,7 +584,10 @@ swap_bytes<4> (&tmp); OCTAVE_LOCAL_BUFFER (char, ctmp1, tmp+1); - is.get (ctmp1, tmp+1, 0); + // is.get (ctmp1, tmp+1, 0); caused is.eof () to be true though + // effectively not reading over file end + is.read (ctmp1, tmp); + ctmp1[tmp] = 0; nm = std::string (ctmp1); if (! is) @@ -578,7 +612,10 @@ swap_bytes<4> (&tmp); OCTAVE_LOCAL_BUFFER (char, ctmp2, tmp+1); - is.get (ctmp2, tmp+1, 0); + // is.get (ctmp2, tmp+1, 0); caused is.eof () to be true though + // effectively not reading over file end + is.read (ctmp2, tmp); + ctmp2[tmp] = 0; unwind_protect_safe frame; @@ -658,7 +695,7 @@ success = set_fcn (octaveroot, fpath); } - return success; + return success; } #if defined (HAVE_HDF5) @@ -1722,7 +1759,8 @@ } /* -%!function y = testrecursionfunc (f, x, n) + +%!function y = __testrecursionfunc (f, x, n) %! if (nargin < 3) %! n = 0; %! endif @@ -1730,10 +1768,12 @@ %! y = f (x); %! else %! n++; -%! y = testrecursionfunc (@(x) f(2*x), x, n); +%! y = __testrecursionfunc (@(x) f(2*x), x, n); %! endif -%!test -%! assert (testrecursionfunc (@(x) x, 1), 8); +%!endfunction +%! +%!assert (__testrecursionfunc (@(x) x, 1), 8) + */ octave_fcn_binder::octave_fcn_binder (const octave_value& f, @@ -1919,3 +1959,12 @@ return retval; } + +/* +%!function r = __f (g, i) +%! r = g(i); +%!endfunction +%!test +%! x = [1,2;3,4]; +%! assert (__f (@(i) x(:,i), 1), [1;3]); +*/
--- a/src/ov-fcn-inline.cc +++ b/src/ov-fcn-inline.cc @@ -661,10 +661,9 @@ if (nargin > 0) { - std::string fun = args(0).string_value (); - - if (! error_state) + if (args(0).is_string ()) { + std::string fun = args(0).string_value (); string_vector fargs; if (nargin == 1) @@ -673,8 +672,9 @@ bool in_string = false; std::string tmp_arg; size_t i = 0; + size_t fun_length = fun.length (); - while (i < fun.length ()) + while (i < fun_length) { bool terminate_arg = false; char c = fun[i++]; @@ -698,7 +698,7 @@ else { // Before we do anything remove trailing whitespaces. - while (i < fun.length () && isspace (c)) + while (i < fun_length && isspace (c)) c = fun[i++]; // Do we have a variable or a function? @@ -710,13 +710,24 @@ is_arg = false; } } + else if (! is_arg) + { + if (c == 'e' || c == 'E') + { + // possible number in exponent form, not arg + if (isdigit (fun[i]) + || fun[i] == '-' || fun[i] == '+') + continue; + } + is_arg = true; + tmp_arg.append (1, c); + } else { tmp_arg.append (1, c); - is_arg = true; } - if (terminate_arg || (i == fun.length () && is_arg)) + if (terminate_arg || (i == fun_length && is_arg)) { bool have_arg = false; @@ -744,6 +755,12 @@ } else if (nargin == 2 && args(1).is_numeric_type ()) { + if (! args(1).is_scalar_type ()) + { + error ("inline: N must be an integer"); + return retval; + } + int n = args(1).int_value (); if (! error_state) @@ -763,7 +780,7 @@ } else { - error ("inline: N must be positive or zero"); + error ("inline: N must be a positive integer or zero"); return retval; } } @@ -779,11 +796,12 @@ for (int i = 1; i < nargin; i++) { - std::string s = args(i).string_value (); - - if (! error_state) - fargs(i-1) = s; - else + if (args(i).is_string ()) + { + std::string s = args(i).string_value (); + fargs(i-1) = s; + } + else { error ("inline: expecting string arguments"); return retval; @@ -804,9 +822,17 @@ /* %!shared fn -%! fn = inline ("x.^2 + 1","x"); +%! fn = inline ("x.^2 + 1"); %!assert (feval (fn, 6), 37) %!assert (fn (6), 37) +%% FIXME: Need tests for other 2 calling forms of inline() + +%% Test input validation +%!error inline () +%!error <STR argument must be a string> inline (1) +%!error <N must be an integer> inline ("2", ones (2,2)) +%!error <N must be a positive integer> inline ("2", -1) +%!error <expecting string arguments> inline ("2", "x", -1, "y") */ DEFUN (formula, args, , @@ -837,6 +863,16 @@ return retval; } +/* +%!assert (formula (fn), "x.^2 + 1") +%!assert (formula (fn), char (fn)) + +%% Test input validation +%!error formula () +%!error formula (1, 2) +%!error <FUN must be an inline function> formula (1) +*/ + DEFUN (argnames, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} argnames (@var{fun})\n\ @@ -873,12 +909,37 @@ return retval; } +/* +%!assert (argnames (fn), {"x"}) +%!assert (argnames (inline ("1e-3*y + 2e4*z")), {"y"; "z"}) +%!assert (argnames (inline ("2", 2)), {"x"; "P1"; "P2"}) + +%% Test input validation +%!error argnames () +%!error argnames (1, 2) +%!error <FUN must be an inline function> argnames (1) +*/ + DEFUN (vectorize, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} vectorize (@var{fun})\n\ Create a vectorized version of the inline function @var{fun}\n\ by replacing all occurrences of @code{*}, @code{/}, etc., with\n\ @code{.*}, @code{./}, etc.\n\ +\n\ +This may be useful, for example, when using inline functions with\n\ +numerical integration or optimization where a vector-valued function\n\ +is expected.\n\ +\n\ +@example\n\ +@group\n\ +fcn = vectorize (inline (\"x^2 - 1\"))\n\ + @result{} fcn = f(x) = x.^2 - 1\n\ +quadv (fcn, 0, 3)\n\ + @result{} 6\n\ +@end group\n\ +@end example\n\ +@seealso{inline, formula, argnames}\n\ @end deftypefn") { octave_value retval; @@ -901,7 +962,7 @@ if (old) old_func = old->fcn_text (); else - error ("vectorize: must be a string or inline function"); + error ("vectorize: FUN must be a string or inline function"); } if (! error_state) @@ -942,3 +1003,18 @@ return retval; } + +/* +%!assert (char (vectorize (fn)), "x.^2 + 1") +%!assert (char (vectorize (inline ("1e-3*y + 2e4*z"))), "1e-3.*y + 2e4.*z") +%!assert (char (vectorize (inline ("2**x^5"))), "2.**x.^5") +%!assert (vectorize ("x.^2 + 1"), "x.^2 + 1") +%!assert (vectorize ("1e-3*y + 2e4*z"), "1e-3.*y + 2e4.*z") +%!assert (vectorize ("2**x^5"), "2.**x.^5") + +%% Test input validation +%!error vectorize () +%!error vectorize (1, 2) +%!error <FUN must be a string or inline function> vectorize (1) +*/ +
--- a/src/ov-fcn.h +++ b/src/ov-fcn.h @@ -61,6 +61,9 @@ virtual std::string fcn_file_name (void) const { return std::string (); } + // The name to show in the profiler (also used as map-key). + virtual std::string profiler_name (void) const { return name (); } + virtual std::string parent_fcn_name (void) const { return std::string (); } virtual symbol_table::scope_id parent_fcn_scope (void) const { return -1; } @@ -100,9 +103,13 @@ bool is_private_function (void) const { return private_function; } - bool is_private_function_of_class (const std::string& nm) + bool is_private_function_of_class (const std::string& nm) const { return private_function && xdispatch_class == nm; } + virtual bool + is_anonymous_function_of_class (const std::string& = std::string ()) const + { return false; } + std::string dir_name (void) const { return my_dir_name; } void stash_dir_name (const std::string& dir) { my_dir_name = dir; }
--- a/src/ov-float.cc +++ b/src/ov-float.cc @@ -69,7 +69,7 @@ // 1x1 matrix back to a scalar value. Need a better solution // to this problem. - octave_value tmp (new octave_matrix (matrix_value ())); + octave_value tmp (new octave_float_matrix (float_matrix_value ())); return tmp.do_index_op (idx, resize_ok); }
--- a/src/ov-flt-re-mat.cc +++ b/src/ov-flt-re-mat.cc @@ -839,3 +839,32 @@ return octave_value (); } + +/* + +%!assert (class (single(1)), "single") +%!assert (class (single(1 + i)), "single") +%!assert (class (single (int8 (1))), "single") +%!assert (class (single (uint8 (1))), "single") +%!assert (class (single (int16 (1))), "single") +%!assert (class (single (uint16 (1))), "single") +%!assert (class (single (int32 (1))), "single") +%!assert (class (single (uint32 (1))), "single") +%!assert (class (single (int64 (1))), "single") +%!assert (class (single (uint64 (1))), "single") +%!assert (class (single (true)), "single") +%!assert (class (single ("A")), "single") +%!error (single (sparse (1))) +%!test +%! x = diag ([1 3 2]); +%! y = single (x); +%! assert (class (x), "double"); +%! assert (class (y), "single"); +%!test +%! x = diag ([i 3 2]); +%! y = single (x); +%! assert (class (x), "double"); +%! assert (class (y), "single"); + +*/ +
--- a/src/ov-int16.cc +++ b/src/ov-int16.cc @@ -82,3 +82,15 @@ { OCTAVE_TYPE_CONV_BODY (int16); } + +/* + +%!assert (class (int16 (1)), "int16") +%!assert (int16 (1.25), int16 (1)) +%!assert (int16 (1.5), int16 (2)) +%!assert (int16 (-1.5), int16 (-2)) +%!assert (int16 (2^17), int16 (2^16-1)) +%!assert (int16 (-2^17), int16 (-2^16)) + +*/ +
--- a/src/ov-int32.cc +++ b/src/ov-int32.cc @@ -82,3 +82,15 @@ { OCTAVE_TYPE_CONV_BODY (int32); } + +/* + +%!assert (class (int32 (1)), "int32") +%!assert (int32 (1.25), int32 (1)) +%!assert (int32 (1.5), int32 (2)) +%!assert (int32 (-1.5), int32 (-2)) +%!assert (int32 (2^33), int32 (2^32-1)) +%!assert (int32 (-2^33), int32 (-2^32)) + +*/ +
--- a/src/ov-int64.cc +++ b/src/ov-int64.cc @@ -82,3 +82,15 @@ { OCTAVE_TYPE_CONV_BODY (int64); } + +/* + +%!assert (class (int64 (1)), "int64") +%!assert (int64 (1.25), int64 (1)) +%!assert (int64 (1.5), int64 (2)) +%!assert (int64 (-1.5), int64 (-2)) +%!assert (int64 (2^65), int64 (2^64-1)) +%!assert (int64 (-2^65), int64 (-2^64)) + +*/ +
--- a/src/ov-int8.cc +++ b/src/ov-int8.cc @@ -82,3 +82,14 @@ { OCTAVE_TYPE_CONV_BODY (int8); } + +/* + +%!assert (class (int8 (1)), "int8") +%!assert (int8 (1.25), int8 (1)) +%!assert (int8 (1.5), int8 (2)) +%!assert (int8 (-1.5), int8 (-2)) +%!assert (int8 (2^9), int8 (2^8-1)) +%!assert (int8 (-2^9), int8 (-2^8)) + +*/
--- a/src/ov-intx.h +++ b/src/ov-intx.h @@ -564,6 +564,14 @@ return retval; } + bool bool_value (bool warn = false) const + { + if (warn && scalar != 0.0 && scalar != 1.0) + gripe_logical_conversion (); + + return scalar.bool_value (); + } + boolNDArray bool_array_value (bool warn = false) const {
--- a/src/ov-mex-fcn.cc +++ b/src/ov-mex-fcn.cc @@ -33,6 +33,7 @@ #include "oct-obj.h" #include "ov-mex-fcn.h" #include "ov.h" +#include "profiler.h" #include "toplev.h" #include "unwind-prot.h" @@ -147,7 +148,9 @@ try { + BEGIN_PROFILER_BLOCK (profiler_name ()) retval = call_mex (have_fmex, mex_fcn_ptr, args, nargout, this); + END_PROFILER_BLOCK } catch (octave_execution_exception) {
--- a/src/ov-null-mat.cc +++ b/src/ov-null-mat.cc @@ -118,3 +118,17 @@ return retval; } +/* + +%!assert (isnull ([]), true) +%!assert (isnull ([1]), false) +%!assert (isnull (zeros (0,3)), false) +%!assert (isnull (""), true) +%!assert (isnull ("A"), false) +%!assert (isnull (''), true) +%!assert (isnull ('A'), false) +%!test +%! x = []; +%! assert (isnull (x), false); + +*/
new file mode 100644 --- /dev/null +++ b/src/ov-oncleanup.cc @@ -0,0 +1,227 @@ +/* + +Copyright (C) 2010-2011 VZLU Prague + +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/>. + +*/ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include "defun.h" +#include "ov-oncleanup.h" +#include "ov-fcn.h" +#include "ov-usr-fcn.h" +#include "pt-misc.h" +#include "toplev.h" + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_oncleanup, "onCleanup", + "onCleanup"); + +octave_oncleanup::octave_oncleanup (const octave_value& f) + : fcn (f) +{ + if (f.is_function_handle ()) + { + octave_function *fptr = f.function_value (true); + if (fptr) + { + octave_user_function *uptr + = dynamic_cast<octave_user_function *> (fptr); + + if (uptr != 0) + { + tree_parameter_list *pl = uptr->parameter_list (); + + if (pl != 0 && pl->length () > 0) + warning ("onCleanup: cleanup action takes parameters"); + } + } + else + error ("onCleanup: no default dispatch for function handle"); + } + else + { + fcn = octave_value (); + error ("onCleanup: argument must be a function handle"); + } +} + +octave_oncleanup::~octave_oncleanup (void) +{ + if (fcn.is_undefined ()) + return; + + unwind_protect frame; + + // Clear interrupts. + frame.protect_var (octave_interrupt_state); + octave_interrupt_state = 0; + + // Disallow quit(). + frame.protect_var (quit_allowed); + quit_allowed = false; + + // Clear errors. + frame.protect_var (error_state); + error_state = 0; + + try + { + // Run the actual code. + fcn.do_multi_index_op (0, octave_value_list ()); + } + catch (octave_interrupt_exception) + { + // Swallow the interrupt. + warning ("onCleanup: interrupt occured in cleanup action"); + } + catch (std::bad_alloc) + { + // Swallow the exception. + warning ("onCleanup: out of memory occured in cleanup action"); + } + catch (...) // Yes, the black hole. We're in a d-tor. + { + // This shouldn't happen, in theory. + error ("onCleanup: internal error: unhandled exception in cleanup action"); + } + + // We don't want to ignore errors that occur in the cleanup code, so + // if an error is encountered there, leave error_state alone. + // Otherwise, set it back to what it was before. + if (error_state) + { + frame.discard_top (); + octave_call_stack::backtrace_error_message (); + } +} + +octave_scalar_map +octave_oncleanup::scalar_map_value (void) const +{ + octave_scalar_map retval; + retval.setfield ("task", fcn); + return retval; +} + +static void +warn_save_load (void) +{ + warning ("onCleanup: load and save not supported"); +} + +bool +octave_oncleanup::save_ascii (std::ostream& /* os */) +{ + warn_save_load (); + return true; +} + +bool +octave_oncleanup::load_ascii (std::istream& /* is */) +{ + warn_save_load (); + return true; +} + +bool +octave_oncleanup::save_binary (std::ostream& /* os */, bool& /* save_as_floats */) +{ + warn_save_load (); + return true; +} + +bool +octave_oncleanup::load_binary (std::istream& /* is */, bool /* swap */, + oct_mach_info::float_format /* fmt */) +{ + warn_save_load (); + return true; +} + +#if defined (HAVE_HDF5) +bool +octave_oncleanup::save_hdf5 (hid_t /* loc_id */, const char * /* name */, + bool /* save_as_floats */) +{ + warn_save_load (); + return true; +} + +bool +octave_oncleanup::load_hdf5 (hid_t /* loc_id */, const char * /* name */) +{ + warn_save_load (); + return true; +} +#endif + +void +octave_oncleanup::print (std::ostream& os, bool pr_as_read_syntax) const +{ + print_raw (os, pr_as_read_syntax); + newline (os); +} + +void +octave_oncleanup::print_raw (std::ostream& os, bool pr_as_read_syntax) const +{ + os << "onCleanup ("; + if (fcn.is_defined ()) + fcn.print_raw (os, pr_as_read_syntax); + os << ")"; +} + +DEFUN (onCleanup, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{c} =} onCleanup (@var{action})\n\ +Create a special object that executes a given function upon destruction.\n\ +If the object is copied to multiple variables (or cell or struct array\n\ +elements) or returned from a function, @var{action} will be executed after\n\ +clearing the last copy of the object. Note that if multiple local onCleanup\n\ +variables are created, the order in which they are called is unspecified.\n\ +For similar functionality @xref{The @code{unwind_protect} Statement}.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = octave_value (new octave_oncleanup (args(0))); + else + print_usage (); + + return retval; +} + +/* + +%!test +%! old_wstate = warning ("query"); +%! unwind_protect +%! trigger = onCleanup (@() warning ("on", "__MY_WARNING__")); +%! warning ("off", "__MY_WARNING__"); +%! assert ((warning ("query", "__MY_WARNING__")).state, "off"); +%! clear trigger +%! assert ((warning ("query", "__MY_WARNING__")).state, "on"); +%! unwind_protect_cleanup +%! warning (old_wstate); +%! end_unwind_protect + +*/
new file mode 100644 --- /dev/null +++ b/src/ov-oncleanup.h @@ -0,0 +1,101 @@ +/* + +Copyright (C) 2010-2011 VZLU Prague + +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/>. + +*/ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <iosfwd> + +#include "ov-base.h" +#include "ov-struct.h" +#include "ov.h" + +static void +gripe_internal (void) +{ + error ("onCleanup: internal error: cloning nonempty object"); +} + +class octave_oncleanup : public octave_base_value +{ +public: + octave_oncleanup (void) : fcn () { } + + octave_oncleanup (const octave_value& fcn); + + octave_base_value *clone (void) const + { + if (fcn.is_defined ()) + gripe_internal (); + + return empty_clone (); + } + + octave_base_value *empty_clone (void) const + { + return new octave_oncleanup (); + } + + ~octave_oncleanup (void); + + bool is_defined (void) const { return true; } + + bool is_object (void) const { return true; } // do we want this? + + octave_map map_value (void) const { return scalar_map_value (); } + + octave_scalar_map scalar_map_value (void) const; + + dim_vector dims (void) const + { + static dim_vector dv (1, 1); + return dv; + } + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + +private: + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA + +protected: + + octave_value fcn; +};
--- a/src/ov-perm.cc +++ b/src/ov-perm.cc @@ -217,6 +217,12 @@ return SparseMatrix (matrix); } +SparseBoolMatrix +octave_perm_matrix::sparse_bool_matrix_value (bool) const +{ + return SparseBoolMatrix (matrix); +} + SparseComplexMatrix octave_perm_matrix::sparse_complex_matrix_value (bool) const {
--- a/src/ov-perm.h +++ b/src/ov-perm.h @@ -160,6 +160,8 @@ SparseMatrix sparse_matrix_value (bool = false) const; + SparseBoolMatrix sparse_bool_matrix_value (bool = false) const; + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; int8NDArray
--- a/src/ov-range.cc +++ b/src/ov-range.cc @@ -370,7 +370,9 @@ { os << name << " ="; newline (os); - newline (os); + if (! Vcompact_format) + newline (os); + retval = true; } @@ -647,11 +649,36 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} allow_noninteger_range_as_index ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} allow_noninteger_range_as_index (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} allow_noninteger_range_as_index (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether non-integer\n\ ranges are allowed as indices. This might be useful for @sc{matlab}\n\ compatibility; however, it is still not entirely compatible because\n\ @sc{matlab} treats the range expression differently in different contexts.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (allow_noninteger_range_as_index); } + +/* +%!test +%! x = 0:10; +%! save = allow_noninteger_range_as_index (); +%! warn_state = warning ("query", "Octave:noninteger-range-as-index"); +%! unwind_protect +%! allow_noninteger_range_as_index (false); +%! fail ('x(2.1:5)'); +%! assert (x(2:5), 1:4); +%! allow_noninteger_range_as_index (true); +%! warning ("off", "Octave:noninteger-range-as-index"); +%! assert (x(2.49:5), 1:3); +%! assert (x(2.5:5), 2:4); +%! assert (x(2.51:5), 2:4); +%! unwind_protect_cleanup +%! allow_noninteger_range_as_index (save); +%! warning (warn_state.state, warn_state.identifier); +%! end_unwind_protect +*/
--- a/src/ov-re-mat.cc +++ b/src/ov-re-mat.cc @@ -979,3 +979,36 @@ return octave_value (); } + +/* + +%!assert (class (double (single (1))), "double") +%!assert (class (double (single (1 + i))), "double") +%!assert (class (double (int8 (1))), "double") +%!assert (class (double (uint8 (1))), "double") +%!assert (class (double (int16 (1))), "double") +%!assert (class (double (uint16 (1))), "double") +%!assert (class (double (int32 (1))), "double") +%!assert (class (double (uint32 (1))), "double") +%!assert (class (double (int64 (1))), "double") +%!assert (class (double (uint64 (1))), "double") +%!assert (class (double (true)), "double") +%!assert (class (double ("A")), "double") +%!test +%! x = sparse (logical ([1 0; 0 1])); +%! y = double (x); +%! assert (class (x), "logical"); +%! assert (class (y), "double"); +%! assert (issparse (y)); +%!test +%! x = diag (single ([1 3 2])); +%! y = double (x); +%! assert (class (x), "single"); +%! assert (class (y), "double"); +%!test +%! x = diag (single ([i 3 2])); +%! y = double (x); +%! assert (class (x), "single"); +%! assert (class (y), "double"); + +*/
--- a/src/ov-struct.cc +++ b/src/ov-struct.cc @@ -480,7 +480,7 @@ } else { - if (t_rhs.is_map()) + if (t_rhs.is_map() || t_rhs.is_object ()) { octave_map rhs_map = t_rhs.map_value (); @@ -1335,11 +1335,14 @@ increment_indent_level (); - newline (os); + if (! Vcompact_format) + newline (os); + indent (os); os << "scalar structure containing the fields:"; newline (os); - newline (os); + if (! Vcompact_format) + newline (os); increment_indent_level (); @@ -2026,6 +2029,7 @@ Convert @var{cell} to a structure. The number of fields in @var{fields}\n\ must match the number of elements in @var{cell} along dimension @var{dim},\n\ that is @code{numel (@var{fields}) == size (@var{cell}, @var{dim})}.\n\ +If @var{dim} is omitted, a value of 1 is assumed.\n\ \n\ @example\n\ @group\n\ @@ -2045,63 +2049,87 @@ { octave_value retval; - if (args.length () == 3) + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) { if (! args(0).is_cell ()) - error ("cell2struct: argument CELL must be of type cell"); - else if (! (args(1).is_cellstr () || args(1).is_char_matrix ())) - error ("cell2struct: FIELDS must be a cell array of strings or a character matrix"); - else if (! args(2).is_real_scalar ()) - error ("cell2struct: DIM must be a real scalar"); - else + { + error ("cell2struct: argument CELL must be of type cell"); + return retval; + } + + if (! (args(1).is_cellstr () || args(1).is_char_matrix ())) { - const Cell vals = args(0).cell_value (); - const Array<std::string> fields = args(1).cellstr_value (); - int dim = args(2).int_value () - 1; - octave_idx_type ext = 0; - - if (dim < 0) - error ("cell2struct: DIM must be a valid dimension"); + error ("cell2struct: FIELDS must be a cell array of strings or a character matrix"); + return retval; + } + + const Cell vals = args(0).cell_value (); + const Array<std::string> fields = args(1).cellstr_value (); + + octave_idx_type ext = 0; + + int dim = 0; + + if (nargin == 3) + { + if (args(2).is_real_scalar ()) + { + dim = nargin == 2 ? 0 : args(2).int_value () - 1; + + if (error_state) + return retval; + } else { - ext = vals.ndims () > dim ? vals.dims ()(dim) : 1; - if (ext != fields.numel ()) - error ("cell2struct: number of FIELDS does not match dimension"); - } - - - if (! error_state) - { - int nd = std::max (dim+1, vals.ndims ()); - // result dimensions. - dim_vector rdv = vals.dims ().redim (nd); - - assert (ext == rdv(dim)); - if (nd == 2) - { - rdv(0) = rdv(1-dim); - rdv(1) = 1; - } - else - { - for (int i = dim + 1; i < nd; i++) - rdv(i-1) = rdv(i); - - rdv.resize (nd-1); - } - - octave_map map (rdv); - Array<idx_vector> ia (dim_vector (nd, 1), idx_vector::colon); - - for (octave_idx_type i = 0; i < ext; i++) - { - ia(dim) = i; - map.setfield (fields(i), vals.index (ia).reshape (rdv)); - } - - retval = map; + error ("cell2struct: DIM must be a real scalar"); + return retval; } } + + if (dim < 0) + { + error ("cell2struct: DIM must be a valid dimension"); + return retval; + } + + ext = vals.ndims () > dim ? vals.dims ()(dim) : 1; + + if (ext != fields.numel ()) + { + error ("cell2struct: number of FIELDS does not match dimension"); + return retval; + } + + int nd = std::max (dim+1, vals.ndims ()); + // result dimensions. + dim_vector rdv = vals.dims ().redim (nd); + + assert (ext == rdv(dim)); + if (nd == 2) + { + rdv(0) = rdv(1-dim); + rdv(1) = 1; + } + else + { + for (int i = dim + 1; i < nd; i++) + rdv(i-1) = rdv(i); + + rdv.resize (nd-1); + } + + octave_map map (rdv); + Array<idx_vector> ia (dim_vector (nd, 1), idx_vector::colon); + + for (octave_idx_type i = 0; i < ext; i++) + { + ia(dim) = i; + map.setfield (fields(i), vals.index (ia).reshape (rdv)); + } + + retval = map; } else print_usage (); @@ -2119,6 +2147,8 @@ %! assert (s, t); %! assert (struct2cell (s), vals'); %! assert (fieldnames (s), keys'); + +%!assert (cell2struct ({1; 2}, {"a"; "b"}), struct ("a", 1, "b", 2)); */ @@ -2186,8 +2216,13 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} struct_levels_to_print ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} struct_levels_to_print (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} struct_levels_to_print (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the number of\n\ structure levels to display.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE_WITH_LIMITS (struct_levels_to_print, @@ -2198,11 +2233,16 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} print_struct_array_contents ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} print_struct_array_contents (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} print_struct_array_contents (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies whether to print struct\n\ array contents. If true, values of struct array elements are printed.\n\ This variable does not affect scalar structures. Their elements\n\ are always printed. In both cases, however, printing will be limited to\n\ the number of levels specified by @var{struct_levels_to_print}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (print_struct_array_contents);
--- a/src/ov-typeinfo.cc +++ b/src/ov-typeinfo.cc @@ -24,10 +24,12 @@ #include <config.h> #endif -#include "ov-typeinfo.h" +#include "Array.h" +#include "singleton-cleanup.h" #include "defun.h" #include "error.h" +#include "ov-typeinfo.h" const int octave_value_typeinfo::init_tab_sz (16); @@ -35,14 +37,18 @@ octave_value_typeinfo * octave_value_typeinfo::instance (0); -#include <Array.h> - bool octave_value_typeinfo::instance_ok (void) { bool retval = true; + if (! instance) - instance = new octave_value_typeinfo (); + { + instance = new octave_value_typeinfo (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) { @@ -591,10 +597,11 @@ DEFUN (typeinfo, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} typeinfo (@var{expr})\n\ +@deftypefn {Built-in Function} {} typeinfo ()\n\ +@deftypefnx {Built-in Function} {} typeinfo (@var{expr})\n\ \n\ Return the type of the expression @var{expr}, as a string. If\n\ -@var{expr} is omitted, return an array of strings containing all the\n\ +@var{expr} is omitted, return an cell array of strings containing all the\n\ currently installed data types.\n\ @end deftypefn") { @@ -611,3 +618,74 @@ return retval; } + +/* +%!error typeinfo ("foo", 1); + +%!assert (iscellstr (typeinfo ())); + +%!assert (typeinfo (false), "bool"); +%!assert (typeinfo ([true, false]), "bool matrix"); + +%!assert (typeinfo (1:2), "range"); + +%!assert (typeinfo ("string"), "string"); +%!assert (typeinfo ('string'), "sq_string"); + +%!assert (typeinfo (diag ([1, 2])), "diagonal matrix") +%!assert (typeinfo (diag ([i, 2])), "complex diagonal matrix") +%!assert (typeinfo (single (diag ([1, 2]))), "float diagonal matrix") +%!assert (typeinfo (single (diag ([i, 2]))), "float complex diagonal matrix") +%!assert (typeinfo (diag (single ([1, 2]))), "float diagonal matrix") +%!assert (typeinfo (diag (single ([i, 2]))), "float complex diagonal matrix") + +%!assert (typeinfo ([]), "null_matrix"); +%!assert (typeinfo (""), "null_string"); +%!assert (typeinfo (''), "null_sq_string"); + +%!assert (typeinfo (1), "scalar"); +%!assert (typeinfo (double (1)), "scalar"); +%!assert (typeinfo ([1, 2]), "matrix"); +%!assert (typeinfo (double ([1, 2])), "matrix"); + +%!assert (typeinfo (i), "complex scalar"); +%!assert (typeinfo ([i, 2]), "complex matrix"); + +%!assert (typeinfo (single (1)), "float scalar"); +%!assert (typeinfo (single ([1, 2])), "float matrix"); + +%!assert (typeinfo (single (i)), "float complex scalar"); +%!assert (typeinfo (single ([i, 2])), "float complex matrix"); + +%!assert (typeinfo (sparse (eye (10))), "sparse matrix"); +%!assert (typeinfo (sparse (i * eye (10))), "sparse complex matrix"); +%!assert (typeinfo (logical (sparse (i * eye (10)))), "sparse bool matrix"); + +%!assert (typeinfo (int8 (1)), "int8 scalar"); +%!assert (typeinfo (int16 (1)), "int16 scalar"); +%!assert (typeinfo (int32 (1)), "int32 scalar"); +%!assert (typeinfo (int64 (1)), "int64 scalar"); +%!assert (typeinfo (uint8 (1)), "uint8 scalar"); +%!assert (typeinfo (uint16 (1)), "uint16 scalar"); +%!assert (typeinfo (uint32 (1)), "uint32 scalar"); +%!assert (typeinfo (uint64 (1)), "uint64 scalar"); + +%!test +%! s.a = 1; +%! assert (typeinfo (s), "scalar struct"); + +%!test +%! s(2).a = 1; +%! assert (typeinfo (s), "struct"); + +%!assert (typeinfo ({"cell"}), "cell"); + +%!assert (typeinfo (@sin), "function handle"); +%!assert (typeinfo (@(x) x), "function handle"); + +%!assert (typeinfo (inline ('x^2')), "inline function"); + +%!test +%! [l, u, p] = lu (rand (3)); +%! assert (typeinfo (p), "permutation matrix"); +*/
--- a/src/ov-typeinfo.h +++ b/src/ov-typeinfo.h @@ -208,12 +208,16 @@ type_conv_ops (dim_vector (init_tab_sz, init_tab_sz), 0), widening_ops (dim_vector (init_tab_sz, init_tab_sz), 0) { } + ~octave_value_typeinfo (void) { } + private: static const int init_tab_sz; static octave_value_typeinfo *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + int num_types; Array<std::string> types;
--- a/src/ov-uint16.cc +++ b/src/ov-uint16.cc @@ -82,3 +82,15 @@ { OCTAVE_TYPE_CONV_BODY (uint16); } + +/* + +%!assert (class (uint16 (1)), "uint16") +%!assert (uint16 (1.25), uint16 (1)) +%!assert (uint16 (1.5), uint16 (2)) +%!assert (uint16 (-1.5), uint16 (0)) +%!assert (uint16 (2^17), uint16 (2^16-1)) +%!assert (uint16 (-2^17), uint16 (0)) + +*/ +
--- a/src/ov-uint32.cc +++ b/src/ov-uint32.cc @@ -82,3 +82,14 @@ { OCTAVE_TYPE_CONV_BODY (uint32); } + +/* + +%!assert (class (uint32 (1)), "uint32") +%!assert (uint32 (1.25), uint32 (1)) +%!assert (uint32 (1.5), uint32 (2)) +%!assert (uint32 (-1.5), uint32 (0)) +%!assert (uint32 (2^33), uint32 (2^32-1)) +%!assert (uint32 (-2^33), uint32 (0)) + +*/
--- a/src/ov-uint64.cc +++ b/src/ov-uint64.cc @@ -82,3 +82,14 @@ { OCTAVE_TYPE_CONV_BODY (uint64); } + +/* + +%!assert (class (uint64 (1)), "uint64") +%!assert (uint64 (1.25), uint64 (1)) +%!assert (uint64 (1.5), uint64 (2)) +%!assert (uint64 (-1.5), uint64 (0)) +%!assert (uint64 (2^65), uint64 (2^64-1)) +%!assert (uint64 (-2^65), uint64 (0)) + +*/
--- a/src/ov-uint8.cc +++ b/src/ov-uint8.cc @@ -82,3 +82,14 @@ { OCTAVE_TYPE_CONV_BODY (uint8); } + +/* + +%!assert (class (uint8 (1)), "uint8") +%!assert (uint8 (1.25), uint8 (1)) +%!assert (uint8 (1.5), uint8 (2)) +%!assert (uint8 (-1.5), uint8 (0)) +%!assert (uint8 (2^9), uint8 (2^8-1)) +%!assert (uint8 (-2^9), uint8 (0)) + +*/
--- a/src/ov-usr-fcn.cc +++ b/src/ov-usr-fcn.cc @@ -24,6 +24,8 @@ #include <config.h> #endif +#include <sstream> + #include "str-vec.h" #include <defaults.h> @@ -47,6 +49,7 @@ #include "unwind-prot.h" #include "utils.h" #include "parse.h" +#include "profiler.h" #include "variables.h" #include "ov-fcn-handle.h" @@ -132,7 +135,9 @@ frame.protect_var (tree_evaluator::statement_context); tree_evaluator::statement_context = tree_evaluator::script; + BEGIN_PROFILER_BLOCK (profiler_name ()) cmd_list->accept (*current_evaluator); + END_PROFILER_BLOCK if (tree_return_command::returning) tree_return_command::returning = 0; @@ -177,13 +182,14 @@ : octave_user_code (std::string (), std::string ()), param_list (pl), ret_list (rl), cmd_list (cl), lead_comm (), trail_comm (), file_name (), + location_line (0), location_column (0), parent_name (), t_parsed (static_cast<time_t> (0)), t_checked (static_cast<time_t> (0)), system_fcn_file (false), call_depth (-1), num_named_args (param_list ? param_list->length () : 0), subfunction (false), inline_function (false), - class_constructor (false), class_method (false), - parent_scope (-1), local_scope (sid), + anonymous_function (false), class_constructor (false), + class_method (false), parent_scope (-1), local_scope (sid), curr_unwind_protect_frame (0) { if (cmd_list) @@ -218,6 +224,25 @@ file_name = nm; } +std::string +octave_user_function::profiler_name (void) const +{ + std::ostringstream result; + + if (is_inline_function ()) + result << "inline@" << fcn_file_name () + << ":" << location_line << ":" << location_column; + else if (is_anonymous_function ()) + result << "anonymous@" << fcn_file_name () + << ":" << location_line << ":" << location_column; + else if (is_subfunction ()) + result << parent_fcn_name () << ">" << name (); + else + result << name (); + + return result.str (); +} + void octave_user_function::mark_as_system_fcn_file (void) { @@ -429,8 +454,9 @@ frame.protect_var (tree_evaluator::statement_context); tree_evaluator::statement_context = tree_evaluator::function; - bool special_expr = (is_inline_function () - || cmd_list->is_anon_function_body ()); + bool special_expr = (is_inline_function () || is_anonymous_function ()); + + BEGIN_PROFILER_BLOCK (profiler_name ()) if (special_expr) { @@ -449,6 +475,8 @@ else cmd_list->accept (*current_evaluator); + END_PROFILER_BLOCK + if (echo_commands) print_code_function_trailer (); @@ -611,7 +639,7 @@ return the declared number of arguments that the function can accept.\n\ If the last argument is @var{varargin} the returned value is negative.\n\ This feature does not work on builtin functions.\n\ -@seealso{nargout, varargin, varargout}\n\ +@seealso{nargout, varargin, isargout, varargout, nthargout}\n\ @end deftypefn") { octave_value retval; @@ -709,7 +737,7 @@ At the top level, @code{nargout} with no argument is undefined.\n\ @code{nargout} does not work on builtin functions.\n\ @code{nargout} returns -1 for all anonymous functions.\n\ -@seealso{nargin, varargin, varargout}\n\ +@seealso{nargin, varargin, isargout, varargout, nthargout}\n\ @end deftypefn") { octave_value retval; @@ -793,9 +821,14 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} optimize_subsasgn_calls ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} optimize_subsasgn_calls (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} optimize_subsasgn_calls (@var{new_val}, \"local\")\n\ Query or set the internal flag for subsasgn method call optimizations.\n\ If true, Octave will attempt to eliminate the redundant copying when calling\n\ subsasgn method of a user-defined class.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (optimize_subsasgn_calls); @@ -834,7 +867,7 @@ false. @var{k} can also be an array, in which case the function works\n\ element-by-element and a logical array is returned. At the top level,\n\ @code{isargout} returns an error.\n\ -@seealso{nargout, nargin, varargin, varargout}\n\ +@seealso{nargout, nargin, varargin, varargout, nthargout}\n\ @end deftypefn") { octave_value retval;
--- a/src/ov-usr-fcn.h +++ b/src/ov-usr-fcn.h @@ -189,6 +189,12 @@ void stash_fcn_file_name (const std::string& nm); + void stash_fcn_location (int line, int col) + { + location_line = line; + location_column = col; + } + void stash_parent_fcn_name (const std::string& p) { parent_name = p; } void stash_parent_fcn_scope (symbol_table::scope_id ps) { parent_scope = ps; } @@ -207,6 +213,8 @@ std::string fcn_file_name (void) const { return file_name; } + std::string profiler_name (void) const; + std::string parent_fcn_name (void) const { return parent_name; } symbol_table::scope_id parent_fcn_scope (void) const { return parent_scope; } @@ -255,6 +263,20 @@ bool is_inline_function (void) const { return inline_function; } + void mark_as_anonymous_function (void) { anonymous_function = true; } + + bool is_anonymous_function (void) const { return anonymous_function; } + + bool is_anonymous_function_of_class + (const std::string& cname = std::string ()) const + { + return anonymous_function + ? (cname.empty () + ? (! dispatch_class().empty ()) + : cname == dispatch_class ()) + : false; + } + void mark_as_class_constructor (void) { class_constructor = true; } bool is_class_constructor (const std::string& cname = std::string ()) const @@ -344,6 +366,10 @@ // The name of the file we parsed. std::string file_name; + // Location where this function was defined. + int location_line; + int location_column; + // The name of the parent function, if any. std::string parent_name; @@ -371,6 +397,9 @@ // TRUE means this is an inline function. bool inline_function; + // TRUE means this is an anonymous function. + bool anonymous_function; + // TRUE means this function is the constructor for class object. bool class_constructor;
--- a/src/ov.cc +++ b/src/ov.cc @@ -65,6 +65,7 @@ #include "ov-range.h" #include "ov-struct.h" #include "ov-class.h" +#include "ov-oncleanup.h" #include "ov-cs-list.h" #include "ov-colon.h" #include "ov-builtin.h" @@ -1132,8 +1133,9 @@ maybe_mutate (); } -octave_value::octave_value (const Octave_map& m, const std::string& id) - : rep (new octave_class (m, id)) +octave_value::octave_value (const Octave_map& m, const std::string& id, + const std::list<std::string>& plist) + : rep (new octave_class (m, id, plist)) { } @@ -2688,27 +2690,9 @@ octave_null_str::register_type (); octave_null_sq_str::register_type (); octave_lazy_index::register_type (); + octave_oncleanup::register_type (); } -#if 0 -DEFUN (cast, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cast (@var{val}, @var{type})\n\ -Convert @var{val} to the new data type @var{type}.\n\ -@seealso{class, typeinfo}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - error ("cast: not implemented"); - else - print_usage (); - - return retval; -} -#endif - DEFUN (sizeof, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} sizeof (@var{val})\n\ @@ -2726,6 +2710,89 @@ return retval; } +/* +%!assert (sizeof (uint64 (ones (3))), 72) +%!assert (sizeof (double (zeros (2,4))), 64) +%!assert (sizeof ({"foo", "bar", "baaz"}), 10) +*/ + +static void +decode_subscripts (const char* name, const octave_value& arg, + std::string& type_string, + std::list<octave_value_list>& idx) +{ + const octave_map m = arg.map_value (); + + if (! error_state + && m.nfields () == 2 && m.contains ("type") && m.contains ("subs")) + { + octave_idx_type nel = m.numel (); + + type_string = std::string (nel, '\0'); + idx = std::list<octave_value_list> (); + + if (nel == 0) + return; + + const Cell type = m.contents ("type"); + const Cell subs = m.contents ("subs"); + + for (int k = 0; k < nel; k++) + { + std::string item = type(k).string_value (); + + if (! error_state) + { + if (item == "{}") + type_string[k] = '{'; + else if (item == "()") + type_string[k] = '('; + else if (item == ".") + type_string[k] = '.'; + else + { + error("%s: invalid indexing type `%s'", name, item.c_str ()); + return; + } + } + else + { + error ("%s: expecting type(%d) to be a character string", + name, k+1); + return; + } + + octave_value_list idx_item; + + if (subs(k).is_string ()) + idx_item(0) = subs(k); + else if (subs(k).is_cell ()) + { + Cell subs_cell = subs(k).cell_value (); + + for (int n = 0; n < subs_cell.length (); n++) + { + if (subs_cell(n).is_string () + && subs_cell(n).string_value () == ":") + idx_item(n) = octave_value(octave_value::magic_colon_t); + else + idx_item(n) = subs_cell(n); + } + } + else + { + error ("%s: expecting subs(%d) to be a character string or cell array", + name, k+1); + return; + } + + idx.push_back (idx_item); + } + } + else + error ("%s: second argument must be a structure with fields `type' and `subs'", name); +} + DEFUN (subsref, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} subsref (@var{val}, @var{idx})\n\ @@ -2750,14 +2817,17 @@ idx.type = \"()\";\n\ idx.subs = @{\":\", 1:2@};\n\ subsref(val, idx)\n\ - @result{} [ 8 1 \n\ - 3 5 \n\ + @result{} [ 8 1\n\ + 3 5\n\ 4 9 ]\n\ @end group\n\ @end example\n\ \n\ @noindent\n\ Note that this is the same as writing @code{val(:,1:2)}.\n\ +\n\ +If @var{idx} is an empty structure array with fields @samp{type}\n\ +and @samp{subs}, return @var{val}.\n\ @seealso{subsasgn, substruct}\n\ @end deftypefn") { @@ -2772,8 +2842,12 @@ if (! error_state) { - octave_value tmp = args(0); - retval = tmp.subsref (type, idx, nargout); + octave_value arg0 = args(0); + + if (type.empty ()) + retval = arg0; + else + retval = arg0.subsref (type, idx, nargout); } } else @@ -2810,6 +2884,9 @@ @end example\n\ \n\ Note that this is the same as writing @code{val(:,1:2) = 0}.\n\ +\n\ +If @var{idx} is an empty structure array with fields @samp{type}\n\ +and @samp{subs}, return @var{rhs}.\n\ @seealso{subsref, substruct}\n\ @end deftypefn") { @@ -2822,15 +2899,147 @@ decode_subscripts ("subsasgn", args(1), type, idx); - octave_value arg0 = args(0); - - arg0.make_unique (); - if (! error_state) - retval = arg0.subsasgn (type, idx, args(2)); + { + if (type.empty ()) + { + // Regularize a null matrix if stored into a variable. + + retval = args(2).storable_value (); + } + else + { + octave_value arg0 = args(0); + + arg0.make_unique (); + + if (! error_state) + retval= arg0.subsasgn (type, idx, args(2)); + } + } } else print_usage (); return retval; } + +/* +%!test +%! a = reshape ([1:25], 5,5); +%! idx1 = substruct ("()", {3, 3}); +%! idx2 = substruct ("()", {2:2:5, 2:2:5}); +%! idx3 = substruct ("()", {":", [1,5]}); +%! idx4 = struct ("type", {}, "subs", {}); +%! assert (subsref (a, idx1), 13); +%! assert (subsref (a, idx2), [7 17; 9 19]); +%! assert (subsref (a, idx3), [1:5; 21:25]'); +%! assert (subsref (a, idx4), a); +%! a = subsasgn (a, idx1, 0); +%! a = subsasgn (a, idx2, 0); +%! a = subsasgn (a, idx3, 0); +%!# a = subsasgn (a, idx4, 0); +%! b = [0 6 11 16 0 +%! 0 0 12 0 0 +%! 0 8 0 18 0 +%! 0 0 14 0 0 +%! 0 10 15 20 0]; +%! assert (a,b); + +%!test +%! c = num2cell (reshape ([1:25],5,5)); +%! idx1 = substruct ("{}", {3, 3}); +%! idx2 = substruct ("()", {2:2:5, 2:2:5}); +%! idx3 = substruct ("()", {":", [1,5]}); +%! idx2p = substruct ("{}", {2:2:5, 2:2:5}); +%! idx3p = substruct ("{}", {":", [1,5]}); +%! idx4 = struct ("type", {}, "subs", {}); +%! assert ({ subsref(c, idx1) }, {13}); +%! assert ({ subsref(c, idx2p) }, {7 9 17 19}); +%! assert ({ subsref(c, idx3p) }, num2cell ([1:5, 21:25])); +%! assert (subsref(c, idx4), c); +%! c = subsasgn (c, idx1, 0); +%! c = subsasgn (c, idx2, 0); +%! c = subsasgn (c, idx3, 0); +%!# c = subsasgn (c, idx4, 0); +%! d = {0 6 11 16 0 +%! 0 0 12 0 0 +%! 0 8 0 18 0 +%! 0 0 14 0 0 +%! 0 10 15 20 0}; +%! assert (c, d); + +%!test +%! s.a = "ohai"; +%! s.b = "dere"; +%! s.c = 42; +%! idx1 = substruct (".", "a"); +%! idx2 = substruct (".", "b"); +%! idx3 = substruct (".", "c"); +%! idx4 = struct ("type", {}, "subs", {}); +%! assert (subsref (s, idx1), "ohai"); +%! assert (subsref (s, idx2), "dere"); +%! assert (subsref (s, idx3), 42); +%! assert (subsref (s, idx4), s); +%! s = subsasgn (s, idx1, "Hello"); +%! s = subsasgn (s, idx2, "There"); +%! s = subsasgn (s, idx3, 163); +%!# s = subsasgn (s, idx4, 163); +%! t.a = "Hello"; +%! t.b = "There"; +%! t.c = 163; +%! assert (s, t); + +*/ + +DEFUN (is_sq_string, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} is_sq_string (@var{x})\n\ +Return true if @var{x} is a single-quoted character string.\n\ +@seealso{is_dq_string, ischar}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_sq_string (); + else + print_usage (); + + return retval; +} + +/* +%!assert (is_sq_string ('foo'), true); +%!assert (is_sq_string ("foo"), false); +%!assert (is_sq_string (1.0), false); +%!assert (is_sq_string ({2.0}), false); +%!error is_sq_string () +%!error is_sq_string ('foo', 2) +*/ + +DEFUN (is_dq_string, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} is_dq_string (@var{x})\n\ +Return true if @var{x} is a double-quoted character string.\n\ +@seealso{is_sq_string, ischar}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_dq_string (); + else + print_usage (); + + return retval; +} + +/* +%!assert (is_dq_string ("foo"), true); +%!assert (is_dq_string ('foo'), false); +%!assert (is_dq_string (1.0), false); +%!assert (is_dq_string ({2.0}), false); +%!error is_dq_string () +%!error is_dq_string ("foo", 2) +*/
--- a/src/ov.h +++ b/src/ov.h @@ -279,7 +279,8 @@ octave_value (const octave_map& m); octave_value (const octave_scalar_map& m); octave_value (const Octave_map& m); - octave_value (const Octave_map& m, const std::string& id); + octave_value (const Octave_map& m, const std::string& id, + const std::list<std::string>& plist); octave_value (const octave_value_list& m, bool = false); octave_value (octave_value::magic_colon); @@ -314,8 +315,12 @@ { if (rep->count > 1) { - --rep->count; - rep = rep->unique_clone (); + octave_base_value *r = rep->unique_clone (); + + if (--rep->count == 0) + delete rep; + + rep = r; } } @@ -326,8 +331,12 @@ { if (rep->count > obsolete_copies + 1) { - --rep->count; - rep = rep->unique_clone (); + octave_base_value *r = rep->unique_clone (); + + if (--rep->count == 0) + delete rep; + + rep = r; } } @@ -654,6 +663,9 @@ bool is_function_handle (void) const { return rep->is_function_handle (); } + bool is_anonymous_function (void) const + { return rep->is_anonymous_function (); } + bool is_inline_function (void) const { return rep->is_inline_function (); } @@ -987,9 +999,8 @@ bool print_name_tag (std::ostream& os, const std::string& name) const { return rep->print_name_tag (os, name); } - void print_with_name (std::ostream& os, const std::string& name, - bool print_padding = true) const - { rep->print_with_name (os, name, print_padding); } + void print_with_name (std::ostream& os, const std::string& name) const + { rep->print_with_name (os, name, true); } int type_id (void) const { return rep->type_id (); } @@ -1367,4 +1378,13 @@ DEF_VALUE_EXTRACTOR (SparseBoolMatrix, sparse_bool_matrix) #undef DEF_VALUE_EXTRACTOR +#define DEF_DUMMY_VALUE_EXTRACTOR(VALUE,DEFVAL) \ +template<> \ +inline VALUE octave_value_extract<VALUE> (const octave_value&) \ + { assert (false); return DEFVAL; } + +DEF_DUMMY_VALUE_EXTRACTOR (char, 0) +DEF_DUMMY_VALUE_EXTRACTOR (octave_value, octave_value ()) +#undef DEF_DUMMY_VALUE_EXTRACTOR + #endif
--- a/src/pager.cc +++ b/src/pager.cc @@ -30,16 +30,16 @@ #include "cmd-edit.h" #include "oct-env.h" +#include "singleton-cleanup.h" -#include "procstream.h" - -#include <defaults.h> +#include "defaults.h" #include "defun.h" #include "error.h" #include "gripes.h" #include "input.h" #include "oct-obj.h" #include "pager.h" +#include "procstream.h" #include "sighandlers.h" #include "unwind-prot.h" #include "utils.h" @@ -311,29 +311,84 @@ delete pb; } -octave_pager_stream& +std::ostream& octave_pager_stream::stream (void) { - if (! instance) - instance = new octave_pager_stream (); - - return *instance; + return instance_ok () ? *instance : std::cout; } void octave_pager_stream::flush_current_contents_to_diary (void) { + if (instance_ok ()) + instance->do_flush_current_contents_to_diary (); +} + +void +octave_pager_stream::set_diary_skip (void) +{ + if (instance_ok ()) + instance->do_set_diary_skip (); +} + +// Reinitialize the pager buffer to avoid hanging on to large internal +// buffers when they might not be needed. This function should only be +// called when the pager is not in use. For example, just before +// getting command-line input. + +void +octave_pager_stream::reset (void) +{ + if (instance_ok ()) + instance->do_reset (); +} + +void +octave_pager_stream::do_flush_current_contents_to_diary (void) +{ if (pb) pb->flush_current_contents_to_diary (); } void -octave_pager_stream::set_diary_skip (void) +octave_pager_stream::do_set_diary_skip (void) { if (pb) pb->set_diary_skip (); } +void +octave_pager_stream::do_reset (void) +{ + delete pb; + pb = new octave_pager_buf (); + rdbuf (pb); + setf (unitbuf); +} + +bool +octave_pager_stream::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_pager_stream (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create pager_stream object!"); + + retval = false; + } + + return retval; +} + octave_diary_stream *octave_diary_stream::instance = 0; octave_diary_stream::octave_diary_stream (void) : std::ostream (0), db (0) @@ -349,13 +404,54 @@ delete db; } -octave_diary_stream& +std::ostream& octave_diary_stream::stream (void) { + return instance_ok () ? *instance : std::cout; +} + +// Reinitialize the diary buffer to avoid hanging on to large internal +// buffers when they might not be needed. This function should only be +// called when the pager is not in use. For example, just before +// getting command-line input. + +void +octave_diary_stream::reset (void) +{ + if (instance_ok ()) + instance->do_reset (); +} + +void +octave_diary_stream::do_reset (void) +{ + delete db; + db = new octave_diary_buf (); + rdbuf (db); + setf (unitbuf); +} + +bool +octave_diary_stream::instance_ok (void) +{ + bool retval = true; + if (! instance) - instance = new octave_diary_stream (); + { + instance = new octave_diary_stream (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } - return *instance; + if (! instance) + { + ::error ("unable to create diary_stream object!"); + + retval = false; + } + + return retval; } void @@ -391,7 +487,7 @@ // // will do the right thing. - octave_stdout.flush_current_contents_to_diary (); + octave_pager_stream::flush_current_contents_to_diary (); if (external_diary_file.is_open ()) { @@ -408,7 +504,7 @@ // If there is pending output in the pager buf, it should not go // into the diary file. - octave_stdout.set_diary_skip (); + octave_pager_stream::set_diary_skip (); external_diary_file.open (diary_file.c_str (), std::ios::app); @@ -544,11 +640,16 @@ DEFUN (page_output_immediately, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} page_output_immediately ()\n\ -@deftypefnx {Built-in Function} {@var{val} =} page_output_immediately (@var{new_val})\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} page_output_immediately (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} page_output_immediately (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether Octave sends\n\ output to the pager as soon as it is available. Otherwise, Octave\n\ buffers its output and waits until just before the prompt is printed to\n\ flush it to the pager.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (page_output_immediately); @@ -558,11 +659,16 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} page_screen_output ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} page_screen_output (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} page_screen_output (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether output intended\n\ for the terminal window that is longer than one page is sent through a\n\ pager. This allows you to view one screenful at a time. Some pagers\n\ (such as @code{less}---see @ref{Installation}) are also capable of moving\n\ backward on the output.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (page_screen_output); @@ -572,11 +678,16 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} PAGER ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} PAGER (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PAGER (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the program to use\n\ to display terminal output on your system. The default value is\n\ normally @code{\"less\"}, @code{\"more\"}, or\n\ @code{\"pg\"}, depending on what programs are installed on your system.\n\ @xref{Installation}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{more, page_screen_output, page_output_immediately, PAGER_FLAGS}\n\ @end deftypefn") { @@ -587,8 +698,13 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} PAGER_FLAGS ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} PAGER_FLAGS (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PAGER_FLAGS (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the options to pass\n\ to the pager.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{PAGER}\n\ @end deftypefn") {
--- a/src/pager.h +++ b/src/pager.h @@ -62,16 +62,28 @@ ~octave_pager_stream (void); - void flush_current_contents_to_diary (void); + static void flush_current_contents_to_diary (void); + + static void set_diary_skip (void); - void set_diary_skip (void); + static std::ostream& stream (void); - static octave_pager_stream& stream (void); + static void reset (void); private: + void do_flush_current_contents_to_diary (void); + + void do_set_diary_skip (void); + + void do_reset (void); + static octave_pager_stream *instance; + static bool instance_ok (void); + + static void cleanup_instance (void) { delete instance; instance = 0; } + octave_pager_buf *pb; // No copying! @@ -106,12 +118,20 @@ ~octave_diary_stream (void); - static octave_diary_stream& stream (void); + static std::ostream& stream (void); + + static void reset (void); private: + void do_reset (void); + static octave_diary_stream *instance; + static bool instance_ok (void); + + static void cleanup_instance (void) { delete instance; instance = 0; } + octave_diary_buf *db; // No copying!
--- a/src/parse.h +++ b/src/parse.h @@ -36,6 +36,7 @@ class tree; class tree_matrix; class tree_identifier; +class tree_statement_list; class octave_function; #include "oct-obj.h" @@ -113,4 +114,6 @@ extern OCTINTERP_API octave_value eval_string (const std::string&, bool silent, int& parse_status); +extern OCTINTERP_API void cleanup_statement_list (tree_statement_list **lst); + #endif
--- a/src/pr-output.cc +++ b/src/pr-output.cc @@ -103,7 +103,7 @@ static int bit_format = 0; // TRUE means don't put newlines around the column number headers. -static bool compact_format = false; +bool Vcompact_format = false; // TRUE means use an e format. static bool print_e = false; @@ -1658,7 +1658,7 @@ << std::resetiosflags (std::ios::scientific|std::ios::left) << " *\n"; - if (! compact_format) + if (! Vcompact_format) os << "\n"; } } @@ -1671,7 +1671,7 @@ { if (col != 0) { - if (compact_format) + if (Vcompact_format) os << "\n"; else os << "\n\n"; @@ -1688,7 +1688,7 @@ else os << " Columns " << col + 1 << " through " << lim << ":\n"; - if (! compact_format) + if (! Vcompact_format) os << "\n"; } } @@ -1956,7 +1956,10 @@ } else { - os << "Diagonal Matrix\n\n"; + os << "Diagonal Matrix\n"; + if (! Vcompact_format) + os << "\n"; + pr_scale_header (os, scale); // kluge. Get the true width of a number. @@ -1999,80 +2002,82 @@ } } } -#define PRINT_ND_ARRAY(os, nda, NDA_T, ELT_T, MAT_T) \ - do \ - { \ - if (nda.is_empty ()) \ - print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); \ - else \ - { \ - \ - int ndims = nda.ndims (); \ - \ - dim_vector dims = nda.dims (); \ - \ - Array<octave_idx_type> ra_idx (dim_vector (ndims, 1), 0);\ - \ - octave_idx_type m = 1; \ - \ - for (int i = 2; i < ndims; i++) \ - m *= dims(i); \ - \ - octave_idx_type nr = dims(0); \ - octave_idx_type nc = dims(1); \ - \ - for (octave_idx_type i = 0; i < m; i++) \ - { \ - octave_quit (); \ - \ - std::string nm = "ans"; \ - \ - if (m > 1) \ - { \ - nm += "(:,:,"; \ - \ - std::ostringstream buf; \ - \ - for (int k = 2; k < ndims; k++) \ - { \ - buf << ra_idx(k) + 1; \ - \ - if (k < ndims - 1) \ - buf << ","; \ - else \ - buf << ")"; \ - } \ - \ - nm += buf.str (); \ - } \ - \ - Array<idx_vector> idx (dim_vector (ndims, 1)); \ - \ - idx(0) = idx_vector (':'); \ - idx(1) = idx_vector (':'); \ - \ - for (int k = 2; k < ndims; k++) \ - idx(k) = idx_vector (ra_idx(k)); \ - \ - octave_value page \ - = MAT_T (Array<ELT_T> (nda.index (idx), dim_vector (nr, nc))); \ - \ - if (i != m - 1) \ - { \ - page.print_with_name (os, nm); \ - } \ - else \ - { \ - page.print_name_tag (os, nm); \ - page.print_raw (os); \ - } \ - \ - if (i < m) \ - NDA_T::increment_index (ra_idx, dims, 2); \ - } \ - } \ - } \ - while (0) + +template <typename NDA_T, typename ELT_T, typename MAT_T> +void print_nd_array(std::ostream& os, const NDA_T& nda, + bool pr_as_read_syntax) +{ + + if (nda.is_empty ()) + print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); + else + { + + int ndims = nda.ndims (); + + dim_vector dims = nda.dims (); + + Array<octave_idx_type> ra_idx (dim_vector (ndims, 1), 0); + + octave_idx_type m = 1; + + for (int i = 2; i < ndims; i++) + m *= dims(i); + + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + + for (octave_idx_type i = 0; i < m; i++) + { + octave_quit (); + + std::string nm = "ans"; + + if (m > 1) + { + nm += "(:,:,"; + + std::ostringstream buf; + + for (int k = 2; k < ndims; k++) + { + buf << ra_idx(k) + 1; + + if (k < ndims - 1) + buf << ","; + else + buf << ")"; + } + + nm += buf.str (); + } + + Array<idx_vector> idx (dim_vector (ndims, 1)); + + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + + for (int k = 2; k < ndims; k++) + idx(k) = idx_vector (ra_idx(k)); + + octave_value page + = MAT_T (Array<ELT_T> (nda.index (idx), dim_vector (nr, nc))); + + if (i != m - 1) + { + page.print_with_name (os, nm); + } + else + { + page.print_name_tag (os, nm); + page.print_raw (os); + } + + if (i < m) + NDA_T::increment_index (ra_idx, dims, 2); + } + } +} void octave_print_internal (std::ostream& os, const NDArray& nda, @@ -2087,7 +2092,7 @@ break; default: - PRINT_ND_ARRAY (os, nda, NDArray, double, Matrix); + print_nd_array <NDArray, double, Matrix> (os, nda, pr_as_read_syntax); break; } } @@ -2367,7 +2372,10 @@ } else { - os << "Diagonal Matrix\n\n"; + os << "Diagonal Matrix\n"; + if (! Vcompact_format) + os << "\n"; + pr_scale_header (os, scale); // kluge. Get the true width of a number. @@ -2512,7 +2520,9 @@ } else { - os << "Permutation Matrix\n\n"; + os << "Permutation Matrix\n"; + if (! Vcompact_format) + os << "\n"; for (octave_idx_type col = 0; col < nc; col += inc) { @@ -2555,7 +2565,8 @@ break; default: - PRINT_ND_ARRAY (os, nda, ComplexNDArray, Complex, ComplexMatrix); + print_nd_array <ComplexNDArray, Complex, + ComplexMatrix> (os, nda, pr_as_read_syntax); break; } } @@ -2756,7 +2767,8 @@ break; default: - PRINT_ND_ARRAY (os, nda, boolNDArray, bool, boolMatrix); + print_nd_array<boolNDArray, bool, + boolMatrix> (os, nda, pr_as_read_syntax); break; } } @@ -2822,7 +2834,8 @@ break; default: - PRINT_ND_ARRAY (os, nda, charNDArray, char, charMatrix); + print_nd_array <charNDArray, char, + charMatrix> (os, nda, pr_as_read_syntax); break; } } @@ -2840,8 +2853,8 @@ octave_print_internal (std::ostream& os, const Array<std::string>& nda, bool pr_as_read_syntax, int /* extra_indent */) { - // FIXME -- this mostly duplicates the code in the - // PRINT_ND_ARRAY macro. + // FIXME -- this mostly duplicates the code in the print_nd_array<> + // function. Can fix this with std::is_same from C++11. if (nda.is_empty ()) print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); @@ -2904,7 +2917,9 @@ octave_idx_type n_rows = page.rows (); octave_idx_type n_cols = page.cols (); - os << nm << " =\n\n"; + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; for (octave_idx_type ii = 0; ii < n_rows; ii++) { @@ -3109,8 +3124,8 @@ octave_print_internal_template (std::ostream& os, const intNDArray<T>& nda, bool pr_as_read_syntax, int extra_indent) { - // FIXME -- this mostly duplicates the code in the - // PRINT_ND_ARRAY macro. + // FIXME -- this mostly duplicates the code in the print_nd_array<> + // function. Can fix this with std::is_same from C++11. if (nda.is_empty ()) print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); @@ -3152,7 +3167,9 @@ nm += buf.str (); - os << nm << " =\n\n"; + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; } Array<idx_vector> idx (dim_vector (ndims, 1)); @@ -3257,7 +3274,9 @@ nm += buf.str (); - os << nm << " =\n\n"; + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; } Array<idx_vector> idx (dim_vector (ndims, 1)); @@ -3528,6 +3547,21 @@ %! endfor %! endfor %! fclose (fd); + +%!test +%! foo.real = pi * ones (3,20,3); +%! foo.complex = pi * ones (3,20,3) + 1i; +%! foo.char = repmat ("- Hello World -", [3, 20]); +%! foo.cell = {foo.real, foo.complex, foo.char}; +%! fields = fieldnames (foo); +%! for f = 1:numel(fields) +%! format loose +%! loose = disp (foo.(fields{f})); +%! format compact +%! compact = disp (foo.(fields{f})); +%! expected = strrep (loose, "\n\n", "\n"); +%! assert (expected, compact) +%! endfor */ static void @@ -3539,7 +3573,7 @@ bank_format = false; hex_format = 0; bit_format = 0; - compact_format = false; + Vcompact_format = false; print_e = false; print_big_e = false; print_g = false; @@ -3714,11 +3748,11 @@ } else if (arg == "compact") { - compact_format = true; + Vcompact_format = true; } else if (arg == "loose") { - compact_format = false; + Vcompact_format = false; } else error ("format: unrecognized format state `%s'", arg.c_str ()); @@ -3890,12 +3924,12 @@ \n\ @table @code\n\ @item compact\n\ -Remove extra blank space around column number labels producing more compact\n\ -output with more data per page.\n\ +Remove blank lines around column number labels and between\n\ +matrices producing more compact output with more data per page.\n\ \n\ @item loose\n\ -Insert blank lines above and below column number labels to produce a more\n\ -readable output with less data per page. (default).\n\ +Insert blank lines above and below column number labels and between matrices\n\ +to produce a more readable output with less data per page. (default).\n\ @end table\n\ @seealso{fixed_point_format, output_max_field_width, output_precision, split_long_rows, rats}\n\ @end deftypefn") @@ -3918,6 +3952,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} fixed_point_format ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} fixed_point_format (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} fixed_point_format (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether Octave will\n\ use a scaled format to print matrix values such that the largest\n\ element may be written with a single leading digit with the scaling\n\ @@ -3942,6 +3977,10 @@ Notice that first value appears to be zero when it is actually 1. For\n\ this reason, you should be careful when setting\n\ @code{fixed_point_format} to a nonzero value.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{format, output_max_field_width, output_precision}\n\ @end deftypefn") { @@ -3952,6 +3991,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} print_empty_dimensions ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} print_empty_dimensions (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} print_empty_dimensions (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether the\n\ dimensions of empty matrices are printed along with the empty matrix\n\ symbol, @samp{[]}. For example, the expression\n\ @@ -3966,6 +4006,10 @@ @example\n\ ans = [](3x0)\n\ @end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{format}\n\ @end deftypefn") { @@ -3976,6 +4020,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} split_long_rows ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} split_long_rows (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} split_long_rows (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether rows of a matrix\n\ may be split when displayed to a terminal window. If the rows are split,\n\ Octave will display the matrix in a series of smaller pieces, each of\n\ @@ -3999,6 +4044,10 @@ 0.44672 0.94303 0.56564 0.82150\n\ @end group\n\ @end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{format}\n\ @end deftypefn") { @@ -4009,8 +4058,13 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} output_max_field_width ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} output_max_field_width (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} output_max_field_width (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the maximum width\n\ of a numeric output field.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{format, fixed_point_format, output_precision}\n\ @end deftypefn") { @@ -4021,8 +4075,13 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} output_precision ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} output_precision (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} output_precision (@var{new_val}, \"local\")\n\ Query or set the internal variable that specifies the minimum number of\n\ significant figures to display for numeric output.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{format, fixed_point_format, output_max_field_width}\n\ @end deftypefn") {
--- a/src/pr-output.h +++ b/src/pr-output.h @@ -256,4 +256,7 @@ // like this: x = [](2x0). extern bool Vprint_empty_dimensions; +// TRUE means don't put empty lines in output +extern bool Vcompact_format; + #endif
new file mode 100644 --- /dev/null +++ b/src/profiler.cc @@ -0,0 +1,470 @@ +/* + +Copyright (C) 2011 Daniel Kraft + +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/>. + +*/ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <iostream> + +#include "defun.h" +#include "oct-time.h" +#include "ov-struct.h" +#include "pager.h" +#include "profiler.h" + +profile_data_accumulator::enter::enter (profile_data_accumulator& a, + const std::string& f) + : acc (a) +{ + if (acc.is_active ()) + { + fcn = f; + acc.enter_function (fcn); + } + else + fcn = ""; +} + +profile_data_accumulator::enter::~enter () +{ + if (fcn != "") + acc.exit_function (fcn); +} + +profile_data_accumulator::stats::stats () + : time (0.0), calls (0), recursive (false), + parents (), children () +{} + +octave_value +profile_data_accumulator::stats::function_set_value (const function_set& list) +{ + const octave_idx_type n = list.size (); + + RowVector retval (n); + octave_idx_type i = 0; + for (function_set::const_iterator p = list.begin (); p != list.end (); ++p) + { + retval(i) = *p; + ++i; + } + assert (i == n); + + return retval; +} + +profile_data_accumulator::tree_node::tree_node (tree_node* p, octave_idx_type f) + : parent (p), fcn_id (f), children (), time (0.0), calls (0) +{} + +profile_data_accumulator::tree_node::~tree_node () +{ + for (child_map::iterator i = children.begin (); i != children.end (); ++i) + delete i->second; +} + +profile_data_accumulator::tree_node* +profile_data_accumulator::tree_node::enter (octave_idx_type fcn) +{ + tree_node* retval; + + child_map::iterator pos = children.find (fcn); + if (pos == children.end ()) + { + retval = new tree_node (this, fcn); + children[fcn] = retval; + } + else + retval = pos->second; + + ++retval->calls; + return retval; +} + +profile_data_accumulator::tree_node* +profile_data_accumulator::tree_node::exit (octave_idx_type fcn) +{ + assert (parent); + assert (fcn_id == fcn); + + return parent; +} + +void +profile_data_accumulator::tree_node::build_flat (flat_profile& data) const +{ + // If this is not the top-level node, update profile entry for this function. + if (fcn_id != 0) + { + stats& entry = data[fcn_id - 1]; + + entry.time += time; + entry.calls += calls; + + assert (parent); + if (parent->fcn_id != 0) + { + entry.parents.insert (parent->fcn_id); + data[parent->fcn_id - 1].children.insert (fcn_id); + } + + if (!entry.recursive) + for (const tree_node* i = parent; i; i = i->parent) + if (i->fcn_id == fcn_id) + { + entry.recursive = true; + break; + } + } + + // Recurse on children. + for (child_map::const_iterator i = children.begin (); + i != children.end (); ++i) + i->second->build_flat (data); +} + +octave_value +profile_data_accumulator::tree_node::get_hierarchical (double* total) const +{ + /* Note that we don't generate the entry just for this node, but rather + a struct-array with entries for all children. This way, the top-node + (for which we don't want a real entry) generates already the final + hierarchical profile data. */ + + const octave_idx_type n = children.size (); + + Cell rv_indices (n, 1); + Cell rv_times (n, 1); + Cell rv_totals (n, 1); + Cell rv_calls (n, 1); + Cell rv_children (n, 1); + + octave_idx_type i = 0; + for (child_map::const_iterator p = children.begin (); + p != children.end (); ++p) + { + const tree_node& entry = *p->second; + double child_total = entry.time; + + rv_indices(i) = octave_value (p->first); + rv_times(i) = octave_value (entry.time); + rv_calls(i) = octave_value (entry.calls); + rv_children(i) = entry.get_hierarchical (&child_total); + rv_totals(i) = octave_value (child_total); + + if (total) + *total += child_total; + + ++i; + } + assert (i == n); + + octave_map retval; + + retval.assign ("Index", rv_indices); + retval.assign ("SelfTime", rv_times); + retval.assign ("TotalTime", rv_totals); + retval.assign ("NumCalls", rv_calls); + retval.assign ("Children", rv_children); + + return retval; +} + +profile_data_accumulator::profile_data_accumulator () + : known_functions (), fcn_index (), + enabled (false), call_tree (NULL), last_time (-1.0) +{} + +profile_data_accumulator::~profile_data_accumulator () +{ + if (call_tree) + delete call_tree; +} + +void +profile_data_accumulator::set_active (bool value) +{ + if (value) + { + // Create a call-tree top-node if there isn't yet one. + if (!call_tree) + call_tree = new tree_node (NULL, 0); + + // Let the top-node be the active one. This ensures we have a clean + // fresh start collecting times. + active_fcn = call_tree; + } + else + { + // Make sure we start with fresh timing if we're re-enabled later. + last_time = -1.0; + } + + enabled = value; +} + +void +profile_data_accumulator::enter_function (const std::string& fcn) +{ + // The enter class will check and only call us if the profiler is active. + assert (is_active ()); + assert (call_tree); + + // If there is already an active function, add to its time before + // pushing the new one. + if (active_fcn != call_tree) + add_current_time (); + + // Map the function's name to its index. + octave_idx_type fcn_idx; + fcn_index_map::iterator pos = fcn_index.find (fcn); + if (pos == fcn_index.end ()) + { + known_functions.push_back (fcn); + fcn_idx = known_functions.size (); + fcn_index[fcn] = fcn_idx; + } + else + fcn_idx = pos->second; + + active_fcn = active_fcn->enter (fcn_idx); + last_time = query_time (); +} + +void +profile_data_accumulator::exit_function (const std::string& fcn) +{ + assert (call_tree); + assert (active_fcn != call_tree); + + // Usually, if we are disabled this function is not even called. But the + // call disabling the profiler is an exception. So also check here + // and only record the time if enabled. + if (is_active ()) + add_current_time (); + + fcn_index_map::iterator pos = fcn_index.find (fcn); + assert (pos != fcn_index.end ()); + active_fcn = active_fcn->exit (pos->second); + + // If this was an "inner call", we resume executing the parent function + // up the stack. So note the start-time for this! + last_time = query_time (); +} + +void +profile_data_accumulator::reset (void) +{ + if (is_active ()) + { + error ("Can't reset active profiler."); + return; + } + + known_functions.clear (); + fcn_index.clear (); + + if (call_tree) + { + delete call_tree; + call_tree = NULL; + } + + last_time = -1.0; +} + +octave_value +profile_data_accumulator::get_flat (void) const +{ + octave_value retval; + + const octave_idx_type n = known_functions.size (); + + flat_profile flat (n); + + if (call_tree) + { + call_tree->build_flat (flat); + + Cell rv_names (n, 1); + Cell rv_times (n, 1); + Cell rv_calls (n, 1); + Cell rv_recursive (n, 1); + Cell rv_parents (n, 1); + Cell rv_children (n, 1); + + for (octave_idx_type i = 0; i != n; ++i) + { + rv_names(i) = octave_value (known_functions[i]); + rv_times(i) = octave_value (flat[i].time); + rv_calls(i) = octave_value (flat[i].calls); + rv_recursive(i) = octave_value (flat[i].recursive); + rv_parents(i) = stats::function_set_value (flat[i].parents); + rv_children(i) = stats::function_set_value (flat[i].children); + } + + octave_map m; + + m.assign ("FunctionName", rv_names); + m.assign ("TotalTime", rv_times); + m.assign ("NumCalls", rv_calls); + m.assign ("IsRecursive", rv_recursive); + m.assign ("Parents", rv_parents); + m.assign ("Children", rv_children); + + retval = m; + } + else + { + static const char *fn[] = + { + "FunctionName", + "TotalTime", + "NumCalls", + "IsRecursive", + "Parents", + "Children", + 0 + }; + + static octave_map m (dim_vector (0, 1), string_vector (fn)); + + retval = m; + } + + return retval; +} + +octave_value +profile_data_accumulator::get_hierarchical (void) const +{ + octave_value retval; + + if (call_tree) + retval = call_tree->get_hierarchical (); + else + { + static const char *fn[] = + { + "Index", + "SelfTime", + "NumCalls", + "Children", + 0 + }; + + static octave_map m (dim_vector (0, 1), string_vector (fn)); + + retval = m; + } + + return retval; +} + +double +profile_data_accumulator::query_time (void) const +{ + octave_time now; + // FIXME -- this should be removed at some point... See bug 34210. +#if defined (__CYGWIN__) || defined (__MINGW32__) + volatile +#endif + double dnow = now.double_value (); + return dnow; +} + +void +profile_data_accumulator::add_current_time (void) +{ + const double t = query_time (); + assert (last_time >= 0.0 && last_time <= t); + + assert (call_tree && active_fcn != call_tree); + active_fcn->add_time (t - last_time); +} + +profile_data_accumulator profiler; + +// Enable or disable the profiler data collection. +DEFUN (__profiler_enable__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_enable ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + + const int nargin = args.length (); + if (nargin > 0) + { + if (nargin > 1) + { + print_usage (); + return retval; + } + + profiler.set_active (args(0).bool_value ()); + } + + retval(0) = profiler.is_active (); + + return retval; +} + +// Clear all collected profiling data. +DEFUN (__profiler_reset__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_reset ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + const int nargin = args.length (); + + if (nargin > 0) + warning ("profiler_reset: ignoring extra arguments"); + + profiler.reset (); + + return retval; +} + +// Query the timings collected by the profiler. +DEFUN (__profiler_data__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_data ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + const int nargin = args.length (); + + if (nargin > 0) + warning ("profiler_data: ignoring extra arguments"); + + retval(0) = profiler.get_flat (); + if (nargout > 1) + retval(1) = profiler.get_hierarchical (); + + return retval; +}
new file mode 100644 --- /dev/null +++ b/src/profiler.h @@ -0,0 +1,190 @@ +/* + +Copyright (C) 2011 Daniel Kraft + +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/>. + +*/ + +#if !defined (octave_profiler_h) +#define octave_profiler_h 1 + +#include <cstddef> +#include <map> +#include <set> +#include <string> +#include <vector> + +class octave_value; + +class +OCTINTERP_API +profile_data_accumulator +{ +public: + + // This is a utility class that can be used to call the enter/exit + // functions in a manner protected from stack unwinding. + class enter + { + private: + + profile_data_accumulator& acc; + std::string fcn; + + public: + + enter (profile_data_accumulator&, const std::string&); + virtual ~enter (void); + + private: + + // No copying! + enter (const enter&); + enter& operator = (const enter&); + }; + + profile_data_accumulator (void); + virtual ~profile_data_accumulator (); + + bool is_active (void) const { return enabled; } + void set_active (bool); + + void reset (void); + + octave_value get_flat (void) const; + octave_value get_hierarchical (void) const; + +private: + + // One entry in the flat profile (i.e., a collection of data for a single + // function). This is filled in when building the flat profile from the + // hierarchical call tree. + struct stats + { + stats (); + + double time; + unsigned calls; + + bool recursive; + + typedef std::set<octave_idx_type> function_set; + function_set parents; + function_set children; + + // Convert a function_set list to an Octave array of indices. + static octave_value function_set_value (const function_set&); + }; + + typedef std::vector<stats> flat_profile; + + // Store data for one node in the call-tree of the hierarchical profiler + // data we collect. + class tree_node + { + public: + + tree_node (tree_node*, octave_idx_type); + virtual ~tree_node (); + + void add_time (double dt) { time += dt; } + + // Enter a child function. It is created in the list of children if it + // wasn't already there. The now-active child node is returned. + tree_node* enter (octave_idx_type); + + // Exit function. As a sanity-check, it is verified that the currently + // active function actually is the one handed in here. Returned is the + // then-active node, which is our parent. + tree_node* exit (octave_idx_type); + + void build_flat (flat_profile&) const; + + // Get the hierarchical profile for this node and its children. If total + // is set, accumulate total time of the subtree in that variable as + // additional return value. + octave_value get_hierarchical (double* total = NULL) const; + + private: + + tree_node* parent; + octave_idx_type fcn_id; + + typedef std::map<octave_idx_type, tree_node*> child_map; + child_map children; + + // This is only time spent *directly* on this level, excluding children! + double time; + + unsigned calls; + + // No copying! + tree_node (const tree_node&); + tree_node& operator = (const tree_node&); + }; + + // Each function we see in the profiler is given a unique index (which + // simply counts starting from 1). We thus have to map profiler-names to + // those indices. For all other stuff, we identify functions by their index. + + typedef std::vector<std::string> function_set; + typedef std::map<std::string, octave_idx_type> fcn_index_map; + + function_set known_functions; + fcn_index_map fcn_index; + + bool enabled; + + tree_node* call_tree; + tree_node* active_fcn; + + // Store last timestamp we had, when the currently active function was called. + double last_time; + + // These are private as only the unwind-protecting inner class enter + // should be allowed to call them. + void enter_function (const std::string&); + void exit_function (const std::string&); + + // Query a timestamp, used for timing calls (obviously). + // This is not static because in the future, maybe we want a flag + // in the profiler or something to choose between cputime, wall-time, + // user-time, system-time, ... + double query_time () const; + + // Add the time elapsed since last_time to the function we're currently in. + // This is called from two different positions, thus it is useful to have + // it as a seperate function. + void add_current_time (void); + + // No copying! + profile_data_accumulator (const profile_data_accumulator&); + profile_data_accumulator& operator = (const profile_data_accumulator&); +}; + +// The instance used. +extern OCTINTERP_API profile_data_accumulator profiler; + +// Helper macro to profile a block of code. +#define BEGIN_PROFILER_BLOCK(name) \ + { \ + profile_data_accumulator::enter pe (profiler, (name)); +#define END_PROFILER_BLOCK \ + } + +#endif
--- a/src/pt-assign.cc +++ b/src/pt-assign.cc @@ -73,7 +73,7 @@ "debug_on_interrupt", "debug_on_warning", "debug_symtab_lookups", - "default_save_format", + "default_save_options", "echo_executing_commands", "fixed_point_format", "gnuplot_binary", @@ -157,7 +157,12 @@ const char *nm_c_str = nm.c_str (); warning_with_id ("Octave:built-in-variable-assignment", - "%s is now a function instead of a built-in variable. By assigning to %s, you have created a variable that hides the function %s. To remove the variable and restore the function, type \"clear %s\"", + "\ +In recent versions of Octave, %s is a function instead\n\ +of a built-in variable.\n\n\ +By assigning to %s, you have created a variable that hides\n\ +the function %s. To remove the variable and restore the \n\ +function, type \"clear %s\"\n", nm_c_str, nm_c_str, nm_c_str, nm_c_str); } }
--- a/src/pt-binop.cc +++ b/src/pt-binop.cc @@ -28,6 +28,7 @@ #include "defun.h" #include "oct-obj.h" #include "ov.h" +#include "profiler.h" #include "pt-binop.h" #include "pt-bp.h" #include "pt-walk.h" @@ -120,10 +121,20 @@ if (! error_state && b.is_defined ()) { + BEGIN_PROFILER_BLOCK ("binary " + oper ()) + + // Note: The profiler does not catch the braindead + // short-circuit evaluation code above, but that should be + // ok. The evaluation of operands and the operator itself + // is entangled and it's not clear where to start/stop + // timing the operator to make it reasonable. + retval = ::do_binary_op (etype, a, b); if (error_state) retval = octave_value (); + + END_PROFILER_BLOCK } } } @@ -183,6 +194,11 @@ bool result = false; + // This evaluation is not caught by the profiler, since we can't find + // a reasonable place where to time. Note that we don't want to + // include evaluation of LHS or RHS into the timing, but this is + // entangled together with short-circuit evaluation here. + if (op_lhs) { octave_value a = op_lhs->rvalue1 (); @@ -266,6 +282,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} do_braindead_shortcircuit_evaluation ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} do_braindead_shortcircuit_evaluation (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} do_braindead_shortcircuit_evaluation (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether Octave will\n\ do short-circuit evaluation of @samp{|} and @samp{&} operators inside the\n\ conditions of if or while statements.\n\ @@ -275,7 +292,27 @@ \n\ To obtain short-circuit behavior for logical expressions in new programs,\n\ you should always use the @samp{&&} and @samp{||} operators.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (do_braindead_shortcircuit_evaluation); } + +/* + +%!test +%! x = 0; +%! do_braindead_shortcircuit_evaluation (0); +%! if (1 | (x = 1)) +%! endif +%! assert (x, 1); +%! do_braindead_shortcircuit_evaluation (1); +%! if (1 | (x = 0)) +%! endif +%! assert (x, 1); + +*/ +
--- a/src/pt-cbinop.cc +++ b/src/pt-cbinop.cc @@ -84,7 +84,9 @@ static octave_value::compound_binary_op simplify_mul_op (tree_expression *&a, tree_expression *&b) { - octave_value::compound_binary_op retop; + octave_value::compound_binary_op retop + = octave_value::unknown_compound_binary_op; + octave_value::unary_op opa = strip_trans_herm (a); if (opa == octave_value::op_hermitian) @@ -99,8 +101,6 @@ retop = octave_value::op_mul_herm; else if (opb == octave_value::op_transpose) retop = octave_value::op_mul_trans; - else - retop = octave_value::unknown_compound_binary_op; } return retop; @@ -111,15 +111,15 @@ static octave_value::compound_binary_op simplify_ldiv_op (tree_expression *&a, tree_expression *&) { - octave_value::compound_binary_op retop; + octave_value::compound_binary_op retop + = octave_value::unknown_compound_binary_op; + octave_value::unary_op opa = strip_trans_herm (a); if (opa == octave_value::op_hermitian) retop = octave_value::op_herm_ldiv; else if (opa == octave_value::op_transpose) retop = octave_value::op_trans_ldiv; - else - retop = octave_value::unknown_compound_binary_op; return retop; } @@ -129,7 +129,9 @@ static octave_value::compound_binary_op simplify_and_or_op (tree_expression *&a, tree_expression *&b, octave_value::binary_op op) { - octave_value::compound_binary_op retop; + octave_value::compound_binary_op retop + = octave_value::unknown_compound_binary_op; + octave_value::unary_op opa = strip_not (a); if (opa == octave_value::op_not) @@ -150,8 +152,6 @@ else if (op == octave_value::op_el_or) retop = octave_value::op_el_or_not; } - else - retop = octave_value::unknown_compound_binary_op; } return retop;
--- a/src/pt-check.cc +++ b/src/pt-check.cc @@ -154,6 +154,11 @@ if (expr) expr->accept (*this); + tree_expression *maxproc = cmd.maxproc_expr (); + + if (maxproc) + maxproc->accept (*this); + tree_statement_list *list = cmd.body (); if (list)
--- a/src/pt-const.cc +++ b/src/pt-const.cc @@ -34,8 +34,7 @@ // We are likely to have a lot of tree_constant objects to allocate, // so make the grow_size large. -octave_allocator -tree_constant::allocator (sizeof (tree_constant), 1024); +DEFINE_OCTAVE_ALLOCATOR2 (tree_constant, 1024); void tree_constant::print (std::ostream& os, bool pr_as_read_syntax, bool pr_orig_text)
--- a/src/pt-const.h +++ b/src/pt-const.h @@ -55,10 +55,6 @@ bool has_magic_end (void) const { return false; } - void *operator new (size_t size) { return allocator.alloc (size); } - - void operator delete (void *p, size_t size) { allocator.free (p, size); } - // Type. It would be nice to eliminate the need for this. bool is_constant (void) const { return true; } @@ -91,9 +87,6 @@ private: - // For custom memory management. - static octave_allocator allocator; - // The actual value that this constant refers to. octave_value val; @@ -105,6 +98,8 @@ tree_constant (const tree_constant&); tree_constant& operator = (const tree_constant&); + + DECLARE_OCTAVE_ALLOCATOR }; #endif
--- a/src/pt-eval.cc +++ b/src/pt-eval.cc @@ -281,18 +281,6 @@ return quit; } -#define DO_SIMPLE_FOR_LOOP_ONCE(VAL) \ - do \ - { \ - ult.assign (octave_value::op_asn_eq, VAL); \ - \ - if (! error_state && loop_body) \ - loop_body->accept (*this); \ - \ - quit = quit_loop_now (); \ - } \ - while (0) - void tree_evaluator::visit_simple_for_command (tree_simple_for_command& cmd) { @@ -302,6 +290,9 @@ if (debug_mode) do_breakpoint (cmd.is_breakpoint ()); + // FIXME -- need to handle PARFOR loops here using cmd.in_parallel () + // and cmd.maxproc_expr (); + unwind_protect frame; frame.protect_var (in_loop_command); @@ -332,7 +323,6 @@ octave_idx_type steps = rng.nelem (); double b = rng.base (); double increment = rng.inc (); - bool quit = false; for (octave_idx_type i = 0; i < steps; i++) { @@ -347,17 +337,24 @@ octave_value val (b + i * increment); - DO_SIMPLE_FOR_LOOP_ONCE (val); + ult.assign (octave_value::op_asn_eq, val); - if (quit) + if (! error_state && loop_body) + loop_body->accept (*this); + + if (quit_loop_now ()) break; } } else if (rhs.is_scalar_type ()) { - bool quit = false; + ult.assign (octave_value::op_asn_eq, rhs); - DO_SIMPLE_FOR_LOOP_ONCE (rhs); + if (! error_state && loop_body) + loop_body->accept (*this); + + // Maybe decrement break and continue states. + quit_loop_now (); } else if (rhs.is_matrix_type () || rhs.is_cell () || rhs.is_string () || rhs.is_map ()) @@ -365,8 +362,6 @@ // A matrix or cell is reshaped to 2 dimensions and iterated by // columns. - bool quit = false; - dim_vector dv = rhs.dims ().redim (2); octave_idx_type nrows = dv(0), steps = dv(1); @@ -397,9 +392,13 @@ // do_index_op expects one-based indices. idx(iidx) = i; octave_value val = arg.do_index_op (idx); - DO_SIMPLE_FOR_LOOP_ONCE (val); + + ult.assign (octave_value::op_asn_eq, val); - if (quit) + if (! error_state && loop_body) + loop_body->accept (*this); + + if (quit_loop_now ()) break; } } @@ -1194,23 +1193,55 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} max_recursion_depth ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} max_recursion_depth (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} max_recursion_depth (@var{new_val}, \"local\")\n\ Query or set the internal limit on the number of times a function may\n\ be called recursively. If the limit is exceeded, an error message is\n\ printed and control returns to the top level.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (max_recursion_depth); } +/* +%!error (max_recursion_depth (1, 2)); +%!test +%! orig_val = max_recursion_depth (); +%! old_val = max_recursion_depth (2*orig_val); +%! assert (orig_val, old_val); +%! assert (max_recursion_depth (), 2*orig_val); +%! max_recursion_depth (orig_val); +%! assert (max_recursion_depth (), orig_val); +*/ + DEFUN (silent_functions, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} silent_functions ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} silent_functions (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} silent_functions (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether internal\n\ output from a function is suppressed. If this option is disabled,\n\ Octave will display the results produced by evaluating expressions\n\ within a function body that are not terminated with a semicolon.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (silent_functions); } + +/* +%!error (silent_functions (1, 2)); +%!test +%! orig_val = silent_functions (); +%! old_val = silent_functions (! orig_val); +%! assert (orig_val, old_val); +%! assert (silent_functions (), ! orig_val); +%! silent_functions (orig_val); +%! assert (silent_functions (), orig_val); +*/
--- a/src/pt-fcn-handle.cc +++ b/src/pt-fcn-handle.cc @@ -124,9 +124,14 @@ parent_scope = curr_fcn->scope (); uf->stash_parent_fcn_scope (parent_scope); + + if (curr_fcn->is_class_method () || curr_fcn->is_class_constructor ()) + uf->stash_dispatch_class (curr_fcn->dispatch_class ()); } - uf->mark_as_inline_function (); + uf->mark_as_anonymous_function (); + uf->stash_fcn_file_name (file_name); + uf->stash_fcn_location (line (), column ()); octave_value ov_fcn (uf); @@ -136,22 +141,24 @@ } /* -%!function r = f2 (f, x) +%!function r = __f2 (f, x) %! r = f (x); -%!function f = f1 (k) -%! f = @(x) f2 (@(y) y-k, x); +%!endfunction +%!function f = __f1 (k) +%! f = @(x) __f2 (@(y) y-k, x); +%!endfunction + +%!assert ((__f1 (3)) (10) == 7) + %!test -%! assert ((f1 (3)) (10) == 7) -%! -%!shared g %! g = @(t) feval (@(x) t*x, 2); -%!assert (g(0.5) == 1) -%! -%!shared f, g, h +%! assert (g(0.5) == 1); + +%!test %! h = @(x) sin (x); %! g = @(f, x) h (x); %! f = @() g (@(x) h, pi); -%!assert (f () == sin (pi)) +%! assert (f () == sin (pi)); */ octave_value_list
--- a/src/pt-fcn-handle.h +++ b/src/pt-fcn-handle.h @@ -92,13 +92,14 @@ public: tree_anon_fcn_handle (int l = -1, int c = -1) - : tree_expression (l, c), fcn (0) { } + : tree_expression (l, c), fcn (0), file_name () { } tree_anon_fcn_handle (tree_parameter_list *pl, tree_parameter_list *rl, tree_statement_list *cl, symbol_table::scope_id sid, int l = -1, int c = -1) : tree_expression (l, c), - fcn (new octave_user_function (sid, pl, rl, cl)) { } + fcn (new octave_user_function (sid, pl, rl, cl)), + file_name () { } ~tree_anon_fcn_handle (void) { delete fcn; } @@ -135,11 +136,16 @@ void accept (tree_walker& tw); + void stash_file_name (const std::string& file) { file_name = file; } + private: // The function. octave_user_function *fcn; + // Filename where the handle was defined. + std::string file_name; + // No copying! tree_anon_fcn_handle (const tree_anon_fcn_handle&);
--- a/src/pt-idx.cc +++ b/src/pt-idx.cc @@ -113,6 +113,13 @@ delete *p; args.erase (p); } + + while (! dyn_field.empty ()) + { + std::list<tree_expression *>::iterator p = dyn_field.begin (); + delete *p; + dyn_field.erase (p); + } } bool
--- a/src/pt-loop.cc +++ b/src/pt-loop.cc @@ -91,7 +91,9 @@ tree_simple_for_command::~tree_simple_for_command (void) { + delete lhs; delete expr; + delete maxproc; delete list; delete lead_comm; delete trail_comm; @@ -101,12 +103,13 @@ tree_simple_for_command::dup (symbol_table::scope_id scope, symbol_table::context_id context) const { - return new tree_simple_for_command (lhs ? lhs->dup (scope, context) : 0, - expr ? expr->dup (scope, context) : 0, - list ? list->dup (scope, context) : 0, - lead_comm ? lead_comm->dup () : 0, - trail_comm ? trail_comm->dup () : 0, - line (), column ()); + return new tree_simple_for_command + (parallel, lhs ? lhs->dup (scope, context) : 0, + expr ? expr->dup (scope, context) : 0, + maxproc ? maxproc->dup (scope, context) : 0, + list ? list->dup (scope, context) : 0, + lead_comm ? lead_comm->dup () : 0, + trail_comm ? trail_comm->dup () : 0, line (), column ()); } void @@ -117,6 +120,7 @@ tree_complex_for_command::~tree_complex_for_command (void) { + delete lhs; delete expr; delete list; delete lead_comm;
--- a/src/pt-loop.h +++ b/src/pt-loop.h @@ -145,23 +145,30 @@ public: tree_simple_for_command (int l = -1, int c = -1) - : tree_command (l, c), lhs (0), expr (0), list (0), lead_comm (0), - trail_comm (0) { } + : tree_command (l, c), parallel (false), lhs (0), expr (0), + maxproc (0), list (0), lead_comm (0), trail_comm (0) { } - tree_simple_for_command (tree_expression *le, tree_expression *re, + tree_simple_for_command (bool parallel_arg, tree_expression *le, + tree_expression *re, + tree_expression *maxproc_arg, tree_statement_list *lst, octave_comment_list *lc = 0, octave_comment_list *tc = 0, int l = -1, int c = -1) - : tree_command (l, c), lhs (le), expr (re), list (lst), + : tree_command (l, c), parallel (parallel_arg), lhs (le), + expr (re), maxproc (maxproc_arg), list (lst), lead_comm (lc), trail_comm (tc) { } ~tree_simple_for_command (void); + bool in_parallel (void) { return parallel; } + tree_expression *left_hand_side (void) { return lhs; } tree_expression *control_expr (void) { return expr; } + tree_expression *maxproc_expr (void) { return maxproc; } + tree_statement_list *body (void) { return list; } octave_comment_list *leading_comment (void) { return lead_comm; } @@ -175,12 +182,20 @@ private: + // TRUE means operate in parallel (subject to the value of the + // maxproc expression). + bool parallel; + // Expression to modify. tree_expression *lhs; // Expression to evaluate. tree_expression *expr; + // Expression to tell how many processors should be used (only valid + // if parallel is TRUE). + tree_expression *maxproc; + // List of commands to execute. tree_statement_list *list;
--- a/src/pt-mat.cc +++ b/src/pt-mat.cc @@ -28,6 +28,7 @@ #include "quit.h" +#include "data.h" #include "defun.h" #include "error.h" #include "oct-obj.h" @@ -68,15 +69,17 @@ : count (1), dv (0, 0), all_str (false), all_sq_str (false), all_dq_str (false), some_str (false), all_real (false), all_cmplx (false), - all_mt (true), any_sparse (false), any_class (false), - all_1x1 (false), class_nm (), ok (false) + all_mt (true), any_cell (false), any_sparse (false), + any_class (false), all_1x1 (false), + first_elem_is_struct (false), class_nm (), ok (false) { } tm_row_const_rep (const tree_argument_list& row) : count (1), dv (0, 0), all_str (false), all_sq_str (false), some_str (false), all_real (false), all_cmplx (false), - all_mt (true), any_sparse (false), any_class (false), - all_1x1 (! row.empty ()), class_nm (), ok (false) + all_mt (true), any_cell (false), any_sparse (false), + any_class (false), all_1x1 (! row.empty ()), + first_elem_is_struct (false), class_nm (), ok (false) { init (row); } ~tm_row_const_rep (void) { } @@ -92,25 +95,28 @@ bool all_real; bool all_cmplx; bool all_mt; + bool any_cell; bool any_sparse; bool any_class; bool all_1x1; + bool first_elem_is_struct; std::string class_nm; bool ok; - bool do_init_element (tree_expression *, const octave_value&, bool&); + void do_init_element (const octave_value&, bool&); void init (const tree_argument_list&); + void cellify (void); + private: tm_row_const_rep (const tm_row_const_rep&); tm_row_const_rep& operator = (const tm_row_const_rep&); - void eval_warning (const char *msg, int l, int c) const; }; public: @@ -169,12 +175,16 @@ bool all_real_p (void) const { return rep->all_real; } bool all_complex_p (void) const { return rep->all_cmplx; } bool all_empty_p (void) const { return rep->all_mt; } + bool any_cell_p (void) const { return rep->any_cell; } bool any_sparse_p (void) const { return rep->any_sparse; } bool any_class_p (void) const { return rep->any_class; } bool all_1x1_p (void) const { return rep->all_1x1; } + bool first_elem_struct_p (void) const { return rep->first_elem_is_struct; } std::string class_name (void) const { return rep->class_nm; } + void cellify (void) { rep->cellify (); } + operator bool () const { return (rep && rep->ok); } iterator begin (void) { return rep->begin (); } @@ -199,6 +209,8 @@ retval = c2; else if (c2.empty ()) retval = c1; + else if (c1 == "class" || c2 == "class") + retval = "class"; else { bool c1_is_int = (c1 == "int8" || c1 == "uint8" @@ -232,7 +244,11 @@ // Order is important here... - if (c1_is_char && c2_is_built_in_type) + if (c1 == "struct" && c2 == c1) + retval = c1; + else if (c1 == "cell" || c2 == "cell") + retval = "cell"; + else if (c1_is_char && c2_is_built_in_type) retval = c1; else if (c2_is_char && c1_is_built_in_type) retval = c2; @@ -250,54 +266,38 @@ retval = c2; else if (c1_is_logical && c2_is_logical) retval = c1; - else if (c1 == "struct" && c2 == c1) - retval = c1; - else if (c1 == "cell" && c2 == c1) - retval = c1; } return retval; } static void -eval_error (const char *msg, int l, int c, - const dim_vector& x, const dim_vector& y) +eval_error (const char *msg, const dim_vector& x, const dim_vector& y) { - if (l == -1 && c == -1) - { - ::error ("%s (%s vs %s)", msg, x.str ().c_str (), y.str ().c_str ()); - } - else - { - ::error ("%s (%s vs %s) near line %d, column %d", msg, - x.str ().c_str (), y.str ().c_str (), l, c); - } + ::error ("%s (%s vs %s)", msg, x.str ().c_str (), y.str ().c_str ()); } -bool -tm_row_const::tm_row_const_rep::do_init_element (tree_expression *elt, - const octave_value& val, +void +tm_row_const::tm_row_const_rep::do_init_element (const octave_value& val, bool& first_elem) { - std::string this_elt_class_nm = val.class_name (); + std::string this_elt_class_nm + = val.is_object () ? std::string ("class") : val.class_name (); + + class_nm = get_concat_class (class_nm, this_elt_class_nm); dim_vector this_elt_dv = val.dims (); - class_nm = get_concat_class (class_nm, this_elt_class_nm); - if (! this_elt_dv.zero_by_zero ()) { all_mt = false; if (first_elem) { + if (val.is_map ()) + first_elem_is_struct = true; + first_elem = false; - dv = this_elt_dv; - } - else if (! dv.hvcat (this_elt_dv, 1)) - { - eval_error ("horizontal dimensions mismatch", elt->line (), elt->column (), dv, this_elt_dv); - return false; } } @@ -321,6 +321,9 @@ if (all_cmplx && ! (val.is_complex_type () || val.is_real_type ())) all_cmplx = false; + if (!any_cell && val.is_cell ()) + any_cell = true; + if (!any_sparse && val.is_sparse_type ()) any_sparse = true; @@ -328,8 +331,6 @@ any_class = true; all_1x1 = all_1x1 && val.numel () == 1; - - return true; } void @@ -340,6 +341,7 @@ all_dq_str = true; all_real = true; all_cmplx = true; + any_cell = false; any_sparse = false; any_class = false; @@ -356,7 +358,10 @@ octave_value tmp = elt->rvalue1 (); if (error_state || tmp.is_undefined ()) - break; + { + ok = ! error_state; + return; + } else { if (tmp.is_cs_list ()) @@ -367,32 +372,91 @@ { octave_quit (); - if (! do_init_element (elt, tlst(i), first_elem)) - goto done; + do_init_element (tlst(i), first_elem); } } else + do_init_element (tmp, first_elem); + } + } + + if (any_cell && ! any_class && ! first_elem_is_struct) + cellify (); + + first_elem = true; + + for (iterator p = begin (); p != end (); p++) + { + octave_quit (); + + octave_value val = *p; + + dim_vector this_elt_dv = val.dims (); + + if (! this_elt_dv.zero_by_zero ()) + { + all_mt = false; + + if (first_elem) { - if (! do_init_element (elt, tmp, first_elem)) - goto done; + first_elem = false; + dv = this_elt_dv; + } + else if (! dv.hvcat (this_elt_dv, 1)) + { + eval_error ("horizontal dimensions mismatch", dv, this_elt_dv); + break; } } } - done: - ok = ! error_state; } void -tm_row_const::tm_row_const_rep::eval_warning (const char *msg, int l, - int c) const +tm_row_const::tm_row_const_rep::cellify (void) { - if (l == -1 && c == -1) - warning_with_id ("Octave:empty-list-elements", "%s", msg); - else - warning_with_id ("Octave:empty-list-elements", - "%s near line %d, column %d", msg, l, c); + bool elt_changed = false; + + for (iterator p = begin (); p != end (); p++) + { + octave_quit (); + + if (! p->is_cell ()) + { + elt_changed = true; + + *p = Cell (*p); + } + } + + if (elt_changed) + { + bool first_elem = true; + + for (iterator p = begin (); p != end (); p++) + { + octave_quit (); + + octave_value val = *p; + + dim_vector this_elt_dv = val.dims (); + + if (! this_elt_dv.zero_by_zero ()) + { + if (first_elem) + { + first_elem = false; + dv = this_elt_dv; + } + else if (! dv.hvcat (this_elt_dv, 1)) + { + eval_error ("horizontal dimensions mismatch", dv, this_elt_dv); + break; + } + } + } + } } class @@ -403,8 +467,8 @@ tm_const (const tree_matrix& tm) : dv (0, 0), all_str (false), all_sq_str (false), all_dq_str (false), some_str (false), all_real (false), all_cmplx (false), - all_mt (true), any_sparse (false), any_class (false), - class_nm (), ok (false) + all_mt (true), any_cell (false), any_sparse (false), + any_class (false), class_nm (), ok (false) { init (tm); } ~tm_const (void) { } @@ -421,6 +485,7 @@ bool all_real_p (void) const { return all_real; } bool all_complex_p (void) const { return all_cmplx; } bool all_empty_p (void) const { return all_mt; } + bool any_cell_p (void) const { return any_cell; } bool any_sparse_p (void) const { return any_sparse; } bool any_class_p (void) const { return any_class; } bool all_1x1_p (void) const { return all_1x1; } @@ -440,6 +505,7 @@ bool all_real; bool all_cmplx; bool all_mt; + bool any_cell; bool any_sparse; bool any_class; bool all_1x1; @@ -465,11 +531,13 @@ all_dq_str = true; all_real = true; all_cmplx = true; + any_cell = false; any_sparse = false; any_class = false; - all_1x1 = ! empty (); + all_1x1 = ! tm.empty (); bool first_elem = true; + bool first_elem_is_struct = false; // Just eval and figure out if what we have is complex or all // strings. We can't check columns until we know that this is a @@ -484,6 +552,13 @@ tm_row_const tmp (*elt); + if (first_elem) + { + first_elem_is_struct = tmp.first_elem_struct_p (); + + first_elem = false; + } + if (tmp && ! tmp.empty ()) { if (all_str && ! tmp.all_strings_p ()) @@ -507,6 +582,9 @@ if (all_mt && ! tmp.all_empty_p ()) all_mt = false; + if (!any_cell && tmp.any_cell_p ()) + any_cell = true; + if (!any_sparse && tmp.any_sparse_p ()) any_sparse = true; @@ -523,11 +601,23 @@ if (! error_state) { - for (iterator p = begin (); p != end (); p++) + if (any_cell && ! any_class && ! first_elem_is_struct) + { + for (iterator q = begin (); q != end (); q++) + { + octave_quit (); + + q->cellify (); + } + } + + first_elem = true; + + for (iterator q = begin (); q != end (); q++) { octave_quit (); - tm_row_const elt = *p; + tm_row_const elt = *q; octave_idx_type this_elt_nr = elt.rows (); octave_idx_type this_elt_nc = elt.cols (); @@ -556,8 +646,7 @@ } else if (! dv.hvcat (this_elt_dv, 0)) { - eval_error ("vertical dimensions mismatch", -1, -1, - dv, this_elt_dv); + eval_error ("vertical dimensions mismatch", dv, this_elt_dv); return; } } @@ -625,7 +714,7 @@ maybe_warn_string_concat (bool all_dq_strings_p, bool all_sq_strings_p) { if (! (all_dq_strings_p || all_sq_strings_p)) - warning_with_id ("Octave:string-concat", + warning_with_id ("Octave:mixed-string-concat", "concatenation of different character string types may have unintended consequences"); } @@ -833,17 +922,54 @@ return result; } +static octave_value +do_class_concat (tm_const& tmc) +{ + octave_value retval; + + octave_value_list rows (tmc.length (), octave_value ()); + + octave_idx_type j = 0; + for (tm_const::iterator p = tmc.begin (); p != tmc.end (); p++) + { + octave_quit (); + + tm_row_const tmrc = *p; + + if (tmrc.length () == 1) + rows(j++) = *(tmrc.begin ()); + else + { + octave_value_list row (tmrc.length (), octave_value ()); + + octave_idx_type i = 0; + for (tm_row_const::iterator q = tmrc.begin (); q != tmrc.end (); q++) + row(i++) = *q; + + rows(j++) = do_class_concat (row, "horzcat", 1); + } + } + + if (! error_state) + { + if (rows.length () == 1) + retval = rows(0); + else + retval = do_class_concat (rows, "vertcat", 0); + } + + return retval; +} + octave_value tree_matrix::rvalue1 (int) { octave_value retval = Matrix (); - bool all_strings_p = false; bool all_sq_strings_p = false; bool all_dq_strings_p = false; bool all_empty_p = false; bool all_real_p = false; - bool all_complex_p = false; bool any_sparse_p = false; bool any_class_p = false; bool frc_str_conv = false; @@ -853,12 +979,10 @@ if (tmp && ! tmp.empty ()) { dim_vector dv = tmp.dims (); - all_strings_p = tmp.all_strings_p (); all_sq_strings_p = tmp.all_sq_strings_p (); all_dq_strings_p = tmp.all_dq_strings_p (); all_empty_p = tmp.all_empty_p (); all_real_p = tmp.all_real_p (); - all_complex_p = tmp.all_complex_p (); any_sparse_p = tmp.any_sparse_p (); any_class_p = tmp.any_class_p (); frc_str_conv = tmp.some_strings_p (); @@ -869,64 +993,7 @@ if (any_class_p) { - octave_value_list tmp3 (tmp.length (), octave_value ()); - - int j = 0; - for (tm_const::iterator p = tmp.begin (); p != tmp.end (); p++) - { - octave_quit (); - - tm_row_const row = *p; - - if (row.length () == 1) - tmp3 (j++) = *(row.begin ()); - else - { - octave_value_list tmp1 (row.length (), octave_value ()); - - int i = 0; - for (tm_row_const::iterator q = row.begin (); - q != row.end (); q++) - tmp1 (i++) = *q; - - octave_value_list tmp2; - octave_value fcn = - symbol_table::find_function ("horzcat", tmp1); - - if (fcn.is_defined ()) - { - tmp2 = fcn.do_multi_index_op (1, tmp1); - - if (error_state) - goto done; - - tmp3 (j++) = tmp2 (0); - } - else - { - ::error ("cannot find overloaded horzcat function"); - goto done; - } - } - } - - if (tmp.length () == 1) - retval = tmp3 (0); - else - { - octave_value_list tmp2; - octave_value fcn = symbol_table::find_function ("vertcat", tmp3); - - if (fcn.is_defined ()) - { - tmp2 = fcn.do_multi_index_op (1, tmp3); - - if (! error_state) - retval = tmp2 (0); - } - else - ::error ("cannot find overloaded vertcat function"); - } + retval = do_class_concat (tmp); } else if (result_type == "double") { @@ -1125,10 +1192,206 @@ tw.visit_matrix (*this); } +/* +%% test concatenation with all zero matrices +%!assert([ '' 65*ones(1,10) ], 'AAAAAAAAAA'); +%!assert([ 65*ones(1,10) '' ], 'AAAAAAAAAA'); + +%!test +%! c = {'foo'; 'bar'; 'bazoloa'}; +%! assert ([c; 'a'; 'bc'; 'def'], {'foo'; 'bar'; 'bazoloa'; 'a'; 'bc'; 'def'}); + +%!assert (class ([int64(1), int64(1)]), 'int64') +%!assert (class ([int64(1), int32(1)]), 'int64') +%!assert (class ([int64(1), int16(1)]), 'int64') +%!assert (class ([int64(1), int8(1)]), 'int64') +%!assert (class ([int64(1), uint64(1)]), 'int64') +%!assert (class ([int64(1), uint32(1)]), 'int64') +%!assert (class ([int64(1), uint16(1)]), 'int64') +%!assert (class ([int64(1), uint8(1)]), 'int64') +%!assert (class ([int64(1), single(1)]), 'int64') +%!assert (class ([int64(1), double(1)]), 'int64') +%!assert (class ([int64(1), cell(1)]), 'cell') +%!assert (class ([int64(1), true]), 'int64') +%!assert (class ([int64(1), 'a']), 'char') + +%!assert (class ([int32(1), int64(1)]), 'int32') +%!assert (class ([int32(1), int32(1)]), 'int32') +%!assert (class ([int32(1), int16(1)]), 'int32') +%!assert (class ([int32(1), int8(1)]), 'int32') +%!assert (class ([int32(1), uint64(1)]), 'int32') +%!assert (class ([int32(1), uint32(1)]), 'int32') +%!assert (class ([int32(1), uint16(1)]), 'int32') +%!assert (class ([int32(1), uint8(1)]), 'int32') +%!assert (class ([int32(1), single(1)]), 'int32') +%!assert (class ([int32(1), double(1)]), 'int32') +%!assert (class ([int32(1), cell(1)]), 'cell') +%!assert (class ([int32(1), true]), 'int32') +%!assert (class ([int32(1), 'a']), 'char') + +%!assert (class ([int16(1), int64(1)]), 'int16') +%!assert (class ([int16(1), int32(1)]), 'int16') +%!assert (class ([int16(1), int16(1)]), 'int16') +%!assert (class ([int16(1), int8(1)]), 'int16') +%!assert (class ([int16(1), uint64(1)]), 'int16') +%!assert (class ([int16(1), uint32(1)]), 'int16') +%!assert (class ([int16(1), uint16(1)]), 'int16') +%!assert (class ([int16(1), uint8(1)]), 'int16') +%!assert (class ([int16(1), single(1)]), 'int16') +%!assert (class ([int16(1), double(1)]), 'int16') +%!assert (class ([int16(1), cell(1)]), 'cell') +%!assert (class ([int16(1), true]), 'int16') +%!assert (class ([int16(1), 'a']), 'char') + +%!assert (class ([int8(1), int64(1)]), 'int8') +%!assert (class ([int8(1), int32(1)]), 'int8') +%!assert (class ([int8(1), int16(1)]), 'int8') +%!assert (class ([int8(1), int8(1)]), 'int8') +%!assert (class ([int8(1), uint64(1)]), 'int8') +%!assert (class ([int8(1), uint32(1)]), 'int8') +%!assert (class ([int8(1), uint16(1)]), 'int8') +%!assert (class ([int8(1), uint8(1)]), 'int8') +%!assert (class ([int8(1), single(1)]), 'int8') +%!assert (class ([int8(1), double(1)]), 'int8') +%!assert (class ([int8(1), cell(1)]), 'cell') +%!assert (class ([int8(1), true]), 'int8') +%!assert (class ([int8(1), 'a']), 'char') + +%!assert (class ([uint64(1), int64(1)]), 'uint64') +%!assert (class ([uint64(1), int32(1)]), 'uint64') +%!assert (class ([uint64(1), int16(1)]), 'uint64') +%!assert (class ([uint64(1), int8(1)]), 'uint64') +%!assert (class ([uint64(1), uint64(1)]), 'uint64') +%!assert (class ([uint64(1), uint32(1)]), 'uint64') +%!assert (class ([uint64(1), uint16(1)]), 'uint64') +%!assert (class ([uint64(1), uint8(1)]), 'uint64') +%!assert (class ([uint64(1), single(1)]), 'uint64') +%!assert (class ([uint64(1), double(1)]), 'uint64') +%!assert (class ([uint64(1), cell(1)]), 'cell') +%!assert (class ([uint64(1), true]), 'uint64') +%!assert (class ([uint64(1), 'a']), 'char') + +%!assert (class ([uint32(1), int64(1)]), 'uint32') +%!assert (class ([uint32(1), int32(1)]), 'uint32') +%!assert (class ([uint32(1), int16(1)]), 'uint32') +%!assert (class ([uint32(1), int8(1)]), 'uint32') +%!assert (class ([uint32(1), uint64(1)]), 'uint32') +%!assert (class ([uint32(1), uint32(1)]), 'uint32') +%!assert (class ([uint32(1), uint16(1)]), 'uint32') +%!assert (class ([uint32(1), uint8(1)]), 'uint32') +%!assert (class ([uint32(1), single(1)]), 'uint32') +%!assert (class ([uint32(1), double(1)]), 'uint32') +%!assert (class ([uint32(1), cell(1)]), 'cell') +%!assert (class ([uint32(1), true]), 'uint32') +%!assert (class ([uint32(1), 'a']), 'char') + +%!assert (class ([uint16(1), int64(1)]), 'uint16') +%!assert (class ([uint16(1), int32(1)]), 'uint16') +%!assert (class ([uint16(1), int16(1)]), 'uint16') +%!assert (class ([uint16(1), int8(1)]), 'uint16') +%!assert (class ([uint16(1), uint64(1)]), 'uint16') +%!assert (class ([uint16(1), uint32(1)]), 'uint16') +%!assert (class ([uint16(1), uint16(1)]), 'uint16') +%!assert (class ([uint16(1), uint8(1)]), 'uint16') +%!assert (class ([uint16(1), single(1)]), 'uint16') +%!assert (class ([uint16(1), double(1)]), 'uint16') +%!assert (class ([uint16(1), cell(1)]), 'cell') +%!assert (class ([uint16(1), true]), 'uint16') +%!assert (class ([uint16(1), 'a']), 'char') + +%!assert (class ([uint8(1), int64(1)]), 'uint8') +%!assert (class ([uint8(1), int32(1)]), 'uint8') +%!assert (class ([uint8(1), int16(1)]), 'uint8') +%!assert (class ([uint8(1), int8(1)]), 'uint8') +%!assert (class ([uint8(1), uint64(1)]), 'uint8') +%!assert (class ([uint8(1), uint32(1)]), 'uint8') +%!assert (class ([uint8(1), uint16(1)]), 'uint8') +%!assert (class ([uint8(1), uint8(1)]), 'uint8') +%!assert (class ([uint8(1), single(1)]), 'uint8') +%!assert (class ([uint8(1), double(1)]), 'uint8') +%!assert (class ([uint8(1), cell(1)]), 'cell') +%!assert (class ([uint8(1), true]), 'uint8') +%!assert (class ([uint8(1), 'a']), 'char') + +%!assert (class ([single(1), int64(1)]), 'int64') +%!assert (class ([single(1), int32(1)]), 'int32') +%!assert (class ([single(1), int16(1)]), 'int16') +%!assert (class ([single(1), int8(1)]), 'int8') +%!assert (class ([single(1), uint64(1)]), 'uint64') +%!assert (class ([single(1), uint32(1)]), 'uint32') +%!assert (class ([single(1), uint16(1)]), 'uint16') +%!assert (class ([single(1), uint8(1)]), 'uint8') +%!assert (class ([single(1), single(1)]), 'single') +%!assert (class ([single(1), double(1)]), 'single') +%!assert (class ([single(1), cell(1)]), 'cell') +%!assert (class ([single(1), true]), 'single') +%!assert (class ([single(1), 'a']), 'char') + +%!assert (class ([double(1), int64(1)]), 'int64') +%!assert (class ([double(1), int32(1)]), 'int32') +%!assert (class ([double(1), int16(1)]), 'int16') +%!assert (class ([double(1), int8(1)]), 'int8') +%!assert (class ([double(1), uint64(1)]), 'uint64') +%!assert (class ([double(1), uint32(1)]), 'uint32') +%!assert (class ([double(1), uint16(1)]), 'uint16') +%!assert (class ([double(1), uint8(1)]), 'uint8') +%!assert (class ([double(1), single(1)]), 'single') +%!assert (class ([double(1), double(1)]), 'double') +%!assert (class ([double(1), cell(1)]), 'cell') +%!assert (class ([double(1), true]), 'double') +%!assert (class ([double(1), 'a']), 'char') + +%!assert (class ([cell(1), int64(1)]), 'cell') +%!assert (class ([cell(1), int32(1)]), 'cell') +%!assert (class ([cell(1), int16(1)]), 'cell') +%!assert (class ([cell(1), int8(1)]), 'cell') +%!assert (class ([cell(1), uint64(1)]), 'cell') +%!assert (class ([cell(1), uint32(1)]), 'cell') +%!assert (class ([cell(1), uint16(1)]), 'cell') +%!assert (class ([cell(1), uint8(1)]), 'cell') +%!assert (class ([cell(1), single(1)]), 'cell') +%!assert (class ([cell(1), double(1)]), 'cell') +%!assert (class ([cell(1), cell(1)]), 'cell') +%!assert (class ([cell(1), true]), 'cell') +%!assert (class ([cell(1), 'a']), 'cell') + +%!assert (class ([true, int64(1)]), 'int64') +%!assert (class ([true, int32(1)]), 'int32') +%!assert (class ([true, int16(1)]), 'int16') +%!assert (class ([true, int8(1)]), 'int8') +%!assert (class ([true, uint64(1)]), 'uint64') +%!assert (class ([true, uint32(1)]), 'uint32') +%!assert (class ([true, uint16(1)]), 'uint16') +%!assert (class ([true, uint8(1)]), 'uint8') +%!assert (class ([true, single(1)]), 'single') +%!assert (class ([true, double(1)]), 'double') +%!assert (class ([true, cell(1)]), 'cell') +%!assert (class ([true, true]), 'logical') +%!assert (class ([true, 'a']), 'char') + +%!assert (class (['a', int64(1)]), 'char') +%!assert (class (['a', int32(1)]), 'char') +%!assert (class (['a', int16(1)]), 'char') +%!assert (class (['a', int8(1)]), 'char') +%!assert (class (['a', int64(1)]), 'char') +%!assert (class (['a', int32(1)]), 'char') +%!assert (class (['a', int16(1)]), 'char') +%!assert (class (['a', int8(1)]), 'char') +%!assert (class (['a', single(1)]), 'char') +%!assert (class (['a', double(1)]), 'char') +%!assert (class (['a', cell(1)]), 'cell') +%!assert (class (['a', true]), 'char') +%!assert (class (['a', 'a']), 'char') + +%!assert (class ([cell(1), struct('foo', 'bar')]), 'cell') +%!error [struct('foo', 'bar'), cell(1)]; +*/ + DEFUN (string_fill_char, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} string_fill_char ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} string_fill_char (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} string_fill_char (@var{new_val}, \"local\")\n\ Query or set the internal variable used to pad all rows of a character\n\ matrix to the same length. It must be a single character. The default\n\ value is @code{\" \"} (a single space). For example:\n\ @@ -1142,7 +1405,26 @@ \"strings\"\n\ @end group\n\ @end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (string_fill_char); } + +/* +%!error (string_fill_char (1, 2)); +%% string_fill_char() function call must be outside of %!test block +%% due to the way a %!test block is wrapped inside a function +%!shared orig_val, old_val +%! orig_val = string_fill_char (); +%! old_val = string_fill_char ("X"); +%!test +%! assert (orig_val, old_val); +%! assert (string_fill_char (), "X"); +%! assert (["these"; "are"; "strings"], ["theseXX"; "areXXXX"; "strings"]); +%! string_fill_char (orig_val); +%! assert (string_fill_char (), orig_val); +*/
--- a/src/pt-pr-code.cc +++ b/src/pt-pr-code.cc @@ -214,10 +214,15 @@ indent (); - os << "for "; + os << (cmd.in_parallel () ? "parfor " : "for "); tree_expression *lhs = cmd.left_hand_side (); + tree_expression *maxproc = cmd.maxproc_expr (); + + if (maxproc) + os << "("; + if (lhs) lhs->accept (*this); @@ -228,6 +233,13 @@ if (expr) expr->accept (*this); + if (maxproc) + { + os << ", "; + maxproc->accept (*this); + os << ")"; + } + newline (); tree_statement_list *list = cmd.body (); @@ -245,7 +257,7 @@ indent (); - os << "endfor"; + os << (cmd.in_parallel () ? "endparfor" : "endfor"); } void @@ -529,16 +541,10 @@ print_parens (expr, "("); - bool expr_has_parens = false; - tree_expression *e = expr.expression (); if (e) - { - e->accept (*this); - - expr_has_parens = e->is_postfix_indexed (); - } + e->accept (*this); std::list<tree_argument_list *> arg_lists = expr.arg_lists (); std::string type_tags = expr.type_tags ();
--- a/src/pt-unop.cc +++ b/src/pt-unop.cc @@ -28,6 +28,7 @@ #include "oct-obj.h" #include "oct-lvalue.h" #include "ov.h" +#include "profiler.h" #include "pt-bp.h" #include "pt-unop.h" #include "pt-walk.h" @@ -72,10 +73,14 @@ if (! error_state) { + BEGIN_PROFILER_BLOCK ("prefix " + oper ()) + ref.do_unary_op (etype); if (! error_state) retval = ref.value (); + + END_PROFILER_BLOCK } } else @@ -84,6 +89,8 @@ if (! error_state && val.is_defined ()) { + BEGIN_PROFILER_BLOCK ("prefix " + oper ()) + // Attempt to do the operation in-place if it is unshared // (a temporary expression). if (val.get_count () == 1) @@ -93,6 +100,8 @@ if (error_state) retval = octave_value (); + + END_PROFILER_BLOCK } } } @@ -153,7 +162,9 @@ { retval = ref.value (); + BEGIN_PROFILER_BLOCK ("postfix " + oper ()) ref.do_unary_op (etype); + END_PROFILER_BLOCK } } else @@ -162,10 +173,14 @@ if (! error_state && val.is_defined ()) { + BEGIN_PROFILER_BLOCK ("postfix " + oper ()) + retval = ::do_unary_op (etype, val); if (error_state) retval = octave_value (); + + END_PROFILER_BLOCK } } }
--- a/src/sighandlers.cc +++ b/src/sighandlers.cc @@ -35,6 +35,7 @@ #include "cmd-edit.h" #include "oct-syscalls.h" #include "quit.h" +#include "singleton-cleanup.h" #include "debug.h" #include "defun.h" @@ -804,7 +805,12 @@ bool retval = true; if (! instance) - instance = new octave_child_list_rep (); + { + instance = new octave_child_list_rep (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) { @@ -945,39 +951,93 @@ return retval; } +/* +%!error SIG (1); +%!assert (isstruct (SIG ())); +%!assert (! isempty (SIG ())); +*/ + DEFUN (debug_on_interrupt, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} debug_on_interrupt ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} debug_on_interrupt (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} debug_on_interrupt (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether Octave will try\n\ to enter debugging mode when it receives an interrupt signal (typically\n\ generated with @kbd{C-c}). If a second interrupt signal is received\n\ before reaching the debugging mode, a normal interrupt will occur.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (debug_on_interrupt); } +/* +%!error (debug_on_interrupt (1, 2)); +%!test +%! orig_val = debug_on_interrupt (); +%! old_val = debug_on_interrupt (! orig_val); +%! assert (orig_val, old_val); +%! assert (debug_on_interrupt (), ! orig_val); +%! debug_on_interrupt (orig_val); +%! assert (debug_on_interrupt (), orig_val); +*/ + DEFUN (sighup_dumps_octave_core, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} sighup_dumps_octave_core ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} sighup_dumps_octave_core (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} sighup_dumps_octave_core (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether Octave tries\n\ to save all current variables to the file \"octave-core\" if it receives\n\ a hangup signal.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (sighup_dumps_octave_core); } +/* +%!error (sighup_dumps_octave_core (1, 2)); +%!test +%! orig_val = sighup_dumps_octave_core (); +%! old_val = sighup_dumps_octave_core (! orig_val); +%! assert (orig_val, old_val); +%! assert (sighup_dumps_octave_core (), ! orig_val); +%! sighup_dumps_octave_core (orig_val); +%! assert (sighup_dumps_octave_core (), orig_val); +*/ + DEFUN (sigterm_dumps_octave_core, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} sigterm_dumps_octave_core ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} sigterm_dumps_octave_core (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} sigterm_dumps_octave_core (@var{new_val}, \"local\")\n\ Query or set the internal variable that controls whether Octave tries\n\ to save all current variables to the file \"octave-core\" if it receives\n\ a terminate signal.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (sigterm_dumps_octave_core); } + +/* +%!error (sigterm_dumps_octave_core (1, 2)); +%!test +%! orig_val = sigterm_dumps_octave_core (); +%! old_val = sigterm_dumps_octave_core (! orig_val); +%! assert (orig_val, old_val); +%! assert (sigterm_dumps_octave_core (), ! orig_val); +%! sigterm_dumps_octave_core (orig_val); +%! assert (sigterm_dumps_octave_core (), orig_val); +*/
--- a/src/sighandlers.h +++ b/src/sighandlers.h @@ -170,6 +170,8 @@ static bool instance_ok (void); static octave_child_list_rep *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } }; #endif
--- a/src/sparse-xpow.cc +++ b/src/sparse-xpow.cc @@ -63,7 +63,7 @@ octave_idx_type nc = a.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be square"); + error ("for A^b, A must be a square matrix"); else { if (static_cast<int> (b) == b) @@ -136,7 +136,7 @@ octave_idx_type nc = a.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be square"); + error ("for A^b, A must be a square matrix"); else { if (static_cast<int> (b) == b)
--- a/src/sparse.cc +++ b/src/sparse.cc @@ -177,7 +177,7 @@ if (! error_state && (m < 0 || n < 0)) - error ("sparse: dimensions must be nonnegative"); + error ("sparse: dimensions must be non-negative"); } else if (nargin != 3) print_usage ();
--- a/src/strfns.cc +++ b/src/strfns.cc @@ -80,10 +80,12 @@ int nargin = args.length (); - if (nargin == 1) + if (nargin == 0) + retval = ""; + else if (nargin == 1) retval = args(0).convert_to_str (true, true, args(0).is_dq_string () ? '"' : '\''); - else if (nargin > 1) + else { int n_elts = 0; @@ -144,14 +146,12 @@ retval = octave_value (result, '\''); } - else - print_usage (); return retval; } /* -%!error <Invalid call to char> char() +%!assert (char (), ''); %!assert (char (100) == "d"); %!assert (all(char (100,100) == ["d";"d"])); %!assert (all(char ({100,100}) == ["d";"d"])); @@ -162,6 +162,13 @@ %!assert (all(char ({100,{100, {""}}}) == ["d";"d";" "])) %!assert (all(char (["a";"be"], {"c", 100}) == ["a";"be";"c";"d"])) %!assert(strcmp (char ("a", "bb", "ccc"), ["a "; "bb "; "ccc"])); +%!assert(strcmp (char ([65, 83, 67, 73, 73]), "ASCII")); + +%!test +%! x = char ("foo", "bar", "foobar"); +%! assert((strcmp (x(1,:), "foo ") +%! && strcmp (x(2,:), "bar ") +%! && strcmp (x(3,:), "foobar"))); */ DEFUN (strvcat, args, , @@ -314,14 +321,20 @@ } /* - %!assert (ischar ("a"), logical (1)); %!assert (ischar (["ab";"cd"]), logical (1)); %!assert (ischar ({"ab"}), logical (0)); %!assert (ischar (1), logical (0)); -%!error <Invalid call to ischar.*> ischar (); - - */ +%!assert(ischar ([1, 2]), logical (0)); +%!assert(ischar ([]), logical (0)); +%!assert(ischar ([1, 2; 3, 4]), logical (0)); +%!assert(ischar (""), logical (1)); +%!assert(ischar ("test"), logical (1)); +%!assert(ischar (["test"; "ing"]), logical (1)); +%!assert(ischar (struct ("foo", "bar")), logical (0)); +%!error <Invalid call to ischar> ischar (); +%!error <Invalid call to ischar> ischar ("test", 1); +*/ static octave_value do_strcmp_fun (const octave_value& arg0, const octave_value& arg1, @@ -576,12 +589,15 @@ } /* +%!error <Invalid call to strcmp> strcmp (); +%!error <Invalid call to strcmp> strcmp ("foo", "bar", 3); +%! %!shared x %! x = char (zeros (0, 2)); %!assert (strcmp ('', x) == false); %!assert (strcmp (x, '') == false); %!assert (strcmp (x, x) == true); -## %!assert (strcmp ({''}, x) == false); +## %!assert (strcmp ({''}, x) == true); ## %!assert (strcmp ({x}, '') == false); ## %!assert (strcmp ({x}, x) == true); ## %!assert (strcmp ('', {x}) == false); @@ -608,14 +624,16 @@ %!assert (all (strcmp ('', {y}) == [true; true])); %!assert (all (strcmp (y, {''}) == [true; true])); %!assert (all (strcmp (y, {y}) == [true; true])); -## %!assert (all (strcmp ({y; y}, '') == [false; false])); -## %!assert (all (strcmp ({y; y}, {''}) == [false; false])); -## %!assert (all (strcmp ('', {y; y}) == [false; false])); -## %!assert (all (strcmp ({''}, {y; y}) == [false; false])); +%!assert (all (strcmp ({y; y}, '') == [true; true])); +%!assert (all (strcmp ({y; y}, {''}) == [true; true])); +%!assert (all (strcmp ('', {y; y}) == [true; true])); +%!assert (all (strcmp ({''}, {y; y}) == [true; true])); %!assert (all (strcmp ({'foo'}, y) == [false; false])); %!assert (all (strcmp ({'foo'}, y) == [false; false])); %!assert (all (strcmp (y, {'foo'}) == [false; false])); %!assert (all (strcmp (y, {'foo'}) == [false; false])); +%!assert (strcmp ("foobar", "foobar"), true); +%!assert (strcmp ("fooba", "foobar"), false); */ // Apparently, Matlab ignores the dims with strncmp. It also @@ -694,8 +712,8 @@ } /* -%!error <Invalid call to strncmp.*> strncmp (); -%!error <Invalid call to strncmp.*> strncmp ("abc", "def"); +%!error <Invalid call to strncmp> strncmp (); +%!error <Invalid call to strncmp> strncmp ("abc", "def"); %!assert (strncmp ("abce", "abc", 3) == 1) %!assert (strncmp (100, 100, 1) == 0) %!assert (all (strncmp ("abce", {"abcd", "bca", "abc"}, 3) == [1, 0, 1])) @@ -844,8 +862,9 @@ If @var{width} is not specified, the width of the terminal screen is used.\n\ Newline characters are used to break the lines in the output string.\n\ For example:\n\ +@c Set example in small font to prevent overfull line\n\ \n\ -@example\n\ +@smallexample\n\ @group\n\ list_in_columns (@{\"abc\", \"def\", \"ghijkl\", \"mnop\", \"qrs\", \"tuv\"@}, 20)\n\ @result{} ans = abc mnop\n\ @@ -862,7 +881,7 @@ \n\ Total is 37 elements using 37 bytes\n\ @end group\n\ -@end example\n\ +@end smallexample\n\ \n\ @seealso{terminal_size}\n\ @end deftypefn") @@ -904,9 +923,9 @@ } /* -%!error <Invalid call to list_in_columns.*> list_in_columns (); -%!error <Invalid call to list_in_columns.*> list_in_columns (["abc", "def"], 20, 2); -%!error <invalid conversion from string to real scalar.*> list_in_columns (["abc", "def"], "a"); +%!error <Invalid call to list_in_columns> list_in_columns (); +%!error <Invalid call to list_in_columns> list_in_columns (["abc", "def"], 20, 2); +%!error <invalid conversion from string to real scalar> list_in_columns (["abc", "def"], "a"); %!test %! input = {"abc", "def", "ghijkl", "mnop", "qrs", "tuv"}; %! result = "abc mnop\ndef qrs\nghijkl tuv\n";
--- a/src/symtab.cc +++ b/src/symtab.cc @@ -25,24 +25,25 @@ #include <config.h> #endif +#include "file-ops.h" +#include "file-stat.h" #include "oct-env.h" #include "oct-time.h" -#include "file-ops.h" -#include "file-stat.h" +#include "singleton-cleanup.h" +#include "debug.h" #include "defun.h" #include "dirfns.h" #include "input.h" #include "load-path.h" -#include "symtab.h" #include "ov-fcn.h" #include "ov-usr-fcn.h" #include "pager.h" #include "parse.h" #include "pt-arg-list.h" +#include "symtab.h" #include "unwind-prot.h" #include "utils.h" -#include "debug.h" symbol_table *symbol_table::instance = 0; @@ -70,6 +71,14 @@ static int Vignore_function_time_stamp = 1; void +symbol_table::scope_id_cache::create_instance (void) +{ + instance = new scope_id_cache (); + + singleton_cleanup_list::add (cleanup_instance); +} + +void symbol_table::symbol_record::symbol_record_rep::dump (std::ostream& os, const std::string& prefix) const { @@ -575,13 +584,16 @@ // variable // subfunction // private function +// class method // class constructor -// class method // legacy dispatch // command-line function // autoload function // function on the path // built-in function +// +// Matlab documentation states that constructors have higher precedence +// than methods, but that does not seem to be the case. octave_value symbol_table::fcn_info::fcn_info_rep::find (const octave_value_list& args, @@ -671,7 +683,7 @@ octave_value& fval = q->second; if (fval.is_defined ()) - out_of_date_check (fval); + out_of_date_check (fval, "", false); if (fval.is_defined ()) return fval; @@ -687,6 +699,18 @@ } } + // Class methods. + + if (! args.empty ()) + { + std::string dispatch_type = get_dispatch_type (args); + + octave_value fcn = find_method (dispatch_type); + + if (fcn.is_defined ()) + return fcn; + } + // Class constructors. The class name and function name are the same. str_val_iterator q = class_constructors.find (name); @@ -716,18 +740,6 @@ } } - // Class methods. - - if (! args.empty ()) - { - std::string dispatch_type = get_dispatch_type (args); - - octave_value fcn = find_method (dispatch_type); - - if (fcn.is_defined ()) - return fcn; - } - // Legacy dispatch. if (! args.empty () && ! dispatch_map.empty ()) @@ -1463,7 +1475,9 @@ { octave_value retval; - if (nargout > 0) + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) { switch (Vignore_function_time_stamp) { @@ -1481,8 +1495,6 @@ } } - int nargin = args.length (); - if (nargin == 1) { std::string sval = args(0).string_value (); @@ -1507,6 +1519,25 @@ return retval; } +/* +%!shared old_state +%! old_state = ignore_function_time_stamp (); +%!test +%! state = ignore_function_time_stamp ("all"); +%! assert (state, old_state); +%! assert (ignore_function_time_stamp (), "all"); +%! state = ignore_function_time_stamp ("system"); +%! assert (state, "all"); +%! assert (ignore_function_time_stamp (), "system"); +%! ignore_function_time_stamp (old_state); + +%% Test input validation +%!error (ignore_function_time_stamp ("all", "all")) +%!error (ignore_function_time_stamp ("UNKNOWN_VALUE")) +%!error (ignore_function_time_stamp (42)) + +*/ + DEFUN (__current_scope__, , , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {[@var{scope}, @var{context}]} __dump_symtab_info__ ()\n\
--- a/src/symtab.h +++ b/src/symtab.h @@ -31,12 +31,13 @@ #include <string> #include "glob-match.h" -#include "regex-match.h" +#include "regexp.h" class tree_argument_list; class octave_user_function; #include "oct-obj.h" +#include "oct-refcount.h" #include "ov.h" class @@ -81,12 +82,14 @@ return instance_ok () ? instance->do_scopes () : std::list<scope_id> (); } + static void create_instance (void); + static bool instance_ok (void) { bool retval = true; if (! instance) - instance = new scope_id_cache (); + create_instance (); if (! instance) { @@ -108,6 +111,8 @@ static scope_id_cache *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + // The next available scope not in the free list. scope_id next_available; @@ -383,7 +388,7 @@ fcn_info *finfo; - size_t count; + octave_refcount<size_t> count; private: @@ -724,7 +729,7 @@ octave_value built_in_function; - size_t count; + octave_refcount<size_t> count; private: @@ -790,6 +795,11 @@ return rep->built_in_function; } + octave_value find_cmdline_function (void) const + { + return rep->cmdline_function; + } + octave_value find_autoload (void) { return rep->find_autoload (); @@ -1674,7 +1684,7 @@ { std::list<symbol_record> retval; - regex_match pat (pattern); + ::regexp pat (pattern); for (global_table_const_iterator p = global_table.begin (); p != global_table.end (); p++) @@ -1683,7 +1693,7 @@ // the results from regexp_variables and regexp_global_variables // may be handled the same way. - if (pat.match (p->first)) + if (pat.is_match (p->first)) retval.push_back (symbol_record (p->first, p->second, symbol_record::global)); } @@ -1787,6 +1797,25 @@ return retval; } + static std::list<std::string> cmdline_function_names (void) + { + std::list<std::string> retval; + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + octave_value fcn = p->second.find_cmdline_function (); + + if (fcn.is_defined ()) + retval.push_back (p->first); + } + + if (! retval.empty ()) + retval.sort (); + + return retval; + } + static bool is_local_variable (const std::string& name) { if (xcurrent_scope == xglobal_scope) @@ -2286,7 +2315,7 @@ void do_clear_variable_regexp (const std::string& pat) { - regex_match pattern (pat); + ::regexp pattern (pat); for (table_iterator p = table.begin (); p != table.end (); p++) { @@ -2294,7 +2323,7 @@ if (sr.is_defined () || sr.is_global ()) { - if (pattern.match (sr.name ())) + if (pattern.is_match (sr.name ())) sr.clear (); } } @@ -2361,11 +2390,11 @@ { std::list<symbol_record> retval; - regex_match pat (pattern); + ::regexp pat (pattern); for (table_const_iterator p = table.begin (); p != table.end (); p++) { - if (pat.match (p->first)) + if (pat.is_match (p->first)) { const symbol_record& sr = p->second;
--- a/src/syscalls.cc +++ b/src/syscalls.cc @@ -145,8 +145,8 @@ int status = octave_syscalls::dup2 (i_old, i_new, msg); + retval(1) = msg; retval(0) = status; - retval(1) = msg; } } } @@ -224,8 +224,8 @@ int status = octave_syscalls::execvp (exec_file, exec_args, msg); + retval(1) = msg; retval(0) = status; - retval(1) = msg; } } else @@ -347,9 +347,9 @@ Cell file_ids (1, 2); - retval(0) = octave_stream_list::insert (os); + retval(2) = pid; retval(1) = octave_stream_list::insert (is); - retval(2) = pid; + retval(0) = octave_stream_list::insert (os); } else error (msg.c_str ()); @@ -496,8 +496,8 @@ int status = octave_fcntl (fid, req, arg, msg); + retval(1) = msg; retval(0) = status; - retval(1) = msg; } } } @@ -546,8 +546,8 @@ pid_t pid = octave_syscalls::fork (msg); + retval(1) = msg; retval(0) = pid; - retval(1) = msg; } else print_usage (); @@ -572,8 +572,8 @@ { std::string msg; + retval(1) = msg; retval(0) = octave_syscalls::getpgrp (msg); - retval(1) = msg; } else print_usage (); @@ -865,10 +865,9 @@ octave_stream os = octave_stdiostream::create (nm, ofile, std::ios::out); + retval(2) = status; retval(1) = octave_stream_list::insert (os); retval(0) = octave_stream_list::insert (is); - - retval(2) = status; } } else @@ -968,7 +967,7 @@ dev = 2049\n\ @}\n\ @result{} err = 0\n\ - @result{} msg = \n\ + @result{} msg =\n\ @end example\n\ @end deftypefn") { @@ -1182,8 +1181,8 @@ DEFUN (gethostname, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{uts}, @var{err}, @var{msg}] =} uname ()\n\ -Return the hostname of the system on which Octave is running\n\ +@deftypefn {Built-in Function} {} gethostname ()\n\ +Return the hostname of the system where Octave is running.\n\ @end deftypefn") { octave_value retval; @@ -1270,8 +1269,8 @@ int status = octave_unlink (name, msg); + retval(1) = msg; retval(0) = status; - retval(1) = msg; } else error ("unlink: FILE must be a string"); @@ -1354,9 +1353,9 @@ pid_t result = octave_syscalls::waitpid (pid, &status, options, msg); - retval(0) = result; + retval(2) = msg; retval(1) = status; - retval(2) = msg; + retval(0) = result; } else error ("waitpid: OPTIONS must be an integer"); @@ -1644,7 +1643,6 @@ #define O_NONBLOCK O_NDELAY #endif -#if defined (F_DUPFD) DEFUNX ("F_DUPFD", FF_DUPFD, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} F_DUPFD ()\n\ @@ -1653,11 +1651,14 @@ @seealso{fcntl, F_GETFD, F_GETFL, F_SETFD, F_SETFL}\n\ @end deftypefn") { +#if defined (F_DUPFD) return const_value (args, F_DUPFD); -} +#else + error ("F_DUPFD: not available on this system"); + return octave_value (); #endif +} -#if defined (F_GETFD) DEFUNX ("F_GETFD", FF_GETFD, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} F_GETFD ()\n\ @@ -1666,11 +1667,14 @@ @seealso{fcntl, F_DUPFD, F_GETFL, F_SETFD, F_SETFL}\n\ @end deftypefn") { +#if defined (F_GETFD) return const_value (args, F_GETFD); -} +#else + error ("F_GETFD: not available on this system"); + return octave_value (); #endif +} -#if defined (F_GETFL) DEFUNX ("F_GETFL", FF_GETFL, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} F_GETFL ()\n\ @@ -1679,11 +1683,14 @@ @seealso{fcntl, F_DUPFD, F_GETFD, F_SETFD, F_SETFL}\n\ @end deftypefn") { +#if defined (F_GETFL) return const_value (args, F_GETFL); -} +#else + error ("F_GETFL: not available on this system"); + return octave_value (); #endif +} -#if defined (F_SETFD) DEFUNX ("F_SETFD", FF_SETFD, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} F_SETFD ()\n\ @@ -1692,11 +1699,14 @@ @seealso{fcntl, F_DUPFD, F_GETFD, F_GETFL, F_SETFL}\n\ @end deftypefn") { +#if defined (F_SETFD) return const_value (args, F_SETFD); -} +#else + error ("F_SETFD: not available on this system"); + return octave_value (); #endif +} -#if defined (F_SETFL) DEFUNX ("F_SETFL", FF_SETFL, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} F_SETFL ()\n\ @@ -1705,11 +1715,14 @@ @seealso{fcntl, F_DUPFD, F_GETFD, F_GETFL, F_SETFD}\n\ @end deftypefn") { +#if defined (F_SETFL) return const_value (args, F_SETFL); -} +#else + error ("F_SETFL: not available on this system"); + return octave_value (); #endif +} -#if defined (O_APPEND) DEFUNX ("O_APPEND", FO_APPEND, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} O_APPEND ()\n\ @@ -1719,11 +1732,14 @@ @seealso{fcntl, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ @end deftypefn") { +#if defined (O_APPEND) return const_value (args, O_APPEND); -} +#else + error ("O_APPEND: not available on this system"); + return octave_value (); #endif +} -#if defined (O_ASYNC) DEFUNX ("O_ASYNC", FO_ASYNC, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} O_ASYNC ()\n\ @@ -1732,11 +1748,14 @@ @seealso{fcntl, O_APPEND, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ @end deftypefn") { +#if defined (O_ASYNC) return const_value (args, O_ASYNC); -} +#else + error ("O_ASYNC: not available on this system"); + return octave_value (); #endif +} -#if defined (O_CREAT) DEFUNX ("O_CREAT", FO_CREAT, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} O_CREAT ()\n\ @@ -1746,11 +1765,14 @@ @seealso{fcntl, O_APPEND, O_ASYNC, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ @end deftypefn") { +#if defined (O_CREAT) return const_value (args, O_CREAT); -} +#else + error ("O_CREAT: not available on this system"); + return octave_value (); #endif +} -#if defined (O_EXCL) DEFUNX ("O_EXCL", FO_EXCL, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} O_EXCL ()\n\ @@ -1759,11 +1781,14 @@ @seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ @end deftypefn") { +#if defined (O_EXCL) return const_value (args, O_EXCL); -} +#else + error ("O_EXCL: not available on this system"); + return octave_value (); #endif +} -#if defined (O_NONBLOCK) DEFUNX ("O_NONBLOCK", FO_NONBLOCK, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} O_NONBLOCK ()\n\ @@ -1773,11 +1798,14 @@ @seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ @end deftypefn") { +#if defined (O_NONBLOCK) return const_value (args, O_NONBLOCK); -} +#else + error ("O_NONBLOCK: not available on this system"); + return octave_value (); #endif +} -#if defined (O_RDONLY) DEFUNX ("O_RDONLY", FO_RDONLY, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} O_RDONLY ()\n\ @@ -1787,11 +1815,14 @@ @seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ @end deftypefn") { +#if defined (O_RDONLY) return const_value (args, O_RDONLY); -} +#else + error ("O_RDONLY: not available on this system"); + return octave_value (); #endif +} -#if defined (O_RDWR) DEFUNX ("O_RDWR", FO_RDWR, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} O_RDWR ()\n\ @@ -1801,11 +1832,14 @@ @seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_SYNC, O_TRUNC, O_WRONLY}\n\ @end deftypefn") { +#if defined (O_RDWR) return const_value (args, O_RDWR); -} +#else + error ("O_RDWR: not available on this system"); + return octave_value (); #endif +} -#if defined (O_SYNC) DEFUNX ("O_SYNC", FO_SYNC, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} O_SYNC ()\n\ @@ -1815,11 +1849,14 @@ @seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_TRUNC, O_WRONLY}\n\ @end deftypefn") { +#if defined (O_SYNC) return const_value (args, O_SYNC); -} +#else + error ("O_SYNC: not available on this system"); + return octave_value (); #endif +} -#if defined (O_TRUNC) DEFUNX ("O_TRUNC", FO_TRUNC, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} O_TRUNC ()\n\ @@ -1829,11 +1866,14 @@ @seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_WRONLY}\n\ @end deftypefn") { +#if defined (O_TRUNC) return const_value (args, O_TRUNC); -} +#else + error ("O_TRUNC: not available on this system"); + return octave_value (); #endif +} -#if defined (O_WRONLY) DEFUNX ("O_WRONLY", FO_WRONLY, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} O_WRONLY ()\n\ @@ -1843,9 +1883,13 @@ @seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC}\n\ @end deftypefn") { +#if defined (O_WRONLY) return const_value (args, O_WRONLY); +#else + error ("O_WRONLY: not available on this system"); + return octave_value (); +#endif } -#endif #if !defined (WNOHANG) #define WNOHANG 0
--- a/src/sysdep.cc +++ b/src/sysdep.cc @@ -101,28 +101,46 @@ #endif #if defined (__WIN32__) && ! defined (_POSIX_VERSION) + +#define WIN32_LEAN_AND_MEAN +#include <tlhelp32.h> + static void w32_set_octave_home (void) { - int n = 1024; - - std::string bin_dir (n, '\0'); + std::string bin_dir; - while (true) + HANDLE h = CreateToolhelp32Snapshot (TH32CS_SNAPMODULE +#ifdef TH32CS_SNAPMODULE32 + | TH32CS_SNAPMODULE32 +#endif + , 0); + + if (h != INVALID_HANDLE_VALUE) { - HMODULE hMod = GetModuleHandle ("octinterp"); - int status = GetModuleFileName (hMod, &bin_dir[0], n); + MODULEENTRY32 mod_info; + + ZeroMemory (&mod_info, sizeof (mod_info)); + mod_info.dwSize = sizeof (mod_info); - if (status < n) - { - bin_dir.resize (status); - break; - } - else - { - n *= 2; - bin_dir.resize (n); - } + if (Module32First (h, &mod_info)) + { + do + { + std::string mod_name (mod_info.szModule); + + if (mod_name.find ("octinterp") != std::string::npos) + { + bin_dir = mod_info.szExePath; + if (bin_dir[bin_dir.length () - 1] != '\\') + bin_dir.append (1, '\\'); + break; + } + } + while (Module32Next (h, &mod_info)); + } + + CloseHandle (h); } if (! bin_dir.empty ()) @@ -586,8 +604,16 @@ return retval; } + DEFALIAS (setenv, putenv); +/* +%!assert (ischar (getenv ("OCTAVE_HOME"))); +%!test +%! setenv ("dummy_variable_that_cannot_matter", "foobar"); +%! assert (getenv ("dummy_variable_that_cannot_matter"), "foobar"); +*/ + // FIXME -- perhaps kbhit should also be able to print a prompt? DEFUN (kbhit, args, , @@ -695,6 +721,12 @@ return retval; } +/* +%!error (pause (1, 2)); +%!test +%! pause (1); +*/ + DEFUN (sleep, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} sleep (@var{seconds})\n\ @@ -724,6 +756,13 @@ return retval; } +/* +%!error (sleep ()); +%!error (sleep (1, 2)); +%!test +%! sleep (1); +*/ + DEFUN (usleep, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} usleep (@var{microseconds})\n\ @@ -760,6 +799,13 @@ return retval; } +/* +%!error (usleep ()); +%!error (usleep (1, 2)); +%!test +%! usleep (1000); +*/ + // FIXME -- maybe this should only return 1 if IEEE floating // point functions really work. @@ -776,6 +822,10 @@ || flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian); } +/* +%!assert (islogical (isieee ())); +*/ + DEFUN (native_float_format, , , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} native_float_format ()\n\ @@ -787,6 +837,10 @@ return octave_value (oct_mach_info::float_format_as_string (flt_fmt)); } +/* +%!assert (ischar (native_float_format ())); +*/ + DEFUN (tilde_expand, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} tilde_expand (@var{string})\n\ @@ -835,3 +889,14 @@ return retval; } + +/* +%!test +%! if (isempty (getenv ("HOME"))) +%! setenv ("HOME", "foobar"); +%! endif +%! home = getenv ("HOME"); +%! assert (tilde_expand ("~/foobar"), strcat (home, "/foobar")); +%! assert (tilde_expand ("/foo/bar"), "/foo/bar"); +%! assert (tilde_expand ("foo/bar"), "foo/bar"); +*/
--- a/src/token.h +++ b/src/token.h @@ -45,11 +45,13 @@ { simple_end, classdef_end, + enumeration_end, events_end, for_end, function_end, if_end, methods_end, + parfor_end, properties_end, switch_end, while_end,
--- a/src/toplev.cc +++ b/src/toplev.cc @@ -39,29 +39,32 @@ #include <unistd.h> #include "cmd-edit.h" +#include "cmd-hist.h" #include "file-ops.h" #include "lo-error.h" #include "lo-mappers.h" #include "oct-env.h" +#include "oct-locbuf.h" #include "quit.h" +#include "singleton-cleanup.h" #include "str-vec.h" -#include "oct-locbuf.h" -#include <defaults.h> +#include "defaults.h" #include "defun.h" #include "error.h" #include "file-io.h" +#include "graphics.h" #include "input.h" #include "lex.h" -#include <oct-conf.h> +#include "oct-conf.h" #include "oct-hist.h" #include "oct-map.h" #include "oct-obj.h" +#include "ov.h" #include "pager.h" #include "parse.h" #include "pathsearch.h" #include "procstream.h" -#include "ov.h" #include "pt-eval.h" #include "pt-jump.h" #include "pt-stmt.h" @@ -72,7 +75,7 @@ #include "unwind-prot.h" #include "utils.h" #include "variables.h" -#include <version.h> +#include "version.h" void (*octave_exit) (int) = ::exit; @@ -96,6 +99,19 @@ octave_call_stack *octave_call_stack::instance = 0; +void +octave_call_stack::create_instance (void) +{ + instance = new octave_call_stack (); + + if (instance) + { + instance->do_push (0, symbol_table::top_scope (), 0); + + singleton_cleanup_list::add (cleanup_instance); + } +} + int octave_call_stack::do_current_line (void) const { @@ -570,11 +586,13 @@ { if (global_command) { - global_command->accept (*current_evaluator); + // Use an unwind-protect cleanup function so that the + // global_command list will be deleted in the event of + // an interrupt. - delete global_command; + frame.add_fcn (cleanup_statement_list, &global_command); - global_command = 0; + global_command->accept (*current_evaluator); octave_quit (); @@ -644,25 +662,6 @@ return retval; } -// Call a function with exceptions handled to avoid problems with -// errors while shutting down. - -#define IGNORE_EXCEPTION(E) \ - catch (E) \ - { \ - std::cerr << "error: ignoring " #E " while preparing to exit" << std::endl; \ - recover_from_exception (); \ - } - -#define SAFE_CALL(F, ARGS) \ - try \ - { \ - F ARGS; \ - } \ - IGNORE_EXCEPTION (octave_interrupt_exception) \ - IGNORE_EXCEPTION (octave_execution_exception) \ - IGNORE_EXCEPTION (std::bad_alloc) - // Fix up things before exiting. void @@ -670,11 +669,6 @@ { do_octave_atexit (); - // Clean up symbol table. - SAFE_CALL (symbol_table::cleanup, ()); - - SAFE_CALL (sysdep_cleanup, ()) - if (octave_exit) (*octave_exit) (retval == EOF ? 0 : retval); } @@ -704,9 +698,13 @@ if (! error_state) { - quitting_gracefully = true; + // Instead of simply calling exit, we simulate an interrupt + // with a request to exit cleanly so that no matter where the + // call to quit occurs, we will run the unwind_protect stack, + // clear the OCTAVE_LOCAL_BUFFER allocations, etc. before + // exiting. - // Simulate interrupt. + quitting_gracefully = true; octave_interrupt_state = -1; @@ -815,8 +813,8 @@ else cmd_status = 127; + retval(1) = output_buf.str (); retval(0) = cmd_status; - retval(1) = output_buf.str (); } else error ("unable to start subprocess for `%s'", cmd_str.c_str ()); @@ -828,31 +826,36 @@ DEFUN (system, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{status}, @var{output}]} system (@var{string}, @var{return_output}, @var{type})\n\ -@deftypefnx {Built-in Function} {[@var{status}, @var{output}]} shell_cmd (@var{string}, @var{return_output}, @var{type})\n\ +@deftypefn {Built-in Function} {} system (\"@var{string}\")\n\ +@deftypefnx {Built-in Function} {} system (\"@var{string}\", @var{return_output})\n\ +@deftypefnx {Built-in Function} {} system (\"@var{string}\", @var{return_output}, @var{type})\n\ +@deftypefnx {Built-in Function} {[@var{status}, @var{output}] =} system (@dots{})\n\ Execute a shell command specified by @var{string}.\n\ -If the optional argument @var{type} is @code{\"async\"}, the process\n\ -is started in the background and the process id of the child process\n\ -is returned immediately. Otherwise, the process is started, and\n\ -Octave waits until it exits. If the @var{type} argument is omitted, a\n\ -value of @code{\"sync\"} is assumed.\n\ +If the optional argument @var{type} is \"async\", the process\n\ +is started in the background and the process ID of the child process\n\ +is returned immediately. Otherwise, the child process is started and\n\ +Octave waits until it exits. If the @var{type} argument is omitted, it\n\ +defaults to the value \"sync\".\n\ \n\ -If the optional argument @var{return_output} is true and the subprocess\n\ -is started synchronously, or if @var{system} is called with one input\n\ -argument and one or more output arguments, the output from the command\n\ -is returned. Otherwise, if the subprocess is executed synchronously, its\n\ -output is sent to the standard output. To send the output of a command\n\ -executed with @code{system} through the pager, use a command like\n\ +If @var{system} is called with one or more output arguments, or if the\n\ +optional argument @var{return_output} is true and the subprocess is started\n\ +synchronously, then the output from the command is returned as a variable. \n\ +Otherwise, if the subprocess is executed synchronously, its output is sent\n\ +to the standard output. To send the output of a command executed with\n\ +@code{system} through the pager, use a command like\n\ \n\ @example\n\ -disp (system (cmd, 1));\n\ +@group\n\ +[output, text] = system (\"cmd\");\n\ +disp (text);\n\ +@end group\n\ @end example\n\ \n\ @noindent\n\ or\n\ \n\ @example\n\ -printf (\"%s\\n\", system (cmd, 1));\n\ +printf (\"%s\\n\", nthargout (2, \"system\", \"cmd\"));\n\ @end example\n\ \n\ The @code{system} function can return two values. The first is the\n\ @@ -869,6 +872,7 @@ \n\ For commands run asynchronously, @var{status} is the process id of the\n\ command shell that is started to run the command.\n\ +@seealso{unix, dos}\n\ @end deftypefn") { octave_value_list retval; @@ -999,7 +1003,17 @@ return retval; } -DEFALIAS (shell_cmd, system); +/* +%!test +%! cmd = ls_command (); +%! [status, output] = system (cmd); +%! assert (status, 0); +%! assert (ischar (output)); +%! assert (! isempty (output)); + +%!error system () +%!error system (1, 2, 3) +*/ // FIXME -- this should really be static, but that causes // problems on some systems. @@ -1016,11 +1030,11 @@ octave_atexit_functions.pop_front (); - SAFE_CALL (reset_error_handler, ()) + OCTAVE_SAFE_CALL (reset_error_handler, ()); - SAFE_CALL (feval, (fcn, octave_value_list (), 0)) + OCTAVE_SAFE_CALL (feval, (fcn, octave_value_list (), 0)); - SAFE_CALL (flush_octave_stdout, ()) + OCTAVE_SAFE_CALL (flush_octave_stdout, ()); } if (! deja_vu) @@ -1030,23 +1044,33 @@ // Do this explicitly so that destructors for mex file objects // are called, so that functions registered with mexAtExit are // called. - SAFE_CALL (clear_mex_functions, ()) + OCTAVE_SAFE_CALL (clear_mex_functions, ()); - SAFE_CALL (command_editor::restore_terminal_state, ()) + OCTAVE_SAFE_CALL (command_editor::restore_terminal_state, ()); // FIXME -- is this needed? Can it cause any trouble? - SAFE_CALL (raw_mode, (0)) + OCTAVE_SAFE_CALL (raw_mode, (0)); + + OCTAVE_SAFE_CALL (octave_history_write_timestamp, ()); - SAFE_CALL (octave_history_write_timestamp, ()) + if (! command_history::ignoring_entries ()) + OCTAVE_SAFE_CALL (command_history::clean_up_and_save, ()); + + OCTAVE_SAFE_CALL (gh_manager::close_all_figures, ()); + + OCTAVE_SAFE_CALL (gtk_manager::unload_all_toolkits, ()); - if (Vsaving_history) - SAFE_CALL (command_history::clean_up_and_save, ()) + OCTAVE_SAFE_CALL (close_files, ()); + + OCTAVE_SAFE_CALL (cleanup_tmp_files, ()); + + OCTAVE_SAFE_CALL (symbol_table::cleanup, ()); - SAFE_CALL (close_files, ()) + OCTAVE_SAFE_CALL (cleanup_parser, ()); - SAFE_CALL (cleanup_tmp_files, ()) + OCTAVE_SAFE_CALL (sysdep_cleanup, ()); - SAFE_CALL (flush_octave_stdout, ()) + OCTAVE_SAFE_CALL (flush_octave_stdout, ()); if (! quitting_gracefully && (interactive || forced_interactive)) { @@ -1055,8 +1079,12 @@ // Yes, we want this to be separate from the call to // flush_octave_stdout above. - SAFE_CALL (flush_octave_stdout, ()) + OCTAVE_SAFE_CALL (flush_octave_stdout, ()); } + + OCTAVE_SAFE_CALL (singleton_cleanup_list::cleanup, ()); + + OCTAVE_SAFE_CALL (octave_chunk_buffer::clear, ()); } } @@ -1285,6 +1313,10 @@ { false, "MAGICK_LDFLAGS", OCTAVE_CONF_MAGICK_LDFLAGS }, { false, "MAGICK_LIBS", OCTAVE_CONF_MAGICK_LIBS }, { false, "MKOCTFILE_DL_LDFLAGS", OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS }, + { false, "OCTAVE_LINK_DEPS", OCTAVE_CONF_OCTAVE_LINK_DEPS }, + { false, "OCTAVE_LINK_OPTS", OCTAVE_CONF_OCTAVE_LINK_OPTS }, + { false, "OCT_LINK_DEPS", OCTAVE_CONF_OCT_LINK_DEPS }, + { false, "OCT_LINK_OPTS", OCTAVE_CONF_OCT_LINK_OPTS }, { false, "OPENGL_LIBS", OCTAVE_CONF_OPENGL_LIBS }, { false, "PTHREAD_CFLAGS", OCTAVE_CONF_PTHREAD_CFLAGS }, { false, "PTHREAD_LIBS", OCTAVE_CONF_PTHREAD_LIBS }, @@ -1298,7 +1330,6 @@ { false, "RDYNAMIC_FLAG", OCTAVE_CONF_RDYNAMIC_FLAG }, { false, "READLINE_LIBS", OCTAVE_CONF_READLINE_LIBS }, { false, "REGEX_LIBS", OCTAVE_CONF_REGEX_LIBS }, - { false, "RLD_FLAG", OCTAVE_CONF_RLD_FLAG }, { false, "SED", OCTAVE_CONF_SED }, { false, "SHARED_LIBS", OCTAVE_CONF_SHARED_LIBS }, { false, "SHLEXT", OCTAVE_CONF_SHLEXT }, @@ -1439,6 +1470,15 @@ return retval; } +/* +%!error octave_config_info (1, 2); +%!assert (ischar (octave_config_info ("version"))); +%!test +%! x = octave_config_info (); +%! assert (isstruct (x)); +%! assert (! isempty (x)); +*/ + #if defined (__GNUG__) && defined (DEBUG_NEW_DELETE) int debug_new_delete = 0;
--- a/src/toplev.h +++ b/src/toplev.h @@ -112,22 +112,20 @@ typedef std::deque<call_stack_elt>::reverse_iterator reverse_iterator; typedef std::deque<call_stack_elt>::const_reverse_iterator const_reverse_iterator; + static void create_instance (void); + static bool instance_ok (void) { bool retval = true; if (! instance) - { - instance = new octave_call_stack (); + create_instance (); - if (instance) - instance->do_push (0, symbol_table::top_scope (), 0); - else - { - ::error ("unable to create call stack object!"); + if (! instance) + { + ::error ("unable to create call stack object!"); - retval = false; - } + retval = false; } return retval; @@ -300,6 +298,8 @@ static octave_call_stack *instance; + static void cleanup_instance (void) { delete instance; instance = 0; } + int do_current_line (void) const; int do_current_column (void) const; @@ -418,4 +418,38 @@ void do_backtrace_error_message (void) const; }; +// Call a function with exceptions handled to avoid problems with +// errors while shutting down. + +#define OCTAVE_IGNORE_EXCEPTION(E) \ + catch (E) \ + { \ + std::cerr << "error: ignoring " #E " while preparing to exit" << std::endl; \ + recover_from_exception (); \ + } + +#define OCTAVE_SAFE_CALL(F, ARGS) \ + do \ + { \ + try \ + { \ + unwind_protect frame; \ + \ + frame.protect_var (Vdebug_on_error); \ + frame.protect_var (Vdebug_on_warning); \ + \ + Vdebug_on_error = false; \ + Vdebug_on_warning = false; \ + \ + F ARGS; \ + } \ + OCTAVE_IGNORE_EXCEPTION (octave_interrupt_exception) \ + OCTAVE_IGNORE_EXCEPTION (octave_execution_exception) \ + OCTAVE_IGNORE_EXCEPTION (std::bad_alloc) \ + \ + if (error_state) \ + error_state = 0; \ + } \ + while (0) + #endif
--- a/src/txt-eng-ft.cc +++ b/src/txt-eng-ft.cc @@ -24,18 +24,47 @@ #include <config.h> #endif -#if HAVE_FREETYPE +#if defined (HAVE_FREETYPE) -#if HAVE_FONTCONFIG +#if defined (HAVE_FONTCONFIG) #include <fontconfig/fontconfig.h> #endif #include <iostream> +#include "singleton-cleanup.h" + #include "error.h" #include "pr-output.h" #include "txt-eng-ft.h" +// FIXME -- maybe issue at most one warning per glyph/font/size/weight +// combination. + +static void +gripe_missing_glyph (char c) +{ + warning_with_id ("Octave:missing-glyph", + "ft_render: skipping missing glyph for character `%c'", + c); +} + +static void +gripe_glyph_render (char c) +{ + warning_with_id ("Octave:glyph-render", + "ft_render: unable to render glyph for character `%c'", + c); +} + +#ifdef _MSC_VER +// This is just a trick to avoid multiply symbols definition. +// PermMatrix.h contains a dllexport'ed Array<octave_idx_type> +// that will make MSVC not to generate new instantiation and +// use the imported one. +#include "PermMatrix.h" +#endif + class ft_manager { @@ -45,7 +74,12 @@ bool retval = true; if (! instance) - instance = new ft_manager (); + { + instance = new ft_manager (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } if (! instance) { @@ -57,6 +91,8 @@ return retval; } + static void cleanup_instance (void) { delete instance; instance = 0; } + static FT_Face get_font (const std::string& name, const std::string& weight, const std::string& angle, double size) { return (instance_ok () @@ -75,37 +111,39 @@ ft_manager& operator = (const ft_manager&); - ft_manager (void) : library () -#if HAVE_FONTCONFIG - , fc_init_done (false) -#endif + ft_manager (void) + : library (), freetype_initialized (false), fontconfig_initialized (false) { if (FT_Init_FreeType (&library)) - { - ::error ("unable to initialize freetype library"); - } + ::error ("unable to initialize freetype library"); + else + freetype_initialized = true; -#if HAVE_FONTCONFIG - fc_init_done = false; +#if defined (HAVE_FONTCONFIG) if (! FcInit ()) - { - ::error ("unable to initialize fontconfig library"); - } + ::error ("unable to initialize fontconfig library"); else - { - fc_init_done = true; - } + fontconfig_initialized = true; #endif } ~ft_manager (void) { -#if HAVE_FONTCONFIG - FcFini (); - fc_init_done = false; + if (freetype_initialized) + FT_Done_FreeType (library); + +#if defined (HAVE_FONTCONFIG) + // FIXME -- Skip the call to FcFini because it can trigger the + // assertion + // + // octave: fccache.c:507: FcCacheFini: Assertion `fcCacheChains[i] == ((void *)0)' failed. + // + // if (fontconfig_initialized) + // FcFini (); #endif } + FT_Face do_get_font (const std::string& name, const std::string& weight, const std::string& angle, double size) { @@ -113,8 +151,8 @@ std::string file; -#if HAVE_FONTCONFIG - if (fc_init_done) +#if defined (HAVE_FONTCONFIG) + if (fontconfig_initialized) { int fc_weight, fc_angle; @@ -191,9 +229,8 @@ private: FT_Library library; -#if HAVE_FONTCONFIG - bool fc_init_done; -#endif + bool freetype_initialized; + bool fontconfig_initialized; }; ft_manager* ft_manager::instance = 0; @@ -202,7 +239,8 @@ ft_render::ft_render (void) : text_processor (), face (0), bbox (1, 4, 0.0), - xoffset (0), yoffset (0), mode (MODE_BBOX), + xoffset (0), yoffset (0), multiline_halign (0), + multiline_align_xoffsets(), mode (MODE_BBOX), red (0), green (0), blue (0) { } @@ -270,25 +308,47 @@ { if (face) { + int line_index = 0; + FT_UInt box_line_width = 0; std::string str = e.string_value (); FT_UInt glyph_index, previous = 0; + if (mode == MODE_BBOX) + multiline_align_xoffsets.clear(); + else if (mode == MODE_RENDER) + xoffset += multiline_align_xoffsets[line_index]; + for (size_t i = 0; i < str.length (); i++) { glyph_index = FT_Get_Char_Index (face, str[i]); - if (! glyph_index - || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT)) - ::warning ("ft_render: skipping missing glyph for character `%c'", - str[i]); + if (str[i] != '\n' + && (! glyph_index + || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT))) + gripe_missing_glyph (str[i]); else { switch (mode) { case MODE_RENDER: - if (FT_Render_Glyph (face->glyph, FT_RENDER_MODE_NORMAL)) - ::warning ("ft_render: unable to render glyph for character `%c'", - str[i]); + if (str[i] == '\n') + { + glyph_index = FT_Get_Char_Index(face, ' '); + if (!glyph_index || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT)) + { + gripe_missing_glyph (' '); + } + else + { + line_index++; + xoffset = multiline_align_xoffsets[line_index]; + yoffset -= (face->size->metrics.height >> 6); + } + } + else if (FT_Render_Glyph (face->glyph, FT_RENDER_MODE_NORMAL)) + { + gripe_glyph_render (str[i]); + } else { FT_Bitmap& bitmap = face->glyph->bitmap; @@ -304,6 +364,14 @@ x0 = xoffset+face->glyph->bitmap_left; y0 = yoffset+face->glyph->bitmap_top; + + // 'w' seems to have a negative -1 + // face->glyph->bitmap_left, this is so we don't + // index out of bound, and assumes we we allocated + // the right amount of horizontal space in the bbox. + if (x0 < 0) + x0 = 0; + for (int r = 0; r < bitmap.rows; r++) for (int c = 0; c < bitmap.width; c++) { @@ -327,43 +395,89 @@ break; case MODE_BBOX: - // width - if (previous) + if (str[i] == '\n') { - FT_Vector delta; - - FT_Get_Kerning (face, previous, glyph_index, FT_KERNING_DEFAULT, &delta); - bbox(2) += (delta.x >> 6); - } - bbox(2) += (face->glyph->advance.x >> 6); - - int asc, desc; - - if (false /*tight*/) - { - desc = face->glyph->metrics.horiBearingY - face->glyph->metrics.height; - asc = face->glyph->metrics.horiBearingY; + glyph_index = FT_Get_Char_Index(face, ' '); + if (! glyph_index + || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT)) + { + gripe_missing_glyph (' '); + } + else + { + multiline_align_xoffsets.push_back(box_line_width); + // Reset the pixel width for this newline, so we don't + // allocate a bounding box larger than the horizontal + // width of the multi-line + box_line_width = 0; + bbox(1) -= (face->size->metrics.height >> 6); + } } else { - asc = face->size->metrics.ascender; - desc = face->size->metrics.descender; - } + // width + if (previous) + { + FT_Vector delta; - asc = yoffset + (asc >> 6); - desc = yoffset + (desc >> 6); + FT_Get_Kerning (face, previous, glyph_index, + FT_KERNING_DEFAULT, &delta); + + box_line_width += (delta.x >> 6); + } + + box_line_width += (face->glyph->advance.x >> 6); + + int asc, desc; - if (desc < bbox(1)) - { - bbox(3) += (bbox(1) - desc); - bbox(1) = desc; - } - if (asc > (bbox(3)+bbox(1))) - bbox(3) = asc-bbox(1); + if (false /*tight*/) + { + desc = face->glyph->metrics.horiBearingY - face->glyph->metrics.height; + asc = face->glyph->metrics.horiBearingY; + } + else + { + asc = face->size->metrics.ascender; + desc = face->size->metrics.descender; + } + + asc = yoffset + (asc >> 6); + desc = yoffset + (desc >> 6); + + if (desc < bbox(1)) + { + bbox(3) += (bbox(1) - desc); + bbox(1) = desc; + } + if (asc > (bbox(3)+bbox(1))) + bbox(3) = asc-bbox(1); + if (bbox(2) < box_line_width) + bbox(2) = box_line_width; + } break; } + if (str[i] == '\n') + previous = 0; + else + previous = glyph_index; + } + } + if (mode == MODE_BBOX) + { + /* Push last the width associated with the last line */ + multiline_align_xoffsets.push_back(box_line_width); - previous = glyph_index; + for (unsigned int i = 0; i < multiline_align_xoffsets.size(); i++) + { + /* Center align */ + if (multiline_halign == 1) + multiline_align_xoffsets[i] = (bbox(2) - multiline_align_xoffsets[i])/2; + /* Right align */ + else if (multiline_halign == 2) + multiline_align_xoffsets[i] = (bbox(2) - multiline_align_xoffsets[i]); + /* Left align */ + else + multiline_align_xoffsets[i] = 0; } } } @@ -480,7 +594,7 @@ text_element *elt = text_parser_none ().parse (txt); Matrix extent = get_extent (elt, rotation); delete elt; - + return extent; } @@ -507,6 +621,8 @@ // FIXME: clip "rotation" between 0 and 360 int rot_mode = rotation_to_mode (rotation); + multiline_halign = halign; + text_element *elt = text_parser_none ().parse (txt); pixels_ = render (elt, box, rot_mode); delete elt;
--- a/src/txt-eng-ft.h +++ b/src/txt-eng-ft.h @@ -25,6 +25,8 @@ #if HAVE_FREETYPE +#include <vector> + #include <ft2build.h> #include FT_FREETYPE_H @@ -94,6 +96,8 @@ uint8NDArray pixels; int xoffset; int yoffset; + int multiline_halign; + std::vector<int> multiline_align_xoffsets; int mode; uint8_t red, green, blue; };
--- a/src/utils.cc +++ b/src/utils.cc @@ -36,6 +36,8 @@ #include <sys/types.h> #include <unistd.h> +#include "vasnprintf.h" + #include "quit.h" #include "dir-ops.h" @@ -94,7 +96,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} isvarname (@var{name})\n\ Return true if @var{name} is a valid variable name.\n\ -@seealso{exist, who}\n\ +@seealso{iskeyword, exist, who}\n\ @end deftypefn") { octave_value retval; @@ -114,6 +116,17 @@ return retval; } +/* +%!error isvarname (); +%!error isvarname ("foo", "bar"); + +%!assert (isvarname ("foo"), true); +%!assert (isvarname ("_foo"), true); +%!assert (isvarname ("_1"), true); +%!assert (isvarname ("1foo"), false); +%!assert (isvarname (""), false); +*/ + // Return TRUE if F and G are both names for the same file. bool @@ -325,6 +338,24 @@ return retval; } +/* +%!error file_in_loadpath (); +%!error file_in_loadpath ("foo", "bar", 1); + +%!test +%! f = file_in_loadpath ("plot.m"); +%! assert (ischar (f)); +%! assert (! isempty (f)); + +%!test +%! f = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$"); +%! assert (f, ""); + +%!test +%! lst = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$", "all"); +%! assert (lst, {}); +*/ + DEFUN (file_in_path, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} file_in_path (@var{path}, @var{file})\n\ @@ -390,6 +421,25 @@ return retval; } +/* +%!error file_in_path (); +%!error file_in_path ("foo"); +%!error file_in_path ("foo", "bar", "baz", 1); + +%!test +%! f = file_in_path (path (), "plot.m"); +%! assert (ischar (f)); +%! assert (! isempty (f)); + +%!test +%! f = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$"); +%! assert (f, ""); + +%!test +%! lst = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$", "all"); +%! assert (lst, {}); +*/ + std::string file_in_path (const std::string& name, const std::string& suffix) { @@ -623,6 +673,22 @@ return retval; } +/* +%!error do_string_escapes (); +%!error do_string_escapes ("foo", "bar"); + +%!assert (do_string_escapes ('foo\nbar'), "foo\nbar"); +%!assert (do_string_escapes ("foo\\nbar"), "foo\nbar"); +%!assert (do_string_escapes ("foo\\nbar"), ["foo", char(10), "bar"]); +%!assert ("foo\nbar", ["foo", char(10), "bar"]); + +%!assert (do_string_escapes ('\a\b\f\n\r\t\v'), "\a\b\f\n\r\t\v"); +%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), "\a\b\f\n\r\t\v"); +%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), +%! char ([7, 8, 12, 10, 13, 9, 11])); +%!assert ("\a\b\f\n\r\t\v", char ([7, 8, 12, 10, 13, 9, 11])); +*/ + const char * undo_string_escape (char c) { @@ -729,6 +795,20 @@ return retval; } +/* +%!error undo_string_escapes (); +%!error undo_string_escapes ("foo", "bar"); + +%!assert (undo_string_escapes ("foo\nbar"), 'foo\nbar'); +%!assert (undo_string_escapes ("foo\nbar"), "foo\\nbar"); +%!assert (undo_string_escapes (["foo", char(10), "bar"]), "foo\\nbar"); + +%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), '\a\b\f\n\r\t\v'); +%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), "\\a\\b\\f\\n\\r\\t\\v"); +%!assert (undo_string_escapes (char ([7, 8, 12, 10, 13, 9, 11])), +%! "\\a\\b\\f\\n\\r\\t\\v"); +*/ + DEFUN (is_absolute_filename, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} is_absolute_filename (@var{file})\n\ @@ -747,6 +827,13 @@ return retval; } +/* +%!error is_absolute_filename (); +%!error is_absolute_filename ("foo", "bar"); + +FIXME -- we need system-dependent tests here. +*/ + DEFUN (is_rooted_relative_filename, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} is_rooted_relative_filename (@var{file})\n\ @@ -765,10 +852,18 @@ return retval; } +/* +%!error is_rooted_relative_filename (); +%!error is_rooted_relative_filename ("foo", "bar"); + +FIXME -- we need system-dependent tests here. +*/ + DEFUN (make_absolute_filename, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} make_absolute_filename (@var{file})\n\ Return the full name of @var{file}, relative to the current directory.\n\ +@seealso{is_absolute_filename, is_rooted_relative_filename, isdir}\n\ @end deftypefn") { octave_value retval = std::string (); @@ -788,9 +883,17 @@ return retval; } +/* +%!error make_absolute_filename (); +%!error make_absolute_filename ("foo", "bar"); + +FIXME -- we need system-dependent tests here. +*/ + DEFUN (find_dir_in_path, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} find_dir_in_path (@var{dir}, \"all\")\n\ +@deftypefn {Built-in Function} {} find_dir_in_path (@var{dir})\n\ +@deftypefnx {Built-in Function} {} find_dir_in_path (@var{dir}, \"all\")\n\ Return the full name of the path element matching @var{dir}. The\n\ match is performed at the end of each path element. For example, if\n\ @var{dir} is @code{\"foo/bar\"}, it matches the path element\n\ @@ -798,7 +901,7 @@ or @code{\"/some/dir/allfoo/bar\"}.\n\ \n\ The second argument is optional. If it is supplied, return a cell array\n\ -containing all the directory names that match.\n\ +containing all name matches rather than just the first.\n\ @end deftypefn") { octave_value retval = std::string (); @@ -827,6 +930,13 @@ return retval; } +/* +%!error find_dir_in_path (); +%!error find_dir_in_path ("foo", "bar", 1); + +FIXME -- need to create tests using current path, pathsep, and dirsep. +*/ + DEFUNX ("errno", Ferrno, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{err} =} errno ()\n\ @@ -871,6 +981,21 @@ return retval; } +/* +%!error errno ("foo", 1); + +%!assert (isnumeric (errno ())); + +%!test +%! lst = errno_list (); +%! fns = fieldnames (lst); +%! oldval = errno (fns{1}); +%! assert (isnumeric (oldval)); +%! errno (oldval); +%! newval = errno (); +%! assert (oldval, newval); +*/ + DEFUN (errno_list, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} errno_list ()\n\ @@ -887,6 +1012,12 @@ return retval; } +/* +%!error errno_list ("foo"); + +%!assert (isstruct (errno_list ())); +*/ + static void check_dimensions (octave_idx_type& nr, octave_idx_type& nc, const char *warnfor) { @@ -1033,79 +1164,6 @@ return retval; } -void -decode_subscripts (const char* name, const octave_value& arg, - std::string& type_string, - std::list<octave_value_list>& idx) -{ - const octave_map m = arg.map_value (); - - if (! error_state - && m.nfields () == 2 && m.contains ("type") && m.contains ("subs")) - { - const Cell type = m.contents ("type"); - const Cell subs = m.contents ("subs"); - - octave_idx_type nel = type.numel (); - - type_string = std::string (nel, '\0'); - - for (int k = 0; k < nel; k++) - { - std::string item = type(k).string_value (); - - if (! error_state) - { - if (item == "{}") - type_string[k] = '{'; - else if (item == "()") - type_string[k] = '('; - else if (item == ".") - type_string[k] = '.'; - else - { - error("%s: invalid indexing type `%s'", name, item.c_str ()); - return; - } - } - else - { - error ("%s: expecting type(%d) to be a character string", - name, k+1); - return; - } - - octave_value_list idx_item; - - if (subs(k).is_string ()) - idx_item(0) = subs(k); - else if (subs(k).is_cell ()) - { - Cell subs_cell = subs(k).cell_value (); - - for (int n = 0; n < subs_cell.length (); n++) - { - if (subs_cell(n).is_string () - && subs_cell(n).string_value () == ":") - idx_item(n) = octave_value(octave_value::magic_colon_t); - else - idx_item(n) = subs_cell(n); - } - } - else - { - error ("%s: expecting subs(%d) to be a character string or cell array", - name, k+1); - return; - } - - idx.push_back (idx_item); - } - } - else - error ("%s: second argument must be a structure with fields `type' and `subs'", name); -} - Matrix identity_matrix (octave_idx_type nr, octave_idx_type nc) { @@ -1138,10 +1196,10 @@ return m; } -int +size_t octave_format (std::ostream& os, const char *fmt, ...) { - int retval = -1; + size_t retval; va_list args; va_start (args, fmt); @@ -1153,121 +1211,43 @@ return retval; } -int +size_t octave_vformat (std::ostream& os, const char *fmt, va_list args) { - int retval = -1; + std::string s = octave_vasprintf (fmt, args); -#if defined (__GNUG__) && !CXX_ISO_COMPLIANT_LIBRARY + os << s; - std::streambuf *sb = os.rdbuf (); + return s.length (); +} - if (sb) - { - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; +std::string +octave_vasprintf (const char *fmt, va_list args) +{ + std::string retval; + + char *result; - retval = sb->vform (fmt, args); + int status = gnulib::vasprintf (&result, fmt, args); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + if (status >= 0) + { + retval = result; + ::free (result); } -#else - - char *s = octave_vsnprintf (fmt, args); - - if (s) - { - os << s; - - retval = strlen (s); - } - -#endif - return retval; } -// We manage storage. User should not free it, and its contents are -// only valid until next call to vsnprintf. - -// Interrupts might happen if someone makes a call with something that -// will require a very large buffer. If we are interrupted in that -// case, we should make the buffer size smaller for the next call. - -#define BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE_FOR_VSNPRINTF \ - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE_1; \ - delete [] buf; \ - buf = 0; \ - size = initial_size; \ - octave_rethrow_exception (); \ - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE_2 - -#if defined __GNUC__ && defined __va_copy -#define SAVE_ARGS(saved_args, args) __va_copy (saved_args, args) -#elif defined va_copy -#define SAVE_ARGS(saved_args, args) va_copy (saved_args, args) -#else -#define SAVE_ARGS(saved_args, args) saved_args = args -#endif - -char * -octave_vsnprintf (const char *fmt, va_list args) +std::string +octave_asprintf (const char *fmt, ...) { - static const size_t initial_size = 100; - - static size_t size = initial_size; - - static char *buf = 0; - - volatile int nchars = 0; - - if (! buf) - buf = new char [size]; - - if (! buf) - return 0; - - while (1) - { - va_list saved_args; - - SAVE_ARGS (saved_args, args); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE_FOR_VSNPRINTF; - - nchars = octave_raw_vsnprintf (buf, size, fmt, saved_args); - - va_end (saved_args); - - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - if (nchars > -1 && nchars < size) - break; - else - { - delete [] buf; - - size = nchars + 1;; - - buf = new char [size]; - - if (! buf) - return 0; - } - } - - return buf; -} - -char * -octave_snprintf (const char *fmt, ...) -{ - char *retval = 0; + std::string retval; va_list args; va_start (args, fmt); - retval = octave_vsnprintf (fmt, args); + retval = octave_vasprintf (fmt, args); va_end (args); @@ -1350,6 +1330,14 @@ return retval; } +/* +%!error isindex (); + +%!assert (isindex ([1, 2, 3])); +%!assert (isindex (1:3)); +%!assert (isindex ([1, 2, -3]), false); +*/ + octave_value_list do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), const char *fun_name, const octave_value_list& args,
--- a/src/utils.h +++ b/src/utils.h @@ -97,26 +97,22 @@ extern OCTINTERP_API octave_idx_type dims_to_numel (const dim_vector& dims, const octave_value_list& idx); -extern OCTINTERP_API void -decode_subscripts (const char* name, const octave_value& arg, - std::string& type_string, - std::list<octave_value_list>& idx); - extern OCTINTERP_API Matrix identity_matrix (octave_idx_type nr, octave_idx_type nc); extern OCTINTERP_API FloatMatrix float_identity_matrix (octave_idx_type nr, octave_idx_type nc); -extern OCTINTERP_API int +extern OCTINTERP_API size_t octave_format (std::ostream& os, const char *fmt, ...); -extern OCTINTERP_API int +extern OCTINTERP_API size_t octave_vformat (std::ostream& os, const char *fmt, va_list args); -extern OCTINTERP_API char *octave_vsnprintf (const char *fmt, va_list args); +extern OCTINTERP_API std::string +octave_vasprintf (const char *fmt, va_list args); -extern OCTINTERP_API char *octave_snprintf (const char *fmt, ...); +extern OCTINTERP_API std::string octave_asprintf (const char *fmt, ...); extern OCTINTERP_API void octave_sleep (double seconds);
--- a/src/variables.cc +++ b/src/variables.cc @@ -36,7 +36,7 @@ #include "oct-env.h" #include "file-ops.h" #include "glob-match.h" -#include "regex-match.h" +#include "regexp.h" #include "str-vec.h" #include <defaults.h> @@ -416,7 +416,9 @@ && var_ok && (type == "any" || type == "var") && (val.is_constant () || val.is_object () - || val.is_inline_function () || val.is_function_handle ())) + || val.is_function_handle () + || val.is_anonymous_function () + || val.is_inline_function ())) { retval = 1; } @@ -546,6 +548,7 @@ @item \"dir\"\n\ Check only for directories.\n\ @end table\n\ +@seealso{file_in_loadpath}\n\ @end deftypefn") { octave_value retval = false; @@ -1042,11 +1045,12 @@ const std::string& expr_str = std::string (), const octave_value& expr_val = octave_value ()) : name (expr_str.empty () ? sr.name () : expr_str), + varval (expr_val.is_undefined () ? sr.varval () : expr_val), is_automatic (sr.is_automatic ()), + is_complex (varval.is_complex_type ()), is_formal (sr.is_formal ()), is_global (sr.is_global ()), - is_persistent (sr.is_persistent ()), - varval (expr_val.is_undefined () ? sr.varval () : expr_val) + is_persistent (sr.is_persistent ()) { } void display_line (std::ostream& os, @@ -1116,13 +1120,14 @@ { case 'a': { - char tmp[5]; + char tmp[6]; tmp[0] = (is_automatic ? 'a' : ' '); - tmp[1] = (is_formal ? 'f' : ' '); - tmp[2] = (is_global ? 'g' : ' '); - tmp[3] = (is_persistent ? 'p' : ' '); - tmp[4] = 0; + tmp[1] = (is_complex ? 'c' : ' '); + tmp[2] = (is_formal ? 'f' : ' '); + tmp[3] = (is_global ? 'g' : ' '); + tmp[4] = (is_persistent ? 'p' : ' '); + tmp[5] = 0; os << tmp; } @@ -1171,11 +1176,12 @@ } std::string name; + octave_value varval; bool is_automatic; + bool is_complex; bool is_formal; bool is_global; bool is_persistent; - octave_value varval; }; public: @@ -1332,6 +1338,9 @@ for (size_t i = 0; i < param_string.length (); i++) param_length(i) = param_names(i) . length (); + // The attribute column needs size 5. + param_length(pos_a) = 5; + // Calculating necessary spacing for name column, // bytes column, elements column and class column @@ -1755,7 +1764,7 @@ \n\ If called as a function, return a cell array of defined variable names\n\ matching the given patterns.\n\ -@seealso{whos, regexp}\n\ +@seealso{whos, isglobal, isvarname, exist, regexp}\n\ @end deftypefn") { octave_value retval; @@ -1797,6 +1806,9 @@ Automatic variable. An automatic variable is one created by the\n\ interpreter, for example @code{argn}.\n\ \n\ +@item @code{c}\n\ +Variable of complex type.\n\ +\n\ @item @code{f}\n\ Formal parameter (function argument).\n\ \n\ @@ -1827,7 +1839,7 @@ \n\ If @code{whos} is called as a function, return a struct array of defined\n\ variable names matching the given patterns. Fields in the structure\n\ -describing each variable are: name, size, bytes, class, global, sparse, \n\ +describing each variable are: name, size, bytes, class, global, sparse,\n\ complex, nesting, persistent.\n\ @seealso{who, whos_line_format}\n\ @end deftypefn") @@ -1954,8 +1966,9 @@ DEFUN (munlock, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} munlock (@var{fcn})\n\ -Unlock the named function. If no function is named\n\ +@deftypefn {Built-in Function} {} munlock ()\n\ +@deftypefnx {Built-in Function} {} munlock (@var{fcn})\n\ +Unlock the named function @var{fcn}. If no function is named\n\ then unlock the current function.\n\ @seealso{mlock, mislocked, persistent}\n\ @end deftypefn") @@ -1989,9 +2002,10 @@ DEFUN (mislocked, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mislocked (@var{fcn})\n\ -Return true if the named function is locked. If no function is named\n\ -then return true if the current function is locked.\n\ +@deftypefn {Built-in Function} {} mislocked ()\n\ +@deftypefnx {Built-in Function} {} mislocked (@var{fcn})\n\ +Return true if the named function @var{fcn} is locked. If no function is\n\ +named then return true if the current function is locked.\n\ @seealso{mlock, munlock, persistent}\n\ @end deftypefn") { @@ -2036,9 +2050,7 @@ { if (have_regexp) { - regex_match pattern (patstr); - - if (pattern.match (nm)) + if (is_regexp_match (patstr, nm)) { retval = true; break; @@ -2262,7 +2274,7 @@ Match the list of characters specified by @var{list}. If the first\n\ character is @code{!} or @code{^}, match all characters except those\n\ specified by @var{list}. For example, the pattern @samp{[a-zA-Z]} will\n\ -match all lower and upper case alphabetic characters.\n\ +match all lowercase and uppercase alphabetic characters.\n\ @end table\n\ \n\ For example, the command\n\ @@ -2310,7 +2322,7 @@ The arguments are treated as regular expressions as any variables that\n\ match will be cleared.\n\ @end table\n\ -With the exception of @code{exclusive}, all long options can be used \n\ +With the exception of @code{exclusive}, all long options can be used\n\ without the dash as well.\n\ @end deftypefn") { @@ -2448,6 +2460,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} whos_line_format ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} whos_line_format (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} whos_line_format (@var{new_val}, \"local\")\n\ Query or set the format string used by the command @code{whos}.\n\ \n\ A full format string is:\n\ @@ -2509,6 +2522,10 @@ \n\ The default format is\n\ @code{\" %a:4; %ln:6; %cs:16:6:1; %rb:12; %lc:-1;\\n\"}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @seealso{whos}\n\ @end deftypefn") { @@ -2521,8 +2538,13 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} missing_function_hook ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} missing_function_hook (@var{new_val})\n\ -Query or set the internal variable that allows setting a custom hook function\n\ -called when an uknown identifier is requested.\n\ +@deftypefnx {Built-in Function} {} missing_function_hook (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the function to call when\n\ +an unknown identifier is requested.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (missing_function_hook);
--- a/src/version.h.in +++ b/src/version.h.in @@ -87,6 +87,8 @@ #define OCTAVE_STARTUP_MESSAGE \ X_OCTAVE_NAME_VERSION_COPYRIGHT_COPYING_WARRANTY_AND_BUGS \ (" For details, type `warranty'.") "\n\n" \ - "For information about changes from previous versions, type `news'." - + "For information about changes from previous versions, type `news'.\n\n\ +** WARNING ** Semantics for arithmetic operators have changed and now\n\ + broadcast. Type `doc broadcast' to get a description of\n\ + the changes." #endif
--- a/src/xdiv.cc +++ b/src/xdiv.cc @@ -64,14 +64,14 @@ template <class T1, class T2> bool -mx_leftdiv_conform (const T1& a, const T2& b) +mx_leftdiv_conform (const T1& a, const T2& b, blas_trans_type blas_trans) { - octave_idx_type a_nr = a.rows (); + octave_idx_type a_nr = blas_trans == blas_no_trans ? a.rows () : a.cols (); octave_idx_type b_nr = b.rows (); if (a_nr != b_nr) { - octave_idx_type a_nc = a.cols (); + octave_idx_type a_nc = blas_trans == blas_no_trans ? a.cols () : a.rows (); octave_idx_type b_nc = b.cols (); gripe_nonconformant ("operator \\", a_nr, a_nc, b_nr, b_nc); @@ -82,7 +82,7 @@ } #define INSTANTIATE_MX_LEFTDIV_CONFORM(T1, T2) \ - template bool mx_leftdiv_conform (const T1&, const T2&) + template bool mx_leftdiv_conform (const T1&, const T2&, blas_trans_type) INSTANTIATE_MX_LEFTDIV_CONFORM (Matrix, Matrix); INSTANTIATE_MX_LEFTDIV_CONFORM (Matrix, ComplexMatrix); @@ -352,7 +352,7 @@ Matrix xleftdiv (const Matrix& a, const Matrix& b, MatrixType &typ, blas_trans_type transt) { - if (! mx_leftdiv_conform (a, b)) + if (! mx_leftdiv_conform (a, b, transt)) return Matrix (); octave_idx_type info; @@ -364,7 +364,7 @@ ComplexMatrix xleftdiv (const Matrix& a, const ComplexMatrix& b, MatrixType &typ, blas_trans_type transt) { - if (! mx_leftdiv_conform (a, b)) + if (! mx_leftdiv_conform (a, b, transt)) return ComplexMatrix (); octave_idx_type info; @@ -377,7 +377,7 @@ ComplexMatrix xleftdiv (const ComplexMatrix& a, const Matrix& b, MatrixType &typ, blas_trans_type transt) { - if (! mx_leftdiv_conform (a, b)) + if (! mx_leftdiv_conform (a, b, transt)) return ComplexMatrix (); octave_idx_type info; @@ -389,7 +389,7 @@ ComplexMatrix xleftdiv (const ComplexMatrix& a, const ComplexMatrix& b, MatrixType &typ, blas_trans_type transt) { - if (! mx_leftdiv_conform (a, b)) + if (! mx_leftdiv_conform (a, b, transt)) return ComplexMatrix (); octave_idx_type info; @@ -650,7 +650,7 @@ FloatMatrix xleftdiv (const FloatMatrix& a, const FloatMatrix& b, MatrixType &typ, blas_trans_type transt) { - if (! mx_leftdiv_conform (a, b)) + if (! mx_leftdiv_conform (a, b, transt)) return FloatMatrix (); octave_idx_type info; @@ -662,7 +662,7 @@ FloatComplexMatrix xleftdiv (const FloatMatrix& a, const FloatComplexMatrix& b, MatrixType &typ, blas_trans_type transt) { - if (! mx_leftdiv_conform (a, b)) + if (! mx_leftdiv_conform (a, b, transt)) return FloatComplexMatrix (); octave_idx_type info; @@ -675,7 +675,7 @@ FloatComplexMatrix xleftdiv (const FloatComplexMatrix& a, const FloatMatrix& b, MatrixType &typ, blas_trans_type transt) { - if (! mx_leftdiv_conform (a, b)) + if (! mx_leftdiv_conform (a, b, transt)) return FloatComplexMatrix (); octave_idx_type info; @@ -687,7 +687,7 @@ FloatComplexMatrix xleftdiv (const FloatComplexMatrix& a, const FloatComplexMatrix& b, MatrixType &typ, blas_trans_type transt) { - if (! mx_leftdiv_conform (a, b)) + if (! mx_leftdiv_conform (a, b, transt)) return FloatComplexMatrix (); octave_idx_type info; @@ -782,7 +782,7 @@ MT dmm_leftdiv_impl (const DMT& d, const MT& a) { - if (! mx_leftdiv_conform (d, a)) + if (! mx_leftdiv_conform (d, a, blas_no_trans)) return MT (); octave_idx_type m = d.cols (), n = a.cols (), k = a.rows (), l = d.length (); @@ -931,7 +931,7 @@ MT dmdm_leftdiv_impl (const DMT& d, const MT& a) { - if (! mx_leftdiv_conform (d, a)) + if (! mx_leftdiv_conform (d, a, blas_no_trans)) return MT (); octave_idx_type m = d.cols (), n = a.cols (), k = d.rows ();
--- a/src/xpow.cc +++ b/src/xpow.cc @@ -49,6 +49,8 @@ #include "utils.h" #include "xpow.h" +#include "bsxfun.h" + #ifdef _OPENMP #include <omp.h> #endif @@ -102,7 +104,7 @@ octave_idx_type nc = b.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be square"); + error ("for x^A, A must be a square matrix"); else { EIG b_eig (b); @@ -153,7 +155,7 @@ octave_idx_type nc = b.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be square"); + error ("for x^A, A must be a square matrix"); else { EIG b_eig (b); @@ -192,7 +194,7 @@ octave_idx_type nc = a.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be square"); + error ("for A^b, A must be a square matrix"); else { if (static_cast<int> (b) == b) @@ -278,7 +280,7 @@ octave_idx_type nc = a.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be square"); + error ("for A^b, A must be a square matrix"); else { if (static_cast<int> (b) == b) @@ -322,7 +324,7 @@ octave_idx_type nc = a.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be square"); + error ("for A^b, A must be a square matrix"); else { EIG a_eig (a); @@ -370,7 +372,7 @@ octave_idx_type nc = b.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be square"); + error ("for x^A, A must be a square matrix"); else { EIG b_eig (b); @@ -418,7 +420,7 @@ octave_idx_type nc = b.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be square"); + error ("for x^A, A must be a square matrix"); else { EIG b_eig (b); @@ -457,7 +459,7 @@ octave_idx_type nc = a.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be square"); + error ("for A^b, A must be a square matrix"); else { if (static_cast<int> (b) == b) @@ -543,7 +545,7 @@ octave_idx_type nc = a.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be square"); + error ("for A^b, A must be a square matrix"); else { EIG a_eig (a); @@ -577,7 +579,7 @@ octave_idx_type nc = a.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be square"); + error ("for A^b, A must be a square matrix"); else { ComplexDiagMatrix r (nr, nc); @@ -1243,8 +1245,21 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + //Potentially complex results + NDArray xa = octave_value_extract<NDArray> (a); + NDArray xb = octave_value_extract<NDArray> (b); + if (! xb.all_integers () && xa.any_element_is_negative ()) + return octave_value (bsxfun_pow (ComplexNDArray (xa), xb)); + else + return octave_value (bsxfun_pow (xa, xb)); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } int len = a.length (); @@ -1318,8 +1333,15 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } ComplexNDArray result (a_dims); @@ -1410,8 +1432,15 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } ComplexNDArray result (a_dims); @@ -1453,8 +1482,15 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } ComplexNDArray result (a_dims); @@ -1517,7 +1553,7 @@ octave_idx_type nc = b.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be square"); + error ("for x^A, A must be a square matrix"); else { FloatEIG b_eig (b); @@ -1569,7 +1605,7 @@ octave_idx_type nc = b.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be square"); + error ("for x^A, A must be a square matrix"); else { FloatEIG b_eig (b); @@ -1608,7 +1644,7 @@ octave_idx_type nc = a.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be square"); + error ("for A^b, A must be a square matrix"); else { if (static_cast<int> (b) == b) @@ -1694,7 +1730,7 @@ octave_idx_type nc = a.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be square"); + error ("for A^b, A must be a square matrix"); else { if (static_cast<int> (b) == b) @@ -1726,7 +1762,7 @@ octave_idx_type nc = a.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be square"); + error ("for A^b, A must be a square matrix"); else { FloatEIG a_eig (a); @@ -1774,7 +1810,7 @@ octave_idx_type nc = b.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be square"); + error ("for x^A, A must be a square matrix"); else { FloatEIG b_eig (b); @@ -1822,7 +1858,7 @@ octave_idx_type nc = b.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be square"); + error ("for x^A, A must be a square matrix"); else { FloatEIG b_eig (b); @@ -1861,7 +1897,7 @@ octave_idx_type nc = a.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be square"); + error ("for A^b, A must be a square matrix"); else { if (static_cast<int> (b) == b) @@ -1947,7 +1983,7 @@ octave_idx_type nc = a.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be square"); + error ("for A^b, A must be a square matrix"); else { FloatEIG a_eig (a); @@ -1981,7 +2017,7 @@ octave_idx_type nc = a.cols (); if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be square"); + error ("for A^b, A must be a square matrix"); else { FloatComplexDiagMatrix r (nr, nc); @@ -2562,8 +2598,21 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + //Potentially complex results + FloatNDArray xa = octave_value_extract<FloatNDArray> (a); + FloatNDArray xb = octave_value_extract<FloatNDArray> (b); + if (! xb.all_integers () && xa.any_element_is_negative ()) + return octave_value (bsxfun_pow (FloatComplexNDArray (xa), xb)); + else + return octave_value (bsxfun_pow (xa, xb)); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } int len = a.length (); @@ -2637,8 +2686,15 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } FloatComplexNDArray result (a_dims); @@ -2729,8 +2785,15 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } FloatComplexNDArray result (a_dims); @@ -2772,8 +2835,15 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } FloatComplexNDArray result (a_dims);
--- a/src/xpow.h +++ b/src/xpow.h @@ -41,118 +41,118 @@ class octave_value; class Range; -extern octave_value xpow (double a, double b); -extern octave_value xpow (double a, const Matrix& b); -extern octave_value xpow (double a, const Complex& b); -extern octave_value xpow (double a, const ComplexMatrix& b); +extern OCTINTERP_API octave_value xpow (double a, double b); +extern OCTINTERP_API octave_value xpow (double a, const Matrix& b); +extern OCTINTERP_API octave_value xpow (double a, const Complex& b); +extern OCTINTERP_API octave_value xpow (double a, const ComplexMatrix& b); -extern octave_value xpow (const Matrix& a, double b); -extern octave_value xpow (const Matrix& a, const Complex& b); +extern OCTINTERP_API octave_value xpow (const Matrix& a, double b); +extern OCTINTERP_API octave_value xpow (const Matrix& a, const Complex& b); -extern octave_value xpow (const DiagMatrix& a, double b); -extern octave_value xpow (const DiagMatrix& a, const Complex& b); +extern OCTINTERP_API octave_value xpow (const DiagMatrix& a, double b); +extern OCTINTERP_API octave_value xpow (const DiagMatrix& a, const Complex& b); -extern octave_value xpow (const PermMatrix& a, double b); +extern OCTINTERP_API octave_value xpow (const PermMatrix& a, double b); -extern octave_value xpow (const Complex& a, double b); -extern octave_value xpow (const Complex& a, const Matrix& b); -extern octave_value xpow (const Complex& a, const Complex& b); -extern octave_value xpow (const Complex& a, const ComplexMatrix& b); +extern OCTINTERP_API octave_value xpow (const Complex& a, double b); +extern OCTINTERP_API octave_value xpow (const Complex& a, const Matrix& b); +extern OCTINTERP_API octave_value xpow (const Complex& a, const Complex& b); +extern OCTINTERP_API octave_value xpow (const Complex& a, const ComplexMatrix& b); -extern octave_value xpow (const ComplexMatrix& a, double b); -extern octave_value xpow (const ComplexMatrix& a, const Complex& b); +extern OCTINTERP_API octave_value xpow (const ComplexMatrix& a, double b); +extern OCTINTERP_API octave_value xpow (const ComplexMatrix& a, const Complex& b); -extern octave_value xpow (const ComplexDiagMatrix& a, double b); -extern octave_value xpow (const ComplexDiagMatrix& a, const Complex& b); +extern OCTINTERP_API octave_value xpow (const ComplexDiagMatrix& a, double b); +extern OCTINTERP_API octave_value xpow (const ComplexDiagMatrix& a, const Complex& b); -extern octave_value elem_xpow (double a, const Matrix& b); -extern octave_value elem_xpow (double a, const ComplexMatrix& b); -extern octave_value elem_xpow (double a, const Range& r); +extern OCTINTERP_API octave_value elem_xpow (double a, const Matrix& b); +extern OCTINTERP_API octave_value elem_xpow (double a, const ComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (double a, const Range& r); -extern octave_value elem_xpow (const Matrix& a, double b); -extern octave_value elem_xpow (const Matrix& a, const Matrix& b); -extern octave_value elem_xpow (const Matrix& a, const Complex& b); -extern octave_value elem_xpow (const Matrix& a, const ComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, double b); +extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, const Matrix& b); +extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, const Complex& b); +extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, const ComplexMatrix& b); -extern octave_value elem_xpow (const Complex& a, const Matrix& b); -extern octave_value elem_xpow (const Complex& a, const ComplexMatrix& b); -extern octave_value elem_xpow (const Complex& a, const Range& r); +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const Matrix& b); +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const ComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const Range& r); -extern octave_value elem_xpow (const ComplexMatrix& a, double b); -extern octave_value elem_xpow (const ComplexMatrix& a, const Matrix& b); -extern octave_value elem_xpow (const ComplexMatrix& a, const Complex& b); -extern octave_value elem_xpow (const ComplexMatrix& a, const ComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, double b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, const Matrix& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, const Complex& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, const ComplexMatrix& b); -extern octave_value elem_xpow (double a, const NDArray& b); -extern octave_value elem_xpow (double a, const ComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (double a, const NDArray& b); +extern OCTINTERP_API octave_value elem_xpow (double a, const ComplexNDArray& b); -extern octave_value elem_xpow (const NDArray& a, double b); -extern octave_value elem_xpow (const NDArray& a, const NDArray& b); -extern octave_value elem_xpow (const NDArray& a, const Complex& b); -extern octave_value elem_xpow (const NDArray& a, const ComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, double b); +extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, const NDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, const Complex& b); +extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, const ComplexNDArray& b); -extern octave_value elem_xpow (const Complex& a, const NDArray& b); -extern octave_value elem_xpow (const Complex& a, const ComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const NDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const ComplexNDArray& b); -extern octave_value elem_xpow (const ComplexNDArray& a, double b); -extern octave_value elem_xpow (const ComplexNDArray& a, const NDArray& b); -extern octave_value elem_xpow (const ComplexNDArray& a, const Complex& b); -extern octave_value elem_xpow (const ComplexNDArray& a, const ComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, double b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, const NDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, const Complex& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, const ComplexNDArray& b); -extern octave_value xpow (float a, float b); -extern octave_value xpow (float a, const FloatMatrix& b); -extern octave_value xpow (float a, const FloatComplex& b); -extern octave_value xpow (float a, const FloatComplexMatrix& b); +extern OCTINTERP_API octave_value xpow (float a, float b); +extern OCTINTERP_API octave_value xpow (float a, const FloatMatrix& b); +extern OCTINTERP_API octave_value xpow (float a, const FloatComplex& b); +extern OCTINTERP_API octave_value xpow (float a, const FloatComplexMatrix& b); -extern octave_value xpow (const FloatMatrix& a, float b); -extern octave_value xpow (const FloatMatrix& a, const FloatComplex& b); +extern OCTINTERP_API octave_value xpow (const FloatMatrix& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatMatrix& a, const FloatComplex& b); -extern octave_value xpow (const FloatDiagMatrix& a, float b); -extern octave_value xpow (const FloatDiagMatrix& a, const FloatComplex& b); +extern OCTINTERP_API octave_value xpow (const FloatDiagMatrix& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatDiagMatrix& a, const FloatComplex& b); -extern octave_value xpow (const FloatComplex& a, float b); -extern octave_value xpow (const FloatComplex& a, const FloatMatrix& b); -extern octave_value xpow (const FloatComplex& a, const FloatComplex& b); -extern octave_value xpow (const FloatComplex& a, const FloatComplexMatrix& b); +extern OCTINTERP_API octave_value xpow (const FloatComplex& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatComplex& a, const FloatMatrix& b); +extern OCTINTERP_API octave_value xpow (const FloatComplex& a, const FloatComplex& b); +extern OCTINTERP_API octave_value xpow (const FloatComplex& a, const FloatComplexMatrix& b); -extern octave_value xpow (const FloatComplexMatrix& a, float b); -extern octave_value xpow (const FloatComplexMatrix& a, const FloatComplex& b); +extern OCTINTERP_API octave_value xpow (const FloatComplexMatrix& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatComplexMatrix& a, const FloatComplex& b); -extern octave_value xpow (const FloatComplexDiagMatrix& a, float b); -extern octave_value xpow (const FloatComplexDiagMatrix& a, const FloatComplex& b); +extern OCTINTERP_API octave_value xpow (const FloatComplexDiagMatrix& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatComplexDiagMatrix& a, const FloatComplex& b); -extern octave_value elem_xpow (float a, const FloatMatrix& b); -extern octave_value elem_xpow (float a, const FloatComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (float a, const FloatMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (float a, const FloatComplexMatrix& b); -extern octave_value elem_xpow (const FloatMatrix& a, float b); -extern octave_value elem_xpow (const FloatMatrix& a, const FloatMatrix& b); -extern octave_value elem_xpow (const FloatMatrix& a, const FloatComplex& b); -extern octave_value elem_xpow (const FloatMatrix& a, const FloatComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, float b); +extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, const FloatMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, const FloatComplex& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, const FloatComplexMatrix& b); -extern octave_value elem_xpow (const FloatComplex& a, const FloatMatrix& b); -extern octave_value elem_xpow (const FloatComplex& a, const FloatComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatComplexMatrix& b); -extern octave_value elem_xpow (const FloatComplexMatrix& a, float b); -extern octave_value elem_xpow (const FloatComplexMatrix& a, const FloatMatrix& b); -extern octave_value elem_xpow (const FloatComplexMatrix& a, const FloatComplex& b); -extern octave_value elem_xpow (const FloatComplexMatrix& a, const FloatComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, float b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, const FloatMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, const FloatComplex& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, const FloatComplexMatrix& b); -extern octave_value elem_xpow (float a, const FloatNDArray& b); -extern octave_value elem_xpow (float a, const FloatComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (float a, const FloatNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (float a, const FloatComplexNDArray& b); -extern octave_value elem_xpow (const FloatNDArray& a, float b); -extern octave_value elem_xpow (const FloatNDArray& a, const FloatNDArray& b); -extern octave_value elem_xpow (const FloatNDArray& a, const FloatComplex& b); -extern octave_value elem_xpow (const FloatNDArray& a, const FloatComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, float b); +extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, const FloatNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, const FloatComplex& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, const FloatComplexNDArray& b); -extern octave_value elem_xpow (const FloatComplex& a, const FloatNDArray& b); -extern octave_value elem_xpow (const FloatComplex& a, const FloatComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatComplexNDArray& b); -extern octave_value elem_xpow (const FloatComplexNDArray& a, float b); -extern octave_value elem_xpow (const FloatComplexNDArray& a, const FloatNDArray& b); -extern octave_value elem_xpow (const FloatComplexNDArray& a, const FloatComplex& b); -extern octave_value elem_xpow (const FloatComplexNDArray& a, const FloatComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, float b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, const FloatNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, const FloatComplex& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, const FloatComplexNDArray& b); #endif
deleted file mode 100644 --- a/test/@Blork/module.mk +++ /dev/null @@ -1,8 +0,0 @@ -at_Blork_FCN_FILES = \ - @Blork/Blork.m \ - @Blork/bleek.m \ - @Blork/display.m \ - @Blork/get.m \ - @Blork/set.m - -FCN_FILES += $(at_Blork_FCN_FILES)
deleted file mode 100644 --- a/test/@Cork/module.mk +++ /dev/null @@ -1,8 +0,0 @@ -at_Cork_FCN_FILES = \ - @Cork/Cork.m \ - @Cork/click.m \ - @Cork/display.m \ - @Cork/get.m \ - @Cork/set.m - -FCN_FILES += $(at_Cork_FCN_FILES)
deleted file mode 100644 --- a/test/@Dork/module.mk +++ /dev/null @@ -1,11 +0,0 @@ -at_Dork_FCN_FILES = \ - @Dork/Dork.m \ - @Dork/bling.m \ - @Dork/display.m \ - @Dork/gack.m \ - @Dork/get.m \ - @Dork/getStash.m \ - @Dork/set.m \ - @Dork/private/myStash.m - -FCN_FILES += $(at_Dork_FCN_FILES)
deleted file mode 100644 --- a/test/@Gork/module.mk +++ /dev/null @@ -1,11 +0,0 @@ -at_Gork_FCN_FILES = \ - @Gork/Gork.m \ - @Gork/cork.m \ - @Gork/display.m \ - @Gork/gark.m \ - @Gork/get.m \ - @Gork/set.m \ - @Gork/subsasgn.m \ - @Gork/subsref.m - -FCN_FILES += $(at_Gork_FCN_FILES)
deleted file mode 100644 --- a/test/@Pork/module.mk +++ /dev/null @@ -1,10 +0,0 @@ -at_Pork_FCN_FILES = \ - @Pork/Pork.m \ - @Pork/bling.m \ - @Pork/display.m \ - @Pork/get.m \ - @Pork/gurk.m \ - @Pork/set.m \ - @Pork/private/myStash.m - -FCN_FILES += $(at_Pork_FCN_FILES)
deleted file mode 100644 --- a/test/@Sneetch/module.mk +++ /dev/null @@ -1,5 +0,0 @@ -at_Sneetch_FCN_FILES = \ - @Sneetch/Sneetch.m \ - @Sneetch/display.m - -FCN_FILES += $(at_Sneetch_FCN_FILES)
deleted file mode 100644 --- a/test/@Snork/module.mk +++ /dev/null @@ -1,17 +0,0 @@ -at_Snork_FCN_FILES = \ - @Snork/Snork.m \ - @Snork/cack.m \ - @Snork/display.m \ - @Snork/end.m \ - @Snork/get.m \ - @Snork/getStash.m \ - @Snork/gick.m \ - @Snork/loadobj.m \ - @Snork/saveobj.m \ - @Snork/set.m \ - @Snork/subsasgn.m \ - @Snork/subsindex.m \ - @Snork/subsref.m \ - @Snork/private/myStash.m - -FCN_FILES += $(at_Snork_FCN_FILES)
deleted file mode 100644 --- a/test/@Spork/module.mk +++ /dev/null @@ -1,13 +0,0 @@ -at_Spork_FCN_FILES = \ - @Spork/Spork.m \ - @Spork/cack.m \ - @Spork/display.m \ - @Spork/geek.m \ - @Spork/get.m \ - @Spork/getStash.m \ - @Spork/loadobj.m \ - @Spork/saveobj.m \ - @Spork/set.m \ - @Spork/private/myStash.m - -FCN_FILES += $(at_Spork_FCN_FILES)
--- a/test/Makefile.am +++ b/test/Makefile.am @@ -18,12 +18,11 @@ # along with Octave; see the file COPYING. If not, see # <http://www.gnu.org/licenses/>. -include $(top_srcdir)/common.mk +include $(top_srcdir)/build-aux/common.mk FCN_FILES = \ fntests.m \ test_args.m \ - test_classes.m \ test_contin.m \ test_diag_perm.m \ test_error.m \ @@ -44,7 +43,6 @@ test_recursion.m \ test_return.m \ test_slice.m \ - test_string.m \ test_struct.m \ test_switch.m \ test_system.m \ @@ -53,14 +51,10 @@ test_unwind.m \ test_while.m -include @Blork/module.mk -include @Cork/module.mk -include @Dork/module.mk -include @Gork/module.mk -include @Pork/module.mk -include @Sneetch/module.mk -include @Snork/module.mk -include @Spork/module.mk +include classes/module.mk +include class-concat/module.mk +include ctor-vs-method/module.mk +include fcn-handle-derived-resolution/module.mk check: test_sparse.m test_bc_overloads.m $(top_builddir)/run-octave --norc --silent --no-history $(srcdir)/fntests.m $(srcdir) @@ -72,7 +66,6 @@ $(srcdir)/build_bc_overload_tests.sh $(srcdir)/bc_overloads_expected EXTRA_DIST = \ - ChangeLog \ build_sparse_tests.sh \ build_bc_overload_tests.sh \ bc_overloads_expected \
--- a/test/build_sparse_tests.sh +++ b/test/build_sparse_tests.sh @@ -102,7 +102,7 @@ # gen_assembly_tests # test for sparse constructors with 'sum' vs. 'unique' # gen_select_tests -# indexing tests +# indexing and assignment tests # gen_solver_tests # Tests the solve function with triangular/banded, etc matrices
new file mode 100644 --- /dev/null +++ b/test/class-concat/@foo/foo.m @@ -0,0 +1,3 @@ +function r = foo () + r = class (struct (), 'foo'); +endfunction
new file mode 100644 --- /dev/null +++ b/test/class-concat/module.mk @@ -0,0 +1,5 @@ +class_concat_FCN_FILES = \ + class-concat/@foo/foo.m \ + class-concat/test_class_concat.m + +FCN_FILES += $(class_concat_FCN_FILES)
new file mode 100644 --- /dev/null +++ b/test/class-concat/test_class_concat.m @@ -0,0 +1,14 @@ +%!test +%! f = foo (); +%! x = [f,f]; +%! assert (size (x), [1, 2]) +%! assert (class (x), "foo") + +%!test +%! f = foo (); +%! x = [f,f]; +%! tmp = num2cell (x); +%! assert (iscell (tmp)) +%! assert (size (tmp), [1, 2]) +%! assert (class (tmp{1}), "foo") +%! assert (class (tmp{2}), "foo")
new file mode 100644 --- /dev/null +++ b/test/classes/module.mk @@ -0,0 +1,63 @@ +classes_FCN_FILES = \ + classes/@Blork/Blork.m \ + classes/@Blork/bleek.m \ + classes/@Blork/display.m \ + classes/@Blork/get.m \ + classes/@Blork/set.m \ + classes/@Cork/Cork.m \ + classes/@Cork/click.m \ + classes/@Cork/display.m \ + classes/@Cork/get.m \ + classes/@Cork/set.m \ + classes/@Dork/Dork.m \ + classes/@Dork/bling.m \ + classes/@Dork/display.m \ + classes/@Dork/gack.m \ + classes/@Dork/get.m \ + classes/@Dork/getStash.m \ + classes/@Dork/private/myStash.m \ + classes/@Dork/set.m \ + classes/@Gork/Gork.m \ + classes/@Gork/cork.m \ + classes/@Gork/display.m \ + classes/@Gork/gark.m \ + classes/@Gork/get.m \ + classes/@Gork/set.m \ + classes/@Gork/subsasgn.m \ + classes/@Gork/subsref.m \ + classes/@Pork/Pork.m \ + classes/@Pork/bling.m \ + classes/@Pork/display.m \ + classes/@Pork/get.m \ + classes/@Pork/gurk.m \ + classes/@Pork/private/myStash.m \ + classes/@Pork/set.m \ + classes/@Sneetch/Sneetch.m \ + classes/@Sneetch/display.m \ + classes/@Snork/Snork.m \ + classes/@Snork/cack.m \ + classes/@Snork/display.m \ + classes/@Snork/end.m \ + classes/@Snork/get.m \ + classes/@Snork/getStash.m \ + classes/@Snork/gick.m \ + classes/@Snork/loadobj.m \ + classes/@Snork/private/myStash.m \ + classes/@Snork/saveobj.m \ + classes/@Snork/set.m \ + classes/@Snork/subsasgn.m \ + classes/@Snork/subsindex.m \ + classes/@Snork/subsref.m \ + classes/@Spork/Spork.m \ + classes/@Spork/cack.m \ + classes/@Spork/display.m \ + classes/@Spork/geek.m \ + classes/@Spork/get.m \ + classes/@Spork/getStash.m \ + classes/@Spork/loadobj.m \ + classes/@Spork/private/myStash.m \ + classes/@Spork/saveobj.m \ + classes/@Spork/set.m \ + classes/test_classes.m + +FCN_FILES += $(classes_FCN_FILES)
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/@derived/derived.m @@ -0,0 +1,5 @@ +function r = derived (varargin) + __trace__ ('begin derived/derived'); + r = class (struct (), 'derived', parent ()); + __trace__ ('end derived/derived'); +end
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/@derived/parent.m @@ -0,0 +1,9 @@ +function r = parent (a) + __trace__ ('begin derived/parent'); + if (isa (a, 'parent')) + r = parent (a.parent); + else + error ('foo'); + end + __trace__ ('end derived/parent'); +end
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/@other/other.m @@ -0,0 +1,5 @@ +function r = other (varargin) + __trace__ ('begin other/other'); + r = class (struct (), 'other'); + __trace__ ('end other/other'); +end
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/@other/parent.m @@ -0,0 +1,4 @@ +function r = parent (a) + __trace__ ('begin other/parent'); + __trace__ ('end other/parent'); +end
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/@parent/method.m @@ -0,0 +1,5 @@ +function r = method (a) + __trace__ ('begin parent/method'); + r = parent (a); + __trace__ ('end parent/method'); +end
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/@parent/parent.m @@ -0,0 +1,15 @@ +function rot = parent (a) + __trace__ ('begin parent/parent'); + if (nargin == 0) + rot = class (struct (), 'parent'); + else + switch class (a) + case 'parent' + %% copy constructor + rot = a; + otherwise + error ('type mismatch in parent constructor') + end + end + __trace__ ('end parent/parent'); +end
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/__trace__.m @@ -0,0 +1,18 @@ +function r = __trace__ (t) + persistent history + if (isempty (history)) + history = {}; + end + if (nargin == 0) + if (nargout == 0) + history = {}; + else + r = history; + end + elseif (nargin == 1); + history = [history; t]; + else + error ('incorrect call to __trace__'); + end +end + \ No newline at end of file
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/module.mk @@ -0,0 +1,11 @@ +ctor_vs_method_FCN_FILES = \ + ctor-vs-method/@derived/derived.m \ + ctor-vs-method/@derived/parent.m \ + ctor-vs-method/@other/other.m \ + ctor-vs-method/@other/parent.m \ + ctor-vs-method/@parent/method.m \ + ctor-vs-method/@parent/parent.m \ + ctor-vs-method/__trace__.m \ + ctor-vs-method/test_ctor_vs_method.m + +FCN_FILES += $(ctor_vs_method_FCN_FILES)
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/test_ctor_vs_method.m @@ -0,0 +1,56 @@ +## Copyright (C) 2011 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/>. + +%% Test script for legacy OOP. +%% Requires the path to contain the directory ctor-vs-method. +%% +%% Note: This script and all classes are also intended to run +%% in Matlab to test compatibility. Don't break that! + +%!shared d, o +%! d = derived (); +%! o = other (); +%! +%!error method (o); + +%!test +%! ctrace = {'begin parent/method'; +%! 'begin derived/parent'; +%! 'begin parent/parent'; +%! 'end parent/parent'; +%! 'end derived/parent'; +%! 'end parent/method'}; +%! __trace__ (); %% clear call trace info +%! method (d); +%! assert (__trace__ (), ctrace); + +%!test +%! ctrace = {'begin other/parent'; +%! 'end other/parent'}; +%! __trace__ (); %% clear call trace info +%! parent (o); +%! assert (__trace__ (), ctrace); + +%!test +%! ctrace = {'begin derived/parent'; +%! 'begin parent/parent'; +%! 'end parent/parent'; +%! 'end derived/parent'}; +%! __trace__ (); %% clear call trace info +%! parent (d); +%! assert (__trace__ (), ctrace);
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/@derived/derived.m @@ -0,0 +1,5 @@ +function r = derived (n) + s.a = n; + p = parent (n); + r = class (s, 'derived', p); +end
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/@other/getsize_arrayfun.m @@ -0,0 +1,3 @@ +function r = getsize_arrayfun (x) + r = arrayfun (@(i) numel (x(i).d), 1:numel(x), 'uniformoutput', true); +end
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/@other/getsize_cellfun.m @@ -0,0 +1,3 @@ +function r = getsize_cellfun (x) + r = cellfun (@numel, {x.d}); +end
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/@other/getsize_loop.m @@ -0,0 +1,7 @@ +function r = getsize_loop (x) + n = numel (x); + r = zeros (1, n); + for i = 1:n + r(i) = numel (x(i).d); + end +end
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/@other/other.m @@ -0,0 +1,4 @@ +function r = other (n) + s.d = derived (n); + r = class (s, 'other'); +end
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/@parent/numel.m @@ -0,0 +1,3 @@ +function r = numel (x, varargin) + r = numel (x.a, varargin{:}); +end
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/@parent/parent.m @@ -0,0 +1,4 @@ +function r = parent (n) + s.a = rand (n, 1); + r = class (s, 'parent'); +end
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/module.mk @@ -0,0 +1,11 @@ +fcn_handle_derived_resolution_FCN_FILES = \ + fcn-handle-derived-resolution/@derived/derived.m \ + fcn-handle-derived-resolution/@other/getsize_arrayfun.m \ + fcn-handle-derived-resolution/@other/getsize_cellfun.m \ + fcn-handle-derived-resolution/@other/getsize_loop.m \ + fcn-handle-derived-resolution/@other/other.m \ + fcn-handle-derived-resolution/@parent/numel.m \ + fcn-handle-derived-resolution/@parent/parent.m \ + fcn-handle-derived-resolution/test_fcn_handle_derived_resolution.m + +FCN_FILES += $(fcn_handle_derived_resolution_FCN_FILES)
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/test_fcn_handle_derived_resolution.m @@ -0,0 +1,59 @@ +## Copyright (C) 2011 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/>. + +%% Test script for legacy OOP. +%% Requires the path to contain the directory ctor-vs-method. +%% +%% Note: This script and all classes are also intended to run +%% in Matlab to test compatibility. Don't break that! + +%!shared +%! clear -classes + +%!test +%! p = parent (7); +%! assert (numel (p), 7) + +%!test +%! d = derived (13); +%! assert (numel (d), 13) + +%!test +%! p = parent (11); +%! f = @numel; +%! assert (f (p), 11) + +%!test +%! d = parent (21); +%! f = @numel; +%! assert (f (d), 21) + +%!test +%! o(1) = other (13); +%! o(2) = other (42); +%! assert (getsize_loop (o), [13, 42]) + +%!test +%! o(1) = other (13); +%! o(2) = other (42); +%! assert (getsize_cellfun (o), [13, 42]) + +%!test +%! o(1) = other (13); +%! o(2) = other (42); +%! assert (getsize_arrayfun (o), [13, 42])
--- a/test/fntests.m +++ b/test/fntests.m @@ -91,7 +91,18 @@ if (fid >= 0) str = fread (fid, "*char")'; fclose (fid); - retval = ! isempty (regexp (str, '^%!(test|assert|error|warning)', "lineanchors")); + retval = ! isempty (regexp (str, '^%!(assert|error|fail|test|warning)', "lineanchors")); + else + error ("fopen failed: %s", f); + endif +endfunction + +function retval = has_demos (f) + fid = fopen (f); + if (fid >= 0) + str = fread (fid, "*char")'; + fclose (fid); + retval = ! isempty (regexp (str, '^%!demo', "lineanchors")); else error ("fopen failed: %s", f); endif @@ -104,24 +115,45 @@ dp = dn = dxf = dsk = 0; for i = 1:length (lst) nm = lst(i).name; - if (length (nm) > 5 && strcmp (nm(1:5), "test_") - && strcmp (nm((end-1):end), ".m")) - p = n = xf = sk = 0; - ffnm = fullfile (d, nm); - if (has_tests (ffnm)) - print_test_file_name (nm); - [p, n, xf, sk] = test (nm(1:(end-2)), "quiet", fid); - print_pass_fail (n, p); - files_with_tests(end+1) = ffnm; - else - files_with_no_tests(end+1) = ffnm; - endif + if (lst(i).isdir + && ! strcmp (nm, ".") && ! strcmp (nm, "..") + && ! strcmp (nm, "private") && nm(1) != "@" + && ! strcmp (nm, "CVS")) + [p, n, xf, sk] = run_test_dir (fid, [d, filesep, nm]); dp += p; dn += n; dxf += xf; dsk += sk; endif endfor + saved_dir = pwd (); + unwind_protect + chdir (d); + for i = 1:length (lst) + nm = lst(i).name; + if (length (nm) > 5 && strcmp (nm(1:5), "test_") + && strcmp (nm((end-1):end), ".m")) + p = n = xf = sk = 0; + ffnm = fullfile (d, nm); + if (has_tests (ffnm)) + print_test_file_name (nm); + [p, n, xf, sk] = test (nm(1:(end-2)), "quiet", fid); + print_pass_fail (n, p); + files_with_tests(end+1) = ffnm; + ##elseif (has_demos (ffnm)) + ## files_with_tests(end+1) = ffnm; + else + files_with_no_tests(end+1) = ffnm; + endif + dp += p; + dn += n; + dxf += xf; + dsk += sk; + endif + endfor + unwind_protect_cleanup + chdir (saved_dir); + end_unwind_protect endfunction function [dp, dn, dxf, dsk] = run_test_script (fid, d); @@ -135,7 +167,7 @@ nm = lst(i).name; if (lst(i).isdir && ! strcmp (nm, ".") && ! strcmp (nm, "..") && ! strcmp (nm, "CVS")) - [p, n, xf, sk] = run_test_script (fid, [d, "/", nm]); + [p, n, xf, sk] = run_test_script (fid, [d, filesep, nm]); dp += p; dn += n; dxf += xf; @@ -154,8 +186,8 @@ p = n = xf = 0; ## Only run if it contains %!test, %!assert %!error or %!warning if (has_tests (f)) - tmp = strrep (f, [topsrcdir, "/"], ""); - tmp = strrep (tmp, [topbuilddir, "/"], "../"); + tmp = strrep (f, [topsrcdir, filesep], ""); + tmp = strrep (tmp, [topbuilddir, filesep], ["..", filesep]); print_test_file_name (tmp); [p, n, xf, sk] = test (f, "quiet", fid); print_pass_fail (n, p); @@ -164,6 +196,8 @@ dxf += xf; dsk += sk; files_with_tests(end+1) = f; + ##elseif (has_demos (f)) + ## files_with_tests(end+1) = f; elseif (has_functions (f)) ## To reduce the list length, only mark .cc files that contain ## DEFUN definitions. @@ -192,16 +226,11 @@ endfunction function n = num_elts_matching_pattern (lst, pat) - n = 0; - for i = 1:length (lst) - if (! isempty (regexp (lst{i}, pat, "once"))) - n++; - endif - endfor + n = sum (cellfun (@(x) !isempty (x), regexp (lst, pat, 'once'))); endfunction function report_files_with_no_tests (with, without, typ) - pat = cstrcat ("\\", typ, "$"); + pat = cstrcat ('\', typ, "$"); n_with = num_elts_matching_pattern (with, pat); n_without = num_elts_matching_pattern (without, pat); n_tot = n_with + n_without; @@ -258,6 +287,12 @@ puts ("because the needed libraries were not present when Octave was built.\n"); endif + ## Weed out deprecated and private functions + weed_idx = cellfun (@isempty, regexp (files_with_tests, '\bdeprecated\b|\bprivate\b', 'once')); + files_with_tests = files_with_tests(weed_idx); + weed_idx = cellfun (@isempty, regexp (files_with_no_tests, '\bdeprecated\b|\bprivate\b', 'once')); + files_with_no_tests = files_with_no_tests(weed_idx); + report_files_with_no_tests (files_with_tests, files_with_no_tests, ".m"); report_files_with_no_tests (files_with_tests, files_with_no_tests, ".cc");
deleted file mode 100644 --- a/test/test_index-wfi-t.m +++ /dev/null @@ -1,379 +0,0 @@ -## Copyright (C) 2006-2011 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/>. - -%% test/octave.test/index-wfi-t/s-1.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = []; -%! assert(isempty (a)); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-2.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! assert(a(1),1); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-3.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! assert(a(:),1); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-4.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! assert(a(:,:),1); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-5.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! assert(a(1,:),1); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-6.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! assert(a(:,1),1); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-7.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! assert(isempty (a(logical (0)))); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-8.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! fail("a(-1);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-9.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! fail("a(2);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-10.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! fail("a(2,:);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-11.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! fail("a(:,2);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-12.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! fail("a(-1,:);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-13.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! fail("a(:,-1);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-14.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! fail("a([1,2,3]);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-15.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! fail("a([1;2;3]);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-16.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! fail("a([1,2;3,4]);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-17.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! fail("a([0,1]);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-18.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! fail("a([0;1]);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-19.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! fail("a([-1,0]);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/s-20.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 1; -%! fail("a([-1;0]);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-1.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! assert(a(1),4); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-2.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! assert(a(2),3); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-3.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! assert(all (a(:) == a_prime)); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-4.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! assert(all (a(1,:) == a)); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-5.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! assert(a(:,3),2); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-6.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! assert(all (a(:,:) == a)); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-7.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! assert(all (a(logical ([0,1,1,0])) == mid_a)); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-8.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! fail("a(0);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-9.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! fail("a(5);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-10.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! fail("a(0,1);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-11.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! assert(isempty (a(logical (0),:))); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-12.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! fail("a(:,0);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-13.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! assert(isempty (a([]))); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-14.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! assert(isempty (a([],:))); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/v-15.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [4,3,2,1]; -%! a_prime = [4;3;2;1]; -%! mid_a = [3,2]; -%! assert(isempty (a(:,[]))); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/m-1.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [1,2;3,4]; -%! a_fvec = [1;3;2;4]; -%! a_col_1 = [1;3]; -%! a_col_2 = [2;4]; -%! a_row_1 = [1,2]; -%! a_row_2 = [3,4]; -%! assert(all (all (a(:,:) == a))); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/m-2.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [1,2;3,4]; -%! a_fvec = [1;3;2;4]; -%! a_col_1 = [1;3]; -%! a_col_2 = [2;4]; -%! a_row_1 = [1,2]; -%! a_row_2 = [3,4]; -%! assert(all (a(:) == a_fvec)); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/m-3.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [1,2;3,4]; -%! a_fvec = [1;3;2;4]; -%! a_col_1 = [1;3]; -%! a_col_2 = [2;4]; -%! a_row_1 = [1,2]; -%! a_row_2 = [3,4]; -%! fail("a(0);"); -%! warning (wfi.state, "Octave:fortran-indexing"); - -%% test/octave.test/index-wfi-t/m-4.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [1,2;3,4]; -%! a_fvec = [1;3;2;4]; -%! a_col_1 = [1;3]; -%! a_col_2 = [2;4]; -%! a_row_1 = [1,2]; -%! a_row_2 = [3,4]; -%! fail("a(2);","warning"); -%! warning (wfi.state, "Octave:fortran-indexing");
rename from test/test_index-wfi-f.m rename to test/test_index.m --- a/test/test_index-wfi-f.m +++ b/test/test_index.m @@ -16,320 +16,177 @@ ## along with Octave; see the file COPYING. If not, see ## <http://www.gnu.org/licenses/>. -%% test/octave.test/index-wfi-f/s-1.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = []; %! assert(isempty (a)); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-2.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! assert(a(1),1); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-3.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! assert(a(:),1); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-4.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! assert(a(:,:),1); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-5.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! assert(a(1,:),1); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-6.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! assert(a(:,1),1); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-7.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! assert(isempty (a(logical (0)))); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-8.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! fail("a(-1)"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-9.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! fail("a(2);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-10.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! fail("a(2,:);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-11.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! fail("a(:,2);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-12.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! fail("a(-1,:);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-13.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! fail("a(:,-1);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-14.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! fail("a([1,2,3]);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-15.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! fail("a([1;2;3]);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-16.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! fail("a([1,2;3,4]);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-17.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! fail("a([0,1]);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-18.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! fail("a([0;1]);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-19.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! fail("a([-1,0]);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/s-20.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 1; %! fail("a([-1;0]);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-1.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! assert(a(1),4); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-2.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! assert(a(2),3); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-3.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! assert(all (a(:) == a_prime)); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-4.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! assert(all (a(1,:) == a)); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-5.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! assert(a(:,3),2); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-6.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! assert(all (a(:,:) == a)); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-7.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! assert(all (a(logical ([0,1,1,0])) == mid_a)); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-8.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! fail("a(0);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-9.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! fail("a(5);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-10.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! fail("a(0,1);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-11.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! assert(isempty (a(logical (0),:))); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-12.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! fail("a(:,0);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-13.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! assert(isempty (a([]))); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-14.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! assert(isempty (a([],:))); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/v-15.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [4,3,2,1]; %! a_prime = [4;3;2;1]; %! mid_a = [3,2]; %! assert(isempty (a(:,[]))); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/m-1.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [1,2;3,4]; %! a_fvec = [1;3;2;4]; %! a_col_1 = [1;3]; @@ -337,12 +194,8 @@ %! a_row_1 = [1,2]; %! a_row_2 = [3,4]; %! assert(all (all (a(:,:) == a))); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/m-2.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [1,2;3,4]; %! a_fvec = [1;3;2;4]; %! a_col_1 = [1;3]; @@ -350,12 +203,8 @@ %! a_row_1 = [1,2]; %! a_row_2 = [3,4]; %! assert(all (a(:) == a_fvec)); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/m-3.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [1,2;3,4]; %! a_fvec = [1;3;2;4]; %! a_col_1 = [1;3]; @@ -363,12 +212,8 @@ %! a_row_1 = [1,2]; %! a_row_2 = [3,4]; %! fail("a(0);"); -%! warning (wfi.state, "Octave:fortran-indexing"); -%% test/octave.test/index-wfi-f/m-4.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [1,2;3,4]; %! a_fvec = [1;3;2;4]; %! a_col_1 = [1;3]; @@ -376,7 +221,6 @@ %! a_row_1 = [1,2]; %! a_row_2 = [3,4]; %! assert(a(2),3); -%! warning (wfi.state, "Octave:fortran-indexing"); %% Additional tests %!shared a, b @@ -505,3 +349,9 @@ %! assert (a, reshape (1:4,[1,1,1,4])); %!error (a(1:2,1:2) = 1:4) + +%!shared x +%! x = 1:5; +%!error <attempted to use a complex scalar as an index> x(i) +%!error <attempted to use a complex scalar as an index> x(j) +%!error <attempted to use a complex scalar as an index> x(1+i)
--- a/test/test_io.m +++ b/test/test_io.m @@ -237,10 +237,36 @@ %!assert(puts (1),-1); %% test/octave.test/io/puts-3.m -%!error <Invalid call to puts.*> puts (); +%!error <Invalid call to puts> puts (); %% test/octave.test/io/puts-4.m -%!error <Invalid call to puts.*> puts (1, 2); +%!error <Invalid call to puts> puts (1, 2); + +%!assert (sscanf ('123456', '%10c'), '123456') +%!assert (sscanf ('123456', '%10s'), '123456') + +%!assert (sscanf (['ab'; 'cd'], '%s'), 'acbd'); + +%!test +%! [val, count, msg, pos] = sscanf ("3I2", "%f"); +%! assert (val, 3); +%! assert (count, 1); +%! assert (msg, ""); +%! assert (pos, 2); + +%!test +%! [val, count, msg, pos] = sscanf ("3In2", "%f"); +%! assert (val, 3); +%! assert (count, 1); +%! assert (msg, ""); +%! assert (pos, 2); + +%!test +%! [val, count, msg, pos] = sscanf ("3Inf2", "%f"); +%! assert (val, [3; Inf; 2]); +%! assert (count, 3); +%! assert (msg, ""); +%! assert (pos, 6); %% test/octave.test/io/sscanf-1.m %!test @@ -253,13 +279,13 @@ %! && v2 == [1; 2] && c2 == 2 && ischar (m2))); %% test/octave.test/io/sscanf-2.m -%!error <Invalid call to sscanf.*> sscanf (); +%!error <Invalid call to sscanf> sscanf (); %% test/octave.test/io/sscanf-3.m %!error sscanf (1, 2); %% test/octave.test/io/sscanf-4.m -%!error <Invalid call to sscanf.*> sscanf ("foo", "bar", "C", 1); +%!error <Invalid call to sscanf> sscanf ("foo", "bar", "C", 1); %% test/octave.test/io/sscanf-5.m %!test @@ -284,7 +310,7 @@ %!error printf (1); %% test/octave.test/io/printf-3.m -%!error <Invalid call to printf.*> printf (); +%!error <Invalid call to printf> printf (); %% test/octave.test/io/sprintf-1.m %!test @@ -296,7 +322,7 @@ %!error sprintf (1); %% test/octave.test/io/sprintf-3.m -%!error <Invalid call to sprintf.*> sprintf (); +%!error <Invalid call to sprintf> sprintf (); %% test/octave.test/io/fopen-1.m %!test @@ -367,16 +393,16 @@ %! assert(prog_output_assert("error:.*")); %% test/octave.test/io/fopen-5.m -%!error <Invalid call to fopen.*> fopen (); +%!error <Invalid call to fopen> fopen (); %% test/octave.test/io/fopen-6.m -%!error <Invalid call to fopen.*> fopen ("foo", "wb", "native", 1); +%!error <Invalid call to fopen> fopen ("foo", "wb", "native", 1); %% test/octave.test/io/fclose-1.m %!error fclose (0); %% test/octave.test/io/fclose-2.m -%!error <Invalid call to fclose.*> fclose (1, 2); +%!error <Invalid call to fclose> fclose (1, 2); %% test/octave.test/io/tmpnam-1.m %!assert(ischar (tmpnam ())); @@ -388,7 +414,7 @@ %!warning tmpnam ("foo", 1); %% test/octave.test/io/tmpnam-4.m -%!error <Invalid call to tmpnam.*> tmpnam (1, 2, 3); +%!error <Invalid call to tmpnam> tmpnam (1, 2, 3); %% test/octave.test/io/binary-io-1.m %!test @@ -473,37 +499,37 @@ %! unlink (nm); %% test/octave.test/io/fputs-1.m -%!error <Invalid call to fputs.*> fputs (); +%!error <Invalid call to fputs> fputs (); %% test/octave.test/io/fputs-2.m -%!error <Invalid call to fputs.*> fputs (1, "foo", 1); +%!error <Invalid call to fputs> fputs (1, "foo", 1); %% test/octave.test/io/fputs-3.m %!assert(fputs (1, 1),-1); %% test/octave.test/io/fgetl-1.m -%!error <Invalid call to fgetl.*> fgetl (); +%!error <Invalid call to fgetl> fgetl (); %% test/octave.test/io/fgetl-2.m -%!error <Invalid call to fgetl.*> fgetl (1, 2, 3); +%!error <Invalid call to fgetl> fgetl (1, 2, 3); %% test/octave.test/io/fgetl-3.m %!error fgetl ("foo", 1); %% test/octave.test/io/fgets-1.m -%!error <Invalid call to fgets.*> fgets (); +%!error <Invalid call to fgets> fgets (); %% test/octave.test/io/fgets-2.m -%!error <Invalid call to fgets.*> fgets (1, 2, 3); +%!error <Invalid call to fgets> fgets (1, 2, 3); %% test/octave.test/io/fgets-3.m %!error fgets ("foo", 1); %% test/octave.test/io/fprintf-1.m -%!error <Invalid call to fprintf.*> fprintf (); +%!error <Invalid call to fprintf> fprintf (); %% test/octave.test/io/fprintf-2.m -%!error <Invalid call to fprintf.*> fprintf (1); +%!error <Invalid call to fprintf> fprintf (1); %% test/octave.test/io/fprintf-3.m %!test @@ -517,37 +543,37 @@ %!error fprintf (-1, "foo"); %% test/octave.test/io/fscanf-1.m -%!error <Invalid call to fscanf.*> fscanf (); +%!error <Invalid call to fscanf> fscanf (); %% test/octave.test/io/fscanf-2.m -%!error <Invalid call to fscanf.*> fscanf (1); +%!error <Invalid call to fscanf> fscanf (1); %% test/octave.test/io/fscanf-3.m %!error fscanf ("foo", "bar"); %% test/octave.test/io/fread-1.m -%!error <Invalid call to fread.*> fread (); +%!error <Invalid call to fread> fread (); %% test/octave.test/io/fread-2.m -%!error <Invalid call to fread.*> fread (1, 2, "char", 1, "native", 2); +%!error <Invalid call to fread> fread (1, 2, "char", 1, "native", 2); %% test/octave.test/io/fread-3.m %!error fread ("foo"); %% test/octave.test/io/fwrite-1.m -%!error <Invalid call to fwrite.*> fwrite (); +%!error <Invalid call to fwrite> fwrite (); %% test/octave.test/io/fwrite-2.m -%!error <Invalid call to fwrite.*> fwrite (1, rand (10), "char", 1, "native", 2); +%!error <Invalid call to fwrite> fwrite (1, rand (10), "char", 1, "native", 2); %% test/octave.test/io/fwrite-3.m %!error fwrite ("foo", 1); %% test/octave.test/io/feof-1.m -%!error <Invalid call to feof.*> feof (); +%!error <Invalid call to feof> feof (); %% test/octave.test/io/feof-2.m -%!error <Invalid call to feof.*> feof (1, 2); +%!error <Invalid call to feof> feof (1, 2); %% test/octave.test/io/feof-3.m %!error feof ("foo"); @@ -566,28 +592,28 @@ %!error ferror ("foo"); %% test/octave.test/io/ftell-1.m -%!error <Invalid call to ftell.*> ftell (); +%!error <Invalid call to ftell> ftell (); %% test/octave.test/io/ftell-2.m -%!error <Invalid call to ftell.*> ftell (1, 2); +%!error <Invalid call to ftell> ftell (1, 2); %% test/octave.test/io/ftell-3.m %!error ftell ("foo"); %% test/octave.test/io/fseek-1.m -%!error <Invalid call to fseek.*> fseek (); +%!error <Invalid call to fseek> fseek (); %% test/octave.test/io/fseek-2.m -%!error <Invalid call to fseek.*> fseek (1, 0, SEEK_SET, 1); +%!error <Invalid call to fseek> fseek (1, 0, SEEK_SET, 1); %% test/octave.test/io/fseek-3.m %!error fseek ("foo", 0, SEEK_SET); %% test/octave.test/io/frewind-1.m -%!error <Invalid call to frewind.*> frewind (); +%!error <Invalid call to frewind> frewind (); %% test/octave.test/io/frewind-2.m -%!error <Invalid call to frewind.*> frewind (1, 2); +%!error <Invalid call to frewind> frewind (1, 2); %% test/octave.test/io/frewind-3.m %!error frewind ("foo");
deleted file mode 100644 --- a/test/test_logical-wfi-t.m +++ /dev/null @@ -1,371 +0,0 @@ -## Copyright (C) 2006-2011 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/>. - -%% test/octave.test/logical-wfi-t/s-1.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = []; -%! fail("a(0);"); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/s-2.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 2; -%! assert(a(1) == 2); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/s-3.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = 2; -%! assert(a(1) == 2); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/s-4.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%!shared a -%! a = 2; -%!error id=Octave:index-out-of-bounds a(logical ([1,1])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/v-1.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8,7,6]; -%! assert(isempty (a(logical ([0,0,0,0])))); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/v-2.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8,7,6]; -%! assert(all (a(logical ([1,1,1,1])) == [9,8,7,6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/v-3.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8,7,6]; -%! assert(all (a(logical ([0,1,1,0])) == [8,7])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/v-4.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8,7,6]; -%! assert(all (a(logical ([1,1])) == [9,8])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-1.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! isempty (a(logical ([0,0,0,0]))); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-2.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! all (a(logical ([1,1,1,1])) == [9,7,8,6]); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-3.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! all (a(logical ([0,1,1,0])) == [7,8]); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-4.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(a(logical (0:1),logical (0:1)) == 6); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-5.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(logical (0:1),2:-1:1) == [6,7])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-6.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(a(logical (0:1),logical ([0,1])) == 6); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-7.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(logical (0:1),[2,1]) == [6,7])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-8.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(logical (0:1),:) == [7,6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-9.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(a(logical (0:1),1) == 7); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-10.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(logical (0:1),logical ([1,1])) == [7,6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-11.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(2:-1:1,logical (0:1)) == [6;8])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-12.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(2:-1:1,logical ([0,1])) == [6;8])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-13.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (all (a(2:-1:1,logical ([1,1])) == [7,6;9,8]))); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-14.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(a(logical ([0,1]),logical (0:1)) == 6); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-15.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(logical ([0,1]),2:-1:1) == [6,7])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-16.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(a(logical ([0,1]),logical ([0,1])) == 6); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-17.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(logical ([0,1]),[2,1]) == [6,7])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-18.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(logical ([0,1]),:) == [7,6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-19.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(a(logical ([0,1]),1) == 7); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-20.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(logical ([0,1]),logical ([1,1])) == [7,6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-21.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a([2,1],logical (0:1)) == [6;8])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-22.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a([2,1],logical ([0,1])) == [6;8])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-23.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (all (a([2,1],logical ([1,1])) == [7,6;9,8]))); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-24.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(:,logical (0:1)) == [8;6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-25.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(:,logical ([0,1])) == [8;6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-26.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (all (a(:,logical ([1,1])) == [9,8;7,6]))); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-27.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(a(1,logical (0:1)) == 8); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-28.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(a(1,logical ([0,1])) == 8); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-29.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(1,logical ([1,1])) == [9,8])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-30.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(logical ([1,1]),logical (0:1)) == [8;6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-31.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (all (a(logical ([1,1]),2:-1:1) == [8,9;6,7]))); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-32.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(logical ([1,1]),logical ([0,1])) == [8;6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-33.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (all (a(logical ([1,1]),[2,1]) == [8,9;6,7]))); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-34.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (all (a(logical ([1,1]),:) == [9,8;7,6]))); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-35.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (a(logical ([1,1]),1) == [9;7])); -%! warning ("wfi.state", "Octave:fortran-indexing"); - -%% test/octave.test/logical-wfi-t/m-36.m -%!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("on", "Octave:fortran-indexing"); -%! a = [9,8;7,6]; -%! assert(all (all (a(logical ([1,1]),logical ([1,1])) == [9,8;7,6]))); -%! warning ("wfi.state", "Octave:fortran-indexing"); -
rename from test/test_logical-wfi-f.m rename to test/test_logical_index.m --- a/test/test_logical-wfi-f.m +++ b/test/test_logical_index.m @@ -16,356 +16,180 @@ ## along with Octave; see the file COPYING. If not, see ## <http://www.gnu.org/licenses/>. -%% test/octave.test/logical-wfi-f/s-1.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = []; %! fail("a(0);"); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/s-2.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 2; %! assert(a(1) == 2); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/s-3.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = 2; %! assert(a(1) == 2); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/s-4.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %!shared a %! a = 2; %!error id=Octave:index-out-of-bounds a(logical ([1,1])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/v-1.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8,7,6]; %! assert(isempty (a(logical ([0,0,0,0])))); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/v-2.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8,7,6]; %! assert(all (a(logical ([1,1,1,1])) == [9,8,7,6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/v-3.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8,7,6]; %! assert(all (a(logical ([0,1,1,0])) == [8,7])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/v-4.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8,7,6]; %! assert(all (a(logical ([1,1])) == [9,8])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-1.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(isempty (a(logical ([0,0,0,0])))); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-2.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(logical ([1,1,1,1])) == [9,7,8,6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-3.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(logical ([0,1,1,0])) == [7,8])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-4.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(a(logical (0:1),logical (0:1)) == 6); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-5.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(logical (0:1),2:-1:1) == [6,7])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-6.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(a(logical (0:1),logical ([0,1])) == 6); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-7.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(logical (0:1),[2,1]) == [6,7])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-8.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(logical (0:1),:) == [7,6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-9.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(a(logical (0:1),1) == 7); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-10.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(logical (0:1),logical ([1,1])) == [7,6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-11.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(2:-1:1,logical (0:1)) == [6;8])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-12.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(2:-1:1,logical ([0,1])) == [6;8])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-13.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (all (a(2:-1:1,logical ([1,1])) == [7,6;9,8]))); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-14.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(a(logical ([0,1]),logical (0:1)) == 6); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-15.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(logical ([0,1]),2:-1:1) == [6,7])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-16.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(a(logical ([0,1]),logical ([0,1])) == 6); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-17.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(logical ([0,1]),[2,1]) == [6,7])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-18.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(logical ([0,1]),:) == [7,6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-19.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(a(logical ([0,1]),1) == 7); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-20.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(logical ([0,1]),logical ([1,1])) == [7,6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-21.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a([2,1],logical (0:1)) == [6;8])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-22.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a([2,1],logical ([0,1])) == [6;8])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-23.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (all (a([2,1],logical ([1,1])) == [7,6;9,8]))); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-24.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(:,logical (0:1)) == [8;6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-25.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(:,logical ([0,1])) == [8;6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-26.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (all (a(:,logical ([1,1])) == [9,8;7,6]))); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-27.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(a(1,logical (0:1)) == 8); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-28.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(a(1,logical ([0,1])) == 8); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-29.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(1,logical ([1,1])) == [9,8])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-30.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(logical ([1,1]),logical (0:1)) == [8;6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-31.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (all (a(logical ([1,1]),2:-1:1) == [8,9;6,7]))); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-32.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(logical ([1,1]),logical ([0,1])) == [8;6])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-33.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (all (a(logical ([1,1]),[2,1]) == [8,9;6,7]))); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-34.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (all (a(logical ([1,1]),:) == [9,8;7,6]))); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-35.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (a(logical ([1,1]),1) == [9;7])); -%! warning ("wfi.state", "Octave:fortran-indexing"); -%% test/octave.test/logical-wfi-f/m-36.m %!test -%! wfi = warning ("query", "Octave:fortran-indexing"); -%! warning ("off", "Octave:fortran-indexing"); %! a = [9,8;7,6]; %! assert(all (all (a(logical ([1,1]),logical ([1,1])) == [9,8;7,6]))); -%! warning ("wfi.state", "Octave:fortran-indexing");
--- a/test/test_parser.m +++ b/test/test_parser.m @@ -27,3 +27,230 @@ %!assert ({1 2,{3 4}}, {1,2,{3,4}}) %!assert ({1 2,{3,4}}, {1,2,{3,4}}) %!assert ({1,2,{3 4}}, {1,2,{3,4}}) + +## Tests for operator precedence as documented in section 8.8 of manual +## There are 13 levels of precedence from "parentheses and indexing" (highest) +## down to "statement operators" (lowest). +## +## Level 13 (parentheses and indexing) +## Overrides all other levels +%!test +%! a.b = 1; +%! assert (a. b++, 1) +%! assert (a.b, 2) +%! clear a; +%! a.b = [0 1]; +%! b = 2; +%! assert (a.b', [0;1]) +%! assert (!a .b, logical ([1 0])) +%! assert (3*a .b, [0 3]) +%! assert (a. b-1, [-1 0]) +%! assert (a. b:3, 0:3) +%! assert (a. b>0.5, logical ([0 1])) +%! assert (a. b&0, logical ([0 0])) +%! assert (a. b|0, logical ([0 1])) +%! a.b = [1 2]; +%! assert (a. b&&0, false) +%! assert (a. b||0, true) +%! a.b += a. b*2; +%! assert (a.b, [3 6]) +## Level 12 (postfix increment and decrement) +%!test +%! a = [3 5]; +%! assert (2.^a ++, [8 32]) +%! assert (a, [4 6]) +%! assert (a--', [4; 6]) +%! assert (a, [3 5]) +%! a = 0; +%! assert (!a --, true) +%! assert (-a ++, 1) +%! assert (3*a ++, 0) +%! assert (a++-2, -1) +%! assert (1:a ++, 1:2) +%! assert (4>a++, true) +%! a = [0 -1]; +%! assert ([1 1] & a++, logical ([0 1])) +%! assert ([0 0] | a++, logical ([1 0])) +%! a = 0; +%! assert (1 && a ++, false) +%! assert (0 || a --, true) +%! a = 5; b = 2; +%! b +=a ++; +%! assert (b, 7) + +## Level 11 (transpose and exponentiation) +%!test +%! assert (-2 ^2, -4) +%! assert (!0 ^0, false) +%! assert (2*3 ^2, 18) +%! assert (2+3 ^2, 11) +%! assert ([1:10](1:2 ^2), [1 2 3 4]) +%! assert (3>2 ^2, false) +%! assert (1&0 ^0, true) +%! assert (0|0 ^0, true) +%! assert (1&&0 ^0, true) +%! assert (0||0 ^0, true) +%! a = 3; +%! a *= 0 ^0; +%! assert (a, 3) +## Level 10 (unary plus/minus, prefix increment/decrement, not) +%!test +%! a = 2; +%! assert (++ a*3, 9) +%! assert (-- a-2, 0) +%! assert (a, 2) +%! assert (! a-2, -2) +%! assert ([1:10](++ a:5), 3:5) +%! a = [1 0]; +%! assert (! a>=[1 0], [false true]) +%! a = 0; +%! assert (++ a&1, true) +%! assert (-- a|0, false) +%! assert (-- a&&1, true) +%! assert (++ a||0, false) +%! a = 3; +%! a *= ++a; +%! assert (a, 16) +## Level 9 (multiply, divide) +%!test +%! assert (3+4 * 5, 23) +%! assert (5 * 1:6, [5 6]) +%! assert (3>1 * 5, false) +%! assert (1&1 * 0, false) +%! assert (1|1 * 0, true) +%! assert (1&&1 * 0, false) +%! assert (1||1 * 0, true) +%! a = 3; +%! a /= a * 2; +%! assert (a, 0.5) +## Level 8 (add, subtract) +%!test +%! assert ([2 + 1:6], 3:6) +%! assert (3>1 + 5, false) +%! assert (1&1 - 1, false) +%! assert (0|1 - 2, true) +%! assert (1&&1 - 1, false) +%! assert (0||1 - 2, true) +%! a = 3; +%! a *= 1 + 1; +%! assert (a, 6) +## Level 7 (colon) +%!test +%! assert (5:-1: 3>4, [true false false]) +%! assert (1: 3&1, [true true true]) +%! assert (1: 3|0, [true true true]) +%! assert (-1: 3&&1, false) +%! assert (-1: 3||0, false) +%! a = [1:3]; +%! a += 3 : 5; +%! assert (a, [4 6 8]) +## Level 6 (relational) +%!test +%! assert (0 == -1&0, false) +%! assert (1 == -1|0, false) +%! assert (0 == -1&&0, false) +%! assert (1 == -1||0, false) +%! a = 2; +%! a *= 3 > 1; +%! assert (a, 2) +## Level 5 (element-wise and) +%!test +%! assert (0 & 1|1, true) +%! assert ([0 1] & 1&&1, false) +%! assert (0 & 1||1, true) +%! a = 2; +%! a *= 3 & 1; +%! assert (a, 2) +## Level 4 (element-wise or) +%!test +%! assert ([0 1] | 1&&0, false) +%! assert ([0 1] | 1||0, true) +%! a = 2; +%! a *= 0 | 1; +%! assert (a, 2) +## Level 3 (logical and) +%!test +%! assert (0 && 1||1, true) +%! a = 2; +%! a *= 3 && 1; +%! assert (a, 2) +## Level 2 (logical or) +%!test +%! a = 2; +%! a *= 0 || 1; +%! assert (a, 2) + +## Tests for operator precedence within each level where ordering should +## be left to right except for postfix and assignment operators. + +## Level 13 (parentheses and indexing) +%!test +%! a.b1 = 2; +%! assert (a.(strcat('b','1'))++, 2) +%! assert (a.b1, 3) +%! b = {1 2 3 4 5}; +%! assert (b{(a. b1 + 1)}, 4) +%! b = 1:5; +%! assert (b(a. b1 + 1), 4) +%! assert ([2 3].^2', [4; 9]) +## Level 12 (postfix increment and decrement) +## No tests possible since a++-- is not valid +## Level 11 (transpose and exponentiation) +## Note: Exponentiation works left to right for compatibility with Matlab. +%! assert (2^3**2, 64) +%! assert ([2 3].^2.', [4;9]) +%! assert ([2 3].'.^2, [4;9]) +%! assert (3*4i'.', 0 - 12i) +%! assert (3*4i.'.', 0 + 12i) +## Level 10 (unary plus/minus, prefix increment/decrement, not) +%!test +%! assert (+-+1, -1) +%! a = -1; +%! assert (!++a, true) +%! assert (a, 0) +%! assert (-~a, -1) +%! assert (!~--a, true) +%! assert (a, -1) +## Level 9 (multiply, divide) +%!test +%! assert (3 * 4 / 5, 2.4) +%! assert (3 ./ 4 .* 5, 3.75) +%! assert (2 * 4 \ 6, 0.75) +%! assert (2 .\ 4 .* 6, 12) +## Level 8 (add, subtract) +%!test +%! assert (-3 - 4 + 1 + 3 * 2, 0) +## Level 7 (colon) +## No tests possible because colon operator can't be combined with second colon operator +## Level 6 (relational) +%!test +%! assert (0 < 1 <= 0.5 == 0 >= 0.5 > 0, true) +%! assert (1 < 1 == 0 != 0, true) +%! assert (1 < 1 == 0 ~= 0, true) +## Level 5 (element-wise and) +## No tests possible. Only one operator (&) at this precedence level and operation is associative. +## Level 4 (element-wise or) +## No tests possible. Only one operator (|) at this precedence level and operation is associative. +## Level 3 (logical and) +%!test +%! a = 1; +%! assert (1 && 0 && ++a, false) +%! assert (a, 1) +## Level 2 (logical or) +%!test +%! a = 1; +%! assert (0 || 1 || ++a, true) +%! assert (a, 1) +## Level 1 (assignment) +%!test +%! a = 2; b = 5; c = 7; +%! assert (a += b *= c += 1, 42) +%! assert (b == 40 && c == 8) + +%!test +%! af_in_cell = {@(x) [1 2]}; +%! assert (af_in_cell{1}(), [1, 2]); + +%!test +%! R = @(rot) [cos(rot) -sin(rot); sin(rot) cos(rot)]; +%! assert (R(pi/2), [cos(pi/2), -sin(pi/2); sin(pi/2),cos(pi/2)]);
deleted file mode 100644 --- a/test/test_string.m +++ /dev/null @@ -1,454 +0,0 @@ -## Copyright (C) 2006-2011 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/>. - -%% test/octave.test/string/str-esc-1.m -%!test -%! x = 7; -%! if (strcmp ("\a", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-2.m -%!test -%! x = 8; -%! if (strcmp ("\b", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-3.m -%!test -%! x = 12; -%! if (strcmp ("\f", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-4.m -%!test -%! x = 10; -%! if (strcmp ("\n", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-5.m -%!test -%! x = 13; -%! if (strcmp ("\r", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-6.m -%!test -%! x = 9; -%! if (strcmp ("\t", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-7.m -%!test -%! x = 11; -%! if (strcmp ("\v", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-8.m -%!test -%! x = 92; -%! if (strcmp ("\\", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-9.m -%!test -%! x = 39; -%! if (strcmp ("\'", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-10.m -%!test -%! x = 34; -%! if (strcmp ("\"", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-11.m -%!test -%! x = 120; -%! fail('strcmp ("\x", setstr (x))',"warning",".*unrecognized escape sequence.*"); - -%% test/octave.test/string/str-esc-12.m -%!test -%! x = [7, 8, 12, 10, 13, 9, 11, 92, 39, 34]; -%! if (strcmp ("\a\b\f\n\r\t\v\\\'\"", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% FIXME -%% Why do the next two tests fail? -%% test/octave.test/string/string_fill_char-1.m -%!#test -%! sfc = string_fill_char; -%! string_fill_char = "X"; -%! str = ["these"; "are"; "strings"]; -%! assert(str,["theseXX"; "areXXXX"; "strings"]); -%! string_fill_char = sfc; - -%% test/octave.test/string/string_fill_char-2.m -%!#test -%! sfc = string_fill_char; -%! string_fill_char = " "; -%! str = ["these"; "are"; "strings"]; -%! assert(str,["these "; "are "; "strings"]); -%! string_fill_char = sfc; - -%% test/octave.test/string/ischar-1.m -%!assert(!(ischar (1))); - -%% test/octave.test/string/ischar-2.m -%!assert(!(ischar ([1, 2]))); - -%% test/octave.test/string/ischar-3.m -%!assert(!(ischar ([]))); - -%% test/octave.test/string/ischar-4.m -%!assert(!(ischar ([1, 2; 3, 4]))); - -%% test/octave.test/string/ischar-5.m -%!assert(ischar ("")); - -%% test/octave.test/string/ischar-6.m -%!assert(ischar ("t")); - -%% test/octave.test/string/ischar-7.m -%!assert(ischar ("test")); - -%% test/octave.test/string/ischar-8.m -%!assert(ischar (["test"; "ing"])); - -%% test/octave.test/string/ischar-9.m -%!test -%! s.a = "test"; -%! assert(!(ischar (s))); - -%% test/octave.test/string/ischar-10.m -%!error <Invalid call to ischar.*> ischar (); - -%% test/octave.test/string/ischar-11.m -%!error <Invalid call to ischar.*> ischar ("test", 1); - - -%% test/octave.test/string/char-1.m -%!assert(strcmp (char ([65, 83, 67, 73, 73]), "ASCII")); - -%% test/octave.test/string/char-2.m -%!error <Invalid call to char.*> char (); - -%% test/octave.test/string/char-3.m -%!test -%! x = char ("foo", "bar", "foobar"); -%! assert((strcmp (x(1,:), "foo ") -%! && strcmp (x(2,:), "bar ") -%! && strcmp (x(3,:), "foobar"))); - - -%% test/octave.test/string/strcmp-1.m -%!assert(strcmp ("foobar", "foobar") && strcmp ("fooba", "foobar") == 0); - -%% test/octave.test/string/strcmp-2.m -%!error <Invalid call to strcmp.*> strcmp (); - -%% test/octave.test/string/strcmp-3.m -%!error <Invalid call to strcmp.*> strcmp ("foo", "bar", 3); - - - -%% test/octave.test/string/undo_string_escapes-1.m -%!assert(strcmp (undo_string_escapes ("abc\a\b\n\r\t\v\f123"), -%! "abc\\a\\b\\n\\r\\t\\v\\f123")); - -%% test/octave.test/string/undo_string_escapes-2.m -%!error <Invalid call to undo_string_escapes.*> undo_string_escapes (); - -%% test/octave.test/string/undo_string_escapes-3.m -%!error <Invalid call to undo_string_escapes.*> undo_string_escapes ("string", 2); - -%% test/octave.test/string/toascii-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = 0:127; -%! -%! assert(all (toascii (charset) == result)); - -%% test/octave.test/string/toascii-3.m -%!error toascii (1, 2); - -%% test/octave.test/string/toascii-3.m -%!error toascii (1, 2); - -%% test/octave.test/string/tolower-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = charset; -%! -%! result ((toascii("A"):toascii("Z"))+1) \ -%! = result ((toascii("a"):toascii("z"))+1); -%! -%! assert(all (tolower (charset) == result)); - -%% test/octave.test/string/tolower-3.m -%!error tolower (1, 2); - -%% test/octave.test/string/tolower-3.m -%!error tolower (1, 2); - -%% test/octave.test/string/toupper-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = charset; -%! -%! result ((toascii("a"):toascii("z"))+1) \ -%! = result ((toascii("A"):toascii("Z"))+1); -%! -%! assert(all (toupper (charset) == result)); - -%% test/octave.test/string/toupper-3.m -%!error toupper (1, 2); - -%% test/octave.test/string/toupper-3.m -%!error toupper (1, 2); - -%% test/octave.test/string/isalnum-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result ((toascii("A"):toascii("Z"))+1) = 1; -%! result ((toascii("0"):toascii("9"))+1) = 1; -%! result ((toascii("a"):toascii("z"))+1) = 1; -%! -%! assert(all (isalnum (charset) == result)); - -%% test/octave.test/string/isalnum-2.m -%!error isalnum (1, 2); - -%% test/octave.test/string/isalnum-3.m -%!error isalnum (); - -%% test/octave.test/string/isalpha-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result ((toascii("A"):toascii("Z"))+1) = 1; -%! result ((toascii("a"):toascii("z"))+1) = 1; -%! -%! assert(all (isalpha (charset) == result)); - -%% test/octave.test/string/isalpha-2.m -%!error isalpha (1, 2); - -%% test/octave.test/string/isalpha-3.m -%!error isalpha (); - -%% test/octave.test/string/isascii-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = ones (1, 128); -%! -%! assert(all (isascii (charset) == result)); - -%% test/octave.test/string/isascii-2.m -%!error isascii (1, 2); - -%% test/octave.test/string/isascii-3.m -%!error isascii (); - -%% test/octave.test/string/iscntrl-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result (1:32) = 1; -%! result (128) = 1; -%! -%! assert(all (iscntrl (charset) == result)); - -%% test/octave.test/string/iscntrl-2.m -%!error iscntrl (1, 2); - -%% test/octave.test/string/iscntrl-3.m -%!error iscntrl (); - -%% test/octave.test/string/isdigit-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result ((toascii("0"):toascii("9"))+1) = 1; -%! -%! assert(all (isdigit (charset) == result)); - -%% test/octave.test/string/isdigit-2.m -%!error isdigit (1, 2); - -%% test/octave.test/string/isdigit-3.m -%!error isdigit (); - -%% test/octave.test/string/isgraph-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result (34:127) = 1; -%! -%! assert(all (isgraph (charset) == result)); - -%% test/octave.test/string/isgraph-2.m -%!error isgraph (1, 2); - -%% test/octave.test/string/isgraph-3.m -%!error isgraph (); - -%% test/octave.test/string/islower-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result ((toascii("a"):toascii("z"))+1) = 1; -%! -%! assert(all (islower (charset) == result)); - -%% test/octave.test/string/islower-2.m -%!error islower (1, 2); - -%% test/octave.test/string/islower-3.m -%!error islower (); - -%% test/octave.test/string/isprint-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result (33:127) = 1; -%! if (ispc () && ! isunix ()) -%! result(10) = 1; -%! endif -%! -%! assert(all (isprint (charset) == result)); - -%% test/octave.test/string/isprint-2.m -%!error isprint (1, 2); - -%% test/octave.test/string/isprint-3.m -%!error isprint (); - -%% test/octave.test/string/ispunct-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result (34:48) = 1; -%! result (59:65) = 1; -%! result (92:97) = 1; -%! result (124:127) = 1; -%! -%! assert(all (ispunct (charset) == result)); - -%% test/octave.test/string/ispunct-2.m -%!error ispunct (1, 2); - -%% test/octave.test/string/ispunct-3.m -%!error ispunct (); - -%% test/octave.test/string/isspace-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result (toascii (" \f\n\r\t\v")+1) = 1; -%! -%! assert(all (isspace (charset) == result)); - -%% test/octave.test/string/isspace-2.m -%!error isspace (1, 2); - -%% test/octave.test/string/isspace-3.m -%!error isspace (); - -%% test/octave.test/string/isupper-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result ((toascii("A"):toascii("Z"))+1) = 1; -%! -%! assert(all (isupper (charset) == result)); - -%% test/octave.test/string/isupper-2.m -%!error isupper (1, 2); - -%% test/octave.test/string/isupper-3.m -%!error isupper (); - -%% test/octave.test/string/isxdigit-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result ((toascii("A"):toascii("F"))+1) = 1; -%! result ((toascii("0"):toascii("9"))+1) = 1; -%! result ((toascii("a"):toascii("f"))+1) = 1; -%! -%! assert(all (isxdigit (charset) == result)); - -%% test/octave.test/string/isxdigit-2.m -%!error isxdigit (1, 2); - -%% test/octave.test/string/isxdigit-3.m -%!error isxdigit (); - -%% test concatenation with all zero matrices -%!assert([ '' 65*ones(1,10) ], 'AAAAAAAAAA'); -%!assert([ 65*ones(1,10) '' ], 'AAAAAAAAAA'); -
--- a/test/test_struct.m +++ b/test/test_struct.m @@ -29,7 +29,7 @@ %! assert(iscell (c) && strcmp (c{1}, "b")); %% test/octave.test/struct/fieldnames-3.m -%!error <Invalid call to fieldnames.*> fieldnames (); +%!error <Invalid call to fieldnames> fieldnames (); %% test/octave.test/struct/fieldnames-4.m %!test @@ -52,7 +52,7 @@ %! assert(!(isfield (s, "b"))); %% test/octave.test/struct/isfield-3.m -%!error <Invalid call to isfield.*> isfield (); +%!error <Invalid call to isfield> isfield (); %% test/octave.test/struct/isfield-4.m %!test @@ -100,7 +100,7 @@ %! assert(isstruct (s.a)); %% test/octave.test/struct/isstruct-10.m -%!error <Invalid call to isstruct.*> isstruct (); +%!error <Invalid call to isstruct> isstruct (); %% test/octave.test/struct/isstruct-11.m %!test
--- a/test/test_system.m +++ b/test/test_system.m @@ -39,7 +39,7 @@ %! assert(prog_output_assert("ok")); %% test/octave.test/system/pause-2.m -%!error <Invalid call to pause.*> pause (1, 2); +%!error <Invalid call to pause> pause (1, 2); %% test/octave.test/system/sleep-1.m %!test @@ -48,10 +48,10 @@ %! assert(prog_output_assert("ok")); %% test/octave.test/system/sleep-2.m -%!error <Invalid call to sleep.*> sleep (); +%!error <Invalid call to sleep> sleep (); %% test/octave.test/system/sleep-3.m -%!error <Invalid call to sleep.*> sleep (1, 2); +%!error <Invalid call to sleep> sleep (1, 2); %% test/octave.test/system/usleep-1.m %!test @@ -60,10 +60,10 @@ %! assert(prog_output_assert("ok")); %% test/octave.test/system/usleep-2.m -%!error <Invalid call to usleep.*> usleep (); +%!error <Invalid call to usleep> usleep (); %% test/octave.test/system/usleep-3.m -%!error <Invalid call to usleep.*> usleep (1, 2); +%!error <Invalid call to usleep> usleep (1, 2); %% test/octave.test/system/rename-1.m %!test @@ -85,10 +85,10 @@ %! endif %% test/octave.test/system/rename-2.m -%!error <Invalid call to rename.*> rename (); +%!error <Invalid call to rename> rename (); %% test/octave.test/system/rename-3.m -%!error <Invalid call to rename.*> rename ("foo", "bar", 1); +%!error <Invalid call to rename> rename ("foo", "bar", 1); %% test/octave.test/system/unlink-1.m %!test @@ -102,10 +102,10 @@ %! endif %% test/octave.test/system/unlink-2.m -%!error <Invalid call to unlink.*> unlink (); +%!error <Invalid call to unlink> unlink (); %% test/octave.test/system/unlink-3.m -%!error <Invalid call to unlink.*> unlink ("foo", 1); +%!error <Invalid call to unlink> unlink ("foo", 1); %% test/octave.test/system/readdir-1.m %!test @@ -113,10 +113,10 @@ %! assert(iscell (files) && status == 0 && strcmp (msg, "")); %% test/octave.test/system/readdir-2.m -%!error <Invalid call to readdir.*> readdir (); +%!error <Invalid call to readdir> readdir (); %% test/octave.test/system/readdir-3.m -%!error <Invalid call to readdir.*> readdir ("foo", 1); +%!error <Invalid call to readdir> readdir ("foo", 1); %% test/octave.test/system/mk-rm-dir-1.m %!test @@ -128,13 +128,13 @@ %! assert((e1 && strcmp (s2.modestr(1), "d") && e3 && e4 < 0)); %% test/octave.test/system/mkdir-1.m -%!error <Invalid call to mkdir.*> mkdir (); +%!error <Invalid call to mkdir> mkdir (); %% test/octave.test/system/mkdir-2.m -%!error <Invalid call to mkdir.*> mkdir ("foo", 1, 2); +%!error <Invalid call to mkdir> mkdir ("foo", 1, 2); %% test/octave.test/system/rmdir-1.m -%!error <Invalid call to rmdir.*> rmdir (); +%!error <Invalid call to rmdir> rmdir (); %% test/octave.test/system/rmdir-2.m %!test @@ -163,10 +163,10 @@ %! assert(strcmp (s1.modestr, "-rw-rw-rw-") && strcmp (s2.modestr, "----------")); %% test/octave.test/system/umask-2.m -%!error <Invalid call to umask.*> umask (); +%!error <Invalid call to umask> umask (); %% test/octave.test/system/umask-3.m -%!error <Invalid call to umask.*> umask (1, 2); +%!error <Invalid call to umask> umask (1, 2); %% test/octave.test/system/stat-1.m %!test @@ -186,10 +186,10 @@ %! && ischar (msg))); %% test/octave.test/system/stat-2.m -%!error <Invalid call to stat.*> stat (); +%!error <Invalid call to stat> stat (); %% test/octave.test/system/stat-3.m -%!error <Invalid call to stat.*> stat ("foo", 1); +%!error <Invalid call to stat> stat ("foo", 1); %% test/octave.test/system/lstat-1.m %!test @@ -209,10 +209,10 @@ %! && ischar (msg))); %% test/octave.test/system/lstat-2.m -%!error <Invalid call to lstat.*> lstat (); +%!error <Invalid call to lstat> lstat (); %% test/octave.test/system/lstat-3.m -%!error <Invalid call to lstat.*> lstat ("foo", 1); +%!error <Invalid call to lstat> lstat ("foo", 1); %% test/octave.test/system/glob-1.m %!assert(iscell (glob ([filesep "*"]))); @@ -221,7 +221,7 @@ %!error <Invalid call to glob*> glob (); %% test/octave.test/system/glob-3.m -%!error <Invalid call to glob.*> glob ("foo", 1); +%!error <Invalid call to glob> glob ("foo", 1); %% test/octave.test/system/fnmatch-1.m %!test @@ -233,10 +233,10 @@ %! && fnmatch ("x???y", {"xabcy"; "xy"}) == [1; 0])); %% test/octave.test/system/fnmatch-2.m -%!error <Invalid call to fnmatch.*> fnmatch (); +%!error <Invalid call to fnmatch> fnmatch (); %% test/octave.test/system/fnmatch-3.m -%!error <Invalid call to fnmatch.*> fnmatch ("foo", "bar", 3); +%!error <Invalid call to fnmatch> fnmatch ("foo", "bar", 3); %% test/octave.test/system/file_in_path-1.m %!assert(ischar (file_in_path (path (), "date.m"))); @@ -245,10 +245,10 @@ %!error <invalid option> file_in_path ("foo", "bar", 1); %% test/octave.test/system/file_in_path-3.m -%!error <Invalid call to file_in_path.*> file_in_path (); +%!error <Invalid call to file_in_path> file_in_path (); %% test/octave.test/system/file_in_path-4.m -%!error <Invalid call to file_in_path.*> file_in_path ("foo", "bar", "baz", "ooka"); +%!error <Invalid call to file_in_path> file_in_path ("foo", "bar", "baz", "ooka"); %% test/octave.test/system/tilde_expand-1.m %!testif HAVE_GETPWUID @@ -258,10 +258,10 @@ %! && strcmp ("foobar", tilde_expand ("foobar")))); %% test/octave.test/system/tilde_expand-2.m -%!error <Invalid call to tilde_expand.*> tilde_expand (); +%!error <Invalid call to tilde_expand> tilde_expand (); %% test/octave.test/system/tilde_expand-3.m -%!error <Invalid call to tilde_expand.*> tilde_expand ("str", 2); +%!error <Invalid call to tilde_expand> tilde_expand ("str", 2); %% test/octave.test/system/getpgrp-1.m %!testif HAVE_GETPGRP @@ -311,10 +311,10 @@ %!assert(strcmp (getenv ("HOME"), tilde_expand ("~"))); %% test/octave.test/system/getenv-2.m -%!error <Invalid call to getenv.*> getenv (); +%!error <Invalid call to getenv> getenv (); %% test/octave.test/system/getenv-3.m -%!error <Invalid call to getenv.*> getenv ("foo", 1); +%!error <Invalid call to getenv> getenv ("foo", 1); %% test/octave.test/system/getenv-4.m %!test @@ -329,10 +329,10 @@ %! assert(strcmp (getenv ("foobar"), "baz")); %% test/octave.test/system/putenv-2.m -%!error <Invalid call to putenv.*> putenv (); +%!error <Invalid call to putenv> putenv (); %% test/octave.test/system/putenv-3.m -%!error <Invalid call to putenv.*> putenv ("foo", "bar", 1); +%!error <Invalid call to putenv> putenv ("foo", "bar", 1); %% test/octave.test/system/putenv-4.m %!test @@ -377,7 +377,7 @@ %! && isfield (s, "shell"))); %% test/octave.test/system/getpwent-2.m -%!error <Invalid call to getpwent.*> getpwent (1); +%!error <Invalid call to getpwent> getpwent (1); %% test/octave.test/system/getpwuid-1.m %!testif HAVE_GETPWUID @@ -387,10 +387,10 @@ %! assert(strcmp (x.name, y.name) && x.uid == y.uid && x.gid == y.gid); %% test/octave.test/system/getpwuid-2.m -%!error <Invalid call to getpwuid.*> getpwuid (); +%!error <Invalid call to getpwuid> getpwuid (); %% test/octave.test/system/getpwuid-3.m -%!error <Invalid call to getpwuid.*> getpwuid (1, 2); +%!error <Invalid call to getpwuid> getpwuid (1, 2); %% test/octave.test/system/getpwnam-1.m %!testif HAVE_GETPWNAM @@ -400,10 +400,10 @@ %! assert(strcmp (x.name, y.name) && x.uid == y.uid && x.gid == y.gid); %% test/octave.test/system/getpwnam-2.m -%!error <Invalid call to getpwnam.*> getpwnam (); +%!error <Invalid call to getpwnam> getpwnam (); %% test/octave.test/system/getpwnam-3.m -%!error <Invalid call to getpwnam.*> getpwnam ("foo", 1); +%!error <Invalid call to getpwnam> getpwnam ("foo", 1); %% test/octave.test/system/setpwent-1.m %!testif HAVE_SETPWENT @@ -414,10 +414,10 @@ %! assert(strcmp (x.name, y.name) && x.uid == y.uid && x.gid == y.gid); %% test/octave.test/system/setpwent-2.m -%!error <Invalid call to setpwent.*> setpwent (1); +%!error <Invalid call to setpwent> setpwent (1); %% test/octave.test/system/endpwent-1.m -%!error <Invalid call to endpwent.*> endpwent (1); +%!error <Invalid call to endpwent> endpwent (1); %% test/octave.test/system/getgrent-1.m %!testif HAVE_GETGRENT @@ -430,7 +430,7 @@ %! && isfield (x, "mem"))); %% test/octave.test/system/getgrent-2.m -%!error <Invalid call to getgrent.*> getgrent (1); +%!error <Invalid call to getgrent> getgrent (1); %% test/octave.test/system/getgrgid-1.m %!testif HAVE_GETGRGID @@ -440,10 +440,10 @@ %! assert(strcmp (x.name, y.name) && x.gid == y.gid); %% test/octave.test/system/getgrgid-2.m -%!error <Invalid call to getgrgid.*> getgrgid (); +%!error <Invalid call to getgrgid> getgrgid (); %% test/octave.test/system/getgrgid-3.m -%!error <Invalid call to getgrgid.*> getgrgid (1, 2); +%!error <Invalid call to getgrgid> getgrgid (1, 2); %% test/octave.test/system/getgrnam-1.m %!testif HAVE_GETGRNAM @@ -453,10 +453,10 @@ %! assert(strcmp (x.name, y.name) && x.gid == y.gid); %% test/octave.test/system/getgrnam-2.m -%!error <Invalid call to getgrnam.*> getgrnam (); +%!error <Invalid call to getgrnam> getgrnam (); %% test/octave.test/system/getgrnam-3.m -%!error <Invalid call to getgrnam.*> getgrnam ("foo", 1); +%!error <Invalid call to getgrnam> getgrnam ("foo", 1); %% test/octave.test/system/setgrent-1.m %!testif HAVE_SETGRENT @@ -467,10 +467,10 @@ %! assert(strcmp (x.name, y.name) && x.gid == y.gid); %% test/octave.test/system/setgrent-2.m -%!error <Invalid call to setgrent.*> setgrent (1); +%!error <Invalid call to setgrent> setgrent (1); %% test/octave.test/system/endgrent-1.m -%!error <Invalid call to endgrent.*> endgrent (1); +%!error <Invalid call to endgrent> endgrent (1); %% test/octave.test/system/isieee-1.m %!assert(isieee () == 1 || isieee () == 0);