Mercurial > octave-nkf
changeset 14029:b265b592c796 stable
merge default onto stable for 3.6.x release series
| author | John W. Eaton <jwe@octave.org> |
|---|---|
| date | Sun, 11 Dec 2011 23:24:25 -0500 |
| parents | 95bcbecf5801 (current diff) 2ed17790425e (diff) |
| children | 08569c50df6f |
| files | doc/interpreter/dir doc/interpreter/eos.txi liboctave/regex-match.cc liboctave/regex-match.h scripts/deprecated/complement.m scripts/deprecated/create_set.m scripts/deprecated/dmult.m scripts/deprecated/iscommand.m scripts/deprecated/israwcommand.m scripts/deprecated/lchol.m scripts/deprecated/loadimage.m scripts/deprecated/mark_as_command.m scripts/deprecated/mark_as_rawcommand.m scripts/deprecated/spatan2.m scripts/deprecated/spchol.m scripts/deprecated/spchol2inv.m scripts/deprecated/spcholinv.m scripts/deprecated/spcumprod.m scripts/deprecated/spcumsum.m scripts/deprecated/spdet.m scripts/deprecated/spdiag.m scripts/deprecated/spfind.m scripts/deprecated/spinv.m scripts/deprecated/spkron.m scripts/deprecated/splchol.m scripts/deprecated/split.m scripts/deprecated/splu.m scripts/deprecated/spmax.m scripts/deprecated/spmin.m scripts/deprecated/spprod.m scripts/deprecated/spqr.m scripts/deprecated/spsum.m scripts/deprecated/spsumsq.m scripts/deprecated/str2mat.m scripts/deprecated/unmark_command.m scripts/deprecated/unmark_rawcommand.m scripts/elfun/lcm.m scripts/general/arrayfun.m scripts/geometry/trimesh.m scripts/geometry/triplot.m scripts/geometry/trisurf.m scripts/help/__strip_html_tags__.m scripts/linear-algebra/gmres.m scripts/miscellaneous/unimplemented.m scripts/plot/__fltk_ginput__.m scripts/plot/__fltk_print__.m scripts/plot/__gnuplot_drawnow__.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/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 src/DLD-FUNCTIONS/onCleanup.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/test_classes.m test/test_string.m |
| diffstat | 1164 files changed, 42605 insertions(+), 25041 deletions(-) [+] |
line wrap: on
line diff
--- a/.dir-locals.el Mon Dec 05 02:02:22 2011 -0500 +++ b/.dir-locals.el Sun Dec 11 23:24:25 2011 -0500 @@ -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))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.hgsub Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,1 @@ +gnulib = [git]git://git.sv.gnu.org/gnulib
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.hgsubstate Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,1 @@ +bb052d4a7416accaad0747e84bd2a0accbfcf923 gnulib
--- a/.hgtags Mon Dec 05 02:02:22 2011 -0500 +++ b/.hgtags Sun Dec 11 23:24:25 2011 -0500 @@ -53,3 +53,4 @@ 901d466ee55ac902a875ec0ade6f1eccef0841dc release-3-4-1 3666e8e6f96e6899b8306d6ea9614aadf0500d67 release-3-4-2 b0e70a71647b671ebcfa7a79af1ae6d3c0f52065 release-3-4-3 +3781981be535e80d44c85373b8fdaa60ca5cd097 ss-3-5-90
--- a/NEWS Mon Dec 05 02:02:22 2011 -0500 +++ b/NEWS Sun Dec 11 23:24:25 2011 -0500 @@ -1,8 +1,168 @@ +Summary of important user-visible changes for version 3.6: +--------------------------------------------------------- + + ** The PCRE library is now required to build Octave. + + ** The following binary elementwise operators and functions now perform + Numpy-like broadcasting (a.k.a. binary singleton expansion): + + plus ldivide rem eq gt xor + minus power mod ne ge + times max atan2 lt and + rdivide min hypot le or + + + .* & + - ./ | + .+ .\ + .- .^ + + += .*= &= + -= ./= |= + .+= .\= + .-= .^= + + This makes the bsxfun function mostly redundant except for + user-defined functions. A new section in the manual has been written + to explain and clarify this change. + + ** 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: + + * ML-compatible whitespace and delimiter defaults + + * ML-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. + strtrim: Now requires character or cellstr input. + No longer trims nulls ("\0") from string for ML compatibility. + strmatch: Follows documentation precisely and ignores trailing spaces + in pattern and in string. Note that Matlab documents this + behavior but the implementation 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. + + ** Octave warning IDs updated + "associativity-change": removed + "complex-cmp-ops" : removed + "empty-list-elements" : removed + "fortran-indexing" : removed + "precedence-change" : removed + "string-concat" : renamed to "mixed-string-concat" + + ** Matlab-compatible preference functions added: + + addpref getpref ispref rmpref setpref + + ** Matlab-compatible handle graphics functions 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 on + the FLTK backend. + + The gnuplot backend does not support any of the uiXXX functions nor + the waitfor function. + + ** New keyword parfor + + 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 + removed from Octave 3.6. + + create_set spcholinv splu + dmult spcumprod spmax + iscommand spcumsum spmin + israwcommand spdet spprod + lchol spdiag spqr + loadimage spfind spsum + mark_as_command sphcat spsumsq + mark_as_rawcommand spinv spvcat + spatan2 spkron str2mat + spchol splchol unmark_command + spchol2inv split unmark_rawcommand + + The following functions have been deprecated in Octave 3.6 and will + be removed from Octave 3.10 (or whatever version is the second major + release after 3.6): + + 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: -----------------------------------------------------------
--- a/build-aux/bootstrap Mon Dec 05 02:02:22 2011 -0500 +++ b/build-aux/bootstrap Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- a/build-aux/bootstrap.conf Mon Dec 05 02:02:22 2011 -0500 +++ b/build-aux/bootstrap.conf Sun Dec 11 23:24:25 2011 -0500 @@ -20,6 +20,8 @@ gnulib_modules=" c-strcase copysign + copysignf + closedir crypto/md5 fclose fcntl @@ -38,10 +40,12 @@ lstat mkdir mkfifo + mkostemp mkstemp mktime nanosleep nproc + opendir pathmax progname readlink @@ -70,7 +74,7 @@ truncf unistd unlink - vsnprintf + vasprintf " # Additional xgettext options to use. Use "\\\newline" to break lines.
--- a/build-aux/common.mk Mon Dec 05 02:02:22 2011 -0500 +++ b/build-aux/common.mk Sun Dec 11 23:24:25 2011 -0500 @@ -162,8 +162,6 @@ RDYNAMIC_FLAG = @RDYNAMIC_FLAG@ -RLD_FLAG = @RLD_FLAG@ - FLIBS = @FLIBS@ LIBOCTINTERP = @LIBOCTINTERP@ @@ -535,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}\"|" \ @@ -551,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}\"|" \
--- a/configure.ac Mon Dec 05 02:02:22 2011 -0500 +++ b/configure.ac Sun Dec 11 23:24:25 2011 -0500 @@ -27,13 +27,13 @@ EXTERN_CFLAGS="$CFLAGS" EXTERN_CXXFLAGS="$CXXFLAGS" -AC_INIT([GNU Octave], [3.4.3], [http://octave.org/bugs.html], [octave]) +AC_INIT([GNU Octave], [3.5.90+], [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="45" +OCTAVE_API_VERSION_NUMBER="46" OCTAVE_API_VERSION="api-v$OCTAVE_API_VERSION_NUMBER+" -OCTAVE_RELEASE_DATE="2011-10-10" +OCTAVE_RELEASE_DATE="2011-12-11" OCTAVE_COPYRIGHT="Copyright (C) 2011 John W. Eaton and others." AC_SUBST(OCTAVE_VERSION) AC_SUBST(OCTAVE_API_VERSION_NUMBER) @@ -167,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 @@ -644,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) @@ -1157,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 ;; @@ -1170,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 @@ -1200,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" @@ -1221,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)' @@ -1335,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*) @@ -1356,7 +1364,6 @@ fi SHLEXT=sl SH_LDFLAGS="-shared -fPIC" - RLD_FLAG='-Wl,+b -Wl,$(octlibdir)' library_path_var=SHLIB_PATH ;; ia64*-hp-hpux*) @@ -1366,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 @@ -1382,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 @@ -1402,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 @@ -1416,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]) @@ -1445,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]) @@ -1474,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) @@ -1488,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 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 @@ -1564,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 @@ -1704,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]) @@ -2070,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. @@ -2178,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 @@ -2445,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])
--- a/doc/faq/OctaveFAQ.texi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/faq/OctaveFAQ.texi Sun Dec 11 23:24:25 2011 -0500 @@ -63,7 +63,7 @@ * Getting Octave:: * Installation:: * Common problems:: -* How do I ...?:: +* Using Octave:: * @sc{Matlab} compatibility:: * Index:: @end menu @@ -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
--- a/doc/interpreter/Makefile.am Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/Makefile.am Sun Dec 11 23:24:25 2011 -0500 @@ -118,6 +118,7 @@ fn-idx.texi \ func.texi \ geometry.texi \ + gui.texi \ gpl.texi \ grammar.texi \ image.texi \
--- a/doc/interpreter/container.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/container.txi Sun Dec 11 23:24:25 2011 -0500 @@ -563,16 +563,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
--- a/doc/interpreter/contributors.in Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/contributors.in Sun Dec 11 23:24:25 2011 -0500 @@ -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 @@ -143,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 @@ -205,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 @@ -232,6 +239,7 @@ Frederick Umminger Utkarsh Upadhyay Stefan van der Walt +David Wells Peter Van Wieren James R. Van Zandt Gregory Vanuxem @@ -244,6 +252,7 @@ Andreas Weingessel Michael Weitzel Fook Fah Yap +Sean Young Michael Zeising Federico Zenith Alex Zvoleff
--- a/doc/interpreter/debug.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/debug.txi Sun Dec 11 23:24:25 2011 -0500 @@ -35,6 +35,8 @@ * Breakpoints:: * Debug Mode:: * Call Stack:: +* Profiling:: +* Profiler Example:: @end menu @node Entering Debug Mode @@ -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 +@group +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 group +@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 + # 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 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/dir Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/doccheck/aspell-octave.en.pws Sun Dec 11 23:24:25 2011 -0500 @@ -1,11 +1,12 @@ personal_ws-1.1 en 1 Abramowitz accumarray +Acknowledgements acknowledgements -Acknowledgements ACM adams Affero +afterwards Ahalt aifm AIX @@ -15,8 +16,8 @@ alnum alphanum amd +ANOVA anova -ANOVA Anymap API approximant @@ -32,14 +33,15 @@ Autoconf autocorrelations autocovariances +autoload Autoload -autoload autoloaded autoloading Autoloading autoregression autoregressions autoscaled +AutoScaling AWK backend Backends @@ -104,6 +106,7 @@ ceil cellstr ChangeLog +changelogs changeset changesets Chaves @@ -128,12 +131,14 @@ cof coffset colamd +collectoutput colorbar colormap colperm Comint Commandline commentstyle +ComplexEqn cond condest conformant @@ -151,6 +156,7 @@ cov CPLEX CreateFcn +CRLF csymamd ctranspose CTRL @@ -167,6 +173,8 @@ dataset datasets datasource +datestr +datestrings davis ddd dddd @@ -175,8 +183,8 @@ deallocated deconv deftypefn +Delaunay delaunay -Delaunay delaunayn DeleteFcn delim @@ -225,9 +233,11 @@ endian Endian endif +endofline Engle's eof EOF +EOLs EOS eps eq @@ -257,8 +267,9 @@ facevertexcdata fcdf femmodel +FFF +FFT fft -FFT fftn fftpack FFTs @@ -269,6 +280,7 @@ filename filenames Filesystem +FinDiffType finv FIRfilter FIXME @@ -292,6 +304,7 @@ Frobenius Fs FSF +FunValCheck gamcdf gaminv gampdf @@ -319,17 +332,18 @@ globbing glpk GLS +gnuplot Gnuplot -gnuplot gnuplot's Golub Gonnet +goto Goto -goto gotos GPL gplot grabdemo +GradObj GraphicsMagick Graymap grayscale @@ -346,6 +360,7 @@ Hankel Hanning hardcode +hardcoding Hauberg HDF hdf @@ -377,8 +392,8 @@ hygepdf hygernd Hyndman +Hypergeometric hypergeometric -Hypergeometric IEEE iff ifft @@ -446,13 +461,14 @@ ldivide ldots le +Leftarrow leftarrow -Leftarrow Leftrightarrow leftrightarrow Lehoucq leq Levinson +LF lfloor li libcruft @@ -463,12 +479,13 @@ lineanchors linefeeds linesearch +linespec linespoints linkprop literalspacing Liu +LM lm -LM loadpath Lobatto logit @@ -506,8 +523,10 @@ matchcase matlab Matsumoto +MaxFunEvals maxima MaxIntervalCount +MaxIter mcnemar McNemar's meansq @@ -515,8 +534,8 @@ Mersenne meshgrid meshgridded +metafile Metafile -metafile metafiles Metafont mex @@ -548,6 +567,7 @@ multi multibyte multiline +multipledelimsasone MultiSelect mxArray myclass @@ -590,6 +610,7 @@ noscal noshare notin +nthargout NTSC nul Nx @@ -626,8 +647,8 @@ PCRE PCX pcx +pdf PDF -pdf periodogram perp Petzold's @@ -661,6 +682,8 @@ presolver printf priori +Profiler +profiler propto proven ps @@ -677,15 +700,15 @@ qhull QP QQ +qrupdate QRUPDATE -qrupdate quadcc quadgk quadl quadpack quadv +quantile Quantile -quantile quantiles Quickhull qz @@ -703,6 +726,7 @@ Readline readline recursing +reentrant regex regressor reimported @@ -718,6 +742,7 @@ resnorm resparsify RET +returnonerror rfloor RGB Riccati @@ -791,9 +816,10 @@ Stadlober stairstep Stallman +startup Startup -startup stdnormal +stdout Stegun Stepleman stepsize @@ -812,8 +838,8 @@ subexpressions subfunction Subfunction +subfunctions Subfunctions -subfunctions subinterval Subintervals subintervals @@ -826,8 +852,8 @@ subprocesses Subprocesses subsasgn +Subscripted subscripted -Subscripted subscripting subseteq subsindex @@ -857,8 +883,9 @@ Tcv terminal's tex +texinfo Texinfo -texinfo +textscan th ths tif @@ -878,6 +905,7 @@ tpdf traceback trapz +treatasempty treelayout treeplot tridiagonal @@ -888,6 +916,7 @@ Tx txi typedefs +TypicalX ub UB uchar @@ -955,16 +984,16 @@ wblpdf wblrnd Weibull +Welch welch -Welch WestOutside whitespace Whitespace whos wienrnd Wikipedia +wilcoxon Wilcoxon -wilcoxon wildcard Wildcards wildcards @@ -1000,10 +1029,10 @@ ydata yerrorbar yerrorbars +yy YY -yy +yyyy YYYY -yyyy yyyymmdd yyyymmddTHHMMSS Zechner
--- a/doc/interpreter/doccheck/mk_undocumented_list Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/doccheck/mk_undocumented_list Sun Dec 11 23:24:25 2011 -0500 @@ -82,7 +82,6 @@ comma debug dbnext -error_text exit F_DUPFD F_GETFD @@ -121,7 +120,6 @@ SEEK_END semicolon setenv -shell_cmd toc triu unimplemented
--- a/doc/interpreter/eos.txi Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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/expr.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/expr.txi Sun Dec 11 23:24:25 2011 -0500 @@ -425,7 +425,7 @@ The following arithmetic operators are available, and work on scalars and matrices. -@table @code +@table @asis @item @var{x} + @var{y} @opindex + Addition. If both operands are matrices, the number of rows and columns @@ -1239,51 +1239,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/func.txi Sun Dec 11 23:24:25 2011 -0500 @@ -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 @@ -353,11 +359,13 @@ 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} and @code{nargoutchk} are -available which provide similar error checking. +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) @anchor{doc-varargin} @anchor{doc-varargout}
--- a/doc/interpreter/grammar.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/grammar.txi Sun Dec 11 23:24:25 2011 -0500 @@ -41,16 +41,17 @@ @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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/doc/interpreter/gui.txi Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/install.txi Sun Dec 11 23:24:25 2011 -0500 @@ -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. @@ -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/io.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/io.txi Sun Dec 11 23:24:25 2011 -0500 @@ -28,7 +28,6 @@ @menu * Basic Input and Output:: * C-Style I/O Functions:: -* GUI Dialogs for I/O:: @end menu @node Basic Input and Output @@ -1065,16 +1064,3 @@ @end group @end example -@node GUI Dialogs for I/O -@section GUI Dialogs for I/O - -Simple dialog menus are available for choosing directories or files. They -return a string variable which can then be used when calling any command -requiring a file name. - -@DOCSTRING(uigetdir) - -@DOCSTRING(uigetfile) - -@DOCSTRING(uiputfile) -
--- a/doc/interpreter/linalg.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/linalg.txi Sun Dec 11 23:24:25 2011 -0500 @@ -187,6 +187,8 @@ @node Specialized Solvers @section Specialized Solvers +@DOCSTRING(bicg) + @DOCSTRING(bicgstab) @DOCSTRING(cgs)
--- a/doc/interpreter/matrix.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/matrix.txi Sun Dec 11 23:24:25 2011 -0500 @@ -257,8 +257,6 @@ @DOCSTRING(rosser) -@DOCSTRING(sylvester_matrix) - @DOCSTRING(toeplitz) @DOCSTRING(vander)
--- a/doc/interpreter/mk_doc_cache.m Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/mk_doc_cache.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/mkoctfile.1 Sun Dec 11 23:24:25 2011 -0500 @@ -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/obsolete.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/obsolete.txi Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/octave.texi Sun Dec 11 23:24:25 2011 -0500 @@ -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 @@ -199,6 +213,7 @@ * Image Processing:: * Audio Processing:: * Object Oriented Programming:: +* GUI Development:: * System Utilities:: * Packages:: * Dynamically Linked Functions:: @@ -462,7 +477,6 @@ * Basic Input and Output:: * C-Style I/O Functions:: -* GUI Dialogs for I/O:: Basic Input and Output @@ -740,6 +754,13 @@ * Operator Overloading:: * Precedence of Objects:: +GUI Development + +* I/O Dialogs:: +* Progress Bar:: +* GUI Utility Functions:: +* User-Defined Preferences:: + System Utilities * Timing Utilities:: @@ -841,7 +862,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. @@ -900,6 +921,7 @@ @include image.texi @include audio.texi @include oop.texi +@include gui.texi @include system.texi @include package.texi
--- a/doc/interpreter/package.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/package.txi Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/plot.txi Sun Dec 11 23:24:25 2011 -0500 @@ -1808,6 +1808,7 @@ @item deletefcn @item displayname +The text of the legend entry corresponding to this line. @item erasemode @@ -1819,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. @@ -1925,6 +1921,7 @@ @item deletefcn @item displayname +The text of the legend entry corresponding to this line. @item edgecolor @@ -2132,6 +2129,9 @@ @item diffusestrength +@item displayname +The text of the legend entry corresponding to this line. + @item edgealpha @item edgecolor @@ -2163,8 +2163,6 @@ @item interruptible -@item keylabel - @item linestyle @xref{Line Styles}. @@ -2282,6 +2280,9 @@ @item diffusestrength +@item displayname +The text of the legend entry corresponding to this surface. + @item edgealpha @item edgecolor @@ -2304,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 @@ -2396,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");
--- a/doc/interpreter/poly.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/poly.txi Sun Dec 11 23:24:25 2011 -0500 @@ -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/sparse.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/sparse.txi Sun Dec 11 23:24:25 2011 -0500 @@ -241,7 +241,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/stats.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/stats.txi Sun Dec 11 23:24:25 2011 -0500 @@ -114,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) @@ -168,9 +166,7 @@ @DOCSTRING(cov) -@DOCSTRING(cor) - -@DOCSTRING(corrcoef) +@DOCSTRING(corr) @DOCSTRING(spearman)
--- a/doc/interpreter/strings.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/strings.txi Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- a/doc/interpreter/system.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/system.txi Sun Dec 11 23:24:25 2011 -0500 @@ -230,6 +230,8 @@ @DOCSTRING(tempname) +@DOCSTRING(recycle) + @node File Archiving Utilities @section File Archiving Utilities @@ -302,6 +304,8 @@ @DOCSTRING(perl) +@DOCSTRING(python) + @DOCSTRING(popen) @DOCSTRING(pclose) @@ -499,6 +503,8 @@ @DOCSTRING(octave_config_info) +@DOCSTRING(usejava) + @DOCSTRING(getrusage) @node Hashing Functions
--- a/doc/interpreter/testfun.txi Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/interpreter/testfun.txi Sun Dec 11 23:24:25 2011 -0500 @@ -167,9 +167,10 @@ @example @group - %!function @var{a} = fn(@var{b}) + %!function @var{a} = fn (@var{b}) %! @var{a} = 2*@var{b}; - %!assert (@var{a}(2),4); + %!endfunction + %!assert (@var{fn}(2), 4); @end group @end example @@ -263,13 +264,16 @@ 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++
--- a/doc/refcard/refcard.tex Mon Dec 05 02:02:22 2011 -0500 +++ b/doc/refcard/refcard.tex Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- a/etc/HACKING Mon Dec 05 02:02:22 2011 -0500 +++ b/etc/HACKING Sun Dec 11 23:24:25 2011 -0500 @@ -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 @@ -159,13 +159,13 @@ time * time and date functions src -- the interpreter itself plus lots of infrastructure - around it. Octave's extensive octave_value class + around it. Octave's extensive octave_value class hierarchy for polymorphically handling all Octave - types is defined here. The built-in functions are + 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" + 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. @@ -184,7 +184,7 @@ jwe@octave.org -Last updated: Wed Sep 28 22:37:37 CDT 2011 +Last updated: Tue Nov 22 20:51:34 PST 2011 ################################################################################
--- a/etc/OLD-ChangeLogs/ChangeLog Mon Dec 05 02:02:22 2011 -0500 +++ b/etc/OLD-ChangeLogs/ChangeLog Sun Dec 11 23:24:25 2011 -0500 @@ -2,6 +2,10 @@ * 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 @@ -88,6 +92,11 @@ * NEWS: Use indentation of 2 spaces rather than 3 in code examples. +2011-02-08 John W. Eaton <jwe@octave.org> + + * NEWS: New section for 3.6. List deprecated functions that + have been removed for 3.6. + 2011-02-08 Ben Abbott <bpabbott@mac.com> * README.MacOS: Add detail.
--- a/etc/OLD-ChangeLogs/doc-ChangeLog Mon Dec 05 02:02:22 2011 -0500 +++ b/etc/OLD-ChangeLogs/doc-ChangeLog Sun Dec 11 23:24:25 2011 -0500 @@ -1,3 +1,7 @@ +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. @@ -16,6 +20,11 @@ * 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 @@ -42,7 +51,7 @@ 2011-04-04 Rik <octave@nomad.inbox5.com> - * interpreter/doccheck/aspell-octave.en.pws, interpreter/nonlin.txi, + * 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>
--- a/etc/OLD-ChangeLogs/liboctave-ChangeLog Mon Dec 05 02:02:22 2011 -0500 +++ b/etc/OLD-ChangeLogs/liboctave-ChangeLog Sun Dec 11 23:24:25 2011 -0500 @@ -1,3 +1,7 @@ +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
--- a/etc/OLD-ChangeLogs/scripts-ChangeLog Mon Dec 05 02:02:22 2011 -0500 +++ b/etc/OLD-ChangeLogs/scripts-ChangeLog Sun Dec 11 23:24:25 2011 -0500 @@ -1,8 +1,47 @@ +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 @@ -20,10 +59,21 @@ 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. @@ -397,6 +447,25 @@ * plot/__go_draw_axes__.m: Properly set fontspec for legends. +2011-02-08 John W. Eaton <jwe@octave.org> + + * deprecated/complement.m, deprecated/create_set.m, + deprecated/dmult.m, deprecated/iscommand.m, + deprecated/israwcommand.m, deprecated/lchol.m, + deprecated/loadimage.m, deprecated/mark_as_command.m, + deprecated/mark_as_rawcommand.m, deprecated/spatan2.m, + deprecated/spchol2inv.m, deprecated/spcholinv.m, + deprecated/spchol.m, deprecated/spcumprod.m, + deprecated/spcumsum.m, deprecated/spdet.m, deprecated/spdiag.m, + deprecated/spfind.m, deprecated/spinv.m, deprecated/spkron.m, + deprecated/splchol.m, deprecated/split.m, deprecated/splu.m, + deprecated/spmax.m, deprecated/spmin.m, deprecated/spprod.m, + deprecated/spqr.m, deprecated/spsum.m, deprecated/spsumsq.m, + deprecated/str2mat.m, deprecated/unmark_command.m, + deprecated/unmark_rawcommand.m: + Remove functions deprecated in version 3.2. + * module.mk (deprecated_FCN_FILES): Remove them from the list. + 2011-02-05 David Bateman <dbateman@free.fr> * plot/legend.m: Allow the location and orientation to be set
--- a/etc/OLD-ChangeLogs/src-ChangeLog Mon Dec 05 02:02:22 2011 -0500 +++ b/etc/OLD-ChangeLogs/src-ChangeLog Sun Dec 11 23:24:25 2011 -0500 @@ -1,10 +1,15 @@ +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 + * load-path.cc (restoredefaultpath): Correct use of it's -> its in documentation. 2011-04-10 John Eaton <jwe@octave.org> @@ -90,7 +95,7 @@ * 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), + ov-usr-fcn.cc (nargout), utils.cc (make_absolute_filename), variables.cc (who): Improve docstrings 2011-03-25 John W. Eaton <jwe@octave.org> @@ -342,6 +347,10 @@ 2011-02-08 John W. Eaton <jwe@octave.org> + * DLD-FUNCTIONS/chol.cc: Delete obsolete test of spcholinv. + +2011-02-08 John W. Eaton <jwe@octave.org> + * oct-parse.yy (parse_fcn_file): Don't warn about coercing nested functions to subfunctions if yyparse failed.
--- a/etc/OLD-ChangeLogs/test-ChangeLog Mon Dec 05 02:02:22 2011 -0500 +++ b/etc/OLD-ChangeLogs/test-ChangeLog Sun Dec 11 23:24:25 2011 -0500 @@ -1,3 +1,9 @@ +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
--- a/etc/README.MacOS Mon Dec 05 02:02:22 2011 -0500 +++ b/etc/README.MacOS Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- a/etc/gdbinit Mon Dec 05 02:02:22 2011 -0500 +++ b/etc/gdbinit Sun Dec 11 23:24:25 2011 -0500 @@ -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/libcruft/Makefile.am Mon Dec 05 02:02:22 2011 -0500 +++ b/libcruft/Makefile.am Sun Dec 11 23:24:25 2011 -0500 @@ -3,17 +3,17 @@ # 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/>. @@ -34,6 +34,13 @@ @CRUFT_DLL_DEFS@ \ $(AM_CPPFLAGS) +include link-deps.mk + +libcruft_la_LIBADD = \ + libranlib.la \ + ../libgnu/libgnu.la \ + $(LIBCRUFT_LINK_DEPS) + # Increment these as needed and according to the rules in the libtool # manual: libcruft_current = 0 @@ -46,13 +53,8 @@ -version-info $(libcruft_version_info) \ $(NO_UNDEFINED_LDFLAG) \ @XTRA_CRUFT_SH_LDFLAGS@ \ - -bindir $(bindir) - -libcruft_la_LIBADD = \ - ../libgnu/libgnu.la \ - libranlib.la \ - $(LAPACK_LIBS) $(BLAS_LIBS) \ - $(FLIBS) + -bindir $(bindir) \ + $(LIBCRUFT_LINK_OPTS) libcruft_la_DEPENDENCIES = cruft.def
--- a/libcruft/blas-xtra/cdotc3.f Mon Dec 05 02:02:22 2011 -0500 +++ b/libcruft/blas-xtra/cdotc3.f Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/libcruft/blas-xtra/cmatm3.f Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/libcruft/blas-xtra/ddot3.f Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/libcruft/blas-xtra/dmatm3.f Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/libcruft/blas-xtra/sdot3.f Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/libcruft/blas-xtra/smatm3.f Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/libcruft/blas-xtra/zdotc3.f Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/libcruft/blas-xtra/zmatm3.f Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/libcruft/lapack-xtra/crsf2csf.f Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/libcruft/lapack-xtra/zrsf2csf.f Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libcruft/link-deps.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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 =
--- a/liboctave/Array.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/Array.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 ()); @@ -2485,7 +2485,7 @@ } else { - // Create diag matrix from vector + // Create diag matrix from vector octave_idx_type roff = 0; octave_idx_type coff = 0; if (k > 0)
--- a/liboctave/Array.h Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/Array.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/CColVector.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/CMatrix.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/CNDArray.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/CRowVector.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/CRowVector.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/CSparse.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/DASPK-opts.in Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/DASRT-opts.in Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/DASSL-opts.in Sun Dec 11 23:24:25 2011 -0500 @@ -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-opts.in Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/LSODE-opts.in Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/LSODE.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/MArray-i.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/MArray-s.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/MArray.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/MDiagArray2.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/MSparse.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/MSparse.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/Makefile.am Sun Dec 11 23:24:25 2011 -0500 @@ -3,17 +3,17 @@ # 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/>. @@ -187,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 \ @@ -242,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 \ @@ -450,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 \ @@ -491,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) \ @@ -516,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@ \ @@ -537,10 +530,7 @@ -version-info $(liboctave_version_info) \ $(NO_UNDEFINED_LDFLAG) \ -bindir $(bindir) \ - $(SPARSE_XLDFLAGS) \ - $(ARPACK_LDFLAGS) \ - $(QRUPDATE_LDFLAGS) \ - $(FFTW_XLDFLAGS) + $(LIBOCTAVE_LINK_OPTS) octinclude_HEADERS = \ $(INCS) \
--- a/liboctave/Quad-opts.in Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/Quad-opts.in Sun Dec 11 23:24:25 2011 -0500 @@ -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,7 +33,7 @@ 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 +the relative tolerance must be greater than or equal to @w{@code{max (50*eps, 0.5e-28)}}. END_DOC_ITEM @@ -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,7 +58,7 @@ 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 +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"
--- a/liboctave/Sparse-op-defs.h Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/Sparse-op-defs.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/Sparse-perm-op-defs.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/Sparse.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- a/liboctave/Sparse.h Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/Sparse.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/SparseCmplxQR.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/SparseQR.h Sun Dec 11 23:24:25 2011 -0500 @@ -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;
--- a/liboctave/base-lu.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/base-lu.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/base-qr.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/boolNDArray.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/boolSparse.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/bsxfun-decl.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/bsxfun-defs.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/bsxfun.h Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,68 @@ +/* + +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" + +inline +bool +is_valid_bsxfun (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; + } + 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 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; + } + return true; +} + +#include "bsxfun-defs.cc" + +#endif
--- a/liboctave/chMatrix.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/chMatrix.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/chMatrix.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/cmd-edit.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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; @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/cmd-edit.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/cmd-hist.cc Sun Dec 11 23:24:25 2011 -0500 @@ -49,6 +49,7 @@ #include "oct-rl-hist.h" #include "file-stat.h" +#include "singleton-cleanup.h" class gnu_history : public command_history @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/cmd-hist.h Sun Dec 11 23:24:25 2011 -0500 @@ -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/dMatrix.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/dMatrix.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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);
--- a/liboctave/dMatrix.h Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/dMatrix.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/dNDArray.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/dNDArray.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/dSparse.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/dSparse.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/dim-vector.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/fCColVector.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/fCMatrix.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/fCNDArray.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/fCRowVector.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/fCRowVector.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/fMatrix.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/fMatrix.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/fNDArray.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/fNDArray.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/file-ops.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/file-ops.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/idx-vector.cc Sun Dec 11 23:24:25 2011 -0500 @@ -27,7 +27,6 @@ #endif #include <cstdlib> -#include <memory> #include <iostream>
--- a/liboctave/idx-vector.h Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/idx-vector.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/int16NDArray.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/int16NDArray.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/int32NDArray.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/int32NDArray.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/int64NDArray.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/int64NDArray.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/int8NDArray.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/int8NDArray.h Sun Dec 11 23:24:25 2011 -0500 @@ -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/kpse.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/kpse.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/link-deps.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/lo-cieee.c Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/lo-mappers.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/lo-mappers.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/lo-utils.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/mach-info.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/mach-info.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/mx-inlines.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 (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 (dr, dx)) + { + do_inplace_bsxfun_op (r, x, op, op1); + } else gripe_nonconformant (opname, dr, dx); return r;
--- a/liboctave/mx-op-defs.h Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/mx-op-defs.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-alloc.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-binmap.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 (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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-env.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-env.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-fftw.cc Sun Dec 11 23:24:25 2011 -0500 @@ -33,6 +33,7 @@ #include "oct-fftw.h" #include "quit.h" #include "oct-locbuf.h" +#include "singleton-cleanup.h" octave_fftw_planner *octave_fftw_planner::instance = 0; @@ -75,7 +76,12 @@ 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) { @@ -383,7 +389,12 @@ 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-fftw.h Sun Dec 11 23:24:25 2011 -0500 @@ -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, @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-inttypes.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-inttypes.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-locbuf.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-locbuf.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-mutex.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-mutex.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-norm.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-rand.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-rand.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-refcount.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-sort.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-spparms.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-spparms.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-time.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/oct-time.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/pathsearch.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/pathsearch.h Sun Dec 11 23:24:25 2011 -0500 @@ -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/regex-match.cc Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -/* - -Copyright (C) 2008-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/>. - -*/ - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include <vector> -#include <iostream> -#include <string> - -#include "regex-match.h" -#include "str-vec.h" -#include "oct-locbuf.h" - -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; -} - -regex_match::~regex_match (void) -{ -#if HAVE_REGEX - for (int i = 0; i < pat.length (); i++) - regfree (compiled +i); - delete [] compiled; -#endif -} - - -void -regex_match::set_pattern (const std::string& p) -{ -#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 (); -} - -void -regex_match::init (void) -{ -#ifdef HAVE_REGEX - int npat = pat.length (); - int err = 0; - int i; - - compiled = new regex_t [npat]; - - 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 (err) - { - 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()); - - for (int j = 0; j < i + 1; j++) - regfree (compiled + j); - } -#else - (*current_liboctave_error_handler) - ("regex not available in this version of Octave"); -#endif -} - -bool -regex_match::match (const std::string& s) -{ -#if HAVE_REGEX - int npat = pat.length (); - - const char *str = s.c_str (); - - for (int i = 0; i < npat; i++) - if (regexec (compiled + i, str, 0, 0, 0) == 0) - return true; -#endif - - return false; -} - -Array<bool> -regex_match::match (const string_vector& s) -{ - int n = s.length (); - - Array<bool> retval (dim_vector (n, 1)); - - for (int i = 0; i < n; i++) - retval(i) = match (s[i]); - - return retval; -}
--- a/liboctave/regex-match.h Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,99 +0,0 @@ -/* - -Copyright (C) 2008-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/>. - -*/ - -#if !defined (octave_regex_match_h) -#define octave_regex_match_h 1 - -#include <string> - -#if defined (HAVE_REGEX) -#if defined (__MINGW32__) -#define __restrict -#endif -#include <sys/types.h> -#include <regex.h> -#endif - -#include "Array.h" -#include "str-vec.h" - -class -OCTAVE_API -regex_match -{ -public: - - regex_match (const std::string& p, bool insen = false) - : pat (p), case_insen (insen) -#if HAVE_REGEX - , compiled (0) -#endif - { - init (); - } - - regex_match (const string_vector& p = string_vector (), bool insen = false) - : pat (p), case_insen (insen) -#if HAVE_REGEX - , compiled (0) -#endif - { - init (); - } - - regex_match (const regex_match& gm) - : pat (gm.pat), case_insen (gm.case_insen) -#if HAVE_REGEX - , compiled (0) -#endif - { - init (); - } - - regex_match& operator = (const regex_match& gm); - - ~regex_match (void); - - void set_pattern (const std::string& p); - - void set_pattern (const string_vector& p); - - bool match (const std::string&); - - Array<bool> match (const string_vector&); - -private: - - void init (void); - - // Regex pattern(s). - string_vector pat; - - // Should match be case insensitive - bool case_insen; - -#if HAVE_REGEX - regex_t *compiled; -#endif -}; - -#endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/regexp.cc Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,579 @@ +/* + +Copyright (C) 2011 John W. Eaton +Copyright (C) 2005-2011 David Bateman +Copyright (C) 2002-2005 Paul Kienzle + +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 <list> +#include <sstream> +#include <string> +#include <vector> + +#if defined (HAVE_PCRE_H) +#include <pcre.h> +#elif defined (HAVE_PCRE_PCRE_H) +#include <pcre/pcre.h> +#endif + +#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" + +// 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 +regexp::free (void) +{ + if (data) + pcre_free (static_cast<pcre *> (data)); +} + +void +regexp::compile_internal (void) +{ + // 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++; + + 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; + (*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; + } + + } + + 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++) + { + // 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); + } + } + + 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; + } + } + + retval = regexp::match_data (lst, named_pats); + + return retval; +} + +bool +regexp::is_match (const std::string& buffer) +{ + regexp::match_data rx_lst = match (buffer); + + regexp::match_data::const_iterator p = rx_lst.begin (); + + std::string match_string = p->match_string (); + + return ! match_string.empty (); +} + +Array<bool> +regexp::is_match (const string_vector& buffer) +{ + octave_idx_type len = buffer.length (); + + Array<bool> retval (len, 1); + + 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; +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/regexp.h Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,281 @@ +/* + +Copyright (C) 2011 John W. Eaton +Copyright (C) 2005-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/>. + +*/ + +#if !defined (octave_regexp_match_h) +#define octave_regexp_match_h 1 + +#include <list> +#include <sstream> +#include <string> + +#include "Array.h" +#include "Matrix.h" +#include "base-list.h" +#include "str-vec.h" + +class regexp +{ +public: + + 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) + { + 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; + } + + return *this; + } + + ~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) + { + if (this != &rx_lst) + { + octave_base_list<match_element>::operator = (rx_lst); + named_pats = rx_lst.named_pats; + } + + return *this; + } + + ~match_data (void) { } + + string_vector named_patterns (void) { return named_pats; } + + private: + + string_vector named_pats; + }; + +private: + + // The pattern we've been asked to match. + std::string pattern; + + opts options; + + // Internal data describing the regular expression. + void *data; + + std::string m; + string_vector named_pats; + int nnames; + Array<int> named_idx; + std::string who; + + 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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/singleton-cleanup.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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; +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/singleton-cleanup.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/sparse-base-chol.h Sun Dec 11 23:24:25 2011 -0500 @@ -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/str-vec.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/str-vec.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/str-vec.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/uint16NDArray.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/uint16NDArray.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/uint32NDArray.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/uint32NDArray.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/uint64NDArray.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/uint64NDArray.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/uint8NDArray.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/liboctave/uint8NDArray.h Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- a/m4/acinclude.m4 Mon Dec 05 02:02:22 2011 -0500 +++ b/m4/acinclude.m4 Sun Dec 11 23:24:25 2011 -0500 @@ -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 @@ -962,7 +963,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 +1341,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 +1388,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
--- a/run-octave.in Mon Dec 05 02:02:22 2011 -0500 +++ b/run-octave.in Sun Dec 11 23:24:25 2011 -0500 @@ -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/Makefile.am Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/Makefile.am Sun Dec 11 23:24:25 2011 -0500 @@ -3,17 +3,17 @@ # 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/>. @@ -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)
--- a/scripts/audio/playaudio.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/audio/playaudio.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/wavread.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/audio/wavread.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 = 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. + ## 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 PARAM argument"); 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) @@ -240,7 +244,6 @@ endif endfunction - -%% Tests for wavread/wavwrite pair are in wavrite.m -%!assert(1) # stop fntests.m from reporting no tests for wavread - +## Mark file as being tested. Tests for wavread/wavwrite pair are in +## wavwrite.m +%!assert(1)
--- a/scripts/audio/wavwrite.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/audio/wavwrite.m Sun Dec 11 23:24:25 2011 -0500 @@ -143,38 +143,41 @@ endfunction +%!shared fname +%! fname = tmpnam (); + %!test %! A = [-1:0.1:1; -1:0.1:1]; -%! wavwrite (A, "a.wav"); -%! [B, samples_per_sec, bits_per_sample] = wavread ("a.wav"); -%! assert(A,B, 1/2^15); -%! assert(samples_per_sec, 8000); -%! assert(bits_per_sample, 16); -%! delete ("a.wav"); +%! 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:0.1:1; -1:0.1:1]; -%! wavwrite (A, 4000, "a.wav"); -%! [B, samples_per_sec, bits_per_sample] = wavread ("a.wav"); -%! assert(A,B, 1/2^15); -%! assert(samples_per_sec, 4000); -%! assert(bits_per_sample, 16); -%! delete ("a.wav"); +%! 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:0.1:1; -1:0.1:1]; -%! wavwrite (A, 4000, 8, "a.wav"); -%! [B, samples_per_sec, bits_per_sample] = wavread ("a.wav"); -%! assert(A,B, 1/128); -%! assert(samples_per_sec, 4000); -%! assert(bits_per_sample, 8); -%! delete ("a.wav"); +%! 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, "a.wav"); -%! B = wavread ("a.wav"); +%! wavwrite (A, fname); +%! B = wavread (fname); %! B *= 32768; -%! assert(B, [-32768 -32768 0 32767 32767]); -%! delete ("a.wav"); +%! assert (B, [-32768 -32768 0 32767 32767]); +%! unlink (fname);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/deprecated/__error_text__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/complement.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,78 +0,0 @@ -## Copyright (C) 1994-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} {} complement (@var{x}, @var{y}) -## Return the elements of set @var{y} that are not in set @var{x}. For -## example: -## -## @example -## @group -## complement ([ 1, 2, 3 ], [ 2, 3, 5 ]) -## @result{} 5 -## @end group -## @end example -## @seealso{union, intersect, unique} -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function y = complement (a, b) - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "complement is obsolete and will be removed from a future version of Octave, please use setdiff instead"); - endif - - if (nargin != 2) - print_usage (); - endif - - if (isempty (a)) - y = unique (b); - elseif (isempty (b)) - y = []; - else - a = unique (a); - b = unique (b); - yindex = 1; - y = zeros (1, length (b)); - for index = 1:length (b) - if (all (a != b (index))) - y(yindex++) = b(index); - endif - endfor - y = y(1:(yindex-1)); - endif - -endfunction - -%!assert(all (all (complement ([1, 2, 3], [3; 4; 5; 6]) == [4, 5, 6]))); - -%!assert(all (all (complement ([1, 2, 3], [3, 4, 5, 6]) == [4, 5, 6]))); - -%!assert(isempty (complement ([1, 2, 3], [3, 2, 1]))); - -%!error complement (1); - -%!error complement (1, 2, 3); -
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/deprecated/cor.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,54 @@ +## Copyright (C) 1995-2011 Kurt Hornik +## +## 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} {} cor (@var{x}) +## @deftypefnx {Function File} {} cor (@var{x}, @var{y}) +## Compute matrix of correlation coefficients. +## +## This is an alias for @code{corrcoef}. +## @seealso{corrcoef} +## @end deftypefn + +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 (); + endif + + retval = corrcoef (x, y); + +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); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/deprecated/corrcoef.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,119 @@ +## 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} {} corrcoef (@var{x}) +## @deftypefnx {Function File} {} corrcoef (@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{corrcoef (@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 corrcoef}(x,y) = {{\rm cov}(x,y) \over {\rm std}(x) {\rm std}(y)} +## $$ +## @end tex +## @ifnottex +## +## @example +## corrcoef(x,y) = cov(x,y)/(std(x)*std(y)) +## @end example +## +## @end ifnottex +## If called with one argument, compute @code{corrcoef (@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 = 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 + + ## 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 = corrcoef (x); +%! cc2 = corrcoef (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 (corrcoef (x,y), -1, 5*eps) +%! assert (corrcoef (x,flipud (y)), 1, 5*eps) +%! assert (corrcoef ([x, y]), [1 -1; -1 1], 5*eps) + +%!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 ([1; 2], ["A", "B"]); +%!error corrcoef (ones (2,2,2)); +%!error corrcoef (ones (2,2), ones (2,2,2)); +
--- a/scripts/deprecated/create_set.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,79 +0,0 @@ -## Copyright (C) 1994-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} {} create_set (@var{x}) -## @deftypefnx {Function File} {} create_set (@var{x}, "rows") -## This function has been deprecated. Use unique instead. -## @end deftypefn - -## Return a row vector containing the unique values in @var{x}, sorted in -## ascending order. For example, -## -## @example -## @group -## create_set ([ 1, 2; 3, 4; 4, 2; 1, 2 ]) -## @result{} [ 1, 2, 3, 4 ] -## @end group -## @end example -## -## If the optional second input argument is the string "rows" each row of -## the matrix @var{x} will be considered an element of set. For example, -## @example -## @group -## create_set ([ 1, 2; 3, 4; 4, 2; 1, 2 ], "rows") -## @result{} 1 2 -## 3 4 -## 4 2 -## @end group -## @end example -## @seealso{union, intersect, complement, unique} - -## Author: jwe - -## Deprecated in version 3.2 - -function y = create_set (x, rows_opt) - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "create_set is obsolete and will be removed from a future version of Octave, please use unique instead"); - endif - - if (nargin < 1 || nargin > 2) - print_usage (); - endif - - if (nargin == 1) - y = unique (x)(:)'; - elseif (strcmpi (rows_opt, "rows")) - y = unique (x, "rows"); - else - error ("create_set: expecting \"rows\" as second argument"); - endif - -endfunction - -%!assert(all (all (create_set ([1, 2, 3, 4, 2, 4]) == [1, 2, 3, 4]))); -%!assert(all (all (create_set ([1, 2; 3, 4; 2, 4]) == [1, 2, 3, 4]))); -%!assert(all (all (create_set ([1; 2; 3; 4; 2; 4]) == [1, 2, 3, 4]))); -%!assert(isempty (create_set ([]))); -%!error create_set (1, 2); -
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/deprecated/cut.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,71 @@ +## Copyright (C) 1996-2011 Kurt Hornik +## +## 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} {} cut (@var{x}, @var{breaks}) +## Create categorical data from numerical or continuous data by +## cutting into intervals. +## +## If @var{breaks} is a scalar, the data is cut into that many +## equal-width intervals. If @var{breaks} is a vector of break points, +## the category has @code{length (@var{breaks}) - 1} groups. +## +## The returned value is a vector of the same size as @var{x} telling +## which group each point in @var{x} belongs to. Groups are labelled +## from 1 to the number of groups; points outside the range of +## @var{breaks} are labelled by @code{NaN}. +## @seealso{histc} +## @end deftypefn + +## Author: KH <Kurt.Hornik@wu-wien.ac.at> +## Description: Cut data into intervals + +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 + + if (!isvector (x)) + error ("cut: X must be a vector"); + endif + if isscalar (breaks) + breaks = linspace (min (x), max (x), breaks + 1); + breaks(1) = breaks(1) - 1; + elseif isvector (breaks) + breaks = sort (breaks); + else + error ("cut: BREAKS must be a scalar or vector"); + endif + + group = NaN (size (x)); + m = length (breaks); + if any (k = find ((x >= min (breaks)) & (x < max (breaks)))) + n = length (k); + group(k) = sum ((ones (m, 1) * reshape (x(k), 1, n)) + >= (reshape (breaks, m, 1) * ones (1, n))); + endif + +endfunction
--- a/scripts/deprecated/dmult.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,49 +0,0 @@ -## Copyright (C) 1995-2011 Kurt Hornik -## -## 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} {} dmult (@var{a}, @var{b}) -## This function has been deprecated. Use the direct syntax @code{diag(A)*B} -## which is more readable and now also more efficient. -## @end deftypefn - -## Author: KH <Kurt.Hornik@wu-wien.ac.at> -## Description: Rescale the rows of a matrix - -## Deprecated in version 3.2 - -function M = dmult (a, B) - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "dmult is obsolete and will be removed from a future version of Octave; please use the straightforward (and now efficient) syntax \"diag(A)*B\""); - endif - - if (nargin != 2) - print_usage (); - endif - if (! isvector (a)) - error ("dmult: a must be a vector of length rows (B)"); - endif - a = a(:); - sb = size (B); - sb(1) = 1; - M = repmat (a(:), sb) .* B; -endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/deprecated/error_text.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/deprecated/glpkmex.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/iscommand.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,44 +0,0 @@ -## Copyright (C) 2009-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} {} iscommand (@var{name}) -## This function is obsolete and will be removed from a future -## version of Octave. -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function retval = iscommand () - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "iscommand is obsolete and will be removed from a future version of Octave"); - endif - - if (nargin == 0) - retval = {}; - else - retval = true; - endif - -endfunction
--- a/scripts/deprecated/israwcommand.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,44 +0,0 @@ -## Copyright (C) 2009-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} {} israwcommand (@var{name}) -## This function is obsolete and will be removed from a future -## version of Octave. -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function retval = israwcommand () - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "israwcommand is obsolete and will be removed from a future version of Octave"); - endif - - if (nargin == 0) - retval = {}; - else - retval = true; - endif - -endfunction
--- a/scripts/deprecated/lchol.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -## Copyright (C) 2008-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 {Loadable Function} {@var{l} =} lchol (@var{a}) -## @deftypefnx {Loadable Function} {[@var{l}, @var{p}] =} lchol (@var{a}) -## This function has been deprecated. Use @code{chol (@dots{},'lower')} -## instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = lchol (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spfind is obsolete and will be removed from a future version of Octave; please use find instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = chol (varargin{:}, "lower"); - -endfunction
--- a/scripts/deprecated/loadimage.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,43 +0,0 @@ -## Copyright (C) 1994-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{x}, @var{map}] =} loadimage (@var{file}) -## Load an image file and its associated color map from the specified -## @var{file}. The image must be stored in Octave's image format. -## @seealso{saveimage, load, save} -## @end deftypefn - -## Author: Tony Richardson <arichard@stark.cc.oh.us> -## Created: July 1994 -## Adapted-By: jwe - -## Deprecated in version 3.2 - -function [img_retval, map_retval] = loadimage (varargin) - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "loadimage is obsolete and will be removed from a future version of Octave; please use imread instead"); - endif - - [img_retval, map_retval] = imread (varargin{:}); - -endfunction
--- a/scripts/deprecated/mark_as_command.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -## Copyright (C) 2009-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} {} mark_as_command (@var{name}) -## This function is obsolete and will be removed from a future -## version of Octave. -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function mark_as_command () - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "mark_as_command is obsolete and will be removed from a future version of Octave"); - endif - -endfunction
--- a/scripts/deprecated/mark_as_rawcommand.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -## Copyright (C) 2009-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} {} mark_as_rawcommand (@var{name}) -## This function is obsolete and will be removed from a future -## version of Octave. -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function mark_as_rawcommand () - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "mark_as_rawcommand is obsolete and will be removed from a future version of Octave"); - endif - -endfunction
--- a/scripts/deprecated/module.mk Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/deprecated/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -6,55 +6,30 @@ deprecated/betai.m \ deprecated/cellidx.m \ deprecated/clg.m \ - deprecated/complement.m \ - deprecated/create_set.m \ + deprecated/cor.m \ + deprecated/corrcoef.m \ deprecated/cquad.m \ + deprecated/cut.m \ deprecated/dispatch.m \ - deprecated/dmult.m \ deprecated/fstat.m \ deprecated/gammai.m \ deprecated/glpkmex.m \ deprecated/intwarning.m \ - deprecated/iscommand.m \ deprecated/is_duplicate_entry.m \ deprecated/is_global.m \ - deprecated/israwcommand.m \ deprecated/isstr.m \ - deprecated/lchol.m \ - deprecated/loadimage.m \ deprecated/krylovb.m \ - deprecated/mark_as_command.m \ - deprecated/mark_as_rawcommand.m \ deprecated/perror.m \ + deprecated/polyderiv.m \ deprecated/replot.m \ deprecated/saveimage.m \ deprecated/setstr.m \ - deprecated/spatan2.m \ - deprecated/spchol2inv.m \ - deprecated/spcholinv.m \ - deprecated/spchol.m \ - deprecated/spcumprod.m \ - deprecated/spcumsum.m \ - deprecated/spdet.m \ - deprecated/spdiag.m \ - deprecated/spfind.m \ + deprecated/shell_cmd.m \ deprecated/sphcat.m \ - deprecated/spinv.m \ - deprecated/spkron.m \ - deprecated/splchol.m \ - deprecated/split.m \ - deprecated/splu.m \ - deprecated/spmax.m \ - deprecated/spmin.m \ - deprecated/spprod.m \ - deprecated/spqr.m \ - deprecated/spsum.m \ - deprecated/spsumsq.m \ deprecated/spvcat.m \ - deprecated/str2mat.m \ deprecated/strerror.m \ - deprecated/unmark_command.m \ - deprecated/unmark_rawcommand.m \ + deprecated/studentize.m \ + deprecated/sylvester_matrix.m \ deprecated/values.m \ deprecated/weibcdf.m \ deprecated/weibinv.m \
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/deprecated/polyderiv.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,108 @@ +## Copyright (C) 1994-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} {} 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}) +## 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{poly, polyint, polyreduce, roots, conv, deconv, residue, +## filter, polygcd, polyval, polyvalm} +## @end deftypefn + +## Author: Tony Richardson <arichard@stark.cc.oh.us> +## Created: June 1994 +## Adapted-By: jwe + +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"); + endif + if (nargin == 2) + if (! isvector (a)) + error ("polyderiv: argument must be a vector"); + endif + if (nargout == 1) + ## derivative of p*a returns a single polynomial + q = polyderiv (conv (p, a)); + else + ## derivative of p/a returns numerator and denominator + d = conv (a, a); + if (numel (p) == 1) + q = -p * polyderiv (a); + elseif (numel (a) == 1) + q = a * polyderiv (p); + else + q = conv (polyderiv (p), a) - conv (p, polyderiv (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 + 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 (polyderiv ([1, 2, 3]) == [2, 2]))); + +%!assert(polyderiv (13) == 0); + +%!error polyderiv ([]); + +%!error polyderiv ([1, 2; 3, 4]); +
--- a/scripts/deprecated/saveimage.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/deprecated/saveimage.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/deprecated/shell_cmd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 +
--- a/scripts/deprecated/spatan2.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -## Copyright (C) 2008-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} {} spatan2 (@var{y}, @var{x}) -## This function has been deprecated. Use @code{atan2} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spatan2 (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spatan2 is obsolete and will be removed from a future version of Octave; please use atan2 instead"); - endif - - retval = atan2 (varargin{:}); - -endfunction
--- a/scripts/deprecated/spchol.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -## Copyright (C) 2008-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 {Loadable Function} {@var{r} =} spchol (@var{a}) -## @deftypefnx {Loadable Function} {[@var{r}, @var{p}] =} spchol (@var{a}) -## @deftypefnx {Loadable Function} {[@var{r}, @var{p}, @var{q}] =} spchol (@var{a}) -## This function has been deprecated. Use @code{chol} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = spchol (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spchol is obsolete and will be removed from a future version of Octave; please use chol instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = chol (varargin{:}); - -endfunction
--- a/scripts/deprecated/spchol2inv.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -## Copyright (C) 2008-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} {} spchol2inv (@var{u}) -## This function has been deprecated. Use @code{chol2inv} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spchol2inv (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spchol2inv is obsolete and will be removed from a future version of Octave; please use chol2inv instead"); - endif - - retval = chol2inv (varargin{:}); - -endfunction
--- a/scripts/deprecated/spcholinv.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -## Copyright (C) 2008-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} {} spcholinv (@var{u}) -## This function has been deprecated. Use @code{cholinv} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spcholinv (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spcholinv is obsolete and will be removed from a future version of Octave; please use cholinv instead"); - endif - retval = cholinv (varargin{:}); - -endfunction
--- a/scripts/deprecated/spcumprod.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -## Copyright (C) 2008-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} {} spcumprod (@var{x}, @var{dim}) -## This function has been deprecated. Use @code{cumprod} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spcumprod (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spcumprod is obsolete and will be removed from a future version of Octave; please use cumprod instead"); - endif - - retval = cumprod (varargin{:}); - -endfunction
--- a/scripts/deprecated/spcumsum.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -## Copyright (C) 2008-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} {} spcumsum (@var{x}, @var{dim}) -## This function has been deprecated. Use @code{cumsum} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spcumsum (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spcumsum is obsolete and will be removed from a future version of Octave; please use cumsum instead"); - endif - - retval = cumsum (varargin{:}); - -endfunction
--- a/scripts/deprecated/spdet.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -## Copyright (C) 2008-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 {Loadable Function} {[@var{d}, @var{rcond}] =} spdet (@var{a}) -## This function has been deprecated. Use @code{det} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = spdet (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spdet is obsolete and will be removed from a future version of Octave; please use det instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = det (varargin{:}); - -endfunction
--- a/scripts/deprecated/spdiag.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -## Copyright (C) 2008-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} {} spdiag (@var{v}, @var{k}) -## This function has been deprecated. Use @code{sparse (diag (@dots{}))} -## instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spdiag (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spdiag is obsolete and will be removed from a future version of Octave; please use sparse (diag (...)) instead"); - endif - - retval = sparse (diag (varargin{:})); - -endfunction
--- a/scripts/deprecated/spfind.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,40 +0,0 @@ -## Copyright (C) 2008-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 {Loadable Function} {} spfind (@var{x}) -## @deftypefnx {Loadable Function} {} spfind (@var{x}, @var{n}) -## @deftypefnx {Loadable Function} {} spfind (@var{x}, @var{n}, @var{direction}) -## @deftypefnx {Loadable Function} {[@var{i}, @var{j}, @var{v}} spfind (@dots{}) -## This function has been deprecated. Use @code{find} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = spfind (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spfind is obsolete and will be removed from a future version of Octave; please use find instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = find (varargin{:}); - -endfunction
--- a/scripts/deprecated/spinv.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -## Copyright (C) 2008-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{x}, @var{rcond}] =} spinv (@var{a}) -## This function has been deprecated. Use @code{inv} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = spinv (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spinv is obsolete and will be removed from a future version of Octave; please use inv instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = inv (varargin{:}); - -endfunction
--- a/scripts/deprecated/spkron.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -## Copyright (C) 2008-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} {} spkron (@var{a}, @var{b}) -## This function has been deprecated. Use @code{kron} instead. -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function retval = spkron (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spkron is obsolete and will be removed from a future version of Octave; please use kron instead"); - endif - - retval = kron (varargin{:}); - -endfunction
--- a/scripts/deprecated/splchol.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,40 +0,0 @@ -## Copyright (C) 2008-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 {Loadable Function} {@var{l} =} splchol (@var{a}) -## @deftypefnx {Loadable Function} {[@var{l}, @var{p}] =} splchol (@var{a}) -## @deftypefnx {Loadable Function} {[@var{l}, @var{p}, @var{q}] =} splchol (@var{a}) -## This function has been deprecated. Use @code{chol (@dots{},'lower')} -## instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = splchol (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "splchol is obsolete and will be removed from a future version of Octave; please use chol instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = chol (varargin{:}, "lower"); - -endfunction
--- a/scripts/deprecated/split.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,130 +0,0 @@ -## Copyright (C) 1996-2011 Kurt Hornik -## -## 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} {} split (@var{s}, @var{t}, @var{n}) -## This function has been deprecated. Use @code{char (strsplit (s, t))} -## instead. -## @end deftypefn - -## Divides the string @var{s} into pieces separated by @var{t}, returning -## the result in a string array (padded with blanks to form a valid -## matrix). If the optional input @var{n} is supplied, split @var{s} -## into at most @var{n} different pieces. -## -## For example, -## -## @example -## split ("Test string", "t") -## @result{} -## "Tes " -## " s " -## "ring" -## @end example -## -## @example -## split ("Test string", "t s", 2) -## @result{} -## "Tes " -## "tring" -## @end example -## @seealso{strtok, index} -## @end deftypefn - -## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> -## Adapted-By: jwe - -## Deprecated in version 3.2 - -function m = split (s, t, n) - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "split is obsolete and will be removed from a future version of Octave; please use strsplit instead"); - endif - - if (nargin == 2 || nargin == 3) - if (nargin == 2) - n = length (s); - endif - - if (ischar (s) && ischar (t)) - - l_s = length (s); - l_t = length (t); - - if (l_s == 0) - m = ""; - return; - elseif (l_t == 0) - m = s'; - return; - elseif (l_s < l_t) - error ("split: S must not be shorter than T"); - endif - - if (min (size (s)) != 1 || min (size (t)) != 1) - error("split: multi-line strings are not supported"); - endif - - ind = findstr (s, t, 0); - if (length (ind) == 0) - m = s; - return; - elseif (n - 1 < length(ind)) - ind = ind(1:n-1); - endif - ind2 = [1, ind+l_t]; - ind = [ind, l_s+1]; - - ind_diff = ind-ind2; - - ## Create a matrix of the correct size that's filled with spaces. - m_rows = length (ind); - m_cols = max (ind_diff); - m = repmat (" ", m_rows, m_cols); - - ## Copy the strings to the matrix. - for i = 1:length (ind) - tmp = ind2(i):(ind(i)-1); - m(i,1:length(tmp)) = s(tmp); - endfor - else - error ("split: both S and T must be strings"); - endif - else - print_usage (); - endif - -endfunction - -%!assert(all (all (split ("Test string", "t") == ["Tes "; " s "; "ring"]))); - -%!error split (); - -%!assert(all (strcmp (split ("foo bar baz", " ", 2), ["foo"; "bar baz"]))); - -%!error split ("foo", "bar", 3, 4); - -%!assert (all (strcmp (split("road//to/hell","/"), ["road"; " "; "to "; "hell"]))) - -%!assert (all (strcmp (split("/road/to/hell/","/"), [" "; "road"; "to "; "hell"; " "]))) - -
--- a/scripts/deprecated/splu.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,48 +0,0 @@ -## Copyright (C) 2008-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 {Loadable Function} {[@var{l}, @var{u}] =} splu (@var{a}) -## @deftypefnx {Loadable Function} {[@var{l}, @var{u}, @var{P}] =} splu (@var{a}) -## @deftypefnx {Loadable Function} {[@var{l}, @var{u}, @var{P}, @var{Q}] =} splu (@var{a}) -## @deftypefnx {Loadable Function} {[@var{l}, @var{u}, @var{P}, @var{Q}] =} splu (@dots{}, @var{thres}) -## @deftypefnx {Loadable Function} {[@var{l}, @var{u}, @var{P}] =} splu (@dots{}, @var{Q}) -## This function has been deprecated. Use @code{lu} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = splu (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "splu is obsolete and will be removed from a future version of Octave; please use lu instead"); - endif - - for i = 2 : nargin - arg = varargin {i}; - if (! isscalar (arg)) - error ("splu: Can no longer treat input column permutations"); - endif - endfor - - varargout = cell (nargout, 1); - [ varargout{:} ] = lu (varargin{:}); - -endfunction
--- a/scripts/deprecated/spmax.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -## Copyright (C) 2008-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 {Mapping Function} {} spmax (@var{x}, @var{y}, @var{dim}) -## @deftypefnx {Mapping Function} {[@var{w}, @var{iw}] =} spmax (@var{x}) -## This function has been deprecated. Use @code{max} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = spmax (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spmax is obsolete and will be removed from a future version of Octave; please use max instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = max (varargin{:}); - -endfunction
--- a/scripts/deprecated/spmin.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -## Copyright (C) 2008-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 {Mapping Function} {} spmin (@var{x}, @var{y}, @var{dim}) -## @deftypefnx {Mapping Function} {[@var{w}, @var{iw}] =} spmin (@var{x}) -## This function has been deprecated. Use @code{min} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = spmin (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spmin is obsolete and will be removed from a future version of Octave; please use min instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = min (varargin{:}); - -endfunction
--- a/scripts/deprecated/spprod.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -## Copyright (C) 2008-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} {} spprod (@var{x}, @var{dim}) -## This function has been deprecated. Use @code{prod} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spprod (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spprod is obsolete and will be removed from a future version of Octave; please use prod instead"); - endif - - retval = prod (varargin{:}); - -endfunction
--- a/scripts/deprecated/spqr.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,40 +0,0 @@ -## Copyright (C) 2008-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 {Loadable Function} {@var{r} =} spqr (@var{a}) -## @deftypefnx {Loadable Function} {@var{r} =} spqr (@var{a}, 0) -## @deftypefnx {Loadable Function} {[@var{c}, @var{r}] =} spqr (@var{a}, @var{b}) -## @deftypefnx {Loadable Function} {[@var{c}, @var{r}] =} spqr (@var{a}, @var{b}, 0) -## This function has been deprecated. Use @code{qr} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = spqr (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spqr is obsolete and will be removed from a future version of Octave; please use qr instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = qr (varargin{:}); - -endfunction
--- a/scripts/deprecated/spsum.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -## Copyright (C) 2008-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} {} spsum (@var{x}, @var{dim}) -## This function has been deprecated. Use @code{sum} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spsum (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spsum is obsolete and will be removed from a future version of Octave; please use sum instead"); - endif - - retval = sum (varargin{:}); - -endfunction
--- a/scripts/deprecated/spsumsq.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -## Copyright (C) 2008-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} {} spsumsq (@var{x}, @var{dim}) -## This function has been deprecated. Use @code{sumsq} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spsumsq (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spsumsq is obsolete and will be removed from a future version of Octave; please use sumsq instead"); - endif - retval = sumsq (varargin{:}); - -endfunction
--- a/scripts/deprecated/str2mat.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,45 +0,0 @@ -## Copyright (C) 1996-2011 Kurt Hornik -## -## 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} {} str2mat (@var{s_1}, @dots{}, @var{s_n}) -## Return a matrix containing the strings @var{s_1}, @dots{}, @var{s_n} as -## its rows. Each string is padded with blanks in order to form a valid -## matrix. -## -## This function is modelled after @sc{matlab}. In Octave, you can create -## a matrix of strings by @code{[@var{s_1}; @dots{}; @var{s_n}]} even if -## the strings are not all the same length. -## @end deftypefn - -## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> -## Adapted-By: jwe - -## Deprecated in version 3.2 - -function retval = str2mat (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "str2mat is obsolete and will be removed from a future version of Octave; please use char instead"); - endif - - retval = char (varargin{:}); - -endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/deprecated/studentize.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,94 @@ +## Copyright (C) 1995-2011 Kurt Hornik +## +## 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} {} studentize (@var{x}) +## @deftypefnx {Function File} {} studentize (@var{x}, @var{dim}) +## If @var{x} is a vector, subtract its mean and divide by its standard +## deviation. +## +## If @var{x} is a matrix, do the above along the first non-singleton +## dimension. +## If the optional argument @var{dim} is given, operate along this dimension. +## @seealso{center} +## @end deftypefn + +## Author: KH <Kurt.Hornik@wu-wien.ac.at> +## 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 (); + endif + + if (! isnumeric(x)) + error ("studentize: X must be a numeric vector or matrix"); + endif + + if (isinteger (x)) + x = double (x); + 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 + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("studentize: DIM must be an integer and a valid dimension"); + endif + endif + + c = sz(dim); + if (c == 0) + t = 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); + 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]) + +%% 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) +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/deprecated/sylvester_matrix.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,69 @@ +## 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} {} sylvester_matrix (@var{k}) +## Return the Sylvester matrix of order +## @tex +## $n = 2^k$. +## @end tex +## @ifnottex +## n = 2^@var{k}. +## @end ifnottex +## +## @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 + + if (isscalar (k)) + if (k < 1) + retval = 1; + else + tmp = sylvester_matrix (k-1); + retval = [tmp, tmp; tmp, -tmp]; + endif + else + error ("sylvester_matrix: expecting scalar argument"); + endif + +endfunction + +%!assert((sylvester_matrix (1) == [1, 1; 1, -1] +%! && (sylvester_matrix (2) +%! == [1, 1, 1, 1; 1, -1, 1, -1; 1, 1, -1, -1; 1, -1, -1, 1]))); + +%!error sylvester_matrix ([1, 2; 3, 4]); + +%!error sylvester_matrix (); + +%!error sylvester_matrix (1, 2); +
--- a/scripts/deprecated/unmark_command.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -## Copyright (C) 2009-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} {} unmark_command (@var{name}) -## This function is obsolete and will be removed from a future -## version of Octave. -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function unmark_command () - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "unmark_command is obsolete and will be removed from a future version of Octave"); - endif - -endfunction
--- a/scripts/deprecated/unmark_rawcommand.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -## Copyright (C) 2009-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} {} unmark_rawcommand (@var{name}) -## This function is obsolete and will be removed from a future -## version of Octave. -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function unmark_rawcommand () - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "unmark_rawcommand is obsolete and will be removed from a future version of Octave"); - endif - -endfunction
--- a/scripts/elfun/cosd.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/elfun/cosd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/lcm.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,61 +0,0 @@ -## Copyright (C) 1994-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 {Mapping Function} {} lcm (@var{x}, @var{y}) -## @deftypefnx {Mapping Function} {} lcm (@var{x}, @var{y}, @dots{}) -## Compute the least common multiple of @var{x} and @var{y}, -## or of the list of all arguments. All elements must be the same size or -## scalar. -## @seealso{factor, gcd} -## @end deftypefn - -## Author: KH <Kurt.Hornik@wu-wien.ac.at> -## Created: 16 September 1994 -## Adapted-By: jwe - -function l = lcm (varargin) - - 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))) - error ("lcm: all arguments must be numeric"); - endif - - l = varargin{1}; - for i = 2:nargin - x = varargin{i}; - msk = l == 0 & x == 0; - l .*= x ./ gcd (l, x); - l(msk) = 0; - endfor - else - print_usage (); - endif - -endfunction - -%!assert(lcm (3, 5, 7, 15) == 105); - -%!error lcm (); - -%!test -%! s.a = 1; -%! fail("lcm (s)"); -
--- a/scripts/elfun/module.mk Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/elfun/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/elfun/sind.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/elfun/tand.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/accumarray.m Sun Dec 11 23:24:25 2011 -0500 @@ -24,14 +24,16 @@ ## 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}. If +## 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}. ## ## 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}. +## 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 @@ -40,8 +42,14 @@ ## 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. +## 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. ## ## By default @code{accumarray} returns a full matrix. If ## @var{issparse} is logically true, then a sparse matrix is returned @@ -49,7 +57,7 @@ ## ## 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 +## 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}). ## @@ -66,7 +74,7 @@ ## @end group ## @end example ## -## Another example, where the result is a multidimensional 3D array and +## Another example, where the result is a multi-dimensional 3-D array and ## the default value (zero) appears in the output: ## ## @example @@ -83,9 +91,9 @@ ## ## 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} +## 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 +## 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. @@ -100,7 +108,7 @@ endif if (iscell (subs)) - subs = cellfun (@vec, subs, "uniformoutput", false); + subs = cellfun ("vec", subs, "uniformoutput", false); ndims = numel (subs); if (ndims == 1) subs = subs{1}; @@ -166,7 +174,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 @@ -177,7 +192,7 @@ if (ndims > 1) if (isempty (sz)) if (iscell (subs)) - sz = cellfun (@max, subs); + sz = cellfun ("max", subs); else sz = max (subs, [], 1); endif @@ -248,6 +263,9 @@ 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 nonpositive. + zero = 0; else zero = NaN; # Neutral value. endif @@ -313,6 +331,10 @@ %!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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/accumdim.m Sun Dec 11 23:24:25 2011 -0500 @@ -42,12 +42,12 @@ ## ## An example of the use of @code{accumdim} is: ## -## @example +## @smallexample ## @group ## 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 +## @end smallexample ## ## @seealso{accumarray} ## @end deftypefn
--- a/scripts/general/arrayfun.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/bitget.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/bitset.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/blkdiag.m Sun Dec 11 23:24:25 2011 -0500 @@ -20,8 +20,9 @@ ## @deftypefn {Function File} {} blkdiag (@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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/cell2mat.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/celldisp.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/circshift.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/colon.m Sun Dec 11 23:24:25 2011 -0500 @@ -38,3 +38,7 @@ 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/common_size.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/dblquad.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/dblquad.m Sun Dec 11 23:24:25 2011 -0500 @@ -37,22 +37,23 @@ ## ## The optional argument @var{quadf} specifies which underlying integrator ## function to use. Any choice but @code{quad} is available and the default -## is @code{quadgk}. +## is @code{quadcc}. ## ## Additional arguments, are passed directly to @var{f}. To use the default -## value for @var{tol} or @var{quadf} one may pass an empty matrix ([]). +## 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__; @@ -72,10 +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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/display.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/flipdim.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/flipdim.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/gradient.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/gradient.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/int2str.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/interp1.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/interpft.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/interpft.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/interpn.m Sun Dec 11 23:24:25 2011 -0500 @@ -129,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"); @@ -145,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}; @@ -174,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");
--- a/scripts/general/isa.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/isa.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/iscolumn.m Sun Dec 11 23:24:25 2011 -0500 @@ -26,8 +26,6 @@ function retval = iscolumn (x) - retval = false; - if (nargin != 1) print_usage (); endif
--- a/scripts/general/isdir.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/isdir.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/isequal.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/isequalwithequalnans.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/isrow.m Sun Dec 11 23:24:25 2011 -0500 @@ -26,8 +26,6 @@ function retval = isrow (x) - retval = false; - if (nargin != 1) print_usage (); endif
--- a/scripts/general/isscalar.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/isscalar.m Sun Dec 11 23:24:25 2011 -0500 @@ -26,12 +26,12 @@ 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));
--- a/scripts/general/issquare.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/issquare.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/isvector.m Sun Dec 11 23:24:25 2011 -0500 @@ -28,15 +28,13 @@ 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));
--- a/scripts/general/logspace.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/logspace.m Sun Dec 11 23:24:25 2011 -0500 @@ -59,44 +59,41 @@ ## 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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,13 +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/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 \
--- a/scripts/general/nargchk.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/nargchk.m Sun Dec 11 23:24:25 2011 -0500 @@ -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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/general/narginchk.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/nargoutchk.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/nextpow2.m Sun Dec 11 23:24:25 2011 -0500 @@ -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);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/general/nthargout.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/num2str.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/postpad.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/postpad.m Sun Dec 11 23:24:25 2011 -0500 @@ -53,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)) @@ -76,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 @@ -88,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/prepad.m Sun Dec 11 23:24:25 2011 -0500 @@ -53,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)) @@ -76,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 @@ -88,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/private/__isequal__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/general/profexplore.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/general/profile.m Sun Dec 11 23:24:25 2011 -0500 @@ -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'});
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/general/profshow.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/quadl.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/quadl.m Sun Dec 11 23:24:25 2011 -0500 @@ -62,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 @@ -79,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; @@ -104,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)) @@ -117,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{:}); + 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) + 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; if (trace) 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, -9e-15) + +## 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/quadv.m Sun Dec 11 23:24:25 2011 -0500 @@ -1,4 +1,5 @@ ## Copyright (C) 2008-2011 David Bateman +## Copyright (C) 2011 Alexander Klein ## ## This file is part of Octave. ## @@ -58,6 +59,8 @@ ## @end deftypefn function [q, nfun] = quadv (f, a, b, tol, trace, varargin) + ## TODO: Make norm for convergence testing configurable + if (nargin < 3) print_usage (); endif @@ -88,10 +91,10 @@ ## 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 @@ -103,7 +106,7 @@ 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"); @@ -133,7 +136,9 @@ endif ## Force at least one adpative step. - if (nfun == 5 || abs (q - q0) > tol) + ## 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, nfun, hmin] = simpsonstp (f, c, b, e, fc, fb, fe, q2, nfun, hmin, @@ -152,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/rat.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/rat.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/rot90.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/rot90.m Sun Dec 11 23:24:25 2011 -0500 @@ -52,58 +52,51 @@ ## 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/rotdim.m Sun Dec 11 23:24:25 2011 -0500 @@ -71,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 @@ -119,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/shift.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/shiftdim.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/sortrows.m Sun Dec 11 23:24:25 2011 -0500 @@ -25,6 +25,7 @@ ## 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 @@ -32,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. @@ -61,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 @@ -83,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 @@ -113,3 +126,12 @@ %! 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/structfun.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/triplequad.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/general/triplequad.m Sun Dec 11 23:24:25 2011 -0500 @@ -37,22 +37,25 @@ ## ## The optional argument @var{quadf} specifies which underlying integrator ## function to use. Any choice but @code{quad} is available and the default -## is @code{quadgk}. +## is @code{quadcc}. ## ## Additional arguments, are passed directly to @var{f}. To use the default -## value for @var{tol} or @var{quadf} one may pass an empty matrix ([]). +## 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__; @@ -61,7 +64,8 @@ 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) @@ -71,8 +75,11 @@ 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/geometry/convhull.m Sun Dec 11 23:24:25 2011 -0500 @@ -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}) -## Return 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/geometry/delaunay.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/geometry/delaunay3.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/geometry/delaunayn.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/griddata3.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/geometry/griddata3.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/geometry/inpolygon.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/geometry/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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/trimesh.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,66 +0,0 @@ -## Copyright (C) 2007-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} {} trimesh (@var{tri}, @var{x}, @var{y}, @var{z}) -## @deftypefnx {Function File} {@var{h} =} trimesh (@dots{}) -## 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. -## @seealso{triplot, trisurf, delaunay3} -## @end deftypefn - -function h = trimesh (tri, x, y, z, varargin) - - if (nargin < 3) - print_usage (); - endif - - if (nargin == 3) - triplot (tri, x, y); - elseif (ischar (z)) - 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 - - if (! ishold ()) - set (gca(), "view", [-37.5, 30], - "xgrid", "on", "ygrid", "on", "zgrid", "on"); - endif - endif -endfunction - -%!demo -%! 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(:));
--- a/scripts/geometry/triplot.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,53 +0,0 @@ -## Copyright (C) 2007-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} {} triplot (@var{tri}, @var{x}, @var{y}) -## @deftypefnx {Function File} {} triplot (@var{tri}, @var{x}, @var{y}, @var{linespec}) -## @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. -## @seealso{plot, trimesh, trisurf, delaunay} -## @end deftypefn - -function h = triplot (tri, x, y, varargin) - - if (nargin < 3) - print_usage (); - endif - - idx = tri(:, [1, 2, 3, 1]).'; - nt = size (tri, 1); - 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{:}); - endif -endfunction - -%!demo -%! rand ('state', 2) -%! x = rand (20, 1); -%! y = rand (20, 1); -%! tri = delaunay (x, y); -%! triplot (tri, x, y);
--- a/scripts/geometry/trisurf.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,102 +0,0 @@ -## Copyright (C) 2007-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} {} trisurf (@var{tri}, @var{x}, @var{y}, @var{z}) -## @deftypefnx {Function File} {@var{h} =} trisurf (@dots{}) -## 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. -## @seealso{triplot, trimesh, delaunay3} -## @end deftypefn - -function varargout = trisurf (tri, x, y, z, varargin) - - if (nargin < 3) - print_usage (); - endif - - if (nargin == 3) - triplot (tri, x, y); - elseif (ischar (z)) - triplot (tri, x, y, z, varargin{:}); - else - if (nargin > 4 && isnumeric (varargin{1})) - c = varargin{1}; - varargin(1) = []; - 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 (); - h = patch ("Faces", tri, "Vertices", [x(:), y(:), z(:)], - "FaceVertexCData", reshape (c, numel (c), 1), - varargin{:}); - if (nargout > 0) - varargout = {h}; - endif - - if (! ishold ()) - set (gca(), "view", [-37.5, 30], - "xgrid", "on", "ygrid", "on", "zgrid", "on"); - endif - endif -endfunction - -%!demo -%! 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 -%! x = rand (100, 1); -%! y = rand (100, 1); -%! z = x.^2 + y.^2; -%! tri = delaunay (x, y); -%! trisurf (tri, x, y, z) - -%!demo -%! 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 -%! 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") - -
--- a/scripts/geometry/voronoi.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/geometry/voronoi.m Sun Dec 11 23:24:25 2011 -0500 @@ -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{}) -## Plot 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/geometry/voronoin.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/help/__makeinfo__.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/help/__makeinfo__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/__strip_html_tags__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,81 +0,0 @@ -## Copyright (C) 2009-2011 Søren Hauberg -## -## 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{text}, @var{status}] =} __strip_html_tags__ (@var{html_text}) -## Undocumented internal function. -## @end deftypefn - -## Remove HTML tags from text. This is used as a simple HTML-to-text -## function. - -function [text, status] = __strip_html_tags__ (html_text) - start = find (html_text == "<"); - stop = find (html_text == ">"); - if (length (start) == length (stop)) - text = html_text; - for n = length(start):-1:1 - text (start (n):stop (n)) = []; - endfor - text = strip_superfluous_endlines (text); - status = 0; - else - warning ("help: invalid HTML data -- raw HTML source follows..."); - disp (html_text); - text = ""; - status = 1; - endif -endfunction - -## This function removes end-lines (\n) that makes printing look bad -function text = strip_superfluous_endlines (text) - ## Find groups of end-lines - els = find (text == "\n"); - dels = diff (els); - groups = [els(1), 1]; # list containing [start, length] of each group - for k = 1:length (dels) - if (dels (k) == 1) - groups (end, 2) ++; - else - groups (end+1, 1:2) = [els(k+1), 1]; - endif - endfor - - keep = true (size (text)); - - ## Remove end-lines in the beginning - if (groups (1, 1) == 1) - keep (1:groups (1, 2)) = false; - endif - - ## Remove end-lines from the end - if (sum (groups (end, :)) - 1 == length (text)) - keep (groups (end, 1):end) = false; - endif - - ## Remove groups of end-lines with more than 3 end-lines next to each other - idx = find (groups (:, 2) >= 3); - for k = 1:length (idx) - start = groups (idx (k), 1); - stop = start + groups (idx (k), 2) - 1; - keep (start+2:stop) = false; - endfor - - ## Actually remove the elements - text = text (keep); -endfunction
--- a/scripts/help/gen_doc_cache.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/help/gen_doc_cache.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/help/get_first_help_sentence.m Sun Dec 11 23:24:25 2011 -0500 @@ -50,7 +50,7 @@ error ("get_first_help_sentence: NAME must be a string"); endif - if (!isnumeric (max_len) || max_len <= 0 || max_len != round (max_len)) + if (!isnumeric (max_len) || max_len <= 0 || max_len != fix (max_len)) error ("get_first_help_sentence: MAX_LEN must be positive integer"); endif
--- a/scripts/help/help.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/help/help.m Sun Dec 11 23:24:25 2011 -0500 @@ -179,3 +179,7 @@ endif endfunction + + +%!assert (! isempty (findstr (help ("ls"), "List directory contents"))) +%!error <invalid input> help (42)
--- a/scripts/help/lookfor.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/help/lookfor.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/help/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/help/print_usage.m Sun Dec 11 23:24:25 2011 -0500 @@ -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) +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/help/private/__strip_html_tags__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,81 @@ +## Copyright (C) 2009-2011 Søren Hauberg +## +## 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{text}, @var{status}] =} __strip_html_tags__ (@var{html_text}) +## Undocumented internal function. +## @end deftypefn + +## Remove HTML tags from text. This is used as a simple HTML-to-text +## function. + +function [text, status] = __strip_html_tags__ (html_text) + start = find (html_text == "<"); + stop = find (html_text == ">"); + if (length (start) == length (stop)) + text = html_text; + for n = length(start):-1:1 + text (start (n):stop (n)) = []; + endfor + text = strip_superfluous_endlines (text); + status = 0; + else + warning ("help: invalid HTML data -- raw HTML source follows..."); + disp (html_text); + text = ""; + status = 1; + endif +endfunction + +## This function removes end-lines (\n) that makes printing look bad +function text = strip_superfluous_endlines (text) + ## Find groups of end-lines + els = find (text == "\n"); + dels = diff (els); + groups = [els(1), 1]; # list containing [start, length] of each group + for k = 1:length (dels) + if (dels (k) == 1) + groups (end, 2) ++; + else + groups (end+1, 1:2) = [els(k+1), 1]; + endif + endfor + + keep = true (size (text)); + + ## Remove end-lines in the beginning + if (groups (1, 1) == 1) + keep (1:groups (1, 2)) = false; + endif + + ## Remove end-lines from the end + if (sum (groups (end, :)) - 1 == length (text)) + keep (groups (end, 1):end) = false; + endif + + ## Remove groups of end-lines with more than 3 end-lines next to each other + idx = find (groups (:, 2) >= 3); + for k = 1:length (idx) + start = groups (idx (k), 1); + stop = start + groups (idx (k), 2) - 1; + keep (start+2:stop) = false; + endfor + + ## Actually remove the elements + text = text (keep); +endfunction
--- a/scripts/help/type.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/help/type.m Sun Dec 11 23:24:25 2011 -0500 @@ -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'))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/help/unimplemented.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,435 @@ +## Copyright (C) 2010-2011 John W. Eaton +## 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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} unimplemented () +## Undocumented internal function. +## @end deftypefn + +function txt = unimplemented (fcn) + + is_matlab_function = true; + + ## 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 core Octave. See the ", + "linear-algebra package at @url{http://octave.sf.net/linear-algebra/}."]; + + case "linprog" + txt = ["Octave does not currently provide linprog. ",... + "Linear programming problems may be solved using @code{glpk}. ",... + "Try @code{help glpk} for more info."]; + + case {"ode113", "ode15i", "ode15s", "ode23", "ode23s", "ode23t", "ode45", "odeget", "odeset"} + txt = ["Octave provides lsode for solving differential equations. ",... + "For more information try @code{help lsode}. ",... + "Matlab-compatible ODE functions are provided by the odepkg package. ",... + "See @url{http://octave.sf.net/odepkg/}."]; + + otherwise + if (ismember (fcn, missing_functions ())) + txt = sprintf ("the `%s' function is not yet implemented in Octave", fcn); + else + is_matlab_function = false; + txt = ""; + endif + endswitch + + if (is_matlab_function) + txt = [txt, "\n\n@noindent\nPlease read ",... + "@url{http://www.octave.org/missing.html} to learn how ",... + "you can contribute missing functionality."]; + txt = __makeinfo__ (txt); + endif + + if (nargout == 0) + warning ("Octave:missing-function", "%s", txt); + endif + +endfunction + +function list = missing_functions () + persistent list = { + "DelaunayTri", + "MException", + "RandStream", + "TriRep", + "TriScatteredInterp", + "align", + "alim", + "alpha", + "alphamap", + "annotation", + "audiodevinfo", + "audioplayer", + "audiorecorder", + "aufinfo", + "auread", + "auwrite", + "avifile", + "aviinfo", + "aviread", + "bar3", + "bar3h", + "bench", + "betaincinv", + "bicgstabl", + "brush", + "builddocsearchdb", + "bvp4c", + "bvp5c", + "bvpget", + "bvpinit", + "bvpset", + "bvpxtend", + "callSoapService", + "calllib", + "camdolly", + "cameratoolbar", + "camlight", + "camlookat", + "camorbit", + "campan", + "campos", + "camproj", + "camroll", + "camtarget", + "camup", + "camva", + "camzoom", + "cdf2rdf", + "cdfepoch", + "cdfinfo", + "cdfread", + "cdfwrite", + "cellplot", + "checkin", + "checkout", + "cholinc", + "clearvars", + "clipboard", + "cmopts", + "cmpermute", + "cmunique", + "colordef", + "colormapeditor", + "commandhistory", + "commandwindow", + "condeig", + "coneplot", + "contourslice", + "copyobj", + "createClassFromWsdl", + "createSoapMessage", + "customverctrl", + "daqread", + "datacursormode", + "datatipinfo", + "dbmex", + "dde23", + "ddeget", + "ddesd", + "ddeset", + "decic", + "depdir", + "depfun", + "deval", + "dialog", + "dither", + "docopt", + "docsearch", + "dragrect", + "dynamicprops", + "echodemo", + "ellipj", + "ellipke", + "erfcinv", + "errordlg", + "evalc", + "exifread", + "expint", + "export2wsdlg", + "figurepalette", + "filebrowser", + "fill3", + "findfigs", + "fitsinfo", + "fitsread", + "flow", + "fminsearch", + "frame2im", + "freqspace", + "funm", + "gallery", + "gammaincinv", + "gco", + "getframe", + "getpixelposition", + "gmres", + "grabcode", + "graymon", + "gsvd", + "guidata", + "guide", + "guihandles", + "handle", + "hdf", + "hdf5", + "hdf5info", + "hdf5read", + "hdf5write", + "hdfinfo", + "hdfread", + "hdftool", + "helpbrowser", + "helpdesk", + "helpdlg", + "helpwin", + "hgexport", + "hgload", + "hgsave", + "hgsetget", + "hgtransform", + "hostid", + "ilu", + "im2frame", + "im2java", + "imapprox", + "imformats", + "import", + "importdata", + "inmem", + "inputParser", + "inputdlg", + "inspect", + "instrfind", + "instrfindall", + "interpstreamspeed", + "iscom", + "isinterface", + "isjava", + "isocaps", + "isstudent", + "javaArray", + "javaMethod", + "javaMethodEDT", + "javaObject", + "javaObjectEDT", + "javaaddpath", + "javachk", + "javaclasspath", + "javarmpath", + "ldl", + "libfunctions", + "libfunctionsview", + "libisloaded", + "libpointer", + "libstruct", + "light", + "lightangle", + "lighting", + "linkaxes", + "linkdata", + "linsolve", + "listdlg", + "listfonts", + "loadlibrary", + "lscov", + "lsqr", + "makehgtform", + "material", + "matlabrc", + "maxNumCompThreads", + "memmapfile", + "memory", + "metaclass", + "methodsview", + "minres", + "mlint", + "mlintrpt", + "mmfileinfo", + "mmreader", + "movegui", + "movie", + "movie2avi", + "msgbox", + "multibandread", + "multibandwrite", + "native2unicode", + "noanimate", + "ode113", + "ode15i", + "ode15s", + "ode23", + "ode23s", + "ode23t", + "ode23tb", + "ode45", + "odefile", + "odeget", + "odeset", + "odextend", + "open", + "openfig", + "opengl", + "openvar", + "ordeig", + "ordqz", + "ordschur", + "padecoef", + "pagesetupdlg", + "pan", + "parseSoapResponse", + "path2rc", + "pathtool", + "pcode", + "pdepe", + "pdeval", + "playshow", + "plotbrowser", + "plotedit", + "plottools", + "polyeig", + "prefdir", + "preferences", + "printdlg", + "printopt", + "printpreview", + "profile", + "profsave", + "propedit", + "propertyeditor", + "publish", + "qmr", + "quad2d", + "questdlg", + "rbbox", + "reducepatch", + "reducevolume", + "resample", + "rgbplot", + "root", + "rotate", + "rotate3d", + "selectmoveresize", + "sendmail", + "serial", + "setpixelposition", + "showplottool", + "shrinkfaces", + "smooth3", + "snapnow", + "sound", + "soundsc", + "ss2tf", + "stream2", + "stream3", + "streamline", + "streamparticles", + "streamribbon", + "streamslice", + "streamtube", + "strings", + "subvolume", + "superclasses", + "support", + "surf2patch", + "symmlq", + "syntax", + "tetramesh", + "texlabel", + "textwrap", + "tfqmr", + "timer", + "timerfind", + "timerfindall", + "timeseries", + "toolboxdir", + "tscollection", + "tstool", + "uibuttongroup", + "uicontextmenu", + "uicontrol", + "uigetpref", + "uiimport", + "uiopen", + "uipanel", + "uipushtool", + "uiresume", + "uisave", + "uisetcolor", + "uisetfont", + "uisetpref", + "uistack", + "uitable", + "uitoggletool", + "uitoolbar", + "uiwait", + "undocheckout", + "unicode2native", + "unloadlibrary", + "unmesh", + "userpath", + "validateattributes", + "verLessThan", + "viewmtx", + "visdiff", + "volumebounds", + "waitfor", + "warndlg", + "waterfall", + "wavfinfo", + "wavplay", + "wavrecord", + "web", + "whatsnew", + "wk1finfo", + "wk1read", + "wk1write", + "workspace", + "xlsfinfo", + "xlsread", + "xlswrite", + "xmlread", + "xmlwrite", + "xslt", + "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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/help/which.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/image.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/image/image.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,
--- a/scripts/image/imagesc.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/image/imagesc.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/image/imshow.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- a/scripts/image/ind2rgb.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/image/ind2rgb.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/io/beep.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/io/csvread.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/io/csvwrite.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/io/dlmwrite.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/io/fileread.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/io/strread.m Sun Dec 11 23:24:25 2011 -0500 @@ -19,15 +19,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 +37,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 +81,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 +102,211 @@ ## @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" ## Parts of the output where no word is available is filled with @var{value}. +## +## @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 "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). +## ## @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 (is_sq_string (delimiter_str)) + 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 (is_sq_string (white_spaces)) + 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 (is_sq_string (eol_char)) + 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 +314,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 +323,406 @@ 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)) + ## Remove any delimiter chars from white_spaces list + white_spaces = setdiff (white_spaces, delimiter_str); + 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 + ## FIXME: This is very complicated. Can this be simplified with regexprep? + 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 - endfor + ## Remove repeated white_space chars. First find white_space positions + idx = strchr (str, white_spaces); + ## Find repeated white_spaces + idx2 = ! (idx(2:end) - idx(1:end-1) - 1); + ## Set all whitespace chars to spaces + ## FIXME: this implies real spaces are always part of white_spaces + str(idx) = ' '; + ## Set all repeated white_space to \0 + str(idx(idx2)) = "\0"; + str = strsplit (str, "\0"); + ## Reconstruct trimmed str + str = cell2mat (str); + ## Remove leading & trailing space, but preserve delimiters. + str = strtrim (str); + ## 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 + + ## We now may have to cope with 3 cases: + ## 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 ) + ## fmt_words has been split properly now, but words{} has only been split on + ## delimiter positions. Some words columns may have to be split further. + ## We also don't know the number of lines (as EndOfLine may have been set to + ## "" (empty) by the caller). + + ## 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); + + ## 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) + error ("strread: Literal '%s' (fmt spec # %d) does not match data", fmt_words{ii}, ii); + 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) + ## Error. Field extends beyond word boundary. + error ("strread: Field width '%s' (fmt spec # %d) extends beyond word limit", fmt_words{ii}, ii); + 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 && idf(ii+1)) + if (! isempty (strfind (words{icol, 1}, fmt_words{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 spaces in text + ## to avoid it being included in consecutive delim series + text = strrep (text, eol_char, [" " eol_char " "]); + else + mult_dlms_s1 = false; + endif + + ## Split text string along delimiters + out = strsplit (text, sep, mult_dlms_s1); + ## 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 +730,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 +747,72 @@ %! 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"; +%! c = textscan (str, "Text%dText%1sText"); +%! assert (c{1}, int32 ([1; 398; 57])); +%! assert (c{2}(1:2), {'2'; '4'}); +%! assert (isempty (c{2}{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 +%! assert (strread ("1\n2\n3", "%d", "delimiter", "\n"), +%! strread ("1\n2\n3", "%d", "delimiter", '\n')) + +%% whitespace as sq_string and dq_string +%! 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'))
--- a/scripts/io/textread.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/io/textread.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,21 +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)) - hdr_lines = floor (varargin{headerlines + 1}); - ## Beware of zero valued headerline, fskipl will count lines to EOF then - if (hdr_lines > 0) - fskipl (fid, hdr_lines); - endif + ## 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/io/textscan.m Sun Dec 11 23:24:25 2011 -0500 @@ -22,23 +22,40 @@ ## @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, @@ -47,89 +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)) - hdr_lines = floor (varargin{headerlines + 1}); - ## Beware of zero valued headerline, fskipl will count lines to EOF - if (hdr_lines > 0) - fskipl (fid, hdr_lines); - endif - 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/linear-algebra/commutation_matrix.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/cross.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/linear-algebra/cross.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/linear-algebra/duplication_matrix.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/gmres.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,214 +0,0 @@ -## 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{pcg, cgs, bicgstab} -## @end deftypefn - -function [x, flag, prec_res_norm, itcnt] = 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)); - prec_res_norm = 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) = prec_res_norm; - prec_b_norm = norm (Pm1x (b), 2); - flag = 1; - - while ((iter <= maxit * restart) && (prec_res_norm > rtol * prec_b_norm)) - - ## restart - if (restart_it > restart) - restart_it = 1; - x_old = x; - prec_res = Pm1x (b - Ax (x_old)); - prec_res_norm = norm (prec_res, 2); - B(1) = prec_res_norm; - H(:) = 0; - V(:, 1) = prec_res / prec_res_norm; - 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); - prec_res_norm = norm (little_res, 2); - - x = x_old + V(:, 1:restart_it) * Y(1:restart_it); - - resids(iter) = prec_res_norm ; - if (norm (x - x_old, inf) <= eps) - flag = 3; - break - endif - - restart_it++ ; iter++; - endwhile - - if (prec_res_norm > rtol * prec_b_norm) - flag = 0; - endif - - resids = resids(1:iter-1); - itcnt = [floor(maxit/restart), rem(maxit, 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/linear-algebra/housh.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/linear-algebra/housh.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/linear-algebra/isdefinite.m Sun Dec 11 23:24:25 2011 -0500 @@ -63,3 +63,22 @@ 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 4]) \ No newline at end of file
--- a/scripts/linear-algebra/krylov.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/linear-algebra/krylov.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/module.mk Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/linear-algebra/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -7,7 +7,6 @@ linear-algebra/cross.m \ linear-algebra/duplication_matrix.m \ linear-algebra/expm.m \ - linear-algebra/gmres.m \ linear-algebra/housh.m \ linear-algebra/isdefinite.m \ linear-algebra/ishermitian.m \
--- a/scripts/linear-algebra/null.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/linear-algebra/null.m Sun Dec 11 23:24:25 2011 -0500 @@ -77,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/linear-algebra/onenormest.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/linear-algebra/orth.m Sun Dec 11 23:24:25 2011 -0500 @@ -39,6 +39,11 @@ if (nargin == 1 || nargin == 2) + if (isempty (A)) + retval = []; + return; + endif + [U, S, V] = svd (A); [rows, cols] = size (A); @@ -74,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/linear-algebra/planerot.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/linear-algebra/qzhess.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/linear-algebra/rank.m Sun Dec 11 23:24:25 2011 -0500 @@ -58,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/linear-algebra/rref.m Sun Dec 11 23:24:25 2011 -0500 @@ -86,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/miscellaneous/ans.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/ans.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/bincoeff.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/bug_report.m Sun Dec 11 23:24:25 2011 -0500 @@ -43,3 +43,6 @@ puts ("\n"); endfunction + +## Mark file as being tested. No real test needed for this function. +%!assert (1)
--- a/scripts/miscellaneous/comma.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/comma.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/computer.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/computer.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/debug.m Sun Dec 11 23:24:25 2011 -0500 @@ -57,13 +57,16 @@ ## Quit debugging mode and return to the main prompt. ## ## @item debug_on_error -## Flag whether to enter debug mode in case Octave encounters an error. +## Function to query or set whether to enter debug mode in case Octave +## encounters an error. ## ## @item debug_on_warning -## Flag whether to enter debug mode in case Octave encounters a warning. +## Function to query or set whether to enter debug mode in case Octave +## encounters a warning. ## ## @item debug_on_interrupt -## Flag whether to enter debug mode in case Octave encounters an interupt. +## Function to query or set whether to enter debug mode in case Octave +## encounters an interupt. ## ## @end table ##
--- a/scripts/miscellaneous/delete.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/delete.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/dos.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/edit.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/edit.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- a/scripts/miscellaneous/fullfile.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/fullfile.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/getappdata.m Sun Dec 11 23:24:25 2011 -0500 @@ -36,9 +36,10 @@ for nh = 1:numel(h) try appdata = get (h(nh), "__appdata__"); - catch + end_try_catch + if (! isfield (appdata, name)) appdata.(name) = []; - end_try_catch + endif val(nh) = {appdata.(name)}; endfor if (nh == 1)
--- a/scripts/miscellaneous/getfield.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/getfield.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/gzip.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/info.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/ismac.m Sun Dec 11 23:24:25 2011 -0500 @@ -32,3 +32,5 @@ endfunction +%!error ismac (1); +%!assert (islogical (ismac ()));
--- a/scripts/miscellaneous/ispc.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/ispc.m Sun Dec 11 23:24:25 2011 -0500 @@ -31,3 +31,6 @@ endif endfunction + +%!error ispc (1); +%!assert (islogical (ispc ()));
--- a/scripts/miscellaneous/isunix.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/isunix.m Sun Dec 11 23:24:25 2011 -0500 @@ -31,3 +31,6 @@ endif endfunction + +%!error isunix (1); +%!assert (islogical (isunix ()));
--- a/scripts/miscellaneous/license.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/license.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/list_primes.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/ls.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/menu.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/menu.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/mexext.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/mkoctfile.m Sun Dec 11 23:24:25 2011 -0500 @@ -75,26 +75,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
--- a/scripts/miscellaneous/module.mk Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -50,6 +50,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,7 +63,6 @@ miscellaneous/tar.m \ miscellaneous/tempdir.m \ miscellaneous/tempname.m \ - miscellaneous/unimplemented.m \ miscellaneous/unix.m \ miscellaneous/unpack.m \ miscellaneous/untar.m \
--- a/scripts/miscellaneous/namelengthmax.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/namelengthmax.m Sun Dec 11 23:24:25 2011 -0500 @@ -19,14 +19,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} namelengthmax () ## Return 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 +## 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/news.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/paren.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/paren.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/private/__xzip__.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/private/__xzip__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 @@ -99,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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/miscellaneous/python.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/miscellaneous/recycle.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/semicolon.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/semicolon.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/setfield.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/setfield.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/swapbytes.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/symvar.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/tempdir.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/tempdir.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/tempname.m Sun Dec 11 23:24:25 2011 -0500 @@ -29,3 +29,7 @@ filename = tmpnam (varargin{:}); endfunction + + +%% No tests needed for alias. +%!assert (1)
--- a/scripts/miscellaneous/unimplemented.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,430 +0,0 @@ -## Copyright (C) 2010-2011 John W. Eaton -## 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/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} unimplemented () -## Undocumented internal function. -## @end deftypefn - -function txt = unimplemented (fcn) - - is_matlab_function = true; - - ## Some smarter cases, add more as needed. - switch (fcn) - - 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/}."]; - - case "linprog" - txt = ["Octave does not currently provide linprog. ",... - "Linear programming problems may be solved using @code{glpk}. ",... - "Try @code{help glpk} for more info."]; - - case {"ode113", "ode15i", "ode15s", "ode23", "ode23s", "ode23t", "ode45", "odeget", "odeset"} - txt = ["Octave provides lsode for solving differential equations. ",... - "For more information try @code{help lsode}. ",... - "Matlab-compatible ODE functions are provided by the odepkg package. ",... - "See @url{http://octave.sf.net/odepkg/}."]; - - otherwise - if (ismember (fcn, missing_functions ())) - txt = sprintf ("the `%s' function is not yet implemented in Octave", fcn); - else - is_matlab_function = false; - txt = ""; - endif - endswitch - - if (is_matlab_function) - txt = [txt, "\n\n@noindent\nPlease read ",... - "@url{http://www.octave.org/missing.html} to learn how ",... - "you can contribute missing functionality."]; - txt = __makeinfo__ (txt); - endif - - if (nargout == 0) - warning ("Octave:missing-function", "%s", txt); - endif - -endfunction - -function list = missing_functions () - persistent list = { - "DelaunayTri", - "MException", - "RandStream", - "TriRep", - "TriScatteredInterp", - "addpref", - "align", - "alim", - "alpha", - "alphamap", - "annotation", - "audiodevinfo", - "audioplayer", - "audiorecorder", - "aufinfo", - "auread", - "auwrite", - "avifile", - "aviinfo", - "aviread", - "bar3", - "bar3h", - "bench", - "betaincinv", - "bicg", - "bicgstabl", - "brush", - "builddocsearchdb", - "bvp4c", - "bvp5c", - "bvpget", - "bvpinit", - "bvpset", - "bvpxtend", - "callSoapService", - "calllib", - "camdolly", - "cameratoolbar", - "camlight", - "camlookat", - "camorbit", - "campan", - "campos", - "camproj", - "camroll", - "camtarget", - "camup", - "camva", - "camzoom", - "cdf2rdf", - "cdfepoch", - "cdfinfo", - "cdfread", - "cdfwrite", - "cellplot", - "checkin", - "checkout", - "cholinc", - "clearvars", - "clipboard", - "cmopts", - "cmpermute", - "cmunique", - "colordef", - "colormapeditor", - "commandhistory", - "commandwindow", - "condeig", - "coneplot", - "contourslice", - "copyobj", - "createClassFromWsdl", - "createSoapMessage", - "customverctrl", - "daqread", - "datacursormode", - "datatipinfo", - "dbmex", - "dde23", - "ddeget", - "ddesd", - "ddeset", - "decic", - "depdir", - "depfun", - "deval", - "dialog", - "dither", - "docopt", - "docsearch", - "dragrect", - "dynamicprops", - "echodemo", - "ellipj", - "ellipke", - "erfcinv", - "errordlg", - "evalc", - "exifread", - "expint", - "export2wsdlg", - "figurepalette", - "filebrowser", - "fill3", - "findfigs", - "fitsinfo", - "fitsread", - "flow", - "fminsearch", - "frame2im", - "freqspace", - "funm", - "gallery", - "gammaincinv", - "gco", - "getframe", - "getpixelposition", - "getpref", - "gmres", - "grabcode", - "graymon", - "gsvd", - "guidata", - "guide", - "guihandles", - "handle", - "hdf", - "hdf5", - "hdf5info", - "hdf5read", - "hdf5write", - "hdfinfo", - "hdfread", - "hdftool", - "helpbrowser", - "helpdesk", - "helpdlg", - "helpwin", - "hgexport", - "hgload", - "hgsave", - "hgsetget", - "hgtransform", - "hostid", - "ilu", - "im2frame", - "im2java", - "imapprox", - "imformats", - "import", - "importdata", - "inmem", - "inputParser", - "inputdlg", - "inspect", - "instrfind", - "instrfindall", - "interpstreamspeed", - "iscom", - "isinterface", - "isjava", - "isocaps", - "ispref", - "isstudent", - "javaArray", - "javaMethod", - "javaMethodEDT", - "javaObject", - "javaObjectEDT", - "javaaddpath", - "javachk", - "javaclasspath", - "javarmpath", - "ldl", - "libfunctions", - "libfunctionsview", - "libisloaded", - "libpointer", - "libstruct", - "light", - "lightangle", - "lighting", - "linkaxes", - "linkdata", - "linsolve", - "listdlg", - "listfonts", - "loadlibrary", - "lscov", - "lsqr", - "makehgtform", - "material", - "matlabrc", - "maxNumCompThreads", - "memmapfile", - "memory", - "metaclass", - "methodsview", - "minres", - "mlint", - "mlintrpt", - "mmfileinfo", - "mmreader", - "movegui", - "movie", - "movie2avi", - "msgbox", - "multibandread", - "multibandwrite", - "native2unicode", - "noanimate", - "ode113", - "ode15i", - "ode15s", - "ode23", - "ode23s", - "ode23t", - "ode23tb", - "ode45", - "odefile", - "odeget", - "odeset", - "odextend", - "open", - "openfig", - "opengl", - "openvar", - "ordeig", - "ordqz", - "ordschur", - "padecoef", - "pagesetupdlg", - "pan", - "parseSoapResponse", - "path2rc", - "pathtool", - "pcode", - "pdepe", - "pdeval", - "playshow", - "plotbrowser", - "plotedit", - "plottools", - "polyeig", - "prefdir", - "preferences", - "printdlg", - "printopt", - "printpreview", - "profile", - "profsave", - "propedit", - "propertyeditor", - "publish", - "qmr", - "quad2d", - "questdlg", - "rbbox", - "recycle", - "reducepatch", - "reducevolume", - "resample", - "reset", - "rgbplot", - "rmpref", - "root", - "rotate", - "rotate3d", - "rsf2csf", - "selectmoveresize", - "sendmail", - "serial", - "setpixelposition", - "setpref", - "showplottool", - "shrinkfaces", - "smooth3", - "snapnow", - "sound", - "soundsc", - "ss2tf", - "stream2", - "stream3", - "streamline", - "streamparticles", - "streamribbon", - "streamslice", - "streamtube", - "strings", - "subvolume", - "superclasses", - "support", - "surf2patch", - "symmlq", - "syntax", - "tetramesh", - "texlabel", - "textwrap", - "tfqmr", - "timer", - "timerfind", - "timerfindall", - "timeseries", - "toolboxdir", - "tscollection", - "tstool", - "uibuttongroup", - "uicontextmenu", - "uicontrol", - "uigetpref", - "uiimport", - "uiopen", - "uipanel", - "uipushtool", - "uiresume", - "uisave", - "uisetcolor", - "uisetfont", - "uisetpref", - "uistack", - "uitable", - "uitoggletool", - "uitoolbar", - "uiwait", - "undocheckout", - "unicode2native", - "unloadlibrary", - "unmesh", - "usejava", - "userpath", - "validateattributes", - "verLessThan", - "viewmtx", - "visdiff", - "volumebounds", - "waitbar", - "waitfor", - "warndlg", - "waterfall", - "wavfinfo", - "wavplay", - "wavrecord", - "web", - "whatsnew", - "wk1finfo", - "wk1read", - "wk1write", - "workspace", - "xlsfinfo", - "xlsread", - "xlswrite", - "xmlread", - "xmlwrite", - "xslt", - "zoom", - }; -endfunction
--- a/scripts/miscellaneous/unix.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/unix.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/unpack.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/miscellaneous/usejava.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 compatability 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/version.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/version.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/warning_ids.m Sun Dec 11 23:24:25 2011 -0500 @@ -18,17 +18,20 @@ ## -*- texinfo -*- ## @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,8 +109,8 @@ ## 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, @@ -115,31 +118,19 @@ ## 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: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 +142,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 +192,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 @@ -217,35 +235,51 @@ ## 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 +297,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/what.m Sun Dec 11 23:24:25 2011 -0500 @@ -90,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/miscellaneous/xor.m Sun Dec 11 23:24:25 2011 -0500 @@ -48,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/optimization/__all_opts__.m Sun Dec 11 23:24:25 2011 -0500 @@ -67,3 +67,7 @@ endfunction + +## No test needed for internal helper function. +%!assert (1) +
--- a/scripts/optimization/fminbnd.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/optimization/fminbnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/optimization/fminunc.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/optimization/fsolve.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/optimization/fzero.m Sun Dec 11 23:24:25 2011 -0500 @@ -93,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/lsqnonneg.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/optimization/lsqnonneg.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/optimization/optimset.m Sun Dec 11 23:24:25 2011 -0500 @@ -90,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. @@ -141,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/optimization/pqpnonneg.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/optimization/qp.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/optimization/sqp.m Sun Dec 11 23:24:25 2011 -0500 @@ -75,7 +75,7 @@ ## formula is used to approximate the Hessian. ## ## When supplied, the gradient function @code{@var{phi}@{2@}} must accept -## one vector argument and return a vector. When supplifed, the Hessian +## 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. ## @@ -83,7 +83,7 @@ ## 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 +## matrix ([]) for @var{g} (or @var{h}). When supplied, these equality ## and inequality constraint functions must accept one vector argument ## and return a vector. ## @@ -113,16 +113,16 @@ ## 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 +## @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 @var{maxiter} specifies the maximum number of -## iterations. The default value is 100. +## iterations. The default value is 100. ## ## The eighth argument @var{tol} specifies the tolerance for the -## stopping criteria. The default value is @code{sqrt(eps)}. +## stopping criteria. The default value is @code{sqrt(eps)}. ## ## The value returned in @var{info} may be one of the following: ## @@ -416,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. @@ -724,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/path/matlabroot.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/pkg.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/pkg/pkg.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,34 +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, ## @@ -90,47 +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: ## -## The option '-forge' lists packages available at the Octave-Forge repository. -## This requires an internet connection and the cURL library. +## @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 @@ -140,7 +158,7 @@ ## output rather than printed on screen: ## ## @example -## desc = pkg ("describe", "secs1d", "image") +## desc = pkg ("describe", "secs1d", "image") ## @end example ## ## @noindent @@ -148,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 @@ -170,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 @@ -196,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 @@ -210,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 ## @@ -236,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 @@ -267,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 (); @@ -288,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" @@ -349,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); @@ -362,7 +384,7 @@ global_list, global_install); unwind_protect_cleanup - cellfun (@unlink, local_files); + cellfun ("unlink", local_files); end_unwind_protect case "uninstall" @@ -492,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 @@ -909,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, @@ -1320,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); @@ -1383,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); @@ -1589,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"), @@ -1637,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"); @@ -1661,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")) @@ -2172,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 = "";
--- a/scripts/plot/__fltk_ginput__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,105 +0,0 @@ -## Copyright (C) 2010-2011 Shai Ayal -## -## 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}, @var{y}, @var{buttons}] =} __fltk_ginput__ (@var{f}, @var{n}) -## Undocumented internal function. -## @end deftypefn - -## This is ginput.m implementation for fltk. - -## FIXME -- Key presses cannot toggle menu items nor hotkey functionality -## (grid, autoscale) during ginput! - -function [x, y, button] = __fltk_ginput__ (f, n = -1) - - if (isempty (get (f, "currentaxes"))) - error ("ginput: must have at least one axes"); - endif - - x = y = button = []; - ginput_aggregator (0, 0, 0, 0); - - unwind_protect - - orig_windowbuttondownfcn = get (f, "windowbuttondownfcn"); - set (f, "windowbuttondownfcn", @ginput_windowbuttondownfcn); - - orig_ginput_keypressfcn = get (f, "keypressfcn"); - set (f, "keypressfcn", @ginput_keypressfcn); - - while (true) - __fltk_redraw__ (); - - ## Release CPU. - sleep (0.01); - - [x, y, n0, button] = ginput_aggregator (-1, 0, 0, 0); - if (n0 == n || n0 < 0) - break; - endif - endwhile - - unwind_protect_cleanup - set (f, "windowbuttondownfcn", orig_windowbuttondownfcn); - set (f, "keypressfcn", orig_ginput_keypressfcn); - end_unwind_protect - -endfunction - -function [x, y, n, button] = ginput_aggregator (mode, xn, yn, btn) - persistent x y n button; - - if (mode == 0) - ## Initialize. - x = []; - y = []; - button = []; - n = 0; - elseif (mode == 1) - ## Accept mouse button or key press. - x = [x; xn]; - y = [y; yn]; - button = [button; btn]; - n += 1; - elseif (mode == 2) - ## The end due to Enter. - n = -1; - endif -endfunction - -function ginput_windowbuttondownfcn (src, data) - point = get (get (src,"currentaxes"), "currentpoint"); - ## FIXME -- How to get the actual mouse button pressed (1,2,3) into - ## "button"? - button = 1; - ginput_aggregator (1, point(1,1), point(2,1), button); -endfunction - -function ginput_keypressfcn (src, evt) - point = get (get (src, "currentaxes"), "currentpoint"); - ## FIXME -- use evt.Key or evt.Character? - key = evt.Key; - if (key == 10) - ## Enter key. - ginput_aggregator (2, point(1,1), point(2,1), key); - else - ginput_aggregator (1, point(1,1), point(2,1), key); - endif -endfunction -
--- a/scripts/plot/__fltk_print__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,161 +0,0 @@ -## Copyright (C) 2010-2011 Shai Ayal -## -## 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} {} __fltk_print__ (@var{@dots{}}) -## Undocumented internal function. -## @end deftypefn - -function opts = __fltk_print__ (opts) - - dos_shell = (ispc () && ! isunix ()); - - figure (opts.figure); - drawnow ("expose"); - __fltk_redraw__ (); - - if (! isempty (opts.fig2dev_binary)) - ## fig2dev is prefered for conversion to emf - fig2dev_devices = {"pstex", "mf", "emf"}; - else - fig2dev_devices = {"pstex", "mf"}; - endif - - gl2ps_device = {}; - pipeline = {}; - switch (lower (opts.devopt)) - case {"eps", "eps2", "epsc", "epsc2"} - ## format GL2PS_EPS - gl2ps_device = {"eps"}; - ## FIXME - use epstool to tighten bbox and provide preview. - pipeline = {opts.epstool_cmd(opts, "-", opts.name)}; - case {"epslatex", "pslatex", "pdflatex", "epslatexstandalone", ... - "pslatexstandalone", "pdflatexstandalone"} - ## format GL2PS_TEX - n = find (opts.devopt == "l", 1); - suffix = opts.devopt(1:n-1); - dot = find (opts.name == ".", 1, "last"); - if ((! isempty (dot)) - && any (strcmpi (opts.name(dot:end), ... - {".eps", ".ps", ".pdf", ".tex", "."}))) - name = opts.name(1:dot-1); - if (dot < numel (opts.name) - && any (strcmpi (opts.name(dot+1:end), {"eps", "ps", "pdf"}))) - ## If user provides eps/ps/pdf suffix, use it. - suffix = opts.name(dot+1:end); - endif - elseif (dot == numel (opts.name)) - name = opts.name; - endif - gl2ps_device = {sprintf("%snotxt", lower (suffix))}; - gl2ps_device{2} = "tex"; - if (dos_shell) - ## FIXME - this will only work on MinGW with the MSYS shell - pipeline = {sprintf("cat > %s-inc.%s", name, suffix)}; - pipeline{2} = sprintf ("cat > %s.tex", name); - else - pipeline = {sprintf("cat > %s-inc.%s", name, suffix)}; - pipeline{2} = sprintf ("cat > %s.tex", name); - endif - case "tikz" - ## format GL2PS_PGF - gl2ps_device = {"pgf"}; - pipeline = {sprintf("cat > %s", opts.name)}; - case "svg" - ## format GL2PS_SVG - gl2ps_device = {"svg"}; - pipeline = {sprintf("cat > %s", opts.name)}; - case fig2dev_devices - cmd_pstoedit = opts.pstoedit_cmd (opts, "fig"); - cmd_fig2dev = opts.fig2dev_cmd (opts, opts.devopt); - if (strcmp (opts.devopt, "pstex")) - [~, ~, ext] = fileparts (opts.name); - if (any (strcmpi (ext, {".ps", ".tex", "."}))) - opts.name = opts.name(1:end-numel(ext)); - endif - opts.name = strcat (opts.name, ".ps"); - cmd = sprintf ("%s | %s > %s", cmd_pstoedit, cmd_fig2dev, opts.name); - gl2ps_device = {"eps"}; - pipeline = {cmd}; - cmd_fig2dev = opts.fig2dev_cmd (opts, "pstex_t"); - gl2ps_device{2} = "eps"; - pipeline{2} = sprintf ("%s | %s > %s", cmd_pstoedit, - cmd_fig2dev, strrep(opts.name, ".ps", ".tex")); - else - cmd = sprintf ("%s | %s > %s", cmd_pstoedit, cmd_fig2dev, opts.name); - gl2ps_device = {"eps"}; - pipeline = {cmd}; - endif - case "aifm" - cmd = opts.pstoedit_cmd (opts, "ps2ai"); - gl2ps_device = {"eps"}; - pipeline = {sprintf("%s > %s", cmd, opts.name)}; - case {"dxf", "emf", "fig", "hpgl"} - cmd = opts.pstoedit_cmd (opts); - gl2ps_device = {"eps"}; - pipeline = {sprintf("%s > %s", cmd, opts.name)}; - case {"corel", "gif"} - error ("print:unsupporteddevice", - "print.m: %s output is not available for the FLTK graphics toolkit", - upper (opts.devopt)); - case opts.ghostscript.device - opts.ghostscript.source = "-"; - opts.ghostscript.output = opts.name; - if (opts.send_to_printer) - opts.unlink(strcmp (opts.unlink, opts.ghostscript.output)) = []; - opts.ghostscript.output = "-"; - endif - [cmd_gs, cmd_cleanup] = __ghostscript__ (opts.ghostscript); - if (opts.send_to_printer || isempty (opts.name)) - cmd_lpr = opts.lpr_cmd (opts); - cmd = sprintf("%s | %s", cmd_gs, cmd_lpr); - else - cmd = sprintf("%s", cmd_gs); - endif - if (! isempty (cmd_cleanup)) - gl2ps_device = {"eps"}; - if (dos_shell) - pipeline = {sprintf("%s & %s", cmd, cmd_cleanup)}; - else - pipeline = {sprintf("%s ; %s", cmd, cmd_cleanup)}; - endif - else - gl2ps_device = {"eps"}; - pipeline = {cmd}; - endif - otherwise - error (sprintf ("print:no%soutput", opts.devopt), - "print.m: %s output is not available for GL2PS output", - upper (opts.devopt)); - endswitch - - opts.pipeline = pipeline; - - for n = 1:numel(pipeline) - if (opts.debug) - fprintf ("fltk-pipeline: '%s'\n", pipeline{n}); - endif - drawnow (gl2ps_device{n}, strcat('|',pipeline{n})); - endfor - - if (! isempty (strfind (opts.devopt, "standalone"))) - opts.latex_standalone (opts); - endif - -endfunction -
--- a/scripts/plot/__gnuplot_drawnow__.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/__gnuplot_drawnow__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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)
--- a/scripts/plot/__gnuplot_get_var__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,161 +0,0 @@ -## Copyright (C) 2009-2011 Ben Abbott -## -## 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{value} =} __gnuplot_get_var__ (@var{h}, @var{name}, @var{fmt}) -## Undocumented internal function. -## @end deftypefn - -## Author: Ben Abbott <bpabbott@mac.com> -## Created: 2009-02-07 - -function gp_var_value = __gnuplot_get_var__ (h, gp_var_name, fmt) - - if (nargin == 0) - h = gcf (); - endif - if (nargin < 2) - print_usage (); - endif - if (nargin < 3) - fmt = ''; - endif - - if (numel (h) == 1 && isfigure (h)) - if (isempty (get (gcf, "__plot_stream__"))) - ostream = __gnuplot_open_stream__ (2, h); - else - ostream = get (h, "__plot_stream__"); - endif - else - ostream = h; - endif - if (numel (ostream) < 1) - error ("__gnuplot_get_var__: stream to gnuplot not open"); - elseif (ispc ()) - if (numel (ostream) == 1) - error ("__gnuplot_get_var__: Need mkfifo that is not implemented under Windows"); - endif - use_mkfifo = false; - istream = ostream(2); - ostream = ostream(1); - else - use_mkfifo = true; - ostream = ostream(1); - endif - - if (use_mkfifo) - gpin_name = tmpnam (); - - ## Mode: 6*8*8 == 0600 - [err, msg] = mkfifo (gpin_name, 6*8*8); - - if (err != 0) - error ("__gnuplot_get_var__: Can not make fifo (%s)", msg); - endif - endif - - gp_var_name = strtrim (gp_var_name); - n = min (strfind (gp_var_name, " "), strfind (gp_var_name, ",")) - 1; - if (isempty (n)) - n = numel (gp_var_name); - endif - - unwind_protect - - ## Notes: Variables may be undefined if user closes gnuplot by "q" - ## or Alt-F4. Further, this abrupt close also requires the leading - ## "\n" on the next line. - if (use_mkfifo) - fprintf (ostream, "\nset print \"%s\";\n", gpin_name); - fflush (ostream); - [gpin, err] = fopen (gpin_name, "r"); - if (err != 0) - ## Try a second time, and then give an error. - [gpin, err] = fopen (gpin_name, "r"); - endif - if (err != 0) - error ("__gnuplot_get_var__: can not open fifo"); - endif - gp_cmd = sprintf ("\nif (exists(\"%s\")) print %s; else print NaN\n", - gp_var_name(1:n), gp_var_name); - fputs (ostream, gp_cmd); - - ## Close output file, to force it to be flushed - fputs (ostream, "set print;\n"); - fflush (ostream); - - ## Now read from fifo. - reading = true; - str = {}; - while (reading) - str{end+1} = fgets (gpin); - if (isnumeric (str{end}) && (str{end} == -1)) - reading = false; - str = str(1:(end-1)); - endif - endwhile - str = strcat (str{:}); - fclose (gpin); - else - ## Direct gnuplot to print to <STDOUT> - fprintf (ostream, "set print \"-\";\n"); - fflush (ostream); - gp_cmd = sprintf ("\nif (exists(\"%s\")) print \"OCTAVE: \", %s; else print NaN\n", - gp_var_name(1:n), gp_var_name); - fputs (ostream, gp_cmd); - fflush (ostream); - ## Direct gnuplot to print to <STDERR> - fputs (ostream, "set print;\n"); - fflush (ostream); - - str = {}; - while (isempty (str)) - str = char (fread (istream)'); - if (isempty (str)) - sleep (0.05); - else - str = regexp (str, 'OCTAVE:.*', "match"); - str = str{end}(8:end); - endif - fclear (istream); - endwhile - endif - - ## Strip out EOLs and the continuation character "|" - str(str=="\n") = ""; - str(str=="\r") = ""; - n_continue = strfind (str, " \\ "); - if (! isempty (n_continue)) - str(n_continue+1) = ""; - endif - - if (isempty (fmt)) - gp_var_value = strtrim (str); - else - gp_var_value = sscanf (str, fmt); - endif - - unwind_protect_cleanup - if (use_mkfifo) - unlink (gpin_name); - endif - end_unwind_protect - -endfunction -
--- a/scripts/plot/__gnuplot_ginput__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,154 +0,0 @@ -## Copyright (C) 2004-2011 Petr Mikulik -## -## 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}, @var{y}, @var{buttons}] =} __gnuplot_ginput__ (@var{f}, @var{n}) -## Undocumented internal function. -## @end deftypefn - -## This is ginput.m implementation for gnuplot and X11. -## It requires gnuplot 4.1 and later. - -## This file initially bore the copyright statement -## Petr Mikulik -## History: June 2006; August 2005; June 2004; April 2004 -## License: public domain - -function [x, y, button] = __gnuplot_ginput__ (f, n) - - ostream = get (f, "__plot_stream__"); - if (numel (ostream) < 1) - error ("ginput: stream to gnuplot not open"); - elseif (ispc ()) - if (numel (ostream) == 1) - error ("ginput: Need mkfifo that is not implemented under Windows"); - endif - use_mkfifo = false; - istream = ostream(2); - ostream = ostream(1); - else - use_mkfifo = true; - ostream = ostream(1); - endif - - if (compare_versions (__gnuplot_version__ (), "4.0", "<=")) - error ("ginput: version %s of gnuplot not supported", gnuplot_version ()); - endif - - if (nargin == 1) - x = zeros (100, 1); - y = zeros (100, 1); - button = zeros (100, 1); - else - x = zeros (n, 1); - y = zeros (n, 1); - button = zeros (n, 1); - endif - - if (use_mkfifo) - gpin_name = tmpnam (); - - ##Mode: 6*8*8 == 0600 - [err, msg] = mkfifo (gpin_name, 6*8*8); - - if (err != 0) - error ("ginput: Can not open fifo (%s)", msg); - endif - endif - - unwind_protect - - k = 0; - while (true) - k++; - - ## Notes: MOUSE_* can be undefined if user closes gnuplot by "q" - ## or Alt-F4. Further, this abrupt close also requires the leading - ## "\n" on the next line. - if (use_mkfifo) - fprintf (ostream, "set print \"%s\";\n", gpin_name); - fflush (ostream); - [gpin, err] = fopen (gpin_name, "r"); - if (err != 0) - error ("ginput: Can not open fifo (%s)", msg); - endif - fputs (ostream, "pause mouse any;\n\n"); - fputs (ostream, "\nif (exists(\"MOUSE_KEY\") && exists(\"MOUSE_X\")) print MOUSE_X, MOUSE_Y, MOUSE_KEY; else print \"0 0 -1\"\n"); - - ## Close output file, to force it to be flushed - fputs (ostream, "set print;\n"); - fflush (ostream); - - ## Now read from fifo. - [x(k), y(k), button(k), count] = fscanf (gpin, "%f %f %d", "C"); - fclose (gpin); - else - fprintf (ostream, "set print \"-\";\n"); - fflush (ostream); - fputs (ostream, "pause mouse any;\n\n"); - fputs (ostream, "\nif (exists(\"MOUSE_KEY\") && exists(\"MOUSE_X\")) print \"OCTAVE: \", MOUSE_X, MOUSE_Y, MOUSE_KEY; else print \"0 0 -1\"\n"); - - ## Close output file, to force it to be flushed - fputs (ostream, "set print;\n"); - fflush (ostream); - - str = {}; - while (isempty (str)) - str = char (fread (istream)'); - if (isempty (str)) - sleep (0.05); - else - str = regexp (str, 'OCTAVE:\s+[-+.\d]+\s+[-+.\d]+\s+\d*', 'match'); - endif - fclear (istream); - endwhile - [x(k), y(k), button(k), count] = sscanf (str{end}(8:end), "%f %f %d", "C"); - endif - - if ([x(k), y(k), button(k)] == [0, 0, -1]) - ## Mousing not active (no plot yet). - break; - endif - - if (nargin > 1) - ## Input argument n was given => stop when k == n. - if (k == n) - break; - endif - else - ## Input argument n not given => stop when hitting a return key. - ## if (button(k) == 0x0D || button(k) == 0x0A) - ## ## hit Return or Enter - if (button(k) == 0x0D) - ## hit Return - x(k:end) = []; - y(k:end) = []; - button(k:end) = []; - break; - endif - endif - endwhile - - unwind_protect_cleanup - if (use_mkfifo) - unlink (gpin_name); - endif - end_unwind_protect - -endfunction -
--- a/scripts/plot/__gnuplot_has_feature__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,61 +0,0 @@ -## Copyright (C) 2009-2011 Ben Abbott -## -## 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{has_feature} =} __gnuplot_has_feature__ (@var{feature}) -## Undocumented internal function. -## @end deftypefn - -## Author: Ben Abbott <bpabbott@mac.com> -## Created: 2009-01-27 - -function res = __gnuplot_has_feature__ (feature) - persistent features has_features - features = {"x11_figure_position", - "wxt_figure_size", - "transparent_patches", - "transparent_surface", - "epslatex_implies_eps_filesuffix", - "epslatexstandalone_terminal", - "screen_coordinates_for_{lrtb}margin", - "variable_GPVAL_TERMINALS", - "key_has_font_properties"}; - - if (isempty (has_features)) - try - gnuplot_version = __gnuplot_version__ (); - catch - ## Don't throw an error if gnuplot isn't installed - gnuplot_version = "0.0.0"; - end_try_catch - versions = {"4.2.5", "4.4", "4.4", "4.4", "4.2", "4.2", "4.4", "4.4", "4.4"}; - operators = {">=", ">=", ">=", ">=", ">=", ">=", ">=", ">=", ">="}; - have_features = logical (zeros (size (features))); - for n = 1 : numel (have_features) - has_features(n) = compare_versions (gnuplot_version, versions{n}, operators{n}); - endfor - endif - - n = find (strcmpi (feature, features)); - if (isempty (n)) - res = NaN; - else - res = has_features(n); - endif -endfunction -
--- a/scripts/plot/__gnuplot_open_stream__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,45 +0,0 @@ -## Copyright (C) 2009-2011 Ben Abbott -## -## 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{stream} =} __gnuplot_open_stream__ (@var{npipes}, @var{h}) -## Undocumented internal function. -## @end deftypefn - -## Author: Ben Abbott <bpabbott@mac.com> -## Created: 2009-04-11 - -function plot_stream = __gnuplot_open_stream__ (npipes, h) - [prog, args] = gnuplot_binary (); - if (npipes > 1) - [plot_stream(1), plot_stream(2), pid] = popen2 (prog, args{:}); - if (pid < 0) - error ("__gnuplot_open_stream__: failed to open connection to gnuplot"); - else - plot_stream(3) = pid; - endif - else - plot_stream = popen (sprintf ("%s ", prog, args{:}), "w"); - if (plot_stream < 0) - error ("__gnuplot_open_stream__: failed to open connection to gnuplot"); - endif - endif - if (nargin > 1) - set (h, "__plot_stream__", plot_stream); - endif -endfunction
--- a/scripts/plot/__gnuplot_print__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,300 +0,0 @@ -## Copyright (C) 1999-2011 Daniel Heiserer -## Copyright (C) 2001 Laurent Mazet -## -## 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} {} __gnuplot_print__ (@var{@dots{}}) -## Undocumented internal function. -## @end deftypefn - -## Author: Daniel Heiserer <Daniel.heiserer@physik.tu-muenchen.de> -## Adapted-By: jwe - -function opts = __gnuplot_print__ (opts) - - dos_shell = (ispc () && ! isunix ()); - - if (isempty (opts.fontsize)) - ## If no fontsize, determine the nominal axes fontsize. - defaultfontsize = get (0, "defaultaxesfontsize"); - axesfontsize = get (findobj (opts.figure, "type", "axes"), "fontsize"); - if (iscell (axesfontsize)) - axesfontsize = round (median (cell2mat (axesfontsize))); - endif - if (isempty (axesfontsize)) - opts.fontsize = defaultfontsize; - else - opts.fontsize = axesfontsize; - endif - endif - ## The axes-label and tick-label spacing is determined by - ## the font spec given in "set terminal ..." - gp_opts = font_spec (opts); - - pipeline = ""; - - switch (lower (opts.devopt)) - case {"eps", "eps2", "epsc", "epsc2"} - if (any (strcmp (opts.devopt, {"eps", "epsc"}))) - gp_opts = sprintf ("%s level1", gp_opts); - endif - if (opts.tight_flag || ! isempty (opts.preview)) - tmp_file = strcat (tmpnam (), ".eps"); - eps_drawnow (opts, tmp_file, gp_opts); - if (dos_shell) - cleanup = sprintf (" & del %s", strrep (tmp_file, '/', '\')); - else - cleanup = sprintf (" ; rm %s", tmp_file); - endif - pipeline = {sprintf("%s %s", - opts.epstool_cmd (opts, tmp_file, opts.name), - cleanup)}; - else - eps_drawnow (opts, opts.name, gp_opts); - endif - case {"epslatex", "pslatex", "pstex", "epslatexstandalone"} - dot = find (opts.name == ".", 1, "last"); - if ((! isempty (dot)) - && any (strcmpi (opts.name(dot:end), - {".eps", ".ps", ".pdf", ".tex", "."}))) - name = opts.name(1:dot-1); - endif - if (strfind (opts.devopt, "standalone")) - term = sprintf ("%s ", - strrep (opts.devopt, "standalone", " standalone")); - else - term = sprintf ("%s ", opts.devopt); - endif - if (__gnuplot_has_feature__ ("epslatex_implies_eps_filesuffix")) - suffix = "tex"; - else - %% Gnuplot 4.0 wants a ".eps" suffix. - suffix = "eps"; - endif - local_drawnow (sprintf ("%s %s", term, gp_opts), - strcat (name, ".", suffix), opts); - case "tikz" - if (__gnuplot_has_terminal__ ("tikz")) - local_drawnow (sprintf ("lua tikz %s", gp_opts), opts.name, opts); - else - error (sprintf ("print:no%soutput", opts.devopt), - "print.m: '%s' output is not available for gnuplot-%s", - upper (opts.devopt), __gnuplot_version__ ()); - endif - case "svg" - local_drawnow (sprintf ("svg dynamic %s", gp_opts), opts.name, opts); - case {"aifm", "corel", "eepic", "emf", "fig"} - local_drawnow (sprintf ("%s %s", opts.devopt, gp_opts), opts.name, opts); - case {"pdfcairo", "pngcairo"} - if (__gnuplot_has_terminal__ (opts.devopt)) - local_drawnow (sprintf ("%s %s", opts.devopt, gp_opts), opts.name, opts); - else - error (sprintf ("print:no%soutput", opts.devopt), - "print.m: '%s' output is not available for gnuplot-%s", - upper (opts.devopt), __gnuplot_version__ ()); - endif - case {"canvas", "dxf", "hpgl", "mf", "gif", "pstricks", "texdraw"} - local_drawnow (sprintf ("%s %s", opts.devopt, gp_opts), opts.name, opts); - case opts.ghostscript.device - gp_opts = font_spec (opts, "devopt", "eps"); - opts.ghostscript.output = opts.name; - opts.ghostscript.source = strcat (tmpnam (), ".eps"); - eps_drawnow (opts, opts.ghostscript.source, gp_opts); - [cmd_gs, cmd_cleanup] = __ghostscript__ (opts.ghostscript); - if (opts.send_to_printer || isempty (opts.name)) - cmd_lpr = opts.lpr_cmd (opts); - cmd = sprintf ("%s | %s", cmd_gs, cmd_lpr); - else - cmd = sprintf ("%s", cmd_gs); - endif - if (dos_shell) - cmd = sprintf ("%s & del %s", cmd, strrep (opts.ghostscript.source, '/', '\')); - else - cmd = sprintf ("%s ; rm %s", cmd, opts.ghostscript.source); - endif - if (! isempty (cmd_cleanup)) - if (dos_shell) - pipeline = {sprintf("%s & %s", cmd, cmd_cleanup)}; - else - pipeline = {sprintf("%s ; %s", cmd, cmd_cleanup)}; - endif - else - pipeline = {cmd}; - endif - otherwise - error (sprintf ("print:no%soutput", opts.devopt), - "print.m: %s output is not available for the Gnuplot graphics toolkit", - upper (opts.devopt)); - endswitch - - - opts.pipeline = pipeline; - - for n = 1:numel(pipeline) - if (opts.debug) - fprintf ("gnuplot-pipeline: '%s'\n", pipeline{n}); - endif - [status, output] = system (pipeline{n}); - if (status) - fprintf ("%s\n%s\n%s\n", - "---------- output begin ----------", - output, - "----------- output end -----------"); - error ("gnuplot:failedpipe", "print: failed to print"); - endif - endfor - -endfunction - -function eps_drawnow (opts, epsfile, gp_opts) - [h, fontsize] = get_figure_text_objs (opts); - unwind_protect - for n = 1:numel(h) - set (h(n), "fontsize", 2 * fontsize{n}); - endfor - local_drawnow (sprintf ("postscript eps %s", gp_opts), epsfile, opts); - unwind_protect_cleanup - for n = 1:numel(h) - set (h(n), "fontsize", fontsize{n}); - endfor - end_unwind_protect -endfunction - -function local_drawnow (term, file, opts) - if (opts.use_color < 0) - mono = true; - else - mono = false; - endif - figure (opts.figure); - if (isempty (opts.debug_file) || ! opts.debug) - drawnow (term, file, mono); - else - drawnow (term, file, mono, opts.debug_file); - endif -endfunction - -function f = font_spec (opts, varargin) - for n = 1:2:numel(varargin) - opts.(varargin{n}) = varargin{n+1}; - endfor - f = ""; - switch (opts.devopt) - case "cgm" - if (! isempty (opts.font) && ! isempty (opts.fontsize)) - f = sprintf ("font ""%s,%d""", opts.font, opts.fontsize); - elseif (! isempty (opts.font)) - f = sprintf ("font ""%s""", opts.font); - elseif (! isempty (opts.fontsize)) - f = sprintf ("%d", opts.fontsize); - endif - case {"eps", "eps2", "epsc", "epsc2"} - ## Gnuplot renders fonts as half their specification, which - ## results in a tight spacing for the axes-labels and tick-labels. - ## Compensate for the half scale. This will produce the proper - ## spacing for the requested fontsize. - if (! isempty (opts.font) && ! isempty (opts.fontsize)) - f = sprintf ("font ""%s,%d""", opts.font, 2 * opts.fontsize); - elseif (! isempty (opts.font)) - f = sprintf ("font ""%s""", opts.font); - elseif (! isempty (opts.fontsize)) - f = sprintf ("%d", 2 * opts.fontsize); - endif - case "svg" - if (! isempty (opts.font) && ! isempty (opts.fontsize)) - fontsize = round (opts.fontsize * 0.75); - f = sprintf ("fname ""%s"" fsize %d", opts.font, fontsize); - elseif (! isempty (opts.font)) - f = sprintf ("fname ""%s""", opts.font); - elseif (! isempty (opts.fontsize)) - fontsize = round (opts.fontsize * 0.75); - f = sprintf ("%s fsize %d", f, fontsize); - endif - case "pdf" - if (! isempty (opts.font) && ! isempty (opts.fontsize)) - f = sprintf ("font ""%s,%d""", opts.font, opts.fontsize); - elseif (! isempty (opts.font)) - f = sprintf ("font ""%s""", opts.font); - elseif (! isempty (opts.fontsize)) - f = sprintf ("fsize %d", f, opts.fontsize); - endif - case {"pdfcairo", "pngcairo"} - if (! isempty (opts.font)) - f = sprintf ("font ""%s""", opts.font); - endif - case {"epslatex", "epslatexstandalone"} - if (! isempty (opts.font) && ! isempty (opts.fontsize)) - f = sprintf ("font ""%s,%d""", opts.font, opts.fontsize); - elseif (! isempty (opts.font)) - f = sprintf ("font ""%s""", opts.font); - elseif (! isempty (opts.fontsize)) - f = sprintf ("%d", opts.fontsize); - endif - case "pslatex" - if (! isempty (opts.fontsize)) - f = sprintf ("%d", opts.fontsize); - endif - case {"gif", "jpeg", "png"} - if (! isempty (opts.font) && ! isempty (opts.fontsize)) - f = sprintf ("font ""%s ,%d""", opts.font, opts.fontsize); - elseif (! isempty (opts.font)) - f = sprintf ("font ""%s""", opts.font); - elseif (! isempty (opts.fontsize)) - f = sprintf ("font ""%d""", opts.fontsize); - endif - case "emf" - if (! isempty (opts.font) && ! isempty (opts.fontsize)) - f = sprintf ("""%s"" %d", opts.font, opts.fontsize); - elseif (! isempty (opts.font)) - f = sprintf ("""%s""", opts.font); - elseif (! isempty (opts.fontsize)) - f = sprintf ("%d", opts.fontsize); - endif - case "canvas" - if (! isempty (opts.fontsize)) - f = sprintf ("fsize %d", opts.fontsize); - endif - case {"aifm", "corel"} - if (! isempty (opts.font) && ! isempty (opts.fontsize)) - f = sprintf ("%s %d", opts.font, opts.fontsize); - elseif (! isempty (opts.font)) - f = sprintf ("%s", opts.font); - elseif (! isempty (opts.fontsize)) - f = sprintf ("%d", opts.fontsize); - endif - case "fig" - if (! isempty (opts.font) && ! isempty (opts.fontsize)) - f = sprintf ("font %s fontsize %d", opts.font, opts.fontsize); - elseif (! isempty (opts.font)) - f = sprintf ("font %s", opts.font); - elseif (! isempty (opts.fontsize)) - f = sprintf ("fontsize %d", opts.fontsize); - endif - endswitch -endfunction - -function [h, fontsize] = get_figure_text_objs (opts) - h = findall (opts.figure, "-property", "fontsize"); - fontsize = get (h, "fontsize"); - switch (numel (fontsize)) - case 0 - fontsize = {}; - case 1 - fontsize = {fontsize}; - endswitch -endfunction
--- a/scripts/plot/__gnuplot_version__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,51 +0,0 @@ -## Copyright (C) 2006-2011 Daniel Sebald -## -## 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{version} =} __gnuplot_version__ () -## Undocumented internal function. -## @end deftypefn - -## Return the version of gnuplot we are using. Note that we do not -## attempt to handle the case of the user switching to different -## versions of gnuplot during the same session. - -function version = __gnuplot_version__ () - - persistent __version__ = ""; - - if (isempty (__version__)) - [status, output] = system (sprintf ("\"%s\" --version", gnuplot_binary ())); - if (status != 0) - ## This message ends in a newline so that the traceback messages - ## are skipped and people might actually see the message, read it, - ## comprehend it, actually take the advice it gives, and stop - ## asking us why plotting fails when gnuplot is not found. - error ("you must have gnuplot installed to display graphics; if you have gnuplot installed in a non-standard location, see the 'gnuplot_binary' function\n"); - endif - output = strrep (output, "gnuplot", ""); - output = strrep (output, "patchlevel", "."); - output = strrep (output, "\n", ""); - output = strrep (output, "\r", ""); - __version__ = strrep (output, " ", ""); - endif - - version = __version__; - -endfunction -
--- a/scripts/plot/__go_close_all__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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/__go_draw_axes__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2484 +0,0 @@ -## Copyright (C) 2005-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_draw_axes__ (@var{h}, @var{plot_stream}, @var{enhanced}, @var{mono}) -## Undocumented internal function. -## @end deftypefn - -## Author: jwe - -function __go_draw_axes__ (h, plot_stream, enhanced, mono, - bg_is_set, fg_is_set, hlgnd) - - if (nargin >= 4 && nargin <= 7) - - showhiddenhandles = get (0, "showhiddenhandles"); - unwind_protect - set (0, "showhiddenhandles", "on"); - axis_obj = __get__ (h); - unwind_protect_cleanup - set (0, "showhiddenhandles", showhiddenhandles); - end_unwind_protect - - parent_figure_obj = get (axis_obj.parent); - 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; - endif - - nd = __calc_dimensions__ (h); - - if (strcmp (axis_obj.dataaspectratiomode, "manual") - && strcmp (axis_obj.xlimmode, "manual") - && strcmp (axis_obj.ylimmode, "manual")) - ## All can't be "manual" - axis_obj.plotboxaspectratiomode = "auto"; - endif - - if (strcmp (axis_obj.dataaspectratiomode, "manual") - && strcmp (axis_obj.xlimmode, "manual") - && strcmp (axis_obj.ylimmode, "manual") - && (nd == 2 || all (mod (axis_obj.view, 90) == 0))) - ## FIXME - adjust plotboxaspectratio to respect other - fpos = get (axis_obj.parent, "position"); - apos = axis_obj.position; - endif - - pos = __actual_axis_position__ (h); - - if (strcmpi (axis_obj.dataaspectratiomode, "manual")) - dr = axis_obj.dataaspectratio; - if (nd == 2 || all (mod (axis_obj.view, 90) == 0)) - dr = dr(1) / dr(2); - else - ## FIXME - need to properly implement 3D - dr = mean (dr(1:2)) / dr(3); - endif - else - dr = 1; - endif - - if (strcmp (axis_obj.activepositionproperty, "position")) - if (__gnuplot_has_feature__ ("screen_coordinates_for_{lrtb}margin")) - if (nd == 2 || all (mod (axis_obj.view, 90) == 0)) - x = [1, 1]; - else - ## 3D plots need to be sized down to fit in the window. - x = 1.0 ./ sqrt([2, 2.5]); - endif - fprintf (plot_stream, "set tmargin screen %.15g;\n", - pos(2)+pos(4)/2+x(2)*pos(4)/2); - fprintf (plot_stream, "set bmargin screen %.15g;\n", - pos(2)+pos(4)/2-x(2)*pos(4)/2); - fprintf (plot_stream, "set lmargin screen %.15g;\n", - pos(1)+pos(3)/2-x(1)*pos(3)/2); - fprintf (plot_stream, "set rmargin screen %.15g;\n", - pos(1)+pos(3)/2+x(1)*pos(3)/2); - sz_str = ""; - else - fprintf (plot_stream, "set tmargin 0;\n"); - fprintf (plot_stream, "set bmargin 0;\n"); - fprintf (plot_stream, "set lmargin 0;\n"); - fprintf (plot_stream, "set rmargin 0;\n"); - - if (nd == 3 && all (axis_obj.view == [0, 90])) - ## FIXME -- Kludge to allow colorbar to be added to a pcolor() plot - pos(3:4) = pos(3:4) * 1.4; - pos(1:2) = pos(1:2) - pos(3:4) * 0.125; - endif - - fprintf (plot_stream, "set origin %.15g, %.15g;\n", pos(1), pos(2)); - - if (strcmpi (axis_obj.dataaspectratiomode, "manual")) - sz_str = sprintf ("set size ratio %.15g", -dr); - else - sz_str = "set size noratio"; - endif - sz_str = sprintf ("%s %.15g, %.15g;\n", sz_str, pos(3), pos(4)); - endif - else ## activepositionproperty == outerposition - fprintf (plot_stream, "unset tmargin;\n"); - fprintf (plot_stream, "unset bmargin;\n"); - fprintf (plot_stream, "unset lmargin;\n"); - fprintf (plot_stream, "unset rmargin;\n"); - fprintf (plot_stream, "set origin %g, %g;\n", pos(1:2)); - sz_str = ""; - if (strcmpi (axis_obj.dataaspectratiomode, "manual")) - sz_str = sprintf ("ratio %g", -dr); - else - sz_str = "noratio"; - endif - sz_str = sprintf ("set size %s %g, %g;\n", sz_str, pos(3:4)); - endif - if (! isempty (sz_str)) - fputs (plot_stream, sz_str); - endif - - ## Reset all labels, axis-labels, tick-labels, and title - ## FIXME - We should have an function to initialize the axis. - ## Presently, this is dispersed in this function. - fputs (plot_stream, "unset label;\n"); - fputs (plot_stream, "unset xtics;\n"); - fputs (plot_stream, "unset ytics;\n"); - fputs (plot_stream, "unset ztics;\n"); - fputs (plot_stream, "unset x2tics;\n"); - fputs (plot_stream, "unset x2tics;\n"); - - if (! isempty (axis_obj.title)) - t = get (axis_obj.title); - if (isempty (t.string)) - fputs (plot_stream, "unset title;\n"); - else - [tt, f, s] = __maybe_munge_text__ (enhanced, t, "string"); - fontspec = create_fontspec (f, s, gnuplot_term); - fprintf (plot_stream, "set title \"%s\" %s %s;\n", - undo_string_escapes (tt), fontspec, - __do_enhanced_option__ (enhanced, t)); - endif - endif - - if (! isempty (axis_obj.xlabel)) - t = get (axis_obj.xlabel); - angle = t.rotation; - colorspec = get_text_colorspec (axis_obj.xcolor, mono); - if (isempty (t.string)) - fprintf (plot_stream, "unset xlabel;\n"); - fprintf (plot_stream, "unset x2label;\n"); - else - [tt, f, s] = __maybe_munge_text__ (enhanced, t, "string"); - fontspec = create_fontspec (f, s, gnuplot_term); - if (strcmpi (axis_obj.xaxislocation, "top")) - fprintf (plot_stream, "set x2label \"%s\" %s %s %s", - undo_string_escapes (tt), colorspec, fontspec, - __do_enhanced_option__ (enhanced, t)); - else - fprintf (plot_stream, "set xlabel \"%s\" %s %s %s", - undo_string_escapes (tt), colorspec, fontspec, - __do_enhanced_option__ (enhanced, t)); - endif - fprintf (plot_stream, " rotate by %f;\n", angle); - if (strcmpi (axis_obj.xaxislocation, "top")) - fprintf (plot_stream, "unset xlabel;\n"); - else - fprintf (plot_stream, "unset x2label;\n"); - endif - endif - endif - - if (! isempty (axis_obj.ylabel)) - t = get (axis_obj.ylabel); - angle = t.rotation; - colorspec = get_text_colorspec (axis_obj.ycolor, mono); - if (isempty (t.string)) - fprintf (plot_stream, "unset ylabel;\n"); - fprintf (plot_stream, "unset y2label;\n"); - else - [tt, f, s] = __maybe_munge_text__ (enhanced, t, "string"); - fontspec = create_fontspec (f, s, gnuplot_term); - if (strcmpi (axis_obj.yaxislocation, "right")) - fprintf (plot_stream, "set y2label \"%s\" %s %s %s", - undo_string_escapes (tt), colorspec, fontspec, - __do_enhanced_option__ (enhanced, t)); - else - fprintf (plot_stream, "set ylabel \"%s\" %s %s %s", - undo_string_escapes (tt), colorspec, fontspec, - __do_enhanced_option__ (enhanced, t)); - endif - fprintf (plot_stream, " rotate by %f;\n", angle); - if (strcmpi (axis_obj.yaxislocation, "right")) - fprintf (plot_stream, "unset ylabel;\n"); - else - fprintf (plot_stream, "unset y2label;\n"); - endif - endif - endif - - if (! isempty (axis_obj.zlabel)) - t = get (axis_obj.zlabel); - angle = t.rotation; - colorspec = get_text_colorspec (axis_obj.zcolor, mono); - if (isempty (t.string)) - fputs (plot_stream, "unset zlabel;\n"); - else - [tt, f, s] = __maybe_munge_text__ (enhanced, t, "string"); - fontspec = create_fontspec (f, s, gnuplot_term); - fprintf (plot_stream, "set zlabel \"%s\" %s %s %s", - undo_string_escapes (tt), colorspec, fontspec, - __do_enhanced_option__ (enhanced, t)); - fprintf (plot_stream, " rotate by %f;\n", angle); - endif - endif - - if (strcmpi (axis_obj.xaxislocation, "top")) - xaxisloc = "x2"; - xaxisloc_using = "x2"; - else - xaxisloc = "x"; - xaxisloc_using = "x1"; - if (strcmpi (axis_obj.xaxislocation, "zero")) - fputs (plot_stream, "set xzeroaxis;\n"); - endif - endif - if (strcmpi (axis_obj.yaxislocation, "right")) - yaxisloc = "y2"; - yaxisloc_using = "y2"; - else - yaxisloc = "y"; - yaxisloc_using = "y1"; - if (strcmpi (axis_obj.yaxislocation, "zero")) - fputs (plot_stream, "set yzeroaxis;\n"); - endif - endif - - have_grid = false; - - if (strcmpi (axis_obj.xgrid, "on")) - have_grid = true; - fprintf (plot_stream, "set grid %stics;\n", xaxisloc); - else - fprintf (plot_stream, "set grid no%stics;\n", xaxisloc); - endif - - if (strcmpi (axis_obj.ygrid, "on")) - have_grid = true; - fprintf (plot_stream, "set grid %stics;\n", yaxisloc); - else - fprintf (plot_stream, "set grid no%stics;\n", yaxisloc); - endif - - if (strcmpi (axis_obj.zgrid, "on")) - have_grid = true; - fputs (plot_stream, "set grid ztics;\n"); - else - fputs (plot_stream, "set grid noztics;\n"); - endif - - if (strcmpi (axis_obj.xminorgrid, "on")) - have_grid = true; - if (strcmp (axis_obj.xscale, "log")) - m = 10; - else - m = 5; - endif - fprintf (plot_stream, "set m%stics %d;\n", xaxisloc, m); - fprintf (plot_stream, "set grid m%stics;\n", xaxisloc); - else - fprintf (plot_stream, "set grid nom%stics;\n", xaxisloc); - endif - - if (strcmpi (axis_obj.yminorgrid, "on")) - have_grid = true; - if (strcmp (axis_obj.yscale, "log")) - m = 10; - else - m = 5; - endif - fprintf (plot_stream, "set m%stics %d;\n", yaxisloc, m); - fprintf (plot_stream, "set grid m%stics;\n", yaxisloc); - else - fprintf (plot_stream, "set grid nom%stics;\n", yaxisloc); - endif - - if (strcmpi (axis_obj.zminorgrid, "on")) - have_grid = true; - if (strcmp (axis_obj.zscale, "log")) - m = 10; - else - m = 5; - endif - fprintf (plot_stream, "set mztics %d;\n", m); - fputs (plot_stream, "set grid mztics;\n"); - else - fputs (plot_stream, "set grid nomztics;\n"); - endif - - ## The grid front/back/layerdefault option also controls the - ## appearance of tics, so it is used even if the grid is absent. - if (strcmpi (axis_obj.layer, "top")) - fputs (plot_stream, "set grid front;\n"); - fputs (plot_stream, "set border front;\n"); - else - fputs (plot_stream, "set grid layerdefault;\n"); - ## FIXME -- the gnuplot help says that "layerdefault" should work - ## for set border too, but it fails for me with gnuplot 4.2.5. So - ## use "back" instead. - fputs (plot_stream, "set border back;\n"); - endif - - fprintf (plot_stream, "set grid linewidth %f, linewidth %f;\n", - axis_obj.linewidth, axis_obj.linewidth); - - if (! have_grid) - fputs (plot_stream, "unset grid;\n"); - endif - - 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 - if (ylogscale) - fprintf (plot_stream, "set logscale %s;\n", yaxisloc); - endif - if (zlogscale) - fputs (plot_stream, "set logscale z;\n"); - endif - - xautoscale = strcmpi (axis_obj.xlimmode, "auto"); - yautoscale = strcmpi (axis_obj.ylimmode, "auto"); - zautoscale = strcmpi (axis_obj.zlimmode, "auto"); - cautoscale = strcmpi (axis_obj.climmode, "auto"); - cdatadirect = false; - truecolor = false; - - fputs (plot_stream, "set clip two;\n"); - - kids = axis_obj.children; - ## Remove the axis labels and title from the children, and - ## preserved the original order. - [jnk, k] = setdiff (kids, [axis_obj.xlabel; axis_obj.ylabel; ... - axis_obj.zlabel; axis_obj.title]); - kids = kids (sort (k)); - - if (nd == 3) - fputs (plot_stream, "set parametric;\n"); - fputs (plot_stream, "set style data lines;\n"); - fputs (plot_stream, "set surface;\n"); - fputs (plot_stream, "unset contour;\n"); - endif - - data_idx = 0; - data = cell (); - is_image_data = []; - 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 - addedcmap = []; - - ximg_data = {}; - ximg_data_idx = 0; - - while (! isempty (kids)) - - obj = get (kids(end)); - if (isfield (obj, "units")) - units = obj.units; - unwind_protect - set (kids(end), "units", "data"); - obj = get (kids(end)); - unwind_protect_cleanup - set (kids(end), "units", units); - end_unwind_protect - endif - kids = kids(1:(end-1)); - - if (strcmpi (obj.visible, "off")) - continue; - endif - - if (xlogscale && isfield (obj, "xdata")) - obj.xdata(obj.xdata<=0) = NaN; - endif - if (ylogscale && isfield (obj, "ydata")) - obj.ydata(obj.ydata<=0) = NaN; - endif - if (zlogscale && isfield (obj, "zdata")) - obj.zdata(obj.zdata<=0) = NaN; - endif - - ## Check for facecolor interpolation for surfaces. - doing_interp_color = ... - isfield (obj, "facecolor") && strncmp (obj.facecolor, "interp", 6); - - switch (obj.type) - case "image" - img_data = obj.cdata; - img_xdata = obj.xdata; - img_ydata = obj.ydata; - - if (ndims (img_data) == 3) - truecolor = true; - elseif (strcmpi (obj.cdatamapping, "direct")) - cdatadirect = true; - endif - data_idx++; - is_image_data(data_idx) = true; - parametric(data_idx) = false; - have_cdata(data_idx) = false; - have_3d_patch(data_idx) = false; - - if (img_xdata(2) < img_xdata(1)) - img_xdata = img_xdata(2:-1:1); - img_data = img_data(:,end:-1:1,:); - elseif (img_xdata(1) == img_xdata(2)) - img_xdata = img_xdata(1) + [0, size(img_data,2)-1]; - endif - if (img_ydata(2) < img_ydata(1)) - img_ydata = img_ydata(2:-1:1); - img_data = img_data(end:-1:1,:,:); - elseif (img_ydata(1) == img_ydata(2)) - img_ydata = img_ydata(1) + [0, size(img_data,1)-1]; - endif - - [y_dim, x_dim] = size (img_data(:,:,1)); - if (x_dim > 1) - dx = abs (img_xdata(2)-img_xdata(1))/(x_dim-1); - else - x_dim = 2; - img_data = [img_data, img_data]; - dx = abs (img_xdata(2)-img_xdata(1)); - endif - if (y_dim > 1) - dy = abs (img_ydata(2)-img_ydata(1))/(y_dim-1); - else - y_dim = 2; - img_data = [img_data; img_data]; - dy = abs (img_ydata(2)-img_ydata(1)); - endif - - x_origin = min (img_xdata); - y_origin = min (img_ydata); - - if (ndims (img_data) == 3) - data{data_idx} = permute (img_data, [3, 1, 2])(:); - format = "1:2:3"; - imagetype = "rgbimage"; - else - data{data_idx} = img_data(:); - format = "1"; - imagetype = "image"; - endif - - titlespec{data_idx} = "title \"\""; - usingclause{data_idx} = sprintf ("binary array=%dx%d scan=yx origin=(%.15g,%.15g) dx=%.15g dy=%.15g using %s", - x_dim, y_dim, x_origin, y_origin, dx, dy, format); - withclause{data_idx} = sprintf ("with %s;", imagetype); - - case "line" - if (strncmp (obj.linestyle, "none", 4) - && (! isfield (obj, "marker") - || (isfield (obj, "marker") - && strncmp (obj.marker, "none", 4)))) - continue; - endif - data_idx++; - is_image_data(data_idx) = false; - parametric(data_idx) = true; - have_cdata(data_idx) = false; - have_3d_patch(data_idx) = false; - if (isempty (obj.displayname)) - titlespec{data_idx} = "title \"\""; - else - tmp = undo_string_escapes (__maybe_munge_text__ (enhanced, obj, "displayname")); - titlespec{data_idx} = cstrcat ("title \"", tmp, "\""); - endif - usingclause{data_idx} = sprintf ("record=%d", numel (obj.xdata)); - errbars = ""; - if (nd == 3) - xdat = obj.xdata(:); - ydat = obj.ydata(:); - if (! isempty (obj.zdata)) - zdat = obj.zdata(:); - else - zdat = zeros (size (xdat)); - endif - data{data_idx} = [xdat, ydat, zdat]'; - usingclause{data_idx} = sprintf ("record=%d using ($1):($2):($3)", numel (xdat)); - ## fputs (plot_stream, "set parametric;\n"); - else - xdat = obj.xdata(:); - ydat = obj.ydata(:); - data{data_idx} = [xdat, ydat]'; - usingclause{data_idx} = sprintf ("record=%d using ($1):($2) axes %s%s", - rows(xdat), xaxisloc_using, yaxisloc_using); - endif - - style = do_linestyle_command (obj, obj.color, data_idx, mono, - plot_stream, errbars); - - withclause{data_idx} = sprintf ("with %s linestyle %d", - style{1}, data_idx); - - if (length (style) > 1) - data_idx++; - is_image_data(data_idx) = is_image_data(data_idx - 1); - parametric(data_idx) = parametric(data_idx - 1); - have_cdata(data_idx) = have_cdata(data_idx - 1); - have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); - titlespec{data_idx} = "title \"\""; - usingclause{data_idx} = usingclause{data_idx - 1}; - data{data_idx} = data{data_idx - 1}; - withclause{data_idx} = sprintf ("with %s linestyle %d", - style{2}, data_idx); - endif - if (length (style) > 2) - data_idx++; - is_image_data(data_idx) = is_image_data(data_idx - 1); - parametric(data_idx) = parametric(data_idx - 1); - have_cdata(data_idx) = have_cdata(data_idx - 1); - have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); - titlespec{data_idx} = "title \"\""; - usingclause{data_idx} = usingclause{data_idx - 1}; - data{data_idx} = data{data_idx - 1}; - withclause{data_idx} = sprintf ("with %s linestyle %d", - style{3}, data_idx); - endif - - case "patch" - cmap = parent_figure_obj.colormap; - [nr, nc] = size (obj.xdata); - - if (! isempty (obj.cdata)) - cdat = obj.cdata; - if (strcmpi (obj.cdatamapping, "direct")) - cdatadirect = true; - endif - else - cdat = []; - endif - - data_3d_idx = NaN; - for i = 1:nc - xcol = obj.xdata(:,i); - ycol = obj.ydata(:,i); - if (nd == 3) - if (! isempty (obj.zdata)) - zcol = obj.zdata(:,i); - else - zcol = zeros (size (xcol)); - endif - endif - - if (! isnan (xcol) && ! isnan (ycol)) - ## Is the patch closed or not - if (strncmp (obj.facecolor, "none", 4)) - hidden_removal = false; - else - - if (isnan (hidden_removal)) - hidden_removal = true; - endif - if (nd == 3) - if (numel (xcol) > 3) - error ("__go_draw_axes__: gnuplot (as of v4.2) only supports 3D filled triangular patches"); - else - if (isnan (data_3d_idx)) - data_idx++; - data_3d_idx = data_idx; - is_image_data(data_idx) = false; - parametric(data_idx) = false; - have_cdata(data_idx) = true; - have_3d_patch(data_idx) = true; - withclause{data_3d_idx} = sprintf ("with pm3d"); - usingclause{data_3d_idx} = "using 1:2:3:4"; - data{data_3d_idx} = []; - endif - local_idx = data_3d_idx; - ccdat = NaN; - endif - else - data_idx++; - local_idx = data_idx; - is_image_data(data_idx) = false; - parametric(data_idx) = false; - have_cdata(data_idx) = false; - have_3d_patch(data_idx) = false; - endif - - if (i > 1 || isempty (obj.displayname)) - titlespec{local_idx} = "title \"\""; - else - tmp = undo_string_escapes (__maybe_munge_text__ (enhanced, obj, "displayname")); - titlespec{local_idx} = cstrcat ("title \"", tmp, "\""); - endif - if (isfield (obj, "facecolor")) - if ((strncmp (obj.facecolor, "flat", 4) - || strncmp (obj.facecolor, "interp", 6)) - && isfield (obj, "cdata")) - if (ndims (obj.cdata) == 2 - && (size (obj.cdata, 2) == nc - && (size (obj.cdata, 1) == 1 - || size (obj.cdata, 1) == 3))) - ccol = cdat (:, i); - elseif (ndims (obj.cdata) == 2 - && (size (obj.cdata, 1) == nc - && (size (obj.cdata, 2) == 1 - || size (obj.cdata, 2) == 3))) - ccol = cdat (i, :); - elseif (ndims (obj.cdata) == 3) - ccol = permute (cdat (:, i, :), [1, 3, 2]); - else - ccol = cdat; - endif - if (strncmp (obj.facecolor, "flat", 4)) - if (numel(ccol) == 3) - color = ccol; - elseif (nd == 3 && numel (xcol) == 3) - ccdat = ccol * ones (3,1); - else - r = 1 + round ((size (cmap, 1) - 1) - * (ccol - clim(1))/(clim(2) - clim(1))); - r = max (1, min (r, size (cmap, 1))); - color = cmap(r, :); - endif - elseif (strncmp (obj.facecolor, "interp", 6)) - if (nd == 3 && numel (xcol) == 3) - ccdat = ccol; - if (! isvector (ccdat)) - tmp = rows(cmap) + rows(addedcmap) + ... - [1 : rows(ccdat)]; - addedcmap = [addedcmap; ccdat]; - ccdat = tmp(:); - else - ccdat = ccdat(:); - endif - else - warning ("\"interp\" not supported, using 1st entry of cdata"); - r = 1 + round ((size (cmap, 1) - 1) * ccol(1)); - r = max (1, min (r, size (cmap, 1))); - color = cmap(r,:); - endif - endif - elseif (isnumeric (obj.facecolor)) - color = obj.facecolor; - else - color = [0, 1, 0]; - endif - else - color = [0, 1, 0]; - endif - - if (nd == 3 && numel (xcol) == 3) - if (isnan (ccdat)) - ccdat = (rows (cmap) + rows(addedcmap) + 1) * ones(3, 1); - addedcmap = [addedcmap; reshape(color, 1, 3)]; - endif - data{data_3d_idx} = [data{data_3d_idx}, ... - [[xcol; xcol(end)], [ycol; ycol(end)], ... - [zcol; zcol(end)], [ccdat; ccdat(end)]]']; - else - if (mono) - colorspec = ""; - elseif (__gnuplot_has_feature__ ("transparent_patches") - && isscalar (obj.facealpha)) - colorspec = sprintf ("lc rgb \"#%02x%02x%02x\" fillstyle transparent solid %f", - round (255*color), obj.facealpha); - else - colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", - round (255*color)); - endif - - withclause{data_idx} = sprintf ("with filledcurve %s", - colorspec); - data{data_idx} = [xcol, ycol]'; - usingclause{data_idx} = sprintf ("record=%d using ($1):($2)", - numel (xcol)); - endif - endif - endif - - ## patch outline - if (!(strncmp (obj.edgecolor, "none", 4) - && (strncmp (obj.marker, "none", 4) - || (strncmp (obj.markeredgecolor, "none", 4) - && strncmp (obj.markerfacecolor, "none", 4))))) - - data_idx++; - is_image_data(data_idx) = false; - parametric(data_idx) = false; - have_cdata(data_idx) = false; - have_3d_patch(data_idx) = false; - titlespec{data_idx} = "title \"\""; - usingclause{data_idx} = sprintf ("record=%d", numel (obj.xdata)); - - if (isfield (obj, "markersize")) - mdat = obj.markersize / 3; - endif - - if (isfield (obj, "edgecolor")) - ## FIXME - ## This is the wrong thing to do as edgecolor, markeredgecolor - ## and markerfacecolor can have different values and we should - ## treat them seperately. However, the below allow the scatter - ## functions to work as expected, where only one of these values - ## is set - if (strncmp (obj.edgecolor, "none", 4)) - if (strncmp (obj.markeredgecolor, "none", 4)) - ec = obj.markerfacecolor; - else - ec = obj.markeredgecolor; - endif - else - ec = obj.edgecolor; - endif - - if ((strncmp (ec, "flat", 4) - || strncmp (ec, "interp", 6)) - && isfield (obj, "cdata")) - if (ndims (obj.cdata) == 2 - && (size (obj.cdata, 2) == nc - && (size (obj.cdata, 1) == 1 - || size (obj.cdata, 1) == 3))) - ccol = cdat (:, i); - elseif (ndims (obj.cdata) == 2 - && (size (obj.cdata, 1) == nc - && (size (obj.cdata, 2) == 1 - || size (obj.cdata, 2) == 3))) - ccol = cdat (i, :); - elseif (ndims (obj.cdata) == 3) - ccol = permute (cdat (:, i, :), [1, 3, 2]); - else - ccol = cdat; - endif - if (strncmp (ec, "flat", 4)) - if (numel(ccol) == 3) - color = ccol; - else - if (isscalar (ccol)) - ccol = repmat(ccol, numel (xcol), 1); - endif - color = "flat"; - have_cdata(data_idx) = true; - endif - elseif (strncmp (ec, "interp", 6)) - if (numel(ccol) == 3) - warning ("\"interp\" not supported, using 1st entry of cdata"); - color = ccol(1,:); - else - if (isscalar (ccol)) - ccol = repmat(ccol, numel (xcol), 1); - endif - color = "interp"; - have_cdata(data_idx) = true; - endif - endif - elseif (isnumeric (ec)) - color = ec; - else - color = [0, 0, 0]; - endif - else - color = [0, 0, 0]; - endif - - if (isfield (obj, "linestyle")) - switch (obj.linestyle) - case "-" - lt = "lt 1"; - case "--" - lt = "lt 2"; - case ":" - lt = "lt 3"; - case "-." - lt = "lt 6"; - case "none" - lt = ""; - otherwise - lt = ""; - endswitch - else - lt = ""; - endif - - if (isfield (obj, "linewidth")) - lw = sprintf("linewidth %f", obj.linewidth); - else - lw = ""; - endif - - [pt, pt2, obj] = gnuplot_pointtype (obj); - if (! isempty (pt)) - pt = sprintf ("pointtype %s", pt); - endif - if (! isempty (pt2)) - pt2 = sprintf ("pointtype %s", pt2); - endif - - if (mono) - colorspec = ""; - else - if (ischar (color)) - colorspec = "palette"; - else - colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", - round (255*color)); - endif - endif - - sidx = 1; - if (isempty (lt)) - style = ""; - else - style = "lines"; - endif - tmpwith = {}; - - facesame = true; - if (! isequal (pt, pt2) && isfield (obj, "markerfacecolor") - && !strncmp (obj.markerfacecolor, "none", 4)) - if (strncmp (obj.markerfacecolor, "auto", 4) - || ! isnumeric (obj.markerfacecolor) - || (isnumeric (obj.markerfacecolor) - && isequal (color, obj.markerfacecolor))) - style = strcat (style, "points"); - if (isfield (obj, "markersize")) - if (length (mdat) == nc) - m = mdat(i); - else - m = mdat; - endif - ps = sprintf("pointsize %f", m / 3); - else - ps = ""; - endif - - tmpwith{sidx} = sprintf ("with %s %s %s %s %s %s", - style, lw, pt2, lt, ps, - colorspec); - else - facesame = false; - if (! isempty (style)) - tmpwith{sidx} = sprintf ("with %s %s %s %s", - style, lw, lt, - colorspec); - sidx ++; - endif - if (isnumeric (obj.markerfacecolor) && ! mono) - colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", - round (255*obj.markerfacecolor)); - endif - style = "points"; - if (isfield (obj, "markersize")) - if (length (mdat) == nc) - m = mdat(i); - else - m = mdat; - endif - ps = sprintf("pointsize %f", m / 3); - else - ps = ""; - endif - tmpwith{sidx} = sprintf ("with %s %s %s %s %s %s", - style, lw, pt2, lt, ps, - colorspec); - endif - endif - - if (isfield (obj, "markeredgecolor") - && !strncmp (obj.markeredgecolor, "none", 4)) - if (facesame && !isempty (pt) - && (strncmp (obj.markeredgecolor, "auto", 4) - || ! isnumeric (obj.markeredgecolor) - || (isnumeric (obj.markeredgecolor) - && isequal (color, obj.markeredgecolor)))) - if (sidx == 1 && ((length (style) == 5 - && strncmp (style, "lines", 5)) - || isempty (style))) - style = strcat (style, "points"); - if (isfield (obj, "markersize")) - if (length (mdat) == nc) - m = mdat(i); - else - m = mdat; - endif - ps = sprintf("pointsize %f", m / 3); - else - ps = ""; - endif - tmpwith{sidx} = sprintf ("with %s %s %s %s %s %s", - style, lw, pt, lt, ps, - colorspec); - endif - else - if (!isempty (style)) - if (length(tmpwith) < sidx || isempty (tmpwith{sidx})) - tmpwith{sidx} = sprintf ("with %s %s %s %s", - style, lw, lt, - colorspec); - endif - sidx ++; - endif - - if (!isempty (pt)) - if (! mono) - if (strncmp (obj.markeredgecolor, "auto", 4)) - colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", - round (255*color)); - elseif (isnumeric (obj.markeredgecolor) && ! mono) - colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", - round (255*obj.markeredgecolor)); - endif - endif - style = "points"; - if (isfield (obj, "markersize")) - if (length (mdat) == nc) - m = mdat(i); - else - m = mdat; - endif - ps = sprintf("pointsize %f", m / 3); - else - ps = ""; - endif - tmpwith{sidx} = sprintf ("with %s %s %s %s %s %s", - style, lw, pt, lt, ps, - colorspec); - endif - endif - endif - - if (isempty (tmpwith)) - withclause{data_idx} = sprintf ("with %s %s %s %s %s", - style, lw, pt, lt, - colorspec); - else - withclause{data_idx} = tmpwith{1}; - endif - if (nd == 3) - if (ischar (color)) - if (! isnan (xcol) && ! isnan (ycol) && ! isnan (zcol)) - data{data_idx} = [[xcol; xcol(1)], [ycol; ycol(1)], ... - [zcol; zcol(1)], [ccol; ccol(1)]]'; - else - data{data_idx} = [xcol, ycol, zcol, ccol]'; - endif - usingclause{data_idx} = sprintf ("record=%d using ($1):($2):($3):($4)", columns (data{data_idx})); - else - if (! isnan (xcol) && ! isnan (ycol) && ! isnan (zcol)) - data{data_idx} = [[xcol; xcol(1)], [ycol; ycol(1)], ... - [zcol; zcol(1)]]'; - else - data{data_idx} = [xcol, ycol, zcol]'; - endif - usingclause{data_idx} = sprintf ("record=%d using ($1):($2):($3)", columns (data{data_idx})); - endif - else - if (ischar (color)) - if (! isnan (xcol) && ! isnan (ycol)) - data{data_idx} = [[xcol; xcol(1)], [ycol; ycol(1)], ... - [ccol; ccol(1)]]'; - else - data{data_idx} = [xcol, ycol, ccol]'; - endif - usingclause{data_idx} = sprintf ("record=%d using ($1):($2):($3)", columns (data{data_idx})); - else - if (! isnan (xcol) && ! isnan (ycol)) - data{data_idx} = [[xcol; xcol(1)], [ycol; ycol(1)]]'; - else - data{data_idx} = [xcol, ycol]'; - endif - usingclause{data_idx} = sprintf ("record=%d using ($1):($2)", columns (data{data_idx})); - endif - endif - - if (length (tmpwith) > 1) - data_idx++; - is_image_data(data_idx) = is_image_data(data_idx - 1); - parametric(data_idx) = parametric(data_idx - 1); - have_cdata(data_idx) = have_cdata(data_idx - 1); - have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); - titlespec{data_idx} = "title \"\""; - usingclause{data_idx} = usingclause{data_idx - 1}; - data{data_idx} = data{data_idx - 1}; - withclause{data_idx} = tmpwith{2}; - endif - if (length (tmpwith) > 2) - data_idx++; - is_image_data(data_idx) = is_image_data(data_idx - 1); - parametric(data_idx) = parametric(data_idx - 1); - have_cdata(data_idx) = have_cdata(data_idx - 1); - have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); - titlespec{data_idx} = "title \"\""; - usingclause{data_idx} = usingclause{data_idx - 1}; - data{data_idx} = data{data_idx - 1}; - withclause{data_idx} = tmpwith{3}; - endif - endif - endfor - - case "surface" - view_map = true; - if (! (strncmp (obj.edgecolor, "none", 4) - && strncmp (obj.facecolor, "none", 4))) - data_idx++; - is_image_data(data_idx) = false; - parametric(data_idx) = false; - have_cdata(data_idx) = true; - have_3d_patch(data_idx) = false; - style = do_linestyle_command (obj, obj.edgecolor, - data_idx, mono, - plot_stream); - - if (isempty (obj.displayname)) - titlespec{data_idx} = "title \"\""; - else - tmp = undo_string_escapes (__maybe_munge_text__ (enhanced, obj, "displayname")); - titlespec{data_idx} = cstrcat ("title \"", tmp, "\""); - endif - withclause{data_idx} = sprintf ("with pm3d linestyle %d", - data_idx); - withpm3d = true; - pm3didx = data_idx; - - xdat = obj.xdata; - ydat = obj.ydata; - zdat = obj.zdata; - cdat = obj.cdata; - - err = false; - if (! size_equal(zdat, cdat)) - err = true; - endif - if (isvector (xdat) && isvector (ydat) && ismatrix (zdat)) - if (rows (zdat) == length (ydat) - && columns (zdat) == length (xdat)) - [xdat, ydat] = meshgrid (xdat, ydat); - else - err = true; - endif - elseif (ismatrix (xdat) && ismatrix (ydat) && ismatrix (zdat)) - if (! size_equal (xdat, ydat, zdat)) - err = true; - endif - else - err = true; - endif - if (err) - error ("__go_draw_axes__: invalid grid data"); - endif - xlen = columns (zdat); - ylen = rows (zdat); - if (xlen == columns (xdat) && xlen == columns (ydat) - && ylen == rows (xdat) && ylen == rows (ydat)) - len = 4 * xlen; - zz = zeros (ylen, len); - k = 1; - for kk = 1:4:len - zz(:,kk) = xdat(:,k); - zz(:,kk+1) = ydat(:,k); - zz(:,kk+2) = zdat(:,k); - zz(:,kk+3) = cdat(:,k); - k++; - endfor - data{data_idx} = zz.'; - endif - - if (doing_interp_color) - interp_str = "interpolate 0, 0"; - else - ## No interpolation of facecolors. - interp_str = ""; - endif - usingclause{data_idx} = sprintf ("record=%dx%d using ($1):($2):($3):($4)", ylen, xlen); - - flat_interp_face = (strncmp (obj.facecolor, "flat", 4) - || strncmp (obj.facecolor, "interp", 6)); - flat_interp_edge = (strncmp (obj.edgecolor, "flat", 4) - || strncmp (obj.edgecolor, "interp", 6)); - - facecolor_none_or_white = (strncmp (obj.facecolor, "none", 4) - || (isnumeric (obj.facecolor) - && all (obj.facecolor == 1))); - hidden_removal = false; - fputs (plot_stream, "set style increment default;\n"); - if (flat_interp_edge && facecolor_none_or_white) - withpm3d = false; - withclause{data_idx} = sprintf ("with %s palette", style {1}); - fputs (plot_stream, "unset pm3d\n"); - if (all (obj.facecolor == 1)) - hidden_removal = true; - endif - elseif (facecolor_none_or_white) - if (all (obj.facecolor == 1)) - hidden_removal = true; - endif - fputs(plot_stream,"unset pm3d;\n"); - fputs(plot_stream,"set style increment user;\n"); - withpm3d = false; - withclause{data_idx} = sprintf("with %s linestyle %d", - style{1}, data_idx); - fputs (plot_stream, "unset pm3d\n"); - endif - - if (doing_interp_color) - ## "depthorder" interferes with interpolation of colors. - dord = "scansautomatic"; - else - dord = "depthorder"; - endif - - if (flat_interp_face && strncmp (obj.edgecolor, "flat", 4)) - fprintf (plot_stream, "set pm3d explicit at s %s %s corners2color c3;\n", - interp_str, dord); - elseif (!facecolor_none_or_white) - if (strncmp (obj.edgecolor, "none", 4)) - if (__gnuplot_has_feature__ ("transparent_surface") - && isscalar (obj.facealpha)) - fprintf (plot_stream, - "set style fill transparent solid %f;\n", - obj.facealpha); - endif - fprintf (plot_stream, "set pm3d explicit at s %s corners2color c3;\n", - interp_str, dord); - else - fprintf (plot_stream, "set pm3d explicit at s hidden3d %d %s %s corners2color c3;\n", - data_idx, interp_str, dord); - - if (__gnuplot_has_feature__ ("transparent_surface") - && isscalar (obj.facealpha)) - fprintf (plot_stream, - "set style fill transparent solid %f;\n", - obj.facealpha); - endif - endif - endif - - zz = []; - if (length (style) > 1) - len = 3 * xlen; - zz = zeros (ylen, len); - k = 1; - for kk = 1:3:len - zz(:,kk) = xdat(:,k); - zz(:,kk+1) = ydat(:,k); - zz(:,kk+2) = zdat(:,k); - k++; - endfor - zz = zz.'; - - data_idx++; - is_image_data(data_idx) = is_image_data(data_idx - 1); - parametric(data_idx) = parametric(data_idx - 1); - have_cdata(data_idx) = false; - have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); - titlespec{data_idx} = "title \"\""; - usingclause{data_idx} = sprintf ("record=%dx%d using ($1):($2):($3)", ylen, xlen); - data{data_idx} = zz; - withclause{data_idx} = sprintf ("with %s linestyle %d", - style{2}, data_idx); - - endif - if (length (style) > 2) - data_idx++; - is_image_data(data_idx) = is_image_data(data_idx - 1); - parametric(data_idx) = parametric(data_idx - 1); - have_cdata(data_idx) = false; - have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); - titlespec{data_idx} = "title \"\""; - usingclause{data_idx} = sprintf ("record=%dx%d using ($1):($2):($3)", ylen, xlen); - data{data_idx} = zz; - withclause{data_idx} = sprintf ("with %s linestyle %d", - style{3}, data_idx); - endif - if (withpm3d && strncmp (style {1}, "linespoints", 11)) - if (isempty(zz)) - len = 3 * xlen; - zz = zeros (ylen, len); - k = 1; - for kk = 1:3:len - zz(:,kk) = xdat(:,k); - zz(:,kk+1) = ydat(:,k); - zz(:,kk+2) = zdat(:,k); - k++; - endfor - zz = zz.'; - endif - data_idx++; - is_image_data(data_idx) = is_image_data(data_idx - 1); - parametric(data_idx) = parametric(data_idx - 1); - have_cdata(data_idx) = false; - have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); - titlespec{data_idx} = "title \"\""; - usingclause{data_idx} = sprintf ("record=%dx%d using ($1):($2):($3)", ylen, xlen); - data{data_idx} = zz; - withclause{data_idx} = sprintf ("with points linestyle %d", - pm3didx); - endif - endif - - case "text" - [label, f, s] = __maybe_munge_text__ (enhanced, obj, "string"); - fontspec = create_fontspec (f, s, gnuplot_term); - lpos = obj.position; - halign = obj.horizontalalignment; - valign = obj.verticalalignment; - angle = obj.rotation; - units = obj.units; - color = obj.color; - if (strcmpi (units, "normalized")) - units = "graph"; - elseif (strcmp (axis_obj.yaxislocation, "right") - && strcmp (units, "data")) - units = "second"; - else - units = ""; - endif - - if (isnumeric (color)) - colorspec = get_text_colorspec (color, mono); - endif - - switch valign - ## Text offset in characters. This relies on gnuplot for font metrics. - case "top" - dy = -0.5; - case "cap" - dy = -0.5; - case "middle" - dy = 0; - case "baseline" - dy = 0.5; - case "bottom" - dy = 0.5; - 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]; - - if (nd == 3) - ## This produces the desired vertical alignment in 3D. - fprintf (plot_stream, - "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 %.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); - endif - - case "hggroup" - ## Push group children into the kid list. - if (isempty (kids)) - kids = obj.children; - elseif (! isempty (obj.children)) - kids = [kids; obj.children]; - endif - - otherwise - error ("__go_draw_axes__: unknown object class, %s", - obj.type); - endswitch - - endwhile - - ## This is need to prevent warnings for rotations in 3D plots, while - ## allowing colorbars with contours. - if (nd == 2 || (data_idx > 1 && !view_map)) - fputs (plot_stream, "set pm3d implicit;\n"); - else - fputs (plot_stream, "set pm3d explicit;\n"); - endif - - if (isnan(hidden_removal) || hidden_removal) - fputs (plot_stream, "set hidden3d;\n"); - else - fputs (plot_stream, "unset hidden3d;\n"); - endif - - 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. - if (isempty (xlim)) - return; - endif - if (strcmpi (axis_obj.xdir, "reverse")) - xdir = "reverse"; - else - xdir = "noreverse"; - endif - fprintf (plot_stream, "set xrange [%.15e:%.15e] %s;\n", xlim, xdir); - if (strcmpi (axis_obj.xaxislocation, "top")) - fprintf (plot_stream, "set x2range [%.15e:%.15e] %s;\n", xlim, xdir); - endif - - if (isempty (ylim)) - return; - endif - if (strcmpi (axis_obj.ydir, "reverse")) - ydir = "reverse"; - else - ydir = "noreverse"; - endif - fprintf (plot_stream, "set yrange [%.15e:%.15e] %s;\n", ylim, ydir); - if (strcmpi (axis_obj.yaxislocation, "right")) - fprintf (plot_stream, "set y2range [%.15e:%.15e] %s;\n", ylim, ydir); - endif - - if (nd == 3) - if (isempty (zlim)) - return; - endif - if (strcmpi (axis_obj.zdir, "reverse")) - zdir = "reverse"; - else - zdir = "noreverse"; - endif - fprintf (plot_stream, "set zrange [%.15e:%.15e] %s;\n", zlim, zdir); - endif - - cmap = parent_figure_obj.colormap; - cmap_sz = rows(cmap); - if (! any (isinf (clim))) - if (truecolor || ! cdatadirect) - if (rows(addedcmap) > 0) - for i = 1:data_idx - if (have_3d_patch(i)) - data{i}(end,:) = clim(2) * (data{i}(end, :) - 0.5) / cmap_sz; - endif - endfor - fprintf (plot_stream, "set cbrange [%g:%g];\n", clim(1), clim(2) * - (cmap_sz + rows(addedcmap)) / cmap_sz); - else - fprintf (plot_stream, "set cbrange [%g:%g];\n", clim); - endif - else - fprintf (plot_stream, "set cbrange [1:%d];\n", cmap_sz + - rows (addedcmap)); - endif - endif - - if (strcmpi (axis_obj.box, "on")) - if (nd == 3) - fputs (plot_stream, "set border 4095;\n"); - else - fputs (plot_stream, "set border 431;\n"); - endif - else - if (nd == 3) - fputs (plot_stream, "set border 895;\n"); - elseif (! isempty (axis_obj.ytick)) - if (strcmpi (axis_obj.yaxislocation, "right")) - fprintf (plot_stream, "unset ytics; set y2tics %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 12;\n"); - else - fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", - axis_obj.tickdir); - fputs (plot_stream, "set border 9;\n"); - endif - else - 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 - fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", - axis_obj.tickdir); - fputs (plot_stream, "set border 3;\n"); - endif - endif - endif - endif - - if (strcmpi (axis_obj.visible, "off")) - fputs (plot_stream, "unset border; unset tics\n"); - else - fprintf (plot_stream, "set border lw %f;\n", axis_obj.linewidth); - endif - - if (! isempty (hlgnd) && ! isempty (hlgnd.children) - && any (strcmpi (get (hlgnd.children, "visible"), "on"))) - if (strcmpi (hlgnd.box, "on")) - box = "box"; - else - box = "nobox"; - endif - if (strcmpi (hlgnd.orientation, "vertical")) - horzvert = "vertical"; - else - horzvert = "horizontal"; - endif - if (strcmpi (hlgnd.textposition, "right")) - reverse = "reverse"; - else - reverse = "noreverse"; - endif - inout = "inside"; - keypos = hlgnd.location; - if (ischar (keypos)) - keypos = lower (keypos); - keyout = findstr (keypos, "outside"); - if (! isempty (keyout)) - inout = "outside"; - keypos = keypos(1:keyout-1); - endif - endif - switch (keypos) - case "north" - pos = "center top"; - case "south" - pos = "center bottom"; - case "east" - pos = "right center"; - case "west" - pos = "left center"; - case "northeast" - pos = "right top"; - case "northwest" - pos = "left top"; - case "southeast" - pos = "right bottom"; - case "southwest" - pos = "left bottom"; - case "best" - pos = ""; - warning ("legend: 'Best' not yet implemented for location specifier.\n"); - ## Least conflict with data in plot. - ## Least unused space outside plot. - otherwise - pos = ""; - endswitch - if (__gnuplot_has_feature__ ("key_has_font_properties")) - [fontname, fontsize] = get_fontname_and_size (hlgnd); - fontspec = create_fontspec (fontname, fontsize, gnuplot_term); - else - fontspec = ""; - endif - fprintf (plot_stream, "set key %s %s;\nset key %s %s %s %s;\n", - inout, pos, box, reverse, horzvert, fontspec); - else - fputs (plot_stream, "unset key;\n"); - endif - fputs (plot_stream, "set style data lines;\n"); - - cmap = [cmap; addedcmap]; - cmap_sz = cmap_sz + rows(addedcmap); - if (length(cmap) > 0) - fprintf (plot_stream, - "set palette positive color model RGB maxcolors %i;\n", - cmap_sz); - fprintf (plot_stream, - "set palette file \"-\" binary record=%d using 1:2:3:4;\n", - cmap_sz); - fwrite (plot_stream, [1:cmap_sz; cmap.'], "float32"); - fwrite (plot_stream, "\n"); - endif - - fputs (plot_stream, "unset colorbox;\n"); - - if (have_data) - if (nd == 2) - plot_cmd = "plot"; - else - plot_cmd = "splot"; - rot_x = 90 - axis_obj.view(2); - rot_z = axis_obj.view(1); - while (rot_z < 0) - rot_z += 360; - endwhile - fputs (plot_stream, "set ticslevel 0;\n"); - if (view_map && rot_x == 0 && rot_z == 0) - fputs (plot_stream, "set view map;\n"); - else - fprintf (plot_stream, "set view %.15g, %.15g;\n", rot_x, rot_z); - endif - endif - if (have_3d_patch (1)) - fputs (plot_stream, "set pm3d depthorder\n"); - 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 - fprintf (plot_stream, "%s \"-\" binary format='%%float64' %s %s %s \\\n", plot_cmd, - usingclause{1}, titlespec{1}, withclause{1}); - endif - for i = 2:data_idx - if (have_3d_patch (i)) - fprintf (plot_stream, ", \"-\" %s %s %s \\\n", - usingclause{i}, titlespec{i}, withclause{i}); - elseif (is_image_data (i)) - if (! is_image_data (i-1)) - fputs (plot_stream, "; "); - if (bg_is_set) - fputs (plot_stream, "unset obj 1; \\\n"); - bg_is_set = false; - endif - if (fg_is_set) - 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 - elseif (is_image_data (i-1)) - if (bg_is_set) - fputs (plot_stream, "unset obj 1; \\\n"); - bg_is_set = false; - endif - if (fg_is_set) - fputs (plot_stream, "unset obj 2; \\\n"); - fg_is_set = false; - endif - fprintf (plot_stream, "%s \"-\" binary format='%%float64' %s %s %s \\\n", plot_cmd, - usingclause{i}, titlespec{i}, withclause{i}); - else - fprintf (plot_stream, ", \"-\" binary format='%%float64' %s %s %s \\\n", - usingclause{i}, titlespec{i}, withclause{i}); - endif - endfor - fputs (plot_stream, ";\n"); - for i = 1:data_idx - if (have_3d_patch (i)) - ## Can't write 3d patch data as binary as can't plot more than - ## a single patch at a time and have to plot all patches together - ## so that the gnuplot depth ordering is done correctly - for j = 1 : 4 : columns(data{i}) - if (j != 1) - fputs (plot_stream, "\n\n"); - endif - fprintf (plot_stream, "%.15g %.15g %.15g %.15g\n", data{i}(:,j).'); - fprintf (plot_stream, "%.15g %.15g %.15g %.15g\n\n", data{i}(:,j+1).'); - fprintf (plot_stream, "%.15g %.15g %.15g %.15g\n", data{i}(:,j+2).'); - fprintf (plot_stream, "%.15g %.15g %.15g %.15g\n", data{i}(:,j+3).'); - endfor - fputs (plot_stream, "e\n"); - elseif (is_image_data(i)) - fwrite (plot_stream, data{i}, "float32"); - else - __gnuplot_write_data__ (plot_stream, data{i}, nd, parametric(i), - have_cdata(i)); - endif - endfor - else - fputs (plot_stream, "plot \"-\";\nInf Inf\ne\n"); - endif - - ## Needed to allow mouse rotation with pcolor. - if (view_map) - fputs (plot_stream, "unset view;\n"); - endif - - if (bg_is_set) - fputs (plot_stream, "unset obj 1;\n"); - bg_is_set = false; - endif - - fflush (plot_stream); - - else - print_usage (); - endif - -endfunction - -function fontspec = create_fontspec (f, s, gp_term) - if (strcmp (f, "*") || strcmp (gp_term, "tikz")) - fontspec = sprintf ("font \",%d\"", s); - else - fontspec = sprintf ("font \"%s,%d\"", f, s); - endif -endfunction - -function style = do_linestyle_command (obj, linecolor, idx, mono, - plot_stream, errbars = "") - style = {}; - - fprintf (plot_stream, "set style line %d default;\n", idx); - fprintf (plot_stream, "set style line %d", idx); - - found_style = false; - if (isnumeric (linecolor)) - color = linecolor; - if (! mono) - fprintf (plot_stream, " linecolor rgb \"#%02x%02x%02x\"", - round (255*color)); - endif - else - color = [0, 0, 0]; - endif - - if (isfield (obj, "linestyle")) - switch (obj.linestyle) - case "-" - lt = "1"; - case "--" - lt = "2"; - case ":" - lt = "3"; - case "-." - lt = "6"; - case "none" - lt = ""; - otherwise - lt = ""; - endswitch - - if (! isempty (lt)) - fprintf (plot_stream, " linetype %s", lt); - endif - - else - lt = ""; - endif - if (! isempty (errbars)) - found_style = true; - endif - - if (isfield (obj, "linewidth")) - fprintf (plot_stream, " linewidth %f", obj.linewidth); - found_style = true; - endif - - [pt, pt2, obj] = gnuplot_pointtype (obj); - - if (! isempty (pt)) - found_style = true; - endif - - sidx = 1; - if (isempty (errbars)) - if (isempty (lt)) - style {sidx} = ""; - else - style {sidx} = "lines"; - endif - - facesame = true; - if (! isequal (pt, pt2) && isfield (obj, "markerfacecolor") - && !strncmp (obj.markerfacecolor, "none", 4)) - if (strncmp (obj.markerfacecolor, "auto", 4) - || ! isnumeric (obj.markerfacecolor) - || (isnumeric (obj.markerfacecolor) - && isequal (color, obj.markerfacecolor))) - if (! isempty (pt2)) - fprintf (plot_stream, " pointtype %s", pt2); - style {sidx} = strcat (style{sidx}, "points"); - endif - if (isfield (obj, "markersize")) - fprintf (plot_stream, " pointsize %f", obj.markersize / 3); - endif - else - facesame = false; - if (! found_style) - fputs (plot_stream, " default"); - endif - fputs (plot_stream, ";\n"); - if (! isempty (style {sidx})) - sidx ++; - idx ++; - else - fputs (plot_stream, ";\n"); - endif - fprintf (plot_stream, "set style line %d default;\n", idx); - fprintf (plot_stream, "set style line %d", idx); - if (isnumeric (obj.markerfacecolor) && ! mono) - fprintf (plot_stream, " linecolor rgb \"#%02x%02x%02x\"", - round (255*obj.markerfacecolor)); - endif - if (! isempty (pt2)) - style {sidx} = "points"; - fprintf (plot_stream, " pointtype %s", pt2); - endif - if (isfield (obj, "markersize")) - fprintf (plot_stream, " pointsize %f", obj.markersize / 3); - endif - endif - endif - if (isfield (obj, "markeredgecolor") - && !strncmp (obj.markeredgecolor, "none", 4)) - if (facesame && !isempty (pt) - && (strncmp (obj.markeredgecolor, "auto", 4) - || ! isnumeric (obj.markeredgecolor) - || (isnumeric (obj.markeredgecolor) - && isequal (color, obj.markeredgecolor)))) - if (sidx == 1 && ((length (style {sidx}) == 5 - && strncmp (style {sidx}, "lines", 5)) || isempty (style {sidx}))) - if (! isempty (pt)) - style {sidx} = strcat (style{sidx}, "points"); - fprintf (plot_stream, " pointtype %s", pt); - endif - if (isfield (obj, "markersize")) - fprintf (plot_stream, " pointsize %f", obj.markersize / 3); - endif - endif - else - if (! found_style) - fputs (plot_stream, " default"); - endif - fputs (plot_stream, ";\n"); - if (!isempty (style {sidx})) - sidx ++; - idx ++; - else - fputs (plot_stream, ";\n"); - endif - fprintf (plot_stream, "set style line %d default;\n", idx); - fprintf (plot_stream, "set style line %d", idx); - if (! mono) - if (strncmp (obj.markeredgecolor, "auto", 4)) - fprintf (plot_stream, " linecolor rgb \"#%02x%02x%02x\"", - round (255*color)); - elseif (isnumeric (obj.markeredgecolor) && ! mono) - fprintf (plot_stream, " linecolor rgb \"#%02x%02x%02x\"", - round (255*obj.markeredgecolor)); - endif - endif - if (! isempty (pt)) - style {sidx} = "points"; - fprintf (plot_stream, " pointtype %s", pt); - endif - if (isfield (obj, "markersize")) - fprintf (plot_stream, " pointsize %f", obj.markersize / 3); - endif - endif - endif - else - style{1} = errbars; - fputs (plot_stream, " pointtype 0"); - endif - - if (! found_style && isempty (style {1})) - fputs (plot_stream, " default"); - endif - - fputs (plot_stream, ";\n"); - -endfunction - -function [pt, pt2, obj] = gnuplot_pointtype (obj) - if (isfield (obj, "marker")) - switch (obj.marker) - case "+" - pt = pt2 = "1"; - case "o" - pt = "6"; - pt2 = "7"; - case "*" - pt = pt2 = "3"; - case "." - pt = "6"; - pt2 = "7"; - if (isfield (obj, "markerfacecolor") - || strncmp (obj.markerfacecolor, "none", 4)) - obj.markerfacecolor = "auto"; - endif - if (isfield (obj, "markersize")) - obj.markersize /= 3; - else - obj.markersize = 5; - endif - case "x" - pt = pt2 = "2"; - case {"square", "s"} - pt = "4"; - pt2 = "5"; - case {"diamond", "d"} - pt = "12"; - pt2 = "13"; - case "^" - pt = "8"; - pt2 = "9"; - case "v" - pt = "10"; - pt2 = "11"; - case ">" - ## FIXME -- should be triangle pointing right, use triangle pointing up - pt = "8"; - pt2 = "9"; - case "<" - ## FIXME -- should be triangle pointing left, use triangle pointing down - pt = "10"; - pt2 = "11"; - case {"pentagram", "p"} - ## FIXME -- should be pentagram, using pentagon - pt = "14"; - pt2 = "15"; - case {"hexagram", "h"} - ## FIXME -- should be 6 pt start, using "*" instead - pt = pt2 = "3"; - case "none" - pt = pt2 = ""; - otherwise - pt = pt2 = ""; - endswitch - else - pt = pt2 = ""; - endif -endfunction - -function __gnuplot_write_data__ (plot_stream, data, nd, parametric, cdata) - - ## DATA is already transposed. - - ## FIXME -- this may need to be converted to C++ for speed. - - ## Convert NA elements to normal NaN values because fprintf writes - ## "NA" and that confuses gnuplot. - idx = find (isna (data)); - if (any (idx)) - data(idx) = NaN; - endif - - if (nd == 2) - fwrite (plot_stream, data, "float64"); - elseif (nd == 3) - if (parametric) - fwrite (plot_stream, data, "float64"); - else - nr = rows (data); - if (cdata) - for j = 1:4:nr - fwrite (plot_stream, data(j:j+3,:), "float64"); - endfor - else - for j = 1:3:nr - fwrite (plot_stream, data(j:j+2,:), "float64"); - endfor - endif - endif - endif - -endfunction - -function do_tics (obj, plot_stream, ymirror, mono, gnuplot_term) - - obj.xticklabel = ticklabel_to_cell (obj.xticklabel); - obj.yticklabel = ticklabel_to_cell (obj.yticklabel); - obj.zticklabel = ticklabel_to_cell (obj.zticklabel); - - if (strcmp (obj.xminorgrid, "on")) - obj.xminortick = "on"; - endif - if (strcmp (obj.yminorgrid, "on")) - obj.yminortick = "on"; - endif - if (strcmp (obj.zminorgrid, "on")) - obj.zminortick = "on"; - endif - - [fontname, fontsize] = get_fontname_and_size (obj); - fontspec = create_fontspec (fontname, fontsize, gnuplot_term); - - ## A Gnuplot tic scale of 69 is equivalent to Octave's 0.5. - ticklength = sprintf ("scale %4.1f", (69/0.5)*obj.ticklength(1)); - - if (strcmpi (obj.xaxislocation, "top")) - 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, 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, - 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, 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, - 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, 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, - 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, 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, - 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, 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, - 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, 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, - 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, 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, gnuplot_term) - persistent warned_latex = false; - if (strcmpi (interpreter, "tex")) - for n = 1 : numel(labels) - labels{n} = __tex2enhanced__ (labels{n}, fontname, false, false); - endfor - elseif (strcmpi (interpreter, "latex")) - if (! warned_latex) - warning ("latex markup not supported for tick marks"); - warned_latex = true; - endif - endif - if (strcmp (scale, "log")) - num_mtics = 10; - if (any (strcmp (gnuplot_term, {"tikz", "pstex", "pslatex", "epslatex"}))) - fmt = "$10^{%T}$"; - else - fmt = "10^{%T}"; - endif - else - fmt = "%g"; - num_mtics = 5; - endif - colorspec = get_text_colorspec (color, mono); - if (strcmpi (ticmode, "manual") || strcmpi (labelmode, "manual")) - if (isempty (tics)) - fprintf (plot_stream, "unset %stics;\nunset m%stics;\n", ax, ax); - elseif (strcmpi (labelmode, "manual")) - if (ischar (labels)) - labels = cellstr (labels); - endif - if (isnumeric (labels)) - labels = num2str (real (labels(:))); - endif - if (ischar (labels)) - labels = permute (cellstr (labels), [2, 1]); - endif - if (iscellstr (labels)) - k = 1; - ntics = numel (tics); - nlabels = numel (labels); - fprintf (plot_stream, "set format %s \"%%s\";\n", ax); - if (mirror) - fprintf (plot_stream, "set %stics %s %s %s mirror (", ax, - tickdir, ticklength, axispos); - else - fprintf (plot_stream, "set %stics %s %s %s nomirror (", ax, - tickdir, ticklength, axispos); - endif - - labels = regexprep(labels, '%', "%%"); - for i = 1:ntics - fprintf (plot_stream, " \"%s\" %.15g", labels{k++}, tics(i)); - if (i < ntics) - fputs (plot_stream, ", "); - endif - if (k > nlabels) - k = 1; - endif - endfor - fprintf (plot_stream, ") %s %s;\n", colorspec, fontspec); - if (strcmp (mtics, "on")) - fprintf (plot_stream, "set m%stics %d;\n", ax, num_mtics); - else - fprintf (plot_stream, "unset m%stics;\n", ax); - endif - else - error ("__go_draw_axes__: unsupported type of ticklabel"); - endif - else - fprintf (plot_stream, "set format %s \"%s\";\n", ax, fmt); - if (mirror) - fprintf (plot_stream, "set %stics %s %s %s mirror (", ax, tickdir, - ticklength, axispos); - else - fprintf (plot_stream, "set %stics %s %s %s nomirror (", ax, tickdir, - ticklength, axispos); - endif - fprintf (plot_stream, " %.15g,", tics(1:end-1)); - fprintf (plot_stream, " %.15g) %s;\n", tics(end), fontspec); - if (strcmp (mtics, "on")) - fprintf (plot_stream, "set m%stics %d;\n", ax, num_mtics); - else - fprintf (plot_stream, "unset m%stics;\n", ax); - endif - endif - else - fprintf (plot_stream, "set format %s \"%s\";\n", ax, fmt); - if (mirror) - fprintf (plot_stream, "set %stics %s %s %s mirror %s %s;\n", ax, - axispos, tickdir, ticklength, colorspec, fontspec); - else - fprintf (plot_stream, "set %stics %s %s %s nomirror %s %s;\n", ax, - tickdir, ticklength, axispos, colorspec, fontspec); - endif - if (strcmp (mtics, "on")) - fprintf (plot_stream, "set m%stics %d;\n", ax, num_mtics); - else - fprintf (plot_stream, "unset m%stics;\n", ax); - endif - endif -endfunction - -function ticklabel = ticklabel_to_cell (ticklabel) - if (isnumeric (ticklabel)) - ## Use upto 5 significant digits - ticklabel = num2str (ticklabel(:), 5); - endif - if (ischar (ticklabel)) - if (size (ticklabel, 1) == 1 && any (ticklabel == "|")) - n = setdiff (findstr (ticklabel, "|"), findstr (ticklabel, '\|')); - ticklabel = strsplit (ticklabel, "|"); - else - ticklabel = cellstr (ticklabel); - endif - elseif (isempty (ticklabel)) - ticklabel = {""}; - else - ticklabel = ticklabel; - endif -endfunction - -function colorspec = get_text_colorspec (color, mono) - if (mono) - colorspec = ""; - else - colorspec = sprintf ("textcolor rgb \"#%02x%02x%02x\"", - round (255*color)); - endif -endfunction - -function [f, s, fnt, it, bld] = get_fontname_and_size (t) - if (isempty (t.fontname) || strcmp (t.fontname, "*")) - fnt = "{}"; - else - fnt = t.fontname; - endif - f = fnt; - it = false; - bld = false; - if (! isempty (t.fontweight) && strcmpi (t.fontweight, "bold")) - if (! isempty(t.fontangle) - && (strcmpi (t.fontangle, "italic") - || strcmpi (t.fontangle, "oblique"))) - f = cstrcat (f, "-bolditalic"); - it = true; - bld = true; - else - f = cstrcat (f, "-bold"); - bld = true; - endif - elseif (! isempty(t.fontangle) - && (strcmpi (t.fontangle, "italic") - || strcmpi (t.fontangle, "oblique"))) - f = cstrcat (f, "-italic"); - it = true; - endif - if (isempty (t.fontsize)) - s = 10; - else - s = t.fontsize; - endif -endfunction - -function [str, f, s] = __maybe_munge_text__ (enhanced, obj, fld) - - persistent warned_latex = false; - - if (strcmp (fld, "string")) - [f, s, fnt, it, bld] = get_fontname_and_size (obj); - else - f = "Helvetica"; - s = 10; - fnt = f; - it = false; - bld = false; - endif - - str = getfield (obj, fld); - if (enhanced) - if (strcmpi (obj.interpreter, "tex")) - str = __tex2enhanced__ (str, fnt, it, bld); - elseif (strcmpi (obj.interpreter, "latex")) - if (! warned_latex) - warning ("latex markup not supported for text objects"); - warned_latex = true; - endif - endif - endif -endfunction - -function str = __tex2enhanced__ (str, fnt, it, bld) - persistent sym = __setup_sym_table__ (); - persistent flds = fieldnames (sym); - - [s, e, m] = regexp(str,'\\([a-zA-Z]+|0)','start','end','matches'); - - for i = length (s) : -1 : 1 - ## special case for "\0" and replace with "{/Symbol \306}' - if (strncmp (m{i}, '\0', 2)) - str = cstrcat (str(1:s(i) - 1), '{/Symbol \306}', str(s(i) + 2:end)); - else - f = m{i}(2:end); - if (isfield (sym, f)) - g = getfield(sym, f); - ## FIXME The symbol font doesn't seem to support bold or italic - ##if (bld) - ## if (it) - ## g = regexprep (g, '/Symbol', '/Symbol-bolditalic'); - ## else - ## g = regexprep (g, '/Symbol', '/Symbol-bold'); - ## endif - ##elseif (it) - ## g = regexprep (g, '/Symbol', '/Symbol-italic'); - ##endif - str = cstrcat (str(1:s(i) - 1), g, str(e(i) + 1:end)); - elseif (strncmp (f, "rm", 2)) - bld = false; - it = false; - str = cstrcat (str(1:s(i) - 1), '/', fnt, ' ', str(s(i) + 3:end)); - elseif (strncmp (f, "it", 2) || strncmp (f, "sl", 2)) - it = true; - if (bld) - str = cstrcat (str(1:s(i) - 1), '/', fnt, '-bolditalic ', - str(s(i) + 3:end)); - else - str = cstrcat (str(1:s(i) - 1), '/', fnt, '-italic ', - str(s(i) + 3:end)); - endif - elseif (strncmp (f, "bf", 2)) - bld = true; - if (it) - str = cstrcat (str(1:s(i) - 1), '/', fnt, '-bolditalic ', - str(2(i) + 3:end)); - else - str = cstrcat (str(1:s(i) - 1), '/', fnt, '-bold ', - str(s(i) + 3:end)); - endif - elseif (strcmpi (f, "color")) - ## FIXME Ignore \color but remove trailing {} block as well - d = strfind(str(e(i) + 1:end),'}'); - if (isempty (d)) - warning ('syntax error in \color argument'); - else - str = cstrcat (str(1:s(i) - 1), str(e(i) + d + 1:end)); - endif - elseif(strcmpi (f, "fontname")) - b1 = strfind(str(e(i) + 1:end),'{'); - b2 = strfind(str(e(i) + 1:end),'}'); - if (isempty(b1) || isempty(b2)) - warning ('syntax error in \fontname argument'); - else - str = cstrcat (str(1:s(i) - 1), '/', - str(e(i)+b1(1) + 1:e(i)+b2(1)-1), '{}', - str(e(i) + b2(1) + 1:end)); - endif - elseif(strcmpi (f, "fontsize")) - b1 = strfind(str(e(i) + 1:end),'{'); - b2 = strfind(str(e(i) + 1:end),'}'); - if (isempty(b1) || isempty(b2)) - warning ('syntax error in \fontname argument'); - else - str = cstrcat (str(1:s(i) - 1), '/=', - str(e(i)+b1(1) + 1:e(i)+b2(1)-1), '{}', - str(e(i) + b2(1) + 1:end)); - endif - else - ## Last desperate attempt to treat the symbol. Look for things - ## like \pix, that should be translated to the symbol Pi and x - for j = 1 : length (flds) - if (strncmp (flds{j}, f, length (flds{j}))) - g = getfield(sym, flds{j}); - ## FIXME The symbol font doesn't seem to support bold or italic - ##if (bld) - ## if (it) - ## g = regexprep (g, '/Symbol', '/Symbol-bolditalic'); - ## else - ## g = regexprep (g, '/Symbol', '/Symbol-bold'); - ## endif - ##elseif (it) - ## g = regexprep (g, '/Symbol', '/Symbol-italic'); - ##endif - str = cstrcat (str(1:s(i) - 1), g, - str(s(i) + length (flds{j}) + 1:end)); - break; - endif - endfor - endif - endif - endfor - - ## Prepend @ to things things like _0^x or _{-100}^{100} for - ## alignment But need to put the shorter of the two arguments first. - ## Carful of nested {} and unprinted characters when defining - ## shortest.. Don't have to worry about things like ^\theta as they - ## are already converted to ^{/Symbol q}. - - ## FIXME -- This is a mess... Is it worth it just for a "@" character? - - [s, m] = regexp(str,'[_\^]','start','matches'); - i = 1; - p = 0; - while (i < length (s)) - if (i < length(s)) - if (str(s(i) + p + 1) == "{") - s1 = strfind(str(s(i) + p + 2:end),'{'); - si = 1; - l1 = strfind(str(s(i) + p + 1:end),'}'); - li = 1; - while (li <= length (l1) && si <= length (s1)) - if (l1(li) < s1(si)) - if (li == si) - break; - endif - li++; - else - si++; - endif - endwhile - l1 = l1 (min (length(l1), si)); - if (s(i) + l1 + 1 == s(i+1)) - if (str(s(i + 1) + p + 1) == "{") - s2 = strfind(str(s(i + 1) + p + 2:end),'{'); - si = 1; - l2 = strfind(str(s(i + 1) + p + 1:end),'}'); - li = 1; - while (li <= length (l2) && si <= length (s2)) - if (l2(li) < s2(si)) - if (li == si) - break; - endif - li++; - else - si++; - endif - endwhile - l2 = l2 (min (length(l2), si)); - if (length_string (str(s(i)+p+2:s(i)+p+l1-1)) <= - length_string(str(s(i+1)+p+2:s(i+1)+p+l2-1))) - ## Shortest already first! - str = cstrcat (str(1:s(i)+p-1), "@", str(s(i)+p:end)); - else - ## Have to swap sub/super-script to get shortest first. - str = cstrcat (str(1:s(i)+p-1), "@", str(s(i+1)+p:s(i+1)+p+l2), - str(s(i)+p:s(i)+p+l1), str(s(i+1)+p+l2+1:end)); - endif - else - ## Have to swap sub/super-script to get shortest first. - str = cstrcat (str(1:s(i)+p-1), "@", str(s(i+1)+p:s(i+1)+p+1), - str(s(i)+p:s(i)+p+l1), str(s(i+1)+p+2:end)); - endif - i += 2; - p ++; - else - i++; - endif - else - if (s(i+1) == s(i) + 2) - ## Shortest already first! - str = cstrcat (str(1:s(i)+p-1), "@", str(s(i)+p:end)); - p ++; - i += 2; - else - i ++; - endif - endif - else - i ++; - endif - endwhile - -endfunction - -function l = length_string (s) - 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)); - endif -endfunction - -function sym = __setup_sym_table__ () - ## Setup the translation table for TeX to gnuplot enhanced mode. - sym.forall = '{/Symbol \042}'; - sym.exists = '{/Symbol \044}'; - sym.ni = '{/Symbol \047}'; - sym.cong = '{/Symbol \100}'; - sym.Delta = '{/Symbol D}'; - sym.Phi = '{/Symbol F}'; - sym.Gamma = '{/Symbol G}'; - sym.vartheta = '{/Symbol J}'; - sym.Lambda = '{/Symbol L}'; - sym.Pi = '{/Symbol P}'; - sym.Theta = '{/Symbol Q}'; - sym.Sigma = '{/Symbol S}'; - sym.varsigma = '{/Symbol V}'; - sym.Omega = '{/Symbol W}'; - sym.Xi = '{/Symbol X}'; - sym.Psi = '{/Symbol Y}'; - sym.perp = '{/Symbol \136}'; - sym.alpha = '{/Symbol a}'; - sym.beta = '{/Symbol b}'; - sym.chi = '{/Symbol c}'; - sym.delta = '{/Symbol d}'; - sym.epsilon = '{/Symbol e}'; - sym.phi = '{/Symbol f}'; - sym.gamma = '{/Symbol g}'; - sym.eta = '{/Symbol h}'; - sym.iota = '{/Symbol i}'; - sym.varphi = '{/Symbol j}'; - sym.kappa = '{/Symbol k}'; - sym.lambda = '{/Symbol l}'; - sym.mu = '{/Symbol m}'; - sym.nu = '{/Symbol n}'; - sym.o = '{/Symbol o}'; - sym.pi = '{/Symbol p}'; - sym.theta = '{/Symbol q}'; - sym.rho = '{/Symbol r}'; - sym.sigma = '{/Symbol s}'; - sym.tau = '{/Symbol t}'; - sym.upsilon = '{/Symbol u}'; - sym.varpi = '{/Symbol v}'; - sym.omega = '{/Symbol w}'; - sym.xi = '{/Symbol x}'; - sym.psi = '{/Symbol y}'; - sym.zeta = '{/Symbol z}'; - sym.sim = '{/Symbol \176}'; - sym.Upsilon = '{/Symbol \241}'; - sym.prime = '{/Symbol \242}'; - sym.leq = '{/Symbol \243}'; - sym.infty = '{/Symbol \245}'; - sym.clubsuit = '{/Symbol \247}'; - sym.diamondsuit = '{/Symbol \250}'; - sym.heartsuit = '{/Symbol \251}'; - sym.spadesuit = '{/Symbol \252}'; - sym.leftrightarrow = '{/Symbol \253}'; - sym.leftarrow = '{/Symbol \254}'; - sym.uparrow = '{/Symbol \255}'; - sym.rightarrow = '{/Symbol \256}'; - sym.downarrow = '{/Symbol \257}'; - sym.circ = '{/Symbol \260}'; - sym.pm = '{/Symbol \261}'; - sym.geq = '{/Symbol \263}'; - sym.times = '{/Symbol \264}'; - sym.propto = '{/Symbol \265}'; - sym.partial = '{/Symbol \266}'; - sym.bullet = '{/Symbol \267}'; - sym.div = '{/Symbol \270}'; - sym.neq = '{/Symbol \271}'; - sym.equiv = '{/Symbol \272}'; - sym.approx = '{/Symbol \273}'; - sym.ldots = '{/Symbol \274}'; - sym.mid = '{/Symbol \275}'; - sym.aleph = '{/Symbol \300}'; - sym.Im = '{/Symbol \301}'; - sym.Re = '{/Symbol \302}'; - sym.wp = '{/Symbol \303}'; - sym.otimes = '{/Symbol \304}'; - sym.oplus = '{/Symbol \305}'; - sym.oslash = '{/Symbol \306}'; - sym.cap = '{/Symbol \307}'; - sym.cup = '{/Symbol \310}'; - sym.supset = '{/Symbol \311}'; - sym.supseteq = '{/Symbol \312}'; - sym.subset = '{/Symbol \314}'; - sym.subseteq = '{/Symbol \315}'; - sym.in = '{/Symbol \316}'; - sym.notin = '{/Symbol \317}'; - sym.angle = '{/Symbol \320}'; - sym.bigtriangledown = '{/Symbol \321}'; - sym.langle = '{/Symbol \341}'; - sym.rangle = '{/Symbol \361}'; - sym.nabla = '{/Symbol \321}'; - sym.prod = '{/Symbol \325}'; - sym.surd = '{/Symbol \326}'; - sym.cdot = '{/Symbol \327}'; - sym.neg = '{/Symbol \330}'; - sym.wedge = '{/Symbol \331}'; - sym.vee = '{/Symbol \332}'; - sym.Leftrightarrow = '{/Symbol \333}'; - sym.Leftarrow = '{/Symbol \334}'; - sym.Uparrow = '{/Symbol \335}'; - sym.Rightarrow = '{/Symbol \336}'; - sym.Downarrow = '{/Symbol \337}'; - sym.diamond = '{/Symbol \340}'; - sym.copyright = '{/Symbol \343}'; - sym.lfloor = '{/Symbol \353}'; - sym.lceil = '{/Symbol \351}'; - sym.rfloor = '{/Symbol \373}'; - sym.rceil = '{/Symbol \371}'; - sym.int = '{/Symbol \362}'; -endfunction - -function retval = __do_enhanced_option__ (enhanced, obj) - retval = ""; - if (enhanced) - if (strcmpi (obj.interpreter, "none")) - retval = "noenhanced"; - else - retval = "enhanced"; - endif - endif -endfunction
--- a/scripts/plot/__go_draw_figure__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,198 +0,0 @@ -## Copyright (C) 2005-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_draw_figure__ (@var{h}, @var{plot_stream}, @var{enhanced}, @var{mono}) -## Undocumented internal function. -## @end deftypefn - -## Author: jwe - -function __go_draw_figure__ (h, plot_stream, enhanced, mono) - - if (nargin == 4) - htype = get (h, "type"); - if (strcmp (htype, "figure")) - ## Get complete list of children. - kids = allchild (h); - nkids = length (kids); - - if (nkids > 0) - fputs (plot_stream, "\nreset;\n"); - fputs (plot_stream, "set autoscale keepfix;\n"); - fputs (plot_stream, "set origin 0, 0\n"); - fputs (plot_stream, "set size 1, 1\n"); - bg = get (h, "color"); - if (isnumeric (bg)) - fprintf (plot_stream, "set obj 1 rectangle from screen 0,0 to screen 1,1 behind fc rgb \"#%02x%02x%02x\"\n", 255 * bg); - bg_is_set = true; - else - bg_is_set = false; - endif - - for i = nkids:-1:1 - type = get (kids(i), "type"); - switch (type) - case "axes" - if (strcmpi (get (kids (i), "tag"), "legend")) - ## This is so ugly. If there was a way of getting - ## gnuplot to give us the text extents of strings - ## then we could get rid of this mess. - lh = getfield (get (kids(i), "userdata"), "handle"); - if (isscalar (lh)) - ## We have a legend with a single parent. It'll be handled - ## below as a gnuplot key to the axis it corresponds to - continue; - else - ca = lh(1); - ## Rely upon listener to convert axes position - ## to "normalized" units. - legend_axes_units = get (kids(i), "units"); - legend_axes_position = get (kids(i), "position"); - legend_axes_outerposition = get (kids(i), "outerposition"); - legend_axes_box = get (kids(i), "box"); - legend_axes_ylim = get (kids(i), "ylim"); - orig_axes_units = get (ca, "units"); - hlgnd = get (kids(i)); - - unwind_protect - set (ca, "units", "normalized"); - set (kids(i), "units", "normalized", "box", "off", - "ylim", [-2, -1], "position", get (ca(1), "position"), - "outerposition", get (ca(1), "outerposition")); - - ## Create a new set of lines with the appropriate - ## displaynames, etc - toberm = []; - hobj = get (kids(i), "children"); - for j = numel (hobj) : -1 : 1 - if (! strcmp (get (hobj(j), "type"), "text")) - continue; - endif - displayname = get (hobj(j), "string"); - ll = []; - lm = []; - for k = numel (hobj) : -1 : 1 - if (! strcmp (get (hobj(k), "type"), "line")) - continue; - endif - if (get (hobj(j), "userdata") - != get (hobj(k), "userdata")) - continue; - endif - if (! strcmp (get (hobj(k), "linestyle"), "none")) - ll = hobj(k); - endif - if (! strcmp (get (hobj(k), "marker"), "none")) - lm = hobj(k); - endif - endfor - - if (! isempty (ll)) - if (!isempty (lm)) - toberm = [toberm, line("xdata",[0,0],"ydata",[0,0], "color", get(lm,"color"), "linestyle", get(ll,"linestyle"), "marker", get(lm,"marker"), "markeredgecolor", get(lm,"markeredgecolor"), "markerfacecolor", get(lm,"markerfacecolor"), "markersize", get (lm, "markersize"), "displayname", displayname, "parent", kids(i))]; - else - toberm = [toberm, line("xdata",[0,0],"ydata",[0,0], "color", get(ll,"color"), "linestyle", get(ll,"linestyle"), "marker", "none", "displayname", displayname, "parent", kids(i))]; - endif - elseif (! isempty (lm)) - toberm = [toberm, line("xdata",[0,0],"ydata",[0,0], "color", get(lm,"color"), "linestyle", "none", "marker", get(lm,"marker"), "markeredgecolor", get(lm,"markeredgecolor"), "markerfacecolor", get(lm,"markerfacecolor"), "markersize", get (lm, "markersize"), "displayname", displayname, "parent", kids(i))]; - endif - endfor - if (bg_is_set) - fprintf (plot_stream, "set border linecolor rgb \"#%02x%02x%02x\"\n", 255 * (1 - bg)); - endif - __go_draw_axes__ (kids(i), plot_stream, enhanced, mono, - bg_is_set, false, hlgnd); - unwind_protect_cleanup - ## Return axes "units" and "position" back to - ## their original values. - set (ca, "units", orig_axes_units); - set (kids(i), "units", legend_axes_units, - "box", legend_axes_box, - "ylim", legend_axes_ylim, - "position", legend_axes_position, - "outerposition", legend_axes_outerposition); - delete (toberm); - bg_is_set = false; - end_unwind_protect - endif - else - ## Rely upon listener to convert axes position - ## to "normalized" units. - orig_axes_units = get (kids(i), "units"); - orig_axes_position = get (kids(i), "position"); - unwind_protect - set (kids(i), "units", "normalized"); - fg = get (kids(i), "color"); - if (isnumeric (fg) && strcmp (get (kids(i), "visible"), "on")) - fprintf (plot_stream, "set obj 2 rectangle from graph 0,0 to graph 1,1 behind fc rgb \"#%02x%02x%02x\"\n", 255 * fg); - fg_is_set = true; - else - fg_is_set = false; - endif - if (bg_is_set) - fprintf (plot_stream, "set border linecolor rgb \"#%02x%02x%02x\"\n", 255 * (1 - bg)); - endif - ## Find if this axes has an associated legend axes and pass it - ## to __go_draw_axes__ - hlegend = []; - fkids = get (h, "children"); - for j = 1 : numel(fkids) - if (ishandle (fkids (j)) - && strcmp (get (fkids (j), "type"), "axes") - && (strcmp (get (fkids (j), "tag"), "legend"))) - udata = get (fkids (j), "userdata"); - if (isscalar(udata.handle) - && ! isempty (intersect (udata.handle, kids (i)))) - hlegend = get (fkids (j)); - break; - endif - endif - endfor - __go_draw_axes__ (kids(i), plot_stream, enhanced, mono, - bg_is_set, fg_is_set, hlegend); - unwind_protect_cleanup - ## Return axes "units" and "position" back to - ## their original values. - set (kids(i), "units", orig_axes_units); - set (kids(i), "position", orig_axes_position); - bg_is_set = false; - fg_is_set = false; - end_unwind_protect - endif - case "uimenu" - ## ignore uimenu objects - otherwise - error ("__go_draw_figure__: unknown object class, %s", type); - endswitch - endfor - fputs (plot_stream, "\nunset multiplot;\n"); - else - fputs (plot_stream, "\nreset; clear;\n"); - fflush (plot_stream); - endif - else - error ("__go_draw_figure__: expecting figure object, found `%s'", - htype); - endif - else - print_usage (); - endif - -endfunction -
--- a/scripts/plot/__marching_cube__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,530 +0,0 @@ -## Copyright (C) 2009-2011 Martin Helm -## -## 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{t}, @var{p}] =} __marching_cube__ (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}) -## @deftypefnx {Function File} {[@var{t}, @var{p}, @var{c}] =} __marching_cube__ (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}, @var{col}) -## Undocumented internal function. -## @end deftypefn - -## -*- texinfo -*- -## @deftypefn {Function File} {[@var{t}, @var{p}] =} __marching_cube__ (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}) -## @deftypefnx {Function File} {[@var{t}, @var{p}, @var{c}] =} __marching_cube__ (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}, @var{col}) -## -## Return the triangulation information @var{t} at points @var{p} for -## the isosurface values resp. the volume data @var{val} and the iso -## level @var{iso}. It is considered that the volume data @var{val} is -## given at the points @var{x}, @var{y} and @var{z} which are of type -## three--dimensional numeric arrays. The orientation of the triangles -## is choosen such that the normals point from the higher values to the -## lower values. -## -## Optionally the color data @var{col} can be passed to this function -## whereas computed vertices color data @var{c} is returned as third -## argument. -## -## The marching cube algorithm is well known and described, for example, at -## Wikipedia. The triangulation lookup table and the edge table used -## here are based on Cory Gene Bloyd's implementation and can be found -## beyond other surface and geometry stuff at Paul Bourke's website -## @uref{http://local.wasp.uwa.edu.au/~pbourke/geometry/polygonise}. -## -## For example: -## -## @example -## @group -## N = 20; -## lin = linspace(0, 2, N); -## [x, y, z] = meshgrid (lin, lin, lin); -## -## c = (x-.5).^2 + (y-.5).^2 + (z-.5).^2; -## [t, p] = __marching_cube__ (x, y, z, c, .5); -## -## figure (); -## trimesh (t, p(:,1), p(:,2), p(:,3)); -## @end group -## @end example -## -## Instead of the @command{trimesh} function the @command{patch} -## function can be used to visualize the geometry. For example: -## -## @example -## @group -## figure (); view (-38, 20); -## pa = patch ("Faces", t, "Vertices", p, "FaceVertexCData", p, \ -## "FaceColor", "interp", "EdgeColor", "none"); -## -## ## Revert normals -## set (pa, "VertexNormals", -get(pa, "VertexNormals")); -## -## ## Set lightning (available with the JHandles package) -## # set (pa, "FaceLighting", "gouraud"); -## # light( "Position", [1 1 5]); -## @end group -## @end example -## -## @end deftypefn - -## Author: Martin Helm <martin@mhelm.de> - -function [T, p, col] = __marching_cube__ (xx, yy, zz, c, iso, colors) - - persistent edge_table=[]; - persistent tri_table=[]; - - calc_cols = false; - lindex = 4; - - if (isempty (tri_table) || isempty (edge_table)) - [edge_table, tri_table] = init_mc (); - endif - - if ((nargin != 5 && nargin != 6) || (nargout != 2 && nargout != 3)) - print_usage (); - endif - - if (!ismatrix (xx) || !ismatrix (yy) || !ismatrix (zz) || !ismatrix (c) || ... - ndims (xx) != 3 || ndims (yy) != 3 || ndims (zz) != 3 || ndims (c) != 3) - error ("__marching_cube__: XX, YY, ZZ, C must be matrices of dim 3"); - endif - - if (!size_equal (xx, yy, zz, c)) - error ("__marching_cube__: XX, YY, ZZ, C must be of equal size"); - endif - - if (any (size (xx) < [2 2 2])) - error ("__marching_cube__: grid size must be at least 2x2x2"); - endif - - if (!isscalar (iso)) - error ("__marching_cube__: ISO must be scalar value"); - endif - - if (nargin == 6) - if ( !ismatrix (colors) || ndims (colors) != 3 || size (colors) != size (c) ) - error ( "COLORS must be a matrix of dim 3 and of same size as C" ); - endif - calc_cols = true; - lindex = 5; - endif - - n = size (c) - 1; - - ## phase I: assign information to each voxel which edges are intersected by - ## the isosurface - cc = zeros (n(1), n(2), n(3), "uint16"); - cedge = zeros (size (cc), "uint16"); - - vertex_idx = {1:n(1), 1:n(2), 1:n(3); ... - 2:n(1)+1, 1:n(2), 1:n(3); ... - 2:n(1)+1, 2:n(2)+1, 1:n(3); ... - 1:n(1), 2:n(2)+1, 1:n(3); ... - 1:n(1), 1:n(2), 2:n(3)+1; ... - 2:n(1)+1, 1:n(2), 2:n(3)+1; ... - 2:n(1)+1, 2:n(2)+1, 2:n(3)+1; ... - 1:n(1), 2:n(2)+1, 2:n(3)+1 }; - - ## calculate which vertices have values higher than iso - for ii=1:8 - idx = c(vertex_idx{ii, :}) > iso; - cc(idx) = bitset (cc(idx), ii); - endfor - - cedge = edge_table(cc+1); # assign the info about intersected edges - id = find (cedge); # select only voxels which are intersected - if (isempty (id)) - T = p = col = []; - return - endif - - ## phase II: calculate the list of intersection points - xyz_off = [1, 1, 1; 2, 1, 1; 2, 2, 1; 1, 2, 1; 1, 1, 2; 2, 1, 2; 2, 2, 2; 1, 2, 2]; - edges = [1 2; 2 3; 3 4; 4 1; 5 6; 6 7; 7 8; 8 5; 1 5; 2 6; 3 7; 4 8]; - offset = sub2ind (size (c), xyz_off(:, 1), xyz_off(:, 2), xyz_off(:, 3)) -1; - pp = zeros (length (id), lindex, 12); - ccedge = [vec(cedge(id)), id]; - ix_offset=0; - for jj=1:12 - id__ = bitget (ccedge(:, 1), jj); - id_ = ccedge(id__, 2); - [ix iy iz] = ind2sub (size (cc), id_); - id_c = sub2ind (size (c), ix, iy, iz); - id1 = id_c + offset(edges(jj, 1)); - id2 = id_c + offset(edges(jj, 2)); - if (calc_cols) - pp(id__, 1:5, jj) = [vertex_interp(iso, xx(id1), yy(id1), zz(id1), ... - xx(id2), yy(id2), zz(id2), c(id1), c(id2), colors(id1), colors(id2)), ... - (1:size (id_, 1))' + ix_offset ]; - else - pp(id__, 1:4, jj) = [vertex_interp(iso, xx(id1), yy(id1), zz(id1), ... - xx(id2), yy(id2), zz(id2), c(id1), c(id2)), ... - (1:size (id_, 1))' + ix_offset ]; - endif - ix_offset += size (id_, 1); - endfor - - ## phase III: calculate the triangulation from the point list - T = []; - tri = tri_table(cc(id)+1, :); - for jj=1:3:15 - id_ = find (tri(:, jj)>0); - p = [id_, lindex*ones(size (id_, 1), 1),tri(id_, jj:jj+2)]; - if (!isempty (p)) - p1 = sub2ind (size (pp), p(:,1), p(:,2), p(:,3)); - p2 = sub2ind (size (pp), p(:,1), p(:,2), p(:,4)); - p3 = sub2ind (size (pp), p(:,1), p(:,2), p(:,5)); - T = [T; pp(p1), pp(p2), pp(p3)]; - endif - endfor - - p = []; - col = []; - for jj = 1:12 - idp = pp(:, lindex, jj) > 0; - if (any (idp)) - p(pp(idp, lindex, jj), 1:3) = pp(idp, 1:3, jj); - if (calc_cols) - col(pp(idp, lindex, jj),1) = pp(idp, 4, jj); - endif - endif - endfor -endfunction - -function p = vertex_interp(isolevel,p1x, p1y, p1z,... - p2x, p2y, p2z,valp1,valp2, col1, col2) - - if (nargin == 9) - p = zeros (length (p1x), 3); - elseif (nargin == 11) - p = zeros (length (p1x), 4); - else - error ("__marching_cube__: wrong number of arguments"); - endif - mu = zeros (length (p1x), 1); - id = abs (valp1-valp2) < (10*eps) .* (abs (valp1) .+ abs (valp2)); - if (any (id)) - p(id, 1:3) = [ p1x(id), p1y(id), p1z(id) ]; - if (nargin == 11) - p(id, 4) = col1(id); - endif - endif - nid = !id; - if (any (nid)) - mu(nid) = (isolevel - valp1(nid)) ./ (valp2(nid) - valp1(nid)); - p(nid, 1:3) = [p1x(nid) + mu(nid) .* (p2x(nid) - p1x(nid)), ... - p1y(nid) + mu(nid) .* (p2y(nid) - p1y(nid)), ... - p1z(nid) + mu(nid) .* (p2z(nid) - p1z(nid))]; - if (nargin == 11) - p(nid, 4) = col1(nid) + mu(nid) .* (col2(nid) - col1(nid)); - endif - endif -endfunction - -function [edge_table, tri_table] = init_mc() - edge_table = [ - 0x0 , 0x109, 0x203, 0x30a, 0x406, 0x50f, 0x605, 0x70c, ... - 0x80c, 0x905, 0xa0f, 0xb06, 0xc0a, 0xd03, 0xe09, 0xf00, ... - 0x190, 0x99 , 0x393, 0x29a, 0x596, 0x49f, 0x795, 0x69c, ... - 0x99c, 0x895, 0xb9f, 0xa96, 0xd9a, 0xc93, 0xf99, 0xe90, ... - 0x230, 0x339, 0x33 , 0x13a, 0x636, 0x73f, 0x435, 0x53c, ... - 0xa3c, 0xb35, 0x83f, 0x936, 0xe3a, 0xf33, 0xc39, 0xd30, ... - 0x3a0, 0x2a9, 0x1a3, 0xaa , 0x7a6, 0x6af, 0x5a5, 0x4ac, ... - 0xbac, 0xaa5, 0x9af, 0x8a6, 0xfaa, 0xea3, 0xda9, 0xca0, ... - 0x460, 0x569, 0x663, 0x76a, 0x66 , 0x16f, 0x265, 0x36c, ... - 0xc6c, 0xd65, 0xe6f, 0xf66, 0x86a, 0x963, 0xa69, 0xb60, ... - 0x5f0, 0x4f9, 0x7f3, 0x6fa, 0x1f6, 0xff , 0x3f5, 0x2fc, ... - 0xdfc, 0xcf5, 0xfff, 0xef6, 0x9fa, 0x8f3, 0xbf9, 0xaf0, ... - 0x650, 0x759, 0x453, 0x55a, 0x256, 0x35f, 0x55 , 0x15c, ... - 0xe5c, 0xf55, 0xc5f, 0xd56, 0xa5a, 0xb53, 0x859, 0x950, ... - 0x7c0, 0x6c9, 0x5c3, 0x4ca, 0x3c6, 0x2cf, 0x1c5, 0xcc , ... - 0xfcc, 0xec5, 0xdcf, 0xcc6, 0xbca, 0xac3, 0x9c9, 0x8c0, ... - 0x8c0, 0x9c9, 0xac3, 0xbca, 0xcc6, 0xdcf, 0xec5, 0xfcc, ... - 0xcc , 0x1c5, 0x2cf, 0x3c6, 0x4ca, 0x5c3, 0x6c9, 0x7c0, ... - 0x950, 0x859, 0xb53, 0xa5a, 0xd56, 0xc5f, 0xf55, 0xe5c, ... - 0x15c, 0x55 , 0x35f, 0x256, 0x55a, 0x453, 0x759, 0x650, ... - 0xaf0, 0xbf9, 0x8f3, 0x9fa, 0xef6, 0xfff, 0xcf5, 0xdfc, ... - 0x2fc, 0x3f5, 0xff , 0x1f6, 0x6fa, 0x7f3, 0x4f9, 0x5f0, ... - 0xb60, 0xa69, 0x963, 0x86a, 0xf66, 0xe6f, 0xd65, 0xc6c, ... - 0x36c, 0x265, 0x16f, 0x66 , 0x76a, 0x663, 0x569, 0x460, ... - 0xca0, 0xda9, 0xea3, 0xfaa, 0x8a6, 0x9af, 0xaa5, 0xbac, ... - 0x4ac, 0x5a5, 0x6af, 0x7a6, 0xaa , 0x1a3, 0x2a9, 0x3a0, ... - 0xd30, 0xc39, 0xf33, 0xe3a, 0x936, 0x83f, 0xb35, 0xa3c, ... - 0x53c, 0x435, 0x73f, 0x636, 0x13a, 0x33 , 0x339, 0x230, ... - 0xe90, 0xf99, 0xc93, 0xd9a, 0xa96, 0xb9f, 0x895, 0x99c, ... - 0x69c, 0x795, 0x49f, 0x596, 0x29a, 0x393, 0x99 , 0x190, ... - 0xf00, 0xe09, 0xd03, 0xc0a, 0xb06, 0xa0f, 0x905, 0x80c, ... - 0x70c, 0x605, 0x50f, 0x406, 0x30a, 0x203, 0x109, 0x0 ]; - - tri_table =[ - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 0, 8, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 0, 1, 9, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 1, 8, 3, 9, 8, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 1, 2, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 0, 8, 3, 1, 2, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 9, 2, 10, 0, 2, 9, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 2, 8, 3, 2, 10, 8, 10, 9, 8, -1, -1, -1, -1, -1, -1, -1; - 3, 11, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 0, 11, 2, 8, 11, 0, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 1, 9, 0, 2, 3, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 1, 11, 2, 1, 9, 11, 9, 8, 11, -1, -1, -1, -1, -1, -1, -1; - 3, 10, 1, 11, 10, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 0, 10, 1, 0, 8, 10, 8, 11, 10, -1, -1, -1, -1, -1, -1, -1; - 3, 9, 0, 3, 11, 9, 11, 10, 9, -1, -1, -1, -1, -1, -1, -1; - 9, 8, 10, 10, 8, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 4, 7, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 4, 3, 0, 7, 3, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 0, 1, 9, 8, 4, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 4, 1, 9, 4, 7, 1, 7, 3, 1, -1, -1, -1, -1, -1, -1, -1; - 1, 2, 10, 8, 4, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 3, 4, 7, 3, 0, 4, 1, 2, 10, -1, -1, -1, -1, -1, -1, -1; - 9, 2, 10, 9, 0, 2, 8, 4, 7, -1, -1, -1, -1, -1, -1, -1; - 2, 10, 9, 2, 9, 7, 2, 7, 3, 7, 9, 4, -1, -1, -1, -1; - 8, 4, 7, 3, 11, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 11, 4, 7, 11, 2, 4, 2, 0, 4, -1, -1, -1, -1, -1, -1, -1; - 9, 0, 1, 8, 4, 7, 2, 3, 11, -1, -1, -1, -1, -1, -1, -1; - 4, 7, 11, 9, 4, 11, 9, 11, 2, 9, 2, 1, -1, -1, -1, -1; - 3, 10, 1, 3, 11, 10, 7, 8, 4, -1, -1, -1, -1, -1, -1, -1; - 1, 11, 10, 1, 4, 11, 1, 0, 4, 7, 11, 4, -1, -1, -1, -1; - 4, 7, 8, 9, 0, 11, 9, 11, 10, 11, 0, 3, -1, -1, -1, -1; - 4, 7, 11, 4, 11, 9, 9, 11, 10, -1, -1, -1, -1, -1, -1, -1; - 9, 5, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 9, 5, 4, 0, 8, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 0, 5, 4, 1, 5, 0, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 8, 5, 4, 8, 3, 5, 3, 1, 5, -1, -1, -1, -1, -1, -1, -1; - 1, 2, 10, 9, 5, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 3, 0, 8, 1, 2, 10, 4, 9, 5, -1, -1, -1, -1, -1, -1, -1; - 5, 2, 10, 5, 4, 2, 4, 0, 2, -1, -1, -1, -1, -1, -1, -1; - 2, 10, 5, 3, 2, 5, 3, 5, 4, 3, 4, 8, -1, -1, -1, -1; - 9, 5, 4, 2, 3, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 0, 11, 2, 0, 8, 11, 4, 9, 5, -1, -1, -1, -1, -1, -1, -1; - 0, 5, 4, 0, 1, 5, 2, 3, 11, -1, -1, -1, -1, -1, -1, -1; - 2, 1, 5, 2, 5, 8, 2, 8, 11, 4, 8, 5, -1, -1, -1, -1; - 10, 3, 11, 10, 1, 3, 9, 5, 4, -1, -1, -1, -1, -1, -1, -1; - 4, 9, 5, 0, 8, 1, 8, 10, 1, 8, 11, 10, -1, -1, -1, -1; - 5, 4, 0, 5, 0, 11, 5, 11, 10, 11, 0, 3, -1, -1, -1, -1; - 5, 4, 8, 5, 8, 10, 10, 8, 11, -1, -1, -1, -1, -1, -1, -1; - 9, 7, 8, 5, 7, 9, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 9, 3, 0, 9, 5, 3, 5, 7, 3, -1, -1, -1, -1, -1, -1, -1; - 0, 7, 8, 0, 1, 7, 1, 5, 7, -1, -1, -1, -1, -1, -1, -1; - 1, 5, 3, 3, 5, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 9, 7, 8, 9, 5, 7, 10, 1, 2, -1, -1, -1, -1, -1, -1, -1; - 10, 1, 2, 9, 5, 0, 5, 3, 0, 5, 7, 3, -1, -1, -1, -1; - 8, 0, 2, 8, 2, 5, 8, 5, 7, 10, 5, 2, -1, -1, -1, -1; - 2, 10, 5, 2, 5, 3, 3, 5, 7, -1, -1, -1, -1, -1, -1, -1; - 7, 9, 5, 7, 8, 9, 3, 11, 2, -1, -1, -1, -1, -1, -1, -1; - 9, 5, 7, 9, 7, 2, 9, 2, 0, 2, 7, 11, -1, -1, -1, -1; - 2, 3, 11, 0, 1, 8, 1, 7, 8, 1, 5, 7, -1, -1, -1, -1; - 11, 2, 1, 11, 1, 7, 7, 1, 5, -1, -1, -1, -1, -1, -1, -1; - 9, 5, 8, 8, 5, 7, 10, 1, 3, 10, 3, 11, -1, -1, -1, -1; - 5, 7, 0, 5, 0, 9, 7, 11, 0, 1, 0, 10, 11, 10, 0, -1; - 11, 10, 0, 11, 0, 3, 10, 5, 0, 8, 0, 7, 5, 7, 0, -1; - 11, 10, 5, 7, 11, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 10, 6, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 0, 8, 3, 5, 10, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 9, 0, 1, 5, 10, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 1, 8, 3, 1, 9, 8, 5, 10, 6, -1, -1, -1, -1, -1, -1, -1; - 1, 6, 5, 2, 6, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 1, 6, 5, 1, 2, 6, 3, 0, 8, -1, -1, -1, -1, -1, -1, -1; - 9, 6, 5, 9, 0, 6, 0, 2, 6, -1, -1, -1, -1, -1, -1, -1; - 5, 9, 8, 5, 8, 2, 5, 2, 6, 3, 2, 8, -1, -1, -1, -1; - 2, 3, 11, 10, 6, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 11, 0, 8, 11, 2, 0, 10, 6, 5, -1, -1, -1, -1, -1, -1, -1; - 0, 1, 9, 2, 3, 11, 5, 10, 6, -1, -1, -1, -1, -1, -1, -1; - 5, 10, 6, 1, 9, 2, 9, 11, 2, 9, 8, 11, -1, -1, -1, -1; - 6, 3, 11, 6, 5, 3, 5, 1, 3, -1, -1, -1, -1, -1, -1, -1; - 0, 8, 11, 0, 11, 5, 0, 5, 1, 5, 11, 6, -1, -1, -1, -1; - 3, 11, 6, 0, 3, 6, 0, 6, 5, 0, 5, 9, -1, -1, -1, -1; - 6, 5, 9, 6, 9, 11, 11, 9, 8, -1, -1, -1, -1, -1, -1, -1; - 5, 10, 6, 4, 7, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 4, 3, 0, 4, 7, 3, 6, 5, 10, -1, -1, -1, -1, -1, -1, -1; - 1, 9, 0, 5, 10, 6, 8, 4, 7, -1, -1, -1, -1, -1, -1, -1; - 10, 6, 5, 1, 9, 7, 1, 7, 3, 7, 9, 4, -1, -1, -1, -1; - 6, 1, 2, 6, 5, 1, 4, 7, 8, -1, -1, -1, -1, -1, -1, -1; - 1, 2, 5, 5, 2, 6, 3, 0, 4, 3, 4, 7, -1, -1, -1, -1; - 8, 4, 7, 9, 0, 5, 0, 6, 5, 0, 2, 6, -1, -1, -1, -1; - 7, 3, 9, 7, 9, 4, 3, 2, 9, 5, 9, 6, 2, 6, 9, -1; - 3, 11, 2, 7, 8, 4, 10, 6, 5, -1, -1, -1, -1, -1, -1, -1; - 5, 10, 6, 4, 7, 2, 4, 2, 0, 2, 7, 11, -1, -1, -1, -1; - 0, 1, 9, 4, 7, 8, 2, 3, 11, 5, 10, 6, -1, -1, -1, -1; - 9, 2, 1, 9, 11, 2, 9, 4, 11, 7, 11, 4, 5, 10, 6, -1; - 8, 4, 7, 3, 11, 5, 3, 5, 1, 5, 11, 6, -1, -1, -1, -1; - 5, 1, 11, 5, 11, 6, 1, 0, 11, 7, 11, 4, 0, 4, 11, -1; - 0, 5, 9, 0, 6, 5, 0, 3, 6, 11, 6, 3, 8, 4, 7, -1; - 6, 5, 9, 6, 9, 11, 4, 7, 9, 7, 11, 9, -1, -1, -1, -1; - 10, 4, 9, 6, 4, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 4, 10, 6, 4, 9, 10, 0, 8, 3, -1, -1, -1, -1, -1, -1, -1; - 10, 0, 1, 10, 6, 0, 6, 4, 0, -1, -1, -1, -1, -1, -1, -1; - 8, 3, 1, 8, 1, 6, 8, 6, 4, 6, 1, 10, -1, -1, -1, -1; - 1, 4, 9, 1, 2, 4, 2, 6, 4, -1, -1, -1, -1, -1, -1, -1; - 3, 0, 8, 1, 2, 9, 2, 4, 9, 2, 6, 4, -1, -1, -1, -1; - 0, 2, 4, 4, 2, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 8, 3, 2, 8, 2, 4, 4, 2, 6, -1, -1, -1, -1, -1, -1, -1; - 10, 4, 9, 10, 6, 4, 11, 2, 3, -1, -1, -1, -1, -1, -1, -1; - 0, 8, 2, 2, 8, 11, 4, 9, 10, 4, 10, 6, -1, -1, -1, -1; - 3, 11, 2, 0, 1, 6, 0, 6, 4, 6, 1, 10, -1, -1, -1, -1; - 6, 4, 1, 6, 1, 10, 4, 8, 1, 2, 1, 11, 8, 11, 1, -1; - 9, 6, 4, 9, 3, 6, 9, 1, 3, 11, 6, 3, -1, -1, -1, -1; - 8, 11, 1, 8, 1, 0, 11, 6, 1, 9, 1, 4, 6, 4, 1, -1; - 3, 11, 6, 3, 6, 0, 0, 6, 4, -1, -1, -1, -1, -1, -1, -1; - 6, 4, 8, 11, 6, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 7, 10, 6, 7, 8, 10, 8, 9, 10, -1, -1, -1, -1, -1, -1, -1; - 0, 7, 3, 0, 10, 7, 0, 9, 10, 6, 7, 10, -1, -1, -1, -1; - 10, 6, 7, 1, 10, 7, 1, 7, 8, 1, 8, 0, -1, -1, -1, -1; - 10, 6, 7, 10, 7, 1, 1, 7, 3, -1, -1, -1, -1, -1, -1, -1; - 1, 2, 6, 1, 6, 8, 1, 8, 9, 8, 6, 7, -1, -1, -1, -1; - 2, 6, 9, 2, 9, 1, 6, 7, 9, 0, 9, 3, 7, 3, 9, -1; - 7, 8, 0, 7, 0, 6, 6, 0, 2, -1, -1, -1, -1, -1, -1, -1; - 7, 3, 2, 6, 7, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 2, 3, 11, 10, 6, 8, 10, 8, 9, 8, 6, 7, -1, -1, -1, -1; - 2, 0, 7, 2, 7, 11, 0, 9, 7, 6, 7, 10, 9, 10, 7, -1; - 1, 8, 0, 1, 7, 8, 1, 10, 7, 6, 7, 10, 2, 3, 11, -1; - 11, 2, 1, 11, 1, 7, 10, 6, 1, 6, 7, 1, -1, -1, -1, -1; - 8, 9, 6, 8, 6, 7, 9, 1, 6, 11, 6, 3, 1, 3, 6, -1; - 0, 9, 1, 11, 6, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 7, 8, 0, 7, 0, 6, 3, 11, 0, 11, 6, 0, -1, -1, -1, -1; - 7, 11, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 7, 6, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 3, 0, 8, 11, 7, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 0, 1, 9, 11, 7, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 8, 1, 9, 8, 3, 1, 11, 7, 6, -1, -1, -1, -1, -1, -1, -1; - 10, 1, 2, 6, 11, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 1, 2, 10, 3, 0, 8, 6, 11, 7, -1, -1, -1, -1, -1, -1, -1; - 2, 9, 0, 2, 10, 9, 6, 11, 7, -1, -1, -1, -1, -1, -1, -1; - 6, 11, 7, 2, 10, 3, 10, 8, 3, 10, 9, 8, -1, -1, -1, -1; - 7, 2, 3, 6, 2, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 7, 0, 8, 7, 6, 0, 6, 2, 0, -1, -1, -1, -1, -1, -1, -1; - 2, 7, 6, 2, 3, 7, 0, 1, 9, -1, -1, -1, -1, -1, -1, -1; - 1, 6, 2, 1, 8, 6, 1, 9, 8, 8, 7, 6, -1, -1, -1, -1; - 10, 7, 6, 10, 1, 7, 1, 3, 7, -1, -1, -1, -1, -1, -1, -1; - 10, 7, 6, 1, 7, 10, 1, 8, 7, 1, 0, 8, -1, -1, -1, -1; - 0, 3, 7, 0, 7, 10, 0, 10, 9, 6, 10, 7, -1, -1, -1, -1; - 7, 6, 10, 7, 10, 8, 8, 10, 9, -1, -1, -1, -1, -1, -1, -1; - 6, 8, 4, 11, 8, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 3, 6, 11, 3, 0, 6, 0, 4, 6, -1, -1, -1, -1, -1, -1, -1; - 8, 6, 11, 8, 4, 6, 9, 0, 1, -1, -1, -1, -1, -1, -1, -1; - 9, 4, 6, 9, 6, 3, 9, 3, 1, 11, 3, 6, -1, -1, -1, -1; - 6, 8, 4, 6, 11, 8, 2, 10, 1, -1, -1, -1, -1, -1, -1, -1; - 1, 2, 10, 3, 0, 11, 0, 6, 11, 0, 4, 6, -1, -1, -1, -1; - 4, 11, 8, 4, 6, 11, 0, 2, 9, 2, 10, 9, -1, -1, -1, -1; - 10, 9, 3, 10, 3, 2, 9, 4, 3, 11, 3, 6, 4, 6, 3, -1; - 8, 2, 3, 8, 4, 2, 4, 6, 2, -1, -1, -1, -1, -1, -1, -1; - 0, 4, 2, 4, 6, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 1, 9, 0, 2, 3, 4, 2, 4, 6, 4, 3, 8, -1, -1, -1, -1; - 1, 9, 4, 1, 4, 2, 2, 4, 6, -1, -1, -1, -1, -1, -1, -1; - 8, 1, 3, 8, 6, 1, 8, 4, 6, 6, 10, 1, -1, -1, -1, -1; - 10, 1, 0, 10, 0, 6, 6, 0, 4, -1, -1, -1, -1, -1, -1, -1; - 4, 6, 3, 4, 3, 8, 6, 10, 3, 0, 3, 9, 10, 9, 3, -1; - 10, 9, 4, 6, 10, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 4, 9, 5, 7, 6, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 0, 8, 3, 4, 9, 5, 11, 7, 6, -1, -1, -1, -1, -1, -1, -1; - 5, 0, 1, 5, 4, 0, 7, 6, 11, -1, -1, -1, -1, -1, -1, -1; - 11, 7, 6, 8, 3, 4, 3, 5, 4, 3, 1, 5, -1, -1, -1, -1; - 9, 5, 4, 10, 1, 2, 7, 6, 11, -1, -1, -1, -1, -1, -1, -1; - 6, 11, 7, 1, 2, 10, 0, 8, 3, 4, 9, 5, -1, -1, -1, -1; - 7, 6, 11, 5, 4, 10, 4, 2, 10, 4, 0, 2, -1, -1, -1, -1; - 3, 4, 8, 3, 5, 4, 3, 2, 5, 10, 5, 2, 11, 7, 6, -1; - 7, 2, 3, 7, 6, 2, 5, 4, 9, -1, -1, -1, -1, -1, -1, -1; - 9, 5, 4, 0, 8, 6, 0, 6, 2, 6, 8, 7, -1, -1, -1, -1; - 3, 6, 2, 3, 7, 6, 1, 5, 0, 5, 4, 0, -1, -1, -1, -1; - 6, 2, 8, 6, 8, 7, 2, 1, 8, 4, 8, 5, 1, 5, 8, -1; - 9, 5, 4, 10, 1, 6, 1, 7, 6, 1, 3, 7, -1, -1, -1, -1; - 1, 6, 10, 1, 7, 6, 1, 0, 7, 8, 7, 0, 9, 5, 4, -1; - 4, 0, 10, 4, 10, 5, 0, 3, 10, 6, 10, 7, 3, 7, 10, -1; - 7, 6, 10, 7, 10, 8, 5, 4, 10, 4, 8, 10, -1, -1, -1, -1; - 6, 9, 5, 6, 11, 9, 11, 8, 9, -1, -1, -1, -1, -1, -1, -1; - 3, 6, 11, 0, 6, 3, 0, 5, 6, 0, 9, 5, -1, -1, -1, -1; - 0, 11, 8, 0, 5, 11, 0, 1, 5, 5, 6, 11, -1, -1, -1, -1; - 6, 11, 3, 6, 3, 5, 5, 3, 1, -1, -1, -1, -1, -1, -1, -1; - 1, 2, 10, 9, 5, 11, 9, 11, 8, 11, 5, 6, -1, -1, -1, -1; - 0, 11, 3, 0, 6, 11, 0, 9, 6, 5, 6, 9, 1, 2, 10, -1; - 11, 8, 5, 11, 5, 6, 8, 0, 5, 10, 5, 2, 0, 2, 5, -1; - 6, 11, 3, 6, 3, 5, 2, 10, 3, 10, 5, 3, -1, -1, -1, -1; - 5, 8, 9, 5, 2, 8, 5, 6, 2, 3, 8, 2, -1, -1, -1, -1; - 9, 5, 6, 9, 6, 0, 0, 6, 2, -1, -1, -1, -1, -1, -1, -1; - 1, 5, 8, 1, 8, 0, 5, 6, 8, 3, 8, 2, 6, 2, 8, -1; - 1, 5, 6, 2, 1, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 1, 3, 6, 1, 6, 10, 3, 8, 6, 5, 6, 9, 8, 9, 6, -1; - 10, 1, 0, 10, 0, 6, 9, 5, 0, 5, 6, 0, -1, -1, -1, -1; - 0, 3, 8, 5, 6, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 10, 5, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 11, 5, 10, 7, 5, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 11, 5, 10, 11, 7, 5, 8, 3, 0, -1, -1, -1, -1, -1, -1, -1; - 5, 11, 7, 5, 10, 11, 1, 9, 0, -1, -1, -1, -1, -1, -1, -1; - 10, 7, 5, 10, 11, 7, 9, 8, 1, 8, 3, 1, -1, -1, -1, -1; - 11, 1, 2, 11, 7, 1, 7, 5, 1, -1, -1, -1, -1, -1, -1, -1; - 0, 8, 3, 1, 2, 7, 1, 7, 5, 7, 2, 11, -1, -1, -1, -1; - 9, 7, 5, 9, 2, 7, 9, 0, 2, 2, 11, 7, -1, -1, -1, -1; - 7, 5, 2, 7, 2, 11, 5, 9, 2, 3, 2, 8, 9, 8, 2, -1; - 2, 5, 10, 2, 3, 5, 3, 7, 5, -1, -1, -1, -1, -1, -1, -1; - 8, 2, 0, 8, 5, 2, 8, 7, 5, 10, 2, 5, -1, -1, -1, -1; - 9, 0, 1, 5, 10, 3, 5, 3, 7, 3, 10, 2, -1, -1, -1, -1; - 9, 8, 2, 9, 2, 1, 8, 7, 2, 10, 2, 5, 7, 5, 2, -1; - 1, 3, 5, 3, 7, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 0, 8, 7, 0, 7, 1, 1, 7, 5, -1, -1, -1, -1, -1, -1, -1; - 9, 0, 3, 9, 3, 5, 5, 3, 7, -1, -1, -1, -1, -1, -1, -1; - 9, 8, 7, 5, 9, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 5, 8, 4, 5, 10, 8, 10, 11, 8, -1, -1, -1, -1, -1, -1, -1; - 5, 0, 4, 5, 11, 0, 5, 10, 11, 11, 3, 0, -1, -1, -1, -1; - 0, 1, 9, 8, 4, 10, 8, 10, 11, 10, 4, 5, -1, -1, -1, -1; - 10, 11, 4, 10, 4, 5, 11, 3, 4, 9, 4, 1, 3, 1, 4, -1; - 2, 5, 1, 2, 8, 5, 2, 11, 8, 4, 5, 8, -1, -1, -1, -1; - 0, 4, 11, 0, 11, 3, 4, 5, 11, 2, 11, 1, 5, 1, 11, -1; - 0, 2, 5, 0, 5, 9, 2, 11, 5, 4, 5, 8, 11, 8, 5, -1; - 9, 4, 5, 2, 11, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 2, 5, 10, 3, 5, 2, 3, 4, 5, 3, 8, 4, -1, -1, -1, -1; - 5, 10, 2, 5, 2, 4, 4, 2, 0, -1, -1, -1, -1, -1, -1, -1; - 3, 10, 2, 3, 5, 10, 3, 8, 5, 4, 5, 8, 0, 1, 9, -1; - 5, 10, 2, 5, 2, 4, 1, 9, 2, 9, 4, 2, -1, -1, -1, -1; - 8, 4, 5, 8, 5, 3, 3, 5, 1, -1, -1, -1, -1, -1, -1, -1; - 0, 4, 5, 1, 0, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 8, 4, 5, 8, 5, 3, 9, 0, 5, 0, 3, 5, -1, -1, -1, -1; - 9, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 4, 11, 7, 4, 9, 11, 9, 10, 11, -1, -1, -1, -1, -1, -1, -1; - 0, 8, 3, 4, 9, 7, 9, 11, 7, 9, 10, 11, -1, -1, -1, -1; - 1, 10, 11, 1, 11, 4, 1, 4, 0, 7, 4, 11, -1, -1, -1, -1; - 3, 1, 4, 3, 4, 8, 1, 10, 4, 7, 4, 11, 10, 11, 4, -1; - 4, 11, 7, 9, 11, 4, 9, 2, 11, 9, 1, 2, -1, -1, -1, -1; - 9, 7, 4, 9, 11, 7, 9, 1, 11, 2, 11, 1, 0, 8, 3, -1; - 11, 7, 4, 11, 4, 2, 2, 4, 0, -1, -1, -1, -1, -1, -1, -1; - 11, 7, 4, 11, 4, 2, 8, 3, 4, 3, 2, 4, -1, -1, -1, -1; - 2, 9, 10, 2, 7, 9, 2, 3, 7, 7, 4, 9, -1, -1, -1, -1; - 9, 10, 7, 9, 7, 4, 10, 2, 7, 8, 7, 0, 2, 0, 7, -1; - 3, 7, 10, 3, 10, 2, 7, 4, 10, 1, 10, 0, 4, 0, 10, -1; - 1, 10, 2, 8, 7, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 4, 9, 1, 4, 1, 7, 7, 1, 3, -1, -1, -1, -1, -1, -1, -1; - 4, 9, 1, 4, 1, 7, 0, 8, 1, 8, 7, 1, -1, -1, -1, -1; - 4, 0, 3, 7, 4, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 4, 8, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 9, 10, 8, 10, 11, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 3, 0, 9, 3, 9, 11, 11, 9, 10, -1, -1, -1, -1, -1, -1, -1; - 0, 1, 10, 0, 10, 8, 8, 10, 11, -1, -1, -1, -1, -1, -1, -1; - 3, 1, 10, 11, 3, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 1, 2, 11, 1, 11, 9, 9, 11, 8, -1, -1, -1, -1, -1, -1, -1; - 3, 0, 9, 3, 9, 11, 1, 2, 9, 2, 11, 9, -1, -1, -1, -1; - 0, 2, 11, 8, 0, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 3, 2, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 2, 3, 8, 2, 8, 10, 10, 8, 9, -1, -1, -1, -1, -1, -1, -1; - 9, 10, 2, 0, 9, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 2, 3, 8, 2, 8, 10, 0, 1, 8, 1, 10, 8, -1, -1, -1, -1; - 1, 10, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 1, 3, 8, 9, 1, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 0, 9, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; - 0, 3, 8, -1, -1, -1, -1, -1, -1, -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
--- a/scripts/plot/__next_line_color__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +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} {@var{rgb} =} __next_line_color__ (@var{reset}) -## Undocumented internal function. -## @end deftypefn - -## Return the next line color in the rotation. - -## Author: jwe - -function rgb = __next_line_color__ (reset) - - persistent color_rotation; - persistent num_colors; - persistent color_index; - - if (nargin < 2) - if (nargin == 1) - if (reset || isempty (color_rotation)) - color_rotation = get (gca (), "colororder"); - num_colors = rows (color_rotation); - color_index = 1; - endif - elseif (! isempty (color_rotation)) - rgb = color_rotation(color_index,:); - if (++color_index > num_colors) - color_index = 1; - __next_line_style__ ("incr"); - endif - else - error ("__next_line_color__: color_rotation not initialized"); - endif - else - print_usage (); - endif - -endfunction
--- a/scripts/plot/__next_line_style__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,58 +0,0 @@ -## Copyright (C) 2010-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} =} __next_line_style__ (@var{reset}) -## Undocumented internal function. -## @end deftypefn - -## Return the next line style in the rotation. - - -function [linestyle, marker] = __next_line_style__ (reset) - - persistent style_rotation; - persistent num_styles; - persistent style_index; - - if (nargin < 2) - if (nargin == 1) - if (ischar (reset) && strncmp (reset, "incr", 4)) - if (isempty (style_rotation)) - error ("__next_line_style__: style_rotation not initialized"); - elseif (++style_index > num_styles) - style_index = 1; - endif - elseif (reset || isempty (style_rotation)) - style_rotation = strsplit (get (gca (), "linestyleorder"), "|"); - num_styles = length (style_rotation); - style_index = 1; - endif - elseif (! isempty (style_rotation)) - options = __pltopt__ ("__next_line_style__", - style_rotation (style_index)); - linestyle = options.linestyle; - marker = options.marker; - else - error ("__next_line_style__: style_rotation not initialized"); - endif - else - print_usage (); - endif - -endfunction
--- a/scripts/plot/__plt_get_axis_arg__.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/__plt_get_axis_arg__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/__print_parse_opts__.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,609 +0,0 @@ -## Copyright (C) 2008-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{x}, @var{y}, @var{buttons}] =} ginput (@var{n}) -## 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. -## @end deftypefn - -function arg_st = __print_parse_opts__ (varargin) - - persistent warn_on_missing_binary = true - - arg_st.append_to_file = false; - arg_st.canvas_size = []; - arg_st.debug = false; - arg_st.debug_file = "octave-print-commands.log"; - arg_st.devopt = ""; - arg_st.epstool_binary = __quote_path__ (__find_binary__ ("epstool")); - arg_st.figure = get (0, "currentfigure"); - arg_st.fig2dev_binary = __quote_path__ (__find_binary__ ("fig2dev")); - arg_st.fontsize = ""; - arg_st.font = ""; - arg_st.force_solid = 0; # 0=default, -1=dashed, +1=solid - arg_st.formatted_for_printing = false; - arg_st.ghostscript.binary = __quote_path__ (__ghostscript_binary__ ()); - arg_st.ghostscript.debug = false; - arg_st.ghostscript.device = ""; - arg_st.ghostscript.epscrop = true; - arg_st.ghostscript.level = []; - arg_st.ghostscript.output = ""; - arg_st.ghostscript.papersize = ""; - arg_st.ghostscript.pageoffset = []; - arg_st.ghostscript.resolution = 150; - arg_st.ghostscript.antialiasing = false; - arg_st.loose = false; - arg_st.lpr_binary = __quote_path__ (__find_binary__ ("lpr")); - arg_st.name = ""; - arg_st.orientation = ""; - arg_st.pstoedit_binary = __quote_path__ (__find_binary__ ("pstoedit")); - arg_st.preview = ""; - arg_st.printer = ""; - arg_st.send_to_printer = false; - arg_st.special_flag = "textnormal"; - arg_st.tight_flag = false; - arg_st.use_color = 0; # 0=default, -1=mono, +1=color - - if (isunix ()) - arg_st.lpr_options = "-l"; - elseif (ispc ()) - arg_st.lpr_options = "-o l"; - else - arg_st.lpr_options = ""; - endif - arg_st.unlink = {}; - - if (nargin > 0 && isfigure (varargin{1})) - arg_st.figure = varargin{1}; - varargin(1) = []; - endif - - for i = 1:numel(varargin) - arg = strtrim (varargin{i}); - if (ischar (arg)) - if (strcmp (arg, "-color")) - arg_st.use_color = 1; - elseif (strcmp (arg, "-append")) - arg_st.append_to_file = true; - elseif (strcmp (arg, "-mono")) - arg_st.use_color = -1; - elseif (strcmp (arg, "-solid")) - arg_st.force_solid = 1; - elseif (strcmp (arg, "-dashed")) - arg_st.force_solid = -1; - elseif (strncmp (arg, "-portrait", numel (arg))) - arg_st.orientation = "portrait"; - elseif (strncmp (arg, "-landscape", numel (arg))) - arg_st.orientation = "landscape"; - elseif (strcmp (arg, "-loose")) - arg_st.loose = true; - arg_st.tight_flag = false; - elseif (strcmp (arg, "-tight")) - arg_st.loose = false; - arg_st.tight_flag = true; - elseif (strcmp (arg, "-textspecial")) - arg_st.special_flag = "textspecial"; - elseif (any (strcmp (arg, {"-interchange", "-metafile", "-pict", "-tiff"}))) - arg_st.preview = arg(2:end); - elseif (strncmp (arg, "-debug", 6)) - arg_st.debug = true; - arg_st.ghostscript.debug = true; - if (length (arg) > 7) - arg_st.debug_file = arg(8:end); - endif - elseif (length (arg) > 2 && arg(1:2) == "-d") - arg_st.devopt = tolower (arg(3:end)); - elseif (length (arg) > 2 && arg(1:2) == "-P") - arg_st.printer = arg; - elseif (strncmp (arg, "-EPSTOOL:", 9)) - arg_st.epstool_binary = arg{10:end}; - elseif (strncmp (arg, "-FIG2DEV:", 9)) - arg_st.fig2dev_binary = arg{10:end}; - elseif (strncmp (arg, "-PSTOEDIT:", 9)) - arg_st.pstoedit_binary = arg{10:end}; - elseif ((length (arg) > 2) && arg(1:2) == "-G") - arg_st.ghostscript.binary = file_in_path (getenv ("PATH"), arg(3:end)); - if (isempty (arg_st.ghostscript.binary)) - error ("print: Ghostscript binary ""%s"" could not be located", - arg(3:end)); - else - arg_st.ghostscript_binary = __quote_path__ (arg_st.ghostscript_binary); - endif - elseif (length (arg) > 2 && arg(1:2) == "-F") - idx = rindex (arg, ":"); - if (idx) - arg_st.font = arg(3:idx-1); - arg_st.fontsize = str2num (arg(idx+1:end)); - else - arg_st.font = arg(3:end); - endif - elseif (length (arg) > 2 && arg(1:2) == "-S") - arg_st.canvas_size = str2num (arg(3:end)); - elseif (length (arg) > 2 && arg(1:2) == "-r") - arg_st.ghostscript.resolution = str2double (arg(3:end)); - elseif (length (arg) > 2 && arg(1:2) == "-f") - arg_st.figure = str2num (arg(3:end)); - elseif (length (arg) >= 1 && arg(1) == "-") - error ("print: unknown option `%s'", arg); - elseif (length (arg) > 0) - arg_st.name = arg; - endif - elseif (isfigure (arg)) - arg_st.figure = arg; - else - error ("print: expecting inputs to be character string options or a figure handle"); - endif - endfor - - if (arg_st.ghostscript.resolution == 0) - ## Do as Matlab does. - arg_st.ghostscript.resolution = num2str (get (0, "screenpixelsperinch")); - endif - - if (isempty (arg_st.orientation)) - if (isfigure (arg_st.figure)) - arg_st.orientation = get (arg_st.figure, "paperorientation"); - else - ## Allows tests to be run without error. - arg_st.orientation = "portrait"; - endif - endif - - if (isempty (arg_st.ghostscript.binary)) - arg_st.ghostscript.binary = __ghostscript_binary__ (); - endif - - dot = rindex (arg_st.name, "."); - if (isempty (arg_st.devopt)) - if (dot == 0) - arg_st.devopt = "psc"; - else - arg_st.devopt = tolower (arg_st.name(dot+1:end)); - endif - endif - - if (arg_st.use_color == 0) - if (any (strcmp ({"ps", "ps2", "eps", "eps2"}, arg_st.devopt))) - arg_st.use_color = -1; - else - arg_st.use_color = 1; - endif - endif - - if (strcmp (arg_st.devopt, "tex")) - arg_st.devopt = "epslatex"; - elseif (strcmp (arg_st.devopt, "ill")) - arg_st.devopt = "aifm"; - elseif (strcmp (arg_st.devopt, "cdr")) - arg_st.devopt = "corel"; - elseif (strcmp (arg_st.devopt, "meta")) - arg_st.devopt = "emf"; - elseif (strcmp (arg_st.devopt, "jpg")) - arg_st.devopt = "jpeg"; - endif - - dev_list = {"aifm", "corel", "fig", "png", "jpeg", ... - "gif", "pbm", "pbmraw", "dxf", "mf", ... - "svg", "hpgl", "ps", "ps2", "psc", ... - "psc2", "eps", "eps2", "epsc", "epsc2", ... - "emf", "pdf", "pslatex", "epslatex", "epslatexstandalone", ... - "pslatexstandalone", "pdflatexstandalone", ... - "pstex", "tiff", "tiffn" "tikz", "pcxmono", ... - "pcx24b", "pcx256", "pcx16", "pgm", "pgmraw", ... - "ppm", "ppmraw", "pdflatex", "texdraw", ... - "pdfcairo", "pngcairo", "pstricks", ... - "epswrite", "pswrite", "ps2write", "pdfwrite"}; - - suffixes = {"ai", "cdr", "fig", "png", "jpg", ... - "gif", "pbm", "pbm", "dxf", "mf", ... - "svg", "hpgl", "ps", "ps", "ps", ... - "ps", "eps", "eps", "eps", "eps", ... - "emf", "pdf", "tex", "tex", "tex", ... - "tex", "tex", ... - "ps", "tiff", "tiff", "tikz", "pcx", ... - "pcx", "pcx", "pcx", "pgm", "pgm", ... - "ppm", "ppm", "tex", "tex", ... - "pdf", "png", "tex", ... - "eps", "ps", "ps", "pdf"}; - - if (isfigure (arg_st.figure)) - __graphics_toolkit__ = get (arg_st.figure, "__graphics_toolkit__"); - else - ## Allow tests when no figures are present. - __graphics_toolkit__ = get (0, "defaultfigure__graphics_toolkit__"); - endif - - if (strcmp (__graphics_toolkit__, "gnuplot") - && __gnuplot_has_feature__ ("epslatex_implies_eps_filesuffix")) - suffixes(strncmp (dev_list, "epslatex", 8)) = {"eps"}; - endif - - match = strcmpi (dev_list, arg_st.devopt); - if (any (match)) - default_suffix = suffixes {match}; - else - default_suffix = arg_st.devopt; - endif - - if (dot == 0 && ! isempty (arg_st.name)) - arg_st.name = strcat (arg_st.name, ".", default_suffix); - endif - - if (arg_st.append_to_file) - if (isempty (arg_st.name)) - arg_st.append_to_file = false; - elseif (any (strcmpi (arg_st.devopt, {"eps", "eps2", "epsc", "epsc2", ... - "ps", "ps2", "psc", "psc2", "pdf"}))) - have_ghostscript = ! isempty (__ghostscript_binary__ ()); - if (have_ghostscript) - file_exists = ((numel (dir (arg_st.name)) == 1) - && (! isdir (arg_st.name))); - if (! file_exists) - arg_st.append_to_file = false; - endif - else - arg_st.append_to_file = false; - warning ("print.m: appended output requires ghostscript to be installed"); - endif - else - warning ("print.m: appended output is not supported for device '%s'", - arg_st.devopt); - arg_st.append_to_file = false; - endif - endif - - if (! isempty (arg_st.printer) || isempty (arg_st.name)) - arg_st.send_to_printer = true; - endif - - if (any (strcmp (arg_st.devopt, {"ps", "ps2", "psc", "psc2", "pdf"}))) - arg_st.formatted_for_printing = true; - endif - - aliases = gs_aliases (); - if (any (strcmp (arg_st.devopt, fieldnames (aliases)))) - arg_st.devopt = aliases.(arg_st.devopt); - endif - - ## FIXME - eps2 & epsc2 needs to be handled - if (strcmp (arg_st.devopt, "pswrite")) - arg_st.ghostscript.level = 1; - elseif (strcmp (arg_st.devopt, "ps2write")) - arg_st.ghostscript.level = 2; - endif - - if ((any (strcmp (arg_st.devopt, gs_device_list)) - && ! arg_st.formatted_for_printing) - || any (strcmp (arg_st.devopt, {"pswrite", "ps2write", "pdfwrite"}))) - ## Use ghostscript for graphic formats - arg_st.ghostscript.device = arg_st.devopt; - arg_st.ghostscript.output = arg_st.name; - arg_st.ghostscript.antialiasing = true; - if (arg_st.formatted_for_printing) - arg_st.ghostscript.epscrop = ! arg_st.loose; - else - ## pstoedit throws errors if the EPS file isn't cropped - arg_st.ghostscript.epscrop = true; - endif - elseif (all (! strcmp (arg_st.devopt, dev_list))) - ## Assume we are formating output for a printer - arg_st.formatted_for_printing = true; - arg_st.ghostscript.device = arg_st.devopt; - arg_st.ghostscript.output = arg_st.name; - arg_st.ghostscript.antialiasing = false; - arg_st.ghostscript.epscrop = ! arg_st.loose; - endif - - if (isempty (arg_st.canvas_size)) - if (isfigure (arg_st.figure)) - [arg_st.ghostscript.papersize, paperposition] = ... - gs_papersize (arg_st.figure, arg_st.orientation); - else - ## allows tests to be run - arg_st.ghostscript.papersize = "letter"; - paperposition = [0.25, 2.50, 8.00, 6.00] * 72; - endif - arg_st.canvas_size = paperposition(3:4); - if (strcmp (__graphics_toolkit__, "gnuplot") && ! arg_st.ghostscript.epscrop) - arg_st.ghostscript.pageoffset = paperposition(1:2) - 50; - else - arg_st.ghostscript.pageoffset = paperposition(1:2); - endif - else - ## Convert canvas size to points from pixles. - arg_st.canvas_size = arg_st.canvas_size * 72 / arg_st.ghostscript.resolution; - arg_st.ghostscript.papersize = arg_st.canvas_size; - arg_st.ghostscript.epscrop = true; - arg_st.ghostscript.pageoffset = [0, 0]; - endif - - if (arg_st.formatted_for_printing) - arg_st.ghostscript.resolution = []; - else - arg_st.ghostscript.papersize = ""; - arg_st.ghostscript.pageoffset = [0, 0]; - endif - - if (warn_on_missing_binary) - if (isempty (arg_st.ghostscript.binary)) - warning ("print:missing_gs", "print.m: Ghostscript binary is not available.\nOnly eps output is available."); - else - if (isempty (arg_st.epstool_binary)) - warning ("print:missing_epstool", "print.m: epstool binary is not available.\nSome output formats are not available."); - endif - if (isempty (arg_st.fig2dev_binary)) - warning ("print:missing_fig2dev", "print.m: fig2dev binary is not available.\nSome output formats are not available."); - endif - if (isempty (arg_st.pstoedit_binary)) - warning ("print:missing_pstoedit", "print.m: pstoedit binary is not available.\nSome output formats are not available."); - endif - endif - warn_on_missing_binary = false; - endif - -endfunction - -%!test -%! opts = __print_parse_opts__ (); -%! assert (opts.devopt, "pswrite"); -%! assert (opts.use_color, 1); -%! assert (opts.send_to_printer, true); -%! assert (opts.canvas_size, [576, 432]); -%! assert (opts.ghostscript.device, "pswrite") - -%!test -%! opts = __print_parse_opts__ ("test.pdf", "-S640,480"); -%! assert (opts.canvas_size, [307.2, 230.4], 0.1); - -%!test -%! opts = __print_parse_opts__ ("-dpsc", "-append", "-loose"); -%! assert (opts.devopt, "pswrite"); -%! assert (opts.send_to_printer, true); -%! assert (opts.use_color, 1); -%! assert (opts.append_to_file, false); -%! assert (opts.ghostscript.device, "pswrite") -%! assert (opts.ghostscript.epscrop, false); - -%!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 -%! opts = __print_parse_opts__ ("-djpg", "foobar", "-mono", "-loose"); -%! assert (opts.devopt, "jpeg") -%! assert (opts.name, "foobar.jpg") -%! assert (opts.ghostscript.device, "jpeg") -%! assert (opts.ghostscript.epscrop, true); -%! assert (opts.ghostscript.papersize, ""); -%! assert (opts.ghostscript.pageoffset, [0, 0]); -%! assert (opts.send_to_printer, false); -%! assert (opts.printer, ""); -%! assert (opts.use_color, -1); - -%!test -%! opts = __print_parse_opts__ ("-ddeskjet", "foobar", "-mono", "-Pmyprinter"); -%! assert (opts.ghostscript.output, "foobar.deskjet") -%! assert (opts.ghostscript.device, "deskjet") -%! assert (opts.devopt, "deskjet") -%! assert (opts.send_to_printer, true); -%! assert (opts.printer, "-Pmyprinter"); -%! assert (opts.use_color, -1); - -%!test -%! opts = __print_parse_opts__ ("-f5", "-dljet3"); -%! assert (opts.ghostscript.device, "ljet3") -%! assert (strfind (opts.ghostscript.output, ".ljet3")) -%! assert (opts.devopt, "ljet3") -%! assert (opts.send_to_printer, true); -%! assert (opts.figure, 5) - -function cmd = __quote_path__ (cmd) - if (any (cmd == " ") && ! (cmd(1) == """" && cmd(end) == """")) - cmd = strcat ("""", strrep (cmd, """", """"""), """"); - endif -endfunction - -function gs = __ghostscript_binary__ () - - persistent ghostscript_binary = "" - persistent warn_on_no_ghostscript = true - persistent warn_on_bad_gsc = true - - if (isempty (ghostscript_binary)) - GSC = getenv ("GSC"); - if (exist (GSC, "file") - || (! isempty (GSC) && file_in_path (getenv ("PATH"), GSC))) - gs_binaries = {GSC}; - elseif (! isempty (GSC) && warn_on_bad_gsc) - warning ("print:badgscenv", - "print.m: GSC environment variable not set properly"); - warn_on_bad_gsc = false; - gs_binaries = {}; - else - gs_binaries = {}; - endif - if (isunix ()) - ## Unix - Includes Mac OSX and Cygwin. - gs_binaries = horzcat (gs_binaries, {"gs", "gs.exe"}); - else - ## pc - Includes Win32 and mingw. - gs_binaries = horzcat (gs_binaries, {"gs.exe", "gswin32c.exe"}); - endif - n = 0; - while (n < numel (gs_binaries) && isempty (ghostscript_binary)) - n = n + 1; - ghostscript_binary = file_in_path (getenv ("PATH"), gs_binaries{n}); - endwhile - if (warn_on_no_ghostscript && isempty (ghostscript_binary)) - warning ("print:noghostscript", - "print.m: ghostscript not found in PATH"); - warn_on_no_ghostscript = false; - endif - endif - - gs = ghostscript_binary; - -endfunction - -function bin = __find_binary__ (binary) - - persistent data = struct () - - if (! isfield (data, binary)) - ## Reinitialize when `user_binaries' is present. - data.(binary).bin = ""; - data.(binary).warn_on_absence = false; - endif - - if (isempty (data.(binary).bin)) - if (isunix ()) - ## Unix - Includes Mac OSX and Cygwin. - binaries = strcat (binary, {"", ".exe"}); - else - ## pc - Includes Win32 and mingw. - binaries = strcat (binary, {".exe"}); - endif - n = 0; - while (n < numel (binaries) && isempty (data.(binary).bin)) - n = n + 1; - data.(binary).bin = file_in_path (getenv ("PATH"), binaries{n}); - endwhile - if (isempty (data.(binary).bin) && data.(binary).warn_on_absence) - warning (sprintf ("print:no%s", binary), - "print.m: '%s' not found in PATH", binary); - data.(binary).warn_on_absence = false; - endif - endif - - bin = data.(binary).bin; - -endfunction - -function [papersize, paperposition] = gs_papersize (hfig, paperorientation) - persistent papertypes papersizes - - if (isempty (papertypes)) - papertypes = {"usletter", "uslegal", "a0", "a1", ... - "a2", "a3", "a4", "a5", ... - "b0", "b1", "b2", "b3", ... - "b4", "b5", "arch-a", "arch-b", ... - "arch-c", "arch-d", "arch-e", "a", ... - "b", "c", "d", "e", ... - "tabloid"}; - papersizes = [ 8.5, 11.0; 8.5, 14.0; 33.1, 46.8; 23.4, 33.1; - 16.5, 23.4; 11.7, 16.5; 8.3, 11.7; 5.8, 8.3; - 39.4, 55.7; 27.8, 39.4; 19.7, 27.8; 13.9, 19.7; - 9.8, 13.9; 6.9, 9.8; 9.0, 12.0; 12.0, 18.0; - 18.0, 24.0; 24.0, 36.0; 36.0, 48.0; 8.5, 11.0; - 11.0, 17.0; 18.0, 24.0; 24.0, 36.0; 36.0, 48.0; - 11.0, 17.0] * 72; - endif - - papertype = get (hfig, "papertype"); - paperunits = get (hfig, "paperunits"); - paperposition = get (hfig, "paperposition"); - if (strcmp (papertype, "<custom>")) - papersize = get (hfig, "papersize"); - papersize = convert2points (papersize , paperunits); - else - papersize = papersizes (strcmp (papertypes, papertype), :); - endif - - if (strcmp (paperunits, "normalized")) - paperposition = paperposition .* papersize([1,2,1,2]); - else - paperposition = convert2points (paperposition, paperunits); - endif - - ## FIXME - This will be obsoleted by listeners for paper properties. - ## Papersize is tall when portrait,and wide when landscape. - if ((papersize(1) > papersize(2) && strcmpi (paperorientation, "portrait")) - || (papersize(1) < papersize(2) && strcmpi (paperorientation, "landscape"))) - papersize = papersize ([2,1]); - paperposition = paperposition([2,1,4,3]); - endif - - if ((! strcmp (papertype, "<custom>")) && (strcmp (paperorientation, "portrait"))) - ## For portrait use the ghostscript name - papersize = papertype; - papersize(papersize=="-") = ""; - papersize = strrep (papersize, "us", ""); - switch (papersize) - case "a" - papersize = "letter"; - case {"b", "tabloid"} - papersize = "11x17"; - case {"c", "d", "e"} - papersize = strcat ("arch", papersize); - endswitch - if (strncmp (papersize, "arch", 4)) - papersize(end) = upper (papersize(end)); - endif - endif - -endfunction - -function value = convert2points (value, units) - switch (units) - case "inches" - value = value * 72; - case "centimeters" - value = value * 72 / 2.54; - case "normalized" - error ("print:customnormalized", - "print.m: papersize=='<custom>' and paperunits='normalized' may not be combined"); - endswitch -endfunction - -function device_list = gs_device_list (); - ## Graphics formats/languages, not priners. - device_list = {"bmp16"; "bmp16m"; "bmp256"; "bmp32b"; "bmpgray"; ... - "epswrite"; "jpeg"; "jpegcymk"; "jpeggray"; "pbm"; ... - "pbmraw"; "pcx16"; "pcx24b"; "pcx256"; "pcx2up"; ... - "pcxcmyk"; "pcxgray"; "pcxmono"; "pdfwrite"; "pgm"; ... - "pgmraw"; "pgnm"; "pgnmraw"; "png16"; "png16m"; ... - "png256"; "png48"; "pngalpha"; "pnggray"; "pngmono"; ... - "pnm"; "pnmraw"; "ppm"; "ppmraw"; "ps2write"; ... - "pswrite"; "tiff12nc"; "tiff24nc"; "tiff32nc"; ... - "tiffcrle"; "tiffg3"; "tiffg32d"; "tiffg4"; ... - "tiffgray"; "tifflzw"; "tiffpack"; "tiffsep"}; -endfunction - -function aliases = gs_aliases (); - ## Aliases for other devices: "bmp", "png", "tiff", "tiffn", "pdf", - ## "ps", "ps2", "psc", "psc2" - ## - ## eps, epsc, eps2, epsc2 are not included here because those are - ## are generated by the graphics toolkit. - aliases.bmp = "bmp32b"; - aliases.pdf = "pdfwrite"; - aliases.png = "png16m"; - aliases.ps = "pswrite"; - aliases.ps2 = "ps2write"; - aliases.psc = "pswrite"; - aliases.psc2 = "ps2write"; - aliases.tiff = "tiff24nc"; - aliases.tiffn = "tiff24nc"; -endfunction -
--- a/scripts/plot/allchild.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/allchild.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ancestor.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/area.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/axes.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/axis.m Sun Dec 11 23:24:25 2011 -0500 @@ -319,20 +319,14 @@ else data = get (kids, strcat (ax, "data")); scale = get (ca, strcat (ax, "scale")); - if (strcmp (scale, "log")) - if (iscell (data)) - for i = 1:length(data) - data{i}(data{i}<=0) = NaN; - endfor - else - data(data<=0) = NaN; - endif + if (strcmp (scale, "log") && any (data > 0)) + data(data<=0) = NaN; endif if (iscell (data)) - data = data (find (! cellfun (@isempty, 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_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]; @@ -508,3 +502,48 @@ %! loglog (1:20, "-s") %! axis tight +%!demo +%! 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 +%! 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 +%! 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 +%! 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 +%! 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 +
--- a/scripts/plot/bar.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/bar.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/barh.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/cla.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/clabel.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/clf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/close.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/compass.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/compass.m Sun Dec 11 23:24:25 2011 -0500 @@ -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)
--- a/scripts/plot/ezcontour.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ezcontour.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 %! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); %! ezcontour (f, [-3, 3]); +
--- a/scripts/plot/ezcontourf.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ezcontourf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,7 @@ endif endfunction + %!demo %! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); %! ezcontourf (f, [-3, 3]);
--- a/scripts/plot/ezmesh.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ezmesh.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,6 +81,7 @@ endif endfunction + %!demo %! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); %! ezmesh (f, [-3, 3]); @@ -90,3 +91,4 @@ %! 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ezmeshc.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,8 @@ endif endfunction + %!demo %! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); %! ezmeshc (f, [-3, 3]); +
--- a/scripts/plot/ezplot.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ezplot.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,6 +79,7 @@ endif endfunction + %!demo %! ezplot (@cos, @sin) @@ -87,4 +87,5 @@ %! ezplot ("1/x") %!demo -%! ezplot (inline("x^2 - y^2 = 1")) +%! ezplot (inline ("x^2 - y^2 = 1")) +
--- a/scripts/plot/ezplot3.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ezplot3.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,10 @@ endif endfunction + %!demo %! fx = @(t) cos (t); %! fy = @(t) sin (t); %! fz = @(t) t; %! ezplot3 (fx, fy, fz, [0, 10*pi], 100); +
--- a/scripts/plot/ezpolar.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ezpolar.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,7 @@ endif endfunction + %!demo %! ezpolar (@(t) 1 + sin (t)); +
--- a/scripts/plot/ezsurf.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ezsurf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,6 +81,7 @@ endif endfunction + %!demo %! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); %! ezsurf (f, [-3, 3]); @@ -90,3 +91,4 @@ %! 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ezsurfc.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,8 @@ endif endfunction + %!demo %! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); %! ezsurfc (f, [-3, 3]); +
--- a/scripts/plot/feather.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/feather.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,8 @@ endfunction + %!demo %! phi = [0 : 15 : 360] * pi / 180; %! feather (sin (phi), cos (phi)) +
--- a/scripts/plot/figure.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/figure.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/fill.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/findall.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/findobj.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/gca.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/gca.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/gcbf.m Sun Dec 11 23:24:25 2011 -0500 @@ -31,3 +31,6 @@ [dummy, fig] = gcbo (); endfunction + +%!test +%! assert (isempty (gcbf ));
--- a/scripts/plot/gcbo.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/gcbo.m Sun Dec 11 23:24:25 2011 -0500 @@ -41,3 +41,6 @@ endif endfunction + +%!test +%! assert (isempty (gcbo ));
--- a/scripts/plot/gcf.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/gcf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ginput.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/graphics_toolkit.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,57 @@ ## @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 (nargin == 0) + retval = get (0, "defaultfigure__graphics_toolkit__"); + 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 + + if (isargout (1)) + retval = 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 +
--- a/scripts/plot/gtext.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/gtext.m Sun Dec 11 23:24:25 2011 -0500 @@ -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);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/guidata.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/guihandles.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/hggroup.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/hold.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/isfigure.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ishghandle.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ishold.m Sun Dec 11 23:24:25 2011 -0500 @@ -30,16 +30,12 @@ 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; @@ -55,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/isonormals.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/isonormals.m Sun Dec 11 23:24:25 2011 -0500 @@ -45,48 +45,50 @@ ## 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} ## @end deftypefn
--- a/scripts/plot/isosurface.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/isosurface.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,17 +99,19 @@ ## [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{isonormals, isocolors} ## @end deftypefn
--- a/scripts/plot/isprop.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/isprop.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/legend.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/line.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/loglog.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/loglog.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/mesh.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/mesh.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 +## suface 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/meshgrid.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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 \ @@ -103,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 \ @@ -171,10 +178,21 @@ 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/waitforbuttonpress.m \ plot/whitebg.m \
--- a/scripts/plot/ndgrid.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ndgrid.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/newplot.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/pareto.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/patch.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,9 +131,9 @@ %! 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 @@ -148,7 +146,90 @@ %! 2, 3, 5; %! 3, 4, 5; %! 4, 1, 5]; -%! patch('Vertices', vertices, 'Faces', faces, ... -%! 'FaceVertexCData', jet(5), 'FaceColor', 'interp') -%! view (-37.5, 30) +%! 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/pcolor.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/pcolor.m Sun Dec 11 23:24:25 2011 -0500 @@ -80,3 +80,14 @@ endif endfunction + +%!demo +%! clf +%! [~,~,Z]=peaks; +%! pcolor(Z); + +%!demo +%! [X,Y,Z]=sombrero; +%! [Fx,Fy] = gradient(Z); +%! pcolor(X,Y,Fx+Fy); +%! shading interp;
--- a/scripts/plot/pie.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/pie.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,19 @@ 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]); +%! colormap ([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); %!demo %! 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 %! 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/pie3.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,19 @@ 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]); +%! colormap ([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); %!demo %! 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 %! 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/plot.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/plotyy.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/plotyy.m Sun Dec 11 23:24:25 2011 -0500 @@ -79,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; @@ -115,8 +115,6 @@ endif end_unwind_protect - set (ax, "activepositionproperty", "position"); - if (nargout > 0) Ax = ax; H1 = h1; @@ -164,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"); @@ -186,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)}); @@ -193,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 @@ -268,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/polar.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,15 @@ endif endfunction + + +%!demo +%! theta = linspace (0, 2*pi, 1000); +%! rho = sin (7*theta); +%! polar (theta, rho); + +%!demo +%! theta = linspace (0, 10*pi, 1000); +%! rho = sin (5/4*theta); +%! polar (theta, rho); +
--- a/scripts/plot/print.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/print.m Sun Dec 11 23:24:25 2011 -0500 @@ -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",
--- a/scripts/plot/private/__axis_label__.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/private/__axis_label__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/private/__bar__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__file_filter__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- a/scripts/plot/private/__fltk_file_filter__.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/private/__fltk_file_filter__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__fltk_ginput__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,105 @@ +## Copyright (C) 2010-2011 Shai Ayal +## +## 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}, @var{y}, @var{buttons}] =} __fltk_ginput__ (@var{f}, @var{n}) +## Undocumented internal function. +## @end deftypefn + +## This is ginput.m implementation for fltk. + +## FIXME -- Key presses cannot toggle menu items nor hotkey functionality +## (grid, autoscale) during ginput! + +function [x, y, button] = __fltk_ginput__ (f, n = -1) + + if (isempty (get (f, "currentaxes"))) + error ("ginput: must have at least one axes"); + endif + + x = y = button = []; + ginput_aggregator (0, 0, 0, 0); + + unwind_protect + + orig_windowbuttondownfcn = get (f, "windowbuttondownfcn"); + set (f, "windowbuttondownfcn", @ginput_windowbuttondownfcn); + + orig_ginput_keypressfcn = get (f, "keypressfcn"); + set (f, "keypressfcn", @ginput_keypressfcn); + + while (true) + __fltk_redraw__ (); + + ## Release CPU. + sleep (0.01); + + [x, y, n0, button] = ginput_aggregator (-1, 0, 0, 0); + if (n0 == n || n0 < 0) + break; + endif + endwhile + + unwind_protect_cleanup + set (f, "windowbuttondownfcn", orig_windowbuttondownfcn); + set (f, "keypressfcn", orig_ginput_keypressfcn); + end_unwind_protect + +endfunction + +function [x, y, n, button] = ginput_aggregator (mode, xn, yn, btn) + persistent x y n button; + + if (mode == 0) + ## Initialize. + x = []; + y = []; + button = []; + n = 0; + elseif (mode == 1) + ## Accept mouse button or key press. + x = [x; xn]; + y = [y; yn]; + button = [button; btn]; + n += 1; + elseif (mode == 2) + ## The end due to Enter. + n = -1; + endif +endfunction + +function ginput_windowbuttondownfcn (src, data) + point = get (get (src,"currentaxes"), "currentpoint"); + ## FIXME -- How to get the actual mouse button pressed (1,2,3) into + ## "button"? + button = 1; + ginput_aggregator (1, point(1,1), point(2,1), button); +endfunction + +function ginput_keypressfcn (src, evt) + point = get (get (src, "currentaxes"), "currentpoint"); + ## FIXME -- use evt.Key or evt.Character? + key = evt.Key; + if (key == 10) + ## Enter key. + ginput_aggregator (2, point(1,1), point(2,1), key); + else + ginput_aggregator (1, point(1,1), point(2,1), key); + endif +endfunction +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__fltk_print__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,161 @@ +## Copyright (C) 2010-2011 Shai Ayal +## +## 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} {} __fltk_print__ (@var{@dots{}}) +## Undocumented internal function. +## @end deftypefn + +function opts = __fltk_print__ (opts) + + dos_shell = (ispc () && ! isunix ()); + + figure (opts.figure); + drawnow ("expose"); + __fltk_redraw__ (); + + if (! isempty (opts.fig2dev_binary)) + ## fig2dev is prefered for conversion to emf + fig2dev_devices = {"pstex", "mf", "emf"}; + else + fig2dev_devices = {"pstex", "mf"}; + endif + + gl2ps_device = {}; + pipeline = {}; + switch (lower (opts.devopt)) + case {"eps", "eps2", "epsc", "epsc2"} + ## format GL2PS_EPS + gl2ps_device = {"eps"}; + ## FIXME - use epstool to tighten bbox and provide preview. + pipeline = {opts.epstool_cmd(opts, "-", opts.name)}; + case {"epslatex", "pslatex", "pdflatex", "epslatexstandalone", ... + "pslatexstandalone", "pdflatexstandalone"} + ## format GL2PS_TEX + n = find (opts.devopt == "l", 1); + suffix = opts.devopt(1:n-1); + dot = find (opts.name == ".", 1, "last"); + if ((! isempty (dot)) + && any (strcmpi (opts.name(dot:end), ... + {".eps", ".ps", ".pdf", ".tex", "."}))) + name = opts.name(1:dot-1); + if (dot < numel (opts.name) + && any (strcmpi (opts.name(dot+1:end), {"eps", "ps", "pdf"}))) + ## If user provides eps/ps/pdf suffix, use it. + suffix = opts.name(dot+1:end); + endif + elseif (dot == numel (opts.name)) + name = opts.name; + endif + gl2ps_device = {sprintf("%snotxt", lower (suffix))}; + gl2ps_device{2} = "tex"; + if (dos_shell) + ## FIXME - this will only work on MinGW with the MSYS shell + pipeline = {sprintf("cat > %s-inc.%s", name, suffix)}; + pipeline{2} = sprintf ("cat > %s.tex", name); + else + pipeline = {sprintf("cat > %s-inc.%s", name, suffix)}; + pipeline{2} = sprintf ("cat > %s.tex", name); + endif + case "tikz" + ## format GL2PS_PGF + gl2ps_device = {"pgf"}; + pipeline = {sprintf("cat > %s", opts.name)}; + case "svg" + ## format GL2PS_SVG + gl2ps_device = {"svg"}; + pipeline = {sprintf("cat > %s", opts.name)}; + case fig2dev_devices + cmd_pstoedit = opts.pstoedit_cmd (opts, "fig"); + cmd_fig2dev = opts.fig2dev_cmd (opts, opts.devopt); + if (strcmp (opts.devopt, "pstex")) + [~, ~, ext] = fileparts (opts.name); + if (any (strcmpi (ext, {".ps", ".tex", "."}))) + opts.name = opts.name(1:end-numel(ext)); + endif + opts.name = strcat (opts.name, ".ps"); + cmd = sprintf ("%s | %s > %s", cmd_pstoedit, cmd_fig2dev, opts.name); + gl2ps_device = {"eps"}; + pipeline = {cmd}; + cmd_fig2dev = opts.fig2dev_cmd (opts, "pstex_t"); + gl2ps_device{2} = "eps"; + pipeline{2} = sprintf ("%s | %s > %s", cmd_pstoedit, + cmd_fig2dev, strrep(opts.name, ".ps", ".tex")); + else + cmd = sprintf ("%s | %s > %s", cmd_pstoedit, cmd_fig2dev, opts.name); + gl2ps_device = {"eps"}; + pipeline = {cmd}; + endif + case "aifm" + cmd = opts.pstoedit_cmd (opts, "ps2ai"); + gl2ps_device = {"eps"}; + pipeline = {sprintf("%s > %s", cmd, opts.name)}; + case {"dxf", "emf", "fig", "hpgl"} + cmd = opts.pstoedit_cmd (opts); + gl2ps_device = {"eps"}; + pipeline = {sprintf("%s > %s", cmd, opts.name)}; + case {"corel", "gif"} + error ("print:unsupporteddevice", + "print.m: %s output is not available for the FLTK graphics toolkit", + upper (opts.devopt)); + case opts.ghostscript.device + opts.ghostscript.source = "-"; + opts.ghostscript.output = opts.name; + if (opts.send_to_printer) + opts.unlink(strcmp (opts.unlink, opts.ghostscript.output)) = []; + opts.ghostscript.output = "-"; + endif + [cmd_gs, cmd_cleanup] = __ghostscript__ (opts.ghostscript); + if (opts.send_to_printer || isempty (opts.name)) + cmd_lpr = opts.lpr_cmd (opts); + cmd = sprintf("%s | %s", cmd_gs, cmd_lpr); + else + cmd = sprintf("%s", cmd_gs); + endif + if (! isempty (cmd_cleanup)) + gl2ps_device = {"eps"}; + if (dos_shell) + pipeline = {sprintf("%s & %s", cmd, cmd_cleanup)}; + else + pipeline = {sprintf("%s ; %s", cmd, cmd_cleanup)}; + endif + else + gl2ps_device = {"eps"}; + pipeline = {cmd}; + endif + otherwise + error (sprintf ("print:no%soutput", opts.devopt), + "print.m: %s output is not available for GL2PS output", + upper (opts.devopt)); + endswitch + + opts.pipeline = pipeline; + + for n = 1:numel(pipeline) + if (opts.debug) + fprintf ("fltk-pipeline: '%s'\n", pipeline{n}); + endif + drawnow (gl2ps_device{n}, strcat('|',pipeline{n})); + endfor + + if (! isempty (strfind (opts.devopt, "standalone"))) + opts.latex_standalone (opts); + endif + +endfunction +
--- a/scripts/plot/private/__ghostscript__.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/private/__ghostscript__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__gnuplot_get_var__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,161 @@ +## Copyright (C) 2009-2011 Ben Abbott +## +## 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{value} =} __gnuplot_get_var__ (@var{h}, @var{name}, @var{fmt}) +## Undocumented internal function. +## @end deftypefn + +## Author: Ben Abbott <bpabbott@mac.com> +## Created: 2009-02-07 + +function gp_var_value = __gnuplot_get_var__ (h, gp_var_name, fmt) + + if (nargin == 0) + h = gcf (); + endif + if (nargin < 2) + print_usage (); + endif + if (nargin < 3) + fmt = ''; + endif + + if (numel (h) == 1 && isfigure (h)) + if (isempty (get (gcf, "__plot_stream__"))) + ostream = __gnuplot_open_stream__ (2, h); + else + ostream = get (h, "__plot_stream__"); + endif + else + ostream = h; + endif + if (numel (ostream) < 1) + error ("__gnuplot_get_var__: stream to gnuplot not open"); + elseif (ispc ()) + if (numel (ostream) == 1) + error ("__gnuplot_get_var__: Need mkfifo that is not implemented under Windows"); + endif + use_mkfifo = false; + istream = ostream(2); + ostream = ostream(1); + else + use_mkfifo = true; + ostream = ostream(1); + endif + + if (use_mkfifo) + gpin_name = tmpnam (); + + ## Mode: 6*8*8 == 0600 + [err, msg] = mkfifo (gpin_name, 6*8*8); + + if (err != 0) + error ("__gnuplot_get_var__: Can not make fifo (%s)", msg); + endif + endif + + gp_var_name = strtrim (gp_var_name); + n = min (strfind (gp_var_name, " "), strfind (gp_var_name, ",")) - 1; + if (isempty (n)) + n = numel (gp_var_name); + endif + + unwind_protect + + ## Notes: Variables may be undefined if user closes gnuplot by "q" + ## or Alt-F4. Further, this abrupt close also requires the leading + ## "\n" on the next line. + if (use_mkfifo) + fprintf (ostream, "\nset print \"%s\";\n", gpin_name); + fflush (ostream); + [gpin, err] = fopen (gpin_name, "r"); + if (err != 0) + ## Try a second time, and then give an error. + [gpin, err] = fopen (gpin_name, "r"); + endif + if (err != 0) + error ("__gnuplot_get_var__: can not open fifo"); + endif + gp_cmd = sprintf ("\nif (exists(\"%s\")) print %s; else print NaN\n", + gp_var_name(1:n), gp_var_name); + fputs (ostream, gp_cmd); + + ## Close output file, to force it to be flushed + fputs (ostream, "set print;\n"); + fflush (ostream); + + ## Now read from fifo. + reading = true; + str = {}; + while (reading) + str{end+1} = fgets (gpin); + if (isnumeric (str{end}) && (str{end} == -1)) + reading = false; + str = str(1:(end-1)); + endif + endwhile + str = strcat (str{:}); + fclose (gpin); + else + ## Direct gnuplot to print to <STDOUT> + fprintf (ostream, "set print \"-\";\n"); + fflush (ostream); + gp_cmd = sprintf ("\nif (exists(\"%s\")) print \"OCTAVE: \", %s; else print NaN\n", + gp_var_name(1:n), gp_var_name); + fputs (ostream, gp_cmd); + fflush (ostream); + ## Direct gnuplot to print to <STDERR> + fputs (ostream, "set print;\n"); + fflush (ostream); + + str = {}; + while (isempty (str)) + str = char (fread (istream)'); + if (isempty (str)) + sleep (0.05); + else + str = regexp (str, 'OCTAVE:.*', "match"); + str = str{end}(8:end); + endif + fclear (istream); + endwhile + endif + + ## Strip out EOLs and the continuation character "|" + str(str=="\n") = ""; + str(str=="\r") = ""; + n_continue = strfind (str, " \\ "); + if (! isempty (n_continue)) + str(n_continue+1) = ""; + endif + + if (isempty (fmt)) + gp_var_value = strtrim (str); + else + gp_var_value = sscanf (str, fmt); + endif + + unwind_protect_cleanup + if (use_mkfifo) + unlink (gpin_name); + endif + end_unwind_protect + +endfunction +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__gnuplot_ginput__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,154 @@ +## Copyright (C) 2004-2011 Petr Mikulik +## +## 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}, @var{y}, @var{buttons}] =} __gnuplot_ginput__ (@var{f}, @var{n}) +## Undocumented internal function. +## @end deftypefn + +## This is ginput.m implementation for gnuplot and X11. +## It requires gnuplot 4.1 and later. + +## This file initially bore the copyright statement +## Petr Mikulik +## History: June 2006; August 2005; June 2004; April 2004 +## License: public domain + +function [x, y, button] = __gnuplot_ginput__ (f, n) + + ostream = get (f, "__plot_stream__"); + if (numel (ostream) < 1) + error ("ginput: stream to gnuplot not open"); + elseif (ispc ()) + if (numel (ostream) == 1) + error ("ginput: Need mkfifo that is not implemented under Windows"); + endif + use_mkfifo = false; + istream = ostream(2); + ostream = ostream(1); + else + use_mkfifo = true; + ostream = ostream(1); + endif + + if (compare_versions (__gnuplot_version__ (), "4.0", "<=")) + error ("ginput: version %s of gnuplot not supported", gnuplot_version ()); + endif + + if (nargin == 1) + x = zeros (100, 1); + y = zeros (100, 1); + button = zeros (100, 1); + else + x = zeros (n, 1); + y = zeros (n, 1); + button = zeros (n, 1); + endif + + if (use_mkfifo) + gpin_name = tmpnam (); + + ##Mode: 6*8*8 == 0600 + [err, msg] = mkfifo (gpin_name, 6*8*8); + + if (err != 0) + error ("ginput: Can not open fifo (%s)", msg); + endif + endif + + unwind_protect + + k = 0; + while (true) + k++; + + ## Notes: MOUSE_* can be undefined if user closes gnuplot by "q" + ## or Alt-F4. Further, this abrupt close also requires the leading + ## "\n" on the next line. + if (use_mkfifo) + fprintf (ostream, "set print \"%s\";\n", gpin_name); + fflush (ostream); + [gpin, err] = fopen (gpin_name, "r"); + if (err != 0) + error ("ginput: Can not open fifo (%s)", msg); + endif + fputs (ostream, "pause mouse any;\n\n"); + fputs (ostream, "\nif (exists(\"MOUSE_KEY\") && exists(\"MOUSE_X\")) print MOUSE_X, MOUSE_Y, MOUSE_KEY; else print \"0 0 -1\"\n"); + + ## Close output file, to force it to be flushed + fputs (ostream, "set print;\n"); + fflush (ostream); + + ## Now read from fifo. + [x(k), y(k), button(k), count] = fscanf (gpin, "%f %f %d", "C"); + fclose (gpin); + else + fprintf (ostream, "set print \"-\";\n"); + fflush (ostream); + fputs (ostream, "pause mouse any;\n\n"); + fputs (ostream, "\nif (exists(\"MOUSE_KEY\") && exists(\"MOUSE_X\")) print \"OCTAVE: \", MOUSE_X, MOUSE_Y, MOUSE_KEY; else print \"0 0 -1\"\n"); + + ## Close output file, to force it to be flushed + fputs (ostream, "set print;\n"); + fflush (ostream); + + str = {}; + while (isempty (str)) + str = char (fread (istream)'); + if (isempty (str)) + sleep (0.05); + else + str = regexp (str, 'OCTAVE:\s+[-+.\d]+\s+[-+.\d]+\s+\d*', 'match'); + endif + fclear (istream); + endwhile + [x(k), y(k), button(k), count] = sscanf (str{end}(8:end), "%f %f %d", "C"); + endif + + if ([x(k), y(k), button(k)] == [0, 0, -1]) + ## Mousing not active (no plot yet). + break; + endif + + if (nargin > 1) + ## Input argument n was given => stop when k == n. + if (k == n) + break; + endif + else + ## Input argument n not given => stop when hitting a return key. + ## if (button(k) == 0x0D || button(k) == 0x0A) + ## ## hit Return or Enter + if (button(k) == 0x0D) + ## hit Return + x(k:end) = []; + y(k:end) = []; + button(k:end) = []; + break; + endif + endif + endwhile + + unwind_protect_cleanup + if (use_mkfifo) + unlink (gpin_name); + endif + end_unwind_protect + +endfunction +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__gnuplot_has_feature__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,61 @@ +## Copyright (C) 2009-2011 Ben Abbott +## +## 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{has_feature} =} __gnuplot_has_feature__ (@var{feature}) +## Undocumented internal function. +## @end deftypefn + +## Author: Ben Abbott <bpabbott@mac.com> +## Created: 2009-01-27 + +function res = __gnuplot_has_feature__ (feature) + persistent features has_features + features = {"x11_figure_position", + "wxt_figure_size", + "transparent_patches", + "transparent_surface", + "epslatex_implies_eps_filesuffix", + "epslatexstandalone_terminal", + "screen_coordinates_for_{lrtb}margin", + "variable_GPVAL_TERMINALS", + "key_has_font_properties"}; + + if (isempty (has_features)) + try + gnuplot_version = __gnuplot_version__ (); + catch + ## Don't throw an error if gnuplot isn't installed + gnuplot_version = "0.0.0"; + end_try_catch + versions = {"4.2.5", "4.4", "4.4", "4.4", "4.2", "4.2", "4.4", "4.4", "4.4"}; + operators = {">=", ">=", ">=", ">=", ">=", ">=", ">=", ">=", ">="}; + have_features = logical (zeros (size (features))); + for n = 1 : numel (have_features) + has_features(n) = compare_versions (gnuplot_version, versions{n}, operators{n}); + endfor + endif + + n = find (strcmpi (feature, features)); + if (isempty (n)) + res = NaN; + else + res = has_features(n); + endif +endfunction +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__gnuplot_open_stream__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,45 @@ +## Copyright (C) 2009-2011 Ben Abbott +## +## 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{stream} =} __gnuplot_open_stream__ (@var{npipes}, @var{h}) +## Undocumented internal function. +## @end deftypefn + +## Author: Ben Abbott <bpabbott@mac.com> +## Created: 2009-04-11 + +function plot_stream = __gnuplot_open_stream__ (npipes, h) + [prog, args] = gnuplot_binary (); + if (npipes > 1) + [plot_stream(1), plot_stream(2), pid] = popen2 (prog, args{:}); + if (pid < 0) + error ("__gnuplot_open_stream__: failed to open connection to gnuplot"); + else + plot_stream(3) = pid; + endif + else + plot_stream = popen (sprintf ("%s ", prog, args{:}), "w"); + if (plot_stream < 0) + error ("__gnuplot_open_stream__: failed to open connection to gnuplot"); + endif + endif + if (nargin > 1) + set (h, "__plot_stream__", plot_stream); + endif +endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__gnuplot_print__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,300 @@ +## Copyright (C) 1999-2011 Daniel Heiserer +## Copyright (C) 2001 Laurent Mazet +## +## 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} {} __gnuplot_print__ (@var{@dots{}}) +## Undocumented internal function. +## @end deftypefn + +## Author: Daniel Heiserer <Daniel.heiserer@physik.tu-muenchen.de> +## Adapted-By: jwe + +function opts = __gnuplot_print__ (opts) + + dos_shell = (ispc () && ! isunix ()); + + if (isempty (opts.fontsize)) + ## If no fontsize, determine the nominal axes fontsize. + defaultfontsize = get (0, "defaultaxesfontsize"); + axesfontsize = get (findobj (opts.figure, "type", "axes"), "fontsize"); + if (iscell (axesfontsize)) + axesfontsize = round (median (cell2mat (axesfontsize))); + endif + if (isempty (axesfontsize)) + opts.fontsize = defaultfontsize; + else + opts.fontsize = axesfontsize; + endif + endif + ## The axes-label and tick-label spacing is determined by + ## the font spec given in "set terminal ..." + gp_opts = font_spec (opts); + + pipeline = ""; + + switch (lower (opts.devopt)) + case {"eps", "eps2", "epsc", "epsc2"} + if (any (strcmp (opts.devopt, {"eps", "epsc"}))) + gp_opts = sprintf ("%s level1", gp_opts); + endif + if (opts.tight_flag || ! isempty (opts.preview)) + tmp_file = strcat (tmpnam (), ".eps"); + eps_drawnow (opts, tmp_file, gp_opts); + if (dos_shell) + cleanup = sprintf (" & del %s", strrep (tmp_file, '/', '\')); + else + cleanup = sprintf (" ; rm %s", tmp_file); + endif + pipeline = {sprintf("%s %s", + opts.epstool_cmd (opts, tmp_file, opts.name), + cleanup)}; + else + eps_drawnow (opts, opts.name, gp_opts); + endif + case {"epslatex", "pslatex", "pstex", "epslatexstandalone"} + dot = find (opts.name == ".", 1, "last"); + if ((! isempty (dot)) + && any (strcmpi (opts.name(dot:end), + {".eps", ".ps", ".pdf", ".tex", "."}))) + name = opts.name(1:dot-1); + endif + if (strfind (opts.devopt, "standalone")) + term = sprintf ("%s ", + strrep (opts.devopt, "standalone", " standalone")); + else + term = sprintf ("%s ", opts.devopt); + endif + if (__gnuplot_has_feature__ ("epslatex_implies_eps_filesuffix")) + suffix = "tex"; + else + %% Gnuplot 4.0 wants a ".eps" suffix. + suffix = "eps"; + endif + local_drawnow (sprintf ("%s %s", term, gp_opts), + strcat (name, ".", suffix), opts); + case "tikz" + if (__gnuplot_has_terminal__ ("tikz")) + local_drawnow (sprintf ("lua tikz %s", gp_opts), opts.name, opts); + else + error (sprintf ("print:no%soutput", opts.devopt), + "print.m: '%s' output is not available for gnuplot-%s", + upper (opts.devopt), __gnuplot_version__ ()); + endif + case "svg" + local_drawnow (sprintf ("svg dynamic %s", gp_opts), opts.name, opts); + case {"aifm", "corel", "eepic", "emf", "fig"} + local_drawnow (sprintf ("%s %s", opts.devopt, gp_opts), opts.name, opts); + case {"pdfcairo", "pngcairo"} + if (__gnuplot_has_terminal__ (opts.devopt)) + local_drawnow (sprintf ("%s %s", opts.devopt, gp_opts), opts.name, opts); + else + error (sprintf ("print:no%soutput", opts.devopt), + "print.m: '%s' output is not available for gnuplot-%s", + upper (opts.devopt), __gnuplot_version__ ()); + endif + case {"canvas", "dxf", "hpgl", "mf", "gif", "pstricks", "texdraw"} + local_drawnow (sprintf ("%s %s", opts.devopt, gp_opts), opts.name, opts); + case opts.ghostscript.device + gp_opts = font_spec (opts, "devopt", "eps"); + opts.ghostscript.output = opts.name; + opts.ghostscript.source = strcat (tmpnam (), ".eps"); + eps_drawnow (opts, opts.ghostscript.source, gp_opts); + [cmd_gs, cmd_cleanup] = __ghostscript__ (opts.ghostscript); + if (opts.send_to_printer || isempty (opts.name)) + cmd_lpr = opts.lpr_cmd (opts); + cmd = sprintf ("%s | %s", cmd_gs, cmd_lpr); + else + cmd = sprintf ("%s", cmd_gs); + endif + if (dos_shell) + cmd = sprintf ("%s & del %s", cmd, strrep (opts.ghostscript.source, '/', '\')); + else + cmd = sprintf ("%s ; rm %s", cmd, opts.ghostscript.source); + endif + if (! isempty (cmd_cleanup)) + if (dos_shell) + pipeline = {sprintf("%s & %s", cmd, cmd_cleanup)}; + else + pipeline = {sprintf("%s ; %s", cmd, cmd_cleanup)}; + endif + else + pipeline = {cmd}; + endif + otherwise + error (sprintf ("print:no%soutput", opts.devopt), + "print.m: %s output is not available for the Gnuplot graphics toolkit", + upper (opts.devopt)); + endswitch + + + opts.pipeline = pipeline; + + for n = 1:numel(pipeline) + if (opts.debug) + fprintf ("gnuplot-pipeline: '%s'\n", pipeline{n}); + endif + [status, output] = system (pipeline{n}); + if (status) + fprintf ("%s\n%s\n%s\n", + "---------- output begin ----------", + output, + "----------- output end -----------"); + error ("gnuplot:failedpipe", "print: failed to print"); + endif + endfor + +endfunction + +function eps_drawnow (opts, epsfile, gp_opts) + [h, fontsize] = get_figure_text_objs (opts); + unwind_protect + for n = 1:numel(h) + set (h(n), "fontsize", 2 * fontsize{n}); + endfor + local_drawnow (sprintf ("postscript eps %s", gp_opts), epsfile, opts); + unwind_protect_cleanup + for n = 1:numel(h) + set (h(n), "fontsize", fontsize{n}); + endfor + end_unwind_protect +endfunction + +function local_drawnow (term, file, opts) + if (opts.use_color < 0) + mono = true; + else + mono = false; + endif + figure (opts.figure); + if (isempty (opts.debug_file) || ! opts.debug) + drawnow (term, file, mono); + else + drawnow (term, file, mono, opts.debug_file); + endif +endfunction + +function f = font_spec (opts, varargin) + for n = 1:2:numel(varargin) + opts.(varargin{n}) = varargin{n+1}; + endfor + f = ""; + switch (opts.devopt) + case "cgm" + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("font ""%s,%d""", opts.font, opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("font ""%s""", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("%d", opts.fontsize); + endif + case {"eps", "eps2", "epsc", "epsc2"} + ## Gnuplot renders fonts as half their specification, which + ## results in a tight spacing for the axes-labels and tick-labels. + ## Compensate for the half scale. This will produce the proper + ## spacing for the requested fontsize. + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("font ""%s,%d""", opts.font, 2 * opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("font ""%s""", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("%d", 2 * opts.fontsize); + endif + case "svg" + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + fontsize = round (opts.fontsize * 0.75); + f = sprintf ("fname ""%s"" fsize %d", opts.font, fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("fname ""%s""", opts.font); + elseif (! isempty (opts.fontsize)) + fontsize = round (opts.fontsize * 0.75); + f = sprintf ("%s fsize %d", f, fontsize); + endif + case "pdf" + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("font ""%s,%d""", opts.font, opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("font ""%s""", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("fsize %d", f, opts.fontsize); + endif + case {"pdfcairo", "pngcairo"} + if (! isempty (opts.font)) + f = sprintf ("font ""%s""", opts.font); + endif + case {"epslatex", "epslatexstandalone"} + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("font ""%s,%d""", opts.font, opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("font ""%s""", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("%d", opts.fontsize); + endif + case "pslatex" + if (! isempty (opts.fontsize)) + f = sprintf ("%d", opts.fontsize); + endif + case {"gif", "jpeg", "png"} + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("font ""%s ,%d""", opts.font, opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("font ""%s""", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("font ""%d""", opts.fontsize); + endif + case "emf" + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("""%s"" %d", opts.font, opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("""%s""", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("%d", opts.fontsize); + endif + case "canvas" + if (! isempty (opts.fontsize)) + f = sprintf ("fsize %d", opts.fontsize); + endif + case {"aifm", "corel"} + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("%s %d", opts.font, opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("%s", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("%d", opts.fontsize); + endif + case "fig" + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("font %s fontsize %d", opts.font, opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("font %s", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("fontsize %d", opts.fontsize); + endif + endswitch +endfunction + +function [h, fontsize] = get_figure_text_objs (opts) + h = findall (opts.figure, "-property", "fontsize"); + fontsize = get (h, "fontsize"); + switch (numel (fontsize)) + case 0 + fontsize = {}; + case 1 + fontsize = {fontsize}; + endswitch +endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__gnuplot_version__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,51 @@ +## Copyright (C) 2006-2011 Daniel Sebald +## +## 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{version} =} __gnuplot_version__ () +## Undocumented internal function. +## @end deftypefn + +## Return the version of gnuplot we are using. Note that we do not +## attempt to handle the case of the user switching to different +## versions of gnuplot during the same session. + +function version = __gnuplot_version__ () + + persistent __version__ = ""; + + if (isempty (__version__)) + [status, output] = system (sprintf ("\"%s\" --version", gnuplot_binary ())); + if (status != 0) + ## This message ends in a newline so that the traceback messages + ## are skipped and people might actually see the message, read it, + ## comprehend it, actually take the advice it gives, and stop + ## asking us why plotting fails when gnuplot is not found. + error ("you must have gnuplot installed to display graphics; if you have gnuplot installed in a non-standard location, see the 'gnuplot_binary' function\n"); + endif + output = strrep (output, "gnuplot", ""); + output = strrep (output, "patchlevel", "."); + output = strrep (output, "\n", ""); + output = strrep (output, "\r", ""); + __version__ = strrep (output, " ", ""); + endif + + version = __version__; + +endfunction +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__go_draw_axes__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,2649 @@ +## Copyright (C) 2005-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_draw_axes__ (@var{h}, @var{plot_stream}, @var{enhanced}, @var{mono}) +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function __go_draw_axes__ (h, plot_stream, enhanced, mono, + bg_is_set, fg_is_set, hlgnd) + + if (nargin >= 4 && nargin <= 7) + + showhiddenhandles = get (0, "showhiddenhandles"); + unwind_protect + set (0, "showhiddenhandles", "on"); + axis_obj = __get__ (h); + unwind_protect_cleanup + set (0, "showhiddenhandles", showhiddenhandles); + end_unwind_protect + + parent_figure_obj = get (axis_obj.parent); + gnuplot_term = __gnuplot_get_var__ (axis_obj.parent, "GPVAL_TERM"); + + ## Set to false for plotyy axes. + 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); + + if (strcmp (axis_obj.dataaspectratiomode, "manual") + && strcmp (axis_obj.xlimmode, "manual") + && strcmp (axis_obj.ylimmode, "manual")) + ## All can't be "manual" + axis_obj.plotboxaspectratiomode = "auto"; + endif + + if (strcmp (axis_obj.dataaspectratiomode, "manual") + && strcmp (axis_obj.xlimmode, "manual") + && strcmp (axis_obj.ylimmode, "manual") + && (nd == 2 || all (mod (axis_obj.view, 90) == 0))) + ## FIXME - adjust plotboxaspectratio to respect other + fpos = get (axis_obj.parent, "position"); + apos = axis_obj.position; + endif + + pos = __actual_axis_position__ (h); + + if (strcmpi (axis_obj.dataaspectratiomode, "manual")) + dr = axis_obj.dataaspectratio; + if (nd == 2 || all (mod (axis_obj.view, 90) == 0)) + dr = dr(1) / dr(2); + else + ## FIXME - need to properly implement 3D + dr = mean (dr(1:2)) / dr(3); + endif + else + dr = 1; + endif + + if (strcmp (axis_obj.activepositionproperty, "position")) + if (__gnuplot_has_feature__ ("screen_coordinates_for_{lrtb}margin")) + if (nd == 2 || all (mod (axis_obj.view, 90) == 0)) + x = [1, 1]; + else + ## 3D plots need to be sized down to fit in the window. + x = 1.0 ./ sqrt([2, 2.5]); + endif + fprintf (plot_stream, "set tmargin screen %.15g;\n", + pos(2)+pos(4)/2+x(2)*pos(4)/2); + fprintf (plot_stream, "set bmargin screen %.15g;\n", + pos(2)+pos(4)/2-x(2)*pos(4)/2); + fprintf (plot_stream, "set lmargin screen %.15g;\n", + pos(1)+pos(3)/2-x(1)*pos(3)/2); + fprintf (plot_stream, "set rmargin screen %.15g;\n", + pos(1)+pos(3)/2+x(1)*pos(3)/2); + sz_str = ""; + else + fprintf (plot_stream, "set tmargin 0;\n"); + fprintf (plot_stream, "set bmargin 0;\n"); + fprintf (plot_stream, "set lmargin 0;\n"); + fprintf (plot_stream, "set rmargin 0;\n"); + + if (nd == 3 && all (axis_obj.view == [0, 90])) + ## FIXME -- Kludge to allow colorbar to be added to a pcolor() plot + pos(3:4) = pos(3:4) * 1.4; + pos(1:2) = pos(1:2) - pos(3:4) * 0.125; + endif + + fprintf (plot_stream, "set origin %.15g, %.15g;\n", pos(1), pos(2)); + + if (strcmpi (axis_obj.dataaspectratiomode, "manual")) + sz_str = sprintf ("set size ratio %.15g", -dr); + else + sz_str = "set size noratio"; + endif + sz_str = sprintf ("%s %.15g, %.15g;\n", sz_str, pos(3), pos(4)); + endif + else ## activepositionproperty == outerposition + fprintf (plot_stream, "unset tmargin;\n"); + fprintf (plot_stream, "unset bmargin;\n"); + fprintf (plot_stream, "unset lmargin;\n"); + fprintf (plot_stream, "unset rmargin;\n"); + fprintf (plot_stream, "set origin %g, %g;\n", pos(1:2)); + sz_str = ""; + if (strcmpi (axis_obj.dataaspectratiomode, "manual")) + sz_str = sprintf ("ratio %g", -dr); + else + sz_str = "noratio"; + endif + sz_str = sprintf ("set size %s %g, %g;\n", sz_str, pos(3:4)); + endif + if (! isempty (sz_str)) + fputs (plot_stream, sz_str); + endif + + ## Reset all labels, axis-labels, tick-labels, and title + ## FIXME - We should have an function to initialize the axis. + ## Presently, this is dispersed in this function. + fputs (plot_stream, "unset label;\n"); + fputs (plot_stream, "unset xtics;\n"); + fputs (plot_stream, "unset ytics;\n"); + fputs (plot_stream, "unset ztics;\n"); + fputs (plot_stream, "unset x2tics;\n"); + fputs (plot_stream, "unset x2tics;\n"); + + if (! isempty (axis_obj.title)) + t = get (axis_obj.title); + if (isempty (t.string)) + fputs (plot_stream, "unset title;\n"); + else + [tt, f, s] = __maybe_munge_text__ (enhanced, t, "string"); + fontspec = create_fontspec (f, s, gnuplot_term); + fprintf (plot_stream, "set title \"%s\" %s %s;\n", + undo_string_escapes (tt), fontspec, + __do_enhanced_option__ (enhanced, t)); + endif + endif + + if (! isempty (axis_obj.xlabel)) + t = get (axis_obj.xlabel); + angle = t.rotation; + colorspec = get_text_colorspec (axis_obj.xcolor, mono); + if (isempty (t.string)) + fprintf (plot_stream, "unset xlabel;\n"); + fprintf (plot_stream, "unset x2label;\n"); + else + [tt, f, s] = __maybe_munge_text__ (enhanced, t, "string"); + fontspec = create_fontspec (f, s, gnuplot_term); + if (strcmpi (axis_obj.xaxislocation, "top")) + fprintf (plot_stream, "set x2label \"%s\" %s %s %s", + undo_string_escapes (tt), colorspec, fontspec, + __do_enhanced_option__ (enhanced, t)); + else + fprintf (plot_stream, "set xlabel \"%s\" %s %s %s", + undo_string_escapes (tt), colorspec, fontspec, + __do_enhanced_option__ (enhanced, t)); + endif + fprintf (plot_stream, " rotate by %f;\n", angle); + if (strcmpi (axis_obj.xaxislocation, "top")) + fprintf (plot_stream, "unset xlabel;\n"); + else + fprintf (plot_stream, "unset x2label;\n"); + endif + endif + endif + + if (! isempty (axis_obj.ylabel)) + t = get (axis_obj.ylabel); + angle = t.rotation; + colorspec = get_text_colorspec (axis_obj.ycolor, mono); + if (isempty (t.string)) + fprintf (plot_stream, "unset ylabel;\n"); + fprintf (plot_stream, "unset y2label;\n"); + else + [tt, f, s] = __maybe_munge_text__ (enhanced, t, "string"); + fontspec = create_fontspec (f, s, gnuplot_term); + if (strcmpi (axis_obj.yaxislocation, "right")) + fprintf (plot_stream, "set y2label \"%s\" %s %s %s", + undo_string_escapes (tt), colorspec, fontspec, + __do_enhanced_option__ (enhanced, t)); + else + fprintf (plot_stream, "set ylabel \"%s\" %s %s %s", + undo_string_escapes (tt), colorspec, fontspec, + __do_enhanced_option__ (enhanced, t)); + endif + fprintf (plot_stream, " rotate by %f;\n", angle); + if (strcmpi (axis_obj.yaxislocation, "right")) + fprintf (plot_stream, "unset ylabel;\n"); + else + fprintf (plot_stream, "unset y2label;\n"); + endif + endif + endif + + if (! isempty (axis_obj.zlabel)) + t = get (axis_obj.zlabel); + angle = t.rotation; + colorspec = get_text_colorspec (axis_obj.zcolor, mono); + if (isempty (t.string)) + fputs (plot_stream, "unset zlabel;\n"); + else + [tt, f, s] = __maybe_munge_text__ (enhanced, t, "string"); + fontspec = create_fontspec (f, s, gnuplot_term); + fprintf (plot_stream, "set zlabel \"%s\" %s %s %s", + undo_string_escapes (tt), colorspec, fontspec, + __do_enhanced_option__ (enhanced, t)); + fprintf (plot_stream, " rotate by %f;\n", angle); + endif + endif + + if (strcmpi (axis_obj.xaxislocation, "top")) + xaxisloc = "x2"; + xaxisloc_using = "x2"; + else + xaxisloc = "x"; + xaxisloc_using = "x1"; + if (strcmpi (axis_obj.xaxislocation, "zero")) + fputs (plot_stream, "set xzeroaxis;\n"); + endif + endif + if (strcmpi (axis_obj.yaxislocation, "right")) + yaxisloc = "y2"; + yaxisloc_using = "y2"; + else + yaxisloc = "y"; + yaxisloc_using = "y1"; + if (strcmpi (axis_obj.yaxislocation, "zero")) + fputs (plot_stream, "set yzeroaxis;\n"); + endif + endif + + have_grid = false; + + if (strcmpi (axis_obj.xgrid, "on")) + have_grid = true; + fprintf (plot_stream, "set grid %stics;\n", xaxisloc); + else + fprintf (plot_stream, "set grid no%stics;\n", xaxisloc); + endif + + if (strcmpi (axis_obj.ygrid, "on")) + have_grid = true; + fprintf (plot_stream, "set grid %stics;\n", yaxisloc); + else + fprintf (plot_stream, "set grid no%stics;\n", yaxisloc); + endif + + if (strcmpi (axis_obj.zgrid, "on")) + have_grid = true; + fputs (plot_stream, "set grid ztics;\n"); + else + fputs (plot_stream, "set grid noztics;\n"); + endif + + if (strcmpi (axis_obj.xminorgrid, "on")) + have_grid = true; + if (strcmp (axis_obj.xscale, "log")) + m = 10; + else + m = 5; + endif + fprintf (plot_stream, "set m%stics %d;\n", xaxisloc, m); + fprintf (plot_stream, "set grid m%stics;\n", xaxisloc); + else + fprintf (plot_stream, "set grid nom%stics;\n", xaxisloc); + endif + + if (strcmpi (axis_obj.yminorgrid, "on")) + have_grid = true; + if (strcmp (axis_obj.yscale, "log")) + m = 10; + else + m = 5; + endif + fprintf (plot_stream, "set m%stics %d;\n", yaxisloc, m); + fprintf (plot_stream, "set grid m%stics;\n", yaxisloc); + else + fprintf (plot_stream, "set grid nom%stics;\n", yaxisloc); + endif + + if (strcmpi (axis_obj.zminorgrid, "on")) + have_grid = true; + if (strcmp (axis_obj.zscale, "log")) + m = 10; + else + m = 5; + endif + fprintf (plot_stream, "set mztics %d;\n", m); + fputs (plot_stream, "set grid mztics;\n"); + else + fputs (plot_stream, "set grid nomztics;\n"); + endif + + ## The grid front/back/layerdefault option also controls the + ## appearance of tics, so it is used even if the grid is absent. + if (strcmpi (axis_obj.layer, "top")) + fputs (plot_stream, "set grid front;\n"); + fputs (plot_stream, "set border front;\n"); + else + fputs (plot_stream, "set grid layerdefault;\n"); + ## FIXME -- the gnuplot help says that "layerdefault" should work + ## for set border too, but it fails for me with gnuplot 4.2.5. So + ## use "back" instead. + fputs (plot_stream, "set border back;\n"); + endif + + fprintf (plot_stream, "set grid linewidth %f, linewidth %f;\n", + axis_obj.linewidth, axis_obj.linewidth); + + if (! have_grid) + 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"); + if (xlogscale) + fprintf (plot_stream, "set logscale %s;\n", xaxisloc); + endif + if (ylogscale) + fprintf (plot_stream, "set logscale %s;\n", yaxisloc); + endif + if (zlogscale) + fputs (plot_stream, "set logscale z;\n"); + endif + + xautoscale = strcmpi (axis_obj.xlimmode, "auto"); + yautoscale = strcmpi (axis_obj.ylimmode, "auto"); + zautoscale = strcmpi (axis_obj.zlimmode, "auto"); + cautoscale = strcmpi (axis_obj.climmode, "auto"); + cdatadirect = false; + truecolor = false; + + fputs (plot_stream, "set clip two;\n"); + + kids = axis_obj.children; + ## Remove the axis labels and title from the children, and + ## preserved the original order. + [jnk, k] = setdiff (kids, [axis_obj.xlabel; axis_obj.ylabel; ... + axis_obj.zlabel; axis_obj.title]); + kids = kids (sort (k)); + + if (nd == 3) + fputs (plot_stream, "set parametric;\n"); + fputs (plot_stream, "set style data lines;\n"); + fputs (plot_stream, "set surface;\n"); + fputs (plot_stream, "unset contour;\n"); + endif + + data_idx = 0; + data = cell (); + is_image_data = []; + hidden_removal = NaN; + view_map = false; + + if (! cautoscale && clim(1) == clim(2)) + clim(2)++; + endif + addedcmap = []; + + ximg_data = {}; + ximg_data_idx = 0; + + while (! isempty (kids)) + + obj = get (kids(end)); + + if (isfield (obj, "units")) + units = obj.units; + unwind_protect + set (kids(end), "units", "data"); + obj = get (kids(end)); + unwind_protect_cleanup + set (kids(end), "units", units); + end_unwind_protect + endif + kids = kids(1:(end-1)); + + if (strcmpi (obj.visible, "off")) + continue; + 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 + + ## Check for facecolor interpolation for surfaces. + doing_interp_color = ... + isfield (obj, "facecolor") && strncmp (obj.facecolor, "interp", 6); + + switch (obj.type) + case "image" + img_data = obj.cdata; + img_xdata = obj.xdata; + img_ydata = obj.ydata; + + if (ndims (img_data) == 3) + truecolor = true; + elseif (strcmpi (obj.cdatamapping, "direct")) + cdatadirect = true; + endif + data_idx++; + is_image_data(data_idx) = true; + parametric(data_idx) = false; + have_cdata(data_idx) = false; + have_3d_patch(data_idx) = false; + + if (img_xdata(2) < img_xdata(1)) + img_xdata = img_xdata(2:-1:1); + img_data = img_data(:,end:-1:1,:); + elseif (img_xdata(1) == img_xdata(2)) + img_xdata = img_xdata(1) + [0, size(img_data,2)-1]; + endif + if (img_ydata(2) < img_ydata(1)) + img_ydata = img_ydata(2:-1:1); + img_data = img_data(end:-1:1,:,:); + elseif (img_ydata(1) == img_ydata(2)) + img_ydata = img_ydata(1) + [0, size(img_data,1)-1]; + endif + + [y_dim, x_dim] = size (img_data(:,:,1)); + if (x_dim > 1) + dx = abs (img_xdata(2)-img_xdata(1))/(x_dim-1); + else + x_dim = 2; + img_data = [img_data, img_data]; + dx = abs (img_xdata(2)-img_xdata(1)); + endif + if (y_dim > 1) + dy = abs (img_ydata(2)-img_ydata(1))/(y_dim-1); + else + y_dim = 2; + img_data = [img_data; img_data]; + dy = abs (img_ydata(2)-img_ydata(1)); + endif + + x_origin = min (img_xdata); + y_origin = min (img_ydata); + + if (ndims (img_data) == 3) + data{data_idx} = permute (img_data, [3, 1, 2])(:); + format = "1:2:3"; + imagetype = "rgbimage"; + else + data{data_idx} = img_data(:); + format = "1"; + imagetype = "image"; + endif + + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = sprintf ("binary array=%dx%d scan=yx origin=(%.15g,%.15g) dx=%.15g dy=%.15g using %s", + x_dim, y_dim, x_origin, y_origin, dx, dy, format); + withclause{data_idx} = sprintf ("with %s;", imagetype); + + case "line" + if (strncmp (obj.linestyle, "none", 4) + && (! isfield (obj, "marker") + || (isfield (obj, "marker") + && strncmp (obj.marker, "none", 4)))) + continue; + endif + data_idx++; + is_image_data(data_idx) = false; + parametric(data_idx) = true; + have_cdata(data_idx) = false; + have_3d_patch(data_idx) = false; + if (isempty (obj.displayname)) + titlespec{data_idx} = "title \"\""; + else + tmp = undo_string_escapes (__maybe_munge_text__ (enhanced, obj, "displayname")); + titlespec{data_idx} = cstrcat ("title \"", tmp, "\""); + endif + usingclause{data_idx} = sprintf ("record=%d", numel (obj.xdata)); + errbars = ""; + if (nd == 3) + xdat = obj.xdata(:); + ydat = obj.ydata(:); + if (! isempty (obj.zdata)) + zdat = obj.zdata(:); + else + zdat = zeros (size (xdat)); + endif + data{data_idx} = [xdat, ydat, zdat]'; + usingclause{data_idx} = sprintf ("record=%d using ($1):($2):($3)", numel (xdat)); + ## fputs (plot_stream, "set parametric;\n"); + else + xdat = obj.xdata(:); + ydat = obj.ydata(:); + data{data_idx} = [xdat, ydat]'; + usingclause{data_idx} = sprintf ("record=%d using ($1):($2) axes %s%s", + rows(xdat), xaxisloc_using, yaxisloc_using); + endif + + style = do_linestyle_command (obj, obj.color, data_idx, mono, + plot_stream, errbars); + + withclause{data_idx} = sprintf ("with %s linestyle %d", + style{1}, data_idx); + + if (length (style) > 1) + data_idx++; + is_image_data(data_idx) = is_image_data(data_idx - 1); + parametric(data_idx) = parametric(data_idx - 1); + have_cdata(data_idx) = have_cdata(data_idx - 1); + have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = usingclause{data_idx - 1}; + data{data_idx} = data{data_idx - 1}; + withclause{data_idx} = sprintf ("with %s linestyle %d", + style{2}, data_idx); + endif + if (length (style) > 2) + data_idx++; + is_image_data(data_idx) = is_image_data(data_idx - 1); + parametric(data_idx) = parametric(data_idx - 1); + have_cdata(data_idx) = have_cdata(data_idx - 1); + have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = usingclause{data_idx - 1}; + data{data_idx} = data{data_idx - 1}; + withclause{data_idx} = sprintf ("with %s linestyle %d", + style{3}, data_idx); + endif + + case "patch" + cmap = parent_figure_obj.colormap; + [nr, nc] = size (obj.xdata); + + if (! isempty (obj.cdata)) + cdat = obj.cdata; + if (strcmpi (obj.cdatamapping, "direct")) + cdatadirect = true; + endif + else + cdat = []; + endif + + data_3d_idx = NaN; + for i = 1:nc + xcol = obj.xdata(:,i); + ycol = obj.ydata(:,i); + if (nd == 3) + if (! isempty (obj.zdata)) + zcol = obj.zdata(:,i); + else + zcol = zeros (size (xcol)); + endif + endif + + if (! isnan (xcol) && ! isnan (ycol)) + ## Is the patch closed or not + if (strncmp (obj.facecolor, "none", 4)) + hidden_removal = false; + else + + if (isnan (hidden_removal)) + hidden_removal = true; + endif + if (nd == 3) + if (numel (xcol) > 3) + error ("__go_draw_axes__: gnuplot (as of v4.2) only supports 3D filled triangular patches"); + else + if (isnan (data_3d_idx)) + data_idx++; + data_3d_idx = data_idx; + is_image_data(data_idx) = false; + parametric(data_idx) = false; + have_cdata(data_idx) = true; + have_3d_patch(data_idx) = true; + withclause{data_3d_idx} = sprintf ("with pm3d"); + usingclause{data_3d_idx} = "using 1:2:3:4"; + data{data_3d_idx} = []; + endif + local_idx = data_3d_idx; + ccdat = NaN; + endif + else + data_idx++; + local_idx = data_idx; + is_image_data(data_idx) = false; + parametric(data_idx) = false; + have_cdata(data_idx) = false; + have_3d_patch(data_idx) = false; + endif + + if (i > 1 || isempty (obj.displayname)) + titlespec{local_idx} = "title \"\""; + else + tmp = undo_string_escapes (__maybe_munge_text__ (enhanced, obj, "displayname")); + titlespec{local_idx} = cstrcat ("title \"", tmp, "\""); + endif + if (isfield (obj, "facecolor")) + if ((strncmp (obj.facecolor, "flat", 4) + || strncmp (obj.facecolor, "interp", 6)) + && isfield (obj, "cdata")) + if (ndims (obj.cdata) == 2 + && (size (obj.cdata, 2) == nc + && (size (obj.cdata, 1) == 1 + || size (obj.cdata, 1) == 3))) + ccol = cdat (:, i); + elseif (ndims (obj.cdata) == 2 + && (size (obj.cdata, 1) == nc + && (size (obj.cdata, 2) == 1 + || size (obj.cdata, 2) == 3))) + ccol = cdat (i, :); + elseif (ndims (obj.cdata) == 3) + ccol = permute (cdat (:, i, :), [1, 3, 2]); + else + ccol = cdat; + endif + if (strncmp (obj.facecolor, "flat", 4)) + if (numel(ccol) == 3) + color = ccol; + elseif (nd == 3 && numel (xcol) == 3) + ccdat = ccol * ones (3,1); + else + 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 + elseif (strncmp (obj.facecolor, "interp", 6)) + if (nd == 3 && numel (xcol) == 3) + ccdat = ccol; + if (! isvector (ccdat)) + tmp = rows(cmap) + rows(addedcmap) + ... + [1 : rows(ccdat)]; + addedcmap = [addedcmap; ccdat]; + ccdat = tmp(:); + else + ccdat = ccdat(:); + endif + else + 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(1),:); + endif + endif + elseif (isnumeric (obj.facecolor)) + color = obj.facecolor; + else + color = [0, 1, 0]; + endif + else + color = [0, 1, 0]; + endif + + if (nd == 3 && numel (xcol) == 3) + if (isnan (ccdat)) + ccdat = (rows (cmap) + rows(addedcmap) + 1) * ones(3, 1); + addedcmap = [addedcmap; reshape(color, 1, 3)]; + endif + data{data_3d_idx} = [data{data_3d_idx}, ... + [[xcol; xcol(end)], [ycol; ycol(end)], ... + [zcol; zcol(end)], [ccdat; ccdat(end)]]']; + else + if (mono) + colorspec = ""; + elseif (__gnuplot_has_feature__ ("transparent_patches") + && isscalar (obj.facealpha)) + colorspec = sprintf ("lc rgb \"#%02x%02x%02x\" fillstyle transparent solid %f", + round (255*color), obj.facealpha); + else + colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", + round (255*color)); + endif + + withclause{data_idx} = sprintf ("with filledcurve %s", + colorspec); + data{data_idx} = [xcol, ycol]'; + usingclause{data_idx} = sprintf ("record=%d using ($1):($2)", + numel (xcol)); + endif + endif + endif + + ## patch outline + if (!(strncmp (obj.edgecolor, "none", 4) + && (strncmp (obj.marker, "none", 4) + || (strncmp (obj.markeredgecolor, "none", 4) + && strncmp (obj.markerfacecolor, "none", 4))))) + + data_idx++; + is_image_data(data_idx) = false; + parametric(data_idx) = false; + have_cdata(data_idx) = false; + have_3d_patch(data_idx) = false; + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = sprintf ("record=%d", numel (obj.xdata)); + + if (isfield (obj, "markersize")) + mdat = obj.markersize / 3; + endif + + if (isfield (obj, "edgecolor")) + ## FIXME + ## This is the wrong thing to do as edgecolor, markeredgecolor + ## and markerfacecolor can have different values and we should + ## treat them seperately. However, the below allow the scatter + ## functions to work as expected, where only one of these values + ## is set + if (strncmp (obj.edgecolor, "none", 4)) + if (strncmp (obj.markeredgecolor, "none", 4)) + ec = obj.markerfacecolor; + else + ec = obj.markeredgecolor; + endif + else + ec = obj.edgecolor; + endif + + if ((strncmp (ec, "flat", 4) + || strncmp (ec, "interp", 6)) + && isfield (obj, "cdata")) + if (ndims (obj.cdata) == 2 + && (size (obj.cdata, 2) == nc + && (size (obj.cdata, 1) == 1 + || size (obj.cdata, 1) == 3))) + ccol = cdat (:, i); + elseif (ndims (obj.cdata) == 2 + && (size (obj.cdata, 1) == nc + && (size (obj.cdata, 2) == 1 + || size (obj.cdata, 2) == 3))) + ccol = cdat (i, :); + elseif (ndims (obj.cdata) == 3) + ccol = permute (cdat (:, i, :), [1, 3, 2]); + else + ccol = cdat; + endif + if (strncmp (ec, "flat", 4)) + if (numel(ccol) == 3) + color = ccol; + else + if (isscalar (ccol)) + ccol = repmat(ccol, numel (xcol), 1); + endif + color = "flat"; + have_cdata(data_idx) = true; + endif + elseif (strncmp (ec, "interp", 6)) + if (numel(ccol) == 3) + warning ("\"interp\" not supported, using 1st entry of cdata"); + color = ccol(1,:); + else + if (isscalar (ccol)) + ccol = repmat(ccol, numel (xcol), 1); + endif + color = "interp"; + have_cdata(data_idx) = true; + endif + endif + elseif (isnumeric (ec)) + color = ec; + else + color = [0, 0, 0]; + endif + else + color = [0, 0, 0]; + endif + + if (isfield (obj, "linestyle")) + switch (obj.linestyle) + case "-" + lt = "lt 1"; + case "--" + lt = "lt 2"; + case ":" + lt = "lt 3"; + case "-." + lt = "lt 6"; + case "none" + lt = ""; + otherwise + lt = ""; + endswitch + else + lt = ""; + endif + + if (isfield (obj, "linewidth")) + lw = sprintf("linewidth %f", obj.linewidth); + else + lw = ""; + endif + + [pt, pt2, obj] = gnuplot_pointtype (obj); + if (! isempty (pt)) + pt = sprintf ("pointtype %s", pt); + endif + if (! isempty (pt2)) + pt2 = sprintf ("pointtype %s", pt2); + endif + + if (mono) + colorspec = ""; + else + if (ischar (color)) + colorspec = "palette"; + else + colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", + round (255*color)); + endif + endif + + sidx = 1; + if (isempty (lt)) + style = ""; + else + style = "lines"; + endif + tmpwith = {}; + + facesame = true; + if (! isequal (pt, pt2) && isfield (obj, "markerfacecolor") + && !strncmp (obj.markerfacecolor, "none", 4)) + if (strncmp (obj.markerfacecolor, "auto", 4) + || ! isnumeric (obj.markerfacecolor) + || (isnumeric (obj.markerfacecolor) + && isequal (color, obj.markerfacecolor))) + style = strcat (style, "points"); + if (isfield (obj, "markersize")) + if (length (mdat) == nc) + m = mdat(i); + else + m = mdat; + endif + ps = sprintf("pointsize %f", m / 3); + else + ps = ""; + endif + + tmpwith{sidx} = sprintf ("with %s %s %s %s %s %s", + style, lw, pt2, lt, ps, + colorspec); + else + facesame = false; + if (! isempty (style)) + tmpwith{sidx} = sprintf ("with %s %s %s %s", + style, lw, lt, + colorspec); + sidx ++; + endif + if (isnumeric (obj.markerfacecolor) && ! mono) + colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", + round (255*obj.markerfacecolor)); + endif + style = "points"; + if (isfield (obj, "markersize")) + if (length (mdat) == nc) + m = mdat(i); + else + m = mdat; + endif + ps = sprintf("pointsize %f", m / 3); + else + ps = ""; + endif + tmpwith{sidx} = sprintf ("with %s %s %s %s %s %s", + style, lw, pt2, lt, ps, + colorspec); + endif + endif + + if (isfield (obj, "markeredgecolor") + && !strncmp (obj.markeredgecolor, "none", 4)) + if (facesame && !isempty (pt) + && (strncmp (obj.markeredgecolor, "auto", 4) + || ! isnumeric (obj.markeredgecolor) + || (isnumeric (obj.markeredgecolor) + && isequal (color, obj.markeredgecolor)))) + if (sidx == 1 && ((length (style) == 5 + && strncmp (style, "lines", 5)) + || isempty (style))) + style = strcat (style, "points"); + if (isfield (obj, "markersize")) + if (length (mdat) == nc) + m = mdat(i); + else + m = mdat; + endif + ps = sprintf("pointsize %f", m / 3); + else + ps = ""; + endif + tmpwith{sidx} = sprintf ("with %s %s %s %s %s %s", + style, lw, pt, lt, ps, + colorspec); + endif + else + if (!isempty (style)) + if (length(tmpwith) < sidx || isempty (tmpwith{sidx})) + tmpwith{sidx} = sprintf ("with %s %s %s %s", + style, lw, lt, + colorspec); + endif + sidx ++; + endif + + if (!isempty (pt)) + if (! mono) + if (strncmp (obj.markeredgecolor, "auto", 4)) + colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", + round (255*color)); + elseif (isnumeric (obj.markeredgecolor) && ! mono) + colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", + round (255*obj.markeredgecolor)); + endif + endif + style = "points"; + if (isfield (obj, "markersize")) + if (length (mdat) == nc) + m = mdat(i); + else + m = mdat; + endif + ps = sprintf("pointsize %f", m / 3); + else + ps = ""; + endif + tmpwith{sidx} = sprintf ("with %s %s %s %s %s %s", + style, lw, pt, lt, ps, + colorspec); + endif + endif + endif + + if (isempty (tmpwith)) + withclause{data_idx} = sprintf ("with %s %s %s %s %s", + style, lw, pt, lt, + colorspec); + else + withclause{data_idx} = tmpwith{1}; + endif + if (nd == 3) + if (ischar (color)) + if (! isnan (xcol) && ! isnan (ycol) && ! isnan (zcol)) + data{data_idx} = [[xcol; xcol(1)], [ycol; ycol(1)], ... + [zcol; zcol(1)], [ccol; ccol(1)]]'; + else + data{data_idx} = [xcol, ycol, zcol, ccol]'; + endif + usingclause{data_idx} = sprintf ("record=%d using ($1):($2):($3):($4)", columns (data{data_idx})); + else + if (! isnan (xcol) && ! isnan (ycol) && ! isnan (zcol)) + data{data_idx} = [[xcol; xcol(1)], [ycol; ycol(1)], ... + [zcol; zcol(1)]]'; + else + data{data_idx} = [xcol, ycol, zcol]'; + endif + usingclause{data_idx} = sprintf ("record=%d using ($1):($2):($3)", columns (data{data_idx})); + endif + else + if (ischar (color)) + if (! isnan (xcol) && ! isnan (ycol)) + data{data_idx} = [[xcol; xcol(1)], [ycol; ycol(1)], ... + [ccol; ccol(1)]]'; + else + data{data_idx} = [xcol, ycol, ccol]'; + endif + usingclause{data_idx} = sprintf ("record=%d using ($1):($2):($3)", columns (data{data_idx})); + else + if (! isnan (xcol) && ! isnan (ycol)) + data{data_idx} = [[xcol; xcol(1)], [ycol; ycol(1)]]'; + else + data{data_idx} = [xcol, ycol]'; + endif + usingclause{data_idx} = sprintf ("record=%d using ($1):($2)", columns (data{data_idx})); + endif + endif + + if (length (tmpwith) > 1) + data_idx++; + is_image_data(data_idx) = is_image_data(data_idx - 1); + parametric(data_idx) = parametric(data_idx - 1); + have_cdata(data_idx) = have_cdata(data_idx - 1); + have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = usingclause{data_idx - 1}; + data{data_idx} = data{data_idx - 1}; + withclause{data_idx} = tmpwith{2}; + endif + if (length (tmpwith) > 2) + data_idx++; + is_image_data(data_idx) = is_image_data(data_idx - 1); + parametric(data_idx) = parametric(data_idx - 1); + have_cdata(data_idx) = have_cdata(data_idx - 1); + have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = usingclause{data_idx - 1}; + data{data_idx} = data{data_idx - 1}; + withclause{data_idx} = tmpwith{3}; + endif + endif + endfor + + case "surface" + view_map = true; + if (! (strncmp (obj.edgecolor, "none", 4) + && strncmp (obj.facecolor, "none", 4))) + data_idx++; + is_image_data(data_idx) = false; + parametric(data_idx) = false; + have_cdata(data_idx) = true; + have_3d_patch(data_idx) = false; + style = do_linestyle_command (obj, obj.edgecolor, + data_idx, mono, + plot_stream); + + if (isempty (obj.displayname)) + titlespec{data_idx} = "title \"\""; + else + tmp = undo_string_escapes (__maybe_munge_text__ (enhanced, obj, "displayname")); + titlespec{data_idx} = cstrcat ("title \"", tmp, "\""); + endif + withclause{data_idx} = sprintf ("with pm3d linestyle %d", + data_idx); + withpm3d = true; + pm3didx = data_idx; + + xdat = obj.xdata; + ydat = obj.ydata; + zdat = obj.zdata; + cdat = obj.cdata; + + err = false; + if (! size_equal(zdat, cdat)) + err = true; + endif + if (isvector (xdat) && isvector (ydat) && ismatrix (zdat)) + if (rows (zdat) == length (ydat) + && columns (zdat) == length (xdat)) + [xdat, ydat] = meshgrid (xdat, ydat); + else + err = true; + endif + elseif (ismatrix (xdat) && ismatrix (ydat) && ismatrix (zdat)) + if (! size_equal (xdat, ydat, zdat)) + err = true; + endif + else + err = true; + endif + if (err) + error ("__go_draw_axes__: invalid grid data"); + endif + xlen = columns (zdat); + ylen = rows (zdat); + if (xlen == columns (xdat) && xlen == columns (ydat) + && ylen == rows (xdat) && ylen == rows (ydat)) + len = 4 * xlen; + zz = zeros (ylen, len); + k = 1; + for kk = 1:4:len + zz(:,kk) = xdat(:,k); + zz(:,kk+1) = ydat(:,k); + zz(:,kk+2) = zdat(:,k); + zz(:,kk+3) = cdat(:,k); + k++; + endfor + data{data_idx} = zz.'; + endif + + if (doing_interp_color) + interp_str = "interpolate 0, 0"; + else + ## No interpolation of facecolors. + interp_str = ""; + endif + usingclause{data_idx} = sprintf ("record=%dx%d using ($1):($2):($3):($4)", ylen, xlen); + + flat_interp_face = (strncmp (obj.facecolor, "flat", 4) + || strncmp (obj.facecolor, "interp", 6)); + flat_interp_edge = (strncmp (obj.edgecolor, "flat", 4) + || strncmp (obj.edgecolor, "interp", 6)); + + facecolor_none_or_white = (strncmp (obj.facecolor, "none", 4) + || (isnumeric (obj.facecolor) + && all (obj.facecolor == 1))); + hidden_removal = false; + fputs (plot_stream, "set style increment default;\n"); + if (flat_interp_edge && facecolor_none_or_white) + withpm3d = false; + withclause{data_idx} = sprintf ("with %s palette", style {1}); + fputs (plot_stream, "unset pm3d\n"); + if (all (obj.facecolor == 1)) + hidden_removal = true; + endif + elseif (facecolor_none_or_white) + if (all (obj.facecolor == 1)) + hidden_removal = true; + endif + fputs(plot_stream,"unset pm3d;\n"); + fputs(plot_stream,"set style increment user;\n"); + withpm3d = false; + withclause{data_idx} = sprintf("with %s linestyle %d", + style{1}, data_idx); + fputs (plot_stream, "unset pm3d\n"); + endif + + if (doing_interp_color) + ## "depthorder" interferes with interpolation of colors. + dord = "scansautomatic"; + else + dord = "depthorder"; + endif + + if (flat_interp_face && strncmp (obj.edgecolor, "flat", 4)) + fprintf (plot_stream, "set pm3d explicit at s %s %s corners2color c3;\n", + interp_str, dord); + elseif (!facecolor_none_or_white) + if (strncmp (obj.edgecolor, "none", 4)) + if (__gnuplot_has_feature__ ("transparent_surface") + && isscalar (obj.facealpha)) + fprintf (plot_stream, + "set style fill transparent solid %f;\n", + obj.facealpha); + endif + fprintf (plot_stream, "set pm3d explicit at s %s corners2color c3;\n", + interp_str, dord); + else + fprintf (plot_stream, "set pm3d explicit at s hidden3d %d %s %s corners2color c3;\n", + data_idx, interp_str, dord); + + if (__gnuplot_has_feature__ ("transparent_surface") + && isscalar (obj.facealpha)) + fprintf (plot_stream, + "set style fill transparent solid %f;\n", + obj.facealpha); + endif + endif + endif + + zz = []; + if (length (style) > 1) + len = 3 * xlen; + zz = zeros (ylen, len); + k = 1; + for kk = 1:3:len + zz(:,kk) = xdat(:,k); + zz(:,kk+1) = ydat(:,k); + zz(:,kk+2) = zdat(:,k); + k++; + endfor + zz = zz.'; + + data_idx++; + is_image_data(data_idx) = is_image_data(data_idx - 1); + parametric(data_idx) = parametric(data_idx - 1); + have_cdata(data_idx) = false; + have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = sprintf ("record=%dx%d using ($1):($2):($3)", ylen, xlen); + data{data_idx} = zz; + withclause{data_idx} = sprintf ("with %s linestyle %d", + style{2}, data_idx); + + endif + if (length (style) > 2) + data_idx++; + is_image_data(data_idx) = is_image_data(data_idx - 1); + parametric(data_idx) = parametric(data_idx - 1); + have_cdata(data_idx) = false; + have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = sprintf ("record=%dx%d using ($1):($2):($3)", ylen, xlen); + data{data_idx} = zz; + withclause{data_idx} = sprintf ("with %s linestyle %d", + style{3}, data_idx); + endif + if (withpm3d && strncmp (style {1}, "linespoints", 11)) + if (isempty(zz)) + len = 3 * xlen; + zz = zeros (ylen, len); + k = 1; + for kk = 1:3:len + zz(:,kk) = xdat(:,k); + zz(:,kk+1) = ydat(:,k); + zz(:,kk+2) = zdat(:,k); + k++; + endfor + zz = zz.'; + endif + data_idx++; + is_image_data(data_idx) = is_image_data(data_idx - 1); + parametric(data_idx) = parametric(data_idx - 1); + have_cdata(data_idx) = false; + have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = sprintf ("record=%dx%d using ($1):($2):($3)", ylen, xlen); + data{data_idx} = zz; + withclause{data_idx} = sprintf ("with points linestyle %d", + pm3didx); + endif + endif + + case "text" + [label, f, s] = __maybe_munge_text__ (enhanced, obj, "string"); + fontspec = create_fontspec (f, s, gnuplot_term); + lpos = obj.position; + halign = obj.horizontalalignment; + valign = obj.verticalalignment; + angle = obj.rotation; + units = obj.units; + color = obj.color; + if (strcmpi (units, "normalized")) + units = "graph"; + elseif (strcmp (axis_obj.yaxislocation, "right") + && strcmp (units, "data")) + units = "second"; + else + units = ""; + endif + + if (isnumeric (color)) + 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" + dy = -0.5; + case "cap" + dy = -0.5; + case "middle" + dy = 0.5 * (num_lines - 1); + case "baseline" + dy = 0.5 + (num_lines - 1); + case "bottom" + 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 %.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 %.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); + endif + + case "hggroup" + ## Push group children into the kid list. + if (isempty (kids)) + kids = obj.children; + elseif (! isempty (obj.children)) + kids = [kids; obj.children]; + endif + + otherwise + error ("__go_draw_axes__: unknown object class, %s", + obj.type); + endswitch + + endwhile + + ## This is need to prevent warnings for rotations in 3D plots, while + ## allowing colorbars with contours. + if (nd == 2 || (data_idx > 1 && !view_map)) + fputs (plot_stream, "set pm3d implicit;\n"); + else + fputs (plot_stream, "set pm3d explicit;\n"); + endif + + if (isnan(hidden_removal) || hidden_removal) + fputs (plot_stream, "set hidden3d;\n"); + else + fputs (plot_stream, "unset hidden3d;\n"); + endif + + 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. + if (isempty (xlim)) + return; + endif + if (strcmpi (axis_obj.xdir, "reverse")) + xdir = "reverse"; + else + xdir = "noreverse"; + endif + fprintf (plot_stream, "set xrange [%.15e:%.15e] %s;\n", xlim, xdir); + if (strcmpi (axis_obj.xaxislocation, "top")) + fprintf (plot_stream, "set x2range [%.15e:%.15e] %s;\n", xlim, xdir); + endif + + if (isempty (ylim)) + return; + endif + if (strcmpi (axis_obj.ydir, "reverse")) + ydir = "reverse"; + else + ydir = "noreverse"; + endif + fprintf (plot_stream, "set yrange [%.15e:%.15e] %s;\n", ylim, ydir); + if (strcmpi (axis_obj.yaxislocation, "right")) + fprintf (plot_stream, "set y2range [%.15e:%.15e] %s;\n", ylim, ydir); + endif + + if (nd == 3) + if (isempty (zlim)) + return; + endif + if (strcmpi (axis_obj.zdir, "reverse")) + zdir = "reverse"; + else + zdir = "noreverse"; + endif + fprintf (plot_stream, "set zrange [%.15e:%.15e] %s;\n", zlim, zdir); + endif + + cmap = parent_figure_obj.colormap; + cmap_sz = rows(cmap); + if (! any (isinf (clim))) + if (truecolor || ! cdatadirect) + if (rows(addedcmap) > 0) + for i = 1:data_idx + if (have_3d_patch(i)) + data{i}(end,:) = clim(2) * (data{i}(end, :) - 0.5) / cmap_sz; + endif + endfor + fprintf (plot_stream, "set cbrange [%g:%g];\n", clim(1), clim(2) * + (cmap_sz + rows(addedcmap)) / cmap_sz); + else + fprintf (plot_stream, "set cbrange [%g:%g];\n", clim); + endif + else + fprintf (plot_stream, "set cbrange [1:%d];\n", cmap_sz + + rows (addedcmap)); + endif + endif + + if (strcmpi (axis_obj.box, "on")) + if (nd == 3) + fputs (plot_stream, "set border 4095;\n"); + else + fputs (plot_stream, "set border 431;\n"); + endif + else + if (nd == 3) + fputs (plot_stream, "set border 895;\n"); + elseif (! isempty (axis_obj.ytick)) + if (strcmpi (axis_obj.yaxislocation, "right")) + fprintf (plot_stream, "unset ytics; set y2tics %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 12;\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 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 + 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"); + 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 + + if (strcmpi (axis_obj.visible, "off")) + fputs (plot_stream, "unset border; unset tics\n"); + else + fprintf (plot_stream, "set border lw %f;\n", axis_obj.linewidth); + endif + + if (! isempty (hlgnd) && ! isempty (hlgnd.children) + && any (strcmpi (get (hlgnd.children, "visible"), "on"))) + if (strcmpi (hlgnd.box, "on")) + box = "box"; + else + box = "nobox"; + endif + if (strcmpi (hlgnd.orientation, "vertical")) + horzvert = "vertical"; + else + horzvert = "horizontal"; + endif + if (strcmpi (hlgnd.textposition, "right")) + reverse = "reverse"; + else + reverse = "noreverse"; + endif + inout = "inside"; + keypos = hlgnd.location; + if (ischar (keypos)) + keypos = lower (keypos); + keyout = findstr (keypos, "outside"); + if (! isempty (keyout)) + inout = "outside"; + keypos = keypos(1:keyout-1); + endif + endif + switch (keypos) + case "north" + pos = "center top"; + case "south" + pos = "center bottom"; + case "east" + pos = "right center"; + case "west" + pos = "left center"; + case "northeast" + pos = "right top"; + case "northwest" + pos = "left top"; + case "southeast" + pos = "right bottom"; + case "southwest" + pos = "left bottom"; + case "best" + pos = ""; + warning ("legend: 'Best' not yet implemented for location specifier.\n"); + ## Least conflict with data in plot. + ## Least unused space outside plot. + otherwise + pos = ""; + endswitch + if (__gnuplot_has_feature__ ("key_has_font_properties")) + [fontname, fontsize] = get_fontname_and_size (hlgnd); + fontspec = create_fontspec (fontname, fontsize, gnuplot_term); + else + fontspec = ""; + endif + fprintf (plot_stream, "set key %s %s;\nset key %s %s %s %s;\n", + inout, pos, box, reverse, horzvert, fontspec); + else + fputs (plot_stream, "unset key;\n"); + endif + fputs (plot_stream, "set style data lines;\n"); + + cmap = [cmap; addedcmap]; + cmap_sz = cmap_sz + rows(addedcmap); + if (length(cmap) > 0) + fprintf (plot_stream, + "set palette positive color model RGB maxcolors %i;\n", + cmap_sz); + fprintf (plot_stream, + "set palette file \"-\" binary record=%d using 1:2:3:4;\n", + cmap_sz); + fwrite (plot_stream, [1:cmap_sz; cmap.'], "float32"); + fwrite (plot_stream, "\n"); + endif + + fputs (plot_stream, "unset colorbox;\n"); + + if (have_data) + if (nd == 2) + plot_cmd = "plot"; + else + plot_cmd = "splot"; + rot_x = 90 - axis_obj.view(2); + rot_z = axis_obj.view(1); + while (rot_z < 0) + rot_z += 360; + endwhile + fputs (plot_stream, "set ticslevel 0;\n"); + if (view_map && rot_x == 0 && rot_z == 0) + fputs (plot_stream, "set view map;\n"); + else + fprintf (plot_stream, "set view %.15g, %.15g;\n", rot_x, rot_z); + endif + endif + if (have_3d_patch (1)) + fputs (plot_stream, "set pm3d depthorder\n"); + 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 + fprintf (plot_stream, "%s \"-\" binary format='%%float64' %s %s %s \\\n", plot_cmd, + usingclause{1}, titlespec{1}, withclause{1}); + endif + for i = 2:data_idx + if (have_3d_patch (i)) + fprintf (plot_stream, ", \"-\" %s %s %s \\\n", + usingclause{i}, titlespec{i}, withclause{i}); + elseif (is_image_data (i)) + if (! is_image_data (i-1)) + fputs (plot_stream, "; "); + if (bg_is_set) + fputs (plot_stream, "unset obj 1; \\\n"); + bg_is_set = false; + endif + if (fg_is_set) + 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 + elseif (is_image_data (i-1)) + if (bg_is_set) + fputs (plot_stream, "unset obj 1; \\\n"); + bg_is_set = false; + endif + if (fg_is_set) + fputs (plot_stream, "unset obj 2; \\\n"); + fg_is_set = false; + endif + fprintf (plot_stream, "%s \"-\" binary format='%%float64' %s %s %s \\\n", plot_cmd, + usingclause{i}, titlespec{i}, withclause{i}); + else + fprintf (plot_stream, ", \"-\" binary format='%%float64' %s %s %s \\\n", + usingclause{i}, titlespec{i}, withclause{i}); + endif + endfor + fputs (plot_stream, ";\n"); + for i = 1:data_idx + if (have_3d_patch (i)) + ## Can't write 3d patch data as binary as can't plot more than + ## a single patch at a time and have to plot all patches together + ## so that the gnuplot depth ordering is done correctly + for j = 1 : 4 : columns(data{i}) + if (j != 1) + fputs (plot_stream, "\n\n"); + endif + fprintf (plot_stream, "%.15g %.15g %.15g %.15g\n", data{i}(:,j).'); + fprintf (plot_stream, "%.15g %.15g %.15g %.15g\n\n", data{i}(:,j+1).'); + fprintf (plot_stream, "%.15g %.15g %.15g %.15g\n", data{i}(:,j+2).'); + fprintf (plot_stream, "%.15g %.15g %.15g %.15g\n", data{i}(:,j+3).'); + endfor + fputs (plot_stream, "e\n"); + elseif (is_image_data(i)) + fwrite (plot_stream, data{i}, "float32"); + else + __gnuplot_write_data__ (plot_stream, data{i}, nd, parametric(i), + have_cdata(i)); + endif + endfor + else + fputs (plot_stream, "plot \"-\";\nInf Inf\ne\n"); + endif + + ## Needed to allow mouse rotation with pcolor. + if (view_map) + fputs (plot_stream, "unset view;\n"); + endif + + if (bg_is_set) + fputs (plot_stream, "unset obj 1;\n"); + bg_is_set = false; + endif + + fflush (plot_stream); + + else + print_usage (); + endif + +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); + else + fontspec = sprintf ("font \"%s,%d\"", f, s); + endif +endfunction + +function style = do_linestyle_command (obj, linecolor, idx, mono, + plot_stream, errbars = "") + style = {}; + + fprintf (plot_stream, "set style line %d default;\n", idx); + fprintf (plot_stream, "set style line %d", idx); + + found_style = false; + if (isnumeric (linecolor)) + color = linecolor; + if (! mono) + fprintf (plot_stream, " linecolor rgb \"#%02x%02x%02x\"", + round (255*color)); + endif + else + color = [0, 0, 0]; + endif + + if (isfield (obj, "linestyle")) + switch (obj.linestyle) + case "-" + lt = "1"; + case "--" + lt = "2"; + case ":" + lt = "3"; + case "-." + lt = "6"; + case "none" + lt = ""; + otherwise + lt = ""; + endswitch + + if (! isempty (lt)) + fprintf (plot_stream, " linetype %s", lt); + endif + + else + lt = ""; + endif + if (! isempty (errbars)) + found_style = true; + endif + + if (isfield (obj, "linewidth")) + fprintf (plot_stream, " linewidth %f", obj.linewidth); + found_style = true; + endif + + [pt, pt2, obj] = gnuplot_pointtype (obj); + + if (! isempty (pt)) + found_style = true; + endif + + sidx = 1; + if (isempty (errbars)) + if (isempty (lt)) + style {sidx} = ""; + else + style {sidx} = "lines"; + endif + + facesame = true; + if (! isequal (pt, pt2) && isfield (obj, "markerfacecolor") + && !strncmp (obj.markerfacecolor, "none", 4)) + if (strncmp (obj.markerfacecolor, "auto", 4) + || ! isnumeric (obj.markerfacecolor) + || (isnumeric (obj.markerfacecolor) + && isequal (color, obj.markerfacecolor))) + if (! isempty (pt2)) + fprintf (plot_stream, " pointtype %s", pt2); + style {sidx} = strcat (style{sidx}, "points"); + endif + if (isfield (obj, "markersize")) + fprintf (plot_stream, " pointsize %f", obj.markersize / 3); + endif + else + facesame = false; + if (! found_style) + fputs (plot_stream, " default"); + endif + fputs (plot_stream, ";\n"); + if (! isempty (style {sidx})) + sidx ++; + idx ++; + else + fputs (plot_stream, ";\n"); + endif + fprintf (plot_stream, "set style line %d default;\n", idx); + fprintf (plot_stream, "set style line %d", idx); + if (isnumeric (obj.markerfacecolor) && ! mono) + fprintf (plot_stream, " linecolor rgb \"#%02x%02x%02x\"", + round (255*obj.markerfacecolor)); + endif + if (! isempty (pt2)) + style {sidx} = "points"; + fprintf (plot_stream, " pointtype %s", pt2); + endif + if (isfield (obj, "markersize")) + fprintf (plot_stream, " pointsize %f", obj.markersize / 3); + endif + endif + endif + if (isfield (obj, "markeredgecolor") + && !strncmp (obj.markeredgecolor, "none", 4)) + if (facesame && !isempty (pt) + && (strncmp (obj.markeredgecolor, "auto", 4) + || ! isnumeric (obj.markeredgecolor) + || (isnumeric (obj.markeredgecolor) + && isequal (color, obj.markeredgecolor)))) + if (sidx == 1 && ((length (style {sidx}) == 5 + && strncmp (style {sidx}, "lines", 5)) || isempty (style {sidx}))) + if (! isempty (pt)) + style {sidx} = strcat (style{sidx}, "points"); + fprintf (plot_stream, " pointtype %s", pt); + endif + if (isfield (obj, "markersize")) + fprintf (plot_stream, " pointsize %f", obj.markersize / 3); + endif + endif + else + if (! found_style) + fputs (plot_stream, " default"); + endif + fputs (plot_stream, ";\n"); + if (!isempty (style {sidx})) + sidx ++; + idx ++; + else + fputs (plot_stream, ";\n"); + endif + fprintf (plot_stream, "set style line %d default;\n", idx); + fprintf (plot_stream, "set style line %d", idx); + if (! mono) + if (strncmp (obj.markeredgecolor, "auto", 4)) + fprintf (plot_stream, " linecolor rgb \"#%02x%02x%02x\"", + round (255*color)); + elseif (isnumeric (obj.markeredgecolor) && ! mono) + fprintf (plot_stream, " linecolor rgb \"#%02x%02x%02x\"", + round (255*obj.markeredgecolor)); + endif + endif + if (! isempty (pt)) + style {sidx} = "points"; + fprintf (plot_stream, " pointtype %s", pt); + endif + if (isfield (obj, "markersize")) + fprintf (plot_stream, " pointsize %f", obj.markersize / 3); + endif + endif + endif + else + style{1} = errbars; + fputs (plot_stream, " pointtype 0"); + endif + + if (! found_style && isempty (style {1})) + fputs (plot_stream, " default"); + endif + + fputs (plot_stream, ";\n"); + +endfunction + +function [pt, pt2, obj] = gnuplot_pointtype (obj) + if (isfield (obj, "marker")) + switch (obj.marker) + case "+" + pt = pt2 = "1"; + case "o" + pt = "6"; + pt2 = "7"; + case "*" + pt = pt2 = "3"; + case "." + pt = "6"; + pt2 = "7"; + if (isfield (obj, "markerfacecolor") + || strncmp (obj.markerfacecolor, "none", 4)) + obj.markerfacecolor = "auto"; + endif + if (isfield (obj, "markersize")) + obj.markersize /= 3; + else + obj.markersize = 5; + endif + case "x" + pt = pt2 = "2"; + case {"square", "s"} + pt = "4"; + pt2 = "5"; + case {"diamond", "d"} + pt = "12"; + pt2 = "13"; + case "^" + pt = "8"; + pt2 = "9"; + case "v" + pt = "10"; + pt2 = "11"; + case ">" + ## FIXME -- should be triangle pointing right, use triangle pointing up + pt = "8"; + pt2 = "9"; + case "<" + ## FIXME -- should be triangle pointing left, use triangle pointing down + pt = "10"; + pt2 = "11"; + case {"pentagram", "p"} + ## FIXME -- should be pentagram, using pentagon + pt = "14"; + pt2 = "15"; + case {"hexagram", "h"} + ## FIXME -- should be 6 pt start, using "*" instead + pt = pt2 = "3"; + case "none" + pt = pt2 = ""; + otherwise + pt = pt2 = ""; + endswitch + else + pt = pt2 = ""; + endif +endfunction + +function __gnuplot_write_data__ (plot_stream, data, nd, parametric, cdata) + + ## DATA is already transposed. + + ## FIXME -- this may need to be converted to C++ for speed. + + ## Convert NA elements to normal NaN values because fprintf writes + ## "NA" and that confuses gnuplot. + idx = find (isna (data)); + if (any (idx)) + data(idx) = NaN; + endif + + if (nd == 2) + fwrite (plot_stream, data, "float64"); + elseif (nd == 3) + if (parametric) + fwrite (plot_stream, data, "float64"); + else + nr = rows (data); + if (cdata) + for j = 1:4:nr + fwrite (plot_stream, data(j:j+3,:), "float64"); + endfor + else + for j = 1:3:nr + fwrite (plot_stream, data(j:j+2,:), "float64"); + endfor + endif + endif + endif + +endfunction + +function do_tics (obj, plot_stream, ymirror, mono, gnuplot_term) + + obj.xticklabel = ticklabel_to_cell (obj.xticklabel); + obj.yticklabel = ticklabel_to_cell (obj.yticklabel); + obj.zticklabel = ticklabel_to_cell (obj.zticklabel); + + if (strcmp (obj.xminorgrid, "on")) + obj.xminortick = "on"; + endif + if (strcmp (obj.yminorgrid, "on")) + obj.yminortick = "on"; + endif + if (strcmp (obj.zminorgrid, "on")) + obj.zminortick = "on"; + endif + + [fontname, fontsize] = get_fontname_and_size (obj); + fontspec = create_fontspec (fontname, fontsize, gnuplot_term); + + ## A Gnuplot tic scale of 69 is equivalent to Octave's 0.5. + ticklength = sprintf ("scale %4.1f", (69/0.5)*obj.ticklength(1)); + + if (strcmpi (obj.xaxislocation, "top")) + 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.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, + 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.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, + 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.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, + 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.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, + 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.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, + 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.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, + 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.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, sgn, gnuplot_term) + persistent warned_latex = false; + if (strcmpi (interpreter, "tex")) + for n = 1 : numel(labels) + labels{n} = __tex2enhanced__ (labels{n}, fontname, false, false); + endfor + elseif (strcmpi (interpreter, "latex")) + if (! warned_latex) + warning ("latex markup not supported for tick marks"); + warned_latex = true; + endif + endif + if (strcmp (scale, "log")) + 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; + endif + colorspec = get_text_colorspec (color, mono); + if (strcmpi (ticmode, "manual") || strcmpi (labelmode, "manual")) + if (isempty (tics)) + fprintf (plot_stream, "unset %stics;\nunset m%stics;\n", ax, ax); + elseif (strcmpi (labelmode, "manual")) + if (ischar (labels)) + labels = cellstr (labels); + endif + if (isnumeric (labels)) + labels = num2str (real (labels(:))); + endif + if (ischar (labels)) + labels = permute (cellstr (labels), [2, 1]); + endif + if (iscellstr (labels)) + k = 1; + ntics = numel (tics); + nlabels = numel (labels); + fprintf (plot_stream, "set format %s \"%%s\";\n", ax); + if (mirror) + fprintf (plot_stream, "set %stics %s %s %s mirror (", ax, + tickdir, ticklength, axispos); + else + fprintf (plot_stream, "set %stics %s %s %s nomirror (", ax, + tickdir, ticklength, axispos); + endif + + labels = regexprep(labels, '%', "%%"); + for i = 1:ntics + fprintf (plot_stream, " \"%s\" %.15g", labels{k++}, tics(i)); + if (i < ntics) + fputs (plot_stream, ", "); + endif + if (k > nlabels) + k = 1; + endif + endfor + fprintf (plot_stream, ") %s %s;\n", colorspec, fontspec); + if (strcmp (mtics, "on")) + fprintf (plot_stream, "set m%stics %d;\n", ax, num_mtics); + else + fprintf (plot_stream, "unset m%stics;\n", ax); + endif + else + error ("__go_draw_axes__: unsupported type of ticklabel"); + endif + else + fprintf (plot_stream, "set format %s \"%s\";\n", ax, fmt); + if (mirror) + fprintf (plot_stream, "set %stics %s %s %s mirror (", ax, tickdir, + ticklength, axispos); + else + fprintf (plot_stream, "set %stics %s %s %s nomirror (", ax, tickdir, + ticklength, axispos); + endif + fprintf (plot_stream, " %.15g,", tics(1:end-1)); + fprintf (plot_stream, " %.15g) %s;\n", tics(end), fontspec); + if (strcmp (mtics, "on")) + fprintf (plot_stream, "set m%stics %d;\n", ax, num_mtics); + else + fprintf (plot_stream, "unset m%stics;\n", ax); + endif + endif + else + fprintf (plot_stream, "set format %s \"%s\";\n", ax, fmt); + if (mirror) + fprintf (plot_stream, "set %stics %s %s %s mirror %s %s;\n", ax, + axispos, tickdir, ticklength, colorspec, fontspec); + else + fprintf (plot_stream, "set %stics %s %s %s nomirror %s %s;\n", ax, + tickdir, ticklength, axispos, colorspec, fontspec); + endif + if (strcmp (mtics, "on")) + fprintf (plot_stream, "set m%stics %d;\n", ax, num_mtics); + else + fprintf (plot_stream, "unset m%stics;\n", ax); + endif + endif +endfunction + +function ticklabel = ticklabel_to_cell (ticklabel) + if (isnumeric (ticklabel)) + ## Use upto 5 significant digits + ticklabel = num2str (ticklabel(:), 5); + endif + if (ischar (ticklabel)) + if (size (ticklabel, 1) == 1 && any (ticklabel == "|")) + n = setdiff (findstr (ticklabel, "|"), findstr (ticklabel, '\|')); + ticklabel = strsplit (ticklabel, "|"); + else + ticklabel = cellstr (ticklabel); + endif + elseif (isempty (ticklabel)) + ticklabel = {""}; + else + ticklabel = ticklabel; + endif +endfunction + +function colorspec = get_text_colorspec (color, mono) + if (mono) + colorspec = ""; + else + colorspec = sprintf ("textcolor rgb \"#%02x%02x%02x\"", + round (255*color)); + endif +endfunction + +function [f, s, fnt, it, bld] = get_fontname_and_size (t) + if (isempty (t.fontname) || strcmp (t.fontname, "*")) + fnt = "{}"; + else + fnt = t.fontname; + endif + f = fnt; + it = false; + bld = false; + if (! isempty (t.fontweight) && strcmpi (t.fontweight, "bold")) + if (! isempty(t.fontangle) + && (strcmpi (t.fontangle, "italic") + || strcmpi (t.fontangle, "oblique"))) + f = cstrcat (f, "-bolditalic"); + it = true; + bld = true; + else + f = cstrcat (f, "-bold"); + bld = true; + endif + elseif (! isempty(t.fontangle) + && (strcmpi (t.fontangle, "italic") + || strcmpi (t.fontangle, "oblique"))) + f = cstrcat (f, "-italic"); + it = true; + endif + if (isempty (t.fontsize)) + s = 10; + else + s = t.fontsize; + endif +endfunction + +function [str, f, s] = __maybe_munge_text__ (enhanced, obj, fld) + + persistent warned_latex = false; + + if (strcmp (fld, "string")) + [f, s, fnt, it, bld] = get_fontname_and_size (obj); + else + f = "Helvetica"; + s = 10; + fnt = f; + it = false; + 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")) + 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); + + [s, e, m] = regexp(str,'\\([a-zA-Z]+|0)','start','end','matches'); + + for i = length (s) : -1 : 1 + ## special case for "\0" and replace with "{/Symbol \306}' + if (strncmp (m{i}, '\0', 2)) + str = cstrcat (str(1:s(i) - 1), '{/Symbol \306}', str(s(i) + 2:end)); + else + f = m{i}(2:end); + if (isfield (sym, f)) + g = getfield(sym, f); + ## FIXME The symbol font doesn't seem to support bold or italic + ##if (bld) + ## if (it) + ## g = regexprep (g, '/Symbol', '/Symbol-bolditalic'); + ## else + ## g = regexprep (g, '/Symbol', '/Symbol-bold'); + ## endif + ##elseif (it) + ## g = regexprep (g, '/Symbol', '/Symbol-italic'); + ##endif + str = cstrcat (str(1:s(i) - 1), g, str(e(i) + 1:end)); + elseif (strncmp (f, "rm", 2)) + bld = false; + it = false; + str = cstrcat (str(1:s(i) - 1), '/', fnt, ' ', str(s(i) + 3:end)); + elseif (strncmp (f, "it", 2) || strncmp (f, "sl", 2)) + it = true; + if (bld) + str = cstrcat (str(1:s(i) - 1), '/', fnt, '-bolditalic ', + str(s(i) + 3:end)); + else + str = cstrcat (str(1:s(i) - 1), '/', fnt, '-italic ', + str(s(i) + 3:end)); + endif + elseif (strncmp (f, "bf", 2)) + bld = true; + if (it) + str = cstrcat (str(1:s(i) - 1), '/', fnt, '-bolditalic ', + str(2(i) + 3:end)); + else + str = cstrcat (str(1:s(i) - 1), '/', fnt, '-bold ', + str(s(i) + 3:end)); + endif + elseif (strcmpi (f, "color")) + ## FIXME Ignore \color but remove trailing {} block as well + d = strfind(str(e(i) + 1:end),'}'); + if (isempty (d)) + warning ('syntax error in \color argument'); + else + str = cstrcat (str(1:s(i) - 1), str(e(i) + d + 1:end)); + endif + elseif(strcmpi (f, "fontname")) + b1 = strfind(str(e(i) + 1:end),'{'); + b2 = strfind(str(e(i) + 1:end),'}'); + if (isempty(b1) || isempty(b2)) + warning ('syntax error in \fontname argument'); + else + str = cstrcat (str(1:s(i) - 1), '/', + str(e(i)+b1(1) + 1:e(i)+b2(1)-1), '{}', + str(e(i) + b2(1) + 1:end)); + endif + elseif(strcmpi (f, "fontsize")) + b1 = strfind(str(e(i) + 1:end),'{'); + b2 = strfind(str(e(i) + 1:end),'}'); + if (isempty(b1) || isempty(b2)) + warning ('syntax error in \fontname argument'); + else + str = cstrcat (str(1:s(i) - 1), '/=', + str(e(i)+b1(1) + 1:e(i)+b2(1)-1), '{}', + str(e(i) + b2(1) + 1:end)); + endif + else + ## Last desperate attempt to treat the symbol. Look for things + ## like \pix, that should be translated to the symbol Pi and x + for j = 1 : length (flds) + if (strncmp (flds{j}, f, length (flds{j}))) + g = getfield(sym, flds{j}); + ## FIXME The symbol font doesn't seem to support bold or italic + ##if (bld) + ## if (it) + ## g = regexprep (g, '/Symbol', '/Symbol-bolditalic'); + ## else + ## g = regexprep (g, '/Symbol', '/Symbol-bold'); + ## endif + ##elseif (it) + ## g = regexprep (g, '/Symbol', '/Symbol-italic'); + ##endif + str = cstrcat (str(1:s(i) - 1), g, + str(s(i) + length (flds{j}) + 1:end)); + break; + endif + endfor + endif + endif + endfor + + ## Prepend @ to things things like _0^x or _{-100}^{100} for + ## alignment But need to put the shorter of the two arguments first. + ## Carful of nested {} and unprinted characters when defining + ## shortest.. Don't have to worry about things like ^\theta as they + ## are already converted to ^{/Symbol q}. + + ## FIXME -- This is a mess... Is it worth it just for a "@" character? + + [s, m] = regexp(str,'[_\^]','start','matches'); + i = 1; + p = 0; + while (i < length (s)) + if (i < length(s)) + if (str(s(i) + p + 1) == "{") + s1 = strfind(str(s(i) + p + 2:end),'{'); + si = 1; + l1 = strfind(str(s(i) + p + 1:end),'}'); + li = 1; + while (li <= length (l1) && si <= length (s1)) + if (l1(li) < s1(si)) + if (li == si) + break; + endif + li++; + else + si++; + endif + endwhile + l1 = l1 (min (length(l1), si)); + if (s(i) + l1 + 1 == s(i+1)) + if (str(s(i + 1) + p + 1) == "{") + s2 = strfind(str(s(i + 1) + p + 2:end),'{'); + si = 1; + l2 = strfind(str(s(i + 1) + p + 1:end),'}'); + li = 1; + while (li <= length (l2) && si <= length (s2)) + if (l2(li) < s2(si)) + if (li == si) + break; + endif + li++; + else + si++; + endif + endwhile + l2 = l2 (min (length(l2), si)); + if (length_string (str(s(i)+p+2:s(i)+p+l1-1)) <= + length_string(str(s(i+1)+p+2:s(i+1)+p+l2-1))) + ## Shortest already first! + str = cstrcat (str(1:s(i)+p-1), "@", str(s(i)+p:end)); + else + ## Have to swap sub/super-script to get shortest first. + str = cstrcat (str(1:s(i)+p-1), "@", str(s(i+1)+p:s(i+1)+p+l2), + str(s(i)+p:s(i)+p+l1), str(s(i+1)+p+l2+1:end)); + endif + else + ## Have to swap sub/super-script to get shortest first. + str = cstrcat (str(1:s(i)+p-1), "@", str(s(i+1)+p:s(i+1)+p+1), + str(s(i)+p:s(i)+p+l1), str(s(i+1)+p+2:end)); + endif + i += 2; + p ++; + else + i++; + endif + else + if (s(i+1) == s(i) + 2) + ## Shortest already first! + str = cstrcat (str(1:s(i)+p-1), "@", str(s(i)+p:end)); + p ++; + i += 2; + else + i ++; + endif + endif + else + i ++; + endif + endwhile + +endfunction + +function l = length_string (s) + 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)); + endif +endfunction + +function sym = __setup_sym_table__ () + ## Setup the translation table for TeX to gnuplot enhanced mode. + sym.forall = '{/Symbol \042}'; + sym.exists = '{/Symbol \044}'; + sym.ni = '{/Symbol \047}'; + sym.cong = '{/Symbol \100}'; + sym.Delta = '{/Symbol D}'; + sym.Phi = '{/Symbol F}'; + sym.Gamma = '{/Symbol G}'; + sym.vartheta = '{/Symbol J}'; + sym.Lambda = '{/Symbol L}'; + sym.Pi = '{/Symbol P}'; + sym.Theta = '{/Symbol Q}'; + sym.Sigma = '{/Symbol S}'; + sym.varsigma = '{/Symbol V}'; + sym.Omega = '{/Symbol W}'; + sym.Xi = '{/Symbol X}'; + sym.Psi = '{/Symbol Y}'; + sym.perp = '{/Symbol \136}'; + sym.alpha = '{/Symbol a}'; + sym.beta = '{/Symbol b}'; + sym.chi = '{/Symbol c}'; + sym.delta = '{/Symbol d}'; + sym.epsilon = '{/Symbol e}'; + sym.phi = '{/Symbol f}'; + sym.gamma = '{/Symbol g}'; + sym.eta = '{/Symbol h}'; + sym.iota = '{/Symbol i}'; + sym.varphi = '{/Symbol j}'; + sym.kappa = '{/Symbol k}'; + sym.lambda = '{/Symbol l}'; + sym.mu = '{/Symbol m}'; + sym.nu = '{/Symbol n}'; + sym.o = '{/Symbol o}'; + sym.pi = '{/Symbol p}'; + sym.theta = '{/Symbol q}'; + sym.rho = '{/Symbol r}'; + sym.sigma = '{/Symbol s}'; + sym.tau = '{/Symbol t}'; + sym.upsilon = '{/Symbol u}'; + sym.varpi = '{/Symbol v}'; + sym.omega = '{/Symbol w}'; + sym.xi = '{/Symbol x}'; + sym.psi = '{/Symbol y}'; + sym.zeta = '{/Symbol z}'; + sym.sim = '{/Symbol \176}'; + sym.Upsilon = '{/Symbol \241}'; + sym.prime = '{/Symbol \242}'; + sym.leq = '{/Symbol \243}'; + sym.infty = '{/Symbol \245}'; + sym.clubsuit = '{/Symbol \247}'; + sym.diamondsuit = '{/Symbol \250}'; + sym.heartsuit = '{/Symbol \251}'; + sym.spadesuit = '{/Symbol \252}'; + sym.leftrightarrow = '{/Symbol \253}'; + sym.leftarrow = '{/Symbol \254}'; + sym.uparrow = '{/Symbol \255}'; + sym.rightarrow = '{/Symbol \256}'; + sym.downarrow = '{/Symbol \257}'; + sym.circ = '{/Symbol \260}'; + sym.pm = '{/Symbol \261}'; + sym.geq = '{/Symbol \263}'; + sym.times = '{/Symbol \264}'; + sym.propto = '{/Symbol \265}'; + sym.partial = '{/Symbol \266}'; + sym.bullet = '{/Symbol \267}'; + sym.div = '{/Symbol \270}'; + sym.neq = '{/Symbol \271}'; + sym.equiv = '{/Symbol \272}'; + sym.approx = '{/Symbol \273}'; + sym.ldots = '{/Symbol \274}'; + sym.mid = '{/Symbol \275}'; + sym.aleph = '{/Symbol \300}'; + sym.Im = '{/Symbol \301}'; + sym.Re = '{/Symbol \302}'; + sym.wp = '{/Symbol \303}'; + sym.otimes = '{/Symbol \304}'; + sym.oplus = '{/Symbol \305}'; + sym.oslash = '{/Symbol \306}'; + sym.cap = '{/Symbol \307}'; + sym.cup = '{/Symbol \310}'; + sym.supset = '{/Symbol \311}'; + sym.supseteq = '{/Symbol \312}'; + sym.subset = '{/Symbol \314}'; + sym.subseteq = '{/Symbol \315}'; + sym.in = '{/Symbol \316}'; + sym.notin = '{/Symbol \317}'; + sym.angle = '{/Symbol \320}'; + sym.bigtriangledown = '{/Symbol \321}'; + sym.langle = '{/Symbol \341}'; + sym.rangle = '{/Symbol \361}'; + sym.nabla = '{/Symbol \321}'; + sym.prod = '{/Symbol \325}'; + sym.surd = '{/Symbol \326}'; + sym.cdot = '{/Symbol \327}'; + sym.neg = '{/Symbol \330}'; + sym.wedge = '{/Symbol \331}'; + sym.vee = '{/Symbol \332}'; + sym.Leftrightarrow = '{/Symbol \333}'; + sym.Leftarrow = '{/Symbol \334}'; + sym.Uparrow = '{/Symbol \335}'; + sym.Rightarrow = '{/Symbol \336}'; + sym.Downarrow = '{/Symbol \337}'; + sym.diamond = '{/Symbol \340}'; + sym.copyright = '{/Symbol \343}'; + sym.lfloor = '{/Symbol \353}'; + sym.lceil = '{/Symbol \351}'; + sym.rfloor = '{/Symbol \373}'; + sym.rceil = '{/Symbol \371}'; + sym.int = '{/Symbol \362}'; +endfunction + +function retval = __do_enhanced_option__ (enhanced, obj) + retval = ""; + if (enhanced) + if (strcmpi (obj.interpreter, "none")) + retval = "noenhanced"; + else + retval = "enhanced"; + endif + endif +endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__go_draw_figure__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,198 @@ +## Copyright (C) 2005-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_draw_figure__ (@var{h}, @var{plot_stream}, @var{enhanced}, @var{mono}) +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function __go_draw_figure__ (h, plot_stream, enhanced, mono) + + if (nargin == 4) + htype = get (h, "type"); + if (strcmp (htype, "figure")) + ## Get complete list of children. + kids = allchild (h); + nkids = length (kids); + + if (nkids > 0) + fputs (plot_stream, "\nreset;\n"); + fputs (plot_stream, "set autoscale keepfix;\n"); + fputs (plot_stream, "set origin 0, 0\n"); + fputs (plot_stream, "set size 1, 1\n"); + bg = get (h, "color"); + if (isnumeric (bg)) + fprintf (plot_stream, "set obj 1 rectangle from screen 0,0 to screen 1,1 behind fc rgb \"#%02x%02x%02x\"\n", 255 * bg); + bg_is_set = true; + else + bg_is_set = false; + endif + + for i = nkids:-1:1 + type = get (kids(i), "type"); + switch (type) + case "axes" + if (strcmpi (get (kids (i), "tag"), "legend")) + ## This is so ugly. If there was a way of getting + ## gnuplot to give us the text extents of strings + ## then we could get rid of this mess. + lh = getfield (get (kids(i), "userdata"), "handle"); + if (isscalar (lh)) + ## We have a legend with a single parent. It'll be handled + ## below as a gnuplot key to the axis it corresponds to + continue; + else + ca = lh(1); + ## Rely upon listener to convert axes position + ## to "normalized" units. + legend_axes_units = get (kids(i), "units"); + legend_axes_position = get (kids(i), "position"); + legend_axes_outerposition = get (kids(i), "outerposition"); + legend_axes_box = get (kids(i), "box"); + legend_axes_ylim = get (kids(i), "ylim"); + orig_axes_units = get (ca, "units"); + hlgnd = get (kids(i)); + + unwind_protect + set (ca, "units", "normalized"); + set (kids(i), "units", "normalized", "box", "off", + "ylim", [-2, -1], "position", get (ca(1), "position"), + "outerposition", get (ca(1), "outerposition")); + + ## Create a new set of lines with the appropriate + ## displaynames, etc + toberm = []; + hobj = get (kids(i), "children"); + for j = numel (hobj) : -1 : 1 + if (! strcmp (get (hobj(j), "type"), "text")) + continue; + endif + displayname = get (hobj(j), "string"); + ll = []; + lm = []; + for k = numel (hobj) : -1 : 1 + if (! strcmp (get (hobj(k), "type"), "line")) + continue; + endif + if (get (hobj(j), "userdata") + != get (hobj(k), "userdata")) + continue; + endif + if (! strcmp (get (hobj(k), "linestyle"), "none")) + ll = hobj(k); + endif + if (! strcmp (get (hobj(k), "marker"), "none")) + lm = hobj(k); + endif + endfor + + if (! isempty (ll)) + if (!isempty (lm)) + toberm = [toberm, line("xdata",[0,0],"ydata",[0,0], "color", get(lm,"color"), "linestyle", get(ll,"linestyle"), "marker", get(lm,"marker"), "markeredgecolor", get(lm,"markeredgecolor"), "markerfacecolor", get(lm,"markerfacecolor"), "markersize", get (lm, "markersize"), "displayname", displayname, "parent", kids(i))]; + else + toberm = [toberm, line("xdata",[0,0],"ydata",[0,0], "color", get(ll,"color"), "linestyle", get(ll,"linestyle"), "marker", "none", "displayname", displayname, "parent", kids(i))]; + endif + elseif (! isempty (lm)) + toberm = [toberm, line("xdata",[0,0],"ydata",[0,0], "color", get(lm,"color"), "linestyle", "none", "marker", get(lm,"marker"), "markeredgecolor", get(lm,"markeredgecolor"), "markerfacecolor", get(lm,"markerfacecolor"), "markersize", get (lm, "markersize"), "displayname", displayname, "parent", kids(i))]; + endif + endfor + if (bg_is_set) + fprintf (plot_stream, "set border linecolor rgb \"#%02x%02x%02x\"\n", 255 * (1 - bg)); + endif + __go_draw_axes__ (kids(i), plot_stream, enhanced, mono, + bg_is_set, false, hlgnd); + unwind_protect_cleanup + ## Return axes "units" and "position" back to + ## their original values. + set (ca, "units", orig_axes_units); + set (kids(i), "units", legend_axes_units, + "box", legend_axes_box, + "ylim", legend_axes_ylim, + "position", legend_axes_position, + "outerposition", legend_axes_outerposition); + delete (toberm); + bg_is_set = false; + end_unwind_protect + endif + else + ## Rely upon listener to convert axes position + ## to "normalized" units. + orig_axes_units = get (kids(i), "units"); + orig_axes_position = get (kids(i), "position"); + unwind_protect + set (kids(i), "units", "normalized"); + fg = get (kids(i), "color"); + if (isnumeric (fg) && strcmp (get (kids(i), "visible"), "on")) + fprintf (plot_stream, "set obj 2 rectangle from graph 0,0 to graph 1,1 behind fc rgb \"#%02x%02x%02x\"\n", 255 * fg); + fg_is_set = true; + else + fg_is_set = false; + endif + if (bg_is_set) + fprintf (plot_stream, "set border linecolor rgb \"#%02x%02x%02x\"\n", 255 * (1 - bg)); + endif + ## Find if this axes has an associated legend axes and pass it + ## to __go_draw_axes__ + hlegend = []; + fkids = get (h, "children"); + for j = 1 : numel(fkids) + if (ishandle (fkids (j)) + && strcmp (get (fkids (j), "type"), "axes") + && (strcmp (get (fkids (j), "tag"), "legend"))) + udata = get (fkids (j), "userdata"); + if (isscalar(udata.handle) + && ! isempty (intersect (udata.handle, kids (i)))) + hlegend = get (fkids (j)); + break; + endif + endif + endfor + __go_draw_axes__ (kids(i), plot_stream, enhanced, mono, + bg_is_set, fg_is_set, hlegend); + unwind_protect_cleanup + ## Return axes "units" and "position" back to + ## their original values. + set (kids(i), "units", orig_axes_units); + set (kids(i), "position", orig_axes_position); + bg_is_set = false; + fg_is_set = false; + end_unwind_protect + endif + case "uimenu" + ## ignore uimenu objects + otherwise + error ("__go_draw_figure__: unknown object class, %s", type); + endswitch + endfor + fputs (plot_stream, "\nunset multiplot;\n"); + else + fputs (plot_stream, "\nreset; clear;\n"); + fflush (plot_stream); + endif + else + error ("__go_draw_figure__: expecting figure object, found `%s'", + htype); + endif + else + print_usage (); + endif + +endfunction +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__is_function__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/private/__line__.m Sun Dec 11 23:24:25 2011 -0500 @@ -53,19 +53,69 @@ error ("line: invalid number of PROPERTY / VALUE pairs"); 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 - endif - other_args = {}; if (nvargs > num_data_args) 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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__marching_cube__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,530 @@ +## Copyright (C) 2009-2011 Martin Helm +## +## 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{t}, @var{p}] =} __marching_cube__ (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}) +## @deftypefnx {Function File} {[@var{t}, @var{p}, @var{c}] =} __marching_cube__ (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}, @var{col}) +## Undocumented internal function. +## @end deftypefn + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{t}, @var{p}] =} __marching_cube__ (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}) +## @deftypefnx {Function File} {[@var{t}, @var{p}, @var{c}] =} __marching_cube__ (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}, @var{col}) +## +## Return the triangulation information @var{t} at points @var{p} for +## the isosurface values resp. the volume data @var{val} and the iso +## level @var{iso}. It is considered that the volume data @var{val} is +## given at the points @var{x}, @var{y} and @var{z} which are of type +## three--dimensional numeric arrays. The orientation of the triangles +## is choosen such that the normals point from the higher values to the +## lower values. +## +## Optionally the color data @var{col} can be passed to this function +## whereas computed vertices color data @var{c} is returned as third +## argument. +## +## The marching cube algorithm is well known and described, for example, at +## Wikipedia. The triangulation lookup table and the edge table used +## here are based on Cory Gene Bloyd's implementation and can be found +## beyond other surface and geometry stuff at Paul Bourke's website +## @uref{http://local.wasp.uwa.edu.au/~pbourke/geometry/polygonise}. +## +## For example: +## +## @example +## @group +## N = 20; +## lin = linspace(0, 2, N); +## [x, y, z] = meshgrid (lin, lin, lin); +## +## c = (x-.5).^2 + (y-.5).^2 + (z-.5).^2; +## [t, p] = __marching_cube__ (x, y, z, c, .5); +## +## figure (); +## trimesh (t, p(:,1), p(:,2), p(:,3)); +## @end group +## @end example +## +## Instead of the @command{trimesh} function the @command{patch} +## function can be used to visualize the geometry. For example: +## +## @example +## @group +## figure (); view (-38, 20); +## pa = patch ("Faces", t, "Vertices", p, "FaceVertexCData", p, \ +## "FaceColor", "interp", "EdgeColor", "none"); +## +## ## Revert normals +## set (pa, "VertexNormals", -get(pa, "VertexNormals")); +## +## ## Set lightning (available with the JHandles package) +## # set (pa, "FaceLighting", "gouraud"); +## # light( "Position", [1 1 5]); +## @end group +## @end example +## +## @end deftypefn + +## Author: Martin Helm <martin@mhelm.de> + +function [T, p, col] = __marching_cube__ (xx, yy, zz, c, iso, colors) + + persistent edge_table=[]; + persistent tri_table=[]; + + calc_cols = false; + lindex = 4; + + if (isempty (tri_table) || isempty (edge_table)) + [edge_table, tri_table] = init_mc (); + endif + + if ((nargin != 5 && nargin != 6) || (nargout != 2 && nargout != 3)) + print_usage (); + endif + + if (!ismatrix (xx) || !ismatrix (yy) || !ismatrix (zz) || !ismatrix (c) || ... + ndims (xx) != 3 || ndims (yy) != 3 || ndims (zz) != 3 || ndims (c) != 3) + error ("__marching_cube__: XX, YY, ZZ, C must be matrices of dim 3"); + endif + + if (!size_equal (xx, yy, zz, c)) + error ("__marching_cube__: XX, YY, ZZ, C must be of equal size"); + endif + + if (any (size (xx) < [2 2 2])) + error ("__marching_cube__: grid size must be at least 2x2x2"); + endif + + if (!isscalar (iso)) + error ("__marching_cube__: ISO must be scalar value"); + endif + + if (nargin == 6) + if ( !ismatrix (colors) || ndims (colors) != 3 || size (colors) != size (c) ) + error ( "COLORS must be a matrix of dim 3 and of same size as C" ); + endif + calc_cols = true; + lindex = 5; + endif + + n = size (c) - 1; + + ## phase I: assign information to each voxel which edges are intersected by + ## the isosurface + cc = zeros (n(1), n(2), n(3), "uint16"); + cedge = zeros (size (cc), "uint16"); + + vertex_idx = {1:n(1), 1:n(2), 1:n(3); ... + 2:n(1)+1, 1:n(2), 1:n(3); ... + 2:n(1)+1, 2:n(2)+1, 1:n(3); ... + 1:n(1), 2:n(2)+1, 1:n(3); ... + 1:n(1), 1:n(2), 2:n(3)+1; ... + 2:n(1)+1, 1:n(2), 2:n(3)+1; ... + 2:n(1)+1, 2:n(2)+1, 2:n(3)+1; ... + 1:n(1), 2:n(2)+1, 2:n(3)+1 }; + + ## calculate which vertices have values higher than iso + for ii=1:8 + idx = c(vertex_idx{ii, :}) > iso; + cc(idx) = bitset (cc(idx), ii); + endfor + + cedge = edge_table(cc+1); # assign the info about intersected edges + id = find (cedge); # select only voxels which are intersected + if (isempty (id)) + T = p = col = []; + return + endif + + ## phase II: calculate the list of intersection points + xyz_off = [1, 1, 1; 2, 1, 1; 2, 2, 1; 1, 2, 1; 1, 1, 2; 2, 1, 2; 2, 2, 2; 1, 2, 2]; + edges = [1 2; 2 3; 3 4; 4 1; 5 6; 6 7; 7 8; 8 5; 1 5; 2 6; 3 7; 4 8]; + offset = sub2ind (size (c), xyz_off(:, 1), xyz_off(:, 2), xyz_off(:, 3)) -1; + pp = zeros (length (id), lindex, 12); + ccedge = [vec(cedge(id)), id]; + ix_offset=0; + for jj=1:12 + id__ = bitget (ccedge(:, 1), jj); + id_ = ccedge(id__, 2); + [ix iy iz] = ind2sub (size (cc), id_); + id_c = sub2ind (size (c), ix, iy, iz); + id1 = id_c + offset(edges(jj, 1)); + id2 = id_c + offset(edges(jj, 2)); + if (calc_cols) + pp(id__, 1:5, jj) = [vertex_interp(iso, xx(id1), yy(id1), zz(id1), ... + xx(id2), yy(id2), zz(id2), c(id1), c(id2), colors(id1), colors(id2)), ... + (1:size (id_, 1))' + ix_offset ]; + else + pp(id__, 1:4, jj) = [vertex_interp(iso, xx(id1), yy(id1), zz(id1), ... + xx(id2), yy(id2), zz(id2), c(id1), c(id2)), ... + (1:size (id_, 1))' + ix_offset ]; + endif + ix_offset += size (id_, 1); + endfor + + ## phase III: calculate the triangulation from the point list + T = []; + tri = tri_table(cc(id)+1, :); + for jj=1:3:15 + id_ = find (tri(:, jj)>0); + p = [id_, lindex*ones(size (id_, 1), 1),tri(id_, jj:jj+2)]; + if (!isempty (p)) + p1 = sub2ind (size (pp), p(:,1), p(:,2), p(:,3)); + p2 = sub2ind (size (pp), p(:,1), p(:,2), p(:,4)); + p3 = sub2ind (size (pp), p(:,1), p(:,2), p(:,5)); + T = [T; pp(p1), pp(p2), pp(p3)]; + endif + endfor + + p = []; + col = []; + for jj = 1:12 + idp = pp(:, lindex, jj) > 0; + if (any (idp)) + p(pp(idp, lindex, jj), 1:3) = pp(idp, 1:3, jj); + if (calc_cols) + col(pp(idp, lindex, jj),1) = pp(idp, 4, jj); + endif + endif + endfor +endfunction + +function p = vertex_interp(isolevel,p1x, p1y, p1z,... + p2x, p2y, p2z,valp1,valp2, col1, col2) + + if (nargin == 9) + p = zeros (length (p1x), 3); + elseif (nargin == 11) + p = zeros (length (p1x), 4); + else + error ("__marching_cube__: wrong number of arguments"); + endif + mu = zeros (length (p1x), 1); + id = abs (valp1-valp2) < (10*eps) .* (abs (valp1) .+ abs (valp2)); + if (any (id)) + p(id, 1:3) = [ p1x(id), p1y(id), p1z(id) ]; + if (nargin == 11) + p(id, 4) = col1(id); + endif + endif + nid = !id; + if (any (nid)) + mu(nid) = (isolevel - valp1(nid)) ./ (valp2(nid) - valp1(nid)); + p(nid, 1:3) = [p1x(nid) + mu(nid) .* (p2x(nid) - p1x(nid)), ... + p1y(nid) + mu(nid) .* (p2y(nid) - p1y(nid)), ... + p1z(nid) + mu(nid) .* (p2z(nid) - p1z(nid))]; + if (nargin == 11) + p(nid, 4) = col1(nid) + mu(nid) .* (col2(nid) - col1(nid)); + endif + endif +endfunction + +function [edge_table, tri_table] = init_mc() + edge_table = [ + 0x0 , 0x109, 0x203, 0x30a, 0x406, 0x50f, 0x605, 0x70c, ... + 0x80c, 0x905, 0xa0f, 0xb06, 0xc0a, 0xd03, 0xe09, 0xf00, ... + 0x190, 0x99 , 0x393, 0x29a, 0x596, 0x49f, 0x795, 0x69c, ... + 0x99c, 0x895, 0xb9f, 0xa96, 0xd9a, 0xc93, 0xf99, 0xe90, ... + 0x230, 0x339, 0x33 , 0x13a, 0x636, 0x73f, 0x435, 0x53c, ... + 0xa3c, 0xb35, 0x83f, 0x936, 0xe3a, 0xf33, 0xc39, 0xd30, ... + 0x3a0, 0x2a9, 0x1a3, 0xaa , 0x7a6, 0x6af, 0x5a5, 0x4ac, ... + 0xbac, 0xaa5, 0x9af, 0x8a6, 0xfaa, 0xea3, 0xda9, 0xca0, ... + 0x460, 0x569, 0x663, 0x76a, 0x66 , 0x16f, 0x265, 0x36c, ... + 0xc6c, 0xd65, 0xe6f, 0xf66, 0x86a, 0x963, 0xa69, 0xb60, ... + 0x5f0, 0x4f9, 0x7f3, 0x6fa, 0x1f6, 0xff , 0x3f5, 0x2fc, ... + 0xdfc, 0xcf5, 0xfff, 0xef6, 0x9fa, 0x8f3, 0xbf9, 0xaf0, ... + 0x650, 0x759, 0x453, 0x55a, 0x256, 0x35f, 0x55 , 0x15c, ... + 0xe5c, 0xf55, 0xc5f, 0xd56, 0xa5a, 0xb53, 0x859, 0x950, ... + 0x7c0, 0x6c9, 0x5c3, 0x4ca, 0x3c6, 0x2cf, 0x1c5, 0xcc , ... + 0xfcc, 0xec5, 0xdcf, 0xcc6, 0xbca, 0xac3, 0x9c9, 0x8c0, ... + 0x8c0, 0x9c9, 0xac3, 0xbca, 0xcc6, 0xdcf, 0xec5, 0xfcc, ... + 0xcc , 0x1c5, 0x2cf, 0x3c6, 0x4ca, 0x5c3, 0x6c9, 0x7c0, ... + 0x950, 0x859, 0xb53, 0xa5a, 0xd56, 0xc5f, 0xf55, 0xe5c, ... + 0x15c, 0x55 , 0x35f, 0x256, 0x55a, 0x453, 0x759, 0x650, ... + 0xaf0, 0xbf9, 0x8f3, 0x9fa, 0xef6, 0xfff, 0xcf5, 0xdfc, ... + 0x2fc, 0x3f5, 0xff , 0x1f6, 0x6fa, 0x7f3, 0x4f9, 0x5f0, ... + 0xb60, 0xa69, 0x963, 0x86a, 0xf66, 0xe6f, 0xd65, 0xc6c, ... + 0x36c, 0x265, 0x16f, 0x66 , 0x76a, 0x663, 0x569, 0x460, ... + 0xca0, 0xda9, 0xea3, 0xfaa, 0x8a6, 0x9af, 0xaa5, 0xbac, ... + 0x4ac, 0x5a5, 0x6af, 0x7a6, 0xaa , 0x1a3, 0x2a9, 0x3a0, ... + 0xd30, 0xc39, 0xf33, 0xe3a, 0x936, 0x83f, 0xb35, 0xa3c, ... + 0x53c, 0x435, 0x73f, 0x636, 0x13a, 0x33 , 0x339, 0x230, ... + 0xe90, 0xf99, 0xc93, 0xd9a, 0xa96, 0xb9f, 0x895, 0x99c, ... + 0x69c, 0x795, 0x49f, 0x596, 0x29a, 0x393, 0x99 , 0x190, ... + 0xf00, 0xe09, 0xd03, 0xc0a, 0xb06, 0xa0f, 0x905, 0x80c, ... + 0x70c, 0x605, 0x50f, 0x406, 0x30a, 0x203, 0x109, 0x0 ]; + + tri_table =[ + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 1, 9, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 8, 3, 9, 8, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 3, 1, 2, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 9, 2, 10, 0, 2, 9, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 2, 8, 3, 2, 10, 8, 10, 9, 8, -1, -1, -1, -1, -1, -1, -1; + 3, 11, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 11, 2, 8, 11, 0, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 9, 0, 2, 3, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 11, 2, 1, 9, 11, 9, 8, 11, -1, -1, -1, -1, -1, -1, -1; + 3, 10, 1, 11, 10, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 10, 1, 0, 8, 10, 8, 11, 10, -1, -1, -1, -1, -1, -1, -1; + 3, 9, 0, 3, 11, 9, 11, 10, 9, -1, -1, -1, -1, -1, -1, -1; + 9, 8, 10, 10, 8, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 7, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 3, 0, 7, 3, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 1, 9, 8, 4, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 1, 9, 4, 7, 1, 7, 3, 1, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 10, 8, 4, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 3, 4, 7, 3, 0, 4, 1, 2, 10, -1, -1, -1, -1, -1, -1, -1; + 9, 2, 10, 9, 0, 2, 8, 4, 7, -1, -1, -1, -1, -1, -1, -1; + 2, 10, 9, 2, 9, 7, 2, 7, 3, 7, 9, 4, -1, -1, -1, -1; + 8, 4, 7, 3, 11, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 11, 4, 7, 11, 2, 4, 2, 0, 4, -1, -1, -1, -1, -1, -1, -1; + 9, 0, 1, 8, 4, 7, 2, 3, 11, -1, -1, -1, -1, -1, -1, -1; + 4, 7, 11, 9, 4, 11, 9, 11, 2, 9, 2, 1, -1, -1, -1, -1; + 3, 10, 1, 3, 11, 10, 7, 8, 4, -1, -1, -1, -1, -1, -1, -1; + 1, 11, 10, 1, 4, 11, 1, 0, 4, 7, 11, 4, -1, -1, -1, -1; + 4, 7, 8, 9, 0, 11, 9, 11, 10, 11, 0, 3, -1, -1, -1, -1; + 4, 7, 11, 4, 11, 9, 9, 11, 10, -1, -1, -1, -1, -1, -1, -1; + 9, 5, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 9, 5, 4, 0, 8, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 5, 4, 1, 5, 0, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 8, 5, 4, 8, 3, 5, 3, 1, 5, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 10, 9, 5, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 3, 0, 8, 1, 2, 10, 4, 9, 5, -1, -1, -1, -1, -1, -1, -1; + 5, 2, 10, 5, 4, 2, 4, 0, 2, -1, -1, -1, -1, -1, -1, -1; + 2, 10, 5, 3, 2, 5, 3, 5, 4, 3, 4, 8, -1, -1, -1, -1; + 9, 5, 4, 2, 3, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 11, 2, 0, 8, 11, 4, 9, 5, -1, -1, -1, -1, -1, -1, -1; + 0, 5, 4, 0, 1, 5, 2, 3, 11, -1, -1, -1, -1, -1, -1, -1; + 2, 1, 5, 2, 5, 8, 2, 8, 11, 4, 8, 5, -1, -1, -1, -1; + 10, 3, 11, 10, 1, 3, 9, 5, 4, -1, -1, -1, -1, -1, -1, -1; + 4, 9, 5, 0, 8, 1, 8, 10, 1, 8, 11, 10, -1, -1, -1, -1; + 5, 4, 0, 5, 0, 11, 5, 11, 10, 11, 0, 3, -1, -1, -1, -1; + 5, 4, 8, 5, 8, 10, 10, 8, 11, -1, -1, -1, -1, -1, -1, -1; + 9, 7, 8, 5, 7, 9, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 9, 3, 0, 9, 5, 3, 5, 7, 3, -1, -1, -1, -1, -1, -1, -1; + 0, 7, 8, 0, 1, 7, 1, 5, 7, -1, -1, -1, -1, -1, -1, -1; + 1, 5, 3, 3, 5, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 9, 7, 8, 9, 5, 7, 10, 1, 2, -1, -1, -1, -1, -1, -1, -1; + 10, 1, 2, 9, 5, 0, 5, 3, 0, 5, 7, 3, -1, -1, -1, -1; + 8, 0, 2, 8, 2, 5, 8, 5, 7, 10, 5, 2, -1, -1, -1, -1; + 2, 10, 5, 2, 5, 3, 3, 5, 7, -1, -1, -1, -1, -1, -1, -1; + 7, 9, 5, 7, 8, 9, 3, 11, 2, -1, -1, -1, -1, -1, -1, -1; + 9, 5, 7, 9, 7, 2, 9, 2, 0, 2, 7, 11, -1, -1, -1, -1; + 2, 3, 11, 0, 1, 8, 1, 7, 8, 1, 5, 7, -1, -1, -1, -1; + 11, 2, 1, 11, 1, 7, 7, 1, 5, -1, -1, -1, -1, -1, -1, -1; + 9, 5, 8, 8, 5, 7, 10, 1, 3, 10, 3, 11, -1, -1, -1, -1; + 5, 7, 0, 5, 0, 9, 7, 11, 0, 1, 0, 10, 11, 10, 0, -1; + 11, 10, 0, 11, 0, 3, 10, 5, 0, 8, 0, 7, 5, 7, 0, -1; + 11, 10, 5, 7, 11, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 10, 6, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 3, 5, 10, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 9, 0, 1, 5, 10, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 8, 3, 1, 9, 8, 5, 10, 6, -1, -1, -1, -1, -1, -1, -1; + 1, 6, 5, 2, 6, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 6, 5, 1, 2, 6, 3, 0, 8, -1, -1, -1, -1, -1, -1, -1; + 9, 6, 5, 9, 0, 6, 0, 2, 6, -1, -1, -1, -1, -1, -1, -1; + 5, 9, 8, 5, 8, 2, 5, 2, 6, 3, 2, 8, -1, -1, -1, -1; + 2, 3, 11, 10, 6, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 11, 0, 8, 11, 2, 0, 10, 6, 5, -1, -1, -1, -1, -1, -1, -1; + 0, 1, 9, 2, 3, 11, 5, 10, 6, -1, -1, -1, -1, -1, -1, -1; + 5, 10, 6, 1, 9, 2, 9, 11, 2, 9, 8, 11, -1, -1, -1, -1; + 6, 3, 11, 6, 5, 3, 5, 1, 3, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 11, 0, 11, 5, 0, 5, 1, 5, 11, 6, -1, -1, -1, -1; + 3, 11, 6, 0, 3, 6, 0, 6, 5, 0, 5, 9, -1, -1, -1, -1; + 6, 5, 9, 6, 9, 11, 11, 9, 8, -1, -1, -1, -1, -1, -1, -1; + 5, 10, 6, 4, 7, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 3, 0, 4, 7, 3, 6, 5, 10, -1, -1, -1, -1, -1, -1, -1; + 1, 9, 0, 5, 10, 6, 8, 4, 7, -1, -1, -1, -1, -1, -1, -1; + 10, 6, 5, 1, 9, 7, 1, 7, 3, 7, 9, 4, -1, -1, -1, -1; + 6, 1, 2, 6, 5, 1, 4, 7, 8, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 5, 5, 2, 6, 3, 0, 4, 3, 4, 7, -1, -1, -1, -1; + 8, 4, 7, 9, 0, 5, 0, 6, 5, 0, 2, 6, -1, -1, -1, -1; + 7, 3, 9, 7, 9, 4, 3, 2, 9, 5, 9, 6, 2, 6, 9, -1; + 3, 11, 2, 7, 8, 4, 10, 6, 5, -1, -1, -1, -1, -1, -1, -1; + 5, 10, 6, 4, 7, 2, 4, 2, 0, 2, 7, 11, -1, -1, -1, -1; + 0, 1, 9, 4, 7, 8, 2, 3, 11, 5, 10, 6, -1, -1, -1, -1; + 9, 2, 1, 9, 11, 2, 9, 4, 11, 7, 11, 4, 5, 10, 6, -1; + 8, 4, 7, 3, 11, 5, 3, 5, 1, 5, 11, 6, -1, -1, -1, -1; + 5, 1, 11, 5, 11, 6, 1, 0, 11, 7, 11, 4, 0, 4, 11, -1; + 0, 5, 9, 0, 6, 5, 0, 3, 6, 11, 6, 3, 8, 4, 7, -1; + 6, 5, 9, 6, 9, 11, 4, 7, 9, 7, 11, 9, -1, -1, -1, -1; + 10, 4, 9, 6, 4, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 10, 6, 4, 9, 10, 0, 8, 3, -1, -1, -1, -1, -1, -1, -1; + 10, 0, 1, 10, 6, 0, 6, 4, 0, -1, -1, -1, -1, -1, -1, -1; + 8, 3, 1, 8, 1, 6, 8, 6, 4, 6, 1, 10, -1, -1, -1, -1; + 1, 4, 9, 1, 2, 4, 2, 6, 4, -1, -1, -1, -1, -1, -1, -1; + 3, 0, 8, 1, 2, 9, 2, 4, 9, 2, 6, 4, -1, -1, -1, -1; + 0, 2, 4, 4, 2, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 8, 3, 2, 8, 2, 4, 4, 2, 6, -1, -1, -1, -1, -1, -1, -1; + 10, 4, 9, 10, 6, 4, 11, 2, 3, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 2, 2, 8, 11, 4, 9, 10, 4, 10, 6, -1, -1, -1, -1; + 3, 11, 2, 0, 1, 6, 0, 6, 4, 6, 1, 10, -1, -1, -1, -1; + 6, 4, 1, 6, 1, 10, 4, 8, 1, 2, 1, 11, 8, 11, 1, -1; + 9, 6, 4, 9, 3, 6, 9, 1, 3, 11, 6, 3, -1, -1, -1, -1; + 8, 11, 1, 8, 1, 0, 11, 6, 1, 9, 1, 4, 6, 4, 1, -1; + 3, 11, 6, 3, 6, 0, 0, 6, 4, -1, -1, -1, -1, -1, -1, -1; + 6, 4, 8, 11, 6, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 7, 10, 6, 7, 8, 10, 8, 9, 10, -1, -1, -1, -1, -1, -1, -1; + 0, 7, 3, 0, 10, 7, 0, 9, 10, 6, 7, 10, -1, -1, -1, -1; + 10, 6, 7, 1, 10, 7, 1, 7, 8, 1, 8, 0, -1, -1, -1, -1; + 10, 6, 7, 10, 7, 1, 1, 7, 3, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 6, 1, 6, 8, 1, 8, 9, 8, 6, 7, -1, -1, -1, -1; + 2, 6, 9, 2, 9, 1, 6, 7, 9, 0, 9, 3, 7, 3, 9, -1; + 7, 8, 0, 7, 0, 6, 6, 0, 2, -1, -1, -1, -1, -1, -1, -1; + 7, 3, 2, 6, 7, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 2, 3, 11, 10, 6, 8, 10, 8, 9, 8, 6, 7, -1, -1, -1, -1; + 2, 0, 7, 2, 7, 11, 0, 9, 7, 6, 7, 10, 9, 10, 7, -1; + 1, 8, 0, 1, 7, 8, 1, 10, 7, 6, 7, 10, 2, 3, 11, -1; + 11, 2, 1, 11, 1, 7, 10, 6, 1, 6, 7, 1, -1, -1, -1, -1; + 8, 9, 6, 8, 6, 7, 9, 1, 6, 11, 6, 3, 1, 3, 6, -1; + 0, 9, 1, 11, 6, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 7, 8, 0, 7, 0, 6, 3, 11, 0, 11, 6, 0, -1, -1, -1, -1; + 7, 11, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 7, 6, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 3, 0, 8, 11, 7, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 1, 9, 11, 7, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 8, 1, 9, 8, 3, 1, 11, 7, 6, -1, -1, -1, -1, -1, -1, -1; + 10, 1, 2, 6, 11, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 10, 3, 0, 8, 6, 11, 7, -1, -1, -1, -1, -1, -1, -1; + 2, 9, 0, 2, 10, 9, 6, 11, 7, -1, -1, -1, -1, -1, -1, -1; + 6, 11, 7, 2, 10, 3, 10, 8, 3, 10, 9, 8, -1, -1, -1, -1; + 7, 2, 3, 6, 2, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 7, 0, 8, 7, 6, 0, 6, 2, 0, -1, -1, -1, -1, -1, -1, -1; + 2, 7, 6, 2, 3, 7, 0, 1, 9, -1, -1, -1, -1, -1, -1, -1; + 1, 6, 2, 1, 8, 6, 1, 9, 8, 8, 7, 6, -1, -1, -1, -1; + 10, 7, 6, 10, 1, 7, 1, 3, 7, -1, -1, -1, -1, -1, -1, -1; + 10, 7, 6, 1, 7, 10, 1, 8, 7, 1, 0, 8, -1, -1, -1, -1; + 0, 3, 7, 0, 7, 10, 0, 10, 9, 6, 10, 7, -1, -1, -1, -1; + 7, 6, 10, 7, 10, 8, 8, 10, 9, -1, -1, -1, -1, -1, -1, -1; + 6, 8, 4, 11, 8, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 3, 6, 11, 3, 0, 6, 0, 4, 6, -1, -1, -1, -1, -1, -1, -1; + 8, 6, 11, 8, 4, 6, 9, 0, 1, -1, -1, -1, -1, -1, -1, -1; + 9, 4, 6, 9, 6, 3, 9, 3, 1, 11, 3, 6, -1, -1, -1, -1; + 6, 8, 4, 6, 11, 8, 2, 10, 1, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 10, 3, 0, 11, 0, 6, 11, 0, 4, 6, -1, -1, -1, -1; + 4, 11, 8, 4, 6, 11, 0, 2, 9, 2, 10, 9, -1, -1, -1, -1; + 10, 9, 3, 10, 3, 2, 9, 4, 3, 11, 3, 6, 4, 6, 3, -1; + 8, 2, 3, 8, 4, 2, 4, 6, 2, -1, -1, -1, -1, -1, -1, -1; + 0, 4, 2, 4, 6, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 9, 0, 2, 3, 4, 2, 4, 6, 4, 3, 8, -1, -1, -1, -1; + 1, 9, 4, 1, 4, 2, 2, 4, 6, -1, -1, -1, -1, -1, -1, -1; + 8, 1, 3, 8, 6, 1, 8, 4, 6, 6, 10, 1, -1, -1, -1, -1; + 10, 1, 0, 10, 0, 6, 6, 0, 4, -1, -1, -1, -1, -1, -1, -1; + 4, 6, 3, 4, 3, 8, 6, 10, 3, 0, 3, 9, 10, 9, 3, -1; + 10, 9, 4, 6, 10, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 9, 5, 7, 6, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 3, 4, 9, 5, 11, 7, 6, -1, -1, -1, -1, -1, -1, -1; + 5, 0, 1, 5, 4, 0, 7, 6, 11, -1, -1, -1, -1, -1, -1, -1; + 11, 7, 6, 8, 3, 4, 3, 5, 4, 3, 1, 5, -1, -1, -1, -1; + 9, 5, 4, 10, 1, 2, 7, 6, 11, -1, -1, -1, -1, -1, -1, -1; + 6, 11, 7, 1, 2, 10, 0, 8, 3, 4, 9, 5, -1, -1, -1, -1; + 7, 6, 11, 5, 4, 10, 4, 2, 10, 4, 0, 2, -1, -1, -1, -1; + 3, 4, 8, 3, 5, 4, 3, 2, 5, 10, 5, 2, 11, 7, 6, -1; + 7, 2, 3, 7, 6, 2, 5, 4, 9, -1, -1, -1, -1, -1, -1, -1; + 9, 5, 4, 0, 8, 6, 0, 6, 2, 6, 8, 7, -1, -1, -1, -1; + 3, 6, 2, 3, 7, 6, 1, 5, 0, 5, 4, 0, -1, -1, -1, -1; + 6, 2, 8, 6, 8, 7, 2, 1, 8, 4, 8, 5, 1, 5, 8, -1; + 9, 5, 4, 10, 1, 6, 1, 7, 6, 1, 3, 7, -1, -1, -1, -1; + 1, 6, 10, 1, 7, 6, 1, 0, 7, 8, 7, 0, 9, 5, 4, -1; + 4, 0, 10, 4, 10, 5, 0, 3, 10, 6, 10, 7, 3, 7, 10, -1; + 7, 6, 10, 7, 10, 8, 5, 4, 10, 4, 8, 10, -1, -1, -1, -1; + 6, 9, 5, 6, 11, 9, 11, 8, 9, -1, -1, -1, -1, -1, -1, -1; + 3, 6, 11, 0, 6, 3, 0, 5, 6, 0, 9, 5, -1, -1, -1, -1; + 0, 11, 8, 0, 5, 11, 0, 1, 5, 5, 6, 11, -1, -1, -1, -1; + 6, 11, 3, 6, 3, 5, 5, 3, 1, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 10, 9, 5, 11, 9, 11, 8, 11, 5, 6, -1, -1, -1, -1; + 0, 11, 3, 0, 6, 11, 0, 9, 6, 5, 6, 9, 1, 2, 10, -1; + 11, 8, 5, 11, 5, 6, 8, 0, 5, 10, 5, 2, 0, 2, 5, -1; + 6, 11, 3, 6, 3, 5, 2, 10, 3, 10, 5, 3, -1, -1, -1, -1; + 5, 8, 9, 5, 2, 8, 5, 6, 2, 3, 8, 2, -1, -1, -1, -1; + 9, 5, 6, 9, 6, 0, 0, 6, 2, -1, -1, -1, -1, -1, -1, -1; + 1, 5, 8, 1, 8, 0, 5, 6, 8, 3, 8, 2, 6, 2, 8, -1; + 1, 5, 6, 2, 1, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 3, 6, 1, 6, 10, 3, 8, 6, 5, 6, 9, 8, 9, 6, -1; + 10, 1, 0, 10, 0, 6, 9, 5, 0, 5, 6, 0, -1, -1, -1, -1; + 0, 3, 8, 5, 6, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 10, 5, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 11, 5, 10, 7, 5, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 11, 5, 10, 11, 7, 5, 8, 3, 0, -1, -1, -1, -1, -1, -1, -1; + 5, 11, 7, 5, 10, 11, 1, 9, 0, -1, -1, -1, -1, -1, -1, -1; + 10, 7, 5, 10, 11, 7, 9, 8, 1, 8, 3, 1, -1, -1, -1, -1; + 11, 1, 2, 11, 7, 1, 7, 5, 1, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 3, 1, 2, 7, 1, 7, 5, 7, 2, 11, -1, -1, -1, -1; + 9, 7, 5, 9, 2, 7, 9, 0, 2, 2, 11, 7, -1, -1, -1, -1; + 7, 5, 2, 7, 2, 11, 5, 9, 2, 3, 2, 8, 9, 8, 2, -1; + 2, 5, 10, 2, 3, 5, 3, 7, 5, -1, -1, -1, -1, -1, -1, -1; + 8, 2, 0, 8, 5, 2, 8, 7, 5, 10, 2, 5, -1, -1, -1, -1; + 9, 0, 1, 5, 10, 3, 5, 3, 7, 3, 10, 2, -1, -1, -1, -1; + 9, 8, 2, 9, 2, 1, 8, 7, 2, 10, 2, 5, 7, 5, 2, -1; + 1, 3, 5, 3, 7, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 7, 0, 7, 1, 1, 7, 5, -1, -1, -1, -1, -1, -1, -1; + 9, 0, 3, 9, 3, 5, 5, 3, 7, -1, -1, -1, -1, -1, -1, -1; + 9, 8, 7, 5, 9, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 5, 8, 4, 5, 10, 8, 10, 11, 8, -1, -1, -1, -1, -1, -1, -1; + 5, 0, 4, 5, 11, 0, 5, 10, 11, 11, 3, 0, -1, -1, -1, -1; + 0, 1, 9, 8, 4, 10, 8, 10, 11, 10, 4, 5, -1, -1, -1, -1; + 10, 11, 4, 10, 4, 5, 11, 3, 4, 9, 4, 1, 3, 1, 4, -1; + 2, 5, 1, 2, 8, 5, 2, 11, 8, 4, 5, 8, -1, -1, -1, -1; + 0, 4, 11, 0, 11, 3, 4, 5, 11, 2, 11, 1, 5, 1, 11, -1; + 0, 2, 5, 0, 5, 9, 2, 11, 5, 4, 5, 8, 11, 8, 5, -1; + 9, 4, 5, 2, 11, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 2, 5, 10, 3, 5, 2, 3, 4, 5, 3, 8, 4, -1, -1, -1, -1; + 5, 10, 2, 5, 2, 4, 4, 2, 0, -1, -1, -1, -1, -1, -1, -1; + 3, 10, 2, 3, 5, 10, 3, 8, 5, 4, 5, 8, 0, 1, 9, -1; + 5, 10, 2, 5, 2, 4, 1, 9, 2, 9, 4, 2, -1, -1, -1, -1; + 8, 4, 5, 8, 5, 3, 3, 5, 1, -1, -1, -1, -1, -1, -1, -1; + 0, 4, 5, 1, 0, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 8, 4, 5, 8, 5, 3, 9, 0, 5, 0, 3, 5, -1, -1, -1, -1; + 9, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 11, 7, 4, 9, 11, 9, 10, 11, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 3, 4, 9, 7, 9, 11, 7, 9, 10, 11, -1, -1, -1, -1; + 1, 10, 11, 1, 11, 4, 1, 4, 0, 7, 4, 11, -1, -1, -1, -1; + 3, 1, 4, 3, 4, 8, 1, 10, 4, 7, 4, 11, 10, 11, 4, -1; + 4, 11, 7, 9, 11, 4, 9, 2, 11, 9, 1, 2, -1, -1, -1, -1; + 9, 7, 4, 9, 11, 7, 9, 1, 11, 2, 11, 1, 0, 8, 3, -1; + 11, 7, 4, 11, 4, 2, 2, 4, 0, -1, -1, -1, -1, -1, -1, -1; + 11, 7, 4, 11, 4, 2, 8, 3, 4, 3, 2, 4, -1, -1, -1, -1; + 2, 9, 10, 2, 7, 9, 2, 3, 7, 7, 4, 9, -1, -1, -1, -1; + 9, 10, 7, 9, 7, 4, 10, 2, 7, 8, 7, 0, 2, 0, 7, -1; + 3, 7, 10, 3, 10, 2, 7, 4, 10, 1, 10, 0, 4, 0, 10, -1; + 1, 10, 2, 8, 7, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 9, 1, 4, 1, 7, 7, 1, 3, -1, -1, -1, -1, -1, -1, -1; + 4, 9, 1, 4, 1, 7, 0, 8, 1, 8, 7, 1, -1, -1, -1, -1; + 4, 0, 3, 7, 4, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 8, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 9, 10, 8, 10, 11, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 3, 0, 9, 3, 9, 11, 11, 9, 10, -1, -1, -1, -1, -1, -1, -1; + 0, 1, 10, 0, 10, 8, 8, 10, 11, -1, -1, -1, -1, -1, -1, -1; + 3, 1, 10, 11, 3, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 11, 1, 11, 9, 9, 11, 8, -1, -1, -1, -1, -1, -1, -1; + 3, 0, 9, 3, 9, 11, 1, 2, 9, 2, 11, 9, -1, -1, -1, -1; + 0, 2, 11, 8, 0, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 3, 2, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 2, 3, 8, 2, 8, 10, 10, 8, 9, -1, -1, -1, -1, -1, -1, -1; + 9, 10, 2, 0, 9, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 2, 3, 8, 2, 8, 10, 0, 1, 8, 1, 10, 8, -1, -1, -1, -1; + 1, 10, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 3, 8, 9, 1, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 9, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 3, 8, -1, -1, -1, -1, -1, -1, -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__next_line_color__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,54 @@ +## 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} {@var{rgb} =} __next_line_color__ (@var{reset}) +## Undocumented internal function. +## @end deftypefn + +## Return the next line color in the rotation. + +## Author: jwe + +function rgb = __next_line_color__ (reset) + + persistent color_rotation; + persistent num_colors; + persistent color_index; + + if (nargin < 2) + if (nargin == 1) + if (reset || isempty (color_rotation)) + color_rotation = get (gca (), "colororder"); + num_colors = rows (color_rotation); + color_index = 1; + endif + elseif (! isempty (color_rotation)) + rgb = color_rotation(color_index,:); + if (++color_index > num_colors) + color_index = 1; + __next_line_style__ ("incr"); + endif + else + error ("__next_line_color__: color_rotation not initialized"); + endif + else + print_usage (); + endif + +endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__next_line_style__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,61 @@ +## Copyright (C) 2010-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} =} __next_line_style__ (@var{reset}) +## Undocumented internal function. +## @end deftypefn + +## Return the next line style in the rotation. + + +function [linestyle, marker] = __next_line_style__ (reset) + + persistent style_rotation; + persistent num_styles; + persistent style_index; + + if (nargin < 2) + if (nargin == 1) + if (ischar (reset) && strncmp (reset, "incr", 4)) + if (isempty (style_rotation)) + error ("__next_line_style__: style_rotation not initialized"); + elseif (++style_index > num_styles) + style_index = 1; + endif + elseif (reset || isempty (style_rotation)) + style_rotation = get (gca (), "linestyleorder"); + if (ischar (style_rotation)) + style_rotation = strsplit (style_rotation, "|"); + endif + num_styles = length (style_rotation); + style_index = 1; + endif + elseif (! isempty (style_rotation)) + options = __pltopt__ ("__next_line_style__", + style_rotation (style_index)); + linestyle = options.linestyle; + marker = options.marker; + else + error ("__next_line_style__: style_rotation not initialized"); + endif + else + print_usage (); + endif + +endfunction
--- a/scripts/plot/private/__patch__.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/private/__patch__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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) @@ -270,23 +318,27 @@ 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)); + elseif (isvector (c)) + fvc = c(:); else - fvc = c(:).'; + fvc = c.'(:); endif args = {"faces", faces, "vertices", vert, "facevertexcdata", fvc, args{:}};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__print_parse_opts__.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,610 @@ +## Copyright (C) 2008-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{x}, @var{y}, @var{buttons}] =} ginput (@var{n}) +## 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. +## @end deftypefn + +function arg_st = __print_parse_opts__ (varargin) + + persistent warn_on_missing_binary = true + + arg_st.append_to_file = false; + arg_st.canvas_size = []; + arg_st.debug = false; + arg_st.debug_file = "octave-print-commands.log"; + arg_st.devopt = ""; + arg_st.epstool_binary = __quote_path__ (__find_binary__ ("epstool")); + arg_st.figure = get (0, "currentfigure"); + arg_st.fig2dev_binary = __quote_path__ (__find_binary__ ("fig2dev")); + arg_st.fontsize = ""; + arg_st.font = ""; + arg_st.force_solid = 0; # 0=default, -1=dashed, +1=solid + arg_st.formatted_for_printing = false; + arg_st.ghostscript.binary = __quote_path__ (__ghostscript_binary__ ()); + arg_st.ghostscript.debug = false; + arg_st.ghostscript.device = ""; + arg_st.ghostscript.epscrop = true; + arg_st.ghostscript.level = []; + arg_st.ghostscript.output = ""; + arg_st.ghostscript.papersize = ""; + arg_st.ghostscript.pageoffset = []; + arg_st.ghostscript.resolution = 150; + arg_st.ghostscript.antialiasing = false; + arg_st.loose = false; + arg_st.lpr_binary = __quote_path__ (__find_binary__ ("lpr")); + arg_st.name = ""; + arg_st.orientation = ""; + arg_st.pstoedit_binary = __quote_path__ (__find_binary__ ("pstoedit")); + arg_st.preview = ""; + arg_st.printer = ""; + arg_st.send_to_printer = false; + arg_st.special_flag = "textnormal"; + arg_st.tight_flag = false; + arg_st.use_color = 0; # 0=default, -1=mono, +1=color + + if (isunix ()) + arg_st.lpr_options = "-l"; + elseif (ispc ()) + arg_st.lpr_options = "-o l"; + else + arg_st.lpr_options = ""; + endif + arg_st.unlink = {}; + + if (nargin > 0 && isfigure (varargin{1})) + arg_st.figure = varargin{1}; + varargin(1) = []; + endif + + for i = 1:numel(varargin) + arg = strtrim (varargin{i}); + if (ischar (arg)) + if (strcmp (arg, "-color")) + arg_st.use_color = 1; + elseif (strcmp (arg, "-append")) + arg_st.append_to_file = true; + elseif (strcmp (arg, "-mono")) + arg_st.use_color = -1; + elseif (strcmp (arg, "-solid")) + arg_st.force_solid = 1; + elseif (strcmp (arg, "-dashed")) + arg_st.force_solid = -1; + elseif (strncmp (arg, "-portrait", numel (arg))) + arg_st.orientation = "portrait"; + elseif (strncmp (arg, "-landscape", numel (arg))) + arg_st.orientation = "landscape"; + elseif (strcmp (arg, "-loose")) + arg_st.loose = true; + arg_st.tight_flag = false; + elseif (strcmp (arg, "-tight")) + arg_st.loose = false; + arg_st.tight_flag = true; + elseif (strcmp (arg, "-textspecial")) + arg_st.special_flag = "textspecial"; + elseif (any (strcmp (arg, {"-interchange", "-metafile", "-pict", "-tiff"}))) + arg_st.preview = arg(2:end); + elseif (strncmp (arg, "-debug", 6)) + arg_st.debug = true; + arg_st.ghostscript.debug = true; + if (length (arg) > 7) + arg_st.debug_file = arg(8:end); + endif + elseif (length (arg) > 2 && arg(1:2) == "-d") + arg_st.devopt = tolower (arg(3:end)); + elseif (length (arg) > 2 && arg(1:2) == "-P") + arg_st.printer = arg; + elseif (strncmp (arg, "-EPSTOOL:", 9)) + arg_st.epstool_binary = arg{10:end}; + elseif (strncmp (arg, "-FIG2DEV:", 9)) + arg_st.fig2dev_binary = arg{10:end}; + elseif (strncmp (arg, "-PSTOEDIT:", 9)) + arg_st.pstoedit_binary = arg{10:end}; + elseif ((length (arg) > 2) && arg(1:2) == "-G") + arg_st.ghostscript.binary = file_in_path (getenv ("PATH"), arg(3:end)); + if (isempty (arg_st.ghostscript.binary)) + error ("print: Ghostscript binary ""%s"" could not be located", + arg(3:end)); + else + arg_st.ghostscript_binary = __quote_path__ (arg_st.ghostscript_binary); + endif + elseif (length (arg) > 2 && arg(1:2) == "-F") + idx = rindex (arg, ":"); + if (idx) + arg_st.font = arg(3:idx-1); + arg_st.fontsize = str2num (arg(idx+1:end)); + else + arg_st.font = arg(3:end); + endif + elseif (length (arg) > 2 && arg(1:2) == "-S") + arg_st.canvas_size = str2num (arg(3:end)); + elseif (length (arg) > 2 && arg(1:2) == "-r") + arg_st.ghostscript.resolution = str2double (arg(3:end)); + elseif (length (arg) > 2 && arg(1:2) == "-f") + arg_st.figure = str2num (arg(3:end)); + elseif (length (arg) >= 1 && arg(1) == "-") + error ("print: unknown option `%s'", arg); + elseif (length (arg) > 0) + arg_st.name = arg; + endif + elseif (isfigure (arg)) + arg_st.figure = arg; + else + error ("print: expecting inputs to be character string options or a figure handle"); + endif + endfor + + if (arg_st.ghostscript.resolution == 0) + ## Do as Matlab does. + arg_st.ghostscript.resolution = num2str (get (0, "screenpixelsperinch")); + endif + + if (isempty (arg_st.orientation)) + if (isfigure (arg_st.figure)) + arg_st.orientation = get (arg_st.figure, "paperorientation"); + else + ## Allows tests to be run without error. + arg_st.orientation = "portrait"; + endif + endif + + if (isempty (arg_st.ghostscript.binary)) + arg_st.ghostscript.binary = __ghostscript_binary__ (); + endif + + dot = rindex (arg_st.name, "."); + if (isempty (arg_st.devopt)) + if (dot == 0) + arg_st.devopt = "psc"; + else + arg_st.devopt = tolower (arg_st.name(dot+1:end)); + endif + endif + + if (arg_st.use_color == 0) + if (any (strcmp ({"ps", "ps2", "eps", "eps2"}, arg_st.devopt))) + arg_st.use_color = -1; + else + arg_st.use_color = 1; + endif + endif + + if (strcmp (arg_st.devopt, "tex")) + arg_st.devopt = "epslatex"; + elseif (strcmp (arg_st.devopt, "ill")) + arg_st.devopt = "aifm"; + elseif (strcmp (arg_st.devopt, "cdr")) + arg_st.devopt = "corel"; + elseif (strcmp (arg_st.devopt, "meta")) + arg_st.devopt = "emf"; + elseif (strcmp (arg_st.devopt, "jpg")) + arg_st.devopt = "jpeg"; + endif + + dev_list = {"aifm", "corel", "fig", "png", "jpeg", ... + "gif", "pbm", "pbmraw", "dxf", "mf", ... + "svg", "hpgl", "ps", "ps2", "psc", ... + "psc2", "eps", "eps2", "epsc", "epsc2", ... + "emf", "pdf", "pslatex", "epslatex", "epslatexstandalone", ... + "pslatexstandalone", "pdflatexstandalone", ... + "pstex", "tiff", "tiffn" "tikz", "pcxmono", ... + "pcx24b", "pcx256", "pcx16", "pgm", "pgmraw", ... + "ppm", "ppmraw", "pdflatex", "texdraw", ... + "pdfcairo", "pngcairo", "pstricks", ... + "epswrite", "pswrite", "ps2write", "pdfwrite"}; + + suffixes = {"ai", "cdr", "fig", "png", "jpg", ... + "gif", "pbm", "pbm", "dxf", "mf", ... + "svg", "hpgl", "ps", "ps", "ps", ... + "ps", "eps", "eps", "eps", "eps", ... + "emf", "pdf", "tex", "tex", "tex", ... + "tex", "tex", ... + "ps", "tiff", "tiff", "tikz", "pcx", ... + "pcx", "pcx", "pcx", "pgm", "pgm", ... + "ppm", "ppm", "tex", "tex", ... + "pdf", "png", "tex", ... + "eps", "ps", "ps", "pdf"}; + + if (isfigure (arg_st.figure)) + __graphics_toolkit__ = get (arg_st.figure, "__graphics_toolkit__"); + else + ## Allow tests when no figures are present. + __graphics_toolkit__ = get (0, "defaultfigure__graphics_toolkit__"); + endif + + if (strcmp (__graphics_toolkit__, "gnuplot") + && __gnuplot_has_feature__ ("epslatex_implies_eps_filesuffix")) + suffixes(strncmp (dev_list, "epslatex", 8)) = {"eps"}; + endif + + match = strcmpi (dev_list, arg_st.devopt); + if (any (match)) + default_suffix = suffixes {match}; + else + default_suffix = arg_st.devopt; + endif + + if (dot == 0 && ! isempty (arg_st.name)) + arg_st.name = strcat (arg_st.name, ".", default_suffix); + endif + + if (arg_st.append_to_file) + if (isempty (arg_st.name)) + arg_st.append_to_file = false; + elseif (any (strcmpi (arg_st.devopt, {"eps", "eps2", "epsc", "epsc2", ... + "ps", "ps2", "psc", "psc2", "pdf"}))) + have_ghostscript = ! isempty (__ghostscript_binary__ ()); + if (have_ghostscript) + file_exists = ((numel (dir (arg_st.name)) == 1) + && (! isdir (arg_st.name))); + if (! file_exists) + arg_st.append_to_file = false; + endif + else + arg_st.append_to_file = false; + warning ("print.m: appended output requires ghostscript to be installed"); + endif + else + warning ("print.m: appended output is not supported for device '%s'", + arg_st.devopt); + arg_st.append_to_file = false; + endif + endif + + if (! isempty (arg_st.printer) || isempty (arg_st.name)) + arg_st.send_to_printer = true; + endif + + if (any (strcmp (arg_st.devopt, {"ps", "ps2", "psc", "psc2", "pdf"}))) + arg_st.formatted_for_printing = true; + endif + + aliases = gs_aliases (); + if (any (strcmp (arg_st.devopt, fieldnames (aliases)))) + arg_st.devopt = aliases.(arg_st.devopt); + endif + + ## FIXME - eps2 & epsc2 needs to be handled + if (strcmp (arg_st.devopt, "pswrite")) + arg_st.ghostscript.level = 1; + elseif (strcmp (arg_st.devopt, "ps2write")) + arg_st.ghostscript.level = 2; + endif + + if ((any (strcmp (arg_st.devopt, gs_device_list)) + && ! arg_st.formatted_for_printing) + || any (strcmp (arg_st.devopt, {"pswrite", "ps2write", "pdfwrite"}))) + ## Use ghostscript for graphic formats + arg_st.ghostscript.device = arg_st.devopt; + arg_st.ghostscript.output = arg_st.name; + arg_st.ghostscript.antialiasing = true; + if (arg_st.formatted_for_printing) + arg_st.ghostscript.epscrop = ! arg_st.loose; + else + ## pstoedit throws errors if the EPS file isn't cropped + arg_st.ghostscript.epscrop = true; + endif + elseif (all (! strcmp (arg_st.devopt, dev_list))) + ## Assume we are formating output for a printer + arg_st.formatted_for_printing = true; + arg_st.ghostscript.device = arg_st.devopt; + arg_st.ghostscript.output = arg_st.name; + arg_st.ghostscript.antialiasing = false; + arg_st.ghostscript.epscrop = ! arg_st.loose; + endif + + if (isempty (arg_st.canvas_size)) + if (isfigure (arg_st.figure)) + [arg_st.ghostscript.papersize, paperposition] = ... + gs_papersize (arg_st.figure, arg_st.orientation); + else + ## allows tests to be run + arg_st.ghostscript.papersize = "letter"; + paperposition = [0.25, 2.50, 8.00, 6.00] * 72; + endif + arg_st.canvas_size = paperposition(3:4); + if (strcmp (__graphics_toolkit__, "gnuplot") && ! arg_st.ghostscript.epscrop) + arg_st.ghostscript.pageoffset = paperposition(1:2) - 50; + else + arg_st.ghostscript.pageoffset = paperposition(1:2); + endif + else + ## Convert canvas size to points from pixles. + arg_st.canvas_size = arg_st.canvas_size * 72 / arg_st.ghostscript.resolution; + arg_st.ghostscript.papersize = arg_st.canvas_size; + arg_st.ghostscript.epscrop = true; + arg_st.ghostscript.pageoffset = [0, 0]; + endif + + if (arg_st.formatted_for_printing) + arg_st.ghostscript.resolution = []; + else + arg_st.ghostscript.papersize = ""; + arg_st.ghostscript.pageoffset = [0, 0]; + endif + + if (warn_on_missing_binary) + if (isempty (arg_st.ghostscript.binary)) + warning ("print:missing_gs", "print.m: Ghostscript binary is not available.\nOnly eps output is available."); + else + if (isempty (arg_st.epstool_binary)) + warning ("print:missing_epstool", "print.m: epstool binary is not available.\nSome output formats are not available."); + endif + if (isempty (arg_st.fig2dev_binary)) + warning ("print:missing_fig2dev", "print.m: fig2dev binary is not available.\nSome output formats are not available."); + endif + if (isempty (arg_st.pstoedit_binary)) + warning ("print:missing_pstoedit", "print.m: pstoedit binary is not available.\nSome output formats are not available."); + endif + endif + warn_on_missing_binary = false; + endif + +endfunction + +## 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); +%! assert (opts.send_to_printer, true); +%! assert (opts.canvas_size, [576, 432]); +%! assert (opts.ghostscript.device, "pswrite") + +#%!test +%! opts = __print_parse_opts__ ("test.pdf", "-S640,480"); +%! assert (opts.canvas_size, [307.2, 230.4], 0.1); + +#%!test +%! opts = __print_parse_opts__ ("-dpsc", "-append", "-loose"); +%! assert (opts.devopt, "pswrite"); +%! assert (opts.send_to_printer, true); +%! assert (opts.use_color, 1); +%! assert (opts.append_to_file, false); +%! assert (opts.ghostscript.device, "pswrite") +%! assert (opts.ghostscript.epscrop, false); + +#%!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 +%! opts = __print_parse_opts__ ("-djpg", "foobar", "-mono", "-loose"); +%! assert (opts.devopt, "jpeg") +%! assert (opts.name, "foobar.jpg") +%! assert (opts.ghostscript.device, "jpeg") +%! assert (opts.ghostscript.epscrop, true); +%! assert (opts.ghostscript.papersize, ""); +%! assert (opts.ghostscript.pageoffset, [0, 0]); +%! assert (opts.send_to_printer, false); +%! assert (opts.printer, ""); +%! assert (opts.use_color, -1); + +#%!test +%! opts = __print_parse_opts__ ("-ddeskjet", "foobar", "-mono", "-Pmyprinter"); +%! assert (opts.ghostscript.output, "foobar.deskjet") +%! assert (opts.ghostscript.device, "deskjet") +%! assert (opts.devopt, "deskjet") +%! assert (opts.send_to_printer, true); +%! assert (opts.printer, "-Pmyprinter"); +%! assert (opts.use_color, -1); + +#%!test +%! opts = __print_parse_opts__ ("-f5", "-dljet3"); +%! assert (opts.ghostscript.device, "ljet3") +%! assert (strfind (opts.ghostscript.output, ".ljet3")) +%! assert (opts.devopt, "ljet3") +%! assert (opts.send_to_printer, true); +%! assert (opts.figure, 5) + +function cmd = __quote_path__ (cmd) + if (any (cmd == " ") && ! (cmd(1) == """" && cmd(end) == """")) + cmd = strcat ("""", strrep (cmd, """", """"""), """"); + endif +endfunction + +function gs = __ghostscript_binary__ () + + persistent ghostscript_binary = "" + persistent warn_on_no_ghostscript = true + persistent warn_on_bad_gsc = true + + if (isempty (ghostscript_binary)) + GSC = getenv ("GSC"); + if (exist (GSC, "file") + || (! isempty (GSC) && file_in_path (getenv ("PATH"), GSC))) + gs_binaries = {GSC}; + elseif (! isempty (GSC) && warn_on_bad_gsc) + warning ("print:badgscenv", + "print.m: GSC environment variable not set properly"); + warn_on_bad_gsc = false; + gs_binaries = {}; + else + gs_binaries = {}; + endif + if (isunix ()) + ## Unix - Includes Mac OSX and Cygwin. + gs_binaries = horzcat (gs_binaries, {"gs", "gs.exe"}); + else + ## pc - Includes Win32 and mingw. + gs_binaries = horzcat (gs_binaries, {"gs.exe", "gswin32c.exe", "mgs.exe"}); + endif + n = 0; + while (n < numel (gs_binaries) && isempty (ghostscript_binary)) + n = n + 1; + ghostscript_binary = file_in_path (getenv ("PATH"), gs_binaries{n}); + endwhile + if (warn_on_no_ghostscript && isempty (ghostscript_binary)) + warning ("print:noghostscript", + "print.m: ghostscript not found in PATH"); + warn_on_no_ghostscript = false; + endif + endif + + gs = ghostscript_binary; + +endfunction + +function bin = __find_binary__ (binary) + + persistent data = struct () + + if (! isfield (data, binary)) + ## Reinitialize when `user_binaries' is present. + data.(binary).bin = ""; + data.(binary).warn_on_absence = false; + endif + + if (isempty (data.(binary).bin)) + if (isunix ()) + ## Unix - Includes Mac OSX and Cygwin. + binaries = strcat (binary, {"", ".exe"}); + else + ## pc - Includes Win32 and mingw. + binaries = strcat (binary, {".exe"}); + endif + n = 0; + while (n < numel (binaries) && isempty (data.(binary).bin)) + n = n + 1; + data.(binary).bin = file_in_path (getenv ("PATH"), binaries{n}); + endwhile + if (isempty (data.(binary).bin) && data.(binary).warn_on_absence) + warning (sprintf ("print:no%s", binary), + "print.m: '%s' not found in PATH", binary); + data.(binary).warn_on_absence = false; + endif + endif + + bin = data.(binary).bin; + +endfunction + +function [papersize, paperposition] = gs_papersize (hfig, paperorientation) + persistent papertypes papersizes + + if (isempty (papertypes)) + papertypes = {"usletter", "uslegal", "a0", "a1", ... + "a2", "a3", "a4", "a5", ... + "b0", "b1", "b2", "b3", ... + "b4", "b5", "arch-a", "arch-b", ... + "arch-c", "arch-d", "arch-e", "a", ... + "b", "c", "d", "e", ... + "tabloid"}; + papersizes = [ 8.5, 11.0; 8.5, 14.0; 33.1, 46.8; 23.4, 33.1; + 16.5, 23.4; 11.7, 16.5; 8.3, 11.7; 5.8, 8.3; + 39.4, 55.7; 27.8, 39.4; 19.7, 27.8; 13.9, 19.7; + 9.8, 13.9; 6.9, 9.8; 9.0, 12.0; 12.0, 18.0; + 18.0, 24.0; 24.0, 36.0; 36.0, 48.0; 8.5, 11.0; + 11.0, 17.0; 18.0, 24.0; 24.0, 36.0; 36.0, 48.0; + 11.0, 17.0] * 72; + endif + + papertype = get (hfig, "papertype"); + paperunits = get (hfig, "paperunits"); + paperposition = get (hfig, "paperposition"); + if (strcmp (papertype, "<custom>")) + papersize = get (hfig, "papersize"); + papersize = convert2points (papersize , paperunits); + else + papersize = papersizes (strcmp (papertypes, papertype), :); + endif + + if (strcmp (paperunits, "normalized")) + paperposition = paperposition .* papersize([1,2,1,2]); + else + paperposition = convert2points (paperposition, paperunits); + endif + + ## FIXME - This will be obsoleted by listeners for paper properties. + ## Papersize is tall when portrait,and wide when landscape. + if ((papersize(1) > papersize(2) && strcmpi (paperorientation, "portrait")) + || (papersize(1) < papersize(2) && strcmpi (paperorientation, "landscape"))) + papersize = papersize ([2,1]); + paperposition = paperposition([2,1,4,3]); + endif + + if ((! strcmp (papertype, "<custom>")) && (strcmp (paperorientation, "portrait"))) + ## For portrait use the ghostscript name + papersize = papertype; + papersize(papersize=="-") = ""; + papersize = strrep (papersize, "us", ""); + switch (papersize) + case "a" + papersize = "letter"; + case {"b", "tabloid"} + papersize = "11x17"; + case {"c", "d", "e"} + papersize = strcat ("arch", papersize); + endswitch + if (strncmp (papersize, "arch", 4)) + papersize(end) = upper (papersize(end)); + endif + endif + +endfunction + +function value = convert2points (value, units) + switch (units) + case "inches" + value = value * 72; + case "centimeters" + value = value * 72 / 2.54; + case "normalized" + error ("print:customnormalized", + "print.m: papersize=='<custom>' and paperunits='normalized' may not be combined"); + endswitch +endfunction + +function device_list = gs_device_list (); + ## Graphics formats/languages, not priners. + device_list = {"bmp16"; "bmp16m"; "bmp256"; "bmp32b"; "bmpgray"; ... + "epswrite"; "jpeg"; "jpegcymk"; "jpeggray"; "pbm"; ... + "pbmraw"; "pcx16"; "pcx24b"; "pcx256"; "pcx2up"; ... + "pcxcmyk"; "pcxgray"; "pcxmono"; "pdfwrite"; "pgm"; ... + "pgmraw"; "pgnm"; "pgnmraw"; "png16"; "png16m"; ... + "png256"; "png48"; "pngalpha"; "pnggray"; "pngmono"; ... + "pnm"; "pnmraw"; "ppm"; "ppmraw"; "ps2write"; ... + "pswrite"; "tiff12nc"; "tiff24nc"; "tiff32nc"; ... + "tiffcrle"; "tiffg3"; "tiffg32d"; "tiffg4"; ... + "tiffgray"; "tifflzw"; "tiffpack"; "tiffsep"}; +endfunction + +function aliases = gs_aliases (); + ## Aliases for other devices: "bmp", "png", "tiff", "tiffn", "pdf", + ## "ps", "ps2", "psc", "psc2" + ## + ## eps, epsc, eps2, epsc2 are not included here because those are + ## are generated by the graphics toolkit. + aliases.bmp = "bmp32b"; + aliases.pdf = "pdfwrite"; + aliases.png = "png16m"; + aliases.ps = "pswrite"; + aliases.ps2 = "ps2write"; + aliases.psc = "pswrite"; + aliases.psc2 = "ps2write"; + aliases.tiff = "tiff24nc"; + aliases.tiffn = "tiff24nc"; +endfunction +
--- a/scripts/plot/private/__quiver__.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/private/__quiver__.m Sun Dec 11 23:24:25 2011 -0500 @@ -125,8 +125,8 @@ 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; + else # special case of identical points with multiple vectors + s = autoscale; endif uu = s * u; vv = s * v;
--- a/scripts/plot/private/__scatter__.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/private/__scatter__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__uigetdir_fltk__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__uigetfile_fltk__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__uiobject_split_args__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__uiputfile_fltk__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/quiver.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,18 @@ 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); +%! 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/quiver3.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- a/scripts/plot/rectangle.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/rectangle.m Sun Dec 11 23:24:25 2011 -0500 @@ -25,15 +25,15 @@ ## @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 +## @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 +## 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 @@ -41,12 +41,13 @@ ## by ## ## @example -## min (pos (1: 2)) / max (pos (1:2)) * curv +## min (pos (1:2)) / max (pos (1:2)) * curv ## @end example ## -## Other properties are passed to the underlying patch command. If called -## with an output argument, @code{rectangle} returns the handle to the -## rectangle. +## 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} @@ -204,17 +205,17 @@ %!demo -%! close all +%! clf %! axis equal %! rectangle ("Position", [0.05, 0.05, 0.9, 0.9], "Curvature", [0.5, 0.5]); %!demo -%! close all +%! clf %! axis equal %! rectangle ("Position", [0.05, 0.05, 0.9, 0.4], "Curvature", 1.0); %!demo -%! close all +%! 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/refreshdata.m Sun Dec 11 23:24:25 2011 -0500 @@ -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{:})}];
--- a/scripts/plot/ribbon.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ribbon.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,9 @@ endfunction + %!demo %! [x, y, z] = sombrero (); %! [x, y] = meshgrid (x, y); %! ribbon (y, z); +
--- a/scripts/plot/rose.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/rose.m Sun Dec 11 23:24:25 2011 -0500 @@ -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)
--- a/scripts/plot/scatter.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/scatter.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/scatter3.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- a/scripts/plot/semilogx.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/semilogx.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,62 @@ end_unwind_protect endfunction + + +%!demo +%! 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/semilogy.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/semilogy.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,61 @@ end_unwind_protect endfunction + +%!demo +%! 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/shading.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/shading.m Sun Dec 11 23:24:25 2011 -0500 @@ -73,24 +73,36 @@ endfunction + %!demo %! clf %! colormap (jet) %! sombrero %! shading faceted -%! title("shading ""faceted""") +%! title ('shading "faceted"') + +%!demo +%! sombrero +%! shading flat +%! title ('shading "flat"') %!demo %! sombrero %! shading interp -%! title("shading ""interp""") +%! title ('shading "interp"') %!demo %! pcolor (peaks ()) %! shading faceted -%! title("shading ""faceted""") +%! title ('shading "faceted"') + +%!demo +%! pcolor (peaks ()) +%! shading flat +%! title ('shading "flat"') %!demo %! pcolor (peaks ()) %! shading interp -%! title("shading ""interp""") +%! title ('shading "interp"') +
--- a/scripts/plot/slice.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/slice.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,14 @@ endfunction + %!demo %! [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 %! [xi, yi] = meshgrid (linspace (-7, 7)); %! zi = xi + yi; %! slice (x, y, z, v, xi, yi, zi); +
--- a/scripts/plot/stem.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/stem.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,33 +86,34 @@ endfunction + %!demo %! x = 1:10; %! stem (x); %!demo %! x = 1:10; -%! y = ones (1, length (x))*2.*x; +%! y = 2*x; %! stem (x, y); %!demo %! x = 1:10; -%! y = ones (size (x))*2.*x; +%! y = 2*x; %! h = stem (x, y, "r"); %!demo %! x = 1:10; -%! y = ones (size (x))*2.*x; +%! y = 2*x; %! h = stem (x, y, "-.k"); %!demo %! x = 1:10; -%! y = ones (size (x))*2.*x; +%! y = 2*x; %! h = stem (x, y, "-.k."); %!demo %! x = 1:10; -%! y = ones (size (x))*2.*x; +%! y = 2*x; %! h = stem (x, y, "filled"); %!demo @@ -121,3 +122,4 @@ %! h = stem (x, y); %! set (h(2), "color", "g"); %! set (h(1), "basevalue", -1) +
--- a/scripts/plot/subplot.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/subplot.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/surf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 @@ -61,19 +64,21 @@ endfunction + %!demo %! clf -%! [~,~,Z]=peaks; -%! surf(Z); +%! [~,~,Z] = peaks; +%! surf (Z); %!demo -%! [~,~,Z]=sombrero; -%! [Fx,Fy] = gradient(Z); -%! surf(Z,Fx+Fy); +%! [~,~,Z] = sombrero; +%! [Fx,Fy] = gradient (Z); +%! surf (Z, Fx+Fy); %! shading interp; %!demo -%! [X,Y,Z]=sombrero; -%! [~,Fy] = gradient(Z); -%! surf(X,Y,Z,Fy); +%! [X,Y,Z] = sombrero; +%! [~,Fy] = gradient (Z); +%! surf (X, Y, Z, Fy); %! shading interp; +
--- a/scripts/plot/surface.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/surface.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/surfc.m Sun Dec 11 23:24:25 2011 -0500 @@ -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];
--- a/scripts/plot/text.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/text.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/title.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/trimesh.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,68 @@ +## Copyright (C) 2007-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} {} trimesh (@var{tri}, @var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {@var{h} =} trimesh (@dots{}) +## 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 optional return value @var{h} is a graphics handle to the created plot. +## @seealso{triplot, trisurf, delaunay3} +## @end deftypefn + +function h = trimesh (tri, x, y, z, varargin) + + if (nargin < 3) + print_usage (); + endif + + if (nargin == 3) + triplot (tri, x, y); + elseif (ischar (z)) + triplot (tri, x, y, z, varargin{:}); + else + newplot (); + 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 +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 10); +%! N = 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(:)); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/triplot.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,59 @@ +## Copyright (C) 2007-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} {} triplot (@var{tri}, @var{x}, @var{y}) +## @deftypefnx {Function File} {} triplot (@var{tri}, @var{x}, @var{y}, @var{linespec}) +## @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, @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 + +function h = triplot (tri, x, y, varargin) + + if (nargin < 3) + print_usage (); + endif + + idx = tri(:, [1, 2, 3, 1]).'; + nt = rows (tri); + handle = plot ([x(idx); NaN(1, nt)](:), + [y(idx); NaN(1, nt)](:), varargin{:}); + + if (nargout > 0) + h = handle; + endif + +endfunction + + +%!demo +%! 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); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/trisurf.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,106 @@ +## Copyright (C) 2007-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} {} trisurf (@var{tri}, @var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {@var{h} =} trisurf (@dots{}) +## 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 optional return value @var{h} is a graphics handle to the created plot. +## @seealso{triplot, trimesh, delaunay3} +## @end deftypefn + +function h = trisurf (tri, x, y, z, varargin) + + if (nargin < 3) + print_usage (); + endif + + if (nargin == 3) + triplot (tri, x, y); + elseif (ischar (z)) + triplot (tri, x, y, z, varargin{:}); + else + if (nargin > 4 && isnumeric (varargin{1})) + c = varargin{1}; + varargin(1) = []; + 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 = handle; + endif + + if (! ishold ()) + set (gca(), "view", [-37.5, 30], + "xgrid", "on", "ygrid", "on", "zgrid", "on"); + endif + endif + +endfunction + + +%!demo +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 10); +%! N = 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 +%! x = rand (100, 1); +%! y = rand (100, 1); +%! z = x.^2 + y.^2; +%! tri = delaunay (x, y); +%! trisurf (tri, x, y, z); + +%!demo +%! 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 +%! 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"); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/uicontextmenu.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/uicontrol.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- a/scripts/plot/uigetdir.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/uigetdir.m Sun Dec 11 23:24:25 2011 -0500 @@ -28,10 +28,19 @@ ## 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") - if (exist("__fltk_uigetfile__") != 3) - error ("uigetfile: fltk graphics toolkit required"); + 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) @@ -45,9 +54,13 @@ if (!isdir (init_path)) init_path = fileparts (init_path); endif - dirname = __fltk_uigetfile__ ("", dialog_name, init_path, [240, 120], "dir"); + dirname = feval (funcname, init_path, dialog_name); endfunction %!demo %! uigetdir(pwd, "Select Directory") + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1);
--- a/scripts/plot/uigetfile.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/uigetfile.m Sun Dec 11 23:24:25 2011 -0500 @@ -64,22 +64,32 @@ function [retfile, retpath, retindex] = uigetfile (varargin) - if (exist("__fltk_uigetfile__") != 3) - error ("uigetfile: fltk graphics toolkit required"); + 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 endif if (nargin > 7) error ("uigetfile: number of input arguments must be less than eight"); endif - 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 + 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 (5, 1); - for i = 1 : 5 + outargs = cell (6, 1); + for i = 1 : 6 outargs{i} = defaultvals{i}; endfor @@ -88,9 +98,9 @@ for i = 1 : length (varargin) val = varargin{i}; if (ischar (val)) - if (strncmp (tolower (val), "multiselect", 11)) + if (strncmpi (val, "multiselect", 11)) idx1 = i; - elseif (strncmp(tolower (val), "position", 8)) + elseif (strncmpi (val, "position", 8)) idx2 = i; endif endif @@ -110,18 +120,36 @@ 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; + [outargs{1}, outargs{3}, defdir] = __file_filter__ (file_filter); + if (length (defdir) > 0) + outargs{6} = defdir; + endif + else + 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 > 1) - outargs{2} = args{2}; - endif - if (len > 2) - outargs{3} = args{3}; + 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) @@ -153,9 +181,13 @@ endfor endif - [retfile, retpath, retindex] = __fltk_uigetfile__ (outargs{:}); + [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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/uimenu.m Sun Dec 11 23:24:25 2011 -0500 @@ -66,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} @@ -77,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{:}); @@ -98,11 +89,60 @@ 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)"); +%! 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 +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/uipanel.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/uipushtool.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- a/scripts/plot/uiputfile.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/uiputfile.m Sun Dec 11 23:24:25 2011 -0500 @@ -55,44 +55,74 @@ function [retfile, retpath, retindex] = uiputfile (varargin) - if (exist("__fltk_uigetfile__") != 3) - error ("uiputfile: fltk graphics toolkit required"); + 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 > 3) print_usage (); endif - defaultvals = {"All Files(*)", #FLTK File Filter - "Save File?", #Dialog Title - pwd, #FLTK default file name - [240, 120], #Dialog Position (pixel x/y) - "create"}; + 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(5, 1); - for i = 1 : 5 + outargs = cell(6, 1); + for i = 1 : 6 outargs{i} = defaultvals{i}; endfor if (nargin > 0) file_filter = varargin{1}; - outargs{1} = __fltk_file_filter__ (file_filter); - if (ischar (file_filter)) - outargs{3} = file_filter; + [outargs{1}, outargs{3}, defdir] = __file_filter__ (file_filter); + if (length (defdir) > 0) + outargs{6} = defdir; endif + else + outargs{1} = __file_filter__ (outargs{1}); endif if (nargin > 1) - outargs{2} = varargin{2}; + if (ischar (varargin{2})) + outargs{2} = varargin{2}; + elseif (! isempty (varargin{2})) + print_usage (); + endif endif if (nargin > 2) - outargs{3} = varargin{3}; + 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] = __fltk_uigetfile__ (outargs{:}); + [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);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/uiresume.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/uitoggletool.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/uitoolbar.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/uiwait.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/view.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/waitbar.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/whitebg.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/xlabel.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/xlim.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ylabel.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/ylim.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/zlabel.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/plot/zlim.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/compan.m Sun Dec 11 23:24:25 2011 -0500 @@ -51,7 +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, +## @seealso{poly, roots, residue, conv, deconv, polyval, polyder, ## polyint} ## @end deftypefn
--- a/scripts/polynomial/conv.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/conv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 ## @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/deconv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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, poly, roots, residue, polyval, polyder, polyint} ## @end deftypefn ## Author: Tony Richardson <arichard@stark.cc.oh.us>
--- a/scripts/polynomial/mkpp.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/mkpp.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 piece-wise 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} ## @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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/mpoles.m Sun Dec 11 23:24:25 2011 -0500 @@ -44,7 +44,7 @@ ## @end group ## @end example ## -## @seealso{poly, roots, conv, deconv, polyval, polyderiv, polyint, residue} +## @seealso{poly, roots, conv, deconv, polyval, polyder, polyint, residue} ## @end deftypefn ## Author: Ben Abbott <bpabbott@mac.com>
--- a/scripts/polynomial/pchip.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/pchip.m Sun Dec 11 23:24:25 2011 -0500 @@ -27,8 +27,8 @@ ## ## 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 +## an array. In the case where @var{y} is a vector, it must have the +## length @var{n}. 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]$$ @@ -73,15 +73,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 +101,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 +117,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 +139,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 +149,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); \ No newline at end of file
--- a/scripts/polynomial/polyder.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/polyder.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,84 @@ ## <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{poly, polyint, polyreduce, roots, conv, deconv, residue, +## filter, polygcd, polyval, polyvalm} ## @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/polyderiv.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,101 +0,0 @@ -## Copyright (C) 1994-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} {} 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}) -## 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{poly, polyint, polyreduce, roots, conv, deconv, residue, -## filter, polygcd, polyval, polyvalm} -## @end deftypefn - -## Author: Tony Richardson <arichard@stark.cc.oh.us> -## Created: June 1994 -## Adapted-By: jwe - -function [q, d] = polyderiv (p, a) - - if (nargin == 1 || nargin == 2) - if (! isvector (p)) - error ("polyderiv: argument must be a vector"); - endif - if (nargin == 2) - if (! isvector (a)) - error ("polyderiv: argument must be a vector"); - endif - if (nargout == 1) - ## derivative of p*a returns a single polynomial - q = polyderiv (conv (p, a)); - else - ## derivative of p/a returns numerator and denominator - d = conv (a, a); - if (numel (p) == 1) - q = -p * polyderiv (a); - elseif (numel (a) == 1) - q = a * polyderiv (p); - else - q = conv (polyderiv (p), a) - conv (p, polyderiv (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 - 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 (polyderiv ([1, 2, 3]) == [2, 2]))); - -%!assert(polyderiv (13) == 0); - -%!error polyderiv ([]); - -%!error polyderiv ([1, 2; 3, 4]); -
--- a/scripts/polynomial/polyfit.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/polyfit.m Sun Dec 11 23:24:25 2011 -0500 @@ -76,7 +76,7 @@ error ("polyfit: X and Y must be vectors of the same size"); endif - if (! (isscalar (n) && n >= 0 && ! isinf (n) && n == round (n))) + if (! (isscalar (n) && n >= 0 && ! isinf (n) && n == fix (n))) error ("polyfit: N must be a nonnegative integer"); endif
--- a/scripts/polynomial/polygcd.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/polygcd.m Sun Dec 11 23:24:25 2011 -0500 @@ -39,7 +39,7 @@ ## @result{} [ 0, 0, 0 ] ## @end group ## @end example -## @seealso{poly, polyint, polyderiv, polyreduce, roots, conv, deconv, +## @seealso{poly, polyint, polyder, polyreduce, roots, conv, deconv, ## residue, filter, polyval, polyvalm} ## @end deftypefn @@ -81,3 +81,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/polyint.m Sun Dec 11 23:24:25 2011 -0500 @@ -22,7 +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, +## @seealso{poly, polyder, polyreduce, roots, conv, deconv, residue, ## filter, polyval, polyvalm} ## @end deftypefn @@ -61,3 +61,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/polyout.m Sun Dec 11 23:24:25 2011 -0500 @@ -35,7 +35,7 @@ ## @var{nargout} is zero). ## @var{x} defaults to the string @code{"s"}. ## @seealso{polyval, polyvalm, poly, roots, conv, deconv, residue, -## filter, polyderiv, polyint} +## filter, polyder, polyint} ## @end deftypefn ## Author: A. S. Hodel <a.s.hodel@eng.auburn.edu> @@ -97,3 +97,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/polyreduce.m Sun Dec 11 23:24:25 2011 -0500 @@ -21,7 +21,7 @@ ## 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} +## polyvalm, polyder, polyint} ## @end deftypefn ## Author: Tony Richardson <arichard@stark.cc.oh.us>
--- a/scripts/polynomial/polyval.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/polyval.m Sun Dec 11 23:24:25 2011 -0500 @@ -20,7 +20,7 @@ ## @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}. @@ -32,24 +32,26 @@ ## prediction interval, the structured variable @var{s}, originating ## form `polyfit', must be present. ## @seealso{polyfit, polyvalm, poly, roots, conv, deconv, residue, filter, -## polyderiv, polyint} +## polyder, polyint} ## @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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/polyvalm.m Sun Dec 11 23:24:25 2011 -0500 @@ -27,7 +27,7 @@ ## ## The argument @var{x} must be a square matrix. ## @seealso{polyval, poly, roots, conv, deconv, residue, filter, -## polyderiv, polyint} +## polyder, polyint} ## @end deftypefn ## Author: Tony Richardson <arichard@stark.cc.oh.us>
--- a/scripts/polynomial/ppder.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/ppder.m Sun Dec 11 23:24:25 2011 -0500 @@ -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}. +## @deftypefn {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 derivate 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/ppint.m Sun Dec 11 23:24:25 2011 -0500 @@ -28,7 +28,7 @@ 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/ppjumps.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/ppval.m Sun Dec 11 23:24:25 2011 -0500 @@ -18,16 +18,18 @@ ## -*- 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 +## Evaluate piece-wise 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. +## +##, 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} +## @seealso{mkpp, unmkpp, spline, pchip, interp1} ## @end deftypefn function yi = ppval (pp, xi) @@ -35,48 +37,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/residue.m Sun Dec 11 23:24:25 2011 -0500 @@ -18,7 +18,7 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{r}, @var{p}, @var{k}, @var{e}] =} residue (@var{b}, @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 @@ -136,7 +136,7 @@ ## @end example ## ## @end ifnottex -## @seealso{poly, roots, conv, deconv, mpoles, polyval, polyderiv, polyint} +## @seealso{poly, roots, conv, deconv, mpoles, polyval, polyder, polyint} ## @end deftypefn ## Author: Tony Richardson <arichard@stark.cc.oh.us>
--- a/scripts/polynomial/spline.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/spline.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/polynomial/unmkpp.m Sun Dec 11 23:24:25 2011 -0500 @@ -47,18 +47,37 @@ ## @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")) +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/addpref.m Sun Dec 11 23:24:25 2011 -0500 @@ -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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/getpref.m Sun Dec 11 23:24:25 2011 -0500 @@ -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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/ispref.m Sun Dec 11 23:24:25 2011 -0500 @@ -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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/private/loadprefs.m Sun Dec 11 23:24:25 2011 -0500 @@ -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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/private/prefsfile.m Sun Dec 11 23:24:25 2011 -0500 @@ -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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/private/saveprefs.m Sun Dec 11 23:24:25 2011 -0500 @@ -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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/rmpref.m Sun Dec 11 23:24:25 2011 -0500 @@ -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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/setpref.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/set/ismember.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/set/powerset.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/set/private/validargs.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/set/setxor.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/signal/autoreg_matrix.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/signal/bartlett.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/signal/blackman.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/signal/detrend.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/signal/fftfilt.m Sun Dec 11 23:24:25 2011 -0500 @@ -54,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; @@ -64,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; @@ -89,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/signal/fftshift.m Sun Dec 11 23:24:25 2011 -0500 @@ -31,7 +31,8 @@ ## f = [ -(ceil((N-1)/2):-1:1)*df 0 (1:floor((N-1)/2))*df ] ## @end example ## -## where @math{df} = 1 / @math{dt}. +## @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. @@ -58,9 +59,7 @@ 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
--- a/scripts/signal/hamming.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/signal/hamming.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/signal/hanning.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/signal/ifftshift.m Sun Dec 11 23:24:25 2011 -0500 @@ -45,10 +45,7 @@ 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
--- a/scripts/signal/sinc.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/signal/sinc.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/signal/sinewave.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/signal/unwrap.m Sun Dec 11 23:24:25 2011 -0500 @@ -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()
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/sparse/bicg.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/sparse/bicgstab.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/sparse/cgs.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/etreeplot.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/sparse/etreeplot.m Sun Dec 11 23:24:25 2011 -0500 @@ -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}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/sparse/gmres.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/sparse/gplot.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/sparse/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/sparse/nonzeros.m Sun Dec 11 23:24:25 2011 -0500 @@ -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])
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/sparse/private/__sprand_impl__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/spconvert.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/sparse/spconvert.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/sprand.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/sparse/sprand.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/sparse/sprandn.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/sparse/sprandsym.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/sparse/spy.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/sparse/svds.m Sun Dec 11 23:24:25 2011 -0500 @@ -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)) @@ -249,8 +251,12 @@ %! s = s(idx); %! u = u(:,idx); %! v = v(:,idx); +%! old_state1 = randn ("state"); +%! restore_state1 = onCleanup (@() randn ("state", old_state1)); +%! old_state2 = rand ("state"); +%! restore_state2 = onCleanup (@() rand ("state", old_state2)); %! randn ('state', 42); % Initialize to make normest function reproducible -%! rand ('state', 42) +%! rand ('state', 42); %! opts.v0 = rand (2*n,1); % Initialize eigs ARPACK starting vector %! % to guarantee reproducible results %!test @@ -277,3 +283,4 @@ %!test %! s = svds (speye (10)); %! assert (s, ones (6, 1), 2*eps); +
--- a/scripts/sparse/treelayout.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/sparse/treelayout.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/specfun/bessel.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/specfun/bessel.m Sun Dec 11 23:24:25 2011 -0500 @@ -91,3 +91,4 @@ error ("bessel: you must use besselj, bessely, besseli, or besselk"); endfunction +%!error bessel ()
--- a/scripts/specfun/factorial.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/specfun/factorial.m Sun Dec 11 23:24:25 2011 -0500 @@ -29,7 +29,7 @@ function x = factorial (n) if (nargin != 1) print_usage (); - elseif (any (n(:) < 0 | n(:) != round (n(:)))) + elseif (any (n(:) < 0 | n(:) != fix (n(:)))) error ("factorial: N must all be nonnegative integers"); endif x = round (gamma (n+1));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/specfun/lcm.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,61 @@ +## Copyright (C) 1994-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 {Mapping Function} {} lcm (@var{x}, @var{y}) +## @deftypefnx {Mapping Function} {} lcm (@var{x}, @var{y}, @dots{}) +## Compute the least common multiple of @var{x} and @var{y}, +## or of the list of all arguments. All elements must be the same size or +## scalar. +## @seealso{factor, gcd} +## @end deftypefn + +## Author: KH <Kurt.Hornik@wu-wien.ac.at> +## Created: 16 September 1994 +## Adapted-By: jwe + +function l = lcm (varargin) + + 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))) + error ("lcm: all arguments must be numeric"); + endif + + l = varargin{1}; + for i = 2:nargin + x = varargin{i}; + msk = l == 0 & x == 0; + l .*= x ./ gcd (l, x); + l(msk) = 0; + endfor + else + print_usage (); + endif + +endfunction + +%!assert(lcm (3, 5, 7, 15) == 105); + +%!error lcm (); + +%!test +%! s.a = 1; +%! fail("lcm (s)"); +
--- a/scripts/specfun/module.mk Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/specfun/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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/nthroot.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/specfun/nthroot.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/specfun/perms.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/specfun/primes.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/special-matrix/hadamard.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/special-matrix/hankel.m Sun Dec 11 23:24:25 2011 -0500 @@ -49,69 +49,50 @@ 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/special-matrix/hilb.m Sun Dec 11 23:24:25 2011 -0500 @@ -54,28 +54,26 @@ 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/special-matrix/invhilb.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/special-matrix/magic.m Sun Dec 11 23:24:25 2011 -0500 @@ -32,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) @@ -45,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) @@ -64,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); @@ -78,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/special-matrix/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/special-matrix/pascal.m Sun Dec 11 23:24:25 2011 -0500 @@ -36,57 +36,55 @@ ## 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/sylvester_matrix.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,62 +0,0 @@ -## 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} {} sylvester_matrix (@var{k}) -## Return the Sylvester matrix of order -## @tex -## $n = 2^k$. -## @end tex -## @ifnottex -## n = 2^@var{k}. -## @end ifnottex -## -## @seealso{toeplitz, hankel} -## @end deftypefn - -## Author: jwe - -function retval = sylvester_matrix (k) - - if (nargin != 1) - print_usage (); - endif - - if (isscalar (k)) - if (k < 1) - retval = 1; - else - tmp = sylvester_matrix (k-1); - retval = [tmp, tmp; tmp, -tmp]; - endif - else - error ("sylvester_matrix: expecting scalar argument"); - endif - -endfunction - -%!assert((sylvester_matrix (1) == [1, 1; 1, -1] -%! && (sylvester_matrix (2) -%! == [1, 1, 1, 1; 1, -1, 1, -1; 1, 1, -1, -1; 1, -1, -1, 1]))); - -%!error sylvester_matrix ([1, 2; 3, 4]); - -%!error sylvester_matrix (); - -%!error sylvester_matrix (1, 2); -
--- a/scripts/special-matrix/toeplitz.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/special-matrix/toeplitz.m Sun Dec 11 23:24:25 2011 -0500 @@ -58,50 +58,55 @@ 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/special-matrix/vander.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/special-matrix/wilkinson.m Sun Dec 11 23:24:25 2011 -0500 @@ -35,7 +35,7 @@ print_usage (); endif - if (! (isscalar (n) && (n == fix (n)) && n >= 0)) + if (! (isscalar (n) && n >= 0 && (n == fix (n)))) error ("wilkinson: N must be a non-negative integer"); endif @@ -45,10 +45,17 @@ endfunction -%!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]) -%!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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/startup/__finish__.m Sun Dec 11 23:24:25 2011 -0500 @@ -36,3 +36,5 @@ endfunction +## No test needed for internal helper function. +%!assert (1)
--- a/scripts/statistics/base/center.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/center.m Sun Dec 11 23:24:25 2011 -0500 @@ -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)
--- a/scripts/statistics/base/cor.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,46 +0,0 @@ -## Copyright (C) 1995-2011 Kurt Hornik -## -## 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} {} cor (@var{x}) -## @deftypefnx {Function File} {} cor (@var{x}, @var{y}) -## Compute matrix of correlation coefficients. -## -## This is an alias for @code{corrcoef}. -## @seealso{corrcoef} -## @end deftypefn - -function retval = cor (x, y = x) - - if (nargin < 1 || nargin > 2) - print_usage (); - endif - - retval = corrcoef (x, y); - -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); -
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/statistics/base/corr.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/corrcoef.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,98 +0,0 @@ -## 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} {} corrcoef (@var{x}) -## @deftypefnx {Function File} {} corrcoef (@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{corrcoef (@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 corrcoef}(x,y) = {{\rm cov}(x,y) \over {\rm std}(x) {\rm std}(y)} -## $$ -## @end tex -## @ifnottex -## -## @example -## corrcoef(x,y) = cov(x,y)/(std(x)*std(y)) -## @end example -## -## @end ifnottex -## If called with one argument, compute @code{corrcoef (@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 = corrcoef (x, y = []) - - 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 - - if (ndims (x) != 2 || ndims (y) != 2) - error ("corrcoef: X and Y must be 2-D matrices or vectors"); - endif - - if (isscalar (x)) - retval = 1; - 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 = corrcoef (x); -%! cc2 = corrcoef (x, x); -%! assert((size (cc1) == [10, 10] && size (cc2) == [10, 10] -%! && abs (cc1 - cc2) < sqrt (eps))); - -%!assert(corrcoef (5), 1); - -%% Test input validation -%!error corrcoef (); -%!error corrcoef (1, 2, 3); -%!error corrcoef ([true, true]); -%!error corrcoef ([1, 2], [true, true]); -%!error corrcoef (ones (2,2,2)); -%!error corrcoef (ones (2,2), ones (2,2,2)); -
--- a/scripts/statistics/base/cov.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/cov.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/cut.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,64 +0,0 @@ -## Copyright (C) 1996-2011 Kurt Hornik -## -## 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} {} cut (@var{x}, @var{breaks}) -## Create categorical data from numerical or continuous data by -## cutting into intervals. -## -## If @var{breaks} is a scalar, the data is cut into that many -## equal-width intervals. If @var{breaks} is a vector of break points, -## the category has @code{length (@var{breaks}) - 1} groups. -## -## The returned value is a vector of the same size as @var{x} telling -## which group each point in @var{x} belongs to. Groups are labelled -## from 1 to the number of groups; points outside the range of -## @var{breaks} are labelled by @code{NaN}. -## @seealso{histc} -## @end deftypefn - -## Author: KH <Kurt.Hornik@wu-wien.ac.at> -## Description: Cut data into intervals - -function group = cut (x, breaks) - - if (nargin != 2) - print_usage (); - endif - - if (!isvector (x)) - error ("cut: X must be a vector"); - endif - if isscalar (breaks) - breaks = linspace (min (x), max (x), breaks + 1); - breaks(1) = breaks(1) - 1; - elseif isvector (breaks) - breaks = sort (breaks); - else - error ("cut: BREAKS must be a scalar or vector"); - endif - - group = NaN (size (x)); - m = length (breaks); - if any (k = find ((x >= min (breaks)) & (x < max (breaks)))) - n = length (k); - group(k) = sum ((ones (m, 1) * reshape (x(k), 1, n)) - >= (reshape (breaks, m, 1) * ones (1, n))); - endif - -endfunction
--- a/scripts/statistics/base/gls.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/gls.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/histc.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/iqr.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/kendall.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/kurtosis.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/logit.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/mahalanobis.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/mean.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/meansq.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/median.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/mode.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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 \ @@ -33,9 +31,9 @@ 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/moment.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/ols.m Sun Dec 11 23:24:25 2011 -0500 @@ -100,13 +100,21 @@ error ("ols: number of rows of X and Y must be equal"); endif - z = x' * x; - rnk = rank (z); + if (isinteger (x)) + x = double (x); + endif + if (isinteger (y)) + y = double (y); + endif - if (rnk == 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)) @@ -118,6 +126,7 @@ endfunction + %!test %! x = [1:5]'; %! y = 3*x + 2;
--- a/scripts/statistics/base/ppplot.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/ppplot.m Sun Dec 11 23:24:25 2011 -0500 @@ -77,6 +77,7 @@ endfunction + %% Test input validation %!error ppplot (); %!error ppplot (ones(2,2));
--- a/scripts/statistics/base/prctile.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/prctile.m Sun Dec 11 23:24:25 2011 -0500 @@ -40,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); @@ -171,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/probit.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/quantile.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/quantile.m Sun Dec 11 23:24:25 2011 -0500 @@ -89,32 +89,41 @@ ## @end itemize ## ## Examples: +## @c Set example in small font to prevent overfull line ## -## @example +## @smallexample ## @group -## x = randi (1000, [10, 1]); # Create random empirical data in range 1-1000 -## q = quantile (x, [0, 1]); # Return minimum, maximum of empirical distribution -## q = quantile (x, [0.25 0.5 0.75]); # Return quartiles of empirical distribution +## 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 example +## @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 @@ -143,6 +152,7 @@ endfunction + %!test %! p = 0.5; %! x = sort (rand (11)); @@ -282,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}. @@ -304,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} @@ -375,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 @@ -387,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/range.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/ranks.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/run_count.m Sun Dec 11 23:24:25 2011 -0500 @@ -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)
--- a/scripts/statistics/base/runlength.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/runlength.m Sun Dec 11 23:24:25 2011 -0500 @@ -30,11 +30,12 @@ ## @end deftypefn function [count, value] = runlength (x) + if (nargin != 1) print_usage (); endif - if (!isnumeric (x) || !isvector (x)) + if (!(isnumeric (x) || islogical (x)) || !isvector (x)) error ("runlength: X must be a numeric vector"); endif @@ -47,8 +48,10 @@ 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 @@ -59,5 +62,5 @@ %% Test input validation %!error runlength () %!error runlength (1, 2) -%!error runlength (true(1,2)) +%!error runlength (['A'; 'B']) %!error runlength (ones(2,2))
--- a/scripts/statistics/base/skewness.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/skewness.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/spearman.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/statistics.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/std.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/studentize.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,88 +0,0 @@ -## Copyright (C) 1995-2011 Kurt Hornik -## -## 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} {} studentize (@var{x}) -## @deftypefnx {Function File} {} studentize (@var{x}, @var{dim}) -## If @var{x} is a vector, subtract its mean and divide by its standard -## deviation. -## -## If @var{x} is a matrix, do the above along the first non-singleton -## dimension. -## If the optional argument @var{dim} is given, operate along this dimension. -## @seealso{center} -## @end deftypefn - -## Author: KH <Kurt.Hornik@wu-wien.ac.at> -## Description: Subtract mean and divide by standard deviation - -function t = studentize (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); - 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 - else - if (!(isscalar (dim) && dim == fix (dim)) - || !(1 <= dim && dim <= nd)) - error ("studentize: DIM must be an integer and a valid dimension"); - endif - endif - - c = sz(dim); - if (c == 0) - t = 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); - 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]) - -%% 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) -
--- a/scripts/statistics/base/table.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/table.m Sun Dec 11 23:24:25 2011 -0500 @@ -60,6 +60,7 @@ endfunction + %% Test input validation %!error table () %!error table (1, 2, 3)
--- a/scripts/statistics/base/var.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/base/var.m Sun Dec 11 23:24:25 2011 -0500 @@ -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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/statistics/base/zscore.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,84 @@ +## Copyright (C) 1995-2011 Kurt Hornik +## +## 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} {} 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. +## +## If @var{x} is a matrix, do the above along the first non-singleton +## dimension. +## If the optional argument @var{dim} is given, operate along this dimension. +## @seealso{center} +## @end deftypefn + +## Author: KH <Kurt.Hornik@wu-wien.ac.at> +## Description: Subtract mean and divide by standard deviation + +function z = zscore (x, dim) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + 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)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("zscore: DIM must be an integer and a valid dimension"); + endif + endif + + n = sz(dim); + if (n == 0) + z = x; + else + 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(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 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/betacdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/betainv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/betapdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/betarnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/binocdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/binoinv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/binopdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/binornd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/cauchy_cdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 (ones (sz) & (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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/cauchy_inv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/cauchy_pdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/cauchy_rnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/chi2cdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/chi2inv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/chi2pdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/chi2rnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/discrete_cdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/discrete_inv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/discrete_pdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/discrete_rnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/empirical_cdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/empirical_inv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/empirical_pdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/empirical_rnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/expcdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/expinv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/exppdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/exprnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/fcdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/finv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/fpdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/frnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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(m); - 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/gamcdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/gaminv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/gampdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/gamrnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/geocdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/geoinv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/geopdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/geornd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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(p); - 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/hygecdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/hygeinv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/hygepdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/hygernd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/kolmogorov_smirnov_cdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/laplace_cdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/laplace_inv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/laplace_pdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/laplace_rnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/logistic_cdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/logistic_inv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/logistic_pdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/logistic_rnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/logncdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/logninv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/lognpdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/lognrnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/nbincdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/nbininv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/nbinpdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/nbinrnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/normcdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/norminv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/normpdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/normrnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/poisscdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/poissinv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/poisspdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/poissrnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/stdnormal_cdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/stdnormal_inv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/stdnormal_pdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/stdnormal_rnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/tcdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/tinv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/tpdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/trnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/unidcdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/unidinv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/unidpdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/unidrnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/unifcdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/unifinv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/unifpdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/unifrnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/wblcdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/wblinv.m Sun Dec 11 23:24:25 2011 -0500 @@ -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) = 0; + 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/wblpdf.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/distributions/wblrnd.m Sun Dec 11 23:24:25 2011 -0500 @@ -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/tests/anova.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/tests/anova.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/tests/cor_test.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/tests/f_test_regression.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/tests/hotelling_test.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/tests/hotelling_test_2.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/tests/manova.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/tests/mcnemar_test.m Sun Dec 11 23:24:25 2011 -0500 @@ -42,7 +42,7 @@ 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))))) + elseif (! (all (all (x >= 0)) && all (all (x == fix (x))))) error ("mcnemar_test: all entries of X must be nonnegative integers"); endif
--- a/scripts/statistics/tests/var_test.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/tests/var_test.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/statistics/tests/wilcoxon_test.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/base2dec.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/bin2dec.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/blanks.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/cstrcat.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/deblank.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/dec2base.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/dec2bin.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/dec2hex.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/findstr.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/hex2dec.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/index.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/isstrprop.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/mat2str.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/regexptranslate.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/rindex.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/str2num.m Sun Dec 11 23:24:25 2011 -0500 @@ -17,7 +17,7 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{x} =} 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: @@ -35,13 +35,15 @@ ## @end example ## ## The optional second output, @var{state}, is logically true when the -## coversion is successful. If the conversion fails the numeric output, +## 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} for a safer and faster ## conversion. +## +## For cell array of strings use @code{str2double}. ## @seealso{str2double, eval} ## @end deftypefn @@ -49,31 +51,35 @@ function [m, state] = str2num (s) - 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))); - state = true; - eval (s, "m = []; state = false;"); - if (ischar (m)) - m = []; - state = false; - endif - else + if (nargin != 1) print_usage (); + elseif (! ischar (s)) + error ("str2num: S must be a string or string array"); + endif + + 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]); -%!error str2num (); - -%!error str2num ("string", 1); +%!assert(str2num ("-1.3e2"), -130); +%!assert(str2num ("[1, 2; 3, 4]"), [1, 2; 3, 4]); %!test %! [x, state] = str2num ("pi"); -%! assert (state) -%! [x, state] = str2num (tmpnam); -%! assert (! state) +%! assert (state); +%! [x, state] = str2num ("Hello World"); +%! assert (! state); + +%% Test input validation +%!error str2num () +%!error str2num ("string", 1) +%!error <S must be a string> str2num ({"string"}) +
--- a/scripts/strings/strcat.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/strcat.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/strchr.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/strjust.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/strmatch.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/strsplit.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/strtok.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/strtrim.m Sun Dec 11 23:24:25 2011 -0500 @@ -18,20 +18,21 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} strtrim (@var{s}) -## Remove leading and trailing whitespace 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,19 +47,28 @@ 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))); endif - elseif (iscell(s)) + elseif (iscell (s)) - s = regexprep (s, "^[\\s\v\\0]+|[\\s\v\\0]+$", ''); + 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: S argument must be a string"); + error ("strtrim: S argument must be a string or cellstring"); endif endfunction @@ -69,8 +79,10 @@ %!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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/strtrunc.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/substr.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/untabify.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/strings/validatestring.m Sun Dec 11 23:24:25 2011 -0500 @@ -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. +## +## Examples: ## -## All comparisons are case insensitive. +## @example +## @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 example +## +## ## @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/demo.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/testfun/demo.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 @@ -123,7 +129,7 @@ __demo__; 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 +138,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/testfun/example.m Sun Dec 11 23:24:25 2011 -0500 @@ -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,15 +67,16 @@ 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 @@ -82,17 +85,18 @@ %!## 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]); +%% Test input validation %!error example; -%!error example('example',3,5) +%!error example('example', 3, 5)
--- a/scripts/testfun/fail.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/testfun/fail.m Sun Dec 11 23:24:25 2011 -0500 @@ -129,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/testfun/rundemos.m Sun Dec 11 23:24:25 2011 -0500 @@ -35,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}; @@ -80,3 +81,5 @@ retval = findstr (str, "%!demo"); endif endfunction + +%!error rundemos ("foo", 1);
--- a/scripts/testfun/runtests.m Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/testfun/runtests.m Sun Dec 11 23:24:25 2011 -0500 @@ -35,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/testfun/speed.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/testfun/test.m Sun Dec 11 23:24:25 2011 -0500 @@ -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) @@ -488,13 +496,13 @@ eval (sprintf ("%s__test__(%s);", __shared_r, __shared)); 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 +677,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 +770,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/addtodate.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/asctime.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/calendar.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/clock.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/ctime.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/date.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/datenum.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 ("date") -## @deftypefnx {Function File} {} datenum ("date", @var{p}) -## Return 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/datestr.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/datetick.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/datevec.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/eomday.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/etime.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/is_leap_year.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/now.m Sun Dec 11 23:24:25 2011 -0500 @@ -18,16 +18,14 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {t =} now () -## Return 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/scripts/time/weekday.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 .13 +## @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,41 +80,45 @@ endfunction + +%!demo +%! ## Current weekday +%! [n, s] = weekday (now ()) +%!demo +%! ## Weekday from datenum input +%! [n, s] = weekday (728647) +%!demo +%! ## Weekday of new millennium from datestr input +%! [n, s] = weekday ('1-Jan-2000') + # tests -%!assert(weekday(728647),2) +%!assert (weekday (728647), 2) ## Test vector inputs for both directions -%!assert(weekday([728647 728648]), [2 3]) -%!assert(weekday([728647;728648]), [2;3]) +%!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) +%!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) +%!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) +%!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) +%!assert (weekday (728647.1), 2) ## Test "long" option %!test -%! [a, b] = weekday ("25-Dec-1994", "long"); -%! assert (a, 1); -%! assert (b, "Sunday"); +%! [n, s] = weekday ("25-Dec-1994", "long"); +%! assert (n, 1); +%! assert (s, "Sunday"); -# demos -%!demo -%! [n, s] = weekday (now ()) -%!demo -%! [n, s] = weekday (728647) -%!demo -%! [n, s] = weekday ('19-Dec-1994')
--- a/src/DLD-FUNCTIONS/__contourc__.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/__contourc__.cc Sun Dec 11 23:24:25 2011 -0500 @@ -333,3 +333,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__delaunayn__.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/__delaunayn__.cc Sun Dec 11 23:24:25 2011 -0500 @@ -62,8 +62,8 @@ 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") @@ -73,7 +73,6 @@ #ifdef HAVE_QHULL retval(0) = 0.0; - std::string options = ""; int nargin = args.length (); if (nargin < 1 || nargin > 2) @@ -86,67 +85,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 +144,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 +204,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__dispatch__.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/__dispatch__.cc Sun Dec 11 23:24:25 2011 -0500 @@ -129,3 +129,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__dsearchn__.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/__dsearchn__.cc Sun Dec 11 23:24:25 2011 -0500 @@ -108,3 +108,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__fltk_uigetfile__.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/__fltk_uigetfile__.cc Sun Dec 11 23:24:25 2011 -0500 @@ -26,6 +26,10 @@ #if defined (HAVE_FLTK) +#ifdef WIN32 +#define WIN32_LEAN_AND_MEAN +#endif + #include <FL/Fl.H> #include <FL/Fl_File_Chooser.H> @@ -130,4 +134,11 @@ return retval; } +/* + +## No test needed for internal helper function. +%!assert (1) + +*/ + #endif
--- a/src/DLD-FUNCTIONS/__glpk__.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/__glpk__.cc Sun Dec 11 23:24:25 2011 -0500 @@ -854,3 +854,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__init_fltk__.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/__init_fltk__.cc Sun Dec 11 23:24:25 2011 -0500 @@ -29,6 +29,8 @@ */ +// PKG_ADD: register_graphics_toolkit ("fltk"); + #ifdef HAVE_CONFIG_H #include <config.h> #endif @@ -40,6 +42,10 @@ #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> @@ -130,6 +136,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 +278,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 +301,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 +312,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 +373,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 +393,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 +407,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 +425,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 +442,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,7 +458,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) { Matrix rgb = uimenup.get_foregroundcolor_rgb (); @@ -453,7 +472,7 @@ } } - 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 @@ -462,17 +481,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 ()) { @@ -490,7 +509,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 ()) @@ -511,7 +531,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) { @@ -520,9 +541,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 @@ -535,9 +556,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; @@ -569,7 +590,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); } } @@ -586,7 +607,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); } } @@ -606,18 +627,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; } @@ -640,7 +661,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); @@ -648,75 +670,46 @@ 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); @@ -759,14 +752,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); @@ -803,7 +803,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); @@ -811,58 +811,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) @@ -878,7 +890,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; @@ -959,6 +971,9 @@ Fl_Button* rotate; Fl_Button* help; Fl_Output* status; + graphics_object ax_obj; + int pos_x; + int pos_y; void axis_auto (void) { @@ -979,14 +994,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")) { @@ -1026,7 +1041,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); @@ -1061,7 +1076,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 ()); @@ -1158,23 +1173,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 ()) @@ -1243,17 +1255,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 (); @@ -1272,42 +1284,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); @@ -1352,13 +1366,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 (); } } @@ -1370,12 +1384,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) @@ -1455,18 +1470,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); } @@ -1488,7 +1510,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)); } @@ -1503,22 +1525,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) @@ -1527,7 +1552,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); } @@ -1561,31 +1587,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 (); @@ -1598,8 +1640,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 (); @@ -1612,28 +1655,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 (); @@ -1644,26 +1686,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 (); @@ -1672,17 +1713,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) @@ -1716,7 +1747,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")) @@ -1725,7 +1756,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; } @@ -1740,12 +1771,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); @@ -1786,6 +1817,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")) @@ -1797,7 +1831,7 @@ } } - void uimenu_set_fltk_label(graphics_object uimenu_obj) + void uimenu_set_fltk_label (graphics_object uimenu_obj) { if (uimenu_obj.valid_object ()) { @@ -1807,14 +1841,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); } } @@ -1831,19 +1865,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; } } } @@ -1891,31 +1940,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; @@ -1929,30 +1989,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; @@ -1968,13 +2004,12 @@ 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. -*/ +// 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\ @@ -2029,7 +2064,6 @@ else mode_str = "none"; - bool failed = false; if (args.length () == 1) @@ -2054,9 +2088,7 @@ if (failed) error ("MODE must be one of the strings: \"2D\", \"3D\", or \"none\""); - - return octave_value(mode_str); + return octave_value (mode_str); } - #endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/DLD-FUNCTIONS/__init_gnuplot__.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/__lin_interpn__.cc Sun Dec 11 23:24:25 2011 -0500 @@ -355,3 +355,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__magick_read__.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/__magick_read__.cc Sun Dec 11 23:24:25 2011 -0500 @@ -531,6 +531,13 @@ return output; } +/* + +## No test needed for internal helper function. +%!assert (1) + +*/ + #ifdef HAVE_MAGICK static void @@ -916,6 +923,13 @@ return retval; } +/* + +## No test needed for internal helper function. +%!assert (1) + +*/ + #ifdef HAVE_MAGICK template<class T> @@ -1134,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 @@ -1193,3 +1214,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__pchip_deriv__.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/__pchip_deriv__.cc Sun Dec 11 23:24:25 2011 -0500 @@ -147,3 +147,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__qp__.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/__qp__.cc Sun Dec 11 23:24:25 2011 -0500 @@ -528,3 +528,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__voronoi__.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/__voronoi__.cc Sun Dec 11 23:24:25 2011 -0500 @@ -36,6 +36,8 @@ #include <cstdio> +#include <list> + #include "lo-ieee.h" #include "Cell.h" @@ -55,138 +57,204 @@ 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; + std::string caller = args(0).string_value (); + #ifdef 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 +264,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/balance.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/balance.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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/betainc.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/betainc.cc Sun Dec 11 23:24:25 2011 -0500 @@ -322,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/bsxfun.cc Sun Dec 11 23:24:25 2011 -0500 @@ -312,15 +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}. @var{f} is a function handle, inline function, or\n\ -string containing the name of the function to evaluate.\n\ -The function @var{f} must be capable of accepting two column-vector\n\ -arguments of equal length, or one column vector argument and a scalar.\n\ +The binary singleton expansion function applier does what its name\n\ +suggests: 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") { @@ -766,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/ccolamd.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/cellfun.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 @@ -44,6 +45,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 +60,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 +78,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 +100,155 @@ 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 ()) + { + std::string arg = args(nargin-2).string_value (); + + std::transform (arg.begin (), arg.end (), + arg.begin (), tolower); + + 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; + } + + 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\ @@ -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,7 +360,7 @@ @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\ @@ -230,172 +390,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 +489,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 +524,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 +540,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 +548,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 +623,7 @@ } retval.resize (nargout1); + for (int j = 0; j < nargout1; j++) { if (nargout > 0 && retv[j].is_undefined ()) @@ -537,10 +635,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 +649,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 +696,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)); @@ -852,6 +994,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 +1724,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 +1873,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 +2307,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 +2421,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/chol.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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,9 @@ \n\ @end ifnottex\n\ \n\ +For full matrices, if the 'lower' flag is set only the lower triangular part of the matrix \ +is used for the factorization, otherwise the upper triangular 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 +159,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 +259,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 +285,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 +316,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 +342,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 +376,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); */ @@ -493,9 +525,6 @@ %!testif HAVE_CHOLMOD %! Ainv3 = cholinv(sparse(A)); %! assert (norm(Ainv-Ainv3),0,1e-10) -%!testif HAVE_CHOLMOD -%! Ainv4 = spcholinv(sparse(A)); -%! assert (norm(Ainv-Ainv4),0,1e-10) */ @@ -996,6 +1025,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/colamd.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 (); } @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/config-module.awk Sun Dec 11 23:24:25 2011 -0500 @@ -1,4 +1,7 @@ BEGIN { + FS = "|"; + nfiles = 0; + print "## DO NOT EDIT -- generated from module-files by config-module.awk"; print "" print "EXTRA_DIST += \\" @@ -6,9 +9,14 @@ print " DLD-FUNCTIONS/config-module.awk \\" print " DLD-FUNCTIONS/module-files" 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 +30,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 +49,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/conv2.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/conv2.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/convhulln.cc Sun Dec 11 23:24:25 2011 -0500 @@ -53,24 +53,39 @@ 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; int nargin = args.length (); if (nargin < 1 || nargin > 2) @@ -79,110 +94,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 +246,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 +271,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/dassl.cc Sun Dec 11 23:24:25 2011 -0500 @@ -558,6 +558,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/det.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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/dot.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/dot.cc Sun Dec 11 23:24:25 2011 -0500 @@ -238,6 +238,17 @@ /* +%! 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, , @@ -344,3 +355,14 @@ 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/eig.cc Sun Dec 11 23:24:25 2011 -0500 @@ -325,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/eigs.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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/filter.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/filter.cc Sun Dec 11 23:24:25 2011 -0500 @@ -104,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; @@ -456,19 +457,10 @@ } 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) - si = si.reshape (dim_vector (1, si.numel ())); + if (si.is_vector () && x.is_vector ()) + si = si.reshape (dim_vector (si.numel (), 1)); } if (! error_state) @@ -513,19 +505,10 @@ } 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) - si = si.reshape (dim_vector (1, si.numel ())); + if (si.is_vector () && x.is_vector ()) + si = si.reshape (dim_vector (si.numel (), 1)); } if (! error_state) @@ -573,19 +556,10 @@ } 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) - si = si.reshape (dim_vector (1, si.numel ())); + if (si.is_vector () && x.is_vector ()) + si = si.reshape (dim_vector (si.numel (), 1)); } if (! error_state) @@ -630,19 +604,10 @@ } 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) - si = si.reshape (dim_vector (1, si.numel ())); + if (si.is_vector () && x.is_vector ()) + si = si.reshape (dim_vector (si.numel (), 1)); } if (! error_state) @@ -749,8 +714,20 @@ %! %!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]); -%!assert(filter (1, ones(10,1)/10, single (1:5)), repmat (single (10), 1, 5)); -%% Should put some tests of the "DIM" parameter in here. +%!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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/find.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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; } @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/gcd.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/getgrent.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/getpwent.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/givens.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/hess.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/hex2num.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/inv.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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]); */
--- a/src/DLD-FUNCTIONS/kron.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/kron.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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/lsode.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/lsode.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/lu.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/luinc.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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/max.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/max.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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]);
--- a/src/DLD-FUNCTIONS/mgorth.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/mgorth.cc Sun Dec 11 23:24:25 2011 -0500 @@ -31,8 +31,8 @@ #include "gripes.h" template <class ColumnVector, class Matrix, class RowVector> -static void -do_mgorth (ColumnVector& x, const Matrix& V, RowVector& h) +static void +do_mgorth (ColumnVector& x, const Matrix& V, RowVector& h) { octave_idx_type Vc = V.columns (); h = RowVector (Vc + 1); @@ -71,7 +71,7 @@ if (nargin != 2 || nargout > 2) { - print_usage (); + print_usage (); return retval; } @@ -90,7 +90,7 @@ { 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 ()) { @@ -139,7 +139,7 @@ } /* - + %!test %! for ii=1:100; assert (abs (mgorth (randn (5, 1), eye (5, 4))), [0 0 0 0 1]', eps); endfor
--- a/src/DLD-FUNCTIONS/module-files Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/module-files Sun Dec 11 23:24:25 2011 -0500 @@ -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 @@ -56,15 +58,14 @@ md5sum.cc mgorth.cc nproc.cc -onCleanup.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 @@ -73,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)
--- a/src/DLD-FUNCTIONS/onCleanup.cc Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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\ -For similar functionality @xref{The @code{unwind_protect} Statement}.\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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/pinv.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/qr.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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\ @@ -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,8 +497,8 @@ %! 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) %! tol = 100*eps (class(q)); @@ -613,8 +615,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 %! @@ -1172,7 +1174,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/quad.cc Sun Dec 11 23:24:25 2011 -0500 @@ -494,14 +494,14 @@ %! [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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/quadcc.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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,9 +1472,7 @@ } - -/* The actual integration routine. - */ +/* The actual integration routine. */ DEFUN_DLD (quadcc, args, nargout, "-*- texinfo -*-\n\ @@ -1545,6 +1542,7 @@ @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 }; @@ -1563,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]; @@ -1580,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) { @@ -1629,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]; @@ -1652,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]); @@ -1688,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++) { @@ -1767,7 +1766,6 @@ /* Initialize some global values. */ igral_final = 0.0; err_final = 0.0; - err_excess = 0.0; /* Main loop. */ @@ -1809,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++) @@ -1957,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++) @@ -2053,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++) @@ -2234,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/qz.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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\ @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/rand.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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; @@ -1026,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{MxN} 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; @@ -1040,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)); @@ -1100,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/rcond.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/regexp.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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\ @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/schur.cc Sun Dec 11 23:24:25 2011 -0500 @@ -289,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]); */ @@ -307,7 +307,7 @@ $U^{\\dagger} U$ is the identity matrix I.\n\ @end tex\n\ @ifnottex\n\ -@code{@var{UR} * @var{TR} * @var{UR}' = @var{U} * @var{T} * @var{U}'} and\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\
--- a/src/DLD-FUNCTIONS/spparms.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/spparms.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/sqrtm.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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; } } @@ -245,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); @@ -270,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/str2double.cc Sun Dec 11 23:24:25 2011 -0500 @@ -271,7 +271,7 @@ } else if (args(0).is_cell ()) { - const Cell cell = args(0).cell_value (); + const Cell cell = args(0).cell_value (); if (! error_state) { @@ -286,7 +286,7 @@ } else retval = NDArray (args(0).dims (), octave_NaN); - + return retval; }
--- a/src/DLD-FUNCTIONS/sub2ind.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/sub2ind.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/svd.cc Sun Dec 11 23:24:25 2011 -0500 @@ -398,9 +398,9 @@ %! 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]); */ @@ -408,9 +408,14 @@ "-*- texinfo -*-\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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/syl.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/symbfact.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/time.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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: @@ -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/typecast.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/typecast.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/DLD-FUNCTIONS/urlwrite.cc Sun Dec 11 23:24:25 2011 -0500 @@ -46,6 +46,7 @@ #include "ov-cell.h" #include "pager.h" #include "oct-map.h" +#include "oct-refcount.h" #include "unwind-prot.h" #ifdef HAVE_CURL @@ -112,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; @@ -141,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; @@ -250,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 @@ -808,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 (); @@ -820,7 +818,7 @@ if (nargout > 0) { - if (res) + if (ok) { retval(2) = std::string (); retval(1) = true; @@ -834,7 +832,7 @@ } } - if (nargout < 2 && res) + if (nargout < 2 && ! ok) error ("urlwrite: curl: %s", curl.lasterror ().c_str ()); #else @@ -942,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/Makefile.am Sun Dec 11 23:24:25 2011 -0500 @@ -3,17 +3,17 @@ # 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/>. @@ -24,7 +24,7 @@ @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 @@ -56,7 +56,7 @@ octave-config endif -## Order matters here. Leave builtins.cc last, because it depends on +## 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 = \ @@ -179,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 \ @@ -230,11 +231,11 @@ octinclude_HEADERS = \ Cell.h \ - base-list.h \ builtins.h \ c-file-ptr-stream.h \ comment-list.h \ cutils.h \ + data.h \ debug.h \ defun-dld.h \ defun-int.h \ @@ -285,6 +286,7 @@ parse.h \ pr-output.h \ procstream.h \ + profiler.h \ sighandlers.h \ siglist.h \ sparse-xdiv.h \ @@ -355,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 \ @@ -446,6 +449,7 @@ pager.cc \ pr-output.cc \ procstream.cc \ + profiler.cc \ sighandlers.cc \ siglist.c \ sparse.cc \ @@ -478,20 +482,15 @@ 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) @@ -506,87 +505,14 @@ version.h \ $(OPT_INC) +liboctinterp_la_CPPFLAGS = @OCTINTERP_DLL_DEFS@ $(AM_CPPFLAGS) -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 +include link-deps.mk -OCTINTERP_LINK_DEPS = \ - $(RLD_FLAG) \ +liboctinterp_la_LIBADD = \ ../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) - -## Additional library dependencies used by module.mk files -OCT_LINK_DEPS = \ - $(RLD_FLAG) $(LDFLAGS) \ - ./liboctinterp.la \ - ../liboctave/liboctave.la \ - ../libcruft/libcruft.la \ - ../libcruft/libranlib.la \ - ../libgnu/libgnu.la - -liboctinterp_la_CPPFLAGS = @OCTINTERP_DLL_DEFS@ $(AM_CPPFLAGS) + $(LIBOCTINTERP_LINK_DEPS) # Increment these as needed and according to the rules in the libtool manual: liboctinterp_current = 0 @@ -598,120 +524,39 @@ liboctinterp_la_LDFLAGS = \ -version-info $(liboctinterp_version_info) \ $(NO_UNDEFINED_LDFLAG) \ - -bindir $(bindir) + -bindir $(bindir) \ + $(LIBOCTINTERP_LINK_OPTS) 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) - -#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) - -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) - - octave_SOURCES = main.c -octave_LDADD = $(OCTAVE_LIBS) +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_STATIC_DEF_FILES = $(DLD_STATIC_SRC:.cc=.df) -DLD_DYNAMIC_DEF_FILES = $(DLD_DYNAMIC_SRC:.cc=.df) +DLD_FUNCTIONS_DEF_FILES = $(DLD_FUNCTIONS_SRC:.cc=.df) ## 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) +if AMCOND_ENABLE_DYNAMIC_LINKING + DEF_FILES = $(SRC_DEF_FILES) +else + DEF_FILES = $(SRC_DEF_FILES) $(DLD_FUNCTIONS_DEF_FILES) +endif -ALL_DEF_FILES = $(DEF_FILES) $(DLD_DYNAMIC_DEF_FILES) +ALL_DEF_FILES = $(SRC_DEF_FILES) $(DLD_FUNCTIONS_DEF_FILES) -$(DEF_FILES) $(DYNAMIC_DLD_DEF_FILES): mkdefs Makefile +$(SRC_DEF_FILES): mkdefs Makefile $(DEF_FILES): $(OPT_HANDLERS) $(OPT_INC) @@ -725,7 +570,7 @@ -DMAKE_BUILTINS $< | $(srcdir)/mkdefs $(srcdir) $< > $@-t mv $@-t $@ -## Special rules: +## Special rules: ## Mostly for sources which must be built before rest of compilation. ## defaults.h and oct-conf.h must depend on Makefile. Calling configure @@ -794,9 +639,13 @@ $(OPT_INC) : %.h : %.in $(MAKE) -C $(@D) $(@F) -DLD-FUNCTIONS/PKG_ADD: $(DLD_DYNAMIC_DEF_FILES) mk-pkg-add - $(srcdir)/mk-pkg-add $(DLD_DYNAMIC_DEF_FILES) > $@-t +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)) @@ -828,8 +677,7 @@ gendoc$(BUILD_EXEEXT): gendoc.cc $(BUILD_CXX) $(BUILD_CXXFLAGS) -o $@ $^ $(BUILD_LDFLAGS) - -all-local: $(OCT_STAMP_FILES) DLD-FUNCTIONS/PKG_ADD .DOCSTRINGS +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 @@ -882,8 +730,8 @@ if AMCOND_ENABLE_DYNAMIC_LINKING install-oct: $(top_srcdir)/build-aux/mkinstalldirs $(DESTDIR)$(octfiledir) - if [ -n "`cat DLD-FUNCTIONS/PKG_ADD`" ]; then \ - $(INSTALL_DATA) DLD-FUNCTIONS/PKG_ADD $(DESTDIR)$(octfiledir)/PKG_ADD; \ + 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 \ @@ -911,7 +759,7 @@ CLEANFILES = \ $(bin_SCRIPTS) \ - DLD-FUNCTIONS/PKG_ADD \ + $(DLD_FUNCTIONS_PKG_ADD_FILE) \ doc-files \ gendoc.cc \ gendoc$(BUILD_EXEEXT) \
--- a/src/OPERATORS/op-cell.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/OPERATORS/op-cell.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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-int.h Mon Dec 05 02:02:22 2011 -0500 +++ b/src/OPERATORS/op-int.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 (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 (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 (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 (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 (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-pm-sm.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/OPERATORS/op-pm-sm.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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/base-list.h Mon Dec 05 02:02:22 2011 -0500 +++ b/src/base-list.h Sun Dec 11 23:24:25 2011 -0500 @@ -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/src/bitfcns.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/bitfcns.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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\
--- a/src/comment-list.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/comment-list.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/comment-list.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/data.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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" @@ -148,8 +149,8 @@ %! && 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); */ @@ -204,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); */ @@ -292,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); */ @@ -588,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 @@ -602,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"); } } } @@ -721,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 @@ -735,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"); } } } @@ -1078,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]); @@ -1229,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]); @@ -1341,8 +1342,8 @@ %!assert(diag (int8([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]), -1), int8([1; 2; 3])); %% Test input validation -%!error <Invalid call to diag.*> diag (); -%!error <Invalid call to diag.*> diag (1,2,3,4); +%!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); @@ -1372,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]); @@ -1527,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) @@ -1539,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; @@ -1558,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) { @@ -1718,6 +1874,197 @@ 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\ @@ -1736,6 +2083,12 @@ 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\ @@ -1943,6 +2296,9 @@ %!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)) ); + */ static octave_value @@ -2057,14 +2413,17 @@ @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\ +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\ @@ -2459,7 +2818,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]); @@ -2534,7 +2893,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]); @@ -3046,8 +3405,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); */ @@ -4194,8 +4553,8 @@ @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") { @@ -4264,7 +4623,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); */ @@ -4387,8 +4746,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"); @@ -4621,7 +4980,7 @@ %! 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); */ @@ -4932,7 +5291,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); @@ -4941,7 +5300,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); @@ -4950,7 +5309,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") { @@ -4982,8 +5342,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") { @@ -5059,7 +5419,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\ @@ -5078,7 +5438,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") { @@ -5090,7 +5450,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\ @@ -5110,7 +5470,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") { @@ -5121,7 +5481,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") { @@ -5132,7 +5492,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") { @@ -5202,7 +5562,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\ @@ -5222,7 +5582,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") { @@ -5234,7 +5594,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") { @@ -5245,7 +5605,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") { @@ -5614,6 +5974,8 @@ if (return_idx) { + retval.resize (2); + Array<octave_idx_type> sidx; retval (0) = arg.sort (sidx, dim, smode); @@ -5797,8 +6159,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); */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/data.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/debug.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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) @@ -835,13 +858,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; @@ -882,7 +900,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 +926,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 +947,28 @@ 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} {[@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") +{ + return do_dbstack (args, nargout, octave_stdout); +} + static void do_dbupdown (const octave_value_list& args, const std::string& who) {
--- a/src/debug.h Mon Dec 05 02:02:22 2011 -0500 +++ b/src/debug.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/defaults.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/dirfns.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 { @@ -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 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/display.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/display.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/dynamic-ld.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/dynamic-ld.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/error.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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; @@ -1062,10 +1050,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"); @@ -1456,8 +1452,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 +1460,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, , @@ -1684,10 +1681,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\ @@ -1769,8 +1762,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); @@ -1780,10 +1778,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); @@ -1793,8 +1796,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/file-io.cc Sun Dec 11 23:24:25 2011 -0500 @@ -46,6 +46,7 @@ #include <stack> #include <vector> +#include <fcntl.h> #include <sys/types.h> #include <unistd.h> @@ -1068,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\ @@ -1102,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\ @@ -1135,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) { @@ -1158,6 +1162,7 @@ if (! error_state) { + retval(2) = os.error (); retval(1) = count; retval(0) = tmp; } @@ -1174,15 +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}, @var{pos}] =} 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. In addition to the values\n\ returned by @code{fscanf}, the index of the next character to be read\n\ -is returned in in @var{pos}.\n\ +is returned in @var{pos}.\n\ @seealso{fscanf, scanf, sprintf}\n\ @end deftypefn") { @@ -1194,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 ()) @@ -1223,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 ()) @@ -1263,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 (); @@ -1275,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\ @@ -1962,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\ @@ -1992,7 +2012,7 @@ OCTAVE_LOCAL_BUFFER (char, tmp, tmpl8.size () + 1); strcpy (tmp, tmpl8.c_str ()); - int fd = gnulib::mkstemp (tmp); + int fd = gnulib::mkostemp (tmp, O_BINARY); if (fd < 0) { @@ -2001,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/find-defun-files.sh Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/genprops.awk Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/gl-render.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/gl-render.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/gl2ps-renderer.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/gl2ps.c Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/gl2ps.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/graphics.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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); @@ -2044,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 @@ -2054,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 @@ -2069,6 +2527,7 @@ finalize (go); } + // --------------------------------------------------------------------- void @@ -2139,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 @@ -2240,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 { @@ -2296,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) { @@ -2462,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); @@ -2570,7 +2919,8 @@ { currentfigure = val; - gh_manager::push_figure (val); + if (val.ok ()) + gh_manager::push_figure (val); } else gripe_set_invalid ("currentfigure"); @@ -2606,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. @@ -2756,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)--; @@ -2772,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; @@ -2782,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) @@ -2810,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) @@ -3172,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); @@ -3263,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; @@ -3286,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; @@ -3359,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; } @@ -3372,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); } @@ -3572,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"); @@ -3645,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"); @@ -4140,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; @@ -4187,6 +4748,8 @@ Matrix viewmat = get_view ().matrix_value (); nearhoriz = std::abs(viewmat(1)) <= 5; + + update_ticklengths (); } void @@ -4223,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) { @@ -4305,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) { @@ -4391,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) { @@ -4499,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")) { @@ -4517,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 @@ -4566,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)) { @@ -4693,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; } @@ -4756,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)); @@ -4795,7 +5413,7 @@ ext(2) = ext(2)-ext(0); ext(3) = ext(3)-ext(1); - + return ext; } @@ -4842,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) { @@ -4929,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 (); @@ -4941,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; @@ -4967,6 +5585,10 @@ val = m(2); if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) min_pos = val; + + val = m(3); + if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) + max_neg = val; } } } @@ -4984,8 +5606,8 @@ } else { - b = static_cast<int> (gnulib::floor (std::log10 (std::abs (x)))); - a = x / std::pow (10.0, b); + b = static_cast<int> (gnulib::floor (std::log10 (std::abs (x)))); + a = x / std::pow (10.0, b); } } @@ -5031,24 +5653,34 @@ 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"); min_val = min_pos; @@ -5059,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 { @@ -5087,8 +5729,8 @@ retval.resize (1, 2); + retval(1) = max_val; retval(0) = min_val; - retval(1) = max_val; return retval; } @@ -5106,19 +5748,29 @@ 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); @@ -5147,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; } @@ -5164,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; @@ -5183,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; @@ -5204,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 @@ -5242,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 (); @@ -5258,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; @@ -5272,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; @@ -5286,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; @@ -5300,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; @@ -5314,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; @@ -5338,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; @@ -5345,7 +6043,7 @@ double val; #define FIX_LIMITS \ - if (limits.numel() == 3) \ + if (limits.numel() == 4) \ { \ val = limits(0); \ if (! (xisinf (val) || xisnan (val))) \ @@ -5356,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" @@ -5374,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'; @@ -5391,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'; @@ -5408,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'; @@ -5425,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) { @@ -5433,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); @@ -5453,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) { @@ -5529,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; @@ -5540,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'; @@ -5554,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'; @@ -5568,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'; @@ -5582,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) { @@ -5590,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); @@ -5607,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) { @@ -5693,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); @@ -5742,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; @@ -5810,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; } @@ -5827,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; } @@ -5864,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 (), @@ -5876,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; @@ -5892,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") || @@ -5941,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 @@ -6102,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; @@ -6134,7 +6895,7 @@ update_type = 'a'; } - if (limits.numel() == 3) + if (limits.numel() == 4) { val = limits(0); if (! (xisinf (val) || xisnan (val))) @@ -6145,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) { @@ -6208,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'; } @@ -6247,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) { @@ -6285,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 (); @@ -6306,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; @@ -6333,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'", @@ -6345,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; @@ -6355,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; } @@ -6392,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: @@ -6408,6 +7491,7 @@ private: graphics_handle handle; std::string callback_name; + octave_value callback; octave_value callback_data; }; @@ -6445,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: @@ -6465,6 +7557,7 @@ graphics_handle handle; std::string property_name; octave_value property_value; + bool notify_toolkit; }; graphics_event @@ -6480,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) { @@ -6493,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; } @@ -6515,7 +7621,7 @@ void gh_manager::do_restore_gcbo (void) { - gh_manager::autolock guard; + gh_manager::auto_lock guard; callback_objects.pop_front (); @@ -6525,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 @@ -6602,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); @@ -6641,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 { @@ -6690,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) { @@ -6718,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; } @@ -6734,7 +7900,7 @@ @seealso{isfigure}\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -6746,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\ @@ -6810,7 +8029,7 @@ @end itemize\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -6898,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\ @@ -6907,7 +8141,7 @@ values or lists respectively.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -6915,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; + } + } + } } } } @@ -6961,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; @@ -6988,7 +8311,7 @@ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7040,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; @@ -7079,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) { @@ -7087,6 +8413,7 @@ xset (h, xargs); xcreatefcn (h); + xinitialize (h); retval = h.value (); @@ -7112,7 +8439,7 @@ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7132,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 (); } @@ -7164,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 (); \ \ @@ -7215,7 +8584,7 @@ object, whether 2 or 3.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7308,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; @@ -7342,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"); @@ -7392,7 +8782,7 @@ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7440,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, , @@ -7547,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, , @@ -7572,7 +9054,6 @@ @end deftypefn") { static int drawnow_executing = 0; - static bool __go_close_all_registered__ = false; octave_value retval; @@ -7585,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++) { @@ -7760,7 +9234,7 @@ \n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7832,7 +9306,7 @@ \n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7952,7 +9426,7 @@ \n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -8010,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; @@ -8027,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; @@ -8044,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/graphics.h.in Sun Dec 11 23:24:25 2011 -0500 @@ -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, PERSISTENT }; +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 { @@ -466,7 +483,7 @@ private: int id; - int count; + octave_refcount<int> count; std::string name; graphics_handle parent; bool hidden; @@ -598,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); @@ -643,6 +662,8 @@ else replace = true; + desired_type = string_t; + if (replace) { str = strings; @@ -672,6 +693,8 @@ } } + desired_type = cell_t; + if (replace) { str = strings; @@ -692,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: @@ -713,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; @@ -726,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; @@ -791,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; } } @@ -1115,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 (); } @@ -1123,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 (); } @@ -1133,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 () { } @@ -1148,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; } @@ -1210,6 +1454,7 @@ double xmin; double xmax; double xminp; + double xmaxp; std::list<std::string> type_constraints; std::list<dim_vector> size_constraints; }; @@ -1471,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; @@ -1587,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; } @@ -1628,6 +1888,9 @@ private: octave_value callback; + + // If TRUE, we are executing this callback. + mutable bool executing; }; // --------------------------------------------------------------------- @@ -1648,7 +1911,7 @@ ~property (void) { - if (--rep->count <= 0) + if (--rep->count == 0) delete rep; } @@ -1685,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 (); } @@ -1702,7 +1966,7 @@ property& operator = (const property& p) { - if (rep && --rep->count <= 0) + if (rep && --rep->count == 0) delete rep; rep = p.rep; @@ -1855,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 @@ -1868,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 @@ -1950,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 @@ -1965,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 { @@ -2028,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). @@ -2080,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); @@ -2131,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 @@ -2150,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; @@ -2224,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) { } @@ -2385,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 () @@ -2437,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 @@ -2635,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 (); } @@ -2696,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) { } @@ -2795,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); @@ -2802,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) { @@ -2824,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"); @@ -2840,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); @@ -2869,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 () @@ -2877,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}" @@ -2885,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" @@ -2905,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: @@ -2916,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: @@ -2932,10 +3415,7 @@ xproperties.override_defaults (*this); } - ~figure (void) - { - xproperties.delete_children (); - } + ~figure (void) { } void override_defaults (base_graphics_object& obj) { @@ -3096,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")) @@ -3206,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); @@ -3233,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" @@ -3288,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 @@ -3318,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: @@ -3411,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"); @@ -3457,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) { @@ -3516,7 +4016,7 @@ xproperties.update_transform (); } - ~axes (void) { xproperties.delete_children (); } + ~axes (void) { } void override_defaults (base_graphics_object& obj) { @@ -3582,6 +4082,9 @@ void reset_default_properties (void); +protected: + void initialize (const graphics_object& go); + private: property_list default_properties; }; @@ -3650,7 +4153,7 @@ xproperties.override_defaults (*this); } - ~line (void) { xproperties.delete_children (); } + ~line (void) { } base_properties& get_properties (void) { return xproperties; } @@ -3667,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 @@ -3712,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 @@ -3722,6 +4227,7 @@ position.add_constraint (dim_vector (1, 2)); position.add_constraint (dim_vector (1, 3)); cached_units = get_units (); + update_font (); } private: @@ -3757,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 (); } @@ -3786,7 +4293,7 @@ xproperties.override_defaults (*this); } - ~text (void) { xproperties.delete_children (); } + ~text (void) { } base_properties& get_properties (void) { return xproperties; } @@ -3910,7 +4417,7 @@ xproperties.override_defaults (*this); } - ~image (void) { xproperties.delete_children (); } + ~image (void) { } base_properties& get_properties (void) { return xproperties; } @@ -3954,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")) @@ -4028,7 +4535,7 @@ xproperties.override_defaults (*this); } - ~patch (void) { xproperties.delete_children (); } + ~patch (void) { } base_properties& get_properties (void) { return xproperties; } @@ -4070,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" @@ -4181,7 +4688,7 @@ xproperties.override_defaults (*this); } - ~surface (void) { xproperties.delete_children (); } + ~surface (void) { } base_properties& get_properties (void) { return xproperties; } @@ -4249,7 +4756,7 @@ xproperties.override_defaults (*this); } - ~hggroup (void) { xproperties.delete_children (); } + ~hggroup (void) { } base_properties& get_properties (void) { return xproperties; } @@ -4286,6 +4793,7 @@ // properties declarations. BEGIN_PROPERTIES (uimenu) + any_property __object__ , Matrix () string_property accelerator , "" callback_property callback , Matrix() bool_property checked , "off" @@ -4312,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; } @@ -4348,7 +5251,7 @@ virtual void execute (void) = 0; private: - int count; + octave_refcount<int> count; }; class @@ -4395,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; }; @@ -4415,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) { @@ -4432,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 (); @@ -4461,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) @@ -4492,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) @@ -4503,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, @@ -4544,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) @@ -4569,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; @@ -4581,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: @@ -4631,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)); @@ -4650,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; } @@ -4686,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 ()) @@ -4715,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); @@ -4728,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/help.cc Sun Dec 11 23:24:25 2011 -0500 @@ -152,43 +152,43 @@ 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{#@{}. Also,\n\ -it is possible to nest block comments.\n\ -@seealso{#, #@}, %@{}\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{%@{}. Also,\n\ -it is possible to nest block comments.\n\ -@seealso{%, %@}, #@{}\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{#@}}. Also,\n\ -it is possible to nest block comments.\n\ -@seealso{#, #@{, %@}}\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{%@}}. Also,\n\ -it is possible to nest block comments.\n\ -@seealso{%, %@{, #@}}\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\ +Continuation marker. Joins current line with following line.\n\ @end deftypefn"), pair_type ("&", @@ -208,12 +208,12 @@ pair_type ("'", "-*- texinfo -*-\n\ @deftypefn {Operator} {} '\n\ -Matrix transpose operator. For complex matrices, computes the\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\n\ +ambiguous.\n\ @seealso{.', transpose}\n\ @end deftypefn"), @@ -260,7 +260,7 @@ pair_type ("++", "-*- texinfo -*-\n\ @deftypefn {Operator} {} ++\n\ -Increment operator. As in C, may be applied as a prefix or postfix\n\ +Increment operator. As in C, may be applied as a prefix or postfix\n\ operator.\n\ @seealso{--}\n\ @end deftypefn"), @@ -281,7 +281,7 @@ pair_type ("--", "-*- texinfo -*-\n\ @deftypefn {Operator} {} --\n\ -Decrement operator. As in C, may be applied as a prefix or postfix\n\ +Decrement operator. As in C, may be applied as a prefix or postfix\n\ operator.\n\ @seealso{++}\n\ @end deftypefn"), @@ -289,7 +289,7 @@ pair_type (".'", "-*- texinfo -*-\n\ @deftypefn {Operator} {} .'\n\ -Matrix transpose operator. For complex matrices, computes the\n\ +Matrix transpose operator. For complex matrices, computes the\n\ transpose, @emph{not} the complex conjugate transpose.\n\ @seealso{', transpose}\n\ @end deftypefn"), @@ -432,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", @@ -455,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", @@ -485,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", @@ -523,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\ @@ -549,7 +556,7 @@ endfor\n\ @end group\n\ @end example\n\ -@seealso{do, while}\n\ +@seealso{do, parfor, while}\n\ @end deftypefn"), pair_type ("function", @@ -608,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\ @@ -619,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\ @@ -706,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", @@ -749,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 (); @@ -758,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); @@ -772,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]; @@ -1238,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\ @@ -1247,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") { @@ -1257,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\ @@ -1264,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") { @@ -1274,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\ @@ -1283,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") { @@ -1293,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") { @@ -1306,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/input.cc Sun Dec 11 23:24:25 2011 -0500 @@ -275,6 +275,9 @@ flush_octave_stdout (); + octave_pager_stream::reset (); + octave_diary_stream::reset (); + octave_diary << prompt; retval = interactive_input (prompt); @@ -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> "; @@ -1363,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\ @@ -1388,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") { @@ -1398,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") { @@ -1414,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") { @@ -1428,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); @@ -1440,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\ @@ -1459,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); @@ -1509,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\ @@ -1529,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/lex.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/lex.ll Sun Dec 11 23:24:25 2011 -0500 @@ -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 (')'); @@ -1395,6 +1416,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 +1538,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 +1558,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 +1578,9 @@ lexer_flags.at_beginning_of_statement = true; break; + case for_kw: + case parfor_kw: case while_kw: promptflag--; lexer_flags.looping++; @@ -1562,9 +1611,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 +3403,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 +3488,14 @@ return retval; } +/* + +%!assert (iskeyword ("for")) +%!assert (iskeyword ("fort"), false) +%!assert (iskeyword ("fft"), false) + +*/ + void prep_lexer_for_script_file (void) {
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/link-deps.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/load-path.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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) {
--- a/src/load-path.h Mon Dec 05 02:02:22 2011 -0500 +++ b/src/load-path.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/load-save.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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); @@ -1457,6 +1475,7 @@ @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\ @@ -1729,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") { @@ -1742,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") { @@ -1756,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\ @@ -1764,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") { @@ -1774,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") { @@ -1787,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") { @@ -1802,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\ @@ -1815,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/load-save.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ls-mat5.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ls-oct-ascii.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/mappers.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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, , @@ -573,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, , @@ -635,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, , @@ -660,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, , @@ -696,7 +687,10 @@ } /* +%% FIXME: Need a test for erfcx +%!error erfcx () +%!error erfcx (1, 2) */ DEFUN (exp, args, , @@ -724,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, , @@ -761,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\ @@ -788,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\ @@ -825,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, , @@ -862,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, , @@ -909,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, , @@ -956,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\ @@ -990,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\ @@ -1008,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\ @@ -1025,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\ @@ -1042,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\ @@ -1059,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\ @@ -1085,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\ @@ -1118,6 +1172,17 @@ 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\ @@ -1135,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\ @@ -1161,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\ @@ -1202,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\ @@ -1235,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\ @@ -1252,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\ @@ -1270,6 +1373,17 @@ 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\ @@ -1287,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\ @@ -1304,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\ @@ -1322,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, , @@ -1377,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\ @@ -1406,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, , @@ -1438,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\ @@ -1455,27 +1595,25 @@ } /* - -%!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}. If there\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\ @@ -1497,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, , @@ -1537,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\ @@ -1571,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, , @@ -1604,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, , @@ -1641,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\ @@ -1676,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, , @@ -1709,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, , @@ -1746,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, , @@ -1786,6 +1933,18 @@ 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\ @@ -1815,23 +1974,28 @@ 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 {Mapping Function} {} toupper (@var{s})\n\ @@ -1861,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/mex.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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);
--- a/src/mkoctfile.cc.in Mon Dec 05 02:02:22 2011 -0500 +++ b/src/mkoctfile.cc.in Sun Dec 11 23:24:25 2011 -0500 @@ -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,13 +765,11 @@ } else { - string LINK_DEPS = vars["LFLAGS"] + " " + vars["OCTAVE_LIBS"] - + " " + vars["LDFLAGS"] + " " - + vars["LAPACK_LIBS"] + " " + 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); }
--- a/src/mkoctfile.in Mon Dec 05 02:02:22 2011 -0500 +++ b/src/mkoctfile.in Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/oct-conf.h.in Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/oct-errno.cc.in Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/oct-errno.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/oct-hist.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/oct-hist.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/oct-map.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/oct-map.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/oct-obj.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/oct-obj.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/oct-parse.yy Sun Dec 11 23:24:25 2011 -0500 @@ -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) @@ -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; } @@ -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; @@ -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); @@ -4363,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 @@ -4399,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 @@ -4446,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\
--- a/src/oct-stream.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/oct-stream.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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,158 +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 (c2); - is.putback (c1); - - is >> ref; - } - } - } - else - { - is.putback (c1); - - is >> ref; - } + is.putback (c1); + + ref = octave_read_value<double> (is); } } break; @@ -2264,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 (); @@ -2294,6 +2146,9 @@ retval(nconv) = num_values; + int err_num; + retval(nconv+1) = error (false, err_num); + if (! quit) { // Pick up any trailing stuff. @@ -3011,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); - } } } @@ -4040,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) { @@ -4299,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/oct-stream.h Sun Dec 11 23:24:25 2011 -0500 @@ -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;
--- a/src/octave-config.cc.in Mon Dec 05 02:02:22 2011 -0500 +++ b/src/octave-config.cc.in Sun Dec 11 23:24:25 2011 -0500 @@ -219,6 +219,6 @@ return 1; } } - + return 0; }
--- a/src/octave-config.in Mon Dec 05 02:02:22 2011 -0500 +++ b/src/octave-config.in Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/octave.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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; @@ -971,6 +974,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 +1001,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 +1023,8 @@ return retval; } + +/* +%!error program_name (1); +%!assert (ischar (program_name ())); +*/
--- a/src/octave.gperf Mon Dec 05 02:02:22 2011 -0500 +++ b/src/octave.gperf Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-base-mat.h Sun Dec 11 23:24:25 2011 -0500 @@ -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.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-base.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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,6 +1530,7 @@ "-*- 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\ For example:\n\ @@ -1544,7 +1548,24 @@ @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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-base.h Sun Dec 11 23:24:25 2011 -0500 @@ -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.h Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-bool.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-builtin.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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-class.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-class.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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"); + } } } } @@ -322,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; } @@ -399,7 +515,7 @@ } else retval(0) = octave_value (map.index (idx.front ()), - class_name ()); + c_name, parent_list); } break; @@ -475,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 (); } @@ -876,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); @@ -996,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 { @@ -1020,7 +1166,8 @@ indent (os); os << name << " ="; newline (os); - newline (os); + if (! Vcompact_format) + newline (os); return retval; } @@ -1685,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 ())); } @@ -1806,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-class.h Sun Dec 11 23:24:25 2011 -0500 @@ -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,14 +134,14 @@ size_t nparents (void) const { return parent_list.size (); } octave_value reshape (const dim_vector& new_dims) const - { + { 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_class retval = octave_class (*this); retval.map.resize (dv); return octave_value (new octave_class (retval)); @@ -160,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-cx-sparse.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-cx-sparse.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-fcn-handle.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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; @@ -1925,3 +1956,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.h Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-fcn.h Sun Dec 11 23:24:25 2011 -0500 @@ -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-flt-re-mat.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-flt-re-mat.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-int16.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-int32.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-int64.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-int8.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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-mex-fcn.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-mex-fcn.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-null-mat.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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); + +*/
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/ov-oncleanup.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 + +*/
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/ov-oncleanup.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-perm.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-perm.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-range.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 +%! save = 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-re-mat.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-struct.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-typeinfo.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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) { @@ -595,7 +601,7 @@ @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") { @@ -612,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-typeinfo.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-uint16.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-uint32.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-uint64.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-uint8.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-usr-fcn.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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" // Whether to optimize subsasgn method calls. @@ -131,7 +134,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; @@ -176,13 +181,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) @@ -217,6 +223,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) { @@ -428,8 +453,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) { @@ -448,6 +474,8 @@ else cmd_list->accept (*current_evaluator); + END_PROFILER_BLOCK + if (echo_commands) print_code_function_trailer (); @@ -607,7 +635,7 @@ Octave. If called with the optional argument @var{fcn_name}, return the\n\ maximum number of arguments the named function can accept, or -1 if the\n\ function accepts a variable number of arguments.\n\ -@seealso{nargout, varargin, varargout}\n\ +@seealso{nargout, varargin, isargout, varargout, nthargout}\n\ @end deftypefn") { octave_value retval; @@ -620,23 +648,33 @@ if (! error_state) { - octave_value fcn_val = symbol_table::find_user_function (fname); + octave_value fcn_val = symbol_table::find_function (fname); - octave_user_function *fcn = fcn_val.user_function_value (true); - - if (fcn) + if (fcn_val.is_user_function ()) { - if (fcn->takes_varargs ()) - retval = -1; - else + octave_user_function *fcn = fcn_val.user_function_value (true); + + if (fcn) { - tree_parameter_list *param_list = fcn->parameter_list (); + if (fcn->takes_varargs ()) + retval = -1; + else + { + tree_parameter_list *param_list = fcn->parameter_list (); - retval = param_list ? param_list->length () : 0; + retval = param_list ? param_list->length () : 0; + } } + else + error ("nargin: loading user-defined function failed"); } else - error ("nargin: invalid function"); + { + // FIXME -- what about built-in functions or functions + // defined in .oct files or .mex files? + + error ("nargin: FCN_NAME must be a user-defined function"); + } } else error ("nargin: FCN_NAME must be a string"); @@ -681,7 +719,7 @@ @code{f}.\n\ \n\ At the top level, @code{nargout} is undefined.\n\ -@seealso{nargin, isargout, varargin, varargout}\n\ +@seealso{nargin, varargin, isargout, varargout, nthargout}\n\ @end deftypefn") { octave_value retval; @@ -737,9 +775,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); @@ -778,7 +821,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov-usr-fcn.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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\ @@ -2758,6 +2825,9 @@ \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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/ov.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pager.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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->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); @@ -545,10 +641,15 @@ "-*- 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} {} 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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pager.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/parse.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pr-output.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pr-output.h Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/profiler.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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; +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/profiler.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-assign.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-binop.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-cbinop.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-check.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-const.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-const.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-eval.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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); @@ -347,17 +338,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 ()) @@ -397,9 +395,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 +1196,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-fcn-handle.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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);
--- a/src/pt-fcn-handle.h Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-fcn-handle.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-idx.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-loop.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-loop.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-mat.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-pr-code.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/pt-unop.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/sighandlers.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/sighandlers.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/sparse-xpow.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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/strfns.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/strfns.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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])) @@ -904,9 +922,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/symtab.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/symtab.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/syscalls.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 @@ -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");
--- a/src/sysdep.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/sysdep.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/token.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/toplev.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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,10 +669,19 @@ { do_octave_atexit (); - // Clean up symbol table. - SAFE_CALL (symbol_table::cleanup, ()); + OCTAVE_SAFE_CALL (gh_manager::close_all_figures, ()); + + OCTAVE_SAFE_CALL (gtk_manager::unload_all_toolkits, ()); + + OCTAVE_SAFE_CALL (symbol_table::cleanup, ()); - SAFE_CALL (sysdep_cleanup, ()) + OCTAVE_SAFE_CALL (cleanup_parser, ()); + + OCTAVE_SAFE_CALL (sysdep_cleanup, ()); + + OCTAVE_SAFE_CALL (singleton_cleanup_list::cleanup, ()); + + OCTAVE_SAFE_CALL (octave_chunk_buffer::clear, ()); if (octave_exit) (*octave_exit) (retval == EOF ? 0 : retval); @@ -704,9 +712,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 +827,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 +840,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 +886,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 +1017,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 +1044,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 +1058,23 @@ // 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)); - SAFE_CALL (octave_history_write_timestamp, ()) + OCTAVE_SAFE_CALL (octave_history_write_timestamp, ()); - if (Vsaving_history) - SAFE_CALL (command_history::clean_up_and_save, ()) + if (! command_history::ignoring_entries ()) + OCTAVE_SAFE_CALL (command_history::clean_up_and_save, ()); - SAFE_CALL (close_files, ()) + OCTAVE_SAFE_CALL (close_files, ()); - SAFE_CALL (cleanup_tmp_files, ()) + OCTAVE_SAFE_CALL (cleanup_tmp_files, ()); - SAFE_CALL (flush_octave_stdout, ()) + OCTAVE_SAFE_CALL (flush_octave_stdout, ()); if (! quitting_gracefully && (interactive || forced_interactive)) { @@ -1055,7 +1083,7 @@ // 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, ()); } } } @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/toplev.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/txt-eng-ft.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/txt-eng-ft.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/utils.cc Sun Dec 11 23:24:25 2011 -0500 @@ -36,6 +36,8 @@ #include <sys/types.h> #include <unistd.h> +#include "vasnprintf.h" + #include "quit.h" #include "dir-ops.h" @@ -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,6 +852,13 @@ 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\ @@ -789,6 +883,13 @@ 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})\n\ @@ -829,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\ @@ -873,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\ @@ -889,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) { @@ -1035,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) { @@ -1140,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); @@ -1155,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); @@ -1352,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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/utils.h Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/src/variables.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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; } @@ -1043,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, @@ -1117,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; } @@ -1172,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: @@ -1333,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 @@ -1798,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\ @@ -2039,9 +2050,7 @@ { if (have_regexp) { - regex_match pattern (patstr); - - if (pattern.match (nm)) + if (is_regexp_match (patstr, nm)) { retval = true; break; @@ -2451,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\ @@ -2512,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") { @@ -2524,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\ +@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/xpow.cc Mon Dec 05 02:02:22 2011 -0500 +++ b/src/xpow.cc Sun Dec 11 23:24:25 2011 -0500 @@ -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 (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 (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 (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 (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 (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 (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 (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 (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/test/@Blork/Blork.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = Blork( bleek ) -% Test class. - - if (nargin==1) && isa(bleek, 'Blork') - s = bleek; - else - if nargin==0 - s.bleek = 1; - else - s.bleek = bleek; - end - s = class(s, 'Blork'); - - end - -end
--- a/test/@Blork/bleek.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = bleek( in, val ) - - if (nargin==1) - out = in.bleek; - else - in.bleek = val; - out = in; - end - -end
--- a/test/@Blork/display.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7 +0,0 @@ -function display( s ) - - disp([inputname(1),'.bleek = ']) - disp(' '); - disp(s.bleek); - -end \ No newline at end of file
--- a/test/@Blork/get.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ v ] = get( s, propName ) - - switch propName - case 'bleek' - v = s.bleek; - otherwise - error([propName, ' is not a valid Blork property']); - end - -end
--- a/test/@Blork/module.mk Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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)
--- a/test/@Blork/set.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = set( s, varargin ) - - propArgs = varargin; - while (length(propArgs) >= 2) - propName = propArgs{1}; - propValue = propArgs{2}; - propArgs = propArgs(3:end); - switch propName - case 'bleek' - s.bleek = propValue; - otherwise - error([propName, ' is not a valid Blork property']); - end - end - -end
--- a/test/@Cork/Cork.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = Cork( click ) -% Test class. - - if ( (nargin==1) && (isa(click, 'Cork')) ) - s = click; - return; - end - - if( nargin<1 ) - s.click = 1; - else - s.click = click; - end - s = class(s, 'Cork'); - -end
--- a/test/@Cork/click.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = click( in, val ) - - if (nargin==1) - out = in.click; - else - in.click = val; - out = in; - end - -end
--- a/test/@Cork/display.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7 +0,0 @@ -function display( s ) - - disp([inputname(1),'.click = ']); - disp(' '); - disp(s.click); - -end \ No newline at end of file
--- a/test/@Cork/get.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ v ] = get( s, propName ) - - switch propName - case 'click' - v = s.click; - otherwise - error([propName, ' is not a valid Cork property']); - end - -end
--- a/test/@Cork/module.mk Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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)
--- a/test/@Cork/set.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = set( s, varargin ) - - propArgs = varargin; - while (length(propArgs) >= 2) - propName = propArgs{1}; - propValue = propArgs{2}; - propArgs = propArgs(3:end); - switch propName - case 'click' - s.click = propValue; - otherwise - error([propName, ' is not a valid Cork property']); - end - end - -end
--- a/test/@Dork/Dork.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -function [ s ] = Dork( gick, gack ) - - if (nargin==1) && isa(gick,'Dork') - s = gick; - else - s.gack = 0; - if nargin == 0 - s0 = Snork(); - elseif nargin==1 - s0 = Snork(gick); - else - s0 = Snork(gick); - s.gack = gack; - end - s = class(s,'Dork',s0); - end - -end
--- a/test/@Dork/bling.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = bling( m1, m2 ) - - out = 1; - -end
--- a/test/@Dork/display.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -function display( s ) -% Display the critical info for an amplifier - - gick = get(s,'gick'); - disp([inputname(1),'.gick = ']) - disp(' '); - disp(gick); - disp(' '); - disp([inputname(1),'.gack = ']) - disp(' '); - disp(s.gack); - -end
--- a/test/@Dork/gack.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = gack( in, val ) - - if (nargin==1) - out = in.gack; - else - in.gack = val; - out = in; - end - -end
--- a/test/@Dork/get.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ v ] = get( s, propName ) - - switch propName - case 'gack' - v = s.gack; - otherwise - v = get(s.Snork,propName); - end - -end
--- a/test/@Dork/getStash.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = getStash(cls) - - out = myStash(); - -end
--- a/test/@Dork/module.mk Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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)
--- a/test/@Dork/private/myStash.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = myStash() - - out = 2; - -end
--- a/test/@Dork/set.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = set( s, varargin ) - - propArgs = varargin; - while (length(propArgs) >= 2) - propName = propArgs{1}; - propValue = propArgs{2}; - propArgs = propArgs(3:end); - switch propName - case 'gack' - s.gack = propValue; - otherwise - s.Snork = set(s.Snork, propName, propValue); - end - end - -end
--- a/test/@Gork/Gork.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,15 +0,0 @@ -function [ s ] = Gork( g ) - if (nargin==1) && isa(g,'Gork') - s = sprk; - return; - end - - drk = Dork(); - prk = Pork(); - blrk = Blork(); - s.Cork = Cork(17); % Aggregation. - s.gark = -2; - s.gyrk = -3; - s = class(s,'Gork',drk,prk,blrk); - -end
--- a/test/@Gork/cork.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = cork( in, val ) - - if (nargin==1) - out = in.Cork; - else - in.Cork = val; - out = in; - end - -end
--- a/test/@Gork/display.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function display( s ) -% Display the critical info for a Gork. - - dork_base = s.Dork - %pork_base = s.Pork - %sprk = s.sprk; - gark = get(s,'gark'); - disp([inputname(1),'.gark = ']) - disp(' '); - disp(gark); - disp([inputname(1),'.Cork= ']) - disp(' '); - disp(click(s.Cork)); - - -end
--- a/test/@Gork/gark.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = gark( in, val ) - - if (nargin==1) - out = in.gark; - else - in.gark = val; - out = in; - end - -end
--- a/test/@Gork/get.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -function [ v ] = get( s, propName ) - - switch propName - case 'cork' - v = s.Cork; - case 'gark' - v = s.gark; - otherwise - % Note that get/set for multiple parents is hard. We only do one - % branch of the parent tree just to test this stuff out. - v = get(s.Dork,propName); - end - -end
--- a/test/@Gork/module.mk Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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)
--- a/test/@Gork/set.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,24 +0,0 @@ -function [ s ] = set( s, varargin ) - - propArgs = varargin; - while (length(propArgs) >= 2) - propName = propArgs{1}; - propValue = propArgs{2}; - propArgs = propArgs(3:end); - switch propName - case 'cork' - if(isa(propValue,'Cork')) - s.Cork = propValue; - else - s.Cork = set(s.Cork, 'click',propValue); - end - case 'gark' - s.gark = propValue; - otherwise - % Note that get/set for multiple parents is hard. We only do one - % branch of the parent tree just to test this stuff out. - s.Dork = set(s.Dork, propName, propValue); - end - end - -end
--- a/test/@Gork/subsasgn.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,9 +0,0 @@ -function g = subsasgn(g, s, x) - - switch s.type - case '.' - switch s.subs - case 'gyrk' - g.gyrk = x; - end -end
--- a/test/@Gork/subsref.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,9 +0,0 @@ -function x = subsref(g, s) - - switch s.type - case '.' - switch s.subs - case 'gyrk' - x = g.gyrk; - end -end
--- a/test/@Pork/Pork.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -function [ s ] = Pork( geek, gurk ) - - if (nargin==1) && isa(geek,'Pork') - s = geek; - else - s.gurk = 0; - if nargin == 0 - s0 = Spork(); - elseif nargin==1 - s0 = Spork(geek); - else - s0 = Spork(geek); - s.gurk = gurk; - end - s = class(s,'Pork',s0); - end - superiorto('Dork'); - -end
--- a/test/@Pork/bling.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = bling( m1, m2 ) - - out = 2; - -end
--- a/test/@Pork/display.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -function display( s ) -% Display the critical info for an amplifier - - geek = get(s,'geek'); - disp([inputname(1),'.geek = ']) - disp(' '); - disp(geek); - disp(' '); - disp([inputname(1),'.gurk = ']) - disp(' '); - disp(s.gurk); - -end
--- a/test/@Pork/get.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ v ] = get( s, propName ) - - switch propName - case 'gurk' - v = s.gurk; - otherwise - v = get(s.Spork,propName); - end - -end
--- a/test/@Pork/gurk.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = gurk( in, val ) - - if (nargin==1) - out = in.gurk; - else - in.gurk = val; - out = in; - end - -end
--- a/test/@Pork/module.mk Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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)
--- a/test/@Pork/private/myStash.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = myStash() - - out = 4; - -end
--- a/test/@Pork/set.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = set( s, varargin ) - - propArgs = varargin; - while (length(propArgs) >= 2) - propName = propArgs{1}; - propValue = propArgs{2}; - propArgs = propArgs(3:end); - switch propName - case 'gurk' - s.gurk = propValue; - otherwise - s.Spork = set(s.Spork, propName, propValue); - end - end - -end
--- a/test/@Sneetch/Sneetch.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = Sneetch( mcbean ) -% Test class: should produce error. - - if (nargin==1) && isa(mcbean, 'Sneetch') - s = mcbean; - else - if nargin==0 - s.mcbean = 1; - else - s.mcbean = mcbean; - end - s = class(s, 'Sneetch'); - s.sylvester = 1; - end - -end
--- a/test/@Sneetch/display.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function display( s ) - - disp([inputname(1),'.mcbean = ']) - disp(' '); - disp(s.mcbean); - disp([inputname(1),'.sylvester = ']) - disp(' '); - disp(s.sylvester); - -end \ No newline at end of file
--- a/test/@Sneetch/module.mk Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -at_Sneetch_FCN_FILES = \ - @Sneetch/Sneetch.m \ - @Sneetch/display.m - -FCN_FILES += $(at_Sneetch_FCN_FILES)
--- a/test/@Snork/Snork.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17 +0,0 @@ -function [ s ] = Snork( gick ) -% Test class. - - if ( (nargin==1) && (isa(gick, 'Snork')) ) - s = gick; - else - s.cack = [0 1 2 3]; - if nargin==0 - s.gick = 1; - else - s.gick = gick; - end - s = class(s, 'Snork'); - - end - -end
--- a/test/@Snork/cack.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = cack( in ) - - out = in.cack; - -end
--- a/test/@Snork/display.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7 +0,0 @@ -function display( s ) - - disp([inputname(1),'.gick = ']); - disp(' '); - disp(s.gick); - -end \ No newline at end of file
--- a/test/@Snork/end.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,9 +0,0 @@ -function r = end (snk, index_pos, num_indices) - - if (num_indices ~= 1) - error ('Snork object may only have one index') - end - - r = length (snk.cack); - -end
--- a/test/@Snork/get.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ v ] = get( s, propName ) - - switch propName - case 'gick' - v = s.gick; - otherwise - error([propName, ' is not a valid Snork property']); - end - -end
--- a/test/@Snork/getStash.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = getStash(cls) - - out = myStash(); - -end
--- a/test/@Snork/gick.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = gick( in, val ) - - if (nargin==1) - out = in.gick; - else - in.gick = val; - out = in; - end - -end
--- a/test/@Snork/loadobj.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6 +0,0 @@ -function [ out ] = loadobj( in ) - - out = in; - out.cack = [-1 -2 -3 -4]; - -end
--- a/test/@Snork/module.mk Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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)
--- a/test/@Snork/private/myStash.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = myStash() - - out = 1; - -end
--- a/test/@Snork/saveobj.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6 +0,0 @@ -function [ out ] = saveobj( in ) - - out = in; - out.cack = []; - -end
--- a/test/@Snork/set.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = set( s, varargin ) - - propArgs = varargin; - while (length(propArgs) >= 2) - propName = propArgs{1}; - propValue = propArgs{2}; - propArgs = propArgs(3:end); - switch propName - case 'gick' - s.gick = propValue; - otherwise - error([propName, ' is not a valid Snork property']); - end - end - -end
--- a/test/@Snork/subsasgn.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -function snk = subsasgn (snk, s, val) - if (length (s) < 1) - error ('Snork: needs index'); - end - switch (s(1).type) - case '()' - ind = s(1).subs; - if (numel (ind) ~= 1) - error ('Snork: need exactly one index'); - else - if (length (s) == 1) - snk.cack(ind{1}) = val; - else - error ('Snork: chained subscripts not allowed for {}'); - end - end - case '{}' - ind = s(1).subs; - if (numel (ind) ~= 1) - error ('Snork: need exactly one index'); - else - if (length (s) == 1) - snk.cack(ind{1}) = val; - else - error ('Snork: chained subscripts not allowed for {}'); - end - end - case '.' - fld = s(1).subs; - if (strcmp (fld, 'gick')) - snk.gick = val; - else - error ('Snork/subsasgn: invalid property \"%s\"', fld); - end - otherwise - error ('invalid subscript type'); - end -end
--- a/test/@Snork/subsindex.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = subsindex( obj ) - - out = 0; - -end
--- a/test/@Snork/subsref.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,30 +0,0 @@ -function b = subsref (snk, s) - if (isempty (s)) - error ('Snork: missing index'); - end - switch (s(1).type) - case '()' - ind = s(1).subs; - if (numel (ind) ~= 1) - error ('Snork: need exactly one index'); - else - b = snk.cack(ind{1}); - end - case '{}' - ind = s(1).subs; - if (numel (ind) ~= 1) - error ('Snork: need exactly one index'); - else - b = snk.cack(ind{1}); - end - case '.' - fld = s.subs; - if (strcmp (fld, 'gick')) - b = snk.gick; - else - error ('Snork/subsref: invalid property \"%s\"', fld); - end - otherwise - error ('invalid subscript type'); - end -end
--- a/test/@Spork/Spork.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17 +0,0 @@ -function [ s ] = Spork( geek ) -% Test class. - - if (nargin==1) && isa(geek, 'Spork') - s = geek; - else - s.cack = [-1 -2 -3 -4]; - if nargin==0 - s.geek = 1; - else - s.geek = geek; - end - s = class(s, 'Spork'); - - end - -end
--- a/test/@Spork/cack.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = cack( in ) - - out = in.cack; - -end
--- a/test/@Spork/display.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7 +0,0 @@ -function display( s ) - - disp([inputname(1),'.geek = ']) - disp(' '); - disp(s.geek); - -end \ No newline at end of file
--- a/test/@Spork/geek.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = geek( in, val ) - - if (nargin==1) - out = in.geek; - else - in.geek = val; - out = in; - end - -end
--- a/test/@Spork/get.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ v ] = get( s, propName ) - - switch propName - case 'geek' - v = s.geek; - otherwise - error([propName, ' is not a valid Spork property']); - end - -end
--- a/test/@Spork/getStash.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = getStash(cls) - - out = myStash(); - -end
--- a/test/@Spork/loadobj.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -function [ out ] = loadobj( in ) - - out = in; - if (~isa(in,'Spork')) - out.cack=[]; - end - -end
--- a/test/@Spork/module.mk Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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/@Spork/private/myStash.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = myStash() - - out = 3; - -end
--- a/test/@Spork/saveobj.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6 +0,0 @@ -function [ out ] = saveobj( in ) - - out = in; - %rmfield(out,'cack'); - -end
--- a/test/@Spork/set.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = set( s, varargin ) - - propArgs = varargin; - while (length(propArgs) >= 2) - propName = propArgs{1}; - propValue = propArgs{2}; - propArgs = propArgs(3:end); - switch propName - case 'geek' - s.geek = propValue; - otherwise - error([propName, ' is not a valid Spork property']); - end - end - -end
--- a/test/Makefile.am Mon Dec 05 02:02:22 2011 -0500 +++ b/test/Makefile.am Sun Dec 11 23:24:25 2011 -0500 @@ -23,7 +23,6 @@ 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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/class-concat/@foo/foo.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,3 @@ +function r = foo () + r = class (struct (), 'foo'); +endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/class-concat/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/class-concat/test_class_concat.m Sun Dec 11 23:24:25 2011 -0500 @@ -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")
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Blork/Blork.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = Blork( bleek ) +% Test class. + + if (nargin==1) && isa(bleek, 'Blork') + s = bleek; + else + if nargin==0 + s.bleek = 1; + else + s.bleek = bleek; + end + s = class(s, 'Blork'); + + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Blork/bleek.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = bleek( in, val ) + + if (nargin==1) + out = in.bleek; + else + in.bleek = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Blork/display.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,7 @@ +function display( s ) + + disp([inputname(1),'.bleek = ']) + disp(' '); + disp(s.bleek); + +end \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Blork/get.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function [ v ] = get( s, propName ) + + switch propName + case 'bleek' + v = s.bleek; + otherwise + error([propName, ' is not a valid Blork property']); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Blork/set.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = set( s, varargin ) + + propArgs = varargin; + while (length(propArgs) >= 2) + propName = propArgs{1}; + propValue = propArgs{2}; + propArgs = propArgs(3:end); + switch propName + case 'bleek' + s.bleek = propValue; + otherwise + error([propName, ' is not a valid Blork property']); + end + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Cork/Cork.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = Cork( click ) +% Test class. + + if ( (nargin==1) && (isa(click, 'Cork')) ) + s = click; + return; + end + + if( nargin<1 ) + s.click = 1; + else + s.click = click; + end + s = class(s, 'Cork'); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Cork/click.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = click( in, val ) + + if (nargin==1) + out = in.click; + else + in.click = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Cork/display.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,7 @@ +function display( s ) + + disp([inputname(1),'.click = ']); + disp(' '); + disp(s.click); + +end \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Cork/get.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function [ v ] = get( s, propName ) + + switch propName + case 'click' + v = s.click; + otherwise + error([propName, ' is not a valid Cork property']); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Cork/set.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = set( s, varargin ) + + propArgs = varargin; + while (length(propArgs) >= 2) + propName = propArgs{1}; + propValue = propArgs{2}; + propArgs = propArgs(3:end); + switch propName + case 'click' + s.click = propValue; + otherwise + error([propName, ' is not a valid Cork property']); + end + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/Dork.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,18 @@ +function [ s ] = Dork( gick, gack ) + + if (nargin==1) && isa(gick,'Dork') + s = gick; + else + s.gack = 0; + if nargin == 0 + s0 = Snork(); + elseif nargin==1 + s0 = Snork(gick); + else + s0 = Snork(gick); + s.gack = gack; + end + s = class(s,'Dork',s0); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/bling.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = bling( m1, m2 ) + + out = 1; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/display.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,13 @@ +function display( s ) +% Display the critical info for an amplifier + + gick = get(s,'gick'); + disp([inputname(1),'.gick = ']) + disp(' '); + disp(gick); + disp(' '); + disp([inputname(1),'.gack = ']) + disp(' '); + disp(s.gack); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/gack.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = gack( in, val ) + + if (nargin==1) + out = in.gack; + else + in.gack = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/get.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function [ v ] = get( s, propName ) + + switch propName + case 'gack' + v = s.gack; + otherwise + v = get(s.Snork,propName); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/getStash.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = getStash(cls) + + out = myStash(); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/private/myStash.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = myStash() + + out = 2; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/set.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = set( s, varargin ) + + propArgs = varargin; + while (length(propArgs) >= 2) + propName = propArgs{1}; + propValue = propArgs{2}; + propArgs = propArgs(3:end); + switch propName + case 'gack' + s.gack = propValue; + otherwise + s.Snork = set(s.Snork, propName, propValue); + end + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/Gork.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,15 @@ +function [ s ] = Gork( g ) + if (nargin==1) && isa(g,'Gork') + s = sprk; + return; + end + + drk = Dork(); + prk = Pork(); + blrk = Blork(); + s.Cork = Cork(17); % Aggregation. + s.gark = -2; + s.gyrk = -3; + s = class(s,'Gork',drk,prk,blrk); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/cork.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = cork( in, val ) + + if (nargin==1) + out = in.Cork; + else + in.Cork = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/display.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,16 @@ +function display( s ) +% Display the critical info for a Gork. + + dork_base = s.Dork + %pork_base = s.Pork + %sprk = s.sprk; + gark = get(s,'gark'); + disp([inputname(1),'.gark = ']) + disp(' '); + disp(gark); + disp([inputname(1),'.Cork= ']) + disp(' '); + disp(click(s.Cork)); + + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/gark.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = gark( in, val ) + + if (nargin==1) + out = in.gark; + else + in.gark = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/get.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,14 @@ +function [ v ] = get( s, propName ) + + switch propName + case 'cork' + v = s.Cork; + case 'gark' + v = s.gark; + otherwise + % Note that get/set for multiple parents is hard. We only do one + % branch of the parent tree just to test this stuff out. + v = get(s.Dork,propName); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/set.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,24 @@ +function [ s ] = set( s, varargin ) + + propArgs = varargin; + while (length(propArgs) >= 2) + propName = propArgs{1}; + propValue = propArgs{2}; + propArgs = propArgs(3:end); + switch propName + case 'cork' + if(isa(propValue,'Cork')) + s.Cork = propValue; + else + s.Cork = set(s.Cork, 'click',propValue); + end + case 'gark' + s.gark = propValue; + otherwise + % Note that get/set for multiple parents is hard. We only do one + % branch of the parent tree just to test this stuff out. + s.Dork = set(s.Dork, propName, propValue); + end + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/subsasgn.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,9 @@ +function g = subsasgn(g, s, x) + + switch s.type + case '.' + switch s.subs + case 'gyrk' + g.gyrk = x; + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/subsref.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,9 @@ +function x = subsref(g, s) + + switch s.type + case '.' + switch s.subs + case 'gyrk' + x = g.gyrk; + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Pork/Pork.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,19 @@ +function [ s ] = Pork( geek, gurk ) + + if (nargin==1) && isa(geek,'Pork') + s = geek; + else + s.gurk = 0; + if nargin == 0 + s0 = Spork(); + elseif nargin==1 + s0 = Spork(geek); + else + s0 = Spork(geek); + s.gurk = gurk; + end + s = class(s,'Pork',s0); + end + superiorto('Dork'); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Pork/bling.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = bling( m1, m2 ) + + out = 2; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Pork/display.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,13 @@ +function display( s ) +% Display the critical info for an amplifier + + geek = get(s,'geek'); + disp([inputname(1),'.geek = ']) + disp(' '); + disp(geek); + disp(' '); + disp([inputname(1),'.gurk = ']) + disp(' '); + disp(s.gurk); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Pork/get.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function [ v ] = get( s, propName ) + + switch propName + case 'gurk' + v = s.gurk; + otherwise + v = get(s.Spork,propName); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Pork/gurk.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = gurk( in, val ) + + if (nargin==1) + out = in.gurk; + else + in.gurk = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Pork/private/myStash.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = myStash() + + out = 4; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Pork/set.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = set( s, varargin ) + + propArgs = varargin; + while (length(propArgs) >= 2) + propName = propArgs{1}; + propValue = propArgs{2}; + propArgs = propArgs(3:end); + switch propName + case 'gurk' + s.gurk = propValue; + otherwise + s.Spork = set(s.Spork, propName, propValue); + end + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Sneetch/Sneetch.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = Sneetch( mcbean ) +% Test class: should produce error. + + if (nargin==1) && isa(mcbean, 'Sneetch') + s = mcbean; + else + if nargin==0 + s.mcbean = 1; + else + s.mcbean = mcbean; + end + s = class(s, 'Sneetch'); + s.sylvester = 1; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Sneetch/display.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function display( s ) + + disp([inputname(1),'.mcbean = ']) + disp(' '); + disp(s.mcbean); + disp([inputname(1),'.sylvester = ']) + disp(' '); + disp(s.sylvester); + +end \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/Snork.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,17 @@ +function [ s ] = Snork( gick ) +% Test class. + + if ( (nargin==1) && (isa(gick, 'Snork')) ) + s = gick; + else + s.cack = [0 1 2 3]; + if nargin==0 + s.gick = 1; + else + s.gick = gick; + end + s = class(s, 'Snork'); + + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/cack.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = cack( in ) + + out = in.cack; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/display.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,7 @@ +function display( s ) + + disp([inputname(1),'.gick = ']); + disp(' '); + disp(s.gick); + +end \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/end.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,9 @@ +function r = end (snk, index_pos, num_indices) + + if (num_indices ~= 1) + error ('Snork object may only have one index') + end + + r = length (snk.cack); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/get.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function [ v ] = get( s, propName ) + + switch propName + case 'gick' + v = s.gick; + otherwise + error([propName, ' is not a valid Snork property']); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/getStash.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = getStash(cls) + + out = myStash(); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/gick.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = gick( in, val ) + + if (nargin==1) + out = in.gick; + else + in.gick = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/loadobj.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,6 @@ +function [ out ] = loadobj( in ) + + out = in; + out.cack = [-1 -2 -3 -4]; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/private/myStash.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = myStash() + + out = 1; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/saveobj.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,6 @@ +function [ out ] = saveobj( in ) + + out = in; + out.cack = []; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/set.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = set( s, varargin ) + + propArgs = varargin; + while (length(propArgs) >= 2) + propName = propArgs{1}; + propValue = propArgs{2}; + propArgs = propArgs(3:end); + switch propName + case 'gick' + s.gick = propValue; + otherwise + error([propName, ' is not a valid Snork property']); + end + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/subsasgn.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,38 @@ +function snk = subsasgn (snk, s, val) + if (length (s) < 1) + error ('Snork: needs index'); + end + switch (s(1).type) + case '()' + ind = s(1).subs; + if (numel (ind) ~= 1) + error ('Snork: need exactly one index'); + else + if (length (s) == 1) + snk.cack(ind{1}) = val; + else + error ('Snork: chained subscripts not allowed for {}'); + end + end + case '{}' + ind = s(1).subs; + if (numel (ind) ~= 1) + error ('Snork: need exactly one index'); + else + if (length (s) == 1) + snk.cack(ind{1}) = val; + else + error ('Snork: chained subscripts not allowed for {}'); + end + end + case '.' + fld = s(1).subs; + if (strcmp (fld, 'gick')) + snk.gick = val; + else + error ('Snork/subsasgn: invalid property \"%s\"', fld); + end + otherwise + error ('invalid subscript type'); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/subsindex.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = subsindex( obj ) + + out = 0; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/subsref.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,30 @@ +function b = subsref (snk, s) + if (isempty (s)) + error ('Snork: missing index'); + end + switch (s(1).type) + case '()' + ind = s(1).subs; + if (numel (ind) ~= 1) + error ('Snork: need exactly one index'); + else + b = snk.cack(ind{1}); + end + case '{}' + ind = s(1).subs; + if (numel (ind) ~= 1) + error ('Snork: need exactly one index'); + else + b = snk.cack(ind{1}); + end + case '.' + fld = s.subs; + if (strcmp (fld, 'gick')) + b = snk.gick; + else + error ('Snork/subsref: invalid property \"%s\"', fld); + end + otherwise + error ('invalid subscript type'); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/Spork.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,17 @@ +function [ s ] = Spork( geek ) +% Test class. + + if (nargin==1) && isa(geek, 'Spork') + s = geek; + else + s.cack = [-1 -2 -3 -4]; + if nargin==0 + s.geek = 1; + else + s.geek = geek; + end + s = class(s, 'Spork'); + + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/cack.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = cack( in ) + + out = in.cack; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/display.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,7 @@ +function display( s ) + + disp([inputname(1),'.geek = ']) + disp(' '); + disp(s.geek); + +end \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/geek.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = geek( in, val ) + + if (nargin==1) + out = in.geek; + else + in.geek = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/get.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,10 @@ +function [ v ] = get( s, propName ) + + switch propName + case 'geek' + v = s.geek; + otherwise + error([propName, ' is not a valid Spork property']); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/getStash.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = getStash(cls) + + out = myStash(); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/loadobj.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,8 @@ +function [ out ] = loadobj( in ) + + out = in; + if (~isa(in,'Spork')) + out.cack=[]; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/private/myStash.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = myStash() + + out = 3; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/saveobj.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,6 @@ +function [ out ] = saveobj( in ) + + out = in; + %rmfield(out,'cack'); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/set.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = set( s, varargin ) + + propArgs = varargin; + while (length(propArgs) >= 2) + propName = propArgs{1}; + propValue = propArgs{2}; + propArgs = propArgs(3:end); + switch propName + case 'geek' + s.geek = propValue; + otherwise + error([propName, ' is not a valid Spork property']); + end + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/test_classes.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,201 @@ +## Copyright (C) 2009-2011 Robert T. Short +## +## 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 test classes. +%% +%% Note: This script and all classes are also intended to run +%% in MATLAB to test compatibility. Don't break that! +%% +%% To Do: This script tests to ensure that things done correctly work +%% corrrectly. It should also check that things done incorrectly +%% error properly. +%% +%% The classes used for the tests reside in the test directory. +%% +%% The classes provide the ability to test most of the major features +%% of the legacy OOP facilities. There are a number of classes, mostly +%% kind of the same, that create a hierarchy. + +%% Test the Snork class. The Snork class has a number of the standard +%% methods that the others don't so we can test indexing and other +%% features. +%!shared snk, snk1, snk2 +%!test snk = Snork(); +%! assert(gick(snk),1) +%! assert(snk.gick,1) +%! assert(snk(2),1); +%! assert(snk{end},3); +%!test snk = gick(snk,2); +%! assert(gick(snk),2) +%!test snk = set(snk,'gick',7); +%! assert(get(snk, 'gick'), 7) +%!test snk.gick = 4; +%! assert(gick(snk),4) +%! snk(1) = 3; +%!test snk{end} = 9; +%! assert(cack(snk),[3 1 2 9]) +%! assert(getStash(snk),1) % Check private functions. +%! assert(isobject(snk)) +%! assert(class(snk),'Snork') +%! assert(isa(snk,'Snork')) +%! assert(~isa(snk,'Sneetch')) +%! assert(ismethod(snk,'gick')) +%! assert(~ismethod(snk,'bletch')) +%! assert(exist('snk')) +%! assert(~exist('blink')) +%!test snk1 = Snork(snk); +%! assert(class(snk1),'Snork') +%! assert(gick(snk1),4) +%!test snk2 = Snork(-3); +%! assert(class(snk2),'Snork') +%! assert(gick(snk2),-3) +%!test x=[1 2 3 4]; +%! assert(x(snk),1); +%% x=methods('Snork'); % Need to test the methods function. +%% save temp snk; +%% load temp % This load causes a segment fault. +%% assert(cack(snk),[-1 -2 -3 -4]); % This is a major bug! + +%% The Spork class is a near clone of Snork but without as many standard +%% methods. We are testing no new octave features, but this is makes +%% sure that we haven't bollixed up the Spork class if we should make +%% changes. We use Spork in the class hierarchy. +%!shared sprk +%!test sprk = Spork(); +%! assert(geek(sprk),1) +%!test sprk = geek(sprk,3); +%! assert(geek(sprk),3) +%!test sprk = set(sprk,'geek',7); +%! assert(get(sprk, 'geek'), 7) +%! assert(class(sprk),'Spork'); +%! assert(isa(sprk,'Spork')) + +%% The Blork class is a near clone of Snork but without as many standard +%% methods. We are testing no new octave features, but this is makes +%% sure that we haven't bollixed up the Blork class if we should make +%% changes. We use Blork in the class hierarchy. +%!shared blrk +%!test blrk = Blork(); +%! assert(bleek(blrk),1) +%!test blrk = bleek(blrk,3); +%! assert(bleek(blrk),3) +%!test blrk = set(blrk,'bleek',13); +%! assert(get(blrk, 'bleek'), 13) +%! assert(class(blrk),'Blork'); +%! assert(isa(blrk,'Blork')) + +%% The Cork class is a near clone of Snork but without as many standard +%% methods. We are testing no new octave features, but this is makes +%% sure that we haven't bollixed up the Cork class if we should make +%% changes. We use Cork in the class hierarchy. +%!shared crk +%!test crk = Cork(23); +%! assert(click(crk),23) +%!test crk = click(crk,3); +%! assert(click(crk),3) +%!test crk = set(crk,'click',13); +%! assert(get(crk, 'click'), 13) +%! assert(class(crk),'Cork'); +%! assert(isa(crk,'Cork')) + +%% The Dork class tests single inheritance. +%!shared drk +%!test drk = Dork(); +%! assert(gack(drk),0) +%!test drk = gack(drk,-2); +%! assert(gack(drk),-2) +%!test drk = gick(drk,2); +%! assert(gick(drk),2); +%!test drk = set(drk, 'gick',3, 'gack',-3); +%! assert(get(drk, 'gick'), 3) +%! assert(get(drk, 'gack'), -3) +%! assert(class(drk),'Dork') +%! assert(isa(drk,'Dork')) +%! assert(isa(drk,'Snork')) +%! assert(getStash(drk),2) +%!test drk1 = Dork(drk); +%! assert(class(drk1),'Dork') +%! assert(isa(drk1,'Snork')) +%! assert(gick(drk1),3) +%! assert(gack(drk1),-3) +%!test drk2 = Dork(-4,4); +%! assert(class(drk2),'Dork') +%! assert(isa(drk2,'Snork')) +%! assert(gick(drk2),-4) +%! assert(gack(drk2),4) + +%% The Pork class is essentially a clone of Dork. It is used as part +%% of the multiple inheritance test. +%!shared prk, drk +%!test prk = Pork(); +%! assert(geek(prk),1) +%! assert(gurk(prk),0) +%!test prk = gurk(prk,-3); +%! assert(gurk(prk),-3) +%!test prk = geek(prk,9); +%! assert(geek(prk),9) +%! assert(class(prk),'Pork') +%! assert(isa(prk,'Pork')) +%! assert(isa(prk,'Spork')) +%!test drk = Dork(); % Precedence. +%! assert(bling(drk,prk),2) +%! assert(bling(prk,drk),2) + +%% The Gork class tests aggregation and multiple inheritance. +%!shared grk +%!test grk = Gork(); +%! assert(gick(grk),1) +%! assert(geek(grk),1) +%! assert(gack(grk),0) +%! assert(gurk(grk),0) +%! assert(bleek(grk),1) +%! assert(gark(grk),-2) +%! assert(click(cork(grk)),17) +%! assert(class(cork(grk)),'Cork') +%!test grk = gick(grk,3); +%!test grk = geek(grk,4); +%!test grk = gack(grk,-9); +%!test grk = gurk(grk,-8); +%!test grk = bleek(grk,-7); +%!test grk = gark(grk,-6); +%!test grk = cork(grk,click(cork(grk),23)); +%! assert(gick(grk),3) +%! assert(geek(grk),4) +%! assert(gack(grk),-9) +%! assert(gurk(grk),-8) +%! assert(bleek(grk),-7) +%! assert(gark(grk),-6) +%! assert(click(cork(grk)),23) +%!test +%! cork1 = Cork(13); +%! grk = set(grk, 'gick',-5, 'gack',-6, 'gark',-7, 'cork',cork1); +%! assert(get(grk,'gick'),-5) +%! assert(get(grk,'gack'),-6) +%! assert(get(grk,'gark'),-7) +%! assert(click(get(grk, 'cork')),13); +%!test grk = set(grk, 'cork',12); +%! assert(click(get(grk, 'cork')),12); +%! assert(class(cork(grk)),'Cork') +%! assert(class(grk),'Gork') +%! assert(isa(grk,'Gork')) +%! assert(isa(grk,'Dork')) +%! assert(isa(grk,'Pork')) +%! assert(isa(grk,'Blork')) +%! assert(isa(grk,'Snork')) +%! assert(isa(grk,'Spork'))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/@derived/derived.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function r = derived (varargin) + __trace__ ('begin derived/derived'); + r = class (struct (), 'derived', parent ()); + __trace__ ('end derived/derived'); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/@derived/parent.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/@other/other.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function r = other (varargin) + __trace__ ('begin other/other'); + r = class (struct (), 'other'); + __trace__ ('end other/other'); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/@other/parent.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,4 @@ +function r = parent (a) + __trace__ ('begin other/parent'); + __trace__ ('end other/parent'); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/@parent/method.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function r = method (a) + __trace__ ('begin parent/method'); + r = parent (a); + __trace__ ('end parent/method'); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/@parent/parent.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/__trace__.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/test_ctor_vs_method.m Sun Dec 11 23:24:25 2011 -0500 @@ -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);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/@derived/derived.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,5 @@ +function r = derived (n) + s.a = n; + p = parent (n); + r = class (s, 'derived', p); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/@other/getsize_arrayfun.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,3 @@ +function r = getsize_arrayfun (x) + r = arrayfun (@(i) numel (x(i).d), 1:numel(x), 'uniformoutput', true); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/@other/getsize_cellfun.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,3 @@ +function r = getsize_cellfun (x) + r = cellfun (@numel, {x.d}); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/@other/getsize_loop.m Sun Dec 11 23:24:25 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/@other/other.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,4 @@ +function r = other (n) + s.d = derived (n); + r = class (s, 'other'); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/@parent/numel.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,3 @@ +function r = numel (x, varargin) + r = numel (x.a, varargin{:}); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/@parent/parent.m Sun Dec 11 23:24:25 2011 -0500 @@ -0,0 +1,4 @@ +function r = parent (n) + s.a = rand (n, 1); + r = class (s, 'parent'); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/module.mk Sun Dec 11 23:24:25 2011 -0500 @@ -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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/test_fcn_handle_derived_resolution.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/test/fntests.m Sun Dec 11 23:24:25 2011 -0500 @@ -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");
--- a/test/test_classes.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,201 +0,0 @@ -## Copyright (C) 2009-2011 Robert T. Short -## -## 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 test classes. -%% -%% Note: This script and all classes are also intended to run -%% in MATLAB to test compatibility. Don't break that! -%% -%% To Do: This script tests to ensure that things done correctly work -%% corrrectly. It should also check that things done incorrectly -%% error properly. -%% -%% The classes used for the tests reside in the test directory. -%% -%% The classes provide the ability to test most of the major features -%% of the legacy OOP facilities. There are a number of classes, mostly -%% kind of the same, that create a hierarchy. - -%% Test the Snork class. The Snork class has a number of the standard -%% methods that the others don't so we can test indexing and other -%% features. -%!shared snk, snk1, snk2 -%!test snk = Snork(); -%! assert(gick(snk),1) -%! assert(snk.gick,1) -%! assert(snk(2),1); -%! assert(snk{end},3); -%!test snk = gick(snk,2); -%! assert(gick(snk),2) -%!test snk = set(snk,'gick',7); -%! assert(get(snk, 'gick'), 7) -%!test snk.gick = 4; -%! assert(gick(snk),4) -%! snk(1) = 3; -%!test snk{end} = 9; -%! assert(cack(snk),[3 1 2 9]) -%! assert(getStash(snk),1) % Check private functions. -%! assert(isobject(snk)) -%! assert(class(snk),'Snork') -%! assert(isa(snk,'Snork')) -%! assert(~isa(snk,'Sneetch')) -%! assert(ismethod(snk,'gick')) -%! assert(~ismethod(snk,'bletch')) -%! assert(exist('snk')) -%! assert(~exist('blink')) -%!test snk1 = Snork(snk); -%! assert(class(snk1),'Snork') -%! assert(gick(snk1),4) -%!test snk2 = Snork(-3); -%! assert(class(snk2),'Snork') -%! assert(gick(snk2),-3) -%!test x=[1 2 3 4]; -%! assert(x(snk),1); -%% x=methods('Snork'); % Need to test the methods function. -%% save temp snk; -%% load temp % This load causes a segment fault. -%% assert(cack(snk),[-1 -2 -3 -4]); % This is a major bug! - -%% The Spork class is a near clone of Snork but without as many standard -%% methods. We are testing no new octave features, but this is makes -%% sure that we haven't bollixed up the Spork class if we should make -%% changes. We use Spork in the class hierarchy. -%!shared sprk -%!test sprk = Spork(); -%! assert(geek(sprk),1) -%!test sprk = geek(sprk,3); -%! assert(geek(sprk),3) -%!test sprk = set(sprk,'geek',7); -%! assert(get(sprk, 'geek'), 7) -%! assert(class(sprk),'Spork'); -%! assert(isa(sprk,'Spork')) - -%% The Blork class is a near clone of Snork but without as many standard -%% methods. We are testing no new octave features, but this is makes -%% sure that we haven't bollixed up the Blork class if we should make -%% changes. We use Blork in the class hierarchy. -%!shared blrk -%!test blrk = Blork(); -%! assert(bleek(blrk),1) -%!test blrk = bleek(blrk,3); -%! assert(bleek(blrk),3) -%!test blrk = set(blrk,'bleek',13); -%! assert(get(blrk, 'bleek'), 13) -%! assert(class(blrk),'Blork'); -%! assert(isa(blrk,'Blork')) - -%% The Cork class is a near clone of Snork but without as many standard -%% methods. We are testing no new octave features, but this is makes -%% sure that we haven't bollixed up the Cork class if we should make -%% changes. We use Cork in the class hierarchy. -%!shared crk -%!test crk = Cork(23); -%! assert(click(crk),23) -%!test crk = click(crk,3); -%! assert(click(crk),3) -%!test crk = set(crk,'click',13); -%! assert(get(crk, 'click'), 13) -%! assert(class(crk),'Cork'); -%! assert(isa(crk,'Cork')) - -%% The Dork class tests single inheritance. -%!shared drk -%!test drk = Dork(); -%! assert(gack(drk),0) -%!test drk = gack(drk,-2); -%! assert(gack(drk),-2) -%!test drk = gick(drk,2); -%! assert(gick(drk),2); -%!test drk = set(drk, 'gick',3, 'gack',-3); -%! assert(get(drk, 'gick'), 3) -%! assert(get(drk, 'gack'), -3) -%! assert(class(drk),'Dork') -%! assert(isa(drk,'Dork')) -%! assert(isa(drk,'Snork')) -%! assert(getStash(drk),2) -%!test drk1 = Dork(drk); -%! assert(class(drk1),'Dork') -%! assert(isa(drk1,'Snork')) -%! assert(gick(drk1),3) -%! assert(gack(drk1),-3) -%!test drk2 = Dork(-4,4); -%! assert(class(drk2),'Dork') -%! assert(isa(drk2,'Snork')) -%! assert(gick(drk2),-4) -%! assert(gack(drk2),4) - -%% The Pork class is essentially a clone of Dork. It is used as part -%% of the multiple inheritance test. -%!shared prk, drk -%!test prk = Pork(); -%! assert(geek(prk),1) -%! assert(gurk(prk),0) -%!test prk = gurk(prk,-3); -%! assert(gurk(prk),-3) -%!test prk = geek(prk,9); -%! assert(geek(prk),9) -%! assert(class(prk),'Pork') -%! assert(isa(prk,'Pork')) -%! assert(isa(prk,'Spork')) -%!test drk = Dork(); % Precedence. -%! assert(bling(drk,prk),2) -%! assert(bling(prk,drk),2) - -%% The Gork class tests aggregation and multiple inheritance. -%!shared grk -%!test grk = Gork(); -%! assert(gick(grk),1) -%! assert(geek(grk),1) -%! assert(gack(grk),0) -%! assert(gurk(grk),0) -%! assert(bleek(grk),1) -%! assert(gark(grk),-2) -%! assert(click(cork(grk)),17) -%! assert(class(cork(grk)),'Cork') -%!test grk = gick(grk,3); -%!test grk = geek(grk,4); -%!test grk = gack(grk,-9); -%!test grk = gurk(grk,-8); -%!test grk = bleek(grk,-7); -%!test grk = gark(grk,-6); -%!test grk = cork(grk,click(cork(grk),23)); -%! assert(gick(grk),3) -%! assert(geek(grk),4) -%! assert(gack(grk),-9) -%! assert(gurk(grk),-8) -%! assert(bleek(grk),-7) -%! assert(gark(grk),-6) -%! assert(click(cork(grk)),23) -%!test -%! cork1 = Cork(13); -%! grk = set(grk, 'gick',-5, 'gack',-6, 'gark',-7, 'cork',cork1); -%! assert(get(grk,'gick'),-5) -%! assert(get(grk,'gack'),-6) -%! assert(get(grk,'gark'),-7) -%! assert(click(get(grk, 'cork')),13); -%!test grk = set(grk, 'cork',12); -%! assert(click(get(grk, 'cork')),12); -%! assert(class(cork(grk)),'Cork') -%! assert(class(grk),'Gork') -%! assert(isa(grk,'Gork')) -%! assert(isa(grk,'Dork')) -%! assert(isa(grk,'Pork')) -%! assert(isa(grk,'Blork')) -%! assert(isa(grk,'Snork')) -%! assert(isa(grk,'Spork'))
--- a/test/test_index-wfi-f.m Mon Dec 05 02:02:22 2011 -0500 +++ b/test/test_index-wfi-f.m Sun Dec 11 23:24:25 2011 -0500 @@ -18,318 +18,211 @@ %% 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 +230,9 @@ %! 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 +240,9 @@ %! 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 +250,9 @@ %! 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 +260,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
--- a/test/test_index-wfi-t.m Mon Dec 05 02:02:22 2011 -0500 +++ b/test/test_index-wfi-t.m Sun Dec 11 23:24:25 2011 -0500 @@ -18,318 +18,211 @@ %% 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]; @@ -337,12 +230,9 @@ %! 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]; @@ -350,12 +240,9 @@ %! 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]; @@ -363,12 +250,9 @@ %! 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]; @@ -376,4 +260,3 @@ %! a_row_1 = [1,2]; %! a_row_2 = [3,4]; %! fail("a(2);","warning"); -%! warning (wfi.state, "Octave:fortran-indexing");
--- a/test/test_io.m Mon Dec 05 02:02:22 2011 -0500 +++ b/test/test_io.m Sun Dec 11 23:24:25 2011 -0500 @@ -237,14 +237,37 @@ %!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 %! [a, b, c] = sscanf ("1.2 3 foo", "%f%d%s", "C"); @@ -256,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 @@ -287,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 @@ -299,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 @@ -370,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 ())); @@ -391,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 @@ -476,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 @@ -520,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"); @@ -569,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");
--- a/test/test_logical-wfi-f.m Mon Dec 05 02:02:22 2011 -0500 +++ b/test/test_logical-wfi-f.m Sun Dec 11 23:24:25 2011 -0500 @@ -18,354 +18,222 @@ %% 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_logical-wfi-t.m Mon Dec 05 02:02:22 2011 -0500 +++ b/test/test_logical-wfi-t.m Sun Dec 11 23:24:25 2011 -0500 @@ -18,354 +18,222 @@ %% 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");
--- a/test/test_parser.m Mon Dec 05 02:02:22 2011 -0500 +++ b/test/test_parser.m Sun Dec 11 23:24:25 2011 -0500 @@ -28,142 +28,229 @@ %!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 11 levels of precedence from "exponentiation" (highest) down to -%# "statement operators" (lowest). -%# -%# Level 11 (exponentiation) overrides all others +## 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 -%! assert (-2^2, -4) -%! assert (!0^0, false); -# FIXME: This test is failing. Transpose mistakenly has higher priority. -%!# assert ([2 3].^2', [4; 9]) -%! 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 (1 && 0^0, true) +%! 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; +%! a *= 0 ^0; %! assert (a, 3) -%# Level 10 (unary plus, increment, not) +## Level 10 (unary plus/minus, prefix increment/decrement, not) %!test -# FIXME: No test for increment and transpose that I can think of. %! a = 2; -%! assert (++a*3, 9) -%! assert (a++-2, 1) -%! assert (a, 4) -%! assert ([1:10](1:++a), [1:5]) -%! assert (5 == a++, true) -%! assert (7 == ++a, true) +%! 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 (1 & a++, false) -%! assert (a, 1) -%! assert (1 && --a, false) +%! assert (++ a&1, true) +%! assert (-- a|0, false) +%! assert (-- a&&1, true) +%! assert (++ a||0, false) %! a = 3; -%! a *= a++; -%! assert (a, 12) -%# Level 9 (transpose) +%! a *= ++a; +%! assert (a, 16) +## Level 9 (multiply, divide) %!test -%! assert ([1 2]*[3 4]', 11) -%! assert ([1 2]'+[3 4]', [4; 6]) -%! assert (1:5', 1:5) -%! assert ([1; 2] == [1 2]', [true; true]) -%! assert ([1; 0] & [1 0]', [true; false]) -# FIXME: No test for transpose and short-circuit operator that I can think of. -%! a = [1 2]; -%! a *= [3 4]'; -%! assert (a, 11) -%# Level 8 (multiply, divide) -%!test -%! assert (3 + 4 * 5, 23) -%! 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, false) +%! 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 7 (add, subtract) +## Level 8 (add, subtract) %!test %! assert ([2 + 1:6], 3:6) -%! assert (3 > 1 + 5, false) -%! assert (1 & 1 - 1, false) -%! assert (1 && 1 - 1, false) +%! 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 6 (colon) +## Level 7 (colon) %!test -%! assert (5:-1: 3 > 4, [true false false]) -%! assert (1: 3 & 1, [true true true]) -%! assert (-1: 3 && 1, false) +%! 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 5 (relational) +## Level 6 (relational) %!test -%! assert (0 == -1 & 0, false) -%! assert (0 == -1 && 0, false) +%! 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 4 (element-wise and, or) +## Level 5 (element-wise and) %!test -%! assert (0 & 1 || 1, true) -%! assert (0 == -1 && 0, false) +%! 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 3 (logical and, or) +## 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 exponents and assignments. -%# Level 11 (exponentiation) +## 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 -%# FIXME : Exponentiation seems to work left to right, despite the -%# documentation and ordinary mathematical rules of precedence. -%!# assert (2^3**2, 512) -%# Level 10 (unary plus, increment, not) +%! 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 = 0; -%# FIXME : Should we test for this corner case at all? -%# (unary minus)(auto-decrement operator) -%!# assert (---a, 1); %! a = -1; %! assert (!++a, true) %! assert (a, 0) %! assert (-~a, -1) -%! assert (!~a++, false) -%! assert (a, 1) -%# Level 9 (transpose) +%! assert (!~--a, true) +%! assert (a, -1) +## Level 9 (multiply, divide) %!test -%! assert (3*4i'.', 0 - 12i) -%! assert (3*4i.'.', 0 + 12i) -%# Level 8 (multiply, divide) +%! 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 / 5, 2.4) -%!assert (3 ./ 4 .* 5, 3.75) -%# Level 7 (add, subtract) -%!test -%!assert (-3 - 4 + 1 + 3 * 2, 0) -%# Level 5 (relational) +%! 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 4 (element-wise and, or) +## 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 -%! assert ([ 1 0] & [0 1] | [1 0], [true false]) -%# Level 2 (assignment) +%! 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)]);
--- a/test/test_string.m Mon Dec 05 02:02:22 2011 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/test/test_struct.m Sun Dec 11 23:24:25 2011 -0500 @@ -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 Mon Dec 05 02:02:22 2011 -0500 +++ b/test/test_system.m Sun Dec 11 23:24:25 2011 -0500 @@ -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);